Envoyer des emails avec Indy via un fil séparé

Question

J'ai déjà posé des questions sur l'envoi d'emails avec des pièces jointes avec Indy via GMail et je suis heureux de dire que le code de base fonctionne correctement. J'ai remarqué, cependant, que l'envoi de pièces jointes prend quelques minutes et dans ce temps, le programme se fige (même si j'ai ajouté un composant TIdAntiFreeze au programme). J'ai pensé que ce serait une bonne idée de faire envoyer l'email par un thread séparé, permettant ainsi au programme d'être réactif.

J'ai été incapable de trouver du code sur le web qui montre comment envoyer des emails depuis un thread et j'ai donc dû écrire mon propre code qui ne fonctionne que partiellement. J'ai supprimé le composant SMTP du formulaire qui envoie le courrier électronique;

à la place, je sauvegarde les données du composant de messagerie sur le disque (avec la méthode TIdMessage.SaveToFile), puis crée une boîte de dialogue non modale, qui crée un thread qui instancie les composants nécessaires et envoie le courrier électronique. Je voudrais créer des gestionnaires d'événements pour les composants SMTP et IdMessage mais je ne sais pas comment faire cela au moment de l'exécution - le code thread ne peut accéder à aucune méthode de formulaire. Bien que je montre mon code, je préférerais voir quelque chose qui fonctionne correctement.

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. 

Answer 1

Utilisez plutôt la classe TThread de la fonction CreateThread(), vous pouvez utiliser des méthodes de la classe comme gestionnaires d'événements, par exemple:

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.