Небольшой код, отсылает в потоке, использует Indy.
| Код |
unit EMailThread;
interface
uses
{VCL} Windows, Messages, SysUtils, Classes,
{Indy} IdMessage, IdEMailAddress, IdAttachment, IdAttachmentMemory, IdText,
IdCoderHeader, IdCharsets, IdSMTP, IdSMTPRelay;
const
WM_EMAILSENDSUCCESS = WM_USER + $1000;
WM_EMAILSENDERROR = WM_USER + $1001;
WM_EMAILTHREADDESTROY = WM_USER + $1002;
type
TEMailThread = class(TThread)
private
FMessage: TIdMessage;
FError: string;
FMailAgent: string;
FServers: TStringList;
FHandle: HWnd;
protected
function SendMail: Boolean;
procedure IdMessageInitializeISO(var VTransferHeader: TTransfer;
var VHeaderEncoding: Char; var VCharSet: String);
public
constructor Create(AHandle: Hwnd; AFromMail, AFromName, AFromOrganization: string;
ASubject: string; ACharset: TIdCharSet; ABody: TStrings; ARecipMail,
ARecipName: string; ACCMail, ACCName: TStrings; AIsAttach: boolean;
AAttachFile: string; AAttachStream: TMemoryStream);
destructor Destroy; override;
procedure Execute; override;
end;
implementation
uses
{ATD Base API} TestVersion;
function GetDNSList: TStringList;
type
PIP_Addr = ^TIP_Addr;
TIP_Addr = packed record
Next: PIP_Addr;
IpAddress: array[0..15] of char;
Unused: array[0..19] of byte; // Unused bytes.
end;
PDNSInfo = ^TDNSInfo;
TDNSInfo = packed record
Unused0: array[0..267] of byte; // Unused bytes.
DNSList: TIP_Addr;
Unused1: array[0..275] of byte; // Unused bytes.
end;
var
IpHlpModule: THandle;
DNSInfo: PDNSInfo;
Size: DWord;
PDNS: PIP_Addr;
err: Integer;
GetNetworkParams: function(Info: PDNSInfo; pLen: PDWord): DWord; stdcall;
function IsValidDNS(const IP: string): Boolean;
begin
Result := (Trim(IP) <> '0.0.0.0') and (Trim(IP) <> '');
end;
procedure AddDNS(const IP: string);
begin
if (IsValidDNS(IP)) then Result.Add(IP);
end;
begin
Result := TStringList.Create;
Size := 0;
IpHlpModule := LoadLibrary('IPHLPAPI.DLL');
if (IpHlpModule <> 0) then
try
GetNetworkParams := GetProcAddress(IpHlpModule, 'GetNetworkParams');
if (@GetNetworkParams <> nil) then
begin
err := GetNetworkParams(nil, @Size);
if (err = ERROR_BUFFER_OVERFLOW) then
begin
GetMem(DNSInfo, Size);
try
err := GetNetworkParams(DNSInfo, @Size);
if (err = ERROR_SUCCESS) then
with DNSInfo^ do
begin
AddDNS(DNSList.IpAddress);
PDNS := DNSList.Next;
while PDNS <> nil do
begin
AddDNS(PDNS^.IPAddress);
PDNS := PDNS.Next;
end;
end;
finally
FreeMem(DNSInfo);
end;
end;
end;
finally
FreeLibrary(IpHlpModule);
end;
if Result.Count = 0 then AddDNS('193.121.171.135'); // An alternative DNS server.
end;
{ TEMailThread }
constructor TEMailThread.Create(AHandle: HWnd; AFromMail, AFromName,
AFromOrganization: string; ASubject: string; ACharset: TIdCharSet; ABody: TStrings;
ARecipMail, ARecipName: string; ACCMail, ACCName: TStrings; AIsAttach: boolean;
AAttachFile: string; AAttachStream: TMemoryStream);
var
I: integer;
FMail: TIdEMailAddressItem;
FAttach: TIdAttachmentMemory;
FText: TIdText;
begin
inherited Create(false);
FreeOnTerminate := true;
FHandle := AHandle;
FError := '';
FMailAgent := sATS + ' (version ' + GetATSVerShort + ')';
FMessage := TIdMessage.Create(nil);
FMessage.OnInitializeISO := IdMessageInitializeISO;
FMessage.Encoding := meMIME;
FMessage.CharSet := IdCharsetNames[ACharset];
FMessage.ContentTransferEncoding := 'base64';
FMessage.From.Address := AFromMail;
FMessage.From.Name := AFromName;
FMessage.Sender.Address := AFromMail;
FMessage.Sender.Name := AFromName;
with FMessage.ReplyTo.Add do
begin
Address := AFromMail;
Name := AFromName;
end;
FMessage.Organization := AFromOrganization;
FMessage.Subject := ASubject;
FMessage.Priority := mpNormal;
with FMessage.Recipients.Add do
begin
Address := ARecipMail;
Name := ARecipName;
end;
if Assigned(ACCMail) and Assigned(ACCName) and (ACCMail.Count = ACCName.Count) then
for I := 0 to ACCMail.Count - 1 do
with FMessage.CCList.Add do
begin
Address := ACCMail.Strings[I];
Name := ACCName.Strings[I];
end;
if AIsAttach then
begin
FText := TIdText.Create(FMessage.MessageParts, ABody);
FText.CharSet := IdCharsetNames[ACharset];
FText.ContentTransfer := 'base64';
AAttachStream.Position := 0;
FAttach := TIdAttachmentMemory.Create(FMessage.MessageParts, AAttachStream);
FAttach.FileName := AAttachFile;
end
else
FMessage.Body.AddStrings(ABody);
end;
procedure TEMailThread.IdMessageInitializeISO(var VTransferHeader: TTransfer;
var VHeaderEncoding: Char; var VCharSet: String);
begin
VCharset := FMessage.CharSet;
end;
destructor TEMailThread.Destroy;
begin
PostMessage(FHandle, WM_EMAILTHREADDESTROY, 0, 0);
FMessage.Free;
inherited Destroy;
end;
procedure TEMailThread.Execute;
var
I: integer;
begin
FServers := GetDNSList;
try
if SendMail then
PostMessage(FHandle, WM_EMAILSENDSUCCESS, 0, 0)
else
SendMessage(FHandle, WM_EMAILSENDERROR, integer(PChar(FError)), 0);
finally
FServers.Free;
end;
end;
function TEMailThread.SendMail: Boolean;
var
Sender: TIdSMTPRelay;
I, J: integer;
begin
Result := false;
Sender := TIdSMTPRelay.Create;
try
with Sender do
begin
for I := 0 to FServers.Count - 1 do
begin
DNSServer := FServers.Strings[I];
MailAgent := FMailAgent;
try
Connect;
Send(FMessage);
Disconnect;
FError := '';
Result := true;
for J := 0 to Sender.StatusList.Count - 1 do
begin
Result := Result and Sender.StatusList.Items[J].Sent;
if not Result then
begin
FError := Sender.StatusList.Items[J].ExceptionMessage;
Break;
end;
end;
if Result then Exit;
except
on E : Exception do
begin
if Connected then
try
Disconnect;
except
end;
Result := false;
FError := E.Message;
end;
end;
end;
end;
finally
Sender.Free;
end;
end;
end.
|
|
