| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707 |
- {==============================================================================|
- | Project : Ararat Synapse | 003.004.003 |
- |==============================================================================|
- | Content: SMTP client |
- |==============================================================================|
- | Copyright (c)1999-2007, Lukas Gebauer |
- | All rights reserved. |
- | |
- | Redistribution and use in source and binary forms, with or without |
- | modification, are permitted provided that the following conditions are met: |
- | |
- | Redistributions of source code must retain the above copyright notice, this |
- | list of conditions and the following disclaimer. |
- | |
- | Redistributions in binary form must reproduce the above copyright notice, |
- | this list of conditions and the following disclaimer in the documentation |
- | and/or other materials provided with the distribution. |
- | |
- | Neither the name of Lukas Gebauer nor the names of its contributors may |
- | be used to endorse or promote products derived from this software without |
- | specific prior written permission. |
- | |
- | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
- | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
- | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
- | ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
- | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
- | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
- | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
- | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
- | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
- | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
- | DAMAGE. |
- |==============================================================================|
- | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
- | Portions created by Lukas Gebauer are Copyright (c) 1999-2007. |
- | All Rights Reserved. |
- |==============================================================================|
- | Contributor(s): |
- |==============================================================================|
- | History: see HISTORY.HTM from distribution package |
- | (Found at URL: http://www.ararat.cz/synapse/) |
- |==============================================================================}
- {:@abstract(SMTP client)
- Used RFC: RFC-1869, RFC-1870, RFC-1893, RFC-2034, RFC-2104, RFC-2195, RFC-2487,
- RFC-2554, RFC-2821
- }
- {$IFDEF FPC}
- {$MODE DELPHI}
- {$ENDIF}
- {$H+}
- unit smtpsend;
- interface
- uses
- SysUtils, Classes,
- blcksock, synautil, synacode;
- const
- cSmtpProtocol = '25';
- type
- {:@abstract(Implementation of SMTP and ESMTP procotol),
- include some ESMTP extensions, include SSL/TLS too.
- Note: Are you missing properties for setting Username and Password for ESMTP?
- Look to parent @link(TSynaClient) object!
- Are you missing properties for specify server address and port? Look to
- parent @link(TSynaClient) too!}
- TSMTPSend = class(TSynaClient)
- private
- FSock: TTCPBlockSocket;
- FResultCode: Integer;
- FResultString: string;
- FFullResult: TStringList;
- FESMTPcap: TStringList;
- FESMTP: Boolean;
- FAuthDone: Boolean;
- FESMTPSize: Boolean;
- FMaxSize: Integer;
- FEnhCode1: Integer;
- FEnhCode2: Integer;
- FEnhCode3: Integer;
- FSystemName: string;
- FAutoTLS: Boolean;
- FFullSSL: Boolean;
- procedure EnhancedCode(const Value: string);
- function ReadResult: Integer;
- function AuthLogin: Boolean;
- function AuthCram: Boolean;
- function Helo: Boolean;
- function Ehlo: Boolean;
- function Connect: Boolean;
- public
- constructor Create;
- destructor Destroy; override;
- {:Connects to SMTP server (defined in @link(TSynaClient.TargetHost)) and
- begin SMTP session. (First try ESMTP EHLO, next old HELO handshake). Parses
- ESMTP capabilites and if you specified Username and password and remote
- server can handle AUTH command, try login by AUTH command. Preffered login
- method is CRAM-MD5 (if safer!). If all OK, result is @true, else result is
- @false.}
- function Login: Boolean;
- {:Close SMTP session (QUIT command) and disconnect from SMTP server.}
- function Logout: Boolean;
- {:Send RSET SMTP command for reset SMTP session. If all OK, result is @true,
- else result is @false.}
- function Reset: Boolean;
- {:Send NOOP SMTP command for keep SMTP session. If all OK, result is @true,
- else result is @false.}
- function NoOp: Boolean;
- {:Send MAIL FROM SMTP command for set sender e-mail address. If sender's
- e-mail address is empty string, transmited message is error message.
- If size not 0 and remote server can handle SIZE parameter, append SIZE
- parameter to request. If all OK, result is @true, else result is @false.}
- function MailFrom(const Value: string; Size: Integer): Boolean;
- {:Send RCPT TO SMTP command for set receiver e-mail address. It cannot be an
- empty string. If all OK, result is @true, else result is @false.}
- function MailTo(const Value: string): Boolean;
- {:Send DATA SMTP command and transmit message data. If all OK, result is
- @true, else result is @false.}
- function MailData(const Value: Tstrings): Boolean;
- {:Send ETRN SMTP command for start sending of remote queue for domain in
- Value. If all OK, result is @true, else result is @false.}
- function Etrn(const Value: string): Boolean;
- {:Send VRFY SMTP command for check receiver e-mail address. It cannot be
- an empty string. If all OK, result is @true, else result is @false.}
- function Verify(const Value: string): Boolean;
- {:Call STARTTLS command for upgrade connection to SSL/TLS mode.}
- function StartTLS: Boolean;
- {:Return string descriptive text for enhanced result codes stored in
- @link(EnhCode1), @link(EnhCode2) and @link(EnhCode3).}
- function EnhCodeString: string;
- {:Try to find specified capability in ESMTP response.}
- function FindCap(const Value: string): string;
- published
- {:result code of last SMTP command.}
- property ResultCode: Integer read FResultCode;
- {:result string of last SMTP command (begin with string representation of
- result code).}
- property ResultString: string read FResultString;
- {:All result strings of last SMTP command (result is maybe multiline!).}
- property FullResult: TStringList read FFullResult;
- {:List of ESMTP capabilites of remote ESMTP server. (If you connect to ESMTP
- server only!).}
- property ESMTPcap: TStringList read FESMTPcap;
- {:@TRUE if you successfuly logged to ESMTP server.}
- property ESMTP: Boolean read FESMTP;
- {:@TRUE if you successfuly pass authorisation to remote server.}
- property AuthDone: Boolean read FAuthDone;
- {:@TRUE if remote server can handle SIZE parameter.}
- property ESMTPSize: Boolean read FESMTPSize;
- {:When @link(ESMTPsize) is @TRUE, contains max length of message that remote
- server can handle.}
- property MaxSize: Integer read FMaxSize;
- {:First digit of Enhanced result code. If last operation does not have
- enhanced result code, values is 0.}
- property EnhCode1: Integer read FEnhCode1;
- {:Second digit of Enhanced result code. If last operation does not have
- enhanced result code, values is 0.}
- property EnhCode2: Integer read FEnhCode2;
- {:Third digit of Enhanced result code. If last operation does not have
- enhanced result code, values is 0.}
- property EnhCode3: Integer read FEnhCode3;
- {:name of our system used in HELO and EHLO command. Implicit value is
- internet address of your machine.}
- property SystemName: string read FSystemName Write FSystemName;
- {:If is set to true, then upgrade to SSL/TLS mode if remote server support it.}
- property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
- {:SSL/TLS mode is used from first contact to server. Servers with full
- SSL/TLS mode usualy using non-standard TCP port!}
- property FullSSL: Boolean read FFullSSL Write FFullSSL;
- {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
- property Sock: TTCPBlockSocket read FSock;
- end;
- {:A very useful function and example of its use would be found in the TSMTPsend
- object. Send maildata (text of e-mail with all SMTP headers! For example when
- text of message is created by @link(TMimemess) object) from "MailFrom" e-mail
- address to "MailTo" e-mail address (If you need more then one receiver, then
- separate their addresses by comma).
- Function sends e-mail to a SMTP server defined in "SMTPhost" parameter.
- Username and password are used for authorization to the "SMTPhost". If you
- don't want authorization, set "Username" and "Password" to empty strings. If
- e-mail message is successfully sent, the result returns @true.
- If you need use different port number then standard, then add this port number
- to SMTPhost after colon. (i.e. '127.0.0.1:1025')}
- function SendToRaw(const MailFrom, MailTo, SMTPHost: string;
- const MailData: TStrings; const Username, Password: string): Boolean;
- {:A very useful function and example of its use would be found in the TSMTPsend
- object. Send "Maildata" (text of e-mail without any SMTP headers!) from
- "MailFrom" e-mail address to "MailTo" e-mail address with "Subject". (If you
- need more then one receiver, then separate their addresses by comma).
- This function constructs all needed SMTP headers (with DATE header) and sends
- the e-mail to the SMTP server defined in the "SMTPhost" parameter. If the
- e-mail message is successfully sent, the result will be @TRUE.
- If you need use different port number then standard, then add this port number
- to SMTPhost after colon. (i.e. '127.0.0.1:1025')}
- function SendTo(const MailFrom, MailTo, Subject, SMTPHost: string;
- const MailData: TStrings): Boolean;
- {:A very useful function and example of its use would be found in the TSMTPsend
- object. Sends "MailData" (text of e-mail without any SMTP headers!) from
- "MailFrom" e-mail address to "MailTo" e-mail address (If you need more then one
- receiver, then separate their addresses by comma).
- This function sends the e-mail to the SMTP server defined in the "SMTPhost"
- parameter. Username and password are used for authorization to the "SMTPhost".
- If you dont want authorization, set "Username" and "Password" to empty Strings.
- If the e-mail message is successfully sent, the result will be @TRUE.
- If you need use different port number then standard, then add this port number
- to SMTPhost after colon. (i.e. '127.0.0.1:1025')}
- function SendToEx(const MailFrom, MailTo, Subject, SMTPHost: string;
- const MailData: TStrings; const Username, Password: string): Boolean;
- implementation
- constructor TSMTPSend.Create;
- begin
- inherited Create;
- FFullResult := TStringList.Create;
- FESMTPcap := TStringList.Create;
- FSock := TTCPBlockSocket.Create;
- FSock.ConvertLineEnd := true;
- FTimeout := 60000;
- FTargetPort := cSmtpProtocol;
- FSystemName := FSock.LocalName;
- FAutoTLS := False;
- FFullSSL := False;
- end;
- destructor TSMTPSend.Destroy;
- begin
- FSock.Free;
- FESMTPcap.Free;
- FFullResult.Free;
- inherited Destroy;
- end;
- procedure TSMTPSend.EnhancedCode(const Value: string);
- var
- s, t: string;
- e1, e2, e3: Integer;
- begin
- FEnhCode1 := 0;
- FEnhCode2 := 0;
- FEnhCode3 := 0;
- s := Copy(Value, 5, Length(Value) - 4);
- t := Trim(SeparateLeft(s, '.'));
- s := Trim(SeparateRight(s, '.'));
- if t = '' then
- Exit;
- if Length(t) > 1 then
- Exit;
- e1 := StrToIntDef(t, 0);
- if e1 = 0 then
- Exit;
- t := Trim(SeparateLeft(s, '.'));
- s := Trim(SeparateRight(s, '.'));
- if t = '' then
- Exit;
- if Length(t) > 3 then
- Exit;
- e2 := StrToIntDef(t, 0);
- t := Trim(SeparateLeft(s, ' '));
- if t = '' then
- Exit;
- if Length(t) > 3 then
- Exit;
- e3 := StrToIntDef(t, 0);
- FEnhCode1 := e1;
- FEnhCode2 := e2;
- FEnhCode3 := e3;
- end;
- function TSMTPSend.ReadResult: Integer;
- var
- s: string;
- begin
- Result := 0;
- FFullResult.Clear;
- repeat
- s := FSock.RecvString(FTimeout);
- FResultString := s;
- FFullResult.Add(s);
- if FSock.LastError <> 0 then
- Break;
- until Pos('-', s) <> 4;
- s := FFullResult[0];
- if Length(s) >= 3 then
- Result := StrToIntDef(Copy(s, 1, 3), 0);
- FResultCode := Result;
- EnhancedCode(s);
- end;
- function TSMTPSend.AuthLogin: Boolean;
- begin
- Result := False;
- FSock.SendString('AUTH LOGIN' + CRLF);
- if ReadResult <> 334 then
- Exit;
- FSock.SendString(EncodeBase64(FUsername) + CRLF);
- if ReadResult <> 334 then
- Exit;
- FSock.SendString(EncodeBase64(FPassword) + CRLF);
- Result := ReadResult = 235;
- end;
- function TSMTPSend.AuthCram: Boolean;
- var
- s: string;
- begin
- Result := False;
- FSock.SendString('AUTH CRAM-MD5' + CRLF);
- if ReadResult <> 334 then
- Exit;
- s := Copy(FResultString, 5, Length(FResultString) - 4);
- s := DecodeBase64(s);
- s := HMAC_MD5(s, FPassword);
- s := FUsername + ' ' + StrToHex(s);
- FSock.SendString(EncodeBase64(s) + CRLF);
- Result := ReadResult = 235;
- end;
- function TSMTPSend.Connect: Boolean;
- begin
- FSock.CloseSocket;
- FSock.Bind(FIPInterface, cAnyPort);
- if FSock.LastError = 0 then
- FSock.Connect(FTargetHost, FTargetPort);
- if FSock.LastError = 0 then
- if FFullSSL then
- FSock.SSLDoConnect;
- Result := FSock.LastError = 0;
- end;
- function TSMTPSend.Helo: Boolean;
- var
- x: Integer;
- begin
- FSock.SendString('HELO ' + FSystemName + CRLF);
- x := ReadResult;
- Result := (x >= 250) and (x <= 259);
- end;
- function TSMTPSend.Ehlo: Boolean;
- var
- x: Integer;
- begin
- FSock.SendString('EHLO ' + FSystemName + CRLF);
- x := ReadResult;
- Result := (x >= 250) and (x <= 259);
- end;
- function TSMTPSend.Login: Boolean;
- var
- n: Integer;
- auths: string;
- s: string;
- begin
- Result := False;
- FESMTP := True;
- FAuthDone := False;
- FESMTPcap.clear;
- FESMTPSize := False;
- FMaxSize := 0;
- if not Connect then
- Exit;
- if ReadResult <> 220 then
- Exit;
- if not Ehlo then
- begin
- FESMTP := False;
- if not Helo then
- Exit;
- end;
- Result := True;
- if FESMTP then
- begin
- for n := 1 to FFullResult.Count - 1 do
- FESMTPcap.Add(Copy(FFullResult[n], 5, Length(FFullResult[n]) - 4));
- if (not FullSSL) and FAutoTLS and (FindCap('STARTTLS') <> '') then
- if StartTLS then
- begin
- Ehlo;
- FESMTPcap.Clear;
- for n := 1 to FFullResult.Count - 1 do
- FESMTPcap.Add(Copy(FFullResult[n], 5, Length(FFullResult[n]) - 4));
- end
- else
- begin
- Result := False;
- Exit;
- end;
- if not ((FUsername = '') and (FPassword = '')) then
- begin
- s := FindCap('AUTH ');
- if s = '' then
- s := FindCap('AUTH=');
- auths := UpperCase(s);
- if s <> '' then
- begin
- if Pos('CRAM-MD5', auths) > 0 then
- FAuthDone := AuthCram;
- if (Pos('LOGIN', auths) > 0) and (not FauthDone) then
- FAuthDone := AuthLogin;
- end;
- end;
- s := FindCap('SIZE');
- if s <> '' then
- begin
- FESMTPsize := True;
- FMaxSize := StrToIntDef(Copy(s, 6, Length(s) - 5), 0);
- end;
- end;
- end;
- function TSMTPSend.Logout: Boolean;
- begin
- FSock.SendString('QUIT' + CRLF);
- Result := ReadResult = 221;
- FSock.CloseSocket;
- end;
- function TSMTPSend.Reset: Boolean;
- begin
- FSock.SendString('RSET' + CRLF);
- Result := ReadResult = 250;
- end;
- function TSMTPSend.NoOp: Boolean;
- begin
- FSock.SendString('NOOP' + CRLF);
- Result := ReadResult = 250;
- end;
- function TSMTPSend.MailFrom(const Value: string; Size: Integer): Boolean;
- var
- s: string;
- begin
- s := 'MAIL FROM:<' + Value + '>';
- if FESMTPsize and (Size > 0) then
- s := s + ' SIZE=' + IntToStr(Size);
- FSock.SendString(s + CRLF);
- Result := ReadResult = 250;
- end;
- function TSMTPSend.MailTo(const Value: string): Boolean;
- begin
- FSock.SendString('RCPT TO:<' + Value + '>' + CRLF);
- Result := ReadResult = 250;
- end;
- function TSMTPSend.MailData(const Value: TStrings): Boolean;
- var
- n: Integer;
- s: string;
- t: string;
- x: integer;
- begin
- Result := False;
- FSock.SendString('DATA' + CRLF);
- if ReadResult <> 354 then
- Exit;
- t := '';
- x := 1500;
- for n := 0 to Value.Count - 1 do
- begin
- s := Value[n];
- if Length(s) >= 1 then
- if s[1] = '.' then
- s := '.' + s;
- if Length(t) + Length(s) >= x then
- begin
- FSock.SendString(t);
- t := '';
- end;
- t := t + s + CRLF;
- end;
- if t <> '' then
- FSock.SendString(t);
- FSock.SendString('.' + CRLF);
- Result := ReadResult = 250;
- end;
- function TSMTPSend.Etrn(const Value: string): Boolean;
- var
- x: Integer;
- begin
- FSock.SendString('ETRN ' + Value + CRLF);
- x := ReadResult;
- Result := (x >= 250) and (x <= 259);
- end;
- function TSMTPSend.Verify(const Value: string): Boolean;
- var
- x: Integer;
- begin
- FSock.SendString('VRFY ' + Value + CRLF);
- x := ReadResult;
- Result := (x >= 250) and (x <= 259);
- end;
- function TSMTPSend.StartTLS: Boolean;
- begin
- Result := False;
- if FindCap('STARTTLS') <> '' then
- begin
- FSock.SendString('STARTTLS' + CRLF);
- if (ReadResult = 220) and (FSock.LastError = 0) then
- begin
- Fsock.SSLDoConnect;
- Result := FSock.LastError = 0;
- end;
- end;
- end;
- function TSMTPSend.EnhCodeString: string;
- var
- s, t: string;
- begin
- s := IntToStr(FEnhCode2) + '.' + IntToStr(FEnhCode3);
- t := '';
- if s = '0.0' then t := 'Other undefined Status';
- if s = '1.0' then t := 'Other address status';
- if s = '1.1' then t := 'Bad destination mailbox address';
- if s = '1.2' then t := 'Bad destination system address';
- if s = '1.3' then t := 'Bad destination mailbox address syntax';
- if s = '1.4' then t := 'Destination mailbox address ambiguous';
- if s = '1.5' then t := 'Destination mailbox address valid';
- if s = '1.6' then t := 'Mailbox has moved';
- if s = '1.7' then t := 'Bad sender''s mailbox address syntax';
- if s = '1.8' then t := 'Bad sender''s system address';
- if s = '2.0' then t := 'Other or undefined mailbox status';
- if s = '2.1' then t := 'Mailbox disabled, not accepting messages';
- if s = '2.2' then t := 'Mailbox full';
- if s = '2.3' then t := 'Message Length exceeds administrative limit';
- if s = '2.4' then t := 'Mailing list expansion problem';
- if s = '3.0' then t := 'Other or undefined mail system status';
- if s = '3.1' then t := 'Mail system full';
- if s = '3.2' then t := 'System not accepting network messages';
- if s = '3.3' then t := 'System not capable of selected features';
- if s = '3.4' then t := 'Message too big for system';
- if s = '3.5' then t := 'System incorrectly configured';
- if s = '4.0' then t := 'Other or undefined network or routing status';
- if s = '4.1' then t := 'No answer from host';
- if s = '4.2' then t := 'Bad connection';
- if s = '4.3' then t := 'Routing server failure';
- if s = '4.4' then t := 'Unable to route';
- if s = '4.5' then t := 'Network congestion';
- if s = '4.6' then t := 'Routing loop detected';
- if s = '4.7' then t := 'Delivery time expired';
- if s = '5.0' then t := 'Other or undefined protocol status';
- if s = '5.1' then t := 'Invalid command';
- if s = '5.2' then t := 'Syntax error';
- if s = '5.3' then t := 'Too many recipients';
- if s = '5.4' then t := 'Invalid command arguments';
- if s = '5.5' then t := 'Wrong protocol version';
- if s = '6.0' then t := 'Other or undefined media error';
- if s = '6.1' then t := 'Media not supported';
- if s = '6.2' then t := 'Conversion required and prohibited';
- if s = '6.3' then t := 'Conversion required but not supported';
- if s = '6.4' then t := 'Conversion with loss performed';
- if s = '6.5' then t := 'Conversion failed';
- if s = '7.0' then t := 'Other or undefined security status';
- if s = '7.1' then t := 'Delivery not authorized, message refused';
- if s = '7.2' then t := 'Mailing list expansion prohibited';
- if s = '7.3' then t := 'Security conversion required but not possible';
- if s = '7.4' then t := 'Security features not supported';
- if s = '7.5' then t := 'Cryptographic failure';
- if s = '7.6' then t := 'Cryptographic algorithm not supported';
- if s = '7.7' then t := 'Message integrity failure';
- s := '???-';
- if FEnhCode1 = 2 then s := 'Success-';
- if FEnhCode1 = 4 then s := 'Persistent Transient Failure-';
- if FEnhCode1 = 5 then s := 'Permanent Failure-';
- Result := s + t;
- end;
- function TSMTPSend.FindCap(const Value: string): string;
- var
- n: Integer;
- s: string;
- begin
- s := UpperCase(Value);
- Result := '';
- for n := 0 to FESMTPcap.Count - 1 do
- if Pos(s, UpperCase(FESMTPcap[n])) = 1 then
- begin
- Result := FESMTPcap[n];
- Break;
- end;
- end;
- {==============================================================================}
- function SendToRaw(const MailFrom, MailTo, SMTPHost: string;
- const MailData: TStrings; const Username, Password: string): Boolean;
- var
- SMTP: TSMTPSend;
- s, t: string;
- begin
- Result := False;
- SMTP := TSMTPSend.Create;
- try
- // if you need SOCKS5 support, uncomment next lines:
- // SMTP.Sock.SocksIP := '127.0.0.1';
- // SMTP.Sock.SocksPort := '1080';
- // if you need support for upgrade session to TSL/SSL, uncomment next lines:
- // SMTP.AutoTLS := True;
- // if you need support for TSL/SSL tunnel, uncomment next lines:
- // SMTP.FullSSL := True;
- SMTP.TargetHost := Trim(SeparateLeft(SMTPHost, ':'));
- s := Trim(SeparateRight(SMTPHost, ':'));
- if (s <> '') and (s <> SMTPHost) then
- SMTP.TargetPort := s;
- SMTP.Username := Username;
- SMTP.Password := Password;
- if SMTP.Login then
- begin
- if SMTP.MailFrom(GetEmailAddr(MailFrom), Length(MailData.Text)) then
- begin
- s := MailTo;
- repeat
- t := GetEmailAddr(Trim(FetchEx(s, ',', '"')));
- if t <> '' then
- Result := SMTP.MailTo(t);
- if not Result then
- Break;
- until s = '';
- if Result then
- Result := SMTP.MailData(MailData);
- end;
- SMTP.Logout;
- end;
- finally
- SMTP.Free;
- end;
- end;
- function SendToEx(const MailFrom, MailTo, Subject, SMTPHost: string;
- const MailData: TStrings; const Username, Password: string): Boolean;
- var
- t: TStrings;
- begin
- t := TStringList.Create;
- try
- t.Assign(MailData);
- t.Insert(0, '');
- t.Insert(0, 'X-mailer: Synapse - Delphi & Kylix TCP/IP library by Lukas Gebauer');
- t.Insert(0, 'Subject: ' + Subject);
- t.Insert(0, 'Date: ' + Rfc822DateTime(now));
- t.Insert(0, 'To: ' + MailTo);
- t.Insert(0, 'From: ' + MailFrom);
- Result := SendToRaw(MailFrom, MailTo, SMTPHost, t, Username, Password);
- finally
- t.Free;
- end;
- end;
- function SendTo(const MailFrom, MailTo, Subject, SMTPHost: string;
- const MailData: TStrings): Boolean;
- begin
- Result := SendToEx(MailFrom, MailTo, Subject, SMTPHost, MailData, '', '');
- end;
- end.
|