Search code examples
delphidelphi-7indy10

Sending emails with Indy via a separate thread


I've asked previous questions about sending emails with attachments with Indy via GMail and I'm pleased to say that basic code works properly. I have noticed, however, that sending attachments takes a few minutes and in that time, the program freezes (even though I added a TIdAntiFreeze component to the program). I thought that it would be a good idea to have the email sent by a separate thread, thus allowing the program to be responsive.

I have been unable to find code on the web which shows how to send email from a thread and so I had to write my own code which only partially works.

I removed the SMTP component from the form which sends email; instead I save the email component's data to disk (with the TIdMessage.SaveToFile method) and then create a non-modal dialog, which creates a thread which instantiates the needed components and sends the email. I would like to create event handlers for the SMTP and IdMessage components but don't know how to do this at runtime - the thread code can't access any form methods.

Although I am showing my code, I would prefer to see something which works properly.

unit Manage77c;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, SizeGrip, ManageForms, ExtCtrls, StdCtrls, IdBaseComponent,
 IdComponent, IdTCPConnection, IdTCPClient, IdExplicitTLSClientServerBase,
 IdMessageClient, IdSMTPBase, IdSMTP, IdIOHandler, IdIOHandlerSocket, IdSSL,
 IdIOHandlerStack, IdMessage, IdSSLOpenSSL;

type
 TSendAMail = class(TForm)
 mem: TMemo;
 procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
public
 constructor create (const s: string);
end;

implementation

{$R *.dfm}

var
 ahost, apassword, ausername, curstatus, fn: string;
 caller: thandle;

function DoEmail (p: pointer): longint; stdcall;
var
 ssl: TIdSSLIOHandlerSocketOpenSSL;
 email: TIdMessage;

begin
 caller:= THandle (p);
 email:= TIdMessage.create;
 with email do
  begin
   loadfromfile (fn);
   // OnInitializeISO:= ??
  end;

 deletefile (fn); 
 ssl:= TIdSSLIOHandlerSocketOpenSSL.create;
 ssl.SSLOptions.SSLVersions:= [sslvTLSv1];

 with TIdSMTP.create do  
  try
   //OnStatus:= ??
   iohandler:= ssl;
   host:= ahost;
   password:= apassword;
   username:= ausername;
   port:= 587;
   useTLS:= utUseExplicitTLS;
   Connect;
   try
    Send (email);
   except
    on E:Exception do;
   end;
  finally
   Disconnect;
   free
  end;
 ssl.free;
 email.free;
 result:= 0
end;

constructor TSendAMail.Create (const s: string);
var
 empty: boolean;
 thrid: dword;

begin
 inherited create (nil);
 fn:= s;
 repeat
  with dm.qGetSMTP do  // this part gets the SMTP definitions from the database
   begin
    open;
    aHost:= fieldbyname ('smtphost').asstring;
    ausername:= fieldbyname ('smtpuser').asstring;
    apassword:= fieldbyname ('smtppass').asstring;
    close
   end;

  empty:= (ahost = '') or (ausername = '') or (apassword = '');
  if empty then
   with TGetSMTP.create (nil) do   // manage77a
    try
     execute
    finally
     free
    end;
 until not empty;
 CreateThread (nil, 0, @DoEmail, pointer (self.handle), 0, thrid);
 close
end;

procedure TSendAMail.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 action:= caFree
end;

end.

Solution

  • Use the TThread class instead of the CreateThread() function, then you can use methods of the class as event handlers, eg:

    unit Manage77c;
    
    interface
    
    procedure SendAMail (const AFileName: string);
    
    implementation
    
    uses
     SysUtils, Classes, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
     IdExplicitTLSClientServerBase, IdMessageClient, IdSMTPBase, IdSMTP, IdIOHandler,
     IdIOHandlerSocket, IdSSL, IdIOHandlerStack, IdMessage, IdSSLOpenSSL;
    
    type
      TEmailThread = class(TThread)
      private
        FFileName: string;
        FHost: string;
        FPassword: string;
        FUsername: string;
        ...
        procedure DoInitializeISO(var VHeaderEncoding: Char; var VCharSet: string);
        procedure DoStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string);
        ...
      protected
        procedure Execute; override;
      public
        constructor Create(const AFileName, AHost, APassword, AUsername: string); reintroduce;
      end;
    
    constructor TEmailThread.Create(const AFileName, AHost, APassword, AUsername: string);
    begin
      inherited Create(False);
      FreeOnTerminate := True;
      FFileName := AFileName;
      FHost := AHost;
      FPassword := APassword;
      FUsername := AUsername;
      ...
    end;
    
    procedure TEmailThread.Execute;
    var
      smtp: TIdSMTP;
      ssl: TIdSSLIOHandlerSocketOpenSSL;
      email: TIdMessage;
    begin
      email := TIdMessage.Create(nil);
      try
        email.LoadFromFile(FFileName);
        email.OnInitializeISO := DoInitializeISO;
    
        DeleteFile (FFileName); 
    
        smtp := TIdSMTP.Create(nil);
        try
          ssl := TIdSSLIOHandlerSocketOpenSSL.Create(smtp);
          ssl.SSLOptions.SSLVersions := [sslvTLSv1];
    
          smtp.OnStatus := DoStatus;
          smtp.IOHandler := ssl;
          smtp.Host := FHost;
          smtp.Password := FPassword;
          smtp.Username := FUsername;
          smtp.UseTLS := utUseExplicitTLS;
          smtp.Port := 587;
    
          smtp.Connect;
          try
            smtp.Send(email);
          finally
            smtp.Disconnect;
          end;
        finally
          smtp.Free;
        end;
      finally
        email.Free;
      end;
    end;
    
    procedure TEmailThread.InitializeISO(var VHeaderEncoding: Char; var VCharSet: string);
    begin
      ...
    end;
    
    procedure TEmailThread.DoStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string);
    begin
      ...
    end;
    
    procedure SendAMail (const AFileName: string);
    var
      host, user, pass: string;
    begin
      repeat
        // this part gets the SMTP definitions from the database
        dm.qGetSMTP.Open;
        try
          host := dm.qGetSMTP.FieldByName('smtphost').AsString;
          username := dm.qGetSMTP.FieldByName('smtpuser').AsString;
          password := dm.qGetSMTP.FieldByName('smtppass').AsString;
        finally
          dm.qGetSMTP.Close;
        end;
    
        if (host <> '') and (user <> '') and (pass <> '') then
          Break;
    
        with TGetSMTP.Create(nil) do   // manage77a
        try
          Execute;
        finally
          Free;
        end;
      until False;
    
      TEmailThread.Create(AFileName, host, pass, user);
    end;
    
    end.