Quick.SMTP.pas 6.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238
  1. { ***************************************************************************
  2. Copyright (c) 2016-2017 Kike Pérez
  3. Unit : Quick.SMTP
  4. Description : Send Emails
  5. Author : Kike Pérez
  6. Version : 1.1
  7. Created : 12/10/2017
  8. Modified : 11/11/2017
  9. This file is part of QuickLib: https://github.com/exilon/QuickLib
  10. ***************************************************************************
  11. Licensed under the Apache License, Version 2.0 (the "License");
  12. you may not use this file except in compliance with the License.
  13. You may obtain a copy of the License at
  14. http://www.apache.org/licenses/LICENSE-2.0
  15. Unless required by applicable law or agreed to in writing, software
  16. distributed under the License is distributed on an "AS IS" BASIS,
  17. WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  18. See the License for the specific language governing permissions and
  19. limitations under the License.
  20. *************************************************************************** }
  21. unit Quick.SMTP;
  22. interface
  23. uses
  24. Classes,
  25. System.SysUtils,
  26. IdGlobal,
  27. IdSMTP,
  28. IdMessage,
  29. IdReplySMTP,
  30. IdSSLOpenSSL,
  31. IdText,
  32. IdAttachment,
  33. IdAttachmentFile,
  34. IdExplicitTLSClientServerBase,
  35. IdHTTP;
  36. type
  37. TMailMessage = class
  38. private
  39. fSenderName : string;
  40. fFrom : string;
  41. fRecipient : string;
  42. fSubject : string;
  43. fBody : string;
  44. fCC : string;
  45. fBCC : string;
  46. fBodyFromFile : Boolean;
  47. fAttachments : TStringList;
  48. procedure SetBody(aValue : string);
  49. public
  50. constructor Create;
  51. destructor Destroy; override;
  52. property SenderName : string read fSenderName write fSenderName;
  53. property From : string read fFrom write fFrom;
  54. property Recipient : string read fRecipient write fRecipient;
  55. property Subject : string read fSubject write fSubject;
  56. property Body : string read fBody write SetBody;
  57. property CC : string read fCC write fCC;
  58. property BCC : string read fBCC write fBCC;
  59. property Attachments : TStringList read fAttachments write fAttachments;
  60. procedure AddBodyFromFile(const cFileName : string);
  61. end;
  62. TSMTP = class(TIdSMTP)
  63. private
  64. fServerAuth : Boolean;
  65. fUseSSL : Boolean;
  66. fMail : TMailMessage;
  67. public
  68. constructor Create; overload;
  69. constructor Create(const cHost : string; cPort : Integer; cUseSSL : Boolean = False); overload;
  70. destructor Destroy; override;
  71. property ServerAuth : Boolean read fServerAuth write fServerAuth;
  72. property UseSSL: Boolean read fUseSSL write fUseSSL;
  73. property Mail : TMailMessage read fMail write fMail;
  74. function SendMail: Boolean; overload;
  75. function SendEmail(const cFrom,cSubject,cTo,cBody : string) : Boolean; overload;
  76. end;
  77. implementation
  78. { TMailMessage }
  79. constructor TMailMessage.Create;
  80. begin
  81. fCC := '';
  82. fBCC := '';
  83. fBody := '';
  84. fAttachments := TStringList.Create;
  85. end;
  86. destructor TMailMessage.Destroy;
  87. begin
  88. if Assigned(fAttachments) then fAttachments.Free;
  89. inherited;
  90. end;
  91. procedure TMailMessage.AddBodyFromFile(const cFileName: string);
  92. begin
  93. fBodyFromFile := True;
  94. fBody := cFileName;
  95. end;
  96. procedure TMailMessage.SetBody(aValue: string);
  97. begin
  98. fBodyFromFile := False;
  99. fBody := aValue;
  100. end;
  101. { TSMTP }
  102. constructor TSMTP.Create;
  103. begin
  104. inherited;
  105. fMail := TMailMessage.Create;
  106. Port := 25;
  107. UseTLS := TIdUseTLS.utNoTLSSupport;
  108. fUseSSL := False;
  109. end;
  110. constructor TSMTP.Create(const cHost : string; cPort : Integer; cUseSSL : Boolean = False);
  111. begin
  112. inherited Create;
  113. Host := cHost;
  114. Port := cPort;
  115. fUseSSL := cUseSSL;
  116. end;
  117. destructor TSMTP.Destroy;
  118. begin
  119. if Assigned(fMail) then fMail.Free;
  120. inherited;
  121. end;
  122. function TSMTP.SendEmail(const cFrom,cSubject,cTo,cBody : string) : Boolean;
  123. begin
  124. fMail.From := cFrom;
  125. fMail.Subject := cSubject;
  126. fMail.Body := cBody;
  127. fMail.Recipient := cTo;
  128. fMail.CC := '';
  129. fMail.BCC := '';
  130. Result := Self.SendMail;
  131. end;
  132. function TSMTP.SendMail: Boolean;
  133. var
  134. msg : TIdMessage;
  135. SSLHandler : TIdSSLIOHandlerSocketOpenSSL;
  136. email : string;
  137. filename : string;
  138. mBody : TIdText;
  139. begin
  140. Result := False;
  141. SSLHandler := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
  142. try
  143. msg := TIdMessage.Create(nil);
  144. try
  145. //create mail msg
  146. msg.From.Address := fMail.From;
  147. if fMail.SenderName <> '' then msg.From.Name := fMail.SenderName;
  148. msg.Subject := fMail.Subject;
  149. for email in fMail.Recipient.Split([',']) do msg.Recipients.Add.Address := email;
  150. for email in fMail.CC.Split([',']) do msg.CCList.Add.Address := email;
  151. for email in fMail.BCC.Split([',']) do msg.BCCList.Add.Address := email;
  152. if fMail.fBodyFromFile then
  153. begin
  154. msg.Body.LoadFromFile(fMail.Body);
  155. end
  156. else
  157. begin
  158. mBody := TIdText.Create(msg.MessageParts);
  159. mBody.ContentType := 'text/html';
  160. mBody.Body.Add(fMail.Body);
  161. end;
  162. //add attachements if exists
  163. if fMail.Attachments.Count > 0 then
  164. begin
  165. for filename in fMail.Attachments do
  166. begin
  167. TIdAttachmentFile.Create(msg.MessageParts,filename);
  168. end;
  169. end;
  170. //configure smtp SSL
  171. try
  172. if fUseSSL then
  173. begin
  174. Self.IOHandler := SSLHandler;
  175. SSLHandler.MaxLineAction := maException;
  176. SSLHandler.SSLOptions.Method := sslvTLSv1_2;
  177. SSLHandler.SSLOptions.Mode := sslmUnassigned;
  178. SSLHandler.SSLOptions.VerifyMode := [];
  179. SSLHandler.SSLOptions.VerifyDepth := 0;
  180. //Self.UseTLS := utUseExplicitTLS;
  181. end;
  182. //server auth
  183. if ServerAuth then Self.AuthType := TIdSMTPAuthenticationType.satDefault;
  184. Self.Port := fPort;
  185. except
  186. on E : Exception do raise Exception.Create(Format('[%s] : %s',[Self.ClassName,e.Message]));
  187. end;
  188. //send email
  189. try
  190. Self.Connect;
  191. if Self.Connected then
  192. begin
  193. Self.Send(msg);
  194. Self.Disconnect(False);
  195. Result := True;
  196. end;
  197. except
  198. on E : Exception do raise Exception.Create(Format('[%s] : %s',[Self.ClassName,e.Message]));
  199. end;
  200. finally
  201. msg.Free;
  202. end;
  203. finally
  204. if Assigned(SSLHandler) then SSLHandler.Free;
  205. end;
  206. end;
  207. end.