0

我之前问过关于通过 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.
4

1 回答 1

2

使用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.
于 2013-03-18T00:29:28.180 回答