Question

我之前已经询问过有关通过GMail发送附带Indy附件的电子邮件的问题，我很高兴地说基本代码可以正常运行。但是，我注意到发送附件需要几分钟，在那段时间内，程序会冻结（即使我在程序中添加了TIdAntiFreeze组件）。我认为通过单独的线程发送电子邮件是个好主意，从而使程序能够响应。

我一直无法在网上找到显示如何从线程发送电子邮件的代码，所以我必须编写自己的代码才能部分工作。

我从发送电子邮件的表单中删除了SMTP组件;相反，我将电子邮件组件的数据保存到磁盘（使用TIdMessage.SaveToFile方法），然后创建一个非模态对话框，该对话框创建一个实例化所需组件并发送电子邮件的线程。我想为SMTP和IdMessage组件创建事件处理程序，但不知道如何在运行时执行此操作 - 线程代码无法访问任何表单方法。

虽然我正在展示我的代码，但我希望看到一些正常运行的东西。

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

使用TThread类而不是CreateThread()函数，然后您可以使用该类的方法作为事件处理程序，例如：

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.

通过单独的线程与Indy发送电子邮件

1 个答案: