Форум на Исходниках.RU

uses ..., MAPI;

// отправка письма с вложением

// =============================================================================

function SendEMail(Handle: THandle; Mail: TStrings): Cardinal;

type

TAttachAccessArray = array [0..0] of TMapiFileDesc;

PAttachAccessArray = ^TAttachAccessArray;

var

MapiMessage: TMapiMessage;

Receip: TMapiRecipDesc;

Attachments: PAttachAccessArray;

AttachCount: Integer;

i1: integer;

FileName: string;

dwRet: Cardinal;

MAPI_Session: Cardinal;

WndList: Pointer;

begin

Result := 0;

dwRet := MapiLogon(Application.Handle,

nil,

MAPI_NEW_SESSION + MAPI_LOGON_UI,

0, @MAPI_Session);

if (dwRet <> SUCCESS_SUCCESS) then

begin

MessageBox(Handle,

PChar('Error while trying to send email'),

PChar('Error'),

MB_ICONERROR or MB_OK);

end

else

begin

FillChar(MapiMessage, SizeOf(MapiMessage), #0);

Attachments := nil;

FillChar(Receip, SizeOf(Receip), #0);

if Mail.Values['to'] <> '' then

begin

Receip.ulReserved := 0;

Receip.ulRecipClass := MAPI_TO;

Receip.lpszName := StrNew(PChar(Mail.Values['to']));

Receip.lpszAddress := StrNew(PChar('SMTP:' + Mail.Values['to']));

Receip.ulEIDSize := 0;

MapiMessage.nRecipCount := 1;

MapiMessage.lpRecips := @Receip;

end;

AttachCount := 0;

for i1 := 0 to MaxInt do

begin

if Mail.Values['attachment' + IntToStr(i1)] = '' then

break;

Inc(AttachCount);

end;

if AttachCount > 0 then

begin

GetMem(Attachments, SizeOf(TMapiFileDesc) * AttachCount);

for i1 := 0 to AttachCount - 1 do

begin

FileName := Mail.Values['attachment' + IntToStr(i1)];

Attachments[i1].ulReserved := 0;

Attachments[i1].flFlags := 0;

Attachments[i1].nPosition := ULONG($FFFFFFFF);

Attachments[i1].lpszPathName := StrNew(PChar(FileName));

Attachments[i1].lpszFileName :=

StrNew(PChar(ExtractFileName(FileName)));

Attachments[i1].lpFileType := nil;

end;

MapiMessage.nFileCount := AttachCount;

MapiMessage.lpFiles := @Attachments^;

end;

if Mail.Values['subject'] <> '' then

MapiMessage.lpszSubject := StrNew(PChar(Mail.Values['subject']));

if Mail.Values['body'] <> '' then

MapiMessage.lpszNoteText := StrNew(PChar(Mail.Values['body']));

WndList := DisableTaskWindows(0);

try

Result := MapiSendMail(MAPI_Session, Handle,

MapiMessage, MAPI_DIALOG, 0);

finally

EnableTaskWindows( WndList );

end;

for i1 := 0 to AttachCount - 1 do

begin

StrDispose(Attachments[i1].lpszPathName);

StrDispose(Attachments[i1].lpszFileName);

end;

if Assigned(MapiMessage.lpszSubject) then

StrDispose(MapiMessage.lpszSubject);

if Assigned(MapiMessage.lpszNoteText) then

StrDispose(MapiMessage.lpszNoteText);

if Assigned(Receip.lpszAddress) then

StrDispose(Receip.lpszAddress);

if Assigned(Receip.lpszName) then

StrDispose(Receip.lpszName);

MapiLogOff(MAPI_Session, Handle, 0, 0);

end;