Wiki copymirror

This is a mirror of the wiki at pascal.chat. Editing, history and sign-in are there.

Synapse - Email Examples

Example 1 - sending to Gmail

(forum user ludob). This works for me with Gmail using Synapse.

pascal
uses
      ..., smtpsend, ssl_openssl;
    
    function SendMail(const User, Password, MailFrom, MailTo, SMTPHost, SMTPPort, MailData: string): Boolean;
    var
      SMTP: TSMTPSend;
      sl:TStringList;
    begin
      Result:=False;
      SMTP:=TSMTPSend.Create;
      sl:=TStringList.Create;
      try
        sl.text:=Maildata;
        SMTP.UserName:=User;
        SMTP.Password:=Password;
        SMTP.TargetHost:=SMTPHost;
        SMTP.TargetPort:=SMTPPort;
        SMTP.AutoTLS:=true;
        if SMTPPort<> '25' then
          SMTP.FullSSL:=true;
        if SMTP.Login then
        begin
          Result:=SMTP.MailFrom(MailFrom, Length(MailData)) and
             SMTP.MailTo(MailTo) and
             SMTP.MailData(sl);
          SMTP.Logout;
        end;
      finally
        SMTP.Free;
        sl.Free;
      end;
    end;

Example 2 - sending attachments

(forum user y.ivanov). Here is my small helper unit for Synapse. The password is the sender password (for SMTP).

pascal
unit mailsendu;
     
    {$mode objfpc}{$H+}
     
    interface
     
    uses
      Classes, SysUtils, smtpsend;
     
    type
     
      { TMySMTPSend }
     
      TMySMTPSend = class(TSMTPSend)
      private
        FSendSize: Integer;
      protected
        function SendToRaw(const AFrom, ATo: String; const AMailData: TStrings)
          : Boolean;
      public
        function SendMessage(AFrom, ATo, ASubject: String; AContent,
          AAttachments: TStrings): Boolean;
     
        property SendSize: Integer read FSendSize write FSendSize;
     
      end;
     
    implementation
     
    uses
      ssl_openssl3, mimemess, mimepart, synautil, synachar;
     
    { TMySMTPSend }
     
    function TMySMTPSend.SendToRaw(const AFrom, ATo: String; const AMailData
      : TStrings): Boolean;
    var
      S, T: String;
    begin
      Result := False;
      if Self.Login then
      begin
        FSendSize := Length(AMailData.Text);
        if Self.MailFrom(GetEmailAddr(AFrom), FSendSize) then
        begin
          S := ATo;
          repeat
            T := GetEmailAddr(Trim(FetchEx(S, ',', '"')));
            if T <> '' then
              Result := Self.MailTo(T);
            if not Result then
              Break;
          until S = '';
          if Result then
            Result := Self.MailData(AMailData);
        end;
        Self.Logout;
      end;
    end;
     
    function TMySMTPSend.SendMessage(AFrom, ATo, ASubject: String; AContent,
      AAttachments: TStrings): Boolean;
    var
      Mime: TMimeMess;
      P: TMimePart;
      I: Integer;
    begin
      Mime := TMimeMess.Create;
      try
        // Set some headers
        Mime.Header.CharsetCode := UTF_8;
        Mime.Header.ToList.Text := ATo;
        Mime.Header.Subject := ASubject;
        Mime.Header.From := AFrom;
     
        // Create a MultiPart part
        P := Mime.AddPartMultipart('mixed', Nil);
     
        // Add as first part the mail text
        Mime.AddPartTextEx(AContent, P, UTF_8, True, ME_8BIT);
     
        // Add all attachments:
        if Assigned(AAttachments) then
          for I := 0 to Pred(AAttachments.Count) do
            Mime.AddPartBinaryFromFile(AAttachments[I], P);
     
        // Compose message
        Mime.EncodeMessage;
     
        // Send using SendToRaw
        Result := Self.SendToRaw(AFrom, ATo, Mime.Lines);
     
      finally
        Mime.Free;
      end;
    end;
     
    end.

This is how to use that unit:

