TSendMailThread = class(TThread)
private:
FromUser: string;
tslFileNames: TStringList;
SMTP1: TNMSMTP;
procedure Send;
protected
procedure Execute;override;
public
constructor Create( theFromUser:string;
theTslFileNames:TStringList);
destructor Destroy; override;
end;
constructor TSendMailThread.Create( theFromUser:string;
theTslFileNames:TStringList);
begin
inherited Create(true);
FromUser := theFromUser;
tslFileNames := TStringList.Create;
for i := 0 to theTslFileNames.Count - 1 do
if FileExists(theTslFileNames.Strings) then
tslFileNames.Add(theTslFileNames.Strings);
SMTP1 := TNMSMTP.Create(Application);
FreeOnTerminate := true;
end;
destructor TSendMailThread.Destroy;
begin
if (SMTP1.Connected) then
try
SMTP1.Abort;
SMTP1.Disconnect;
Application.ProcessMessages;
except
end;
SMTP1.Free;
inherited Destroy;
end;
procedure TSendMailThread.Send;
var
i,j: integer;
FileName,Buffer, FirstFileName : String;
F : TextFile;
SendCount,TotalCount:integer;
bError:boolean;
begin
SMTP1.Host := RegIniFile.ReadString('User/'+FromUser, 'SmtpServer' , '');
SMTP1.UserID := RegIniFile.ReadString('User/'+FromUser, 'POP3Account', '');
SMTP1.Port := RegIniFile.ReadInteger('User/'+FromUser, 'SmtpPort', 25);
SMTP1.TimeOut := RegIniFile.ReadInteger('Options', 'TimeOut', 60)*1000;
try
SMTP1.Connect;//如果第一个进程跟第二个进程的SMTP Server不一样,
//第二个进程就会停在这里不动,直到第一个进程结束。
except
if(SMTP1.Connected) then
try
SMTP1.Abort;
SMTP1.DisConnect;
Application.ProcessMessages;
except
end;
ShowMessage('错误:连接到SMTP服务器'+SMTP1.Host+'出错!');
exit;
end;
......
后面就是根据tslFilenames读取信件,发送信件,都正常
end;
procedure TSendMailThread.Execute;
begin
if(tslFileNames.Text <> '') then Synchronize(Send);
end;
下面是调用:根据不同的CurrentUserName,决定不同的发送文件列表(List),
调用进程:
try
with TSendMailThread.Create(CurrentUserName,List) do
begin
OnTerminate := nil;
Resume;
end;
except
on E: Exception do ShowMessage(E.Message);
end;
如果CurrentUserName一个为sqh一个为DreamTiger,而且两个用户的SMTP不一样,
从程序可以看到,进程中的SMTP1.Host就不一样,这时候就会出现上面说的情况,
进程2会等待进程1结束后再继续运行。如果进程1时间很长,可能导致进程2超时出错。