Advertisement
Guest User

Untitled

a guest
Dec 8th, 2016
74
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 5.11 KB | None | 0 0
  1. function SendEMail(Handle: THandle; Mail: TStrings): Cardinal;
  2. type
  3. TAttachAccessArray = array [0..0] of TMapiFileDesc;
  4. PAttachAccessArray = ^TAttachAccessArray;
  5. var
  6. MapiMessage: TMapiMessage;
  7. Receip, ComCopia: TMapiRecipDesc;
  8. Attachments: PAttachAccessArray;
  9. AttachCount: Integer;
  10. i1: integer;
  11. FileName: string;
  12. dwRet: Cardinal;
  13. MAPI_Session: Cardinal;
  14. WndList: Pointer;
  15.  
  16. aRecep: Array of TMapiRecipDesc;
  17. iRecipC, iCont: Integer;
  18. sAuxCCo, sCCo, sTO: String;
  19. begin
  20. dwRet := MapiLogon(Handle, PAnsiChar(''), PAnsiChar(''), MAPI_LOGON_UI or MAPI_NEW_SESSION, 0, @MAPI_Session);
  21. if (dwRet <> SUCCESS_SUCCESS) then
  22. begin
  23. MessageBox(Handle, PChar('Error while trying to send email'#10+SysErrorMessage(GetLastError)), PChar('Error'), MB_ICONERROR or MB_OK);
  24. end
  25. else
  26. begin
  27. AttachCount := 0;
  28. Attachments := nil;
  29. try
  30. FillChar(MapiMessage, SizeOf(MapiMessage), #0);
  31. FillChar(Receip, SizeOf(Receip), #0);
  32. FillChar(ComCopia, SizeOf(ComCopia), #0);
  33.  
  34. iRecipC := 0;
  35. if Mail.Values['to'] <> '' then
  36. begin
  37. sAuxCCo := Mail.Values['to'];
  38. if (sAuxCCo[Length(sAuxCCo)] <> ';') then
  39. sAuxCCo := sAuxCCo + ';';
  40. while (Pos(';',sAuxCCo)) > 0 do
  41. begin
  42. sTO := sTO + Copy(sAuxCCo,1,Pos(';',sAuxCCo));
  43. Delete(sAuxCCo,1,Pos(';',sAuxCCo));
  44. Inc(iRecipC);
  45. end;
  46. end;
  47.  
  48. if Mail.Values['CCo'] <> '' then
  49. begin
  50. sAuxCCo := Mail.Values['CCo'];
  51. if (sAuxCCo[Length(sAuxCCo)] <> ';') then
  52. sAuxCCo := sAuxCCo + ';';
  53. while (Pos(';',sAuxCCo)) > 0 do
  54. begin
  55. sCCo := sCCo + Copy(sAuxCCo,1,Pos(';',sAuxCCo));
  56. Delete(sAuxCCo,1,Pos(';',sAuxCCo));
  57. Inc(iRecipC);
  58. end;
  59. end;
  60.  
  61. SetLength(aRecep, iRecipC);
  62.  
  63. iCont := 0;
  64. if sTO <> '' then
  65. begin
  66. while ((sTO) <> '') do
  67. begin
  68. sAuxCCo := Copy(sTO,1,Pos(';',sTO)- 1);
  69.  
  70. aRecep[iCont].ulReserved := 0;
  71. aRecep[iCont].ulRecipClass := MAPI_TO;
  72. aRecep[iCont].lpszName := StrNew(PAnsiChar(AnsiString(sAuxCCo)));
  73. aRecep[iCont].lpszAddress := StrNew(PAnsiChar(AnsiString('SMTP:' + sAuxCCo)));
  74. aRecep[iCont].ulEIDSize := 0;
  75.  
  76. Delete(sTO,1,Pos(';',sTO));
  77. Inc(iCont);
  78. end;
  79. end;
  80.  
  81. if sCCo <> '' then
  82. begin
  83. while ((sCCo) <> '') do
  84. begin
  85. sAuxCCo := Copy(sCCo,1,Pos(';',sCCo)- 1);
  86.  
  87. aRecep[iCont].ulReserved := 0;
  88. aRecep[iCont].ulRecipClass := MAPI_BCC;
  89. aRecep[iCont].lpszName := StrNew(PAnsiChar(AnsiString(sAuxCCo)));
  90. aRecep[iCont].lpszAddress := StrNew(PAnsiChar(AnsiString('SMTP:' + sAuxCCo)));
  91. aRecep[iCont].ulEIDSize := 0;
  92.  
  93. Delete(sCCo,1,Pos(';',sCCo));
  94. Inc(iCont);
  95. end;
  96. end;
  97.  
  98. AttachCount := 0;
  99.  
  100. for i1 := 0 to MaxInt do
  101. begin
  102. if Mail.Values['attachment' + IntToStr(i1)] = '' then
  103. break;
  104. Inc(AttachCount);
  105. end;
  106.  
  107. if AttachCount > 0 then
  108. begin
  109. GetMem(Attachments, SizeOf(TMapiFileDesc) * AttachCount);
  110.  
  111. for i1 := 0 to AttachCount - 1 do
  112. begin
  113. FileName := Mail.Values['attachment' + IntToStr(i1)];
  114. Attachments[i1].ulReserved := 0;
  115. Attachments[i1].flFlags := 0;
  116. Attachments[i1].nPosition := ULONG($FFFFFFFF);
  117. Attachments[i1].lpszPathName := StrNew(PAnsiChar(AnsiString(FileName)));
  118. Attachments[i1].lpszFileName := StrNew(PAnsiChar(AnsiString(ExtractFileName(FileName))));
  119. Attachments[i1].lpFileType := nil;
  120. end;
  121. end;
  122.  
  123. with MapiMessage do
  124. begin
  125. ulReserved := 0;
  126. lpszSubject := StrNew(PAnsiChar(AnsiString(Mail.Values['subject'])));
  127. lpszNoteText := StrNew(PAnsiChar(AnsiString(Mail.Values['body'])));
  128. lpszMessageType := Nil;
  129. lpszDateReceived := Nil;
  130. lpszConversationID := Nil;
  131. flFlags := 0;
  132. lpOriginator := Nil;
  133. nRecipCount := iRecipC;
  134. lpRecips := @aRecep[0];
  135. nFileCount := AttachCount;
  136. lpFiles := @Attachments[0];
  137. end;
  138.  
  139. WndList := DisableTaskWindows(0);
  140. try
  141. Result := MapiSendMail(MAPI_Session, Handle, MapiMessage, MAPI_DIALOG, 0);
  142. finally
  143. EnableTaskWindows( WndList );
  144. end;
  145. finally
  146. for i1 := 0 to AttachCount - 1 do
  147. begin
  148. StrDispose(Attachments[i1].lpszPathName);
  149. StrDispose(Attachments[i1].lpszFileName);
  150. end;
  151.  
  152. if Assigned(MapiMessage.lpszSubject) then
  153. StrDispose(MapiMessage.lpszSubject);
  154. if Assigned(MapiMessage.lpszNoteText) then
  155. StrDispose(MapiMessage.lpszNoteText);
  156. if Assigned(Receip.lpszAddress) then
  157. StrDispose(Receip.lpszAddress);
  158. if Assigned(Receip.lpszName) then
  159. StrDispose(Receip.lpszName);
  160.  
  161. MapiLogOff(MAPI_Session, Handle, 0, 0);
  162. end;
  163. end;
  164. end;
  165.  
  166. 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