source: trunk/Packages/synapse/smtpsend.pas

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