smtpsend.pas 23 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707
  1. {==============================================================================|
  2. | Project : Ararat Synapse | 003.004.003 |
  3. |==============================================================================|
  4. | Content: SMTP client |
  5. |==============================================================================|
  6. | Copyright (c)1999-2007, Lukas Gebauer |
  7. | All rights reserved. |
  8. | |
  9. | Redistribution and use in source and binary forms, with or without |
  10. | modification, are permitted provided that the following conditions are met: |
  11. | |
  12. | Redistributions of source code must retain the above copyright notice, this |
  13. | list of conditions and the following disclaimer. |
  14. | |
  15. | Redistributions in binary form must reproduce the above copyright notice, |
  16. | this list of conditions and the following disclaimer in the documentation |
  17. | and/or other materials provided with the distribution. |
  18. | |
  19. | Neither the name of Lukas Gebauer nor the names of its contributors may |
  20. | be used to endorse or promote products derived from this software without |
  21. | specific prior written permission. |
  22. | |
  23. | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
  24. | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
  25. | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
  26. | ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
  27. | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
  28. | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
  29. | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
  30. | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
  31. | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
  32. | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
  33. | DAMAGE. |
  34. |==============================================================================|
  35. | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
  36. | Portions created by Lukas Gebauer are Copyright (c) 1999-2007. |
  37. | All Rights Reserved. |
  38. |==============================================================================|
  39. | Contributor(s): |
  40. |==============================================================================|
  41. | History: see HISTORY.HTM from distribution package |
  42. | (Found at URL: http://www.ararat.cz/synapse/) |
  43. |==============================================================================}
  44. {:@abstract(SMTP client)
  45. Used RFC: RFC-1869, RFC-1870, RFC-1893, RFC-2034, RFC-2104, RFC-2195, RFC-2487,
  46. RFC-2554, RFC-2821
  47. }
  48. {$IFDEF FPC}
  49. {$MODE DELPHI}
  50. {$ENDIF}
  51. {$H+}
  52. unit smtpsend;
  53. interface
  54. uses
  55. SysUtils, Classes,
  56. blcksock, synautil, synacode;
  57. const
  58. cSmtpProtocol = '25';
  59. type
  60. {:@abstract(Implementation of SMTP and ESMTP procotol),
  61. include some ESMTP extensions, include SSL/TLS too.
  62. Note: Are you missing properties for setting Username and Password for ESMTP?
  63. Look to parent @link(TSynaClient) object!
  64. Are you missing properties for specify server address and port? Look to
  65. parent @link(TSynaClient) too!}
  66. TSMTPSend = class(TSynaClient)
  67. private
  68. FSock: TTCPBlockSocket;
  69. FResultCode: Integer;
  70. FResultString: string;
  71. FFullResult: TStringList;
  72. FESMTPcap: TStringList;
  73. FESMTP: Boolean;
  74. FAuthDone: Boolean;
  75. FESMTPSize: Boolean;
  76. FMaxSize: Integer;
  77. FEnhCode1: Integer;
  78. FEnhCode2: Integer;
  79. FEnhCode3: Integer;
  80. FSystemName: string;
  81. FAutoTLS: Boolean;
  82. FFullSSL: Boolean;
  83. procedure EnhancedCode(const Value: string);
  84. function ReadResult: Integer;
  85. function AuthLogin: Boolean;
  86. function AuthCram: Boolean;
  87. function Helo: Boolean;
  88. function Ehlo: Boolean;
  89. function Connect: Boolean;
  90. public
  91. constructor Create;
  92. destructor Destroy; override;
  93. {:Connects to SMTP server (defined in @link(TSynaClient.TargetHost)) and
  94. begin SMTP session. (First try ESMTP EHLO, next old HELO handshake). Parses
  95. ESMTP capabilites and if you specified Username and password and remote
  96. server can handle AUTH command, try login by AUTH command. Preffered login
  97. method is CRAM-MD5 (if safer!). If all OK, result is @true, else result is
  98. @false.}
  99. function Login: Boolean;
  100. {:Close SMTP session (QUIT command) and disconnect from SMTP server.}
  101. function Logout: Boolean;
  102. {:Send RSET SMTP command for reset SMTP session. If all OK, result is @true,
  103. else result is @false.}
  104. function Reset: Boolean;
  105. {:Send NOOP SMTP command for keep SMTP session. If all OK, result is @true,
  106. else result is @false.}
  107. function NoOp: Boolean;
  108. {:Send MAIL FROM SMTP command for set sender e-mail address. If sender's
  109. e-mail address is empty string, transmited message is error message.
  110. If size not 0 and remote server can handle SIZE parameter, append SIZE
  111. parameter to request. If all OK, result is @true, else result is @false.}
  112. function MailFrom(const Value: string; Size: Integer): Boolean;
  113. {:Send RCPT TO SMTP command for set receiver e-mail address. It cannot be an
  114. empty string. If all OK, result is @true, else result is @false.}
  115. function MailTo(const Value: string): Boolean;
  116. {:Send DATA SMTP command and transmit message data. If all OK, result is
  117. @true, else result is @false.}
  118. function MailData(const Value: Tstrings): Boolean;
  119. {:Send ETRN SMTP command for start sending of remote queue for domain in
  120. Value. If all OK, result is @true, else result is @false.}
  121. function Etrn(const Value: string): Boolean;
  122. {:Send VRFY SMTP command for check receiver e-mail address. It cannot be
  123. an empty string. If all OK, result is @true, else result is @false.}
  124. function Verify(const Value: string): Boolean;
  125. {:Call STARTTLS command for upgrade connection to SSL/TLS mode.}
  126. function StartTLS: Boolean;
  127. {:Return string descriptive text for enhanced result codes stored in
  128. @link(EnhCode1), @link(EnhCode2) and @link(EnhCode3).}
  129. function EnhCodeString: string;
  130. {:Try to find specified capability in ESMTP response.}
  131. function FindCap(const Value: string): string;
  132. published
  133. {:result code of last SMTP command.}
  134. property ResultCode: Integer read FResultCode;
  135. {:result string of last SMTP command (begin with string representation of
  136. result code).}
  137. property ResultString: string read FResultString;
  138. {:All result strings of last SMTP command (result is maybe multiline!).}
  139. property FullResult: TStringList read FFullResult;
  140. {:List of ESMTP capabilites of remote ESMTP server. (If you connect to ESMTP
  141. server only!).}
  142. property ESMTPcap: TStringList read FESMTPcap;
  143. {:@TRUE if you successfuly logged to ESMTP server.}
  144. property ESMTP: Boolean read FESMTP;
  145. {:@TRUE if you successfuly pass authorisation to remote server.}
  146. property AuthDone: Boolean read FAuthDone;
  147. {:@TRUE if remote server can handle SIZE parameter.}
  148. property ESMTPSize: Boolean read FESMTPSize;
  149. {:When @link(ESMTPsize) is @TRUE, contains max length of message that remote
  150. server can handle.}
  151. property MaxSize: Integer read FMaxSize;
  152. {:First digit of Enhanced result code. If last operation does not have
  153. enhanced result code, values is 0.}
  154. property EnhCode1: Integer read FEnhCode1;
  155. {:Second digit of Enhanced result code. If last operation does not have
  156. enhanced result code, values is 0.}
  157. property EnhCode2: Integer read FEnhCode2;
  158. {:Third digit of Enhanced result code. If last operation does not have
  159. enhanced result code, values is 0.}
  160. property EnhCode3: Integer read FEnhCode3;
  161. {:name of our system used in HELO and EHLO command. Implicit value is
  162. internet address of your machine.}
  163. property SystemName: string read FSystemName Write FSystemName;
  164. {:If is set to true, then upgrade to SSL/TLS mode if remote server support it.}
  165. property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
  166. {:SSL/TLS mode is used from first contact to server. Servers with full
  167. SSL/TLS mode usualy using non-standard TCP port!}
  168. property FullSSL: Boolean read FFullSSL Write FFullSSL;
  169. {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
  170. property Sock: TTCPBlockSocket read FSock;
  171. end;
  172. {:A very useful function and example of its use would be found in the TSMTPsend
  173. object. Send maildata (text of e-mail with all SMTP headers! For example when
  174. text of message is created by @link(TMimemess) object) from "MailFrom" e-mail
  175. address to "MailTo" e-mail address (If you need more then one receiver, then
  176. separate their addresses by comma).
  177. Function sends e-mail to a SMTP server defined in "SMTPhost" parameter.
  178. Username and password are used for authorization to the "SMTPhost". If you
  179. don't want authorization, set "Username" and "Password" to empty strings. If
  180. e-mail message is successfully sent, the result returns @true.
  181. If you need use different port number then standard, then add this port number
  182. to SMTPhost after colon. (i.e. '127.0.0.1:1025')}
  183. function SendToRaw(const MailFrom, MailTo, SMTPHost: string;
  184. const MailData: TStrings; const Username, Password: string): Boolean;
  185. {:A very useful function and example of its use would be found in the TSMTPsend
  186. object. Send "Maildata" (text of e-mail without any SMTP headers!) from
  187. "MailFrom" e-mail address to "MailTo" e-mail address with "Subject". (If you
  188. need more then one receiver, then separate their addresses by comma).
  189. This function constructs all needed SMTP headers (with DATE header) and sends
  190. the e-mail to the SMTP server defined in the "SMTPhost" parameter. If the
  191. e-mail message is successfully sent, the result will be @TRUE.
  192. If you need use different port number then standard, then add this port number
  193. to SMTPhost after colon. (i.e. '127.0.0.1:1025')}
  194. function SendTo(const MailFrom, MailTo, Subject, SMTPHost: string;
  195. const MailData: TStrings): Boolean;
  196. {:A very useful function and example of its use would be found in the TSMTPsend
  197. object. Sends "MailData" (text of e-mail without any SMTP headers!) from
  198. "MailFrom" e-mail address to "MailTo" e-mail address (If you need more then one
  199. receiver, then separate their addresses by comma).
  200. This function sends the e-mail to the SMTP server defined in the "SMTPhost"
  201. parameter. Username and password are used for authorization to the "SMTPhost".
  202. If you dont want authorization, set "Username" and "Password" to empty Strings.
  203. If the e-mail message is successfully sent, the result will be @TRUE.
  204. If you need use different port number then standard, then add this port number
  205. to SMTPhost after colon. (i.e. '127.0.0.1:1025')}
  206. function SendToEx(const MailFrom, MailTo, Subject, SMTPHost: string;
  207. const MailData: TStrings; const Username, Password: string): Boolean;
  208. implementation
  209. constructor TSMTPSend.Create;
  210. begin
  211. inherited Create;
  212. FFullResult := TStringList.Create;
  213. FESMTPcap := TStringList.Create;
  214. FSock := TTCPBlockSocket.Create;
  215. FSock.ConvertLineEnd := true;
  216. FTimeout := 60000;
  217. FTargetPort := cSmtpProtocol;
  218. FSystemName := FSock.LocalName;
  219. FAutoTLS := False;
  220. FFullSSL := False;
  221. end;
  222. destructor TSMTPSend.Destroy;
  223. begin
  224. FSock.Free;
  225. FESMTPcap.Free;
  226. FFullResult.Free;
  227. inherited Destroy;
  228. end;
  229. procedure TSMTPSend.EnhancedCode(const Value: string);
  230. var
  231. s, t: string;
  232. e1, e2, e3: Integer;
  233. begin
  234. FEnhCode1 := 0;
  235. FEnhCode2 := 0;
  236. FEnhCode3 := 0;
  237. s := Copy(Value, 5, Length(Value) - 4);
  238. t := Trim(SeparateLeft(s, '.'));
  239. s := Trim(SeparateRight(s, '.'));
  240. if t = '' then
  241. Exit;
  242. if Length(t) > 1 then
  243. Exit;
  244. e1 := StrToIntDef(t, 0);
  245. if e1 = 0 then
  246. Exit;
  247. t := Trim(SeparateLeft(s, '.'));
  248. s := Trim(SeparateRight(s, '.'));
  249. if t = '' then
  250. Exit;
  251. if Length(t) > 3 then
  252. Exit;
  253. e2 := StrToIntDef(t, 0);
  254. t := Trim(SeparateLeft(s, ' '));
  255. if t = '' then
  256. Exit;
  257. if Length(t) > 3 then
  258. Exit;
  259. e3 := StrToIntDef(t, 0);
  260. FEnhCode1 := e1;
  261. FEnhCode2 := e2;
  262. FEnhCode3 := e3;
  263. end;
  264. function TSMTPSend.ReadResult: Integer;
  265. var
  266. s: string;
  267. begin
  268. Result := 0;
  269. FFullResult.Clear;
  270. repeat
  271. s := FSock.RecvString(FTimeout);
  272. FResultString := s;
  273. FFullResult.Add(s);
  274. if FSock.LastError <> 0 then
  275. Break;
  276. until Pos('-', s) <> 4;
  277. s := FFullResult[0];
  278. if Length(s) >= 3 then
  279. Result := StrToIntDef(Copy(s, 1, 3), 0);
  280. FResultCode := Result;
  281. EnhancedCode(s);
  282. end;
  283. function TSMTPSend.AuthLogin: Boolean;
  284. begin
  285. Result := False;
  286. FSock.SendString('AUTH LOGIN' + CRLF);
  287. if ReadResult <> 334 then
  288. Exit;
  289. FSock.SendString(EncodeBase64(FUsername) + CRLF);
  290. if ReadResult <> 334 then
  291. Exit;
  292. FSock.SendString(EncodeBase64(FPassword) + CRLF);
  293. Result := ReadResult = 235;
  294. end;
  295. function TSMTPSend.AuthCram: Boolean;
  296. var
  297. s: string;
  298. begin
  299. Result := False;
  300. FSock.SendString('AUTH CRAM-MD5' + CRLF);
  301. if ReadResult <> 334 then
  302. Exit;
  303. s := Copy(FResultString, 5, Length(FResultString) - 4);
  304. s := DecodeBase64(s);
  305. s := HMAC_MD5(s, FPassword);
  306. s := FUsername + ' ' + StrToHex(s);
  307. FSock.SendString(EncodeBase64(s) + CRLF);
  308. Result := ReadResult = 235;
  309. end;
  310. function TSMTPSend.Connect: Boolean;
  311. begin
  312. FSock.CloseSocket;
  313. FSock.Bind(FIPInterface, cAnyPort);
  314. if FSock.LastError = 0 then
  315. FSock.Connect(FTargetHost, FTargetPort);
  316. if FSock.LastError = 0 then
  317. if FFullSSL then
  318. FSock.SSLDoConnect;
  319. Result := FSock.LastError = 0;
  320. end;
  321. function TSMTPSend.Helo: Boolean;
  322. var
  323. x: Integer;
  324. begin
  325. FSock.SendString('HELO ' + FSystemName + CRLF);
  326. x := ReadResult;
  327. Result := (x >= 250) and (x <= 259);
  328. end;
  329. function TSMTPSend.Ehlo: Boolean;
  330. var
  331. x: Integer;
  332. begin
  333. FSock.SendString('EHLO ' + FSystemName + CRLF);
  334. x := ReadResult;
  335. Result := (x >= 250) and (x <= 259);
  336. end;
  337. function TSMTPSend.Login: Boolean;
  338. var
  339. n: Integer;
  340. auths: string;
  341. s: string;
  342. begin
  343. Result := False;
  344. FESMTP := True;
  345. FAuthDone := False;
  346. FESMTPcap.clear;
  347. FESMTPSize := False;
  348. FMaxSize := 0;
  349. if not Connect then
  350. Exit;
  351. if ReadResult <> 220 then
  352. Exit;
  353. if not Ehlo then
  354. begin
  355. FESMTP := False;
  356. if not Helo then
  357. Exit;
  358. end;
  359. Result := True;
  360. if FESMTP then
  361. begin
  362. for n := 1 to FFullResult.Count - 1 do
  363. FESMTPcap.Add(Copy(FFullResult[n], 5, Length(FFullResult[n]) - 4));
  364. if (not FullSSL) and FAutoTLS and (FindCap('STARTTLS') <> '') then
  365. if StartTLS then
  366. begin
  367. Ehlo;
  368. FESMTPcap.Clear;
  369. for n := 1 to FFullResult.Count - 1 do
  370. FESMTPcap.Add(Copy(FFullResult[n], 5, Length(FFullResult[n]) - 4));
  371. end
  372. else
  373. begin
  374. Result := False;
  375. Exit;
  376. end;
  377. if not ((FUsername = '') and (FPassword = '')) then
  378. begin
  379. s := FindCap('AUTH ');
  380. if s = '' then
  381. s := FindCap('AUTH=');
  382. auths := UpperCase(s);
  383. if s <> '' then
  384. begin
  385. if Pos('CRAM-MD5', auths) > 0 then
  386. FAuthDone := AuthCram;
  387. if (Pos('LOGIN', auths) > 0) and (not FauthDone) then
  388. FAuthDone := AuthLogin;
  389. end;
  390. end;
  391. s := FindCap('SIZE');
  392. if s <> '' then
  393. begin
  394. FESMTPsize := True;
  395. FMaxSize := StrToIntDef(Copy(s, 6, Length(s) - 5), 0);
  396. end;
  397. end;
  398. end;
  399. function TSMTPSend.Logout: Boolean;
  400. begin
  401. FSock.SendString('QUIT' + CRLF);
  402. Result := ReadResult = 221;
  403. FSock.CloseSocket;
  404. end;
  405. function TSMTPSend.Reset: Boolean;
  406. begin
  407. FSock.SendString('RSET' + CRLF);
  408. Result := ReadResult = 250;
  409. end;
  410. function TSMTPSend.NoOp: Boolean;
  411. begin
  412. FSock.SendString('NOOP' + CRLF);
  413. Result := ReadResult = 250;
  414. end;
  415. function TSMTPSend.MailFrom(const Value: string; Size: Integer): Boolean;
  416. var
  417. s: string;
  418. begin
  419. s := 'MAIL FROM:<' + Value + '>';
  420. if FESMTPsize and (Size > 0) then
  421. s := s + ' SIZE=' + IntToStr(Size);
  422. FSock.SendString(s + CRLF);
  423. Result := ReadResult = 250;
  424. end;
  425. function TSMTPSend.MailTo(const Value: string): Boolean;
  426. begin
  427. FSock.SendString('RCPT TO:<' + Value + '>' + CRLF);
  428. Result := ReadResult = 250;
  429. end;
  430. function TSMTPSend.MailData(const Value: TStrings): Boolean;
  431. var
  432. n: Integer;
  433. s: string;
  434. t: string;
  435. x: integer;
  436. begin
  437. Result := False;
  438. FSock.SendString('DATA' + CRLF);
  439. if ReadResult <> 354 then
  440. Exit;
  441. t := '';
  442. x := 1500;
  443. for n := 0 to Value.Count - 1 do
  444. begin
  445. s := Value[n];
  446. if Length(s) >= 1 then
  447. if s[1] = '.' then
  448. s := '.' + s;
  449. if Length(t) + Length(s) >= x then
  450. begin
  451. FSock.SendString(t);
  452. t := '';
  453. end;
  454. t := t + s + CRLF;
  455. end;
  456. if t <> '' then
  457. FSock.SendString(t);
  458. FSock.SendString('.' + CRLF);
  459. Result := ReadResult = 250;
  460. end;
  461. function TSMTPSend.Etrn(const Value: string): Boolean;
  462. var
  463. x: Integer;
  464. begin
  465. FSock.SendString('ETRN ' + Value + CRLF);
  466. x := ReadResult;
  467. Result := (x >= 250) and (x <= 259);
  468. end;
  469. function TSMTPSend.Verify(const Value: string): Boolean;
  470. var
  471. x: Integer;
  472. begin
  473. FSock.SendString('VRFY ' + Value + CRLF);
  474. x := ReadResult;
  475. Result := (x >= 250) and (x <= 259);
  476. end;
  477. function TSMTPSend.StartTLS: Boolean;
  478. begin
  479. Result := False;
  480. if FindCap('STARTTLS') <> '' then
  481. begin
  482. FSock.SendString('STARTTLS' + CRLF);
  483. if (ReadResult = 220) and (FSock.LastError = 0) then
  484. begin
  485. Fsock.SSLDoConnect;
  486. Result := FSock.LastError = 0;
  487. end;
  488. end;
  489. end;
  490. function TSMTPSend.EnhCodeString: string;
  491. var
  492. s, t: string;
  493. begin
  494. s := IntToStr(FEnhCode2) + '.' + IntToStr(FEnhCode3);
  495. t := '';
  496. if s = '0.0' then t := 'Other undefined Status';
  497. if s = '1.0' then t := 'Other address status';
  498. if s = '1.1' then t := 'Bad destination mailbox address';
  499. if s = '1.2' then t := 'Bad destination system address';
  500. if s = '1.3' then t := 'Bad destination mailbox address syntax';
  501. if s = '1.4' then t := 'Destination mailbox address ambiguous';
  502. if s = '1.5' then t := 'Destination mailbox address valid';
  503. if s = '1.6' then t := 'Mailbox has moved';
  504. if s = '1.7' then t := 'Bad sender''s mailbox address syntax';
  505. if s = '1.8' then t := 'Bad sender''s system address';
  506. if s = '2.0' then t := 'Other or undefined mailbox status';
  507. if s = '2.1' then t := 'Mailbox disabled, not accepting messages';
  508. if s = '2.2' then t := 'Mailbox full';
  509. if s = '2.3' then t := 'Message Length exceeds administrative limit';
  510. if s = '2.4' then t := 'Mailing list expansion problem';
  511. if s = '3.0' then t := 'Other or undefined mail system status';
  512. if s = '3.1' then t := 'Mail system full';
  513. if s = '3.2' then t := 'System not accepting network messages';
  514. if s = '3.3' then t := 'System not capable of selected features';
  515. if s = '3.4' then t := 'Message too big for system';
  516. if s = '3.5' then t := 'System incorrectly configured';
  517. if s = '4.0' then t := 'Other or undefined network or routing status';
  518. if s = '4.1' then t := 'No answer from host';
  519. if s = '4.2' then t := 'Bad connection';
  520. if s = '4.3' then t := 'Routing server failure';
  521. if s = '4.4' then t := 'Unable to route';
  522. if s = '4.5' then t := 'Network congestion';
  523. if s = '4.6' then t := 'Routing loop detected';
  524. if s = '4.7' then t := 'Delivery time expired';
  525. if s = '5.0' then t := 'Other or undefined protocol status';
  526. if s = '5.1' then t := 'Invalid command';
  527. if s = '5.2' then t := 'Syntax error';
  528. if s = '5.3' then t := 'Too many recipients';
  529. if s = '5.4' then t := 'Invalid command arguments';
  530. if s = '5.5' then t := 'Wrong protocol version';
  531. if s = '6.0' then t := 'Other or undefined media error';
  532. if s = '6.1' then t := 'Media not supported';
  533. if s = '6.2' then t := 'Conversion required and prohibited';
  534. if s = '6.3' then t := 'Conversion required but not supported';
  535. if s = '6.4' then t := 'Conversion with loss performed';
  536. if s = '6.5' then t := 'Conversion failed';
  537. if s = '7.0' then t := 'Other or undefined security status';
  538. if s = '7.1' then t := 'Delivery not authorized, message refused';
  539. if s = '7.2' then t := 'Mailing list expansion prohibited';
  540. if s = '7.3' then t := 'Security conversion required but not possible';
  541. if s = '7.4' then t := 'Security features not supported';
  542. if s = '7.5' then t := 'Cryptographic failure';
  543. if s = '7.6' then t := 'Cryptographic algorithm not supported';
  544. if s = '7.7' then t := 'Message integrity failure';
  545. s := '???-';
  546. if FEnhCode1 = 2 then s := 'Success-';
  547. if FEnhCode1 = 4 then s := 'Persistent Transient Failure-';
  548. if FEnhCode1 = 5 then s := 'Permanent Failure-';
  549. Result := s + t;
  550. end;
  551. function TSMTPSend.FindCap(const Value: string): string;
  552. var
  553. n: Integer;
  554. s: string;
  555. begin
  556. s := UpperCase(Value);
  557. Result := '';
  558. for n := 0 to FESMTPcap.Count - 1 do
  559. if Pos(s, UpperCase(FESMTPcap[n])) = 1 then
  560. begin
  561. Result := FESMTPcap[n];
  562. Break;
  563. end;
  564. end;
  565. {==============================================================================}
  566. function SendToRaw(const MailFrom, MailTo, SMTPHost: string;
  567. const MailData: TStrings; const Username, Password: string): Boolean;
  568. var
  569. SMTP: TSMTPSend;
  570. s, t: string;
  571. begin
  572. Result := False;
  573. SMTP := TSMTPSend.Create;
  574. try
  575. // if you need SOCKS5 support, uncomment next lines:
  576. // SMTP.Sock.SocksIP := '127.0.0.1';
  577. // SMTP.Sock.SocksPort := '1080';
  578. // if you need support for upgrade session to TSL/SSL, uncomment next lines:
  579. // SMTP.AutoTLS := True;
  580. // if you need support for TSL/SSL tunnel, uncomment next lines:
  581. // SMTP.FullSSL := True;
  582. SMTP.TargetHost := Trim(SeparateLeft(SMTPHost, ':'));
  583. s := Trim(SeparateRight(SMTPHost, ':'));
  584. if (s <> '') and (s <> SMTPHost) then
  585. SMTP.TargetPort := s;
  586. SMTP.Username := Username;
  587. SMTP.Password := Password;
  588. if SMTP.Login then
  589. begin
  590. if SMTP.MailFrom(GetEmailAddr(MailFrom), Length(MailData.Text)) then
  591. begin
  592. s := MailTo;
  593. repeat
  594. t := GetEmailAddr(Trim(FetchEx(s, ',', '"')));
  595. if t <> '' then
  596. Result := SMTP.MailTo(t);
  597. if not Result then
  598. Break;
  599. until s = '';
  600. if Result then
  601. Result := SMTP.MailData(MailData);
  602. end;
  603. SMTP.Logout;
  604. end;
  605. finally
  606. SMTP.Free;
  607. end;
  608. end;
  609. function SendToEx(const MailFrom, MailTo, Subject, SMTPHost: string;
  610. const MailData: TStrings; const Username, Password: string): Boolean;
  611. var
  612. t: TStrings;
  613. begin
  614. t := TStringList.Create;
  615. try
  616. t.Assign(MailData);
  617. t.Insert(0, '');
  618. t.Insert(0, 'X-mailer: Synapse - Delphi & Kylix TCP/IP library by Lukas Gebauer');
  619. t.Insert(0, 'Subject: ' + Subject);
  620. t.Insert(0, 'Date: ' + Rfc822DateTime(now));
  621. t.Insert(0, 'To: ' + MailTo);
  622. t.Insert(0, 'From: ' + MailFrom);
  623. Result := SendToRaw(MailFrom, MailTo, SMTPHost, t, Username, Password);
  624. finally
  625. t.Free;
  626. end;
  627. end;
  628. function SendTo(const MailFrom, MailTo, Subject, SMTPHost: string;
  629. const MailData: TStrings): Boolean;
  630. begin
  631. Result := SendToEx(MailFrom, MailTo, Subject, SMTPHost, MailData, '', '');
  632. end;
  633. end.