Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- function SendEMail(Handle: THandle; Mail: TStrings): Cardinal;
- type
- TAttachAccessArray = array [0..0] of TMapiFileDesc;
- PAttachAccessArray = ^TAttachAccessArray;
- var
- MapiMessage: TMapiMessage;
- Receip, ComCopia: TMapiRecipDesc;
- Attachments: PAttachAccessArray;
- AttachCount: Integer;
- i1: integer;
- FileName: string;
- dwRet: Cardinal;
- MAPI_Session: Cardinal;
- WndList: Pointer;
- aRecep: Array of TMapiRecipDesc;
- iRecipC, iCont: Integer;
- sAuxCCo, sCCo, sTO: String;
- begin
- dwRet := MapiLogon(Handle, PAnsiChar(''), PAnsiChar(''), MAPI_LOGON_UI or MAPI_NEW_SESSION, 0, @MAPI_Session);
- if (dwRet <> SUCCESS_SUCCESS) then
- begin
- MessageBox(Handle, PChar('Error while trying to send email'#10+SysErrorMessage(GetLastError)), PChar('Error'), MB_ICONERROR or MB_OK);
- end
- else
- begin
- AttachCount := 0;
- Attachments := nil;
- try
- FillChar(MapiMessage, SizeOf(MapiMessage), #0);
- FillChar(Receip, SizeOf(Receip), #0);
- FillChar(ComCopia, SizeOf(ComCopia), #0);
- iRecipC := 0;
- if Mail.Values['to'] <> '' then
- begin
- sAuxCCo := Mail.Values['to'];
- if (sAuxCCo[Length(sAuxCCo)] <> ';') then
- sAuxCCo := sAuxCCo + ';';
- while (Pos(';',sAuxCCo)) > 0 do
- begin
- sTO := sTO + Copy(sAuxCCo,1,Pos(';',sAuxCCo));
- Delete(sAuxCCo,1,Pos(';',sAuxCCo));
- Inc(iRecipC);
- end;
- end;
- if Mail.Values['CCo'] <> '' then
- begin
- sAuxCCo := Mail.Values['CCo'];
- if (sAuxCCo[Length(sAuxCCo)] <> ';') then
- sAuxCCo := sAuxCCo + ';';
- while (Pos(';',sAuxCCo)) > 0 do
- begin
- sCCo := sCCo + Copy(sAuxCCo,1,Pos(';',sAuxCCo));
- Delete(sAuxCCo,1,Pos(';',sAuxCCo));
- Inc(iRecipC);
- end;
- end;
- SetLength(aRecep, iRecipC);
- iCont := 0;
- if sTO <> '' then
- begin
- while ((sTO) <> '') do
- begin
- sAuxCCo := Copy(sTO,1,Pos(';',sTO)- 1);
- aRecep[iCont].ulReserved := 0;
- aRecep[iCont].ulRecipClass := MAPI_TO;
- aRecep[iCont].lpszName := StrNew(PAnsiChar(AnsiString(sAuxCCo)));
- aRecep[iCont].lpszAddress := StrNew(PAnsiChar(AnsiString('SMTP:' + sAuxCCo)));
- aRecep[iCont].ulEIDSize := 0;
- Delete(sTO,1,Pos(';',sTO));
- Inc(iCont);
- end;
- end;
- if sCCo <> '' then
- begin
- while ((sCCo) <> '') do
- begin
- sAuxCCo := Copy(sCCo,1,Pos(';',sCCo)- 1);
- aRecep[iCont].ulReserved := 0;
- aRecep[iCont].ulRecipClass := MAPI_BCC;
- aRecep[iCont].lpszName := StrNew(PAnsiChar(AnsiString(sAuxCCo)));
- aRecep[iCont].lpszAddress := StrNew(PAnsiChar(AnsiString('SMTP:' + sAuxCCo)));
- aRecep[iCont].ulEIDSize := 0;
- Delete(sCCo,1,Pos(';',sCCo));
- Inc(iCont);
- end;
- 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(PAnsiChar(AnsiString(FileName)));
- Attachments[i1].lpszFileName := StrNew(PAnsiChar(AnsiString(ExtractFileName(FileName))));
- Attachments[i1].lpFileType := nil;
- end;
- end;
- with MapiMessage do
- begin
- ulReserved := 0;
- lpszSubject := StrNew(PAnsiChar(AnsiString(Mail.Values['subject'])));
- lpszNoteText := StrNew(PAnsiChar(AnsiString(Mail.Values['body'])));
- lpszMessageType := Nil;
- lpszDateReceived := Nil;
- lpszConversationID := Nil;
- flFlags := 0;
- lpOriginator := Nil;
- nRecipCount := iRecipC;
- lpRecips := @aRecep[0];
- nFileCount := AttachCount;
- lpFiles := @Attachments[0];
- end;
- WndList := DisableTaskWindows(0);
- try
- Result := MapiSendMail(MAPI_Session, Handle, MapiMessage, MAPI_DIALOG, 0);
- finally
- EnableTaskWindows( WndList );
- end;
- finally
- 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;
- end;
- end;
- MessageBox(Handle, PChar('Error while trying to send email'#10+SysErrorMessage(GetLastError)), PChar('Error'), MB_ICONERROR or MB_OK);
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement