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.
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.