pascal
program mailsend_test;
     
    uses
      Classes, SysUtils, mailsendu, blcksock;
     
    type
     
      { TSink }
     
      TSink = class(TObject)
        procedure Progress(Sender: TObject; Reason: THookSocketReason;const Value: String);
      end;
     
    var
      Content: TStringList = Nil;
      Attach: TStringList = Nil;
      SMTP: TMySMTPSend = Nil;
      Sink: TSink = Nil;
      Written: Integer;
     
    { TSink }
     
    procedure TSink.Progress(Sender: TObject; Reason: THookSocketReason;
      const Value: String);
    begin
      case Reason  of
        {:Socket connected to IP and Port. Connected IP and Port is in parameter in
         format like: 'localhost.somewhere.com:25'.}
        HR_Connect: Written := 0;
        {:report count of bytes writed to socket. Number is in parameter string. If
         you need is in integer, you must use StrToInt function!}
        HR_WriteCount:
          begin
            Written := Written + StrToInt(Value);
            WriteLn('Written ', Written, ' of ', SMTP.SendSize, ' bytes');
          end;
        {:report situation where communication error occured. When raiseexcept is
         @true, then exception is called after this Hook reason.}
        HR_Error: WriteLn('Error: ', Value);
      end;
    end;
     
    begin
      try
        Sink := TSink.Create;
        Content := TStringList.Create;
        Content.Add('Hello!');
        Content.Add('This is a SMTP send test.');
        Content.Add('Hello from the other side!');
        Content.Add('Regards,');
        Attach := TStringList.Create;
        Attach.Add('mismisc.pas');
        Attach.Add('notused.pas');
        SMTP := TMySMTPSend.Create;
        SMTP.TargetHost := 'smtp.googlemail.com';
        SMTP.TargetPort := '465';
        SMTP.Username := 'user@gmail.com';
        SMTP.Password := 'password here';
        SMTP.FullSSL := True;
        SMTP.Sock.OnStatus := @Sink.Progress;
        SMTP.Sock.RaiseExcept := True;
        try
          if SMTP.SendMessage(
            'user@gmail.com', // AFrom
            'recipient@domain.com', // ATo
            'Test subject FullSSL 2', // ASubject
            Content,
            Attach)
          then
            WriteLn('Success.')
          else
          begin
            WriteLn('Failure!');
          end;
        except
          on E: Exception do
            WriteLn('EXCEPTION: ', E.Message);
        end;
     
        with SMTP do
        begin
          WriteLn;
          WriteLn('  ResultCode: ', ResultCode);
          WriteLn('ResultString: ', ResultString);
          WriteLn('  FullResult: ', FullResult.Text);
          WriteLn('    AuthDone: ', AuthDone) ;
        end;
      finally
        FreeAndNil(Content);
        FreeAndNil(Attach);
        FreeAndNil(Sink);
        FreeAndNil(SMTP);
      end;
     
    end.

Example 3 - using the XMailer wrapper

(forum user Silvio Clécio). I use XMailer plugin (it uses Synapse framework). Works fine with Gmail, Hotmail, Yahoo etc.

It is also available in the Online Package Manager.

Example 4 - with error checking for debugging

This version is "advanced" in so far as it does a lot of error checking and shows you the responses from the remote mail server. It is very useful for debugging especially when you do not have access to the remote mail server's logs.

pascal
unit Unit1;
    
    {$mode objfpc}{$H+}
    
    interface
    
    uses
      Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls;
    
    type
    
      { TForm1 }
    
      TForm1 = class(TForm)
        Button1: TButton;
        Memo1: TMemo;
        procedure Button1Click(Sender: TObject);
      private
      public
      end;
    
    var
      Form1: TForm1;
    
    implementation
    
    {$R *.lfm}
    uses
       // "ssl_openssl" unit is required to use SSL / TLS
       ssl_openssl, SMTPsend;
    
    // MailData is the text of the mail.
    procedure SendMail(User, Password, MailFrom, MailTo, SMTPHost, SMTPPort: string; MailData: string);
    var
      SMTP: TSMTPSend;
      email_lines: TStringList;
    begin
      SMTP := TSMTPSend.Create;
      email_lines := TStringList.Create;
    
      try
        email_lines.text := Maildata;
        SMTP.UserName := User;
        SMTP.Password := Password;
        SMTP.TargetHost := SMTPHost;
        SMTP.TargetPort := SMTPPort;
        //SMTP.AutoTLS := True;  // upgrade to SSL/TLS if remote server supports it
    
        if Trim(SMTPPort) <> '25' then
          SMTP.FullSSL := true; // if sending to port 25, don't use encryption
    
        Form1.Memo1.Clear; // clear memo text
    
        if not SMTP.Login() then
          begin
            Form1.Memo1.Append('SMTP ERROR: Login:' + SMTP.EnhCodeString);
            Form1.Memo1.Append('SMTP Login: Failed - does server exist? does it accept mail?');
            Exit
          end
        else
          begin
            Form1.Memo1.Append('SMTP Login: OK');
            Form1.Memo1.append('-- Remote response: ' + SMTP.FullResult[0]);
          end;
    
        if(SMTP.ESMTP) then
          Form1.Memo1.Append('SMTP: ' + SMTPHost + ' supports ESMTP')
        else
          Form1.Memo1.Append('SMTP: ' + SMTPHost + ' supports plain SMTP');
    
        // Insist on SSL/TLS connection to remote server
        // - if the server might not support it, omit and then
        //   uncomment SMTP.AutoTLS above
        if not SMTP.StartTLS() then
          Form1.Memo1.Append('SMTP ERROR: StartTLS:' + SMTP.EnhCodeString)
        else
          begin
            Form1.Memo1.Append('SMTP StartTLS: OK');
            Form1.Memo1.append('-- Remote response: ' + SMTP.FullResult[0]);
          end;
    
        if not SMTP.MailFrom(MailFrom, Length(MailFrom)) then
          Form1.Memo1.Append('SMTP ERROR: MailFrom:' + SMTP.EnhCodeString)
        else
          begin
            Form1.Memo1.Append('SMTP MailFrom: OK');
            Form1.Memo1.append('-- Remote response: ' + SMTP.FullResult[0]);
          end;
    
        if not SMTP.MailTo(MailTo) then
          Form1.Memo1.Append('SMTP ERROR: MailTo:' + SMTP.EnhCodeString)
        else
          begin
            Form1.Memo1.Append('SMTP MailTo: OK');
            Form1.Memo1.append('-- Remote response: ' + SMTP.FullResult[0]);
          end;
    
        if not SMTP.MailData(email_lines) then
          Form1.Memo1.Append('SMTP ERROR: MailData:' + SMTP.EnhCodeString)
        else
          begin
            Form1.Memo1.Append('SMTP MailData: OK');
            Form1.Memo1.append('-- Remote response: ' + SMTP.FullResult[0]);
          end;
    
        if not SMTP.Logout() then
          Form1.Memo1.Append('SMTP ERROR: Logout:' + SMTP.EnhCodeString)
        else
          begin
            Form1.Memo1.Append('SMTP Logout: OK');
            Form1.Memo1.append('-- Remote response: ' + SMTP.FullResult[0]);
          end;
    
      finally
        SMTP.Free;
        email_lines.Free;
      end;
    end;
    
    procedure TForm1.Button1Click(Sender: TObject);
    begin
      SendMail(
        '',                              // Name if authentication required
        '',                              // Password if authentication required
        'trev@example.com',              // MailFrom
        'trev@example.org',              // MailTo
        'shadow.example.org',            // Mail server to send to
        '25',                            // Mail server port
        'To: trev@example.org'           // Otherwise To: is blank on receipt
        + LineEnding + 'Subject: Test'   // Otherwise Subject: is blank on receipt
        + LineEnding +'Gday!'            // Email body
        + LineEnding);
    end;
    
    end.

Example Memo1 output on success

pascal
SMTP Login: OK
    -- Remote response: 250-shadow.example.org Hello macmini8.example.org [192.168.1.21], pleased to meet you
    SMTP: shadow.example.org supports ESMTP
    SMTP StartTLS: OK
    -- Remote response: 220 2.0.0 Ready to start TLS
    SMTP MailFrom: OK
    -- Remote response: 250 2.1.0 <trev@example.com>... Sender ok
    SMTP MailTo: OK
    -- Remote response: 250 2.1.5 <trev@example.org>... Recipient ok
    SMTP MailData: OK
    -- Remote response: 250 2.0.0 22G97AqL046395 Message accepted for delivery
    SMTP Logout: OK
    -- Remote response: 221 2.0.0 shadow.example.org closing connection

Example Memo1 output on failure

pascal
SMTP Login: OK
    -- Remote response: 250-shadow.example.org Hello 103-216-191-138.dyn.launtel.net.au [103.216.191.138], pleased to meet you
    SMTP: shadow.example.org supports ESMTP
    SMTP StartTLS: OK
    -- Remote response: 220 2.0.0 Ready to start TLS
    SMTP MailFrom: OK
    -- Remote response: 250 2.1.0 <trev@example.com>... Sender ok
    SMTP ERROR: [MailTo:Persistent](<MailTo:Persistent>) Transient Failure-Delivery not authorized, message refused
    -- Remote response: 451 4.7.1 Spam alert: 103-116-191-138.dyn.launtel.net.au [103.116.191.138] mail delivery delayed
    SMTP ERROR: MailData:Permanent Failure-Other undefined Status
    -- Remote response: 503 5.0.0 Need RCPT (recipient)
    SMTP Logout: OK
    -- Remote response: 221 2.0.0 shadow.example.org closing connection

See also

From the Free Pascal wiki, page "Synapse - Email Examples", as the Internet Archive kept it on 2026-02-04, last changed on 2025-08-15. Copyright stays with the author who wrote it, according to the old wiki's Licensing page. If you have concerns about this material, message the admin.

Revision 3, last changed by WikiArchive .