Release 2

git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@5 7c85be65-684b-0410-a082-b2ed4fbef004

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                                        |
+| History: see HISTORY.HTM from distribution package                           |
-|          First release                                                 |
+|          (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;

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.