From b42ea890cc7237d96186c77549ea304581c80382 Mon Sep 17 00:00:00 2001 From: geby Date: Wed, 23 Apr 2008 20:24:29 +0000 Subject: [PATCH] Release 2 git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@5 7c85be65-684b-0410-a082-b2ed4fbef004 --- blcksock.pas | 10 +- smtpsend.pas | 257 +++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 260 insertions(+), 7 deletions(-) create mode 100644 smtpsend.pas diff --git a/blcksock.pas b/blcksock.pas index d28023b..bdacd12 100644 --- a/blcksock.pas +++ b/blcksock.pas @@ -1,5 +1,5 @@ {==============================================================================| -| Project : Delphree - Synapse | 001.000.000 | +| Project : Delphree - Synapse | 001.000.001 | |==============================================================================| | Content: Library base | |==============================================================================| @@ -19,8 +19,8 @@ |==============================================================================| | Contributor(s): | |==============================================================================| -| History: 26.9.1999 Version 001.000.000 | -| First release | +| History: see HISTORY.HTM from distribution package | +| (Found at URL: http://www.mlp.cz/space/gebauerl/synapse/) | |==============================================================================} unit blcksock; @@ -38,7 +38,6 @@ type {TBlockSocket} TBlockSocket = class (TObject) Protected -{identifikator socketu} FSocket:TSocket; FLocalSin:TSockAddrIn; FRemoteSin:TSockAddrIn; @@ -46,13 +45,10 @@ Protected FProtocol:integer; FBuffer:string; -{vyhodnoti IP adresu a port (vcetne symbolickych nazvu) - a naplni jimi strukturu SIN} procedure SetSin (var sin:TSockAddrIn;ip,port:string); function GetSinIP (sin:TSockAddrIn):string; function GetSinPort (sin:TSockAddrIn):integer; public -{informace o WinSock} FWsaData : TWSADATA; constructor Create; diff --git a/smtpsend.pas b/smtpsend.pas new file mode 100644 index 0000000..ccf0f0e --- /dev/null +++ b/smtpsend.pas @@ -0,0 +1,257 @@ +{==============================================================================| +| Project : Delphree - Synapse | 001.000.000 | +|==============================================================================| +| Content: SMTP client | +|==============================================================================| +| The contents of this file are subject to the Mozilla Public License Ver. 1.0 | +| (the "License"); you may not use this file except in compliance with the | +| License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ | +| | +| Software distributed under the License is distributed on an "AS IS" basis, | +| WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for | +| the specific language governing rights and limitations under the License. | +|==============================================================================| +| The Original Code is Synapse Delphi Library. | +|==============================================================================| +| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| +| Portions created by Lukas Gebauer are Copyright (c) 1999. | +| All Rights Reserved. | +|==============================================================================| +| Contributor(s): | +|==============================================================================| +| History: see HISTORY.HTM from distribution package | +| (Found at URL: http://www.mlp.cz/space/gebauerl/synapse/) | +|==============================================================================} + +unit SMTPsend; + +interface +uses + Blcksock, sysutils, classes, windows; + +const + CRLF=#13+#10; + +type + TSMTPSend = class + private + Sock:TTCPBlockSocket; + function ReadResult:integer; + public + timeout:integer; + SMTPHost:string; + Constructor Create; + Destructor Destroy; override; + function login:Boolean; + procedure logout; + function reset:Boolean; + function noop:Boolean; + function mailfrom(Value:string):Boolean; + function mailto(Value:string):Boolean; + function maildata(Value:Tstrings):Boolean; + end; + +function timezone:string; +function Rfc822DateTime(t:TDateTime):String; +function Sendto (mailfrom,mailto,subject,SMTPHost:string;maildata:TStrings):Boolean; + +implementation + +{TSMTPSend.Create} +Constructor TSMTPSend.Create; +begin + inherited Create; + sock:=TTCPBlockSocket.create; + sock.CreateSocket; + timeout:=300; + SMTPhost:='localhost'; +end; + +{TSMTPSend.Destroy} +Destructor TSMTPSend.Destroy; +begin + Sock.free; + inherited destroy; +end; + +{TSMTPSend.ReadResult} +function TSMTPSend.ReadResult:integer; +var + s:string; +begin + Result:=0; + s:=sock.recvstring(timeout); + if Length(s)>=3 then Result:=Strtointdef(Copy(s,1,3),0); + while pos('-',s)=4 do + begin + s:=sock.recvstring(timeout); + if sock.LastError<>0 then + begin + Result:=0; + break; + end; + end; +end; + +{TSMTPSend.login} +function TSMTPSend.login:Boolean; +begin + Result:=False; + sock.Connect(SMTPHost,'smtp'); + if sock.lasterror<>0 then Exit; + if readresult<>220 then Exit; + Sock.SendString('HELO '+sock.LocalName+CRLF); + if readresult<>250 then Exit; + Result:=True; +end; + +{TSMTPSend.logout} +procedure TSMTPSend.logout; +begin + Sock.SendString('QUIT'+CRLF); + readresult; + Sock.CloseSocket; +end; + +{TSMTPSend.reset} +function TSMTPSend.reset:Boolean; +begin + Result:=false; + Sock.SendString('RSET'+CRLF); + if readresult<>250 then Exit; + Result:=True; +end; + +{TSMTPSend.noop} +function TSMTPSend.noop:Boolean; +begin + Result:=false; + Sock.SendString('NOOP'+CRLF); + if readresult<>250 then Exit; + Result:=True; +end; + + +{TSMTPSend.mailfrom} +function TSMTPSend.mailfrom(Value:string):Boolean; +begin + Result:=false; + Sock.SendString('MAIL FROM:<'+Value+'>'+CRLF); + if readresult<>250 then Exit; + Result:=True; +end; + +{TSMTPSend.mailto} +function TSMTPSend.mailto(Value:string):Boolean; +begin + Result:=false; + Sock.SendString('RCPT TO:<'+Value+'>'+CRLF); + if readresult<>250 then Exit; + Result:=True; +end; + +{TSMTPSend.maildata} +function TSMTPSend.maildata(Value:Tstrings):Boolean; +var + n:integer; + s:string; +begin + Result:=false; + Sock.SendString('DATA'+CRLF); + if readresult<>354 then Exit; + for n:=0 to Value.Count-1 do + begin + s:=value[n]; + if Length(s)>1 then + if s[1]='.' then s:='.'+s; + Sock.SendString(s+CRLF); + end; + Sock.SendString('.'+CRLF); + if readresult<>250 then Exit; + Result:=True; +end; + +{==============================================================================} + +function timezone:string; +var + zoneinfo:TTimeZoneInformation; + bias:integer; + h,m:integer; +begin + GetTimeZoneInformation(Zoneinfo); + bias:=zoneinfo.bias; + if bias<=0 then result:='+' + else result:='-'; + bias:=abs(bias); + h:=bias div 60; + m:=bias mod 60; + result:=result+format('%.2d%.2d',[h,m]); +end; + +function Rfc822DateTime(t:TDateTime):String; +var + I: Integer; + SaveDayNames: array[1..7] of string; + SaveMonthNames: array[1..12] of string; +const + MyDayNames: array[1..7] of string = + ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat'); + MyMonthNames: array[1..12] of string = + ('Jan', 'Feb', 'Mar', 'Apr', + 'May', 'Jun', 'Jul', 'Aug', + 'Sep', 'Oct', 'Nov', 'Dec'); +begin + if ShortDayNames[1] = MyDayNames[1] + then Result := FormatDateTime('ddd, d mmm yyyy hh:mm:ss', t) + else + begin + for I := Low(ShortDayNames) to High(ShortDayNames) do + begin + SaveDayNames[I] := ShortDayNames[I]; + ShortDayNames[I] := MyDayNames[I]; + end; + for I := Low(ShortMonthNames) to High(ShortMonthNames) do + begin + SaveMonthNames[I] := ShortMonthNames[I]; + ShortMonthNames[I] := MyMonthNames[I]; + end; + Result := FormatDateTime('ddd, d mmm yyyy hh:mm:ss', t); + for I := Low(ShortDayNames) to High(ShortDayNames) do + ShortDayNames[I] := SaveDayNames[I]; + for I := Low(ShortMonthNames) to High(ShortMonthNames) do + ShortMonthNames[I] := SaveMonthNames[I]; + end; + Result:=Result+' '+Timezone; +end; + +function Sendto (mailfrom,mailto,subject,SMTPHost:string;maildata:TStrings):Boolean; +var + SMTP:TSMTPSend; + t:TStrings; +begin + Result:=False; + SMTP:=TSMTPSend.Create; + t:=TStringList.Create; + try + t.assign(Maildata); + t.Insert(0,''); + t.Insert(0,'subject: '+subject); + t.Insert(0,'date: '+Rfc822DateTime(now)); + t.Insert(0,'to: '+mailto); + t.Insert(0,'from: '+mailfrom); + SMTP.SMTPHost:=SMTPHost; + if not SMTP.login then Exit; + if not SMTP.mailfrom(mailfrom) then Exit; + if not SMTP.mailto(mailto) then Exit; + if not SMTP.maildata(t) then Exit; + SMTP.logout; + Result:=True; + finally + SMTP.Free; + t.Free; + end; +end; + + +end.