Release 23

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

asn1util.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.003.002 |
+| Project : Delphree - Synapse                                   | 001.003.003 |
 |==============================================================================|
 | Content: support for ASN.1 coding and decoding                               |
 |==============================================================================|
-| The contents of this file are subject to the Mozilla Public License Ver. 1.0 |
+| The contents of this file are subject to the Mozilla Public License Ver. 1.1 |
 | (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/ |
 |                                                                              |
@@ -26,6 +26,7 @@
 |==============================================================================}
 
 {$Q-}
+{$WEAKPACKAGEUNIT ON}
 
 unit ASN1Util;
 
@@ -46,204 +47,202 @@ const
   ASN1_TIMETICKS = $43;
   ASN1_OPAQUE = $44;
 
-function ASNEncOIDitem(Value: integer): string;
+function ASNEncOIDItem(Value: Integer): string;
-function ASNDecOIDitem(var Start: integer; Buffer: string): integer;
+function ASNDecOIDItem(var Start: Integer; const Buffer: string): Integer;
-function ASNEncLen(Len: integer): string;
+function ASNEncLen(Len: Integer): string;
-function ASNDecLen(var Start: integer; Buffer: string): integer;
+function ASNDecLen(var Start: Integer; const Buffer: string): Integer;
-function ASNEncInt(Value: integer): string;
+function ASNEncInt(Value: Integer): string;
-function ASNEncUInt(Value: integer): string;
+function ASNEncUInt(Value: Integer): string;
-function ASNObject(Data: string; ASNType: integer): string;
+function ASNObject(const Data: string; ASNType: Integer): string;
-function ASNItem(var Start: integer; Buffer: string; var ValueType:integer): string;
+function ASNItem(var Start: Integer; const Buffer: string;
-Function MibToId(mib:string):string;
+  var ValueType: Integer): string;
-Function IdToMib(id:string):string;
+function MibToId(Mib: string): string;
-Function IntMibToStr(int:string):string;
+function IdToMib(const Id: string): string;
+function IntMibToStr(const Value: string): string;
 function IPToID(Host: string): string;
 
 implementation
 
 {==============================================================================}
-{ASNEncOIDitem}
+
-function ASNEncOIDitem(Value: integer): string;
+function ASNEncOIDItem(Value: Integer): string;
 var
-  x,xm:integer;
+  x, xm: Integer;
-  b:boolean;
+  b: Boolean;
 begin
-  x:=value;
+  x := Value;
-  b:=false;
+  b := False;
-  result:='';
+  Result := '';
   repeat
-    xm:=x mod 128;
+    xm := x mod 128;
-    x:=x div 128;
+    x := x div 128;
     if b then
-      xm:=xm or $80;
+      xm := xm or $80;
-    if x>0
+    if x > 0 then
-      then b:=true;
+      b := True;
-    result:=char(xm)+result;
+    Result := Char(xm) + Result;
-  until x=0;
+  until x = 0;
 end;
 
 {==============================================================================}
-{ASNDecOIDitem}
+
-function ASNDecOIDitem(var Start: integer; Buffer: string): integer;
+function ASNDecOIDItem(var Start: Integer; const Buffer: string): Integer;
 var
-  x:integer;
+  x: Integer;
-  b:boolean;
+  b: Boolean;
 begin
-  result:=0;
+  Result := 0;
   repeat
-    result:=result*128;
+    Result := Result * 128;
     x := Ord(Buffer[Start]);
-    inc(start);
+    Inc(Start);
-    b:=x>$7f;
+    b := x > $7F;
-    x:=x and $7f;
+    x := x and $7F;
-    result:=result+x;
+    Result := Result + x;
-    if not b
+  until not b;
-      then break;
-  until false
 end;
 
 {==============================================================================}
-{ASNEncLen}
+
-function ASNEncLen(Len: integer): string;
+function ASNEncLen(Len: Integer): string;
 var
-  x, y: integer;
+  x, y: Integer;
 begin
-  if (len<$80)
+  if Len < $80 then
-    then result:=char(len)
+    Result := Char(Len)
   else
   begin
-        x:=len;
+    x := Len;
-        result:='';
+    Result := '';
     repeat
-          y:=x mod 256;
+      y := x mod 256;
-          x:=x div 256;
+      x := x div 256;
-          result:=char(y)+result;
+      Result := Char(y) + Result;
-        until x=0;
+    until x = 0;
-        y:=length(result);
+    y := Length(Result);
-        y:=y or $80;
+    y := y or $80;
-        result:=char(y)+result;
+    Result := Char(y) + Result;
   end;
 end;
 
 {==============================================================================}
-{ASNDecLen}
+
-function ASNDecLen(var Start: integer; Buffer: string): integer;
+function ASNDecLen(var Start: Integer; const Buffer: string): Integer;
 var
-  x,n: integer;
+  x, n: Integer;
 begin
-  x:=Ord(Buffer[Start]);
+  x := Ord(Buffer[Start]);
   Inc(Start);
-  if (x<$80)
+  if x < $80 then
-    then Result:=x
+    Result := x
   else
   begin
-        result:=0;
+    Result := 0;
-        x:=x and $7f;
+    x := x and $7F;
-        for n:=1 to x do
+    for n := 1 to x do
     begin
-            result:=result*256;
+      Result := Result * 256;
-            x:=Ord(Buffer[Start]);
+      x := Ord(Buffer[Start]);
       Inc(Start);
-            result:=result+x;
+      Result := Result + x;
     end;
   end;
 end;
 
 {==============================================================================}
-{ASNEncInt}
+
-function ASNEncInt(Value: integer): string;
+function ASNEncInt(Value: Integer): string;
 var
-  x,y:cardinal;
+  x, y: Cardinal;
-  neg:boolean;
+  neg: Boolean;
 begin
-  neg:=value<0;
+  neg := Value < 0;
-  x:=abs(Value);
+  x := Abs(Value);
   if neg then
-    x:=not (x-1);
+    x := not (x - 1);
-  result:='';
+  Result := '';
   repeat
-    y:=x mod 256;
+    y := x mod 256;
-    x:=x div 256;
+    x := x div 256;
-    result:=char(y)+result;
+    Result := Char(y) + Result;
-  until x=0;
+  until x = 0;
-  if (not neg) and (result[1]>#$7F)
+  if (not neg) and (Result[1] > #$7F) then
-    then result:=#0+result;
+    Result := #0 + Result;
 end;
 
 {==============================================================================}
-{ASNEncUInt}
+
-function ASNEncUInt(Value: integer): string;
+function ASNEncUInt(Value: Integer): string;
 var
-  x,y:integer;
+  x, y: Integer;
-  neg:boolean;
+  neg: Boolean;
 begin
-  neg:=value<0;
+  neg := Value < 0;
-  x:=Value;
+  x := Value;
-  if neg
+  if neg then
-    then x:=x and $7FFFFFFF;
+    x := x and $7FFFFFFF;
-  result:='';
+  Result := '';
   repeat
-    y:=x mod 256;
+    y := x mod 256;
-    x:=x div 256;
+    x := x div 256;
-    result:=char(y)+result;
+    Result := Char(y) + Result;
-  until x=0;
+  until x = 0;
-  if neg
+  if neg then
-    then result[1]:=char(ord(result[1]) or $80);
+    Result[1] := Char(Ord(Result[1]) or $80);
 end;
 
 {==============================================================================}
-{ASNObject}
+
-function ASNObject(Data: string; ASNType: integer): string;
+function ASNObject(const Data: string; ASNType: Integer): string;
 begin
   Result := Char(ASNType) + ASNEncLen(Length(Data)) + Data;
 end;
 
 {==============================================================================}
-{ASNItem}
+
-function ASNItem(var Start: integer; Buffer: string; var ValueType:integer): string;
+function ASNItem(var Start: Integer; const Buffer: string;
+  var ValueType: Integer): string;
 var
-  ASNType: integer;
+  ASNType: Integer;
-  ASNSize: integer;
+  ASNSize: Integer;
-  y,n: integer;
+  y, n: Integer;
   x: byte;
   s: string;
   c: char;
-  neg: boolean;
+  neg: Boolean;
-  l:integer;
+  l: Integer;
 begin
-  Result:='';
+  Result := '';
-  ValueType:=ASN1_NULL;
+  ValueType := ASN1_NULL;
-  l:=length(buffer);
+  l := Length(Buffer);
-  if l<(start+1)
+  if l < (Start + 1) then
-    then exit;
+    Exit;
   ASNType := Ord(Buffer[Start]);
-  Valuetype:=ASNType;
+  ValueType := ASNType;
-  Inc(start);
+  Inc(Start);
   ASNSize := ASNDecLen(Start, Buffer);
-  if (Start+ASNSize-1)>l
+  if (Start + ASNSize - 1) > l then
-    then exit;
+    Exit;
-  if ((ASNType and $20) > 0) then
+  if (ASNType and $20) > 0 then
-  begin
+    Result := '$' + IntToHex(ASNType, 2)
-    Result := '$' + IntToHex(ASNType, 2);
-  end
   else
     case ASNType of
       ASN1_INT:
         begin
           y := 0;
-          neg:=false;
+          neg := False;
           for n := 1 to ASNSize do
           begin
-            x:=Ord(Buffer[Start]);
+            x := Ord(Buffer[Start]);
-            if (n=1) and (x>$7F)
+            if (n = 1) and (x > $7F) then
-              then neg:=true;
+              neg := True;
-            if neg
+            if neg then
-              then x:=not x;
+              x := not x;
             y := y * 256 + x;
             Inc(Start);
           end;
-          if neg
+          if neg then
-            then y:=-(y+1);
+            y := -(y + 1);
           Result := IntToStr(y);
         end;
       ASN1_COUNTER, ASN1_GAUGE, ASN1_TIMETICKS:
@@ -299,101 +298,95 @@ begin
 end;
 
 {==============================================================================}
-{MibToId}
-function MibToId(mib:string):string;
-var
-  x:integer;
 
-  Function walkInt(var s:string):integer;
+function MibToId(Mib: string): string;
+var
+  x: Integer;
+
+  function WalkInt(var s: string): Integer;
   var
-    x:integer;
+    x: Integer;
-    t:string;
+    t: string;
   begin
-    x:=pos('.',s);
+    x := Pos('.', s);
-    if x<1 then
+    if x < 1 then
     begin
-        t:=s;
+      t := s;
-        s:='';
+      s := '';
     end
     else
     begin
-        t:=copy(s,1,x-1);
+      t := Copy(s, 1, x - 1);
-        s:=copy(s,x+1,length(s)-x);
+      s := Copy(s, x + 1, Length(s) - x);
     end;
-    result:=StrToIntDef(t,0);
+    Result := StrToIntDef(t, 0);
   end;
+
 begin
-  result:='';
+  Result := '';
-  x:=walkint(mib);
+  x := WalkInt(Mib);
-  x:=x*40+walkint(mib);
+  x := x * 40 + WalkInt(Mib);
-  result:=ASNEncOIDItem(x);
+  Result := ASNEncOIDItem(x);
-  while mib<>'' do
+  while Mib <> '' do
   begin
-      x:=walkint(mib);
+    x := WalkInt(Mib);
-      result:=result+ASNEncOIDItem(x);
+    Result := Result + ASNEncOIDItem(x);
   end;
 end;
 
 {==============================================================================}
-{IdToMib}
+
-Function IdToMib(id:string):string;
+function IdToMib(const Id: string): string;
 var
-  x,y,n:integer;
+  x, y, n: Integer;
 begin
-  result:='';
+  Result := '';
-  n:=1;
+  n := 1;
-  while length(id)+1>n do
+  while Length(Id) + 1 > n do
   begin
-      x:=ASNDecOIDItem(n,id);
+    x := ASNDecOIDItem(n, Id);
-      if (n-1)=1 then
+    if (n - 1) = 1 then
     begin
-          y:=x div 40;
+      y := x div 40;
-          x:=x mod 40;
+      x := x mod 40;
-          result:=IntTostr(y);
+      Result := IntToStr(y);
     end;
-      result:=result+'.'+IntToStr(x);
+    Result := Result + '.' + IntToStr(x);
   end;
 end;
 
 {==============================================================================}
-{IntMibToStr}
+
-Function IntMibToStr(int:string):string;
+function IntMibToStr(const Value: string): string;
-Var
+var
-  n,y:integer;
+  n, y: Integer;
 begin
-  y:=0;
+  y := 0;
-  for n:=1 to length(int)-1 do
+  for n := 1 to Length(Value) - 1 do
-    y:=y*256+ord(int[n]);
+    y := y * 256 + Ord(Value[n]);
-  result:=IntToStr(y);
+  Result := IntToStr(y);
 end;
 
 {==============================================================================}
-{IPToID} //Hernan Sanchez
+//Hernan Sanchez
+
 function IPToID(Host: string): string;
 var
   s, t: string;
-  i, x: integer;
+  i, x: Integer;
 begin
   Result := '';
-  for x:= 1 to 3 do
+  for x := 1 to 3 do
   begin
     t := '';
     s := StrScan(PChar(Host), '.');
     t := Copy(Host, 1, (Length(Host) - Length(s)));
     Delete(Host, 1, (Length(Host) - Length(s) + 1));
-      i := StrTointDef(t, 0);
+    i := StrToIntDef(t, 0);
     Result := Result + Chr(i);
   end;
-  i := StrTointDef(Host, 0);
+  i := StrToIntDef(Host, 0);
   Result := Result + Chr(i);
 end;
 
-{==============================================================================}
-
-begin
-  exit;
-  asm
-    db 'Synapse ASN.1 library by Lukas Gebauer',0
-  end;
 end.
-

blcksck2.pas

@@ -1,134 +0,0 @@
-{==============================================================================|
-| Project : Delphree - Synapse                                   | 002.000.000 |
-|==============================================================================|
-| Content: Library base for RAW sockets                                        |
-|==============================================================================|
-| 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)2000.                     |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-Remember, this unit work only on Linux or Windows with Winsock2!
- (on Win98 and WinNT 4.0 or higher)
-If you must use this unit on Win95, download Wínsock2 from Microsoft
-and distribute it with your application!
-
-In spite of I use Winsock level version 1.1, RAW sockets work in this level only
-if Winsock2 is installed on your computer!!!
-
-On WinNT standardly RAW sockets work if program is running under user with
-administrators provilegies. To use RAW sockets under another users, you must
-create the following registry variable and set its value to DWORD 1:
-
-HKLM\System\CurrentControlSet\Services\Afd\Parameters\DisableRawSecurity
-
-After you change the registry, you need to restart your computer!
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-}
-
-unit blcksck2;
-
-interface
-
-uses
-  synsock, SysUtils, blcksock,
-{$IFDEF LINUX}
-  libc, kernelioctl;
-{$ELSE}
-  winsock, windows;
-{$ENDIF}
-
-type
-
-{TICMPBlockSocket}
-TICMPBlockSocket = class (TBlockSocket)
-public
-  procedure CreateSocket; override;
-end;
-
-{TRAWBlockSocket}
-TRAWBlockSocket = class (TBlockSocket)
-public
-  procedure CreateSocket; override;
-end;
-
-TIPHeader = Record
-   VerLen : Byte;
-   TOS : Byte;
-   TotalLen : Word;
-   Identifer : Word;
-   FragOffsets : Word;
-   TTL : Byte;
-   Protocol : Byte;
-   CheckSum : Word;
-   SourceIp : Dword;
-   DestIp : Dword;
-   Options : Dword;
- End;
-
-function SetTimeout(Sock:TSocket;Timeout:integer):Boolean;
-
-
-implementation
-
-{======================================================================}
-
-{TICMPBlockSocket.CreateSocket}
-Procedure TICMPBlockSocket.CreateSocket;
-begin
-  FSocket:=synsock.socket(PF_INET,integer(SOCK_RAW),IPPROTO_ICMP);
-  FProtocol:=IPPROTO_ICMP;
-  inherited createSocket;
-end;
-
-
-{======================================================================}
-
-{TRAWBlockSocket.CreateSocket}
-Procedure TRAWBlockSocket.CreateSocket;
-begin
-  FSocket:=synsock.socket(PF_INET,integer(SOCK_RAW),IPPROTO_RAW);
-  FProtocol:=IPPROTO_RAW;
-  inherited createSocket;
-end;
-
-
-{======================================================================}
-
-function SetTimeout(Sock:TSocket;Timeout:integer):Boolean;
-var
-  len,Value,res:integer;
-  r1,r2:Boolean;
-begin
-  Result:=False;
-  r1:=False;
-  r2:=False;
-  Value:=Timeout;
-  len:=SizeOf(Value);
-  Res:=synsock.setsockopt(sock,SOL_SOCKET,SO_RCVTIMEO,@Value,len);
-  r1:=res<>SOCKET_ERROR;
-  Res:=synsock.setsockopt(sock,SOL_SOCKET,SO_SNDTIMEO,@Value,len);
-  r2:=res<>SOCKET_ERROR;
-  Result:=r1 and r2;
-end;
-
-end.

dnssend.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.001.001 |
+| Project : Delphree - Synapse                                   | 001.001.002 |
 |==============================================================================|
 | Content: DNS client                                                          |
 |==============================================================================|
-| The contents of this file are subject to the Mozilla Public License Ver. 1.0 |
+| The contents of this file are subject to the Mozilla Public License Ver. 1.1 |
 | (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/ |
 |                                                                              |
@@ -14,7 +14,7 @@
 | 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)2000.                     |
+| Portions created by Lukas Gebauer are Copyright (c)2000,2001.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -23,350 +23,341 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
-//RFC-1035, RFC-1183, RFC1706, RFC1712, RFC2163, RFC2230
+// RFC-1035, RFC-1183, RFC1706, RFC1712, RFC2163, RFC2230
 
 {$Q-}
+{$WEAKPACKAGEUNIT ON}
 
 unit DNSsend;
 
 interface
+
 uses
-  Blcksock, sysutils, classes, SynaUtil;
+  SysUtils, Classes,
+  blcksock, SynaUtil;
 
 const
-  Qtype_A     =1;
+  cDnsProtocol = 'Domain';
-  Qtype_NS    =2;
-  Qtype_MD    =3;
-  Qtype_MF    =4;
-  Qtype_CNAME =5;
-  Qtype_SOA   =6;
-  Qtype_MB    =7;
-  Qtype_MG    =8;
-  Qtype_MR    =9;
-  Qtype_NULL  =10;
-  Qtype_WKS   =11;  //
-  Qtype_PTR   =12;
-  Qtype_HINFO =13;
-  Qtype_MINFO =14;
-  Qtype_MX    =15;
-  Qtype_TXT   =16;
 
-  Qtype_RP    =17;
+  QTYPE_A = 1;
-  Qtype_AFSDB =18;
+  QTYPE_NS = 2;
-  Qtype_X25   =19;
+  QTYPE_MD = 3;
-  Qtype_ISDN  =20;
+  QTYPE_MF = 4;
-  Qtype_RT    =21;
+  QTYPE_CNAME = 5;
-  Qtype_NSAP  =22;
+  QTYPE_SOA = 6;
-  Qtype_NSAPPTR=23;
+  QTYPE_MB = 7;
-  Qtype_SIG   =24; //RFC-2065
+  QTYPE_MG = 8;
-  Qtype_KEY   =25; //RFC-2065
+  QTYPE_MR = 9;
-  Qtype_PX    =26;
+  QTYPE_NULL = 10;
-  Qtype_GPOS  =27;
+  QTYPE_WKS = 11; //
-  Qtype_AAAA  =28; //IP6 Address                     [Susan Thomson]
+  QTYPE_PTR = 12;
-  Qtype_LOC   =29; //RFC-1876
+  QTYPE_HINFO = 13;
-  Qtype_NXT   =30; //RFC-2065
+  QTYPE_MINFO = 14;
+  QTYPE_MX = 15;
+  QTYPE_TXT = 16;
 
-  Qtype_SRV   =33; //RFC-2052
+  QTYPE_RP = 17;
-  Qtype_NAPTR =35; //RFC-2168
+  QTYPE_AFSDB = 18;
-  Qtype_KX    =36;
+  QTYPE_X25 = 19;
+  QTYPE_ISDN = 20;
+  QTYPE_RT = 21;
+  QTYPE_NSAP = 22;
+  QTYPE_NSAPPTR = 23;
+  QTYPE_SIG = 24; // RFC-2065
+  QTYPE_KEY = 25; // RFC-2065
+  QTYPE_PX = 26;
+  QTYPE_GPOS = 27;
+  QTYPE_AAAA = 28; // IP6 Address  [Susan Thomson]
+  QTYPE_LOC = 29; // RFC-1876
+  QTYPE_NXT = 30; // RFC-2065
 
-  Qtype_AXFR  =252; //
+  QTYPE_SRV = 33; // RFC-2052
-  Qtype_MAILB =253; //
+  QTYPE_NAPTR = 35; // RFC-2168
-  Qtype_MAILA =254; //
+  QTYPE_KX = 36;
-  Qtype_ALL   =255; //
+
+  QTYPE_AXFR = 252; //
+  QTYPE_MAILB = 253; //
+  QTYPE_MAILA = 254; //
+  QTYPE_ALL = 255; //
 
 type
-  TDNSSend = class
+  TDNSSend = class(TObject)
   private
-    Buffer:string;
+    FTimeout: Integer;
-    Sock:TUDPBlockSocket;
+    FDNSHost: string;
-    function CompressName(Value:string):string;
+    FRCode: Integer;
-    function CodeHeader:string;
+    FBuffer: string;
-    function CodeQuery(Name:string; Qtype:integer):string;
+    FSock: TUDPBlockSocket;
-    function DecodeLabels(var From:integer):string;
+    function CompressName(const Value: string): string;
-    function DecodeResource(var i:integer; Name:string; Qtype:integer):string;
+    function CodeHeader: string;
+    function CodeQuery(const Name: string; QType: Integer): string;
+    function DecodeLabels(var From: Integer): string;
+    function DecodeResource(var i: Integer; const Name: string;
+      QType: Integer): string;
   public
-    timeout:integer;
+    constructor Create;
-    DNSHost:string;
+    destructor Destroy; override;
-    RCode:integer;
+    function DNSQuery(Name: string; QType: Integer;
-    Constructor Create;
+      const Reply: TStrings): Boolean;
-    Destructor Destroy; override;
+  published
-    Function DNSQuery(Name:string;Qtype:integer;Reply:TStrings):Boolean;
+    property Timeout: Integer read FTimeout Write FTimeout;
+    property DNSHost: string read FDNSHost Write FDNSHost;
+    property RCode: Integer read FRCode;
   end;
 
-function GetMailServers (DNSHost, domain:string; servers:TStringList):Boolean;
+function GetMailServers(const DNSHost, Domain: string;
+  const Servers: TStrings): Boolean;
 
 implementation
 
-{TDNSSend.Create}
+constructor TDNSSend.Create;
-Constructor TDNSSend.Create;
 begin
   inherited Create;
-  sock:=TUDPBlockSocket.create;
+  FSock := TUDPBlockSocket.Create;
-  sock.CreateSocket;
+  FSock.CreateSocket;
-  timeout:=5000;
+  FTimeout := 5000;
-  DNShost:='localhost';
+  FDNSHost := cLocalhost;
 end;
 
-{TDNSSend.Destroy}
+destructor TDNSSend.Destroy;
-Destructor TDNSSend.Destroy;
 begin
-  Sock.free;
+  FSock.Free;
-  inherited destroy;
+  inherited Destroy;
 end;
 
-{TDNSSend.ComressName}
+function TDNSSend.CompressName(const Value: string): string;
-function TDNSSend.CompressName(Value:string):string;
 var
-  n:integer;
+  n: Integer;
-  s:String;
+  s: string;
 begin
-  Result:='';
+  Result := '';
-  if Value='' then Result:=char(0)
+  if Value = '' then
+    Result := #0
   else
   begin
-        s:='';
+    s := '';
-        for n:=1 to Length(Value) do
+    for n := 1 to Length(Value) do
-          if Value[n]='.' then
+      if Value[n] = '.' then
       begin
-              Result:=Result+char(Length(s))+s;
+        Result := Result + Char(Length(s)) + s;
-              s:='';
+        s := '';
       end
-            else s:=s+Value[n];
+      else
-        if s<>'' then Result:=Result+char(Length(s))+s;
+        s := s + Value[n];
-        Result:=Result+char(0);
+    if s <> '' then
+      Result := Result + Char(Length(s)) + s;
+    Result := Result + #0;
   end;
 end;
 
-{TDNSSend.CodeHeader}
+function TDNSSend.CodeHeader: string;
-function TDNSSend.CodeHeader:string;
 begin
   Randomize;
-  Result:=Codeint(Random(32767)); //ID
+  Result := CodeInt(Random(32767)); // ID
-  Result:=Result+Codeint($0100);  //flags
+  Result := Result + CodeInt($0100); // flags
-  Result:=Result+Codeint(1);   //QDCount
+  Result := Result + CodeInt(1); // QDCount
-  Result:=Result+Codeint(0);   //ANCount
+  Result := Result + CodeInt(0); // ANCount
-  Result:=Result+Codeint(0);   //NSCount
+  Result := Result + CodeInt(0); // NSCount
-  Result:=Result+Codeint(0);   //ARCount
+  Result := Result + CodeInt(0); // ARCount
 end;
 
-{TDNSSend.CodeQuery}
+function TDNSSend.CodeQuery(const Name: string; QType: Integer): string;
-function TDNSSend.CodeQuery(Name:string; Qtype:integer):string;
 begin
-  Result:=Compressname(Name);
+  Result := CompressName(Name);
-  Result:=Result+Codeint(Qtype);
+  Result := Result + CodeInt(QType);
-  Result:=Result+Codeint(1); //Type INTERNET
+  Result := Result + CodeInt(1); // Type INTERNET
 end;
 
-{TDNSSend.DecodeLabels}
+function TDNSSend.DecodeLabels(var From: Integer): string;
-function TDNSSend.DecodeLabels(var From:integer):string;
 var
-  l,f:integer;
+  l, f: Integer;
 begin
-  Result:='';
+  Result := '';
   while True do
   begin
-      l:=Ord(Buffer[From]);
+    l := Ord(FBuffer[From]);
     Inc(From);
-      if l=0 then break;
+    if l = 0 then
-      if Result<>'' then Result:=Result+'.';
+      Break;
-      if (l and $C0)=$C0
+    if Result <> '' then
-      then
+      Result := Result + '.';
+    if (l and $C0) = $C0 then
     begin
-          f:=l and $3F;
+      f := l and $3F;
-          f:=f*256+Ord(Buffer[From])+1;
+      f := f * 256 + Ord(FBuffer[From]) + 1;
       Inc(From);
-          Result:=Result+Self.decodelabels(f);
+      Result := Result + DecodeLabels(f);
-          break;
+      Break;
     end
     else
     begin
-          Result:=Result+Copy(Buffer,From,l);
+      Result := Result + Copy(FBuffer, From, l);
-          Inc(From,l);
+      Inc(From, l);
     end;
   end;
 end;
 
-{TDNSSend.DecodeResource}
+function TDNSSend.DecodeResource(var i: Integer; const Name: string;
-function TDNSSend.DecodeResource(var i:integer; Name:string;
+  QType: Integer): string;
-Qtype:integer):string;
 var
-  Rname:string;
+  Rname: string;
-  RType,Len,j,x,n:integer;
+  RType, Len, j, x, n: Integer;
 begin
-  Result:='';
+  Result := '';
-  Rname:=decodelabels(i);
+  Rname := DecodeLabels(i);
-  Rtype:=DeCodeint(Buffer,i);
+  RType := DecodeInt(FBuffer, i);
-  Inc(i,8);
+  Inc(i, 8);
-  Len:=DeCodeint(Buffer,i);
+  Len := DecodeInt(FBuffer, i);
-  Inc(i,2);   //i point to begin of data
+  Inc(i, 2); // i point to begin of data
-  j:=i;
+  j := i;
-  i:=i+len;   //i point to next record
+  i := i + len; // i point to next record
-  if (Name=Rname) and (Qtype=RType) then
+  if (Name = Rname) and (QType = RType) then
   begin
-      case Rtype of
+    case RType of
-        Qtype_A     :
+      QTYPE_A:
         begin
-                        Result:=IntToStr(Ord(Buffer[j]));
+          Result := IntToStr(Ord(FBuffer[j]));
           Inc(j);
-                        Result:=Result+'.'+IntToStr(Ord(Buffer[j]));
+          Result := Result + '.' + IntToStr(Ord(FBuffer[j]));
           Inc(j);
-                        Result:=Result+'.'+IntToStr(Ord(Buffer[j]));
+          Result := Result + '.' + IntToStr(Ord(FBuffer[j]));
           Inc(j);
-                        Result:=Result+'.'+IntToStr(Ord(Buffer[j]));
+          Result := Result + '.' + IntToStr(Ord(FBuffer[j]));
         end;
-        Qtype_NS,
+      QTYPE_NS, QTYPE_MD, QTYPE_MF, QTYPE_CNAME, QTYPE_MB,
-        Qtype_MD,
+        QTYPE_MG, QTYPE_MR, QTYPE_PTR, QTYPE_X25, QTYPE_NSAP,
-        Qtype_MF,
+        QTYPE_NSAPPTR:
-        Qtype_CNAME,
+        Result := DecodeLabels(j);
-        Qtype_MB,
+      QTYPE_SOA:
-        Qtype_MG,
-        Qtype_MR,
-        Qtype_PTR,
-        Qtype_X25,
-        Qtype_NSAP,
-        Qtype_NSAPPTR:
         begin
-                        Result:=Decodelabels(j);
+          Result := DecodeLabels(j);
-                      end;
+          Result := Result + ',' + DecodeLabels(j);
-        Qtype_SOA   :
+          for n := 1 to 5 do
           begin
-                        Result:=Decodelabels(j);
+            x := DecodeInt(FBuffer, j) * 65536 + DecodeInt(FBuffer, j + 2);
-                        Result:=Result+','+Decodelabels(j);
+            Inc(j, 4);
-                        for n:=1 to 5 do
+            Result := Result + ',' + IntToStr(x);
-                          begin
-                            x:=DecodeInt(Buffer,j)*65536+DecodeInt(Buffer,j+2);
-                            Inc(j,4);
-                            Result:=Result+','+IntToStr(x);
           end;
         end;
-        Qtype_NULL  :
+      QTYPE_NULL:
         begin
         end;
-        Qtype_WKS   :
+      QTYPE_WKS:
         begin
         end;
-        Qtype_HINFO,
+      QTYPE_HINFO, QTYPE_MINFO, QTYPE_RP, QTYPE_ISDN:
-        Qtype_MINFO,
-        Qtype_RP,
-        Qtype_ISDN  :
         begin
-                        Result:=Decodelabels(j);
+          Result := DecodeLabels(j);
-                        Result:=Result+','+Decodelabels(j);
+          Result := Result + ',' + DecodeLabels(j);
         end;
-        Qtype_MX,
+      QTYPE_MX, QTYPE_AFSDB, QTYPE_RT, QTYPE_KX:
-        Qtype_AFSDB,
-        Qtype_RT,
-        Qtype_KX    :
         begin
-                        x:=DecodeInt(Buffer,j);
+          x := DecodeInt(FBuffer, j);
-                        Inc(j,2);
+          Inc(j, 2);
-                        Result:=IntToStr(x);
+          Result := IntToStr(x);
-                        Result:=Result+','+Decodelabels(j);
+          Result := Result + ',' + DecodeLabels(j);
         end;
-        Qtype_TXT   :
+      QTYPE_TXT:
+        Result := DecodeLabels(j);
+      QTYPE_GPOS:
         begin
-                        Result:=Decodelabels(j);
+          Result := DecodeLabels(j);
+          Result := Result + ',' + DecodeLabels(j);
+          Result := Result + ',' + DecodeLabels(j);
         end;
-        Qtype_GPOS  :
+      QTYPE_PX:
         begin
-                        Result:=Decodelabels(j);
+          x := DecodeInt(FBuffer, j);
-                        Result:=Result+','+Decodelabels(j);
+          Inc(j, 2);
-                        Result:=Result+','+Decodelabels(j);
+          Result := IntToStr(x);
-                      end;
+          Result := Result + ',' + DecodeLabels(j);
-        Qtype_PX    :
+          Result := Result + ',' + DecodeLabels(j);
-                      begin
-                        x:=DecodeInt(Buffer,j);
-                        Inc(j,2);
-                        Result:=IntToStr(x);
-                        Result:=Result+','+Decodelabels(j);
-                        Result:=Result+','+Decodelabels(j);
         end;
     end;
   end;
 end;
 
-{TDNSSend.DNSQuery}
+function TDNSSend.DNSQuery(Name: string; QType: Integer;
-Function TDNSSend.DNSQuery(Name:string;Qtype:integer;Reply:TStrings):Boolean;
+  const Reply: TStrings): Boolean;
 var
-  x,n,i:integer;
+  x, n, i: Integer;
-  flag,qdcount, ancount, nscount, arcount:integer;
+  flag, qdcount, ancount, nscount, arcount: Integer;
-  s:string;
+  s: string;
 begin
-  Result:=False;
+  Result := False;
   Reply.Clear;
-  if IsIP(Name) then Name:=ReverseIP(Name)+'.in-addr.arpa';
+  if IsIP(Name) then
-  Buffer:=Codeheader+CodeQuery(Name,QType);
+    Name := ReverseIP(Name) + '.in-addr.arpa';
-  sock.connect(DNSHost,'domain');
+  FBuffer := CodeHeader + CodeQuery(Name, QType);
-//  dump(Buffer,'c:\dnslog.Txt');
+  FSock.Connect(FDNSHost, cDnsProtocol);
-  sock.sendstring(Buffer);
+  FSock.SendString(FBuffer);
-  if sock.canread(timeout)
+  if FSock.CanRead(FTimeout) then
-    then begin
-      x:=sock.waitingdata;
-      setlength(Buffer,x);
-      sock.recvbuffer(Pointer(Buffer),x);
-//      dump(Buffer,'c:\dnslogr.Txt');
-      flag:=DeCodeint(Buffer,3);
-      RCode:=Flag and $000F;
-      if RCode=0 then
   begin
-          qdcount:=DeCodeint(Buffer,5);
+    x := FSock.WaitingData;
-          ancount:=DeCodeint(Buffer,7);
+    SetLength(FBuffer, x);
-          nscount:=DeCodeint(Buffer,9);
+    FSock.RecvBuffer(Pointer(FBuffer), x);
-          arcount:=DeCodeint(Buffer,11);
+    flag := DecodeInt(FBuffer, 3);
-          i:=13;    //begin of body
+    FRCode := Flag and $000F;
-          if qdcount>0 then   //skip questions
+    if FRCode = 0 then
-            for n:=1 to qdcount do
     begin
-                while (Buffer[i]<>#0) and ((Ord(Buffer[i]) and $C0)<>$C0) do
+      qdcount := DecodeInt(FBuffer, 5);
+      ancount := DecodeInt(FBuffer, 7);
+      nscount := DecodeInt(FBuffer, 9);
+      arcount := DecodeInt(FBuffer, 11);
+      i := 13; //begin of body
+      if qdcount > 0 then //skip questions
+        for n := 1 to qdcount do
+        begin
+          while (FBuffer[i] <> #0) and ((Ord(FBuffer[i]) and $C0) <> $C0) do
             Inc(i);
-                Inc(i,5);
+          Inc(i, 5);
         end;
-          if ancount>0 then
+      if ancount > 0 then
-            for n:=1 to ancount do
+        for n := 1 to ancount do
         begin
-                s:=DecodeResource(i, Name, Qtype);
+          s := DecodeResource(i, Name, QType);
-                if s<>'' then
+          if s <> '' then
             Reply.Add(s);
         end;
-          Result:=True;
+      Result := True;
     end;
   end;
 end;
 
 {==============================================================================}
 
-function GetMailServers (DNSHost, domain:string; servers:TStringList):Boolean;
+function GetMailServers(const DNSHost, Domain: string;
+  const Servers: TStrings): Boolean;
 var
-  DNS:TDNSSend;
+  DNS: TDNSSend;
-  t:TStringList;
+  t: TStringList;
-  n,m,x:integer;
+  n, m, x: Integer;
 begin
-  Result:=False;
+  Result := False;
-  servers.Clear;
+  Servers.Clear;
-  t:=TStringList.Create;
+  t := TStringList.Create;
-  DNS:=TDNSSend.Create;
+  DNS := TDNSSend.Create;
   try
-    DNS.DNSHost:=DNSHost;
+    DNS.DNSHost := DNSHost;
-    if DNS.DNSQuery(domain,QType_MX,t) then
+    if DNS.DNSQuery(Domain, QType_MX, t) then
     begin
-        {normalize preference number to 5 digits}
+      { normalize preference number to 5 digits }
-        for n:=0 to t.Count-1 do
+      for n := 0 to t.Count - 1 do
       begin
-            x:=Pos(',',t[n]);
+        x := Pos(',', t[n]);
-            if x>0 then
+        if x > 0 then
-              for m:=1 to 6-x do
+          for m := 1 to 6 - x do
-                t[n]:='0'+t[n];
+            t[n] := '0' + t[n];
       end;
-        {sort server list}
+      { sort server list }
-        t.Sorted:=True;
+      t.Sorted := True;
-        {result is sorted list without preference numbers}
+      { result is sorted list without preference numbers }
-        for n:=0 to t.Count-1 do
+      for n := 0 to t.Count - 1 do
       begin
-            x:=Pos(',',t[n]);
+        x := Pos(',', t[n]);
-            servers.Add(Copy(t[n],x+1,Length(t[n])-x));
+        Servers.Add(Copy(t[n], x + 1, Length(t[n]) - x));
       end;
-        Result:=True;
+      Result := True;
     end;
   finally
     DNS.Free;
@@ -375,5 +366,3 @@ begin
 end;
 
 end.
-
-

httpsend.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.001.000 |
+| Project : Delphree - Synapse                                   | 002.001.001 |
 |==============================================================================|
 | Content: HTTP client                                                         |
 |==============================================================================|
-| The contents of this file are subject to the Mozilla Public License Ver. 1.0 |
+| The contents of this file are subject to the Mozilla Public License Ver. 1.1 |
 | (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/ |
 |                                                                              |
@@ -23,423 +23,432 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
+{$WEAKPACKAGEUNIT ON}
+
 unit HTTPSend;
 
 interface
+
 uses
-  Blcksock, sysutils, classes, SynaUtil, SynaCode;
+  SysUtils, Classes,
+  blcksock, SynaUtil, SynaCode;
 
 const
-  CRLF=#13+#10;
+  cHttpProtocol = '80';
 
 type
-  TTransferEncoding=(TE_UNKNOWN,
+  TTransferEncoding = (TE_UNKNOWN, TE_IDENTITY, TE_CHUNKED);
-                     TE_IDENTITY,
-                     TE_CHUNKED);
 
-  THTTPSend = class
+  THTTPSend = class(TObject)
   private
-    Sock:TTCPBlockSocket;
+    FSock: TTCPBlockSocket;
-    TransferEncoding:TTransferEncoding;
+    FTransferEncoding: TTransferEncoding;
-    AliveHost:string;
+    FAliveHost: string;
-    AlivePort:string;
+    FAlivePort: string;
-    function ReadUnknown:boolean;
+    FHeaders: TStringList;
-    function ReadIdentity(size:integer):boolean;
+    FDocument: TMemoryStream;
-    function ReadChunked:boolean;
+    FMimeType: string;
+    FProtocol: string;
+    FKeepAlive: Boolean;
+    FTimeout: Integer;
+    FHTTPHost: string;
+    FHTTPPort: string;
+    FProxyHost: string;
+    FProxyPort: string;
+    FProxyUser: string;
+    FProxyPass: string;
+    FResultCode: Integer;
+    FResultString: string;
+    function ReadUnknown: Boolean;
+    function ReadIdentity(Size: Integer): Boolean;
+    function ReadChunked: Boolean;
   public
-    headers:TStringlist;
+    constructor Create;
-    Document:TMemoryStream;
+    destructor Destroy; override;
-    MimeType:string;
+    procedure Clear;
-    Protocol:string;
+    procedure DecodeStatus(const Value: string);
-    KeepAlive:boolean;
+    function HTTPMethod(const Method, URL: string): Boolean;
-    Timeout:integer;
+  published
-    HTTPHost:string;
+    property Headers: TStringList read FHeaders Write FHeaders;
-    HTTPPort:string;
+    property Document: TMemoryStream read FDocument Write FDocument;
-    ProxyHost:string;
+    property MimeType: string read FMimeType Write FMimeType;
-    ProxyPort:string;
+    property Protocol: string read FProtocol Write FProtocol;
-    ProxyUser:string;
+    property KeepAlive: Boolean read FKeepAlive Write FKeepAlive;
-    ProxyPass:string;
+    property Timeout: Integer read FTimeout Write FTimeout;
-    ResultCode:integer;
+    property HTTPHost: string read FHTTPHost;
-    ResultString:string;
+    property HTTPPort: string read FHTTPPort;
-    Constructor Create;
+    property ProxyHost: string read FProxyHost Write FProxyHost;
-    Destructor Destroy; override;
+    property ProxyPort: string read FProxyPort Write FProxyPort;
-    procedure clear;
+    property ProxyUser: string read FProxyUser Write FProxyUser;
-    procedure DecodeStatus(value:string);
+    property ProxyPass: string read FProxyPass Write FProxyPass;
-    function HTTPmethod(method,URL:string):boolean;
+    property ResultCode: Integer read FResultCode;
+    property ResultString: string read FResultString;
   end;
 
-function HttpGetText(URL:string;Response:TStrings):Boolean;
+function HttpGetText(const URL: string; const Response: TStrings): Boolean;
-function HttpGetBinary(URL:string;Response:TStream):Boolean;
+function HttpGetBinary(const URL: string; const Response: TStream): Boolean;
-function HttpPostBinary(URL:string;Data:TStream):Boolean;
+function HttpPostBinary(const URL: string; const Data: TStream): Boolean;
-function HttpPostURL(URL:string;URLData:string;Data:TStream):Boolean;
+function HttpPostURL(const URL, URLData: string; const Data: TStream): Boolean;
 
 implementation
 
-{THTTPSend.Create}
+const
-Constructor THTTPSend.Create;
+  CRLF = #13#10;
+
+constructor THTTPSend.Create;
 begin
   inherited Create;
-  Headers:=TStringList.create;
+  FHeaders := TStringList.Create;
-  Document:=TMemoryStream.Create;
+  FDocument := TMemoryStream.Create;
-  sock:=TTCPBlockSocket.create;
+  FSock := TTCPBlockSocket.Create;
-  sock.SizeRecvBuffer:=65536;
+  FSock.SizeRecvBuffer := 65536;
-  sock.SizeSendBuffer:=65536;
+  FSock.SizeSendBuffer := 65536;
-  timeout:=300000;
+  FTimeout := 300000;
-  HTTPhost:='localhost';
+  FHTTPHost := cLocalhost;
-  HTTPPort:='80';
+  FHTTPPort := cHttpProtocol;
-  ProxyHost:='';
+  FProxyHost := '';
-  ProxyPort:='8080';
+  FProxyPort := '8080';
-  ProxyUser:='';
+  FProxyUser := '';
-  ProxyPass:='';
+  FProxyPass := '';
-  AliveHost:='';
+  FAliveHost := '';
-  AlivePort:='';
+  FAlivePort := '';
-  Protocol:='1.1';
+  FProtocol := '1.1';
-  KeepAlive:=true;
+  FKeepAlive := True;
   Clear;
 end;
 
-{THTTPSend.Destroy}
+destructor THTTPSend.Destroy;
-Destructor THTTPSend.Destroy;
 begin
-  Sock.free;
+  FSock.Free;
-  Document.free;
+  FDocument.Free;
-  headers.free;
+  FHeaders.Free;
-  inherited destroy;
+  inherited Destroy;
 end;
 
-{THTTPSend.Clear}
 procedure THTTPSend.Clear;
 begin
-  Document.Clear;
+  FDocument.Clear;
-  Headers.Clear;
+  FHeaders.Clear;
-  MimeType:='text/html';
+  FMimeType := 'text/html';
 end;
 
-{THTTPSend.DecodeStatus}
+procedure THTTPSend.DecodeStatus(const Value: string);
-procedure THTTPSend.DecodeStatus(value:string);
 var
-  s,su:string;
+  s, su: string;
 begin
-  s:=separateright(value,' ');
+  s := SeparateRight(Value, ' ');
-  su:=separateleft(s,' ');
+  su := SeparateLeft(s, ' ');
-  ResultCode:=StrToIntDef(su,0);
+  FResultCode := StrToIntDef(su, 0);
-  ResultString:=separateright(s,' ');
+  FResultString := SeparateRight(s, ' ');
-  if ResultString=s
+  if FResultString = s then
-    then ResultString:='';
+    FResultString := '';
 end;
 
-{THTTPSend.HTTPmethod}
+function THTTPSend.HTTPMethod(const Method, URL: string): Boolean;
-function THTTPSend.HTTPmethod(method,URL:string):boolean;
 var
-  sending,receiving:boolean;
+  Sending, Receiving: Boolean;
-  status100:boolean;
+  status100: Boolean;
-  status100error:string;
+  status100error: string;
-  ToClose:boolean;
+  ToClose: Boolean;
-  size:integer;
+  Size: Integer;
-  Prot,User,Pass,Host,Port,Path,Para,URI:string;
+  Prot, User, Pass, Host, Port, Path, Para, URI: string;
-  n:integer;
+  n: Integer;
-  s,su:string;
+  s, su: string;
 begin
   {initial values}
-  result:=false;
+  Result := False;
-  ResultCode:=500;
+  FResultCode := 500;
-  ResultString:='';
+  FResultString := '';
 
-  URI:=ParseURL(URL,Prot,User,Pass,Host,Port,Path,Para);
+  URI := ParseURL(URL, Prot, User, Pass, Host, Port, Path, Para);
-  sending:=Document.Size>0;
+  Sending := Document.Size > 0;
-  {headers for sending data}
+  {Headers for Sending data}
-  status100:=sending and (protocol='1.1');
+  status100 := Sending and (FProtocol = '1.1');
-  if status100
+  if status100 then
-    then Headers.insert(0,'Expect: 100-continue');
+    FHeaders.Insert(0, 'Expect: 100-continue');
-  if sending then
+  if Sending then
   begin
-      Headers.insert(0,'Content-Length: '+inttostr(Document.size));
+    FHeaders.Insert(0, 'Content-Length: ' + IntToStr(FDocument.Size));
-      if MimeType<>''
+    if FMimeType <> '' then
-        then Headers.insert(0,'Content-Type: '+MimeType);
+      FHeaders.Insert(0, 'Content-Type: ' + FMimeType);
   end;
-  {seting KeepAlives}
+  { setting KeepAlives }
-  if not KeepAlive
+  if not FKeepAlive then
-    then Headers.insert(0,'Connection: close');
+    FHeaders.Insert(0, 'Connection: close');
-  {set target servers/proxy, authorisations, etc...}
+  { set target servers/proxy, authorisations, etc... }
-  if User<>''
+  if User <> '' then
-    then Headers.insert(0,'Authorization: Basic '+EncodeBase64(user+':'+pass));
+    FHeaders.Insert(0, 'Authorization: Basic ' + EncodeBase64(user + ':' + pass));
-  if (proxyhost<>'') and (proxyUser<>'')
+  if (FProxyHost <> '') and (FProxyUser <> '') then
-    then Headers.insert(0,'Proxy-Authorization: Basic '+EncodeBase64(Proxyuser+':'+Proxypass));
+    FHeaders.Insert(0, 'Proxy-Authorization: Basic ' +
-  Headers.insert(0,'Host: '+host+':'+port);
+      EncodeBase64(FProxyUser + ':' + FProxyPass));
-  if proxyHost<>''
+  FHeaders.Insert(0, 'Host: ' + Host + ':' + Port);
-    then URI:=prot+'://'+host+':'+port+URI;
+  if FProxyHost <> '' then
-  if URI='/*'
+    URI := Prot + '://' + Host + ':' + Port + URI;
-    then URI:='*';
+  if URI = '/*' then
-  if protocol='0.9'
+    URI := '*';
-    then Headers.insert(0,uppercase(method)+' '+URI)
+  if FProtocol = '0.9' then
-    else Headers.insert(0,uppercase(method)+' '+URI+' HTTP/'+protocol);
+    FHeaders.Insert(0, UpperCase(Method) + ' ' + URI)
-  if proxyhost=''
+  else
-    then
+    FHeaders.Insert(0, UpperCase(Method) + ' ' + URI + ' HTTP/' + FProtocol);
+  if FProxyHost = '' then
   begin
-        HttpHost:=host;
+    FHTTPHost := Host;
-        HttpPort:=port;
+    FHTTPPort := Port;
   end
   else
   begin
-        HttpHost:=Proxyhost;
+    FHTTPHost := FProxyHost;
-        HttpPort:=Proxyport;
+    FHTTPPort := FProxyPort;
   end;
-  if headers[headers.count-1]<>''
+  if FHeaders[FHeaders.Count - 1] <> '' then
-    then headers.add('');
+    FHeaders.Add('');
 
-  {connect}
+  { connect }
-  if (Alivehost<>HTTPhost) or (AlivePort<>HTTPport)
+  if (FAliveHost <> FHTTPHost) or (FAlivePort <> FHTTPPort) then
-    then
   begin
-        sock.CloseSocket;
+    FSock.CloseSocket;
-        sock.CreateSocket;
+    FSock.CreateSocket;
-        sock.Connect(HTTPHost,HTTPPort);
+    FSock.Connect(FHTTPHost, FHTTPPort);
-        if sock.lasterror<>0 then Exit;
+    if FSock.LastError <> 0 then
-        Alivehost:=HTTPhost;
+      Exit;
-        AlivePort:=HTTPport;
+    FAliveHost := FHTTPHost;
+    FAlivePort := FHTTPPort;
   end
   else
   begin
-        if sock.canread(0) then
+    if FSock.CanRead(0) then
     begin
-            sock.CloseSocket;
+      FSock.CloseSocket;
-            sock.createsocket;
+      FSock.CreateSocket;
-            sock.Connect(HTTPHost,HTTPPort);
+      FSock.Connect(FHTTPHost, FHTTPPort);
-            if sock.lasterror<>0 then Exit;
+      if FSock.LastError <> 0 then
+        Exit;
     end;
   end;
 
-  {send headers}
+  { send Headers }
-  Sock.SendString(Headers[0]+CRLF);
+  FSock.SendString(Headers[0] + CRLF);
-  if protocol<>'0.9' then
+  if FProtocol <> '0.9' then
-    for n:=1 to Headers.Count-1 do
+    for n := 1 to FHeaders.Count - 1 do
-      Sock.SendString(Headers[n]+CRLF);
+      FSock.SendString(FHeaders[n] + CRLF);
-  if sock.lasterror<>0 then Exit;
+  if FSock.LastError <> 0 then
+    Exit;
 
-  {reading Status}
+  { reading Status }
-  Status100Error:='';
+  Status100Error := '';
   if status100 then
   begin
     repeat
-        s:=sock.recvstring(timeout);
+      s := FSock.RecvString(FTimeout);
-        if s<>'' then break;
+      if s <> '' then
-      until sock.lasterror<>0;
+        Break;
+    until FSock.LastError <> 0;
     DecodeStatus(s);
-      if (ResultCode>=100) and (ResultCode<200)
+    if (FResultCode >= 100) and (FResultCode < 200) then
-        then
+      repeat
+        s := FSock.recvstring(FTimeout);
+        if s = '' then
+          Break;
+      until FSock.LastError <> 0
+    else
+    begin
+      Sending := False;
+      Status100Error := s;
+    end;
+  end;
+
+  { send document }
+  if Sending then
+  begin
+    FSock.SendBuffer(FDocument.Memory, FDocument.Size);
+    if FSock.LastError <> 0 then
+      Exit;
+  end;
+
+  Clear;
+  Size := -1;
+  FTransferEncoding := TE_UNKNOWN;
+
+  { read status }
+  if Status100Error = '' then
   begin
     repeat
-              s:=sock.recvstring(timeout);
+      s := FSock.RecvString(FTimeout);
-              if s='' then break;
+      if s <> '' then
-            until sock.lasterror<>0;
+        Break;
+    until FSock.LastError <> 0;
+    if Pos('HTTP/', UpperCase(s)) = 1 then
+    begin
+      FHeaders.Add(s);
+      DecodeStatus(s);
     end
     else
     begin
-           sending:=false;
+      { old HTTP 0.9 and some buggy servers not send result }
-           Status100Error:=s;
+      s := s + CRLF;
+      FDocument.Write(Pointer(s)^, Length(s));
+      FResultCode := 0;
     end;
-    end;
-
-  {send document}
-  if sending then
-    begin
-      Sock.SendBuffer(Document.memory,Document.size);
-      if sock.lasterror<>0 then Exit;
-    end;
-
-  clear;
-  size:=-1;
-  TransferEncoding:=TE_UNKNOWN;
-
-  {read status}
-  If Status100Error=''
-    then
-      begin
-        repeat
-          s:=sock.recvstring(timeout);
-          if s<>'' then break;
-        until sock.lasterror<>0;
-        if pos('HTTP/',uppercase(s))=1
-          then
-            begin
-              Headers.add(s);
-              decodeStatus(s);
   end
   else
-            begin
+    FHeaders.Add(Status100Error);
-              {old HTTP 0.9 and some buggy servers not send result}
-              s:=s+CRLF;
-              document.Write(pointer(s)^,length(s));
-              ResultCode:=0;
-            end;
-      end
-    else Headers.add(Status100Error);
 
-  {if need receive hedaers, receive and parse it}
+  { if need receive hedaers, receive and parse it }
-  ToClose:=protocol<>'1.1';
+  ToClose := FProtocol <> '1.1';
-  if Headers.count>0 then
+  if FHeaders.Count > 0 then
     repeat
-      s:=sock.recvstring(timeout);
+      s := FSock.RecvString(FTimeout);
-      Headers.Add(s);
+      FHeaders.Add(s);
-      if s=''
+      if s = '' then
-        then break;
+        Break;
-      su:=uppercase(s);
+      su := UpperCase(s);
-      if pos('CONTENT-LENGTH:',su)=1 then
+      if Pos('CONTENT-LENGTH:', su) = 1 then
       begin
-          size:=strtointdef(separateright(s,' '),-1);
+        Size := StrToIntDef(SeparateRight(s, ' '), -1);
-          TransferEncoding:=TE_IDENTITY;
+        FTransferEncoding := TE_IDENTITY;
       end;
-      if pos('CONTENT-TYPE:',su)=1 then
+      if Pos('CONTENT-TYPE:', su) = 1 then
-        MimeType:=separateright(s,' ');
+        FMimeType := SeparateRight(s, ' ');
-      if pos('TRANSFER-ENCODING:',su)=1 then
+      if Pos('TRANSFER-ENCODING:', su) = 1 then
       begin
-          s:=separateright(su,' ');
+        s := SeparateRight(su, ' ');
-          if pos('CHUNKED',s)>0 then
+        if Pos('CHUNKED', s) > 0 then
-            TransferEncoding:=TE_CHUNKED;
+          FTransferEncoding := TE_CHUNKED;
       end;
-      if pos('CONNECTION: CLOSE',su)=1 then
+      if Pos('CONNECTION: CLOSE', su) = 1 then
-        ToClose:=true;
+        ToClose := True;
-    until sock.lasterror<>0;
+    until FSock.LastError <> 0;
 
   {if need receive response body, read it}
-  Receiving:=Method<>'HEAD';
+  Receiving := Method <> 'HEAD';
-  Receiving:=Receiving and (ResultCode<>204);
+  Receiving := Receiving and (FResultCode <> 204);
-  Receiving:=Receiving and (ResultCode<>304);
+  Receiving := Receiving and (FResultCode <> 304);
   if Receiving then
-    case TransferEncoding of
+    case FTransferEncoding of
-      TE_UNKNOWN : readunknown;
+      TE_UNKNOWN:
-      TE_IDENTITY: readidentity(size);
+        ReadUnknown;
-      TE_CHUNKED : readChunked;
+      TE_IDENTITY:
+        ReadIdentity(Size);
+      TE_CHUNKED:
+        ReadChunked;
     end;
 
-  Document.Seek(0,soFromBeginning);
+  FDocument.Seek(0, soFromBeginning);
-  result:=true;
+  Result := True;
   if ToClose then
   begin
-      sock.closesocket;
+    FSock.CloseSocket;
-      Alivehost:='';
+    FAliveHost := '';
-      AlivePort:='';
+    FAlivePort := '';
   end;
 end;
 
-{THTTPSend.ReadUnknown}
+function THTTPSend.ReadUnknown: Boolean;
-function THTTPSend.ReadUnknown:boolean;
 var
-  s:string;
+  s: string;
 begin
-  result:=false;
   repeat
-    s:=sock.recvstring(timeout);
+    s := FSock.RecvString(FTimeout);
-    s:=s+CRLF;
+    s := s + CRLF;
-    document.Write(pointer(s)^,length(s));
+    FDocument.Write(Pointer(s)^, Length(s));
-  until sock.lasterror<>0;
+  until FSock.LastError <> 0;
-  result:=true;
+  Result := True;
 end;
 
-{THTTPSend.ReadIdentity}
+function THTTPSend.ReadIdentity(Size: Integer): Boolean;
-function THTTPSend.ReadIdentity(size:integer):boolean;
 var
-  mem:TMemoryStream;
+  mem: TMemoryStream;
 begin
-  mem:=TMemoryStream.create;
+  mem := TMemoryStream.Create;
   try
-    mem.SetSize(size);
+    mem.SetSize(Size);
-    sock.RecvBufferEx(mem.memory,size,timeout);
+    FSock.RecvBufferEx(mem.Memory, Size, FTimeout);
-    result:=sock.lasterror=0;
+    Result := FSock.LastError = 0;
-    document.CopyFrom(mem,0);
+    FDocument.CopyFrom(mem, 0);
   finally
-    mem.free;
+    mem.Free;
   end;
 end;
 
-{THTTPSend.ReadChunked}
+function THTTPSend.ReadChunked: Boolean;
-function THTTPSend.ReadChunked:boolean;
 var
-  s:string;
+  s: string;
-  size:integer;
+  Size: Integer;
 begin
   repeat
     repeat
-      s:=sock.recvstring(timeout);
+      s := FSock.RecvString(FTimeout);
-    until s<>'';
+    until s <> '';
-    if sock.lasterror<>0
+    if FSock.LastError <> 0 then
-      then break;
+      Break;
-    s:=separateleft(s,' ');
+    s := SeparateLeft(s, ' ');
-    size:=strtointdef('$'+s,0);
+    Size := StrToIntDef('$' + s, 0);
-    if size=0 then break;
+    if Size = 0 then
-    ReadIdentity(size);
+      Break;
-  until false;
+    ReadIdentity(Size);
-  result:=sock.lasterror=0;
+  until False;
+  Result := FSock.LastError = 0;
 end;
 
 {==============================================================================}
 
-{HttpGetText}
+function HttpGetText(const URL: string; const Response: TStrings): Boolean;
-function HttpGetText(URL:string;Response:TStrings):Boolean;
 var
-  HTTP:THTTPSend;
+  HTTP: THTTPSend;
 begin
-  Result:=False;
+  HTTP := THTTPSend.Create;
-  HTTP:=THTTPSend.Create;
   try
-    Result:=HTTP.HTTPmethod('GET',URL);
+    Result := HTTP.HTTPMethod('GET', URL);
-    response.LoadFromStream(HTTP.document);
+    Response.LoadFromStream(HTTP.Document);
   finally
     HTTP.Free;
   end;
 end;
 
-{HttpGetBinary}
+function HttpGetBinary(const URL: string; const Response: TStream): Boolean;
-function HttpGetBinary(URL:string;Response:TStream):Boolean;
 var
-  HTTP:THTTPSend;
+  HTTP: THTTPSend;
 begin
-  Result:=False;
+  HTTP := THTTPSend.Create;
-  HTTP:=THTTPSend.Create;
   try
-    Result:=HTTP.HTTPmethod('GET',URL);
+    Result := HTTP.HTTPMethod('GET', URL);
-    Response.Seek(0,soFromBeginning);
+    Response.Seek(0, soFromBeginning);
-    Response.CopyFrom(HTTP.document,0);
+    Response.CopyFrom(HTTP.Document, 0);
   finally
     HTTP.Free;
   end;
 end;
 
-{HttpPostBinary}
+function HttpPostBinary(const URL: string; const Data: TStream): Boolean;
-function HttpPostBinary(URL:string;Data:TStream):Boolean;
 var
-  HTTP:THTTPSend;
+  HTTP: THTTPSend;
 begin
-  Result:=False;
+  HTTP := THTTPSend.Create;
-  HTTP:=THTTPSend.Create;
   try
-    HTTP.Document.CopyFrom(data,0);
+    HTTP.Document.CopyFrom(Data, 0);
-    HTTP.MimeType:='Application/octet-stream';
+    HTTP.MimeType := 'Application/octet-stream';
-    Result:=HTTP.HTTPmethod('POST',URL);
+    Result := HTTP.HTTPMethod('POST', URL);
-    data.Seek(0,soFromBeginning);
+    Data.Seek(0, soFromBeginning);
-    data.CopyFrom(HTTP.document,0);
+    Data.CopyFrom(HTTP.Document, 0);
   finally
     HTTP.Free;
   end;
 end;
 
-{HttpPostURL}
+function HttpPostURL(const URL, URLData: string; const Data: TStream): Boolean;
-function HttpPostURL(URL:string;URLData:string;Data:TStream):Boolean;
 var
-  HTTP:THTTPSend;
+  HTTP: THTTPSend;
 begin
-  Result:=False;
+  HTTP := THTTPSend.Create;
-  HTTP:=THTTPSend.Create;
   try
-    HTTP.Document.Write(pointer(URLData)^,Length(URLData));
+    HTTP.Document.Write(Pointer(URLData)^, Length(URLData));
-    HTTP.MimeType:='application/x-url-encoded';
+    HTTP.MimeType := 'application/x-url-encoded';
-    Result:=HTTP.HTTPmethod('POST',URL);
+    Result := HTTP.HTTPMethod('POST', URL);
-    data.Seek(0,soFromBeginning);
+    Data.Seek(0, soFromBeginning);
-    data.CopyFrom(HTTP.document,0);
+    Data.CopyFrom(HTTP.Document, 0);
   finally
     HTTP.Free;
   end;
 end;
 
-
 end.

mimeinln.pas

@@ -1,11 +1,11 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.000.001 |
+| Project : Delphree - Synapse                                   | 001.000.002 |
 |==============================================================================|
 | Content: Inline MIME support procedures and functions                        |
 |==============================================================================|
-| The contents of this file are subject to the Mozilla Public License Ver. 1.0 |
+| The contents of this file are subject to the Mozilla Public License Ver. 1.1 |
 | (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/ |
+| 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 |
@@ -14,7 +14,7 @@
 | 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)2000.                     |
+| Portions created by Lukas Gebauer are Copyright (c)2000,2001.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -23,151 +23,151 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
+{$WEAKPACKAGEUNIT ON}
+
 unit MIMEinLn;
 
 interface
 
 uses
-  sysutils, classes, MIMEchar, SynaCode, SynaUtil;
+  SysUtils, Classes,
+  SynaChar, SynaCode, SynaUtil;
 
-function InlineDecode(value:string;CP:TMimeChar):string;
+function InlineDecode(const Value: string; CP: TMimeChar): string;
-function InlineEncode(value:string;CP,MimeP:TMimeChar):string;
+function InlineEncode(const Value: string; CP, MimeP: TMimeChar): string;
-Function NeedInline(value:string):boolean;
+function NeedInline(const Value: string): boolean;
-function InlineCode(value:string):string;
+function InlineCode(const Value: string): string;
-function InlineEmail(value:string):string;
+function InlineEmail(const Value: string): string;
 
 implementation
 
 {==============================================================================}
-{InlineDecode}
-function InlineDecode(value:string;CP:TMimeChar):string;
-var
-  s,su:string;
-  x,y,z,n:integer;
-  ichar:TMimeChar;
-  c:char;
 
-  function SearchEndInline(value:string;be:integer):integer;
+function InlineDecode(const Value: string; CP: TMimeChar): string;
+var
+  s, su: string;
+  x, y, z, n: Integer;
+  ichar: TMimeChar;
+  c: Char;
+
+  function SearchEndInline(const Value: string; be: Integer): Integer;
   var
-    n,q:integer;
+    n, q: Integer;
   begin
-    q:=0;
+    q := 0;
-    result:=0;
+    Result := 0;
-    for n:=be+2 to length(value)-1 do
+    for n := be + 2 to Length(Value) - 1 do
-      if value[n]='?' then
+      if Value[n] = '?' then
       begin
-          inc(q);
+        Inc(q);
-          if (q>2) and (value[n+1]='=') then
+        if (q > 2) and (Value[n + 1] = '=') then
         begin
-              result:=n;
+          Result := n;
-              break;
+          Break;
         end;
       end;
   end;
 
 begin
-  result:=value;
+  Result := Value;
-  x:=pos('=?',result);
+  x := Pos('=?', Result);
-  y:=SearchEndInline(result,x);
+  y := SearchEndInline(Result, x);
-  while y>x do
+  while y > x do
   begin
-      s:=copy(result,x,y-x+2);
+    s := Copy(Result, x, y - x + 2);
-      su:=copy(s,3,length(s)-4);
+    su := Copy(s, 3, Length(s) - 4);
-      ichar:=GetCPfromID(su);
+    ichar := GetCPFromID(su);
-      z:=pos('?',su);
+    z := Pos('?', su);
-      if (length(su)>=(z+2)) and (su[z+2]='?') then
+    if (Length(su) >= (z + 2)) and (su[z + 2] = '?') then
     begin
-          c:=uppercase(su)[z+1];
+      c := UpperCase(su)[z + 1];
-          su:=copy(su,z+3,length(su)-z-2);
+      su := Copy(su, z + 3, Length(su) - z - 2);
-          if c='B' then
+      if c = 'B' then
       begin
-              s:=DecodeBase64(su);
+        s := DecodeBase64(su);
-              s:=DecodeChar(s,ichar,CP);
+        s := CharsetConversion(s, ichar, CP);
       end;
-          if c='Q' then
+      if c = 'Q' then
       begin
-              s:='';
+        s := '';
-              for n:=1 to length(su) do
+        for n := 1 to Length(su) do
-                if su[n]='_'
+          if su[n] = '_' then
-                  then s:=s+' '
+            s := s + ' '
-                  else s:=s+su[n];
+          else
-              s:=DecodeQuotedprintable(s);
+            s := s + su[n];
-              s:=DecodeChar(s,ichar,CP);
+        s := DecodeQuotedPrintable(s);
+        s := CharsetConversion(s, ichar, CP);
       end;
     end;
-      result:=copy(result,1,x-1)+s+copy(result,y+2,length(result)-y-1);
+    Result := Copy(Result, 1, x - 1) + s +
-      x:=pos('=?',result);
+      Copy(Result, y + 2, Length(Result) - y - 1);
-      y:=SearchEndInline(result,x);
+    x := Pos('=?', Result);
+    y := SearchEndInline(Result, x);
   end;
 end;
 
 {==============================================================================}
-{InlineEncode}
+
-function InlineEncode(value:string;CP,MimeP:TMimeChar):string;
+function InlineEncode(const Value: string; CP, MimeP: TMimeChar): string;
 var
-  s,s1:string;
+  s, s1: string;
-  n:integer;
+  n: Integer;
 begin
-  s:=DecodeChar(value,CP,MimeP);
+  s := CharsetConversion(Value, CP, MimeP);
-  s:=EncodeQuotedPrintable(s);
+  s := EncodeQuotedPrintable(s);
-  s1:='';
+  s1 := '';
-  for n:=1 to length(s) do
+  for n := 1 to Length(s) do
-    if s[n]=' '
+    if s[n] = ' ' then
-      then s1:=s1+'=20'
+      s1 := s1 + '=20'
-      else s1:=s1+s[n];
+    else
-  result:='=?'+GetIdFromCP(MimeP)+'?Q?'+s1+'?=';
+      s1 := s1 + s[n];
+  Result := '=?' + GetIdFromCP(MimeP) + '?Q?' + s1 + '?=';
 end;
 
 {==============================================================================}
-{NeedInline}
+
-Function NeedInline(value:string):boolean;
+function NeedInline(const Value: string): boolean;
 var
-  n:integer;
+  n: Integer;
 begin
-  result:=false;
+  Result := False;
-  for n:=1 to length(value) do
+  for n := 1 to Length(Value) do
-    if value[n] in (SpecialChar+[char(1)..char(31),char(128)..char(255)]) then
+    if Value[n] in (SpecialChar + [Char(1)..Char(31), Char(128)..Char(255)]) then
     begin
-        result:=true;
+      Result := True;
-        break;
+      Break;
     end;
 end;
 
 {==============================================================================}
-{InlineCode}
+
-function InlineCode(value:string):string;
+function InlineCode(const Value: string): string;
 var
-  c:TMimeChar;
+  c: TMimeChar;
 begin
-  if NeedInline(value)
+  if NeedInline(Value) then
-    then
   begin
-        c:=IdealCoding(value,GetCurCP,
+    c := IdealCharsetCoding(Value, GetCurCP,
       [ISO_8859_1, ISO_8859_2, ISO_8859_3, ISO_8859_4, ISO_8859_5,
       ISO_8859_6, ISO_8859_7, ISO_8859_8, ISO_8859_9, ISO_8859_10]);
-        result:=InlineEncode(value,GetCurCP,c);
+    Result := InlineEncode(Value, GetCurCP, c);
   end
-    else result:=value;
+  else
+    Result := Value;
 end;
 
 {==============================================================================}
-{InlineEmail}
+
-function InlineEmail(value:string):string;
+function InlineEmail(const Value: string): string;
 var
-  sd,se:string;
+  sd, se: string;
 begin
-  sd:=getEmaildesc(value);
+  sd := GetEmailDesc(Value);
-  se:=getEmailAddr(value);
+  se := GetEmailAddr(Value);
-  if sd=''
+  if sd = '' then
-    then result:=se
+    Result := se
-    else result:='"'+InlineCode(sd)+'"<'+se+'>';
+  else
+    Result := '"' + InlineCode(sd) + '"<' + se + '>';
 end;
 
-{==============================================================================}
-
-begin
-  exit;
-  asm
-    db 'Synapse Inline MIME encoding and decoding library by Lukas Gebauer',0
-  end;
 end.

mimemess.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.003.000 |
+| Project : Delphree - Synapse                                   | 001.004.000 |
 |==============================================================================|
 | Content: MIME message object                                                 |
 |==============================================================================|
-| The contents of this file are subject to the Mozilla Public License Ver. 1.0 |
+| The contents of this file are Subject to the Mozilla Public License Ver. 1.1 |
 | (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/ |
 |                                                                              |
@@ -19,314 +19,334 @@
 |==============================================================================|
 | Contributor(s):                                                              |
 |==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
+| History: see HISTORY.HTM From distribution package                           |
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
+{$WEAKPACKAGEUNIT ON}
 
 unit MIMEmess;
 
 interface
 
 uses
-  classes, Sysutils, MIMEpart, MimeChar, SynaUtil, MIMEInLn;
+  Classes, SysUtils,
+  MIMEpart, SynaChar, SynaUtil, MIMEinLn;
 
 type
-
+  TMessHeader = class(TObject)
-TMessHeader=record
-  from:string;
-  ToList:tstringlist;
-  subject:string;
-  organization:string;
-end;
-
-TMimeMess=class(TObject)
   private
+    FFrom: string;
+    FToList: TStringList;
+    FSubject: string;
+    FOrganization: string;
   public
-    PartList:TList;
-    Lines:TStringList;
-    header:TMessHeader;
     constructor Create;
     destructor Destroy; override;
     procedure Clear;
-    function AddPart:integer;
+  published
-    procedure AddPartText(value:tstringList);
+    property From: string read FFrom Write FFrom;
-    procedure AddPartHTML(value:tstringList);
+    property ToList: TStringList read FToList Write FToList;
-    procedure AddPartHTMLBinary(Value,Cid:string);
+    property Subject: string read FSubject Write FSubject;
-    procedure AddPartBinary(value:string);
+    property Organization: string read FOrganization Write FOrganization;
+  end;
+
+  TMimeMess = class(TObject)
+  private
+    FPartList: TList;
+    FLines: TStringList;
+    FHeader: TMessHeader;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure Clear;
+    function AddPart: Integer;
+    procedure AddPartText(Value: TStringList);
+    procedure AddPartHTML(Value: TStringList);
+    procedure AddPartHTMLBinary(Value, Cid: string);
+    procedure AddPartBinary(Value: string);
     procedure EncodeMessage;
     procedure FinalizeHeaders;
     procedure ParseHeaders;
     procedure DecodeMessage;
-end;
+  published
+    property PartList: TList read FPartList Write FPartList;
+    property Lines: TStringList read FLines Write FLines;
+    property Header: TMessHeader read FHeader Write FHeader;
+  end;
 
 implementation
 
 {==============================================================================}
-{TMimeMess.Create}
+
-Constructor TMimeMess.Create;
+constructor TMessHeader.Create;
 begin
   inherited Create;
-  PartList:=TList.create;
+  FToList := TStringList.Create;
-  Lines:=TStringList.create;
-  Header.ToList:=TStringList.create;
 end;
 
-{TMimeMess.Destroy}
+destructor TMessHeader.Destroy;
-Destructor TMimeMess.Destroy;
 begin
-  Header.ToList.free;
+  FToList.Free;
-  Lines.free;
+  inherited Destroy;
-  PartList.free;
-  inherited destroy;
 end;
 
 {==============================================================================}
-{TMimeMess.Clear}
+
+procedure TMessHeader.Clear;
+begin
+  FFrom := '';
+  FToList.Clear;
+  FSubject := '';
+  FOrganization := '';
+end;
+
+{==============================================================================}
+
+constructor TMimeMess.Create;
+begin
+  inherited Create;
+  FPartList := TList.Create;
+  FLines := TStringList.Create;
+  FHeader := TMessHeader.Create;
+end;
+
+destructor TMimeMess.Destroy;
+begin
+  FHeader.Free;
+  Lines.Free;
+  PartList.Free;
+  inherited Destroy;
+end;
+
+{==============================================================================}
+
 procedure TMimeMess.Clear;
 var
-  n:integer;
+  n: Integer;
 begin
-  Lines.clear;
+  Lines.Clear;
-  for n:=0 to PartList.count-1 do
+  for n := 0 to PartList.Count - 1 do
     TMimePart(PartList[n]).Free;
   PartList.Clear;
-  with header do
+  FHeader.Clear;
-    begin
-      from:='';
-      ToList.clear;
-      subject:='';
-      organization:='';
-    end;
 end;
 
 {==============================================================================}
-{TMimeMess.AddPart}
+
-function TMimeMess.AddPart:integer;
+function TMimeMess.AddPart: Integer;
 var
-  mp:TMimePart;
+  mp: TMimePart;
 begin
-  mp:=TMimePart.create;
+  mp := TMimePart.Create;
-  result:=PartList.Add(mp);
+  Result := PartList.Add(mp);
 end;
 
 {==============================================================================}
-{TMimeMess.AddPartText}
+
-procedure TMimeMess.AddPartText(value:tstringList);
+procedure TMimeMess.AddPartText(Value: TStringList);
 var
-  x:integer;
+  x: Integer;
 begin
-  x:=Addpart;
+  x := AddPart;
   with TMimePart(PartList[x]) do
   begin
-      value.SaveToStream(decodedlines);
+    Value.SaveToStream(DecodedLines);
-      primary:='text';
+    Primary := 'text';
-      secondary:='plain';
+    Secondary := 'plain';
-      description:='Message text';
+    Description := 'Message text';
-      disposition:='inline';
+    Disposition := 'inline';
-      CharsetCode:=IdealCoding(value.text,targetCharset,
+    CharsetCode := IdealCharsetCoding(Value.Text, TargetCharset,
       [ISO_8859_1, ISO_8859_2, ISO_8859_3, ISO_8859_4, ISO_8859_5,
       ISO_8859_6, ISO_8859_7, ISO_8859_8, ISO_8859_9, ISO_8859_10]);
-      EncodingCode:=ME_QUOTED_PRINTABLE;
+    EncodingCode := ME_QUOTED_PRINTABLE;
     EncodePart;
   end;
 end;
 
 {==============================================================================}
-{TMimeMess.AddPartHTML}
+
-procedure TMimeMess.AddPartHTML(value:tstringList);
+procedure TMimeMess.AddPartHTML(Value: TStringList);
 var
-  x:integer;
+  x: Integer;
 begin
-  x:=Addpart;
+  x := AddPart;
   with TMimePart(PartList[x]) do
   begin
-      value.SaveToStream(decodedlines);
+    Value.SaveToStream(DecodedLines);
-      primary:='text';
+    Primary := 'text';
-      secondary:='html';
+    Secondary := 'html';
-      description:='HTML text';
+    Description := 'HTML text';
-      disposition:='inline';
+    Disposition := 'inline';
-      CharsetCode:=UTF_8;
+    CharsetCode := UTF_8;
-      EncodingCode:=ME_QUOTED_PRINTABLE;
+    EncodingCode := ME_QUOTED_PRINTABLE;
     EncodePart;
   end;
 end;
 
 {==============================================================================}
-{TMimeMess.AddPartBinary}
+
-procedure TMimeMess.AddPartBinary(value:string);
+procedure TMimeMess.AddPartBinary(Value: string);
 var
-  x:integer;
+  x: Integer;
-  s:string;
+  s: string;
 begin
-  x:=Addpart;
+  x := AddPart;
   with TMimePart(PartList[x]) do
   begin
     DecodedLines.LoadFromFile(Value);
-      s:=ExtractFileName(value);
+    s := ExtractFileName(Value);
     MimeTypeFromExt(s);
-      description:='Attached file: '+s;
+    Description := 'Attached file: ' + s;
-      disposition:='attachment';
+    Disposition := 'attachment';
-      filename:=s;
+    FileName := s;
-      EncodingCode:=ME_BASE64;
+    EncodingCode := ME_BASE64;
     EncodePart;
   end;
 end;
 
-{TMimeMess.AddPartHTMLBinary}
+procedure TMimeMess.AddPartHTMLBinary(Value, Cid: string);
-procedure TMimeMess.AddPartHTMLBinary(Value,Cid:string);
 var
-  x:integer;
+  x: Integer;
-  s:string;
+  s: string;
 begin
-  x:=Addpart;
+  x := AddPart;
   with TMimePart(PartList[x]) do
   begin
     DecodedLines.LoadFromFile(Value);
-      s:=ExtractFileName(value);
+    s := ExtractFileName(Value);
     MimeTypeFromExt(s);
-      description:='Included file: '+s;
+    Description := 'Included file: ' + s;
-      disposition:='inline';
+    Disposition := 'inline';
-      contentID:=cid;
+    ContentID := cid;
-      filename:=s;
+    FileName := s;
-      EncodingCode:=ME_BASE64;
+    EncodingCode := ME_BASE64;
     EncodePart;
   end;
 end;
 
 {==============================================================================}
-{TMimeMess.Encodemessage}
+
-procedure TMimeMess.Encodemessage;
+procedure TMimeMess.EncodeMessage;
 var
-  bound:string;
+  bound: string;
-  n:integer;
+  n: Integer;
-  m:TMimepart;
 begin
-  lines.clear;
+  Lines.Clear;
-  If PartList.Count=1
+  if PartList.Count = 1 then
-    then
+    Lines.Assign(TMimePart(PartList[0]).Lines)
-      Lines.assign(TMimePart(PartList[0]).lines)
   else
   begin
-        bound:=generateboundary;
+    bound := GenerateBoundary;
-        for n:=0 to PartList.count-1 do
+    for n := 0 to PartList.Count - 1 do
     begin
-            Lines.add('--'+bound);
+      Lines.Add('--' + bound);
-            lines.AddStrings(TMimePart(PartList[n]).lines);
+      Lines.AddStrings(TMimePart(PartList[n]).Lines);
     end;
-        Lines.add('--'+bound);
+    Lines.Add('--' + bound);
-        m:=TMimePart.Create;
+    with TMimePart.Create do
     try
-          Lines.SaveToStream(m.DecodedLines);
+      Self.Lines.SaveToStream(DecodedLines);
-          m.Primary:='Multipart';
+      Primary := 'Multipart';
-          m.secondary:='mixed';
+      Secondary := 'mixed';
-          m.description:='Multipart message';
+      Description := 'Multipart message';
-          m.boundary:=bound;
+      Boundary := bound;
-          m.EncodePart;
+      EncodePart;
-          Lines.assign(m.lines);
+      Self.Lines.Assign(Lines);
     finally
-          m.free;
+      Free;
     end;
   end;
 end;
 
 {==============================================================================}
-{TMimeMess.FinalizeHeaders}
+
 procedure TMimeMess.FinalizeHeaders;
 var
-  n:integer;
+  n: Integer;
 begin
-  Lines.Insert(0,'x-mailer: Synapse - Delphi TCP/IP library by Lukas Gebauer');
+  Lines.Insert(0, 'x-mailer: Synapse - Delphi TCP/IP library by Lukas Gebauer');
-  Lines.Insert(0,'MIME-Version: 1.0 (produced by Synapse)');
+  Lines.Insert(0, 'MIME-Version: 1.0 (produced by Synapse)');
-  Lines.Insert(0,'date: '+Rfc822DateTime(now));
+  Lines.Insert(0, 'date: ' + Rfc822DateTime(Now));
-  if header.organization<>''
+  if FHeader.Organization <> '' then
-    then Lines.Insert(0,'Organization: '+InlineCode(header.organization));
+    Lines.Insert(0, 'Organization: ' + InlineCode(Header.Organization));
-  if header.subject<>''
+  if Header.Subject <> '' then
-    then Lines.Insert(0,'Subject: '+InlineCode(header.subject));
+    FLines.Insert(0, 'Subject: ' + InlineCode(Header.Subject));
-  for n:=0 to Header.ToList.count-1 do
+  for n := 0 to FHeader.ToList.Count - 1 do
-    Lines.Insert(0,'To: '+InlineEmail(header.ToList[n]));
+    Lines.Insert(0, 'To: ' + InlineEmail(FHeader.ToList[n]));
-  Lines.Insert(0,'From: '+InlineEmail(header.from));
+  Lines.Insert(0, 'From: ' + InlineEmail(FHeader.From));
 end;
 
 {==============================================================================}
-{TMimeMess.ParseHeaders}
+
 procedure TMimeMess.ParseHeaders;
 var
-  s:string;
+  s: string;
-  x:integer;
+  x: Integer;
-  cp:TMimeChar;
+  cp: TMimeChar;
 begin
-  cp:=getCurCP;
+  cp := GetCurCP;
-  header.ToList.clear;
+  FHeader.Clear;
-  x:=0;
+  x := 0;
-  while lines.count>x do
+  while Lines.Count > x do
   begin
-      s:=normalizeheader(lines,x);
+    s := NormalizeHeader(Lines, x);
-      if s=''
+    if s = '' then
-        then break;
+      Break;
-      If pos('FROM:',uppercase(s))=1
+    if Pos('FROM:', UpperCase(s)) = 1 then
-        then header.from:=InlineDecode(separateright(s,':'),cp);
+      FHeader.From := InlineDecode(SeparateRight(s, ':'), cp);
-      If pos('SUBJECT:',uppercase(s))=1
+    if Pos('SUBJECT:', UpperCase(s)) = 1 then
-        then header.subject:=InlineDecode(separateright(s,':'),cp);
+      FHeader.Subject := InlineDecode(SeparateRight(s, ':'), cp);
-      If pos('ORGANIZATION:',uppercase(s))=1
+    if Pos('ORGANIZATION:', UpperCase(s)) = 1 then
-        then header.organization:=InlineDecode(separateright(s,':'),cp);
+      FHeader.Organization := InlineDecode(SeparateRight(s, ':'), cp);
-      If pos('TO:',uppercase(s))=1
+    if Pos('TO:', UpperCase(s)) = 1 then
-        then header.ToList.add(InlineDecode(separateright(s,':'),cp));
+      FHeader.ToList.Add(InlineDecode(SeparateRight(s, ':'), cp));
   end;
 end;
 
 {==============================================================================}
-{TMimeMess.DecodeMessage}
+
 procedure TMimeMess.DecodeMessage;
 var
-  l:tstringlist;
+  l: TStringList;
-  m:tmimepart;
+  m: TMimePart;
-  x,i:integer;
+  x, i: Integer;
-  bound:string;
+  bound: string;
 begin
-  l:=tstringlist.create;
+  l := TStringList.Create;
-  m:=tmimepart.create;
+  m := TMimePart.Create;
   try
-    l.assign(lines);
+    l.Assign(Lines);
-    with header do
+    FHeader.Clear;
-      begin
-        from:='';
-        ToList.clear;
-        subject:='';
-        organization:='';
-      end;
     ParseHeaders;
-    m.ExtractPart(l,0);
+    m.ExtractPart(l, 0);
-    if m.primarycode=MP_MULTIPART
+    if m.PrimaryCode = MP_MULTIPART then
-      then
     begin
-          bound:=m.boundary;
+      bound := m.Boundary;
-          i:=0;
+      i := 0;
       repeat
-            x:=AddPart;
+        x := AddPart;
         with TMimePart(PartList[x]) do
         begin
-                boundary:=bound;
+          Boundary := bound;
-                i:=ExtractPart(l,i);
+          i := ExtractPart(l, i);
           DecodePart;
         end;
-          until i>=l.count-2;
+      until i >= l.Count - 2;
     end
     else
     begin
-          x:=AddPart;
+      x := AddPart;
       with TMimePart(PartList[x]) do
       begin
-              ExtractPart(l,0);
+        ExtractPart(l, 0);
         DecodePart;
       end;
     end;
   finally
-    m.free;
+    m.Free;
-    l.free;
+    l.Free;
   end;
 end;
 
-{==============================================================================}
-
 end.

mimepart.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.004.000 |
+| Project : Delphree - Synapse                                   | 001.004.001 |
 |==============================================================================|
 | Content: MIME support procedures and functions                               |
 |==============================================================================|
-| The contents of this file are subject to the Mozilla Public License Ver. 1.0 |
+| The contents of this file are subject to the Mozilla Public License Ver. 1.1 |
 | (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/ |
 |                                                                              |
@@ -28,553 +28,532 @@ unit MIMEpart;
 interface
 
 uses
-  sysutils, classes, MIMEchar, SynaCode, SynaUtil, MIMEinLn;
+  SysUtils, Classes,
+  SynaChar, SynaCode, SynaUtil, MIMEinLn;
 
 type
 
-TMimePrimary=(MP_TEXT,
+  TMimePrimary = (MP_TEXT, MP_MULTIPART,
-              MP_MULTIPART,
+    MP_MESSAGE, MP_BINARY);
-              MP_MESSAGE,
-              MP_BINARY);
 
-TMimeEncoding=(ME_7BIT,
+  TMimeEncoding = (ME_7BIT, ME_8BIT, ME_QUOTED_PRINTABLE,
-               ME_8BIT,
+    ME_BASE64, ME_UU, ME_XX);
-               ME_QUOTED_PRINTABLE,
-               ME_BASE64,
-               ME_UU,
-               ME_XX);
 
-TMimePart=class
+  TMimePart = class(TObject)
   private
-    FPrimary:string;
+    FPrimary: string;
-    FEncoding:string;
+    FEncoding: string;
-    FCharset:string;
+    FCharset: string;
-    procedure Setprimary(Value:string);
+    FPrimaryCode: TMimePrimary;
-    procedure SetEncoding(Value:string);
+    FEncodingCode: TMimeEncoding;
-    procedure SetCharset(Value:string);
+    FCharsetCode: TMimeChar;
-  protected
+    FTargetCharset: TMimeChar;
+    FSecondary: string;
+    FDescription: string;
+    FDisposition: string;
+    FContentID: string;
+    FBoundary: string;
+    FFileName: string;
+    FLines: TStringList;
+    FDecodedLines: TMemoryStream;
+    procedure SetPrimary(Value: string);
+    procedure SetEncoding(Value: string);
+    procedure SetCharset(Value: string);
   public
-    PrimaryCode:TMimePrimary;
-    EncodingCode:TMimeEncoding;
-    CharsetCode:TMimeChar;
-    TargetCharset:TMimeChar;
-    secondary:string;
-    description:string;
-    disposition:string;
-    contentID:string;
-    boundary:string;
-    FileName:string;
-    Lines:TStringList;
-    DecodedLines:TmemoryStream;
     constructor Create;
     destructor Destroy; override;
-    procedure clear;
+    procedure Clear;
-    function ExtractPart(value:TStringList; BeginLine:integer):integer;
+    function ExtractPart(Value: TStringList; BeginLine: Integer): Integer;
     procedure DecodePart;
     procedure EncodePart;
-    procedure MimeTypeFromExt(value:string);
+    procedure MimeTypeFromExt(Value: string);
-  property
+  published
-    Primary:string read FPrimary Write SetPrimary;
+    property Primary: string read FPrimary write SetPrimary;
-  property
+    property Encoding: string read FEncoding write SetEncoding;
-    encoding:string read FEncoding write SetEncoding;
+    property Charset: string read FCharset write SetCharset;
-  property
+    property PrimaryCode: TMimePrimary read FPrimaryCode Write FPrimaryCode;
-    Charset:string read FCharset write SetCharset;
+    property EncodingCode: TMimeEncoding read FEncodingCode Write FEncodingCode;
-end;
+    property CharsetCode: TMimeChar read FCharsetCode Write FCharsetCode;
+    property TargetCharset: TMimeChar read FTargetCharset Write FTargetCharset;
+    property Secondary: string read FSecondary Write FSecondary;
+    property Description: string read FDescription Write FDescription;
+    property Disposition: string read FDisposition Write FDisposition;
+    property ContentID: string read FContentID Write FContentID;
+    property Boundary: string read FBoundary Write FBoundary;
+    property FileName: string read FFileName Write FFileName;
+    property Lines: TStringList read FLines Write FLines;
+    property DecodedLines: TMemoryStream read FDecodedLines Write FDecodedLines;
+  end;
 
 const
-  MaxMimeType=25;
+  MaxMimeType = 25;
-  MimeType:array [0..MaxMimeType,0..2] of string=
+  MimeType: array[0..MaxMimeType, 0..2] of string =
   (
-      ('AU','audio','basic'),
+    ('AU', 'audio', 'basic'),
-      ('AVI','video','x-msvideo'),
+    ('AVI', 'video', 'x-msvideo'),
-      ('BMP','image','BMP'),
+    ('BMP', 'image', 'BMP'),
-      ('DOC','application','MSWord'),
+    ('DOC', 'application', 'MSWord'),
-      ('EPS','application','Postscript'),
+    ('EPS', 'application', 'Postscript'),
-      ('GIF','image','GIF'),
+    ('GIF', 'image', 'GIF'),
-      ('JPEG','image','JPEG'),
+    ('JPEG', 'image', 'JPEG'),
-      ('JPG','image','JPEG'),
+    ('JPG', 'image', 'JPEG'),
-      ('MID','audio','midi'),
+    ('MID', 'audio', 'midi'),
-      ('MOV','video','quicktime'),
+    ('MOV', 'video', 'quicktime'),
-      ('MPEG','video','MPEG'),
+    ('MPEG', 'video', 'MPEG'),
-      ('MPG','video','MPEG'),
+    ('MPG', 'video', 'MPEG'),
-      ('MP2','audio','mpeg'),
+    ('MP2', 'audio', 'mpeg'),
-      ('MP3','audio','mpeg'),
+    ('MP3', 'audio', 'mpeg'),
-      ('PDF','application','PDF'),
+    ('PDF', 'application', 'PDF'),
-      ('PNG','image','PNG'),
+    ('PNG', 'image', 'PNG'),
-      ('PS','application','Postscript'),
+    ('PS', 'application', 'Postscript'),
-      ('QT','video','quicktime'),
+    ('QT', 'video', 'quicktime'),
-      ('RA','audio','x-realaudio'),
+    ('RA', 'audio', 'x-realaudio'),
-      ('RTF','application','RTF'),
+    ('RTF', 'application', 'RTF'),
-      ('SND','audio','basic'),
+    ('SND', 'audio', 'basic'),
-      ('TIF','image','TIFF'),
+    ('TIF', 'image', 'TIFF'),
-      ('TIFF','image','TIFF'),
+    ('TIFF', 'image', 'TIFF'),
-      ('WAV','audio','x-wav'),
+    ('WAV', 'audio', 'x-wav'),
-      ('WPD','application','Wordperfect5.1'),
+    ('WPD', 'application', 'Wordperfect5.1'),
-      ('ZIP','application','ZIP')
+    ('ZIP', 'application', 'ZIP')
     );
 
-function NormalizeHeader(value:TStringList;var index:integer):string;
+function NormalizeHeader(Value: TStringList; var Index: Integer): string;
-function GenerateBoundary:string;
+function GenerateBoundary: string;
 
 implementation
 
-function NormalizeHeader(value:TStringList;var index:integer):string;
+function NormalizeHeader(Value: TStringList; var Index: Integer): string;
 var
-  s,t:string;
+  s, t: string;
-  n:integer;
+  n: Integer;
 begin
-  s:=value[index];
+  s := Value[Index];
-  inc(index);
+  Inc(Index);
-  if s<>''
+  if s <> '' then
-    then
+    while (Value.Count - 1) > Index do
-      while (value.Count-1) > index do
     begin
-          t:=value[index];
+      t := Value[Index];
-          if t=''
+      if t = '' then
-            then break;
+        Break;
-          for n:=1 to length(t) do
+      for n := 1 to Length(t) do
-            if t[n]=#9
+        if t[n] = #9 then
-              then t[n]:=' ';
+          t[n] := ' ';
-          if t[1]<>' '
+      if t[1] <> ' ' then
-            then break
+        Break
       else
       begin
-                s:=s+' '+trim(t);
+        s := s + ' ' + Trim(t);
-                inc(index);
+        Inc(Index);
       end;
     end;
-  result:=s;
+  Result := s;
 end;
 
 {==============================================================================}
-{TMIMEPart.Create}
+
-Constructor TMIMEPart.Create;
+constructor TMIMEPart.Create;
 begin
   inherited Create;
-  Lines:=TStringList.Create;
+  FLines := TStringList.Create;
-  DecodedLines:=TmemoryStream.create;
+  FDecodedLines := TMemoryStream.Create;
-  TargetCharset:=GetCurCP;
+  FTargetCharset := GetCurCP;
 end;
 
-{TMIMEPart.Destroy}
+destructor TMIMEPart.Destroy;
-Destructor TMIMEPart.Destroy;
 begin
-  DecodedLines.free;
+  FDecodedLines.Free;
-  Lines.free;
+  FLines.Free;
-  inherited destroy;
+  inherited Destroy;
 end;
 
 {==============================================================================}
-{TMIMEPart.Clear}
+
 procedure TMIMEPart.Clear;
 begin
-  FPrimary:='';
+  FPrimary := '';
-  FEncoding:='';
+  FEncoding := '';
-  FCharset:='';
+  FCharset := '';
-  PrimaryCode:=MP_TEXT;
+  FPrimaryCode := MP_TEXT;
-  EncodingCode:=ME_7BIT;
+  FEncodingCode := ME_7BIT;
-  CharsetCode:=ISO_8859_1;
+  FCharsetCode := ISO_8859_1;
-  TargetCharset:=GetCurCP;
+  FTargetCharset := GetCurCP;
-  secondary:='';
+  FSecondary := '';
-  disposition:='';
+  FDisposition := '';
-  contentID:='';
+  FContentID := '';
-  description:='';
+  FDescription := '';
-  boundary:='';
+  FBoundary := '';
-  FileName:='';
+  FFileName := '';
-  Lines.clear;
+  FLines.Clear;
-  DecodedLines.clear;
+  FDecodedLines.Clear;
 end;
 
 {==============================================================================}
-{TMIMEPart.ExtractPart}
+
-function TMIMEPart.ExtractPart(value:TStringList; BeginLine:integer):integer;
+function TMIMEPart.ExtractPart(Value: TStringList; BeginLine: Integer): Integer;
 var
-  n,x,x1,x2:integer;
+  n, x, x1, x2: Integer;
-  t:tstringlist;
+  t: TStringList;
-  s,su,b:string;
+  s, su, b: string;
-  st,st2:string;
+  st, st2: string;
-  e:boolean;
+  e: Boolean;
-  fn:string;
+  fn: string;
 begin
-  t:=tstringlist.create;
+  t := TStringlist.Create;
   try
-    {defaults}
+    { defaults }
-    lines.clear;
+    FLines.Clear;
-    primary:='text';
+    Primary := 'text';
-    secondary:='plain';
+    FSecondary := 'plain';
-    description:='';
+    FDescription := '';
-    charset:='US-ASCII';
+    Charset := 'US-ASCII';
-    FileName:='';
+    FFileName := '';
-    encoding:='7BIT';
+    Encoding := '7BIT';
 
-    fn:='';
+    fn := '';
-    x:=beginline;
+    x := BeginLine;
-    b:=boundary;
+    b := FBoundary;
-    if b<>'' then
+    if b <> '' then
-      while value.count>x do
+      while Value.Count > x do
       begin
-          s:=value[x];
+        s := Value[x];
-          inc(x);
+        Inc(x);
-          if pos('--'+b,s)>0
+        if Pos('--' + b, s) > 0 then
-            then break;
+          Break;
       end;
 
-    {parse header}
+    { parse header }
-    while value.count>x do
+    while Value.Count > x do
     begin
-        s:=normalizeheader(value,x);
+      s := NormalizeHeader(Value, x);
-        if s=''
+      if s = '' then
-          then break;
+        Break;
-        su:=uppercase(s);
+      su := UpperCase(s);
-        if pos('CONTENT-TYPE:',su)=1 then
+      if Pos('CONTENT-TYPE:', su) = 1 then
       begin
-            st:=separateright(su,':');
+        st := SeparateRight(su, ':');
-            st2:=separateleft(st,';');
+        st2 := SeparateLeft(st, ';');
-            primary:=separateleft(st2,'/');
+        Primary := SeparateLeft(st2, '/');
-            secondary:=separateright(st2,'/');
+        FSecondary := SeparateRight(st2, '/');
-            if (secondary=primary) and (pos('/',st2)<1)
+        if (FSecondary = Primary) and (Pos('/', st2) < 1) then FSecondary := '';
-              then secondary:='';
+        case FPrimaryCode of
-            case primarycode of
           MP_TEXT:
-                begin
+            Charset := UpperCase(GetParameter(s, 'charset='));
-                  charset:=uppercase(getparameter(s,'charset='));
-                end;
           MP_MULTIPART:
-                begin
+            FBoundary := GetParameter(s, 'Boundary=');
-                  boundary:=getparameter(s,'boundary=');
-                end;
           MP_MESSAGE:
             begin
             end;
           MP_BINARY:
+            FFileName := GetParameter(s, 'name=');
+        end;
+      end;
+      if Pos('CONTENT-TRANSFER-ENCODING:', su) = 1 then
+        Encoding := SeparateRight(su, ':');
+      if Pos('CONTENT-DESCRIPTION:', su) = 1 then
+        FDescription := SeparateRight(s, ':');
+      if Pos('CONTENT-DISPOSITION:', su) = 1 then
       begin
-                  filename:=getparameter(s,'name=');
+        FDisposition := SeparateRight(su, ':');
-                end;
+        FDisposition := Trim(SeparateLeft(FDisposition, ';'));
-            end;
+        fn := GetParameter(s, 'FileName=');
-          end;
-        if pos('CONTENT-TRANSFER-ENCODING:',su)=1 then
-          begin
-            encoding:=separateright(su,':');
-          end;
-        if pos('CONTENT-DESCRIPTION:',su)=1 then
-          begin
-            description:=separateright(s,':');
-          end;
-        if pos('CONTENT-DISPOSITION:',su)=1 then
-          begin
-            disposition:=separateright(su,':');
-            disposition:=trim(separateleft(disposition,';'));
-            fn:=getparameter(s,'filename=');
-          end;
-        if pos('CONTENT-ID:',su)=1 then
-          begin
-            contentID:=separateright(s,':');
       end;
+      if Pos('CONTENT-ID:', su) = 1 then
+        FContentID := SeparateRight(s, ':');
     end;
 
-    if (primarycode=MP_BINARY) and (filename='')
+    if (PrimaryCode = MP_BINARY) and (FFileName = '') then
-      then filename:=fn;
+      FFileName := fn;
-    filename:=InlineDecode(filename,getCurCP);
+    FFileName := InlineDecode(FFileName, getCurCP);
-    filename:=extractfilename(filename);
+    FFileName := ExtractFileName(FFileName);
 
-    x1:=x;
+    x1 := x;
-    x2:=value.count-1;
+    x2 := Value.Count - 1;
-    if b<>'' then
+    if b <> '' then
     begin
-        for n:=x to value.count-1 do
+      for n := x to Value.Count - 1 do
       begin
-            x2:=n;
+        x2 := n;
-            s:=value[n];
+        s := Value[n];
-            if pos('--'+b,s)>0
+        if Pos('--' + b, s) > 0 then
-              then begin
+        begin
-                dec(x2);
+          Dec(x2);
-                break;
+          Break;
         end;
       end;
     end;
-    if primarycode=MP_MULTIPART then
+    if FPrimaryCode = MP_MULTIPART then
     begin
-        for n:=x to value.count-1 do
+      for n := x to Value.Count - 1 do
       begin
-            s:=value[n];
+        s := Value[n];
-            if pos('--'+boundary,s)>0 then
+        if Pos('--' + Boundary, s) > 0 then
         begin
-                x1:=n;
+          x1 := n;
-                break;
+          Break;
         end;
       end;
-        for n:=value.count-1 downto x do
+      for n := Value.Count - 1 downto x do
       begin
-            s:=value[n];
+        s := Value[n];
-            if pos('--'+boundary,s)>0 then
+        if Pos('--' + Boundary, s) > 0 then
         begin
-                x2:=n;
+          x2 := n;
-                break;
+          Break;
         end;
       end;
     end;
-    for n:=x1 to x2 do
+    for n := x1 to x2 do
-      lines.add(value[n]);
+      FLines.Add(Value[n]);
-    result:=x2;
+    Result := x2;
-    if primarycode=MP_MULTIPART then
+    if FPrimaryCode = MP_MULTIPART then
     begin
-        e:=false;
+      e := False;
-        for n:=x2+1 to value.count-1 do
+      for n := x2 + 1 to Value.Count - 1 do
-          if pos('--'+boundary,value[n])>0 then
+        if Pos('--' + Boundary, Value[n]) > 0 then
         begin
-              e:=true;
+          e := True;
-              break;
+          Break;
         end;
-        if not e
+      if not e then
-          then result:=value.count-1;
+        Result := Value.Count - 1;
     end;
   finally
-    t.free;
+    t.Free;
   end;
 end;
 
 {==============================================================================}
-{TMIMEPart.DecodePart}
+
 procedure TMIMEPart.DecodePart;
 const
-  CRLF=#$0D+#$0A;
+  CRLF = #13#10;
 var
-  n:integer;
+  n: Integer;
-  s:string;
+  s: string;
 begin
-  decodedLines.Clear;
+  FDecodedLines.Clear;
-  for n:=0 to lines.count-1 do
+  for n := 0 to FLines.Count - 1 do
   begin
-      s:=lines[n];
+    s := FLines[n];
-      case EncodingCode of
+    case FEncodingCode of
       ME_7BIT:
-          begin
+        s := s + CRLF;
-            s:=s+CRLF;
-          end;
       ME_8BIT:
         begin
-            s:=decodeChar(s,CharsetCode,TargetCharset);
+          s := CharsetConversion(s, FCharsetCode, FTargetCharset);
-            s:=s+CRLF;
+          s := s + CRLF;
         end;
       ME_QUOTED_PRINTABLE:
         begin
-            if s=''
+          if s = '' then
-              then s:=CRLF
+            s := CRLF
           else
-                if s[length(s)]<>'='
+            if s[Length(s)] <> '=' then
-                  then s:=s+CRLF;
+              s := s + CRLF;
-            s:=DecodeQuotedPrintable(s);
+          s := DecodeQuotedPrintable(s);
-            if PrimaryCode=MP_TEXT
+          if FPrimaryCode = MP_TEXT then
-              then s:=decodeChar(s,CharsetCode,TargetCharset);
+            s := CharsetConversion(s, FCharsetCode, FTargetCharset);
         end;
       ME_BASE64:
         begin
-            if s<>''
+          if s <> '' then
-              then s:=DecodeBase64(s);
+            s := DecodeBase64(s);
-            if PrimaryCode=MP_TEXT
+          if FPrimaryCode = MP_TEXT then
-              then s:=decodeChar(s,CharsetCode,TargetCharset);
+            s := CharsetConversion(s, FCharsetCode, FTargetCharset);
         end;
       ME_UU:
-          begin
+        if s <> '' then
-            if s<>''
+          s := DecodeUU(s);
-              then s:=DecodeUU(s);
-          end;
       ME_XX:
-          begin
+        if s <> '' then
-            if s<>''
+          s := DecodeXX(s);
-              then s:=DecodeXX(s);
     end;
+    FDecodedLines.Write(Pointer(s)^, Length(s));
   end;
-      Decodedlines.Write(pointer(s)^,length(s));
+  FDecodedLines.Seek(0, soFromBeginning);
-    end;
-  decodedlines.Seek(0,soFromBeginning);
 end;
 
 {==============================================================================}
-{TMIMEPart.EncodePart}
+
 procedure TMIMEPart.EncodePart;
 var
-  l:TStringList;
+  l: TStringList;
-  s,buff:string;
+  s, buff: string;
-  n,x:integer;
+  n, x: Integer;
 begin
-  if EncodingCode=ME_UU
+  if (FEncodingCode = ME_UU) or (FEncodingCode = ME_XX) then
-    then encoding:='base64';
+    Encoding := 'base64';
-  if EncodingCode=ME_XX
+  l := TStringList.Create;
-    then encoding:='base64';
+  FLines.Clear;
-  l:=tstringlist.create;
+  FDecodedLines.Seek(0, soFromBeginning);
-  Lines.clear;
-  decodedlines.Seek(0,soFromBeginning);
   try
-    case primarycode of
+    case FPrimaryCode of
-      MP_MULTIPART,
+      MP_MULTIPART, MP_MESSAGE:
-      MP_MESSAGE:
+        FLines.LoadFromStream(FDecodedLines);
+      MP_TEXT, MP_BINARY:
+        if FEncodingCode = ME_BASE64 then
         begin
-          lines.LoadFromStream(DecodedLines);
+          while FDecodedLines.Position < FDecodedLines.Size do
-        end;
-      MP_TEXT,
-      MP_BINARY:
-        if EncodingCode=ME_BASE64
-          then
           begin
-              while decodedlines.Position<decodedlines.Size do
+            Setlength(Buff, 54);
-                begin
+            s := '';
-                  Setlength(Buff,54);
+            x := FDecodedLines.Read(pointer(Buff)^, 54);
-                  s:='';
+            for n := 1 to x do
-                  x:=Decodedlines.Read(pointer(Buff)^,54);
+              s := s + Buff[n];
-                  for n:=1 to x do
+            if FPrimaryCode = MP_TEXT then
-                    s:=s+Buff[n];
+              s := CharsetConversion(s, FTargetCharset, FCharsetCode);
-                  if PrimaryCode=MP_TEXT
+            s := EncodeBase64(s);
-                    then s:=decodeChar(s,TargetCharset,CharsetCode);
+            if x <> 54 then
-                  s:=EncodeBase64(s);
+              s := s + '=';
-                  if x<>54
+            FLines.Add(s);
-                    then s:=s+'=';
-                  Lines.add(s);
           end;
         end
         else
         begin
-              l.LoadFromStream(DecodedLines);
+          l.LoadFromStream(FDecodedLines);
-              for n:=0 to l.count-1 do
+          for n := 0 to l.Count - 1 do
           begin
-                  s:=l[n];
+            s := l[n];
-                  if PrimaryCode=MP_TEXT
+            if FPrimaryCode = MP_TEXT then
-                    then s:=decodeChar(s,TargetCharset,CharsetCode);
+              s := CharsetConversion(s, FTargetCharset, FCharsetCode);
-                  s:=EncodeQuotedPrintable(s);
+            s := EncodeQuotedPrintable(s);
-                  Lines.add(s);
+            FLines.Add(s);
           end;
         end;
 
     end;
-    Lines.add('');
+    FLines.Add('');
-    lines.insert(0,'');
+    FLines.Insert(0, '');
-    if secondary='' then
+    if FSecondary = '' then
-      case PrimaryCode of
+      case FPrimaryCode of
-        MP_TEXT:       secondary:='plain';
+        MP_TEXT:
-        MP_MULTIPART:  secondary:='mixed';
+          FSecondary := 'plain';
-        MP_MESSAGE:    secondary:='rfc822';
+        MP_MULTIPART:
-        MP_BINARY:     secondary:='octet-stream';
+          FSecondary := 'mixed';
+        MP_MESSAGE:
+          FSecondary := 'rfc822';
+        MP_BINARY:
+          FSecondary := 'octet-stream';
       end;
-    if description<>''
+    if FDescription <> '' then
-      then lines.insert(0,'Content-Description: '+Description);
+      FLines.Insert(0, 'Content-Description: ' + FDescription);
-    if disposition<>'' then
+    if FDisposition <> '' then
     begin
-        s:='';
+      s := '';
-        if filename<>''
+      if FFileName <> '' then
-          then s:='; filename="'+filename+'"';
+        s := '; FileName="' + FFileName + '"';
-        lines.insert(0,'Content-Disposition: '+lowercase(disposition)+s);
+      FLines.Insert(0, 'Content-Disposition: ' + LowerCase(FDisposition) + s);
     end;
-    if contentID<>''
+    if FContentID <> '' then
-      then lines.insert(0,'Content-ID: '+contentID);
+      FLines.Insert(0, 'Content-ID: ' + FContentID);
 
-    case EncodingCode of
+    case FEncodingCode of
-      ME_7BIT:              s:='7bit';
+      ME_7BIT:
-      ME_8BIT:              s:='8bit';
+        s := '7bit';
-      ME_QUOTED_PRINTABLE:  s:='Quoted-printable';
+      ME_8BIT:
-      ME_BASE64:            s:='Base64';
+        s := '8bit';
+      ME_QUOTED_PRINTABLE:
+        s := 'Quoted-printable';
+      ME_BASE64:
+        s := 'Base64';
     end;
-    case PrimaryCode of
+    case FPrimaryCode of
       MP_TEXT,
-      MP_BINARY:     lines.insert(0,'Content-Transfer-Encoding: '+s);
+        MP_BINARY: FLines.Insert(0, 'Content-Transfer-Encoding: ' + s);
     end;
-    case PrimaryCode of
+    case FPrimaryCode of
-      MP_TEXT:       s:=primary+'/'+secondary+'; charset='+GetIDfromCP(charsetcode);
+      MP_TEXT:
-      MP_MULTIPART:  s:=primary+'/'+secondary+'; boundary="'+boundary+'"';
+        s := FPrimary + '/' + FSecondary + '; charset=' + GetIDfromCP(FCharsetCode);
-      MP_MESSAGE:    s:=primary+'/'+secondary+'';
+      MP_MULTIPART:
-      MP_BINARY:     s:=primary+'/'+secondary+'; name="'+FileName+'"';
+        s := FPrimary + '/' + FSecondary + '; boundary="' + Boundary + '"';
+      MP_MESSAGE:
+        s := FPrimary + '/' + FSecondary + '';
+      MP_BINARY:
+        s := FPrimary + '/' + FSecondary + '; name="' + FFileName + '"';
     end;
-    lines.insert(0,'Content-type: '+s);
+    FLines.Insert(0, 'Content-type: ' + s);
   finally
-    l.free;
+    l.Free;
   end;
 end;
 
 {==============================================================================}
-{TMIMEPart.MimeTypeFromExt}
+
-procedure TMIMEPart.MimeTypeFromExt(value:string);
+procedure TMIMEPart.MimeTypeFromExt(Value: string);
 var
-  s:string;
+  s: string;
-  n:integer;
+  n: Integer;
 begin
-  primary:='';
+  Primary := '';
-  secondary:='';
+  FSecondary := '';
-  s:=uppercase(extractfileext(value));
+  s := UpperCase(ExtractFileExt(Value));
-  if s=''
+  if s = '' then
-    then s:=uppercase(value);
+    s := UpperCase(Value);
-  s:=separateright(s,'.');
+  s := SeparateRight(s, '.');
-  for n:=0 to MaxMimeType do
+  for n := 0 to MaxMimeType do
-    if MimeType[n,0]=s then
+    if MimeType[n, 0] = s then
     begin
-        primary:=MimeType[n,1];
+      Primary := MimeType[n, 1];
-        secondary:=MimeType[n,2];
+      FSecondary := MimeType[n, 2];
-        break;
+      Break;
     end;
-  if primary=''
+  if Primary = '' then
-    then primary:='application';
+    Primary := 'application';
-  if secondary=''
+  if FSecondary = '' then
-    then secondary:='mixed';
+    FSecondary := 'mixed';
-end;
-
-{==============================================================================}
-{TMIMEPart.Setprimary}
-procedure TMIMEPart.Setprimary(Value:string);
-var
-  s:string;
-begin
-  Fprimary:=Value;
-  s:=uppercase(Value);
-  PrimaryCode:=MP_BINARY;
-  if Pos('TEXT',s)=1
-    then PrimaryCode:=MP_TEXT;
-  if Pos('MULTIPART',s)=1
-    then PrimaryCode:=MP_MULTIPART;
-  if Pos('MESSAGE',s)=1
-    then PrimaryCode:=MP_MESSAGE;
-end;
-
-{TMIMEPart.SetEncoding}
-procedure TMIMEPart.SetEncoding(Value:string);
-var
-  s:string;
-begin
-  FEncoding:=Value;
-  s:=uppercase(Value);
-  EncodingCode:=ME_7BIT;
-  if Pos('8BIT',s)=1
-    then EncodingCode:=ME_8BIT;
-  if Pos('QUOTED-PRINTABLE',s)=1
-    then EncodingCode:=ME_QUOTED_PRINTABLE;
-  if Pos('BASE64',s)=1
-    then EncodingCode:=ME_BASE64;
-  if Pos('X-UU',s)=1
-    then EncodingCode:=ME_UU;
-  if Pos('X-XX',s)=1
-    then EncodingCode:=ME_XX;
-end;
-
-{TMIMEPart.SetCharset}
-procedure TMIMEPart.SetCharset(Value:string);
-begin
-  FCharset:=Value;
-  CharsetCode:=GetCPfromID(value);
-end;
-
-{==============================================================================}
-{GenerateBoundary}
-function GenerateBoundary:string;
-var
-  x:integer;
-begin
-  randomize;
-  x:=random(maxint);
-  result:='----'+Inttohex(x,8)+'_Synapse_message_boundary';
 end;
 
 {==============================================================================}
 
+procedure TMIMEPart.SetPrimary(Value: string);
+var
+  s: string;
 begin
-  exit;
+  FPrimary := Value;
-  asm
+  s := UpperCase(Value);
-    db 'Synapse MIME messages encoding and decoding library by Lukas Gebauer',0
+  FPrimaryCode := MP_BINARY;
-  end;
+  if Pos('TEXT', s) = 1 then
+    FPrimaryCode := MP_TEXT;
+  if Pos('MULTIPART', s) = 1 then
+    FPrimaryCode := MP_MULTIPART;
+  if Pos('MESSAGE', s) = 1 then
+    FPrimaryCode := MP_MESSAGE;
+end;
+
+procedure TMIMEPart.SetEncoding(Value: string);
+var
+  s: string;
+begin
+  FEncoding := Value;
+  s := UpperCase(Value);
+  FEncodingCode := ME_7BIT;
+  if Pos('8BIT', s) = 1 then
+    FEncodingCode := ME_8BIT;
+  if Pos('QUOTED-PRINTABLE', s) = 1 then
+    FEncodingCode := ME_QUOTED_PRINTABLE;
+  if Pos('BASE64', s) = 1 then
+    FEncodingCode := ME_BASE64;
+  if Pos('X-UU', s) = 1 then
+    FEncodingCode := ME_UU;
+  if Pos('X-XX', s) = 1 then
+    FEncodingCode := ME_XX;
+end;
+
+procedure TMIMEPart.SetCharset(Value: string);
+begin
+  FCharset := Value;
+  FCharsetCode := GetCPFromID(Value);
+end;
+
+{==============================================================================}
+
+function GenerateBoundary: string;
+var
+  x: Integer;
+begin
+  Randomize;
+  x := Random(MaxInt);
+  Result := '----' + IntToHex(x, 8) + '_Synapse_message_boundary';
+end;
+
 end.

pingsend.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.000.000 |
+| Project : Delphree - Synapse                                   | 002.001.000 |
 |==============================================================================|
 | Content: PING sender                                                         |
 |==============================================================================|
-| The contents of this file are subject to the Mozilla Public License Ver. 1.0 |
+| The contents of this file are subject to the Mozilla Public License Ver. 1.1 |
 | (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/ |
 |                                                                              |
@@ -14,7 +14,7 @@
 | 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)2000.                     |
+| Portions created by Lukas Gebauer are Copyright (c)2000,2001.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -25,27 +25,12 @@
 
 {
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
+See 'winsock2.txt' file in distribute package!
-Remember, this unit work only on Linux or Windows with Winsock2!
- (on Win98 and WinNT 4.0 or higher)
-If you must use this unit on Win95, download Wínsock2 from Microsoft
-and distribute it with your application!
-
-In spite of I use Winsock level version 1.1, RAW sockets work in this level only
-if Winsock2 is installed on your computer!!!
-
-On WinNT standardly RAW sockets work if program is running under user with
-administrators provilegies. To use RAW sockets under another users, you must
-create the following registry variable and set its value to DWORD 1:
-
-HKLM\System\CurrentControlSet\Services\Afd\Parameters\DisableRawSecurity
-
-After you change the registry, you need to restart your computer!
-
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 }
 
 {$Q-}
+{$WEAKPACKAGEUNIT ON}
 
 unit PINGsend;
 
@@ -53,159 +38,183 @@ interface
 
 uses
 {$IFDEF LINUX}
-  libc,
+  Libc,
 {$ELSE}
-  windows,
+  Windows,
 {$ENDIF}
-  synsock, SysUtils, blcksck2, Synautil;
+  SysUtils,
+  synsock, blcksock, SynaUtil;
 
 const
-  ICMP_ECHO=8;
+  ICMP_ECHO = 8;
-  ICMP_ECHOREPLY=0;
+  ICMP_ECHOREPLY = 0;
 
 type
+  TIcmpEchoHeader = record
+    i_type: Byte;
+    i_code: Byte;
+    i_checkSum: Word;
+    i_Id: Word;
+    i_seq: Word;
+    TimeStamp: ULONG;
+  end;
 
-TIcmpEchoHeader = Record
+  TPINGSend = class(TObject)
-  i_type : Byte;
-  i_code : Byte;
-  i_checkSum : Word;
-  i_Id : Word;
-  i_seq : Word;
-  TimeStamp : ULong;
-End;
-
-TPINGSend=class(TObject)
   private
-    Sock:TICMPBlockSocket;
+    FSock: TICMPBlockSocket;
-    Buffer:string;
+    FBuffer: string;
-    seq:integer;
+    FSeq: Integer;
-    id:integer;
+    FId: Integer;
-    function checksum:integer;
+    FTimeout: Integer;
-    function GetTick:cardinal;
+    FPacketSize: Integer;
+    FPingTime: Integer;
+    function Checksum: Integer;
+    function GetTick: Cardinal;
+    function ReadPacket: Boolean;
   public
-    timeout:integer;
+    function Ping(const Host: string): Boolean;
-    PacketSize:integer;
-    PingTime:integer;
-    function ping(host:string):Boolean;
     constructor Create;
     destructor Destroy; override;
-end;
+  published
+    property Timeout: Integer read FTimeout Write FTimeout;
+    property PacketSize: Integer read FPacketSize Write FPacketSize;
+    property PingTime: Integer read FPingTime;
+  end;
 
-function PingHost(host:string):integer;
+function PingHost(const Host: string): Integer;
 
 implementation
 
 {==============================================================================}
 
-{TPINGSend.Create}
+constructor TPINGSend.Create;
-Constructor TPINGSend.Create;
 begin
   inherited Create;
-  sock:=TICMPBlockSocket.create;
+  FSock := TICMPBlockSocket.Create;
-  sock.CreateSocket;
+  FSock.CreateSocket;
-  timeout:=5000;
+  FTimeout := 5000;
-  packetsize:=32;
+  FPacketSize := 32;
-  seq:=0;
+  FSeq := 0;
+  Randomize;
 end;
 
-{TPINGSend.Destroy}
+destructor TPINGSend.Destroy;
-Destructor TPINGSend.Destroy;
 begin
-  Sock.free;
+  FSock.Free;
-  inherited destroy;
+  inherited Destroy;
 end;
 
-{TPINGSend.ping}
+function TPINGSend.ReadPacket: Boolean;
-function TPINGSend.ping(host:string):Boolean;
 var
-  PIPHeader:^TIPHeader;
+  x: Integer;
-  IpHdrLen:Integer;
-  PIcmpEchoHeader:^TICMPEchoHeader;
-  n,x:integer;
 begin
-  Result:=False;
+  Result := FSock.CanRead(FTimeout);
-  sock.connect(host,'0');
+  if Result then
-  Buffer:=StringOfChar(#0,SizeOf(TICMPEchoHeader)+packetSize);
-  PIcmpEchoHeader := Pointer(Buffer);
-  With PIcmpEchoHeader^ Do Begin
-    i_type:=ICMP_ECHO;
-    i_code:=0;
-    i_CheckSum:=0;
-    id:=Random(32767);
-    i_Id:=id;
-    TimeStamp:=GetTick;
-    Inc(Seq);
-    i_Seq:=Seq;
-    for n:=Succ(SizeOf(TicmpEchoHeader)) to Length(Buffer) do
-      Buffer[n]:=#$55;
-    i_CheckSum:=CheckSum;
-  end;
-  sock.sendString(Buffer);
-  if sock.canread(timeout)
-    then begin
-      x:=sock.waitingdata;
-      setlength(Buffer,x);
-      sock.recvbuffer(Pointer(Buffer),x);
-      PIpHeader:=Pointer(Buffer);
-      IpHdrLen:=(PIpHeader^.VerLen and $0F)*4;
-      PIcmpEchoHeader:=@Buffer[IpHdrLen+1];
-      if (PIcmpEchoHeader^.i_type=ICMP_ECHOREPLY)
-// Linux return from localhost ECHO instead ECHOREPLY???
-       or (PIcmpEchoHeader^.i_type=ICMP_ECHO) then
-        if (PIcmpEchoHeader^.i_id=id) then
   begin
-            PingTime:=GetTick-PIcmpEchoHeader^.TimeStamp;
+    x := FSock.WaitingData;
-            Result:=True;
+    SetLength(FBuffer, x);
-          end;
+    FSock.RecvBuffer(Pointer(FBuffer), x);
   end;
 end;
 
-{TPINGSend.checksum}
+function TPINGSend.Ping(const Host: string): Boolean;
-function TPINGSend.checksum:integer;
-type
-  tWordArray=Array[0..0] Of Word;
 var
-  PWordArray:^TWordArray;
+  IPHeadPtr: ^TIPHeader;
-  CkSum:Dword;
+  IpHdrLen: Integer;
-  Num,Remain:Integer;
+  IcmpEchoHeaderPtr: ^TICMPEchoHeader;
-  n:Integer;
+  n: Integer;
+  t: Boolean;
 begin
-  Num:=length(Buffer) div 2;
+  Result := False;
-  Remain:=length(Buffer) mod 2;
+  FSock.Connect(Host, '0');
-  PWordArray:=Pointer(Buffer);
+  FBuffer := StringOfChar(#0, SizeOf(TICMPEchoHeader) + FPacketSize);
-  CkSum := 0;
+  IcmpEchoHeaderPtr := Pointer(FBuffer);
-  for n:=0 to Num-1 do
+  with IcmpEchoHeaderPtr^ do
-    CkSum:=CkSum+PWordArray^[n];
+  begin
-  if Remain<>0 then
+    i_type := ICMP_ECHO;
-    CkSum:=CkSum+ord(Buffer[Length(Buffer)]);
+    i_code := 0;
-  CkSum:=(CkSum shr 16)+(CkSum and $FFFF);
+    i_CheckSum := 0;
-  CkSum:=CkSum+(CkSum shr 16);
+    FId := Random(32767);
-  Result:=Word(not CkSum);
+    i_Id := FId;
+    TimeStamp := GetTick;
+    Inc(FSeq);
+    i_Seq := FSeq;
+    for n := Succ(SizeOf(TIcmpEchoHeader)) to Length(FBuffer) do
+      FBuffer[n] := #$55;
+    i_CheckSum := CheckSum;
+  end;
+  FSock.SendString(FBuffer);
+  repeat
+    t := ReadPacket;
+    if not t then
+      break;
+    IPHeadPtr := Pointer(FBuffer);
+    IpHdrLen := (IPHeadPtr^.VerLen and $0F) * 4;
+    IcmpEchoHeaderPtr := @FBuffer[IpHdrLen + 1];
+  until IcmpEchoHeaderPtr^.i_type <> ICMP_ECHO;
+  //it discard sometimes possible 'echoes' of previosly sended packet...
+  if t then
+    if (IcmpEchoHeaderPtr^.i_type = ICMP_ECHOREPLY) then
+      if (IcmpEchoHeaderPtr^.i_id = FId) then
+      begin
+        FPingTime := GetTick - IcmpEchoHeaderPtr^.TimeStamp;
+        Result := True;
+      end;
 end;
 
-{TPINGSend.GetTick}
+function TPINGSend.Checksum: Integer;
-function TPINGSend.GetTick:cardinal;
+type
+  TWordArray = array[0..0] of Word;
+var
+  WordArr: ^TWordArray;
+  CkSum: DWORD;
+  Num, Remain: Integer;
+  n: Integer;
 begin
-{$IFDEF LINUX}
+  Num := Length(FBuffer) div 2;
-  result:=clock div (CLOCKS_PER_SEC div 1000);
+  Remain := Length(FBuffer) mod 2;
-{$ELSE}
+  WordArr := Pointer(FBuffer);
-  result:=windows.GetTickCount;
+  CkSum := 0;
-{$ENDIF}
+  for n := 0 to Num - 1 do
+    CkSum := CkSum + WordArr^[n];
+  if Remain <> 0 then
+    CkSum := CkSum + Ord(FBuffer[Length(FBuffer)]);
+  CkSum := (CkSum shr 16) + (CkSum and $FFFF);
+  CkSum := CkSum + (CkSum shr 16);
+  Result := Word(not CkSum);
 end;
 
+{$IFDEF LINUX}
+
+function TPINGSend.GetTick: Cardinal;
+var
+  Stamp: TTimeStamp;
+begin
+  Stamp := DateTimeToTimeStamp(Now);
+  Result := Stamp.Time;
+end;
+
+{$ELSE}
+
+function TPINGSend.GetTick: Cardinal;
+begin
+  Result := Windows.GetTickCount;
+end;
+
+{$ENDIF}
+
 {==============================================================================}
 
-function PingHost(host:string):integer;
+function PingHost(const Host: string): Integer;
-var
-  ping:TPINGSend;
 begin
-  ping:=TPINGSend.Create;
+  with TPINGSend.Create do
   try
-    if ping.ping(host)
+    if Ping(Host) then
-      then Result:=ping.pingtime
+      Result := PingTime
-      else Result:=-1;
+    else
+      Result := -1;
   finally
-    ping.Free;
+    Free;
   end;
 end;
 

pop3send.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.001.000 |
+| Project : Delphree - Synapse                                   | 001.001.001 |
 |==============================================================================|
 | Content: POP3 client                                                         |
 |==============================================================================|
-| The contents of this file are subject to the Mozilla Public License Ver. 1.0 |
+| The contents of this file are subject to the Mozilla Public License Ver. 1.1 |
 | (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/ |
 |                                                                              |
@@ -23,252 +23,239 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
+{$WEAKPACKAGEUNIT ON}
+
 unit POP3send;
 
 interface
+
 uses
-  Blcksock, sysutils, classes, SynaUtil, SynaCode;
+  SysUtils, Classes,
+  blcksock, SynaUtil, SynaCode;
 
 const
-  CRLF=#13+#10;
+  cPop3Protocol = 'pop3';
 
 type
-  TPOP3AuthType = (POP3AuthAll,POP3AuthLogin,POP3AuthAPOP);
+  TPOP3AuthType = (POP3AuthAll, POP3AuthLogin, POP3AuthAPOP);
 
-  TPOP3Send = class
+  TPOP3Send = class(TObject)
   private
-    Sock:TTCPBlockSocket;
+    FSock: TTCPBlockSocket;
-    function ReadResult(full:boolean):integer;
+    FTimeout: Integer;
-    function Connect:Boolean;
+    FPOP3Host: string;
+    FPOP3Port: string;
+    FResultCode: Integer;
+    FResultString: string;
+    FFullResult: TStringList;
+    FUsername: string;
+    FPassword: string;
+    FStatCount: Integer;
+    FStatSize: Integer;
+    FTimeStamp: string;
+    FAuthType: TPOP3AuthType;
+    function ReadResult(Full: Boolean): Integer;
+    function Connect: Boolean;
+    function AuthLogin: Boolean;
+    function AuthApop: Boolean;
   public
-    timeout:integer;
+    constructor Create;
-    POP3Host:string;
+    destructor Destroy; override;
-    POP3Port:string;
+    function Login: Boolean;
-    ResultCode:integer;
+    procedure Logout;
-    ResultString:string;
+    function Reset: Boolean;
-    FullResult:TStringList;
+    function NoOp: Boolean;
-    Username:string;
+    function Stat: Boolean;
-    Password:string;
+    function List(Value: Integer): Boolean;
-    StatCount:integer;
+    function Retr(Value: Integer): Boolean;
-    StatSize:integer;
+    function Dele(Value: Integer): Boolean;
-    TimeStamp:string;
+    function Top(Value, Maxlines: Integer): Boolean;
-    AuthType:TPOP3AuthType;
+    function Uidl(Value: Integer): Boolean;
-    Constructor Create;
+  published
-    Destructor Destroy; override;
+    property Timeout: Integer read FTimeout Write FTimeout;
-    function AuthLogin:Boolean;
+    property POP3Host: string read FPOP3Host Write FPOP3Host;
-    function AuthApop:Boolean;
+    property POP3Port: string read FPOP3Port Write FPOP3Port;
-    function login:Boolean;
+    property ResultCode: Integer read FResultCode;
-    procedure logout;
+    property ResultString: string read FResultString;
-    function reset:Boolean;
+    property FullResult: TStringList read FFullResult;
-    function noop:Boolean;
+    property Username: string read FUsername Write FUsername;
-    function stat:Boolean;
+    property Password: string read FPassword Write FPassword;
-    function list(value:integer):Boolean;
+    property StatCount: Integer read FStatCount;
-    function retr(value:integer):Boolean;
+    property StatSize: Integer read  FStatSize;
-    function dele(value:integer):Boolean;
+    property TimeStamp: string read FTimeStamp;
-    function top(value,maxlines:integer):Boolean;
+    property AuthType: TPOP3AuthType read FAuthType Write FAuthType;
-    function uidl(value:integer):Boolean;
   end;
 
 implementation
 
-{TPOP3Send.Create}
+const
-Constructor TPOP3Send.Create;
+  CRLF = #13#10;
+
+constructor TPOP3Send.Create;
 begin
   inherited Create;
-  FullResult:=TStringList.create;
+  FFullResult := TStringList.Create;
-  sock:=TTCPBlockSocket.create;
+  FSock := TTCPBlockSocket.Create;
-  sock.CreateSocket;
+  FSock.CreateSocket;
-  timeout:=300000;
+  FTimeout := 300000;
-  POP3host:='localhost';
+  FPOP3host := cLocalhost;
-  POP3Port:='pop3';
+  FPOP3Port := cPop3Protocol;
-  Username:='';
+  FUsername := '';
-  Password:='';
+  FPassword := '';
-  StatCount:=0;
+  FStatCount := 0;
-  StatSize:=0;
+  FStatSize := 0;
-  AuthType:=POP3AuthAll;
+  FAuthType := POP3AuthAll;
 end;
 
-{TPOP3Send.Destroy}
+destructor TPOP3Send.Destroy;
-Destructor TPOP3Send.Destroy;
 begin
-  Sock.free;
+  FSock.Free;
-  FullResult.free;
+  FullResult.Free;
-  inherited destroy;
+  inherited Destroy;
 end;
 
-{TPOP3Send.ReadResult}
+function TPOP3Send.ReadResult(Full: Boolean): Integer;
-function TPOP3Send.ReadResult(full:boolean):integer;
 var
-  s:string;
+  s: string;
 begin
-  Result:=0;
+  Result := 0;
-  FullResult.Clear;
+  FFullResult.Clear;
-  s:=sock.recvstring(timeout);
+  s := FSock.RecvString(FTimeout);
-  if pos('+OK',s)=1
+  if Pos('+OK', s) = 1 then
-    then result:=1;
+    Result := 1;
-  ResultString:=s;
+  FResultString := s;
-  if full and (result=1)then
+  if Full and (Result = 1) then
     repeat
-      s:=sock.recvstring(timeout);
+      s := FSock.RecvString(FTimeout);
-      if s='.'
+      if s = '.' then
-        then break;
+        Break;
-      FullResult.add(s);
+      FFullResult.Add(s);
-    until sock.LastError<>0;
+    until FSock.LastError <> 0;
-  ResultCode:=Result;
+  FResultCode := Result;
 end;
 
-{TPOP3Send.AuthLogin}
+function TPOP3Send.AuthLogin: Boolean;
-function TPOP3Send.AuthLogin:Boolean;
 begin
-  Result:=false;
+  Result := False;
-  Sock.SendString('USER '+username+CRLF);
+  FSock.SendString('USER ' + FUserName + CRLF);
-  if readresult(false)<>1 then Exit;
+  if ReadResult(False) <> 1 then
-  Sock.SendString('PASS '+password+CRLF);
+    Exit;
-  if readresult(false)<>1 then Exit;
+  FSock.SendString('PASS ' + FPassword + CRLF);
-  Result:=True;
+  Result := ReadResult(False) = 1;
 end;
 
-{TPOP3Send.AuthAPop}
+function TPOP3Send.AuthAPOP: Boolean;
-function TPOP3Send.AuthAPOP:Boolean;
 var
-  s:string;
+  s: string;
 begin
-  Result:=false;
+  s := StrToHex(MD5(FTimeStamp + FPassWord));
-  s:=StrToHex(MD5(TimeStamp+PassWord));
+  FSock.SendString('APOP ' + FUserName + ' ' + s + CRLF);
-  Sock.SendString('APOP '+username+' '+s+CRLF);
+  Result := ReadResult(False) = 1;
-  if readresult(false)<>1 then Exit;
-  Result:=True;
 end;
 
-
+function TPOP3Send.Connect: Boolean;
-{TPOP3Send.Connect}
-function TPOP3Send.Connect:Boolean;
 begin
-//Do not call this function! It is calling by LOGIN method!
+  // Do not call this function! It is calling by LOGIN method!
-  Result:=false;
+  FStatCount := 0;
-  StatCount:=0;
+  FStatSize := 0;
-  StatSize:=0;
+  FSock.CloseSocket;
-  sock.CloseSocket;
+  FSock.LineBuffer := '';
-  sock.LineBuffer:='';
+  FSock.CreateSocket;
-  sock.CreateSocket;
+  FSock.Connect(POP3Host, POP3Port);
-  sock.Connect(POP3Host,POP3Port);
+  Result := FSock.LastError = 0;
-  if sock.lasterror<>0 then Exit;
-  Result:=True;
 end;
 
-{TPOP3Send.login}
+function TPOP3Send.Login: Boolean;
-function TPOP3Send.login:Boolean;
 var
-  s,s1:string;
+  s, s1: string;
 begin
-  Result:=False;
+  Result := False;
-  TimeStamp:='';
+  FTimeStamp := '';
-  if not Connect then Exit;
+  if not Connect then
-  if readresult(false)<>1 then Exit;
+    Exit;
-  s:=separateright(Resultstring,'<');
+  if ReadResult(False) <> 1 then
-  if s<>Resultstring then
+    Exit;
+  s := SeparateRight(FResultString, '<');
+  if s <> FResultString then
   begin
-      s1:=separateleft(s,'>');
+    s1 := SeparateLeft(s, '>');
-      if s1<>s
+    if s1 <> s then
-        then TimeStamp:='<'+s1+'>';
+      FTimeStamp := '<' + s1 + '>';
   end;
-  result:=false;
+  Result := False;
-  if (TimeStamp<>'') and not(AuthType=POP3AuthLogin)
+  if (FTimeStamp <> '') and not (FAuthType = POP3AuthLogin) then
-    then result:=AuthApop;
+    Result := AuthApop;
-  if not(Result) and not(AuthType=POP3AuthAPOP)
+  if not Result and not (FAuthType = POP3AuthAPOP) then
-    then result:=AuthLogin;
+    Result := AuthLogin;
 end;
 
-{TPOP3Send.logout}
+procedure TPOP3Send.Logout;
-procedure TPOP3Send.logout;
 begin
-  Sock.SendString('QUIT'+CRLF);
+  FSock.SendString('QUIT' + CRLF);
-  readresult(false);
+  ReadResult(False);
-  Sock.CloseSocket;
+  FSock.CloseSocket;
 end;
 
-{TPOP3Send.reset}
+function TPOP3Send.Reset: Boolean;
-function TPOP3Send.reset:Boolean;
 begin
-  Result:=false;
+  FSock.SendString('RSET' + CRLF);
-  Sock.SendString('RSET'+CRLF);
+  Result := ReadResult(False) = 1;
-  if readresult(false)<>1 then Exit;
-  Result:=True;
 end;
 
-{TPOP3Send.noop}
+function TPOP3Send.NoOp: Boolean;
-function TPOP3Send.noop:Boolean;
 begin
-  Result:=false;
+  FSock.SendString('NOOP' + CRLF);
-  Sock.SendString('NOOP'+CRLF);
+  Result := ReadResult(False) = 1;
-  if readresult(false)<>1 then Exit;
-  Result:=True;
 end;
 
-{TPOP3Send.stat}
+function TPOP3Send.Stat: Boolean;
-function TPOP3Send.stat:Boolean;
 var
-  s:string;
+  s: string;
 begin
-  Result:=false;
+  Result := False;
-  Sock.SendString('STAT'+CRLF);
+  FSock.SendString('STAT' + CRLF);
-  if readresult(false)<>1 then Exit;
+  if ReadResult(False) <> 1 then
-  s:=separateright(ResultString,'+OK ');
+    Exit;
-  StatCount:=StrToIntDef(separateleft(s,' '),0);
+  s := SeparateRight(ResultString, '+OK ');
-  StatSize:=StrToIntDef(separateright(s,' '),0);
+  FStatCount := StrToIntDef(SeparateLeft(s, ' '), 0);
-  Result:=True;
+  FStatSize := StrToIntDef(SeparateRight(s, ' '), 0);
+  Result := True;
 end;
 
-{TPOP3Send.list}
+function TPOP3Send.List(Value: Integer): Boolean;
-function TPOP3Send.list(value:integer):Boolean;
 begin
-  Result:=false;
+  if Value = 0 then
-  if value=0
+    FSock.SendString('LIST' + CRLF)
-    then Sock.SendString('LIST'+CRLF)
+  else
-    else Sock.SendString('LIST '+IntToStr(value)+CRLF);
+    FSock.SendString('LIST ' + IntToStr(Value) + CRLF);
-  if readresult(value=0)<>1 then Exit;
+  Result := ReadResult(Value = 0) = 1;
-  Result:=True;
 end;
 
-{TPOP3Send.retr}
+function TPOP3Send.Retr(Value: Integer): Boolean;
-function TPOP3Send.retr(value:integer):Boolean;
 begin
-  Result:=false;
+  FSock.SendString('RETR ' + IntToStr(Value) + CRLF);
-  Sock.SendString('RETR '+IntToStr(value)+CRLF);
+  Result := ReadResult(True) = 1;
-  if readresult(true)<>1 then Exit;
-  Result:=True;
 end;
 
-{TPOP3Send.dele}
+function TPOP3Send.Dele(Value: Integer): Boolean;
-function TPOP3Send.dele(value:integer):Boolean;
 begin
-  Result:=false;
+  FSock.SendString('DELE ' + IntToStr(Value) + CRLF);
-  Sock.SendString('DELE '+IntToStr(value)+CRLF);
+  Result := ReadResult(False) = 1;
-  if readresult(false)<>1 then Exit;
-  Result:=True;
 end;
 
-{TPOP3Send.top}
+function TPOP3Send.Top(Value, Maxlines: Integer): Boolean;
-function TPOP3Send.top(value,maxlines:integer):Boolean;
 begin
-  Result:=false;
+  FSock.SendString('TOP ' + IntToStr(Value) + ' ' + IntToStr(Maxlines) + CRLF);
-  Sock.SendString('TOP '+IntToStr(value)+' '+IntToStr(maxlines)+CRLF);
+  Result := ReadResult(True) = 1;
-  if readresult(true)<>1 then Exit;
-  Result:=True;
 end;
 
-{TPOP3Send.uidl}
+function TPOP3Send.Uidl(Value: Integer): Boolean;
-function TPOP3Send.uidl(value:integer):Boolean;
 begin
-  Result:=false;
+  if Value = 0 then
-  if value=0
+    FSock.SendString('UIDL' + CRLF)
-    then Sock.SendString('UIDL'+CRLF)
+  else
-    else Sock.SendString('UIDL '+IntToStr(value)+CRLF);
+    FSock.SendString('UIDL ' + IntToStr(Value) + CRLF);
-  if readresult(value=0)<>1 then Exit;
+  Result := ReadResult(Value = 0) = 1;
-  Result:=True;
 end;
 
-
-{==============================================================================}
-
 end.

smtpsend.pas

@@ -1,11 +1,11 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.001.002 |
+| Project : Delphree - Synapse                                   | 002.001.003 |
 |==============================================================================|
 | Content: SMTP client                                                         |
 |==============================================================================|
-| The contents of this file are subject to the Mozilla Public License Ver. 1.0 |
+| The contents of this file are Subject to the Mozilla Public License Ver. 1.1 |
 | (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/ |
+| 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 |
@@ -23,485 +23,481 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
+{$WEAKPACKAGEUNIT ON}
+
 unit SMTPsend;
 
 interface
+
 uses
-  Blcksock, sysutils, classes, SynaUtil, SynaCode;
+  SysUtils, Classes,
+  blcksock, SynaUtil, SynaCode;
 
 const
-  CRLF=#13+#10;
+  cSmtpProtocol = 'smtp';
 
 type
-  TSMTPSend = class
+  TSMTPSend = class(TObject)
   private
-    Sock:TTCPBlockSocket;
+    FSock: TTCPBlockSocket;
-    procedure EnhancedCode(value:string);
+    FTimeout: Integer;
-    function ReadResult:integer;
+    FSMTPHost: string;
+    FSMTPPort: string;
+    FResultCode: Integer;
+    FResultString: string;
+    FFullResult: TStringList;
+    FESMTPcap: TStringList;
+    FESMTP: Boolean;
+    FUsername: string;
+    FPassword: string;
+    FAuthDone: Boolean;
+    FESMTPSize: Boolean;
+    FMaxSize: Integer;
+    FEnhCode1: Integer;
+    FEnhCode2: Integer;
+    FEnhCode3: Integer;
+    FSystemName: string;
+    procedure EnhancedCode(const Value: string);
+    function ReadResult: Integer;
+    function AuthLogin: Boolean;
+    function AuthCram: Boolean;
+    function Helo: Boolean;
+    function Ehlo: Boolean;
+    function Connect: Boolean;
   public
-    timeout:integer;
+    constructor Create;
-    SMTPHost:string;
+    destructor Destroy; override;
-    SMTPPort:string;
+    function Login: Boolean;
-    ResultCode:integer;
+    procedure Logout;
-    ResultString:string;
+    function Reset: Boolean;
-    FullResult:TStringList;
+    function NoOp: Boolean;
-    ESMTPcap:TStringList;
+    function MailFrom(const Value: string; Size: Integer): Boolean;
-    ESMTP:boolean;
+    function MailTo(const Value: string): Boolean;
-    Username:string;
+    function MailData(const Value: Tstrings): Boolean;
-    Password:string;
+    function Etrn(const Value: string): Boolean;
-    AuthDone:boolean;
+    function Verify(const Value: string): Boolean;
-    ESMTPSize:boolean;
+    function EnhCodeString: string;
-    MaxSize:integer;
+    function FindCap(const Value: string): string;
-    EnhCode1:integer;
+  published
-    EnhCode2:integer;
+    property Timeout: Integer read FTimeout Write FTimeout;
-    EnhCode3:integer;
+    property SMTPHost: string read FSMTPHost Write FSMTPHost;
-    SystemName:string;
+    property SMTPPort: string read FSMTPPort Write FSMTPPort;
-    Constructor Create;
+    property ResultCode: Integer read FResultCode;
-    Destructor Destroy; override;
+    property ResultString: string read FResultString;
-    function AuthLogin:Boolean;
+    property FullResult: TStringList read FFullResult;
-    function AuthCram:Boolean;
+    property ESMTPcap: TStringList read FESMTPcap;
-    function Connect:Boolean;
+    property ESMTP: Boolean read FESMTP;
-    function Helo:Boolean;
+    property Username: string read FUsername Write FUsername;
-    function Ehlo:Boolean;
+    property Password: string read FPassword Write FPassword;
-    function login:Boolean;
+    property AuthDone: Boolean read FAuthDone;
-    procedure logout;
+    property ESMTPSize: Boolean read FESMTPSize;
-    function reset:Boolean;
+    property MaxSize: Integer read FMaxSize;
-    function noop:Boolean;
+    property EnhCode1: Integer read FEnhCode1;
-    function mailfrom(Value:string; size:integer):Boolean;
+    property EnhCode2: Integer read FEnhCode2;
-    function mailto(Value:string):Boolean;
+    property EnhCode3: Integer read FEnhCode3;
-    function maildata(Value:Tstrings):Boolean;
+    property SystemName: string read FSystemName Write FSystemName;
-    function etrn(Value:string):Boolean;
-    function verify(Value:string):Boolean;
-    function EnhCodeString:string;
-    function FindCap(value:string):string;
   end;
 
-function SendtoRaw
+function SendToRaw(const MailFrom, MailTo, SMTPHost: string;
-(mailfrom,mailto,SMTPHost:string;maildata:TStrings;Username,Password:string):Boolean;
+  const MailData: TStrings; const Username, Password: string): Boolean;
-function Sendto
+function SendTo(const MailFrom, MailTo, Subject, SMTPHost: string;
-(mailfrom,mailto,subject,SMTPHost:string;maildata:TStrings):Boolean;
+  const MailData: TStrings): Boolean;
-function SendtoEx
+function SendToEx(const MailFrom, MailTo, Subject, SMTPHost: string;
-(mailfrom,mailto,subject,SMTPHost:string;maildata:TStrings;Username,Password:string):Boolean;
+  const MailData: TStrings; const Username, Password: string): Boolean;
 
 implementation
 
-{TSMTPSend.Create}
+const
-Constructor TSMTPSend.Create;
+  CRLF = #13#10;
+
+constructor TSMTPSend.Create;
 begin
   inherited Create;
-  FullResult:=TStringList.create;
+  FFullResult := TStringList.Create;
-  ESMTPcap:=TStringList.create;
+  FESMTPcap := TStringList.Create;
-  sock:=TTCPBlockSocket.create;
+  FSock := TTCPBlockSocket.Create;
-  sock.CreateSocket;
+  FSock.CreateSocket;
-  timeout:=300000;
+  FTimeout := 300000;
-  SMTPhost:='localhost';
+  FSMTPhost := cLocalhost;
-  SMTPPort:='smtp';
+  FSMTPPort := cSmtpProtocol;
-  Username:='';
+  FUsername := '';
-  Password:='';
+  FPassword := '';
-  SystemName:=sock.localname;
+  FSystemName := FSock.LocalName;
 end;
 
-{TSMTPSend.Destroy}
+destructor TSMTPSend.Destroy;
-Destructor TSMTPSend.Destroy;
 begin
-  Sock.free;
+  FSock.Free;
-  ESMTPcap.free;
+  FESMTPcap.Free;
-  FullResult.free;
+  FFullResult.Free;
-  inherited destroy;
+  inherited Destroy;
 end;
 
-{TSMTPSend.EnhancedCode}
+procedure TSMTPSend.EnhancedCode(const Value: string);
-procedure TSMTPSend.EnhancedCode (value:string);
 var
-  s,t:string;
+  s, t: string;
-  e1,e2,e3:integer;
+  e1, e2, e3: Integer;
 begin
-  EnhCode1:=0;
+  FEnhCode1 := 0;
-  EnhCode2:=0;
+  FEnhCode2 := 0;
-  EnhCode3:=0;
+  FEnhCode3 := 0;
-  s:=copy(value,5,length(value)-4);
+  s := Copy(Value, 5, Length(Value) - 4);
-  t:=separateleft(s,'.');
+  t := SeparateLeft(s, '.');
-  s:=separateright(s,'.');
+  s := SeparateRight(s, '.');
-  if t='' then exit;
+  if t = '' then
-  if length(t)>1 then exit;
+    Exit;
-  e1:=strtointdef(t,0);
+  if Length(t) > 1 then
-  if e1=0 then exit;
+    Exit;
-  t:=separateleft(s,'.');
+  e1 := StrToIntDef(t, 0);
-  s:=separateright(s,'.');
+  if e1 = 0 then
-  if t='' then exit;
+    Exit;
-  if length(t)>3 then exit;
+  t := SeparateLeft(s, '.');
-  e2:=strtointdef(t,0);
+  s := SeparateRight(s, '.');
-  t:=separateleft(s,' ');
+  if t = '' then
-  if t='' then exit;
+    Exit;
-  if length(t)>3 then exit;
+  if Length(t) > 3 then
-  e3:=strtointdef(t,0);
+    Exit;
-  EnhCode1:=e1;
+  e2 := StrToIntDef(t, 0);
-  EnhCode2:=e2;
+  t := SeparateLeft(s, ' ');
-  EnhCode3:=e3;
+  if t = '' then
+    Exit;
+  if Length(t) > 3 then
+    Exit;
+  e3 := StrToIntDef(t, 0);
+  FEnhCode1 := e1;
+  FEnhCode2 := e2;
+  FEnhCode3 := e3;
 end;
 
-{TSMTPSend.ReadResult}
+function TSMTPSend.ReadResult: Integer;
-function TSMTPSend.ReadResult:integer;
 var
-  s:string;
+  s: string;
 begin
-  Result:=0;
+  Result := 0;
-  FullResult.Clear;
+  FFullResult.Clear;
   repeat
-    s:=sock.recvstring(timeout);
+    s := FSock.RecvString(FTimeout);
-    ResultString:=s;
+    FResultString := s;
-    FullResult.add(s);
+    FFullResult.Add(s);
-    if sock.LastError<>0 then
+    if FSock.LastError <> 0 then
-      break;
+      Break;
-  until pos('-',s)<>4;
+  until Pos('-', s) <> 4;
-  s:=FullResult[0];
+  s := FFullResult[0];
-  if Length(s)>=3 then Result:=Strtointdef(Copy(s,1,3),0);
+  if Length(s) >= 3 then
-  ResultCode:=Result;
+    Result := StrToIntDef(Copy(s, 1, 3), 0);
+  FResultCode := Result;
   EnhancedCode(s);
 end;
 
-{TSMTPSend.AuthLogin}
+function TSMTPSend.AuthLogin: Boolean;
-function TSMTPSend.AuthLogin:Boolean;
 begin
-  Result:=false;
+  Result := False;
-  Sock.SendString('AUTH LOGIN'+CRLF);
+  FSock.SendString('AUTH LOGIN' + CRLF);
-  if readresult<>334 then Exit;
+  if ReadResult <> 334 then
-  Sock.SendString(Encodebase64(username)+CRLF);
+    Exit;
-  if readresult<>334 then Exit;
+  FSock.SendString(EncodeBase64(FUsername) + CRLF);
-  Sock.SendString(Encodebase64(password)+CRLF);
+  if ReadResult <> 334 then
-  if readresult<>235 then Exit;
+    Exit;
-  Result:=True;
+  FSock.SendString(EncodeBase64(FPassword) + CRLF);
+  Result := ReadResult = 235;
 end;
 
-{TSMTPSend.AuthCram}
+function TSMTPSend.AuthCram: Boolean;
-function TSMTPSend.AuthCram:Boolean;
 var
-  s:string;
+  s: string;
 begin
-  Result:=false;
+  Result := False;
-  Sock.SendString('AUTH CRAM-MD5'+CRLF);
+  FSock.SendString('AUTH CRAM-MD5' + CRLF);
-  if readresult<>334 then Exit;
+  if ReadResult <> 334 then
-  s:=copy(ResultString,5,length(ResultString)-4);
+    Exit;
-  s:=DecodeBase64(s);
+  s := Copy(FResultString, 5, Length(FResultString) - 4);
-  s:=HMAC_MD5(s,password);
+  s := DecodeBase64(s);
-  s:=Username+' '+strtohex(s);
+  s := HMAC_MD5(s, FPassword);
-  Sock.SendString(Encodebase64(s)+CRLF);
+  s := FUsername + ' ' + StrToHex(s);
-  if readresult<>235 then Exit;
+  FSock.SendString(EncodeBase64(s) + CRLF);
-  Result:=True;
+  Result := ReadResult = 235;
 end;
 
-{TSMTPSend.Connect}
+function TSMTPSend.Connect: Boolean;
-function TSMTPSend.Connect:Boolean;
 begin
-  Result:=false;
+  FSock.CloseSocket;
-  sock.CloseSocket;
+  FSock.CreateSocket;
-  sock.CreateSocket;
+  FSock.Connect(FSMTPHost, FSMTPPort);
-  sock.Connect(SMTPHost,SMTPPort);
+  Result := FSock.LastError = 0;
-  if sock.lasterror<>0 then Exit;
-  Result:=True;
 end;
 
-{TSMTPSend.Helo}
+function TSMTPSend.Helo: Boolean;
-function TSMTPSend.Helo:Boolean;
 var
-  x:integer;
+  x: Integer;
 begin
-  Result:=false;
+  FSock.SendString('HELO ' + FSystemName + CRLF);
-  Sock.SendString('HELO '+SystemName+CRLF);
+  x := ReadResult;
-  x:=ReadResult;
+  Result := (x >= 250) and (x <= 259);
-  if (x<250) or (x>259) then Exit;
-  Result:=True;
 end;
 
-{TSMTPSend.Ehlo}
+function TSMTPSend.Ehlo: Boolean;
-function TSMTPSend.Ehlo:Boolean;
 var
-  x:integer;
+  x: Integer;
 begin
-  Result:=false;
+  FSock.SendString('EHLO ' + FSystemName + CRLF);
-  Sock.SendString('EHLO '+SystemName+CRLF);
+  x := ReadResult;
-  x:=ReadResult;
+  Result := (x >= 250) and (x <= 259);
-  if (x<250) or (x>259) then Exit;
-  Result:=True;
 end;
 
-{TSMTPSend.login}
+function TSMTPSend.Login: Boolean;
-function TSMTPSend.login:Boolean;
 var
-  n:integer;
+  n: Integer;
-  auths:string;
+  auths: string;
-  s:string;
+  s: string;
 begin
-  Result:=False;
+  Result := False;
-  ESMTP:=true;
+  FESMTP := True;
-  AuthDone:=false;
+  FAuthDone := False;
-  ESMTPcap.clear;
+  FESMTPcap.clear;
-  ESMTPSize:=false;
+  FESMTPSize := False;
-  MaxSize:=0;
+  FMaxSize := 0;
-  if not Connect then Exit;
+  if not Connect then
-  if readresult<>220 then Exit;
+    Exit;
+  if ReadResult <> 220 then
+    Exit;
   if not Ehlo then
   begin
-      ESMTP:=false;
+    FESMTP := False;
-      if not Helo then exit;
+    if not Helo then
+      Exit;
   end;
-  Result:=True;
+  Result := True;
-  if ESMTP then
+  if FESMTP then
   begin
-      for n:=1 to FullResult.count-1 do
+    for n := 1 to FFullResult.Count - 1 do
-        ESMTPcap.add(Copy(FullResult[n],5,length(Fullresult[n])-4));
+      FESMTPcap.Add(Copy(FFullResult[n], 5, Length(FFullResult[n]) - 4));
-      if not ((Username='') and (Password='')) then
+    if not ((FUsername = '') and (FPassword = '')) then
     begin
-          s:=FindCap('AUTH ');
+      s := FindCap('AUTH ');
-          if s=''
+      if s = '' then
-            then s:=FindCap('AUTH=');
+        s := FindCap('AUTH=');
-          auths:=uppercase(s);
+      auths := UpperCase(s);
-          if s<>'' then
+      if s <> '' then
       begin
-              if pos('CRAM-MD5',auths)>0
+        if Pos('CRAM-MD5', auths) > 0 then
-                then AuthDone:=AuthCram;
+          FAuthDone := AuthCram;
-              if (pos('LOGIN',auths)>0) and (not authDone)
+        if (Pos('LOGIN', auths) > 0) and (not FauthDone) then
-                then AuthDone:=AuthLogin;
+          FAuthDone := AuthLogin;
       end;
-          if AuthDone
+      if FAuthDone then
-            then Ehlo;
+        Ehlo;
     end;
-      s:=FindCap('SIZE');
+    s := FindCap('SIZE');
-      if s<>'' then
+    if s <> '' then
     begin
-          ESMTPsize:=true;
+      FESMTPsize := True;
-          MaxSize:=StrToIntDef(copy(s,6,length(s)-5),0);
+      FMaxSize := StrToIntDef(Copy(s, 6, Length(s) - 5), 0);
     end;
   end;
 end;
 
-{TSMTPSend.logout}
+procedure TSMTPSend.Logout;
-procedure TSMTPSend.logout;
 begin
-  Sock.SendString('QUIT'+CRLF);
+  FSock.SendString('QUIT' + CRLF);
-  readresult;
+  ReadResult;
-  Sock.CloseSocket;
+  FSock.CloseSocket;
 end;
 
-{TSMTPSend.reset}
+function TSMTPSend.Reset: Boolean;
-function TSMTPSend.reset:Boolean;
 begin
-  Result:=false;
+  FSock.SendString('RSET' + CRLF);
-  Sock.SendString('RSET'+CRLF);
+  Result := ReadResult = 250;
-  if readresult<>250 then Exit;
-  Result:=True;
 end;
 
-{TSMTPSend.noop}
+function TSMTPSend.NoOp: Boolean;
-function TSMTPSend.noop:Boolean;
 begin
-  Result:=false;
+  FSock.SendString('NOOP' + CRLF);
-  Sock.SendString('NOOP'+CRLF);
+  Result := ReadResult = 250;
-  if readresult<>250 then Exit;
-  Result:=True;
 end;
 
-
+function TSMTPSend.MailFrom(const Value: string; Size: Integer): Boolean;
-{TSMTPSend.mailfrom}
-function TSMTPSend.mailfrom(Value:string; size:integer):Boolean;
 var
-  s:string;
+  s: string;
 begin
-  Result:=false;
+  s := 'MAIL FROM:<' + Value + '>';
-  s:='MAIL FROM:<'+Value+'>';
+  if FESMTPsize and (Size > 0) then
-  if ESMTPsize and (size>0)
+    s := s + ' SIZE=' + IntToStr(Size);
-    then s:=s+' SIZE='+IntToStr(size);
+  FSock.SendString(s + CRLF);
-  Sock.SendString(s+CRLF);
+  Result := ReadResult = 250;
-  if readresult<>250 then Exit;
-  Result:=True;
 end;
 
-{TSMTPSend.mailto}
+function TSMTPSend.MailTo(const Value: string): Boolean;
-function TSMTPSend.mailto(Value:string):Boolean;
 begin
-  Result:=false;
+  FSock.SendString('RCPT TO:<' + Value + '>' + CRLF);
-  Sock.SendString('RCPT TO:<'+Value+'>'+CRLF);
+  Result := ReadResult = 250;
-  if readresult<>250 then Exit;
-  Result:=True;
 end;
 
-{TSMTPSend.maildata}
+function TSMTPSend.MailData(const Value: TStrings): Boolean;
-function TSMTPSend.maildata(Value:Tstrings):Boolean;
 var
-  n:integer;
+  n: Integer;
-  s:string;
+  s: string;
 begin
-  Result:=false;
+  Result := False;
-  Sock.SendString('DATA'+CRLF);
+  FSock.SendString('DATA' + CRLF);
-  if readresult<>354 then Exit;
+  if ReadResult <> 354 then
-  for n:=0 to Value.Count-1 do
+    Exit;
+  for n := 0 to Value.Count - 1 do
   begin
-      s:=value[n];
+    s := Value[n];
-      if Length(s)>=1 then
+    if Length(s) >= 1 then
-        if s[1]='.' then s:='.'+s;
+      if s[1] = '.' then
-      Sock.SendString(s+CRLF);
+        s := '.' + s;
+    FSock.SendString(s + CRLF);
   end;
-  Sock.SendString('.'+CRLF);
+  FSock.SendString('.' + CRLF);
-  if readresult<>250 then Exit;
+  Result := ReadResult = 250;
-  Result:=True;
 end;
 
-{TSMTPSend.etrn}
+function TSMTPSend.Etrn(const Value: string): Boolean;
-function TSMTPSend.etrn(Value:string):Boolean;
 var
-  x:integer;
+  x: Integer;
 begin
-  Result:=false;
+  FSock.SendString('ETRN ' + Value + CRLF);
-  Sock.SendString('ETRN '+Value+CRLF);
+  x := ReadResult;
-  x:=ReadResult;
+  Result := (x >= 250) and (x <= 259);
-  if (x<250) or (x>259) then Exit;
-  Result:=True;
 end;
 
-{TSMTPSend.verify}
+function TSMTPSend.Verify(const Value: string): Boolean;
-function TSMTPSend.verify(Value:string):Boolean;
 var
-  x:integer;
+  x: Integer;
 begin
-  Result:=false;
+  FSock.SendString('VRFY ' + Value + CRLF);
-  Sock.SendString('VRFY '+Value+CRLF);
+  x := ReadResult;
-  x:=ReadResult;
+  Result := (x >= 250) and (x <= 259);
-  if (x<250) or (x>259) then Exit;
-  Result:=True;
 end;
 
-{TSMTPSend.EnhCodeString}
+function TSMTPSend.EnhCodeString: string;
-function TSMTPSend.EnhCodeString:string;
 var
-  s,t:string;
+  s, t: string;
 begin
-  s:=inttostr(EnhCode2)+'.'+inttostr(EnhCode3);
+  s := IntToStr(FEnhCode2) + '.' + IntToStr(FEnhCode3);
-  t:='';
+  t := '';
-  if s='0.0' then t:='Other undefined Status';
+  if s = '0.0' then t := 'Other undefined Status';
-  if s='1.0' then t:='Other address status';
+  if s = '1.0' then t := 'Other address status';
-  if s='1.1' then t:='Bad destination mailbox address';
+  if s = '1.1' then t := 'Bad destination mailbox address';
-  if s='1.2' then t:='Bad destination system 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.3' then t := 'Bad destination mailbox address syntax';
-  if s='1.4' then t:='Destination mailbox address ambiguous';
+  if s = '1.4' then t := 'Destination mailbox address ambiguous';
-  if s='1.5' then t:='Destination mailbox address valid';
+  if s = '1.5' then t := 'Destination mailbox address valid';
-  if s='1.6' then t:='Mailbox has moved';
+  if s = '1.6' then t := 'Mailbox has moved';
-  if s='1.7' then t:='Bad sender''s mailbox address syntax';
+  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 = '1.8' then t := 'Bad sender''s system address';
-  if s='2.0' then t:='Other or undefined mailbox status';
+  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.1' then t := 'Mailbox disabled, not accepting messages';
-  if s='2.2' then t:='Mailbox full';
+  if s = '2.2' then t := 'Mailbox full';
-  if s='2.3' then t:='Message length exceeds administrative limit';
+  if s = '2.3' then t := 'Message Length exceeds administrative limit';
-  if s='2.4' then t:='Mailing list expansion problem';
+  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.0' then t := 'Other or undefined mail system status';
-  if s='3.1' then t:='Mail system full';
+  if s = '3.1' then t := 'Mail system full';
-  if s='3.2' then t:='System not accepting network messages';
+  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.3' then t := 'System not capable of selected features';
-  if s='3.4' then t:='Message too big for system';
+  if s = '3.4' then t := 'Message too big for system';
-  if s='3.5' then t:='System incorrectly configured';
+  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.0' then t := 'Other or undefined network or routing status';
-  if s='4.1' then t:='No answer from host';
+  if s = '4.1' then t := 'No answer from host';
-  if s='4.2' then t:='Bad connection';
+  if s = '4.2' then t := 'Bad connection';
-  if s='4.3' then t:='Routing server failure';
+  if s = '4.3' then t := 'Routing server failure';
-  if s='4.4' then t:='Unable to route';
+  if s = '4.4' then t := 'Unable to route';
-  if s='4.5' then t:='Network congestion';
+  if s = '4.5' then t := 'Network congestion';
-  if s='4.6' then t:='Routing loop detected';
+  if s = '4.6' then t := 'Routing loop detected';
-  if s='4.7' then t:='Delivery time expired';
+  if s = '4.7' then t := 'Delivery time expired';
-  if s='5.0' then t:='Other or undefined protocol status';
+  if s = '5.0' then t := 'Other or undefined protocol status';
-  if s='5.1' then t:='Invalid command';
+  if s = '5.1' then t := 'Invalid command';
-  if s='5.2' then t:='Syntax error';
+  if s = '5.2' then t := 'Syntax error';
-  if s='5.3' then t:='Too many recipients';
+  if s = '5.3' then t := 'Too many recipients';
-  if s='5.4' then t:='Invalid command arguments';
+  if s = '5.4' then t := 'Invalid command arguments';
-  if s='5.5' then t:='Wrong protocol version';
+  if s = '5.5' then t := 'Wrong protocol version';
-  if s='6.0' then t:='Other or undefined media error';
+  if s = '6.0' then t := 'Other or undefined media error';
-  if s='6.1' then t:='Media not supported';
+  if s = '6.1' then t := 'Media not supported';
-  if s='6.2' then t:='Conversion required and prohibited';
+  if s = '6.2' then t := 'Conversion required and prohibited';
-  if s='6.3' then t:='Conversion required but not supported';
+  if s = '6.3' then t := 'Conversion required but not supported';
-  if s='6.4' then t:='Conversion with loss performed';
+  if s = '6.4' then t := 'Conversion with loss performed';
-  if s='6.5' then t:='Conversion failed';
+  if s = '6.5' then t := 'Conversion failed';
-  if s='7.0' then t:='Other or undefined security status';
+  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.1' then t := 'Delivery not authorized, message refused';
-  if s='7.2' then t:='Mailing list expansion prohibited';
+  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.3' then t := 'Security conversion required but not possible';
-  if s='7.4' then t:='Security features not supported';
+  if s = '7.4' then t := 'Security features not supported';
-  if s='7.5' then t:='Cryptographic failure';
+  if s = '7.5' then t := 'Cryptographic failure';
-  if s='7.6' then t:='Cryptographic algorithm not supported';
+  if s = '7.6' then t := 'Cryptographic algorithm not supported';
-  if s='7.7' then t:='Message integrity failure';
+  if s = '7.7' then t := 'Message integrity failure';
-  s:='???-';
+  s := '???-';
-  if EnhCode1=2 then s:='Success-';
+  if FEnhCode1 = 2 then s := 'Success-';
-  if EnhCode1=4 then s:='Persistent Transient Failure-';
+  if FEnhCode1 = 4 then s := 'Persistent Transient Failure-';
-  if EnhCode1=5 then s:='Permanent Failure-';
+  if FEnhCode1 = 5 then s := 'Permanent Failure-';
-  result:=s+t;
+  Result := s + t;
 end;
 
-{TSMTPSend.FindCap}
+function TSMTPSend.FindCap(const Value: string): string;
-function TSMTPSend.FindCap(value:string):string;
 var
-  n:integer;
+  n: Integer;
-  s:string;
+  s: string;
 begin
-  s:=uppercase(value);
+  s := UpperCase(Value);
-  result:='';
+  Result := '';
-  for n:=0 to ESMTPcap.count-1 do
+  for n := 0 to FESMTPcap.Count - 1 do
-    if pos(s,uppercase(ESMTPcap[n]))=1 then
+    if Pos(s, UpperCase(FESMTPcap[n])) = 1 then
     begin
-        result:=ESMTPcap[n];
+      Result := FESMTPcap[n];
-        break;
+      Break;
     end;
 end;
 
 {==============================================================================}
 
-function SendtoRaw (mailfrom,mailto,SMTPHost:string;maildata:TStrings;
+function SendToRaw(const MailFrom, MailTo, SMTPHost: string;
-  Username,Password:string):Boolean;
+  const MailData: TStrings; const Username, Password: string): Boolean;
 var
-  SMTP:TSMTPSend;
+  SMTP: TSMTPSend;
-  size:integer;
 begin
-  Result:=False;
+  Result := False;
-  SMTP:=TSMTPSend.Create;
+  SMTP := TSMTPSend.Create;
   try
-    SMTP.SMTPHost:=SMTPHost;
+    SMTP.SMTPHost := SMTPHost;
-    SMTP.Username:=Username;
+    SMTP.Username := Username;
-    SMTP.Password:=Password;
+    SMTP.Password := Password;
-    if not SMTP.login then Exit;
+    if SMTP.Login then
-    size:=length(maildata.text);
+    begin
-    if not SMTP.mailfrom(mailfrom,size) then Exit;
+      if SMTP.MailFrom(MailFrom, Length(MailData.Text)) then
-    if not SMTP.mailto(mailto) then Exit;
+        if SMTP.MailTo(MailTo) then
-    if not SMTP.maildata(Maildata) then Exit;
+          if SMTP.MailData(MailData) then
-    SMTP.logout;
+            Result := True;
-    Result:=True;
+      SMTP.Logout;
+    end;
   finally
     SMTP.Free;
   end;
 end;
 
-function SendtoEx (mailfrom,mailto,subject,SMTPHost:string;maildata:TStrings;
+function SendToEx(const MailFrom, MailTo, Subject, SMTPHost: string;
-  Username,Password:string):Boolean;
+  const MailData: TStrings; const Username, Password: string): Boolean;
 var
-  t:TStrings;
+  t: TStrings;
 begin
-//  Result:=False;
+  t := TStringList.Create;
-  t:=TStringList.Create;
   try
-    t.assign(Maildata);
+    t.Assign(MailData);
-    t.Insert(0,'');
+    t.Insert(0, '');
-    t.Insert(0,'x-mailer: Synapse - Delphi TCP/IP library by Lukas Gebauer');
+    t.Insert(0, 'x-mailer: Synapse - Delphi TCP/IP library by Lukas Gebauer');
-    t.Insert(0,'subject: '+subject);
+    t.Insert(0, 'subject: ' + Subject);
-    t.Insert(0,'date: '+Rfc822DateTime(now));
+    t.Insert(0, 'date: ' + Rfc822DateTime(now));
-    t.Insert(0,'to: '+mailto);
+    t.Insert(0, 'to: ' + MailTo);
-    t.Insert(0,'from: '+mailfrom);
+    t.Insert(0, 'from: ' + MailFrom);
-    Result:=SendToRaw(mailfrom,mailto,SMTPHost,t,Username,Password);
+    Result := SendToRaw(MailFrom, MailTo, SMTPHost, t, Username, Password);
   finally
     t.Free;
   end;
 end;
 
-function Sendto 
+function SendTo(const MailFrom, MailTo, Subject, SMTPHost: string;
-(mailfrom,mailto,subject,SMTPHost:string;maildata:TStrings):Boolean;
+  const MailData: TStrings): Boolean;
 begin
-  result:=SendToEx(mailfrom,mailto,subject,SMTPHost,maildata,'','');
+  Result := SendToEx(MailFrom, MailTo, Subject, SMTPHost, MailData, '', '');
 end;
 
 end.
-
-

snmpsend.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.003.001 |
+| Project : Delphree - Synapse                                   | 002.003.002 |
 |==============================================================================|
 | Content: SNMP client                                                         |
 |==============================================================================|
-| The contents of this file are subject to the Mozilla Public License Ver. 1.0 |
+| The contents of this file are subject to the Mozilla Public License Ver. 1.1 |
 | (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/ |
 |                                                                              |
@@ -25,201 +25,213 @@
 |==============================================================================}
 
 {$Q-}
+{$WEAKPACKAGEUNIT ON}
 
 unit SNMPSend;
 
 interface
 
 uses
-  BlckSock, synautil, classes, sysutils, ASN1Util;
+  Classes, SysUtils,
+  blckSock, SynaUtil, ASN1Util;
 
 const
+  cSnmpProtocol = '161';
 
 //PDU type
-PDUGetRequest=$a0;
+  PDUGetRequest = $A0;
-PDUGetNextRequest=$a1;
+  PDUGetNextRequest = $A1;
-PDUGetResponse=$a2;
+  PDUGetResponse = $A2;
-PDUSetRequest=$a3;
+  PDUSetRequest = $A3;
-PDUTrap=$a4;
+  PDUTrap = $A4;
 
 //errors
-ENoError=0;
+  ENoError = 0;
-ETooBig=1;
+  ETooBig = 1;
-ENoSuchName=2;
+  ENoSuchName = 2;
-EBadValue=3;
+  EBadValue = 3;
-EReadOnly=4;
+  EReadOnly = 4;
-EGenErr=5;
+  EGenErr = 5;
 
 type
-
+  TSNMPMib = class(TObject)
-TSNMPMib = class
-  OID: string;
-  Value: string;
-  ValueType: integer;
-end;
-
-TSNMPRec=class(TObject)
-  public
-    version:integer;
-    community:string;
-    PDUType:integer;
-    ID:integer;
-    ErrorStatus:integer;
-    ErrorIndex:integer;
-    SNMPMibList: TList;
-    constructor Create;
-    destructor Destroy; override;
-    function DecodeBuf(Buffer:string):boolean;
-    function EncodeBuf:string;
-    procedure Clear;
-    procedure MIBAdd(MIB,Value:string; ValueType:integer);
-    procedure MIBdelete(Index:integer);
-    function MIBGet(MIB:string):string;
-end;
-
-TSNMPSend=class(TObject)
   private
-    Sock:TUDPBlockSocket;
+    FOID: string;
-    Buffer:string;
+    FValue: string;
+    FValueType: Integer;
+  published
+    property OID: string read FOID Write FOID;
+    property Value: string read FValue Write FValue;
+    property ValueType: Integer read FValueType Write FValueType;
+  end;
+
+  TSNMPRec = class(TObject)
+  private
+    FVersion: Integer;
+    FCommunity: string;
+    FPDUType: Integer;
+    FID: Integer;
+    FErrorStatus: Integer;
+    FErrorIndex: Integer;
+    FSNMPMibList: TList;
   public
-    Timeout:integer;
-    Host:string;
-    HostIP:string;
-    Query:TSNMPrec;
-    Reply:TSNMPrec;
     constructor Create;
     destructor Destroy; override;
-    function DoIt:boolean;
+    function DecodeBuf(const Buffer: string): Boolean;
-end;
+    function EncodeBuf: string;
+    procedure Clear;
+    procedure MIBAdd(const MIB, Value: string; ValueType: Integer);
+    procedure MIBDelete(Index: Integer);
+    function MIBGet(const MIB: string): string;
+  published
+    property Version: Integer read FVersion Write FVersion;
+    property Community: string read FCommunity Write FCommunity;
+    property PDUType: Integer read FPDUType Write FPDUType;
+    property ID: Integer read FID Write FID;
+    property ErrorStatus: Integer read FErrorStatus Write FErrorStatus;
+    property ErrorIndex: Integer read FErrorIndex Write FErrorIndex;
+    property SNMPMibList: TList read FSNMPMibList;
+  end;
 
-function SNMPget (Oid, Community, SNMPHost:string; var Value:string):Boolean;
+  TSNMPSend = class(TObject)
-function SNMPSet (Oid, Community, SNMPHost, Value: string; ValueType: integer): boolean;
+  private
+    FSock: TUDPBlockSocket;
+    FBuffer: string;
+    FTimeout: Integer;
+    FHost: string;
+    FHostIP: string;
+    FQuery: TSNMPRec;
+    FReply: TSNMPRec;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    function DoIt: Boolean;
+  published
+    property Timeout: Integer read FTimeout Write FTimeout;
+    property Host: string read FHost Write FHost;
+    property HostIP: string read FHostIP;
+    property Query: TSNMPRec read FQuery;
+    property Reply: TSNMPRec read FReply;
+  end;
+
+function SNMPGet(const Oid, Community, SNMPHost: string;
+  var Value: string): Boolean;
+function SNMPSet(const Oid, Community, SNMPHost, Value: string;
+  ValueType: Integer): Boolean;
 
 implementation
 
 {==============================================================================}
 
-{TSNMPRec.Create}
 constructor TSNMPRec.Create;
 begin
-  inherited create;
+  inherited Create;
-  SNMPMibList := TList.create;
+  FSNMPMibList := TList.Create;
-  id:=1;
+  id := 1;
 end;
 
-{TSNMPRec.Destroy}
 destructor TSNMPRec.Destroy;
 var
-  i:integer;
+  i: Integer;
 begin
-  for i := 0 to SNMPMibList.count - 1 do
+  for i := 0 to FSNMPMibList.Count - 1 do
-    TSNMPMib(SNMPMibList[i]).Free;
+    TSNMPMib(FSNMPMibList[i]).Free;
-  SNMPMibList.free;
+  FSNMPMibList.Free;
-  inherited destroy;
+  inherited Destroy;
 end;
 
-{TSNMPRec.DecodeBuf}
+function TSNMPRec.DecodeBuf(const Buffer: string): Boolean;
-function TSNMPRec.DecodeBuf(Buffer:string):boolean;
 var
-  Pos:integer;
+  Pos: Integer;
-  endpos:integer;
+  EndPos: Integer;
-  sm,sv:string;
+  sm, sv: string;
-  svt: integer;
+  Svt: Integer;
 begin
-  result:=false;
+  Result := False;
-  if length(buffer)<2
+  if Length(Buffer) < 2 then
-    then exit;
+    Exit;
-  if (ord(buffer[1]) and $20)=0
+  if (Ord(Buffer[1]) and $20) = 0 then
-    then exit;
+    Exit;
-  Pos:=2;
+  Pos := 2;
-  Endpos:=ASNDecLen(Pos,buffer);
+  EndPos := ASNDecLen(Pos, Buffer);
-  if length(buffer)<(Endpos+2)
+  if Length(Buffer) < (EndPos + 2) then
-    then exit;
+    Exit;
-  Self.version:=StrToIntDef(ASNItem(Pos,buffer,svt),0);
+  Self.FVersion := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
-  Self.community:=ASNItem(Pos,buffer,svt);
+  Self.FCommunity := ASNItem(Pos, Buffer, Svt);
-  Self.PDUType:=StrToIntDef(ASNItem(Pos,buffer,svt),0);
+  Self.FPDUType := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
-  Self.ID:=StrToIntDef(ASNItem(Pos,buffer,svt),0);
+  Self.FID := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
-  Self.ErrorStatus:=StrToIntDef(ASNItem(Pos,buffer,svt),0);
+  Self.FErrorStatus := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
-  Self.ErrorIndex:=StrToIntDef(ASNItem(Pos,buffer,svt),0);
+  Self.FErrorIndex := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
-  ASNItem(Pos,buffer,svt);
+  ASNItem(Pos, Buffer, Svt);
-  while Pos<Endpos do
+  while Pos < EndPos do
   begin
-      ASNItem(Pos,buffer,svt);
+    ASNItem(Pos, Buffer, Svt);
-      Sm:=ASNItem(Pos,buffer,svt);
+    Sm := ASNItem(Pos, Buffer, Svt);
-      Sv:=ASNItem(Pos,buffer,svt);
+    Sv := ASNItem(Pos, Buffer, Svt);
-      Self.MIBadd(sm,sv, svt);
+    Self.MIBAdd(sm, sv, Svt);
   end;
-  result:=true;
+  Result := True;
 end;
 
-{TSNMPRec.EncodeBuf}
+function TSNMPRec.EncodeBuf: string;
-function TSNMPRec.EncodeBuf:string;
 var
-  data,s:string;
+  data, s: string;
   SNMPMib: TSNMPMib;
-  n:integer;
+  n: Integer;
 begin
-  data:='';
+  data := '';
-  for n:=0 to SNMPMibList.Count-1 do
+  for n := 0 to FSNMPMibList.Count - 1 do
   begin
-      SNMPMib := SNMPMibList[n];
+    SNMPMib := FSNMPMibList[n];
-      case (SNMPMib.ValueType) of
+    case SNMPMib.ValueType of
       ASN1_INT:
-          begin
+        s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) +
-            s := ASNObject(MibToID(SNMPMib.OID),ASN1_OBJID)
+          ASNObject(ASNEncInt(StrToIntDef(SNMPMib.Value, 0)), SNMPMib.ValueType);
-              +ASNObject(ASNEncInt(strToIntDef(SNMPMib.Value,0)),SNMPMib.ValueType);
-          end;
       ASN1_COUNTER, ASN1_GAUGE, ASN1_TIMETICKS:
-          begin
+        s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) +
-            s := ASNObject(MibToID(SNMPMib.OID),ASN1_OBJID)
+          ASNObject(ASNEncUInt(StrToIntDef(SNMPMib.Value, 0)), SNMPMib.ValueType);
-              +ASNObject(ASNEncUInt(strToIntDef(SNMPMib.Value,0)),SNMPMib.ValueType);
-          end;
       ASN1_OBJID:
-          begin
+        s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) +
-            s := ASNObject(MibToID(SNMPMib.OID),ASN1_OBJID) + ASNObject(MibToID(SNMPMib.Value),SNMPMib.ValueType);
+          ASNObject(MibToID(SNMPMib.Value), SNMPMib.ValueType);
-          end;
       ASN1_IPADDR:
-          begin
+        s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) +
-            s := ASNObject(MibToID(SNMPMib.OID),ASN1_OBJID) + ASNObject(IPToID(SNMPMib.Value),SNMPMib.ValueType);
+          ASNObject(IPToID(SNMPMib.Value), SNMPMib.ValueType);
-          end;
       ASN1_NULL:
-          begin
+        s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) +
-            s := ASNObject(MibToID(SNMPMib.OID),ASN1_OBJID) + ASNObject('',ASN1_NULL);
+          ASNObject('', ASN1_NULL);
-          end;
     else
-          s := ASNObject(MibToID(SNMPMib.OID),ASN1_OBJID) + ASNObject(SNMPMib.Value,SNMPMib.ValueType);
+      s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) +
+        ASNObject(SNMPMib.Value, SNMPMib.ValueType);
     end;
     data := data + ASNObject(s, ASN1_SEQ);
   end;
-  data:=ASNObject(data,ASN1_SEQ);
+  data := ASNObject(data, ASN1_SEQ);
-  data:=ASNObject(ASNEncInt(Self.ID),ASN1_INT)
+  data := ASNObject(ASNEncInt(Self.FID), ASN1_INT) +
-    +ASNObject(ASNEncInt(Self.ErrorStatus),ASN1_INT)
+    ASNObject(ASNEncInt(Self.FErrorStatus), ASN1_INT) +
-    +ASNObject(ASNEncInt(Self.ErrorIndex),ASN1_INT)
+    ASNObject(ASNEncInt(Self.FErrorIndex), ASN1_INT) +
-    +data;
+    data;
-  data:=ASNObject(ASNEncInt(Self.Version),ASN1_INT)
+  data := ASNObject(ASNEncInt(Self.FVersion), ASN1_INT) +
-    +ASNObject(Self.community,ASN1_OCTSTR)
+    ASNObject(Self.FCommunity, ASN1_OCTSTR) +
-    +ASNObject(data,Self.PDUType);
+    ASNObject(data, Self.FPDUType);
-  data:=ASNObject(data,ASN1_SEQ);
+  data := ASNObject(data, ASN1_SEQ);
-  Result:=data;
+  Result := data;
 end;
 
-{TSNMPRec.Clear}
 procedure TSNMPRec.Clear;
 var
-  i:integer;
+  i: Integer;
 begin
-  version:=0;
+  FVersion := 0;
-  community:='';
+  FCommunity := '';
-  PDUType:=0;
+  FPDUType := 0;
-  ErrorStatus:=0;
+  FErrorStatus := 0;
-  ErrorIndex:=0;
+  FErrorIndex := 0;
-  for i := 0 to SNMPMibList.count - 1 do
+  for i := 0 to FSNMPMibList.Count - 1 do
-    TSNMPMib(SNMPMibList[i]).Free;
+    TSNMPMib(FSNMPMibList[i]).Free;
-  SNMPMibList.Clear;
+  FSNMPMibList.Clear;
 end;
 
-{TSNMPRec.MIBAdd}
+procedure TSNMPRec.MIBAdd(const MIB, Value: string; ValueType: Integer);
-procedure TSNMPRec.MIBAdd(MIB,Value:string; ValueType:integer);
 var
   SNMPMib: TSNMPMib;
 begin
@@ -227,122 +239,117 @@ begin
   SNMPMib.OID := MIB;
   SNMPMib.Value := Value;
   SNMPMib.ValueType := ValueType;
-  SNMPMibList.Add(SNMPMib);
+  FSNMPMibList.Add(SNMPMib);
 end;
 
-{TSNMPRec.MIBdelete}
+procedure TSNMPRec.MIBDelete(Index: Integer);
-procedure TSNMPRec.MIBdelete(Index:integer);
 begin
-  if (Index >= 0) and (Index < SNMPMibList.count) then
+  if (Index >= 0) and (Index < FSNMPMibList.Count) then
   begin
-      TSNMPMib(SNMPMibList[Index]).Free;
+    TSNMPMib(FSNMPMibList[Index]).Free;
-      SNMPMibList.Delete(Index);
+    FSNMPMibList.Delete(Index);
   end;
 end;
 
-{TSNMPRec.MIBGet}
+function TSNMPRec.MIBGet(const MIB: string): string;
-function TSNMPRec.MIBGet(MIB:string):string;
 var
-  i: integer;
+  i: Integer;
 begin
   Result := '';
-  for i := 0 to SNMPMibList.count - 1 do
+  for i := 0 to FSNMPMibList.Count - 1 do
   begin
-      if ((TSNMPMib(SNMPMibList[i])).OID = MIB) then
+    if ((TSNMPMib(FSNMPMibList[i])).OID = MIB) then
     begin
-        Result := (TSNMPMib(SNMPMibList[i])).Value;
+      Result := (TSNMPMib(FSNMPMibList[i])).Value;
-        break;
+      Break;
     end;
   end;
 end;
 
-
 {==============================================================================}
 
-{TSNMPSend.Create}
 constructor TSNMPSend.Create;
 begin
-  inherited create;
+  inherited Create;
-  Query:=TSNMPRec.Create;
+  FQuery := TSNMPRec.Create;
-  Reply:=TSNMPRec.Create;
+  FReply := TSNMPRec.Create;
-  Query.Clear;
+  FQuery.Clear;
-  Reply.Clear;
+  FReply.Clear;
-  sock:=TUDPBlockSocket.create;
+  FSock := TUDPBlockSocket.Create;
-  sock.createsocket;
+  FSock.CreateSocket;
-  timeout:=5000;
+  FTimeout := 5000;
-  host:='localhost';
+  FHost := cLocalhost;
-  HostIP:='';
+  FHostIP := '';
 end;
 
-{TSNMPSend.Destroy}
 destructor TSNMPSend.Destroy;
 begin
-  Sock.Free;
+  FSock.Free;
-  Reply.Free;
+  FReply.Free;
-  Query.Free;
+  FQuery.Free;
-  inherited destroy;
+  inherited Destroy;
 end;
 
-{TSNMPSend.DoIt}
+function TSNMPSend.DoIt: Boolean;
-function TSNMPSend.DoIt:boolean;
 var
-  x:integer;
+  x: Integer;
 begin
-  Result:=false;
+  Result := False;
-  reply.clear;
+  FReply.Clear;
-  Buffer:=Query.Encodebuf;
+  FBuffer := Query.EncodeBuf;
-  sock.connect(host,'161');
+  FSock.Connect(FHost, cSnmpProtocol);
-  HostIP:=sock.GetRemoteSinIP;
+  FHostIP := FSock.GetRemoteSinIP;
-  sock.SendBuffer(PChar(Buffer),Length(Buffer));
+  FSock.SendBuffer(PChar(FBuffer), Length(FBuffer));
-  if sock.canread(timeout)
+  if FSock.CanRead(FTimeout) then
-    then begin
-      x:=sock.WaitingData;
-      if x>0 then
   begin
-          setlength(Buffer,x);
+    x := FSock.WaitingData;
-          sock.RecvBuffer(PChar(Buffer),x);
+    if x > 0 then
-          result:=true;
+    begin
+      SetLength(FBuffer, x);
+      FSock.RecvBuffer(PChar(FBuffer), x);
+      Result := True;
     end;
   end;
-  if Result
+  if Result then
-    then result:=reply.DecodeBuf(Buffer);
+    Result := FReply.DecodeBuf(FBuffer);
 end;
 
 {==============================================================================}
 
-function SNMPget (Oid, Community, SNMPHost:string; var Value:string):Boolean;
+function SNMPGet(const Oid, Community, SNMPHost: string;
+  var Value: string): Boolean;
 var
-  SNMP:TSNMPSend;
+  SNMP: TSNMPSend;
 begin
-  SNMP:=TSNMPSend.Create;
+  SNMP := TSNMPSend.Create;
   try
-    Snmp.Query.community:=Community;
+    SNMP.Query.Community := Community;
-    Snmp.Query.PDUType:=PDUGetRequest;
+    SNMP.Query.PDUType := PDUGetRequest;
-    Snmp.Query.MIBAdd(Oid,'',ASN1_NULL);
+    SNMP.Query.MIBAdd(Oid, '', ASN1_NULL);
-    Snmp.host:=SNMPHost;
+    SNMP.Host := SNMPHost;
-    Result:=Snmp.DoIt;
+    Result := SNMP.DoIt;
     if Result then
-      Value:=Snmp.Reply.MIBGet(Oid);
+      Value := SNMP.Reply.MIBGet(Oid);
   finally
     SNMP.Free;
   end;
 end;
 
-function SNMPSet(Oid, Community, SNMPHost, Value: string; ValueType: integer): boolean;
+function SNMPSet(const Oid, Community, SNMPHost, Value: string;
+  ValueType: Integer): Boolean;
 var
   SNMPSend: TSNMPSend;
 begin
   SNMPSend := TSNMPSend.Create;
   try
-    SNMPSend.Query.community := Community;
+    SNMPSend.Query.Community := Community;
     SNMPSend.Query.PDUType := PDUSetRequest;
     SNMPSend.Query.MIBAdd(Oid, Value, ValueType);
     SNMPSend.Host := SNMPHost;
-    result:= SNMPSend.DoIt=true;
+    Result := SNMPSend.DoIt = True;
   finally
     SNMPSend.Free;
   end;
 end;
 
-
 end.

snmptrap.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.002.001 |
+| Project : Delphree - Synapse                                   | 002.002.002 |
 |==============================================================================|
 | Content: SNMP traps                                                          |
 |==============================================================================|
-| The contents of this file are subject to the Mozilla Public License Ver. 1.0 |
+| The contents of this file are subject to the Mozilla Public License Ver. 1.1 |
 | (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/ |
 |                                                                              |
@@ -25,16 +25,18 @@
 |==============================================================================}
 
 {$Q-}
+{$WEAKPACKAGEUNIT ON}
 
 unit SNMPTrap;
 
 interface
 
 uses
-  Classes, SysUtils, BlckSock, SynaUtil, ASN1Util, SNMPsend;
+  Classes, SysUtils,
+  blckSock, SynaUtil, ASN1Util, SNMPSend;
 
 const
-  TRAP_PORT      = 162;
+  cSnmpTrapProtocol = '162';
 
   SNMP_VERSION = 0;
 
@@ -47,83 +49,99 @@ const
 type
   TTrapPDU = class(TObject)
   private
-    protected
+    FBuffer: string;
-      Buffer: string;
+    FTrapPort: string;
+    FVersion: Integer;
+    FPDUType: Integer;
+    FCommunity: string;
+    FEnterprise: string;
+    FTrapHost: string;
+    FGenTrap: Integer;
+    FSpecTrap: Integer;
+    FTimeTicks: Integer;
+    FSNMPMibList: TList;
   public
-      TrapPort: integer;
-      Version: integer;
-      PDUType: integer;
-      Community: string;
-      Enterprise: string;
-      TrapHost: string;
-      GenTrap: integer;
-      SpecTrap: integer;
-      TimeTicks: integer;
-      SNMPMibList: TList;
     constructor Create;
     destructor Destroy; override;
     procedure Clear;
-      procedure MIBAdd(MIB, Value: string; ValueType:integer);
+    procedure MIBAdd(const MIB, Value: string; ValueType: Integer);
-      procedure MIBDelete(Index: integer);
+    procedure MIBDelete(Index: Integer);
-      function MIBGet(MIB: string): string;
+    function MIBGet(const MIB: string): string;
-      function EncodeTrap: integer;
+    function EncodeTrap: Integer;
-      function DecodeTrap: boolean;
+    function DecodeTrap: Boolean;
+  published
+    property Version: Integer read FVersion Write FVersion;
+    property Community: string read FCommunity Write FCommunity;
+    property PDUType: Integer read FPDUType Write FPDUType;
+    property TrapPort: string read FTrapPort Write FTrapPort;
+    property Enterprise: string read FEnterprise Write FEnterprise;
+    property TrapHost: string read FTrapHost Write FTrapHost;
+    property GenTrap: Integer read FGenTrap Write FGenTrap;
+    property SpecTrap: Integer read FSpecTrap Write FSpecTrap;
+    property TimeTicks: Integer read FTimeTicks Write FTimeTicks;
+    property SNMPMibList: TList read FSNMPMibList;
   end;
 
   TTrapSNMP = class(TObject)
   private
-    sock: TUDPBlockSocket;
+    FSock: TUDPBlockSocket;
+    FTrap: TTrapPDU;
+    FSNMPHost: string;
+    FTimeout: Integer;
   public
-    Trap: TTrapPDU;
-    SNMPHost: string;
-    Timeout: integer;
     constructor Create;
     destructor Destroy; override;
-    function Send: integer;
+    function Send: Integer;
-    function Recv: integer;
+    function Recv: Integer;
+  published
+    property Trap: TTrapPDU read FTrap;
+    property SNMPHost: string read FSNMPHost Write FSNMPHost;
+    property Timeout: Integer read FTimeout Write FTimeout;
   end;
 
-function SendTrap(Dest, Source, Enterprise, Community: string;
+function SendTrap(const Dest, Source, Enterprise, Community: string;
-  Generic, Specific, Seconds: integer; MIBName, MIBValue: string; MIBtype:integer): integer;
+  Generic, Specific, Seconds: Integer; const MIBName, MIBValue: string;
+  MIBtype: Integer): Integer;
 function RecvTrap(var Dest, Source, Enterprise, Community: string;
-  var Generic, Specific, Seconds: integer; var MIBName, MIBValue: TStringList): integer;
+  var Generic, Specific, Seconds: Integer; const MIBName,
+  MIBValue: TStringList): Integer;
 
 implementation
 
 constructor TTrapPDU.Create;
 begin
   inherited Create;
-  SNMPMibList := TList.create;
+  FSNMPMibList := TList.Create;
-  TrapPort := TRAP_PORT;
+  FTrapPort := cSnmpTrapProtocol;
-  Version := SNMP_VERSION;
+  FVersion := SNMP_VERSION;
-  PDUType := PDU_TRAP;
+  FPDUType := PDU_TRAP;
-  Community := 'public';
+  FCommunity := 'public';
 end;
 
 destructor TTrapPDU.Destroy;
 var
-  i:integer;
+  i: Integer;
 begin
-  for i := 0 to SNMPMibList.count - 1 do
+  for i := 0 to FSNMPMibList.Count - 1 do
-    TSNMPMib(SNMPMibList[i]).Free;
+    TSNMPMib(FSNMPMibList[i]).Free;
-  SNMPMibList.free;
+  FSNMPMibList.Free;
   inherited Destroy;
 end;
 
 procedure TTrapPDU.Clear;
 var
-  i:integer;
+  i: Integer;
 begin
-  for i := 0 to SNMPMibList.count - 1 do
+  for i := 0 to FSNMPMibList.Count - 1 do
-    TSNMPMib(SNMPMibList[i]).Free;
+    TSNMPMib(FSNMPMibList[i]).Free;
-  SNMPMibList.Clear;
+  FSNMPMibList.Clear;
-  TrapPort := TRAP_PORT;
+  FTrapPort := cSnmpTrapProtocol;
-  Version := SNMP_VERSION;
+  FVersion := SNMP_VERSION;
-  PDUType := PDU_TRAP;
+  FPDUType := PDU_TRAP;
-  Community := 'public';
+  FCommunity := 'public';
 end;
 
-procedure TTrapPDU.MIBAdd(MIB, Value: string; ValueType:integer);
+procedure TTrapPDU.MIBAdd(const MIB, Value: string; ValueType: Integer);
 var
   SNMPMib: TSNMPMib;
 begin
@@ -131,216 +149,207 @@ begin
   SNMPMib.OID := MIB;
   SNMPMib.Value := Value;
   SNMPMib.ValueType := ValueType;
-  SNMPMibList.Add(SNMPMib);
+  FSNMPMibList.Add(SNMPMib);
 end;
 
-procedure TTrapPDU.MIBDelete(Index: integer);
+procedure TTrapPDU.MIBDelete(Index: Integer);
 begin
-  if (Index >= 0) and (Index < SNMPMibList.count) then
+  if (Index >= 0) and (Index < FSNMPMibList.Count) then
   begin
-      TSNMPMib(SNMPMibList[Index]).Free;
+    TSNMPMib(FSNMPMibList[Index]).Free;
-      SNMPMibList.Delete(Index);
+    FSNMPMibList.Delete(Index);
   end;
 end;
 
-function TTrapPDU.MIBGet(MIB: string): string;
+function TTrapPDU.MIBGet(const MIB: string): string;
 var
-  i: integer;
+  i: Integer;
 begin
   Result := '';
-  for i := 0 to SNMPMibList.count - 1 do
+  for i := 0 to FSNMPMibList.Count - 1 do
   begin
-      if ((TSNMPMib(SNMPMibList[i])).OID = MIB) then
+    if TSNMPMib(FSNMPMibList[i]).OID = MIB then
     begin
-        Result := (TSNMPMib(SNMPMibList[i])).Value;
+      Result := TSNMPMib(FSNMPMibList[i]).Value;
-        break;
+      Break;
     end;
   end;
 end;
 
-function TTrapPDU.EncodeTrap: integer;
+function TTrapPDU.EncodeTrap: Integer;
 var
   s: string;
-  n: integer;
+  n: Integer;
   SNMPMib: TSNMPMib;
 begin
-  Buffer := '';
+  FBuffer := '';
-  for n:=0 to SNMPMibList.Count-1 do
+  for n := 0 to FSNMPMibList.Count - 1 do
   begin
-      SNMPMib := SNMPMibList[n];
+    SNMPMib := FSNMPMibList[n];
-      case (SNMPMib.ValueType) of
+    case SNMPMib.ValueType of
       ASN1_INT:
-          begin
+        s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) +
-            s := ASNObject(MibToID(SNMPMib.OID),ASN1_OBJID)
+          ASNObject(ASNEncInt(StrToIntDef(SNMPMib.Value, 0)), SNMPMib.ValueType);
-              +ASNObject(ASNEncInt(strToIntDef(SNMPMib.Value,0)),SNMPMib.ValueType);
-          end;
       ASN1_COUNTER, ASN1_GAUGE, ASN1_TIMETICKS:
-          begin
+        s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) +
-            s := ASNObject(MibToID(SNMPMib.OID),ASN1_OBJID)
+          ASNObject(ASNEncUInt(StrToIntDef(SNMPMib.Value, 0)), SNMPMib.ValueType);
-              +ASNObject(ASNEncUInt(strToIntDef(SNMPMib.Value,0)),SNMPMib.ValueType);
-          end;
       ASN1_OBJID:
-          begin
+        s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) +
-            s := ASNObject(MibToID(SNMPMib.OID),ASN1_OBJID) + ASNObject(MibToID(SNMPMib.Value),SNMPMib.ValueType);
+          ASNObject(MibToID(SNMPMib.Value), SNMPMib.ValueType);
-          end;
       ASN1_IPADDR:
-          begin
+        s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) +
-            s := ASNObject(MibToID(SNMPMib.OID),ASN1_OBJID) + ASNObject(IPToID(SNMPMib.Value),SNMPMib.ValueType);
+          ASNObject(IPToID(SNMPMib.Value), SNMPMib.ValueType);
-          end;
       ASN1_NULL:
-          begin
+        s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) +
-            s := ASNObject(MibToID(SNMPMib.OID),ASN1_OBJID) + ASNObject('',ASN1_NULL);
+          ASNObject('', ASN1_NULL);
-          end;
     else
-          s := ASNObject(MibToID(SNMPMib.OID),ASN1_OBJID) + ASNObject(SNMPMib.Value,SNMPMib.ValueType);
+      s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) +
+        ASNObject(SNMPMib.Value, SNMPMib.ValueType);
     end;
-      Buffer := Buffer + ASNObject(s, ASN1_SEQ);
+    FBuffer := FBuffer + ASNObject(s, ASN1_SEQ);
   end;
-  Buffer := ASNObject(Buffer, ASN1_SEQ);
+  FBuffer := ASNObject(FBuffer, ASN1_SEQ);
-  Buffer := ASNObject(ASNEncInt(GenTrap), ASN1_INT)
+  FBuffer := ASNObject(ASNEncInt(FGenTrap), ASN1_INT) +
-    + ASNObject(ASNEncInt(SpecTrap), ASN1_INT)
+    ASNObject(ASNEncInt(FSpecTrap), ASN1_INT) +
-    + ASNObject(ASNEncUInt(TimeTicks), ASN1_TIMETICKS)
+    ASNObject(ASNEncUInt(FTimeTicks), ASN1_TIMETICKS) +
-    + Buffer;
+    FBuffer;
-  Buffer := ASNObject(MibToID(Enterprise), ASN1_OBJID)
+  FBuffer := ASNObject(MibToID(FEnterprise), ASN1_OBJID) +
-    + ASNObject(IPToID(TrapHost), ASN1_IPADDR)
+    ASNObject(IPToID(FTrapHost), ASN1_IPADDR) +
-    + Buffer;
+    FBuffer;
-  Buffer := ASNObject(ASNEncInt(Version), ASN1_INT)
+  FBuffer := ASNObject(ASNEncInt(FVersion), ASN1_INT) +
-    + ASNObject(Community, ASN1_OCTSTR)
+    ASNObject(FCommunity, ASN1_OCTSTR) +
-    + ASNObject(Buffer, Self.PDUType);
+    ASNObject(FBuffer, Self.FPDUType);
-  Buffer := ASNObject(Buffer, ASN1_SEQ);
+  FBuffer := ASNObject(FBuffer, ASN1_SEQ);
   Result := 1;
 end;
 
-function TTrapPDU.DecodeTrap: boolean;
+function TTrapPDU.DecodeTrap: Boolean;
 var
-  Pos, EndPos: integer;
+  Pos, EndPos: Integer;
   Sm, Sv: string;
-  Svt:integer;
+  Svt: Integer;
 begin
-  clear;
+  Clear;
-  result:=false;
+  Result := False;
-  if length(buffer)<2
+  if Length(FBuffer) < 2 then
-    then exit;
+    Exit;
-  if (ord(buffer[1]) and $20)=0
+  if (Ord(FBuffer[1]) and $20) = 0 then
-    then exit;
+    Exit;
   Pos := 2;
-  EndPos := ASNDecLen(Pos, Buffer);
+  EndPos := ASNDecLen(Pos, FBuffer);
-  Version := StrToIntDef(ASNItem(Pos, Buffer,svt), 0);
+  FVersion := StrToIntDef(ASNItem(Pos, FBuffer, Svt), 0);
-  Community := ASNItem(Pos, Buffer,svt);
+  FCommunity := ASNItem(Pos, FBuffer, Svt);
-  PDUType := StrToIntDef(ASNItem(Pos, Buffer,svt), PDU_TRAP);
+  FPDUType := StrToIntDef(ASNItem(Pos, FBuffer, Svt), PDU_TRAP);
-  Enterprise := ASNItem(Pos, Buffer,svt);
+  FEnterprise := ASNItem(Pos, FBuffer, Svt);
-  TrapHost := ASNItem(Pos, Buffer,svt);
+  FTrapHost := ASNItem(Pos, FBuffer, Svt);
-  GenTrap := StrToIntDef(ASNItem(Pos, Buffer,svt), 0);
+  FGenTrap := StrToIntDef(ASNItem(Pos, FBuffer, Svt), 0);
-  Spectrap := StrToIntDef(ASNItem(Pos, Buffer,svt), 0);
+  FSpecTrap := StrToIntDef(ASNItem(Pos, FBuffer, Svt), 0);
-  TimeTicks := StrToIntDef(ASNItem(Pos, Buffer,svt), 0);
+  FTimeTicks := StrToIntDef(ASNItem(Pos, FBuffer, Svt), 0);
-  ASNItem(Pos, Buffer,svt);
+  ASNItem(Pos, FBuffer, Svt);
-  while (Pos < EndPos) do
+  while Pos < EndPos do
   begin
-      ASNItem(Pos, Buffer,svt);
+    ASNItem(Pos, FBuffer, Svt);
-      Sm := ASNItem(Pos, Buffer,svt);
+    Sm := ASNItem(Pos, FBuffer, Svt);
-      Sv := ASNItem(Pos, Buffer,svt);
+    Sv := ASNItem(Pos, FBuffer, Svt);
-      MIBAdd(Sm, Sv, svt);
+    MIBAdd(Sm, Sv, Svt);
   end;
-  Result := true;
+  Result := True;
 end;
 
 constructor TTrapSNMP.Create;
 begin
   inherited Create;
-  Sock := TUDPBlockSocket.Create;
+  FSock := TUDPBlockSocket.Create;
-  Trap := TTrapPDU.Create;
+  FTrap := TTrapPDU.Create;
-  Timeout := 5000;
+  FTimeout := 5000;
-  SNMPHost := '127.0.0.1';
+  FSNMPHost := cLocalhost;
-  Sock.CreateSocket;
+  FSock.CreateSocket;
 end;
 
 destructor TTrapSNMP.Destroy;
 begin
-  Trap.Free;
+  FTrap.Free;
-  Sock.Free;
+  FSock.Free;
   inherited Destroy;
 end;
 
-function TTrapSNMP.Send: integer;
+function TTrapSNMP.Send: Integer;
 begin
-  Trap.EncodeTrap;
+  FTrap.EncodeTrap;
-  Sock.Connect(SNMPHost, IntToStr(Trap.TrapPort));
+  FSock.Connect(SNMPHost, FTrap.TrapPort);
-  Sock.SendBuffer(PChar(Trap.Buffer), Length(Trap.Buffer));
+  FSock.SendBuffer(PChar(FTrap.FBuffer), Length(FTrap.FBuffer));
   Result := 1;
 end;
 
-function TTrapSNMP.Recv: integer;
+function TTrapSNMP.Recv: Integer;
 var
-  x: integer;
+  x: Integer;
 begin
   Result := 0;
-  Sock.Bind('0.0.0.0', IntToStr(Trap.TrapPort));
+  FSock.Bind('0.0.0.0', FTrap.TrapPort);
-  if Sock.CanRead(Timeout) then
+  if FSock.CanRead(FTimeout) then
   begin
-      x := Sock.WaitingData;
+    x := FSock.WaitingData;
-      if (x > 0) then
+    if x > 0 then
     begin
-          SetLength(Trap.Buffer, x);
+      SetLength(FTrap.FBuffer, x);
-          Sock.RecvBuffer(PChar(Trap.Buffer), x);
+      FSock.RecvBuffer(PChar(FTrap.FBuffer), x);
-          if Trap.DecodeTrap
+      if FTrap.DecodeTrap then
-            then Result:=1;
+        Result := 1;
     end;
   end;
 end;
 
-function SendTrap(Dest, Source, Enterprise, Community: string;
+function SendTrap(const Dest, Source, Enterprise, Community: string;
-  Generic, Specific, Seconds: integer; MIBName, MIBValue: string; MIBtype:integer): integer;
+  Generic, Specific, Seconds: Integer; const MIBName, MIBValue: string;
-var
+  MIBtype: Integer): Integer;
-  SNMP: TTrapSNMP;
 begin
-  SNMP := TTrapSNMP.Create;
+  with TTrapSNMP.Create do
   try
-    SNMP.SNMPHost := Dest;
+    SNMPHost := Dest;
-    SNMP.Trap.TrapHost := Source;
+    Trap.TrapHost := Source;
-    SNMP.Trap.Enterprise := Enterprise;
+    Trap.Enterprise := Enterprise;
-    SNMP.Trap.Community := Community;
+    Trap.Community := Community;
-    SNMP.Trap.GenTrap := Generic;
+    Trap.GenTrap := Generic;
-    SNMP.Trap.SpecTrap := Specific;
+    Trap.SpecTrap := Specific;
-    SNMP.Trap.TimeTicks := Seconds;
+    Trap.TimeTicks := Seconds;
-    SNMP.Trap.MIBAdd(MIBName,MIBValue,MIBType);
+    Trap.MIBAdd(MIBName, MIBValue, MIBType);
-    Result := SNMP.Send;
+    Result := Send;
   finally
-    SNMP.Free;
+    Free;
   end;
 end;
 
 function RecvTrap(var Dest, Source, Enterprise, Community: string;
-  var Generic, Specific, Seconds: integer; var MIBName, MIBValue: TStringList):
+  var Generic, Specific, Seconds: Integer;
-integer;
+  const MIBName, MIBValue: TStringList): Integer;
 var
-  SNMP: TTrapSNMP;
+  i: Integer;
-  i: integer;
 begin
-  SNMP := TTrapSNMP.Create;
+  with TTrapSNMP.Create do
   try
-    SNMP.SNMPHost := Dest;
+    SNMPHost := Dest;
-    Result := SNMP.Recv;
+    Result := Recv;
-    if (Result <> 0) then
+    if Result <> 0 then
     begin
-      Dest := SNMP.SNMPHost;
+      Dest := SNMPHost;
-      Source := SNMP.Trap.TrapHost;
+      Source := Trap.TrapHost;
-      Enterprise := SNMP.Trap.Enterprise;
+      Enterprise := Trap.Enterprise;
-      Community := SNMP.Trap.Community;
+      Community := Trap.Community;
-      Generic := SNMP.Trap.GenTrap;
+      Generic := Trap.GenTrap;
-      Specific := SNMP.Trap.SpecTrap;
+      Specific := Trap.SpecTrap;
-      Seconds := SNMP.Trap.TimeTicks;
+      Seconds := Trap.TimeTicks;
       MIBName.Clear;
       MIBValue.Clear;
-      for i:=0 to (SNMP.Trap.SNMPMibList.count - 1) do
+      for i := 0 to Trap.SNMPMibList.Count - 1 do
       begin
-          MIBName.Add(TSNMPMib(SNMP.Trap.SNMPMibList[i]).OID);
+        MIBName.Add(TSNMPMib(Trap.SNMPMibList[i]).OID);
-          MIBValue.Add(TSNMPMib(SNMP.Trap.SNMPMibList[i]).Value);
+        MIBValue.Add(TSNMPMib(Trap.SNMPMibList[i]).Value);
       end;
     end;
   finally
-    SNMP.Free;
+    Free;
   end;
 end;
 
 end.
-

sntpsend.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.000.000 |
+| Project : Delphree - Synapse                                   | 002.000.001 |
 |==============================================================================|
 | Content: SNTP client                                                         |
 |==============================================================================|
-| The contents of this file are subject to the Mozilla Public License Ver. 1.0 |
+| The contents of this file are subject to the Mozilla Public License Ver. 1.1 |
 | (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/ |
 |                                                                              |
@@ -14,7 +14,7 @@
 | 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)2000.                     |
+| Portions created by Lukas Gebauer are Copyright (c)2000,2001.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -24,142 +24,144 @@
 |==============================================================================}
 
 {$Q-}
+{$WEAKPACKAGEUNIT ON}
 
 unit SNTPsend;
 
 interface
 
 uses
-  synsock, SysUtils, blcksock;
+  SysUtils,
+  synsock, blcksock;
+
+const
+  cNtpProtocol = 'ntp';
 
 type
-
+  PNtp = ^TNtp;
   TNtp = packed record
-    mode:Byte;
+    mode: Byte;
-    stratum:Byte;
+    stratum: Byte;
-    poll:Byte;
+    poll: Byte;
-    Precision:Byte;
+    Precision: Byte;
-    RootDelay : longint;
+    RootDelay: Longint;
-    RootDisperson : longint;
+    RootDisperson: Longint;
-    RefID : longint;
+    RefID: Longint;
-    Ref1, Ref2,
+    Ref1: Longint;
-    Org1, Org2,
+    Ref2: Longint;
-    Rcv1, Rcv2,
+    Org1: Longint;
-    Xmit1, Xmit2 : longint;
+    Org2: Longint;
+    Rcv1: Longint;
+    Rcv2: Longint;
+    Xmit1: Longint;
+    Xmit2: Longint;
   end;
 
-TSNTPSend=class(TObject)
+  TSNTPSend = class(TObject)
   private
-    Sock:TUDPBlockSocket;
+    FNTPReply: TNtp;
-    Buffer:string;
+    FNTPTime: TDateTime;
+    FSntpHost: string;
+    FTimeout: Integer;
+    FSock: TUDPBlockSocket;
+    FBuffer: string;
   public
-    timeout:integer;
-    SntpHost:string;
-    NTPReply:TNtp;
-    NTPTime:TDateTime;
     constructor Create;
     destructor Destroy; override;
-    function DecodeTs(nsec,nfrac:Longint):tdatetime;
+    function DecodeTs(Nsec, Nfrac: Longint): TDateTime;
-    function GetNTP:Boolean;
+    function GetNTP: Boolean;
-    function GetBroadcastNTP:Boolean;
+    function GetBroadcastNTP: Boolean;
-end;
+  published
+    property NTPReply: TNtp read FNTPReply;
+    property NTPTime: TDateTime read FNTPTime;
+    property SntpHost: string read FSntpHost write FSntpHost;
+    property Timeout: Integer read FTimeout write FTimeout;
+  end;
 
 implementation
 
-{==============================================================================}
+constructor TSNTPSend.Create;
-
-{TSNTPSend.Create}
-Constructor TSNTPSend.Create;
 begin
   inherited Create;
-  sock:=TUDPBlockSocket.create;
+  FSock := TUDPBlockSocket.Create;
-  sock.CreateSocket;
+  FSock.CreateSocket;
-  timeout:=5000;
+  FTimeout := 5000;
-  sntphost:='localhost';
+  FSntpHost := cLocalhost;
 end;
 
-{TSNTPSend.Destroy}
+destructor TSNTPSend.Destroy;
-Destructor TSNTPSend.Destroy;
 begin
-  Sock.free;
+  FSock.Free;
-  inherited destroy;
+  inherited Destroy;
 end;
 
-{TSNTPSend.DecodeTs}
+function TSNTPSend.DecodeTs(Nsec, Nfrac: Longint): TDateTime;
-function TSNTPSend.DecodeTs(nsec,nfrac:Longint):tdatetime;
 const
   maxi = 4294967296.0;
 var
-  d, d1: double;
+  d, d1: Double;
 begin
-  nsec:=synsock.htonl(nsec);
+  Nsec := synsock.htonl(Nsec);
-  nfrac:=synsock.htonl(nfrac);
+  Nfrac := synsock.htonl(Nfrac);
-  d:=nsec;
+  d := Nsec;
-  if d<0
+  if d < 0 then
-    then d:=maxi+d-1;
+    d := maxi + d - 1;
-  d1 := nfrac;
+  d1 := Nfrac;
-  if d1<0
+  if d1 < 0 then
-    then d1:=maxi+d1-1;
+    d1 := maxi + d1 - 1;
-  d1:=d1/maxi;
+  d1 := d1 / maxi;
-  d1:=trunc(d1*1000)/1000;
+  d1 := Trunc(d1 * 1000) / 1000;
-  result:=(d+d1)/86400;
+  Result := (d + d1) / 86400;
-  result := Result + 2;
+  Result := Result + 2;
 end;
 
-
+function TSNTPSend.GetBroadcastNTP: Boolean;
-{TSNTPSend.GetBroadcastNTP}
-function TSNTPSend.GetBroadcastNTP:Boolean;
 var
-  PNtp:^TNtp;
+  NtpPtr: PNtp;
-  x:integer;
+  x: Integer;
 begin
-  Result:=False;
+  Result := False;
-  sock.bind('0.0.0.0','ntp');
+  FSock.Bind('0.0.0.0', cNtpProtocol);
-  if sock.canread(timeout)
+  if FSock.CanRead(Timeout) then
-    then begin
-      x:=sock.waitingdata;
-      setlength(Buffer,x);
-      sock.recvbufferFrom(Pointer(Buffer),x);
-      if (sntphost='0.0.0.0') or (sock.GetRemoteSinIP=sntphost) then
-        if x>=SizeOf(NTPReply) then
   begin
-            PNtp:=Pointer(Buffer);
+    x := FSock.WaitingData;
-            NtpReply:=PNtp^;
+    SetLength(FBuffer, x);
-            NTPtime:=DeCodeTs(ntpreply.Xmit1,ntpreply.Xmit2);
+    FSock.RecvBufferFrom(Pointer(FBuffer), x);
-            Result:=True;
+    if (SntpHost = '0.0.0.0') or (FSock.GetRemoteSinIP = SntpHost) then
+      if x >= SizeOf(NTPReply) then
+      begin
+        NtpPtr := Pointer(FBuffer);
+        FNTPReply := NtpPtr^;
+        FNTPTime := DecodeTs(NTPReply.Xmit1, NTPReply.Xmit2);
+        Result := True;
       end;
   end;
 end;
 
-{TSNTPSend.GetNTP}
+function TSNTPSend.GetNTP: Boolean;
-function TSNTPSend.GetNTP:Boolean;
 var
-  q:Tntp;
+  q: TNtp;
-  PNtp:^TNtp;
+  NtpPtr: PNtp;
-  x:integer;
+  x: Integer;
 begin
-  Result:=False;
+  Result := False;
-  sock.Connect(sntphost,'ntp');
+  FSock.Connect(sntphost, cNtpProtocol);
-  fillchar(q,SizeOf(q),0);
+  FillChar(q, SizeOf(q), 0);
-  q.mode:=$1b;
+  q.mode := $1B;
-  sock.SendBuffer(@q,SizeOf(q));
+  FSock.SendBuffer(@q, SizeOf(q));
-  if sock.canread(timeout)
+  if FSock.CanRead(Timeout) then
-    then begin
-      x:=sock.waitingdata;
-      setlength(Buffer,x);
-      sock.recvbuffer(Pointer(Buffer),x);
-      if x>=SizeOf(NTPReply) then
   begin
-          PNtp:=Pointer(Buffer);
+    x := FSock.WaitingData;
-          NtpReply:=PNtp^;
+    SetLength(FBuffer, x);
-          NTPtime:=DeCodeTs(ntpreply.Xmit1,ntpreply.Xmit2);
+    FSock.RecvBuffer(Pointer(FBuffer), x);
-          Result:=True;
+    if x >= SizeOf(NTPReply) then
+    begin
+      NtpPtr := Pointer(FBuffer);
+      FNTPReply := NtpPtr^;
+      FNTPTime := DecodeTs(NTPReply.Xmit1, NTPReply.Xmit2);
+      Result := True;
     end;
   end;
 end;
 
-
-{==============================================================================}
-
-
 end.

synahook.pas

@@ -0,0 +1,21 @@
+unit SynaHook;
+
+interface
+
+type
+  THookReason = (
+    HR_connect,
+    HR_login,
+    HR_logout,
+    HR_command,
+    HR_result,
+    HR_beginTransfer,
+    HR_endTransfer,
+    HR_TransferCounter
+    );
+
+  THookEvent = procedure(Sender: TObject; Reason: THookReason; Value: string) of object;
+
+implementation
+
+end.

synautil.pas

@@ -1,11 +1,11 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.000.000 |
+| Project : Delphree - Synapse                                   | 002.000.001 |
 |==============================================================================|
 | Content: support procedures and functions                                    |
 |==============================================================================|
-| The contents of this file are subject to the Mozilla Public License Ver. 1.0 |
+| The contents of this file are subject to the Mozilla Public License Ver. 1.1 |
 | (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/ |
+| 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 |
@@ -32,73 +32,79 @@ unit SynaUtil;
 interface
 
 uses
-  sysutils, classes,
+  SysUtils, Classes,
 {$IFDEF LINUX}
-  libc;
+  Libc;
 {$ELSE}
-  windows;
+  Windows;
 {$ENDIF}
 
-function timezone:string;
+function Timezone: string;
-function Rfc822DateTime(t:TDateTime):String;
+function Rfc822DateTime(t: TDateTime): string;
-function CodeInt(Value:word):string;
+function CodeInt(Value: Word): string;
-function DeCodeInt(Value:string;Index:integer):word;
+function DecodeInt(const Value: string; Index: Integer): Word;
-function IsIP(Value:string):Boolean;
+function IsIP(const Value: string): Boolean;
-function ReverseIP(Value:string):string;
+function ReverseIP(Value: string): string;
-procedure Dump (Buffer:string;DumpFile:string);
+procedure Dump(const Buffer, DumpFile: string);
-function SeparateLeft(value,delimiter:string):string;
+function SeparateLeft(const Value, Delimiter: string): string;
-function SeparateRight(value,delimiter:string):string;
+function SeparateRight(const Value, Delimiter: string): string;
-function getparameter(value,parameter:string):string;
+function GetParameter(const Value, Parameter: string): string;
-function GetEmailAddr(value:string):string;
+function GetEmailAddr(const Value: string): string;
-function GetEmailDesc(value:string):string;
+function GetEmailDesc(Value: string): string;
-function StrToHex(value:string):string;
+function StrToHex(const Value: string): string;
-function IntToBin(value:integer;digits:byte):string;
+function IntToBin(Value: Integer; Digits: Byte): string;
-function BinToInt(value:string):integer;
+function BinToInt(const Value: string): Integer;
-function ParseURL(URL:string; var Prot,User,Pass,Host,Port,Path,Para:string):string;
+function ParseURL(URL: string; var Prot, User, Pass, Host, Port, Path,
-function StringReplace(value,search,replace:string):string;
+  Para: string): string;
+function StringReplace(Value, Search, Replace: string): string;
 
 implementation
 
 {==============================================================================}
-{timezone}
+
-function timezone:string;
+function Timezone: string;
 {$IFDEF LINUX}
 var
   t: TTime_T;
   UT: TUnixTime;
-  bias:integer;
+  bias: Integer;
-  h,m:integer;
+  h, m: Integer;
 begin
   __time(@T);
-  localtime_r(@T,UT);
+  localtime_r(@T, UT);
-  bias:=ut.__tm_gmtoff div 60;
+  bias := ut.__tm_gmtoff div 60;
-  if bias>=0 then result:='+'
+  if bias >= 0 then
-    else result:='-';
+    Result := '+'
+  else
+    Result := '-';
 {$ELSE}
 var
-  zoneinfo:TTimeZoneInformation;
+  zoneinfo: TTimeZoneInformation;
-  bias:integer;
+  bias: Integer;
-  h,m:integer;
+  h, m: Integer;
 begin
   case GetTimeZoneInformation(Zoneinfo) of
-    2:  bias:=zoneinfo.bias+zoneinfo.DaylightBias;
+    2:
-    1:  bias:=zoneinfo.bias+zoneinfo.StandardBias;
+      bias := zoneinfo.Bias + zoneinfo.DaylightBias;
+    1:
+      bias := zoneinfo.Bias + zoneinfo.StandardBias;
   else
-      bias:=zoneinfo.bias;
+    bias := zoneinfo.Bias;
   end;
-  if bias<=0 then result:='+'
+  if bias <= 0 then
-    else result:='-';
+    Result := '+'
+  else
+    Result := '-';
 {$ENDIF}
-  bias:=abs(bias);
+  bias := Abs(bias);
-  h:=bias div 60;
+  h := bias div 60;
-  m:=bias mod 60;
+  m := bias mod 60;
-  result:=result+format('%.2d%.2d',[h,m]);
+  Result := Result + Format('%.2d%.2d', [h, m]);
 end;
 
 {==============================================================================}
 
-{Rfc822DateTime}
+function Rfc822DateTime(t: TDateTime): string;
-function Rfc822DateTime(t:TDateTime):String;
 var
   I: Integer;
   SaveDayNames: array[1..7] of string;
@@ -111,8 +117,8 @@ const
     'May', 'Jun', 'Jul', 'Aug',
     'Sep', 'Oct', 'Nov', 'Dec');
 begin
-  if ShortDayNames[1] = MyDayNames[1]
+  if ShortDayNames[1] = MyDayNames[1] then
-    then Result := FormatDateTime('ddd, d mmm yyyy hh:mm:ss', t)
+    Result := FormatDateTime('ddd, d mmm yyyy hh:mm:ss', t)
   else
   begin
     for I := Low(ShortDayNames) to High(ShortDayNames) do
@@ -131,329 +137,342 @@ begin
     for I := Low(ShortMonthNames) to High(ShortMonthNames) do
       ShortMonthNames[I] := SaveMonthNames[I];
   end;
-  Result:=Result+' '+Timezone;
+  Result := Result + ' ' + Timezone;
 end;
 
 {==============================================================================}
 
-{CodeInt}
+function CodeInt(Value: Word): string;
-function CodeInt(Value:word):string;
 begin
-  Result := Chr(Hi(Value))+ Chr(Lo(Value))
+  Result := Chr(Hi(Value)) + Chr(Lo(Value))
 end;
 
 {==============================================================================}
 
-{DeCodeInt}
+function DecodeInt(const Value: string; Index: Integer): Word;
-function DeCodeInt(Value:string;Index:integer):word;
 var
-  x,y:Byte;
+  x, y: Byte;
 begin
-  if Length(Value)>index then x:=Ord(Value[index])
+  if Length(Value) > Index then
-    else x:=0;
+    x := Ord(Value[Index])
-  if Length(Value)>(Index+1) then y:=Ord(Value[Index+1])
+  else
-    else y:=0;
+    x := 0;
-  Result:=x*256+y;
+  if Length(Value) > (Index + 1) then
+    y := Ord(Value[Index + 1])
+  else
+    y := 0;
+  Result := x * 256 + y;
 end;
 
 {==============================================================================}
 
-{IsIP}
+function IsIP(const Value: string): Boolean;
-function IsIP(Value:string):Boolean;
 var
-  n,x:integer;
+  n, x: Integer;
 begin
-  Result:=true;
+  Result := true;
-  x:=0;
+  x := 0;
-  for n:=1 to Length(Value) do
+  for n := 1 to Length(Value) do
-    if not (Value[n] in ['0'..'9','.'])
+    if not (Value[n] in ['0'..'9', '.']) then
-      then begin
+    begin
-        Result:=False;
+      Result := False;
-        break;
+      Break;
     end
-      else begin
+    else
-        if Value[n]='.' then Inc(x);
+    begin
+      if Value[n] = '.' then
+        Inc(x);
     end;
-  if x<>3 then Result:=False;
+  if x <> 3 then
+    Result := False;
 end;
 
 {==============================================================================}
 
-{ReverseIP}
+function ReverseIP(Value: string): string;
-function ReverseIP(Value:string):string;
 var
-  x:integer;
+  x: Integer;
 begin
-  Result:='';
+  Result := '';
   repeat
-    x:=LastDelimiter('.',Value);
+    x := LastDelimiter('.', Value);
-    Result:=Result+'.'+Copy(Value,x+1,Length(Value)-x);
+    Result := Result + '.' + Copy(Value, x + 1, Length(Value) - x);
-    Delete(Value,x,Length(Value)-x+1);
+    Delete(Value, x, Length(Value) - x + 1);
-  until x<1;
+  until x < 1;
-  if Length(Result)>0 then
+  if Length(Result) > 0 then
-    if Result[1]='.' then
+    if Result[1] = '.' then
       Delete(Result, 1, 1);
 end;
 
 {==============================================================================}
 
-{dump}
+procedure Dump(const Buffer, DumpFile: string);
-procedure dump (Buffer:string;DumpFile:string);
 var
-  n:integer;
+  n: Integer;
-  s:string;
+  s: string;
-  f:Text;
+  f: Text;
 begin
-  s:='';
+  s := '';
-  for n:=1 to Length(Buffer) do
+  for n := 1 to Length(Buffer) do
-    s:=s+' +#$'+IntToHex(Ord(Buffer[n]),2);
+    s := s + ' +#$' + IntToHex(Ord(Buffer[n]), 2);
-  Assignfile(f,DumpFile);
+  AssignFile(f, DumpFile);
-  if fileexists(DumpFile) then deletefile(PChar(DumpFile));
+  if FileExists(DumpFile) then
-  rewrite(f);
+    DeleteFile(PChar(DumpFile));
+  Rewrite(f);
   try
-    writeln(f,s);
+    Writeln(f, s);
   finally
-    closefile(f);
+    CloseFile(f);
   end;
 end;
 
 {==============================================================================}
-{SeparateLeft}
+
-function SeparateLeft(value,delimiter:string):string;
+function SeparateLeft(const Value, Delimiter: string): string;
 var
-  x:integer;
+  x: Integer;
 begin
-  x:=pos(delimiter,value);
+  x := Pos(Delimiter, Value);
-  if x<1
+  if x < 1 then
-    then result:=trim(value)
+    Result := Trim(Value)
-    else result:=trim(copy(value,1,x-1));
+  else
+    Result := Trim(Copy(Value, 1, x - 1));
 end;
 
 {==============================================================================}
-{SeparateRight}
+
-function SeparateRight(value,delimiter:string):string;
+function SeparateRight(const Value, Delimiter: string): string;
 var
-  x:integer;
+  x: Integer;
 begin
-  x:=pos(delimiter,value);
+  x := Pos(Delimiter, Value);
-  if x>0
+  if x > 0 then
-    then x:=x+length(delimiter)-1;
+    x := x + Length(Delimiter) - 1;
-  result:=trim(copy(value,x+1,length(value)-x));
+  Result := Trim(Copy(Value, x + 1, Length(Value) - x));
 end;
 
 {==============================================================================}
-{GetParameter}
+
-function getparameter(value,parameter:string):string;
+function GetParameter(const Value, Parameter: string): string;
 var
-  x,x1:integer;
+  x, x1: Integer;
-  s:string;
+  s: string;
 begin
-  x:=pos(uppercase(parameter),uppercase(value));
+  x := Pos(UpperCase(Parameter), UpperCase(Value));
-  result:='';
+  Result := '';
-  if x>0 then
+  if x > 0 then
   begin
-      s:=copy(value,x+length(parameter),length(value)-(x+length(parameter))+1);
+    s := Copy(Value, x + Length(Parameter), Length(Value)
-      s:=trim(s);
+      - (x + Length(Parameter)) + 1);
-      x1:=length(s);
+    s := Trim(s);
-      if length(s)>1 then
+    x1 := Length(s);
+    if Length(s) > 1 then
     begin
-          if s[1]='"'
+      if s[1] = '"' then
-            then
       begin
-                s:=copy(s,2,length(s)-1);
+        s := Copy(s, 2, Length(s) - 1);
-                x:=pos('"',s);
+        x := Pos('"', s);
-                if x>0 then x1:=x-1;
+        if x > 0 then
+          x1 := x - 1;
       end
       else
       begin
-                x:=pos(' ',s);
+        x := Pos(' ', s);
-                if x>0 then x1:=x-1;
+        if x > 0 then
+          x1 := x - 1;
       end;
     end;
-      result:=copy(s,1,x1);
+    Result := Copy(s, 1, x1);
   end;
 end;
 
 {==============================================================================}
-{GetEmailAddr}
+
-function GetEmailAddr(value:string):string;
+function GetEmailAddr(const Value: string): string;
 var
-  s:string;
+  s: string;
 begin
-  s:=separateright(value,'<');
+  s := SeparateRight(Value, '<');
-  s:=separateleft(s,'>');
+  s := SeparateLeft(s, '>');
-  result:=trim(s);
+  Result := Trim(s);
 end;
 
 {==============================================================================}
-{GetEmailDesc}
+
-function GetEmailDesc(value:string):string;
+function GetEmailDesc(Value: string): string;
 var
-  s:string;
+  s: string;
 begin
-  value:=trim(value);
+  Value := Trim(Value);
-  s:=separateright(value,'"');
+  s := SeparateRight(Value, '"');
-  if s<>value
+  if s <> Value then
-    then s:=separateleft(s,'"')
+    s := SeparateLeft(s, '"')
   else
   begin
-        s:=separateright(value,'(');
+    s := SeparateRight(Value, '(');
-        if s<>value
+    if s <> Value then
-          then s:=separateleft(s,')')
+      s := SeparateLeft(s, ')')
     else
     begin
-              s:=separateleft(value,'<');
+      s := SeparateLeft(Value, '<');
-              if s=value
+      if s = Value then
-                then s:='';
+        s := '';
     end;
   end;
-  result:=trim(s);
+  Result := Trim(s);
 end;
 
 {==============================================================================}
-{StrToHex}
+
-function StrToHex(value:string):string;
+function StrToHex(const Value: string): string;
 var
-  n:integer;
+  n: Integer;
 begin
-  result:='';
+  Result := '';
-  for n:=1 to length(value) do
+  for n := 1 to Length(Value) do
-    Result:=Result+IntToHex(Byte(value[n]),2);
+    Result := Result + IntToHex(Byte(Value[n]), 2);
-  result:=lowercase(result);
+  Result := LowerCase(Result);
 end;
 
 {==============================================================================}
-{IntToBin}
+
-function IntToBin(value:integer;digits:byte):string;
+function IntToBin(Value: Integer; Digits: Byte): string;
 var
-  x,y,n:integer;
+  x, y, n: Integer;
 begin
-  result:='';
+  Result := '';
-  x:=value;
+  x := Value;
   repeat
-    y:=x mod 2;
+    y := x mod 2;
-    x:=x div 2;
+    x := x div 2;
-    if y>0
+    if y > 0 then
-      then result:='1'+result
+      Result := '1' + Result
-      else result:='0'+result;
+    else
-  until x=0;
+      Result := '0' + Result;
-  x:=length(result);
+  until x = 0;
-  for n:=x to digits-1 do
+  x := Length(Result);
-    result:='0'+result;
+  for n := x to Digits - 1 do
+    Result := '0' + Result;
 end;
 
 {==============================================================================}
-{BinToInt}
+
-function BinToInt(value:string):integer;
+function BinToInt(const Value: string): Integer;
 var
-  x,n:integer;
+  n: Integer;
 begin
-  result:=0;
+  Result := 0;
-  for n:=1 to length(value) do
+  for n := 1 to Length(Value) do
   begin
-      if value[n]='0'
+    if Value[n] = '0' then
-        then x:=0
+      Result := Result * 2
-        else x:=1;
+    else
-      result:=result*2+x;
+      if Value[n] = '1' then
+        Result := Result * 2 + 1
+      else
+        Break;
   end;
 end;
 
 {==============================================================================}
-{ParseURL}
-function ParseURL(URL:string; var Prot,User,Pass,Host,Port,Path,Para:string):string;
-var
-  x:integer;
-  sURL:string;
-  s:string;
-  s1,s2:string;
-begin
-  prot:='http';
-  user:='';
-  pass:='';
-  port:='80';
-  para:='';
 
-  x:=pos('://',URL);
+function ParseURL(URL: string; var Prot, User, Pass, Host, Port, Path,
-  if x>0 then
+  Para: string): string;
+var
+  x: Integer;
+  sURL: string;
+  s: string;
+  s1, s2: string;
+begin
+  Prot := 'http';
+  User := '';
+  Pass := '';
+  Port := '80';
+  Para := '';
+
+  x := Pos('://', URL);
+  if x > 0 then
   begin
-      prot:=separateleft(URL,'://');
+    Prot := SeparateLeft(URL, '://');
-      sURL:=separateright(URL,'://');
+    sURL := SeparateRight(URL, '://');
   end
-    else sURL:=URL;
+  else
-  x:=pos('@',sURL);
+    sURL := URL;
-  if x>0 then
+  x := Pos('@', sURL);
+  if x > 0 then
   begin
-      s:=separateleft(sURL,'@');
+    s := SeparateLeft(sURL, '@');
-      sURL:=separateright(sURL,'@');
+    sURL := SeparateRight(sURL, '@');
-      x:=pos(':',s);
+    x := Pos(':', s);
-      if x>0 then
+    if x > 0 then
     begin
-          user:=separateleft(s,':');
+      User := SeparateLeft(s, ':');
-          pass:=separateright(s,':');
+      Pass := SeparateRight(s, ':');
     end
-        else user:=s;
+    else
+      User := s;
   end;
-  x:=pos('/',sURL);
+  x := Pos('/', sURL);
-  if x>0 then
+  if x > 0 then
   begin
-      s1:=separateleft(sURL,'/');
+    s1 := SeparateLeft(sURL, '/');
-      s2:=separateright(sURL,'/');
+    s2 := SeparateRight(sURL, '/');
   end
   else
   begin
-      s1:=sURL;
+    s1 := sURL;
-      s2:='';
+    s2 := '';
   end;
-  x:=pos(':',s1);
+  x := Pos(':', s1);
-  if x>0 then
+  if x > 0 then
   begin
-      host:=separateleft(s1,':');
+    Host := SeparateLeft(s1, ':');
-      port:=separateright(s1,':');
+    Port := SeparateRight(s1, ':');
   end
-    else host:=s1;
+  else
-  result:='/'+s2;
+    Host := s1;
-  x:=pos('?',s2);
+  Result := '/' + s2;
-  if x>0 then
+  x := Pos('?', s2);
+  if x > 0 then
   begin
-      path:='/'+separateleft(s2,'?');
+    Path := '/' + SeparateLeft(s2, '?');
-      para:=separateright(s2,'?');
+    Para := SeparateRight(s2, '?');
   end
-    else path:='/'+s2;
+  else
-  if host=''
+    Path := '/' + s2;
-    then host:='localhost';
+  if Host = '' then
+    Host := 'localhost';
 end;
 
 {==============================================================================}
-{StringReplace}
+
-function StringReplace(value,search,replace:string):string;
+function StringReplace(Value, Search, Replace: string): string;
 var
-  x,l,ls,lr:integer;
+  x, l, ls, lr: Integer;
 begin
-  if (value='') or (Search='') then
+  if (Value = '') or (Search = '') then
   begin
-      result:=value;
+    Result := Value;
     Exit;
   end;
-  ls:=length(search);
+  ls := Length(Search);
-  lr:=length(replace);
+  lr := Length(Replace);
-  result:='';
+  Result := '';
-  x:=pos(search,value);
+  x := Pos(Search, Value);
-  while x>0 do
+  while x > 0 do
   begin
-      l:=length(result);
+    l := Length(Result);
-      setlength(result,l+x-1);
+    SetLength(Result, l + x - 1);
-      Move(pointer(value)^,Pointer(@result[l+1])^, x-1);
+    Move(Pointer(Value)^, Pointer(@Result[l + 1])^, x - 1);
-//      result:=result+copy(value,1,x-1);
+//      Result:=Result+Copy(Value,1,x-1);
-      l:=length(result);
+    l := Length(Result);
-      setlength(result,l+lr);
+    SetLength(Result, l + lr);
-      Move(pointer(replace)^,Pointer(@result[l+1])^, lr);
+    Move(Pointer(Replace)^, Pointer(@Result[l + 1])^, lr);
-//      result:=result+replace;
+//      Result:=Result+Replace;
-      delete(value,1,x-1+ls);
+    Delete(Value, 1, x - 1 + ls);
-      x:=pos(search,value);
+    x := Pos(Search, Value);
   end;
-  result:=result+value;
+  Result := Result + Value;
 end;
 
-{==============================================================================}
-
 end.

synsock.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.000.001 |
+| Project : Delphree - Synapse                                   | 001.000.002 |
 |==============================================================================|
 | Content: Socket Independent Platform                                         |
 |==============================================================================|
-| The contents of this file are subject to the Mozilla Public License Ver. 1.0 |
+| The contents of this file are subject to the Mozilla Public License Ver. 1.1 |
 | (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/ |
 |                                                                              |
@@ -23,15 +23,17 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
+{$WEAKPACKAGEUNIT ON}
+
 unit synsock;
 
 interface
 
 uses
 {$IFDEF LINUX}
-  libc, kernelioctl;
+  Libc, KernelIoctl;
 {$ELSE}
-  winsock, windows;
+  Windows, WinSock;
 {$ENDIF}
 
 {$IFDEF LINUX}
@@ -90,10 +92,11 @@ const
   WSANO_DATA = -6;
 
 {$ELSE}
+
 const
   DLLStackName = 'wsock32.dll';
 var
-  LibHandle : THandle = 0;
+  LibHandle: THandle = 0;
 {$ENDIF}
 
 {$IFDEF LINUX}
@@ -111,321 +114,328 @@ type
     iMaxUdpDg: Word;
     lpVendorInfo: PChar;
   end;
-  DWORD=integer;
+  DWORD = Integer;
-  TLinger=Linger;
+  TLinger = Linger;
 {$ENDIF}
 
-
 type
-  TWSAStartup            = function (wVersionRequired: word;
+  TWSAStartup = function(wVersionRequired: Word;
     var WSData: TWSAData): Integer; stdcall;
-  TWSACleanup            = function : Integer; stdcall;
+  TWSACleanup = function: Integer; stdcall;
-  TWSAGetLastError       = function : Integer; stdcall;
+  TWSAGetLastError = function: Integer; stdcall;
-  TGetServByName         = function (name, proto: PChar): PServEnt; stdcall;
+  TGetServByName = function(name, proto: PChar): PServEnt; stdcall;
-  TGetServByPort         = function (port: Integer; proto: PChar): PServEnt; stdcall;
+  TGetServByPort = function(port: Integer; proto: PChar): PServEnt; stdcall;
-  TGetProtoByName        = function (name: PChar): PProtoEnt; stdcall;
+  TGetProtoByName = function(name: PChar): PProtoEnt; stdcall;
-  TGetProtoByNumber      = function (proto: Integer): PProtoEnt; stdcall;
+  TGetProtoByNumber = function(proto: Integer): PProtoEnt; stdcall;
-  TGetHostByName         = function (name: PChar): PHostEnt; stdcall;
+  TGetHostByName = function(name: PChar): PHostEnt; stdcall;
-  TGetHostByAddr         = function (addr: Pointer; len, Struct: Integer): PHostEnt; stdcall;
+  TGetHostByAddr = function(addr: Pointer; len, Struc: Integer): PHostEnt; stdcall;
-  TGetHostName           = function (name: PChar; len: Integer): Integer; stdcall;
+  TGetHostName = function(name: PChar; len: Integer): Integer; stdcall;
-  TShutdown              = function (s: TSocket; how: Integer): Integer; stdcall;
+  TShutdown = function(s: TSocket; how: Integer): Integer; stdcall;
-  TSetSockOpt            = function (s: TSocket; level, optname: Integer;
+  TSetSockOpt = function(s: TSocket; level, optname: Integer;
-                                     optval: PChar;
+    optval: PChar; optlen: Integer): Integer; stdcall;
-                                     optlen: Integer): Integer; stdcall;
+  TGetSockOpt = function(s: TSocket; level, optname: Integer;
-  TGetSockOpt            = function (s: TSocket; level, optname: Integer;
+    optval: PChar; var optlen: Integer): Integer; stdcall;
-                                     optval: PChar;
+  TSendTo = function(s: TSocket; var Buf;
-                                     var optlen: Integer): Integer; stdcall;
+    len, flags: Integer; var addrto: TSockAddr;
-  TSendTo                = function (s: TSocket; var Buf;
-                                     len, flags: Integer;
-                                     var addrto: TSockAddr;
     tolen: Integer): Integer; stdcall;
-  TSend                  = function (s: TSocket; var Buf;
+  TSend = function(s: TSocket; var Buf;
     len, flags: Integer): Integer; stdcall;
-  TRecv                  = function (s: TSocket;
+  TRecv = function(s: TSocket;
-                                     var Buf;
+    var Buf; len, flags: Integer): Integer; stdcall;
-                                     len, flags: Integer): Integer; stdcall;
+  TRecvFrom = function(s: TSocket;
-  TRecvFrom              = function (s: TSocket;
+    var Buf; len, flags: Integer; var from: TSockAddr;
-                                     var Buf; len, flags: Integer;
-                                     var from: TSockAddr;
     var fromlen: Integer): Integer; stdcall;
-  Tntohs                 = function (netshort: u_short): u_short; stdcall;
+  Tntohs = function(netshort: u_short): u_short; stdcall;
-  Tntohl                 = function (netlong: u_long): u_long; stdcall;
+  Tntohl = function(netlong: u_long): u_long; stdcall;
-  TListen                = function (s: TSocket;
+  TListen = function(s: TSocket; backlog: Integer): Integer; stdcall;
-                                     backlog: Integer): Integer; stdcall;
+  TIoctlSocket = function(s: TSocket; cmd: DWORD;
-  TIoctlSocket           = function (s: TSocket; cmd: DWORD;
     var arg: u_long): Integer; stdcall;
-  TInet_ntoa             = function (inaddr: TInAddr): PChar; stdcall;
+  TInet_ntoa = function(inaddr: TInAddr): PChar; stdcall;
-  TInet_addr             = function (cp: PChar): u_long; stdcall;
+  TInet_addr = function(cp: PChar): u_long; stdcall;
-  Thtons                 = function (hostshort: u_short): u_short; stdcall;
+  Thtons = function(hostshort: u_short): u_short; stdcall;
-  Thtonl                 = function (hostlong: u_long): u_long; stdcall;
+  Thtonl = function(hostlong: u_long): u_long; stdcall;
-  TGetSockName           = function (s: TSocket; var name: TSockAddr;
+  TGetSockName = function(s: TSocket; var name: TSockAddr;
     var namelen: Integer): Integer; stdcall;
-  TGetPeerName           = function (s: TSocket; var name: TSockAddr;
+  TGetPeerName = function(s: TSocket; var name: TSockAddr;
     var namelen: Integer): Integer; stdcall;
-  TConnect               = function (s: TSocket; var name: TSockAddr;
+  TConnect = function(s: TSocket; var name: TSockAddr;
     namelen: Integer): Integer; stdcall;
-  TCloseSocket           = function (s: TSocket): Integer; stdcall;
+  TCloseSocket = function(s: TSocket): Integer; stdcall;
-  TBind                  = function (s: TSocket; var addr: TSockAddr;
+  TBind = function(s: TSocket; var addr: TSockAddr;
     namelen: Integer): Integer; stdcall;
-  TAccept                = function (s: TSocket; addr: PSockAddr;
+  TAccept = function(s: TSocket; addr: PSockAddr;
     addrlen: PInteger): TSocket; stdcall;
-  TSocketProc            = function (af, Struct, protocol: Integer): TSocket; stdcall;
+  TSocketProc = function(af, Struc, Protocol: Integer): TSocket; stdcall;
-  TSelect                = function (nfds: Integer; readfds, writefds, exceptfds: PFDSet;
+  TSelect = function(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
     timeout: PTimeVal): Longint; stdcall;
 
 var
-   WSAStartup            : TWSAStartup       =nil;
+  WSAStartup: TWSAStartup = nil;
-   WSACleanup            : TWSACleanup       =nil;
+  WSACleanup: TWSACleanup = nil;
-   WSAGetLastError       : TWSAGetLastError  =nil;
+  WSAGetLastError: TWSAGetLastError = nil;
-   GetServByName         : TGetServByName    =nil;
+  GetServByName: TGetServByName = nil;
-   GetServByPort         : TGetServByPort    =nil;
+  GetServByPort: TGetServByPort = nil;
-   GetProtoByName        : TGetProtoByName   =nil;
+  GetProtoByName: TGetProtoByName = nil;
-   GetProtoByNumber      : TGetProtoByNumber =nil;
+  GetProtoByNumber: TGetProtoByNumber = nil;
-   GetHostByName         : TGetHostByName    =nil;
+  GetHostByName: TGetHostByName = nil;
-   GetHostByAddr         : TGetHostByAddr    =nil;
+  GetHostByAddr: TGetHostByAddr = nil;
-   GetHostName           : TGetHostName      =nil;
+  GetHostName: TGetHostName = nil;
-   Shutdown              : TShutdown         =nil;
+  Shutdown: TShutdown = nil;
-   SetSockOpt            : TSetSockOpt       =nil;
+  SetSockOpt: TSetSockOpt = nil;
-   GetSockOpt            : TGetSockOpt       =nil;
+  GetSockOpt: TGetSockOpt = nil;
-   SendTo                : TSendTo           =nil;
+  SendTo: TSendTo = nil;
-   Send                  : TSend             =nil;
+  Send: TSend = nil;
-   Recv                  : TRecv             =nil;
+  Recv: TRecv = nil;
-   RecvFrom              : TRecvFrom         =nil;
+  RecvFrom: TRecvFrom = nil;
-   ntohs                 : Tntohs            =nil;
+  ntohs: Tntohs = nil;
-   ntohl                 : Tntohl            =nil;
+  ntohl: Tntohl = nil;
-   Listen                : TListen           =nil;
+  Listen: TListen = nil;
-   IoctlSocket           : TIoctlSocket      =nil;
+  IoctlSocket: TIoctlSocket = nil;
-   Inet_ntoa             : TInet_ntoa        =nil;
+  Inet_ntoa: TInet_ntoa = nil;
-   Inet_addr             : TInet_addr        =nil;
+  Inet_addr: TInet_addr = nil;
-   htons                 : Thtons            =nil;
+  htons: Thtons = nil;
-   htonl                 : Thtonl            =nil;
+  htonl: Thtonl = nil;
-   GetSockName           : TGetSockName      =nil;
+  GetSockName: TGetSockName = nil;
-   GetPeerName           : TGetPeerName      =nil;
+  GetPeerName: TGetPeerName = nil;
-   Connect               : TConnect          =nil;
+  Connect: TConnect = nil;
-   CloseSocket           : TCloseSocket      =nil;
+  CloseSocket: TCloseSocket = nil;
-   Bind                  : TBind             =nil;
+  Bind: TBind = nil;
-   Accept                : TAccept           =nil;
+  Accept: TAccept = nil;
-   Socket                : TSocketProc       =nil;
+  Socket: TSocketProc = nil;
-   Select                : TSelect           =nil;
+  Select: TSelect = nil;
 
-function InitSocketInterface(stack:string):Boolean;
+function InitSocketInterface(stack: string): Boolean;
-function DestroySocketInterface:Boolean;
+function DestroySocketInterface: Boolean;
 
 {$IFDEF LINUX}
-function LSWSAStartup (wVersionRequired: Word; var WSData: TWSAData): Integer; stdcall;
+function LSWSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer; stdcall;
-function LSWSACleanup : Integer; stdcall;
+function LSWSACleanup: Integer; stdcall;
-function LSWSAGetLastError : Integer; stdcall;
+function LSWSAGetLastError: Integer; stdcall;
-function LSGetServByName (name, proto: PChar): PServEnt; stdcall;
+function LSGetServByName(name, proto: PChar): PServEnt; stdcall;
-function LSGetServByPort (port: Integer; proto: PChar): PServEnt; stdcall;
+function LSGetServByPort(port: Integer; proto: PChar): PServEnt; stdcall;
-function LSGetProtoByName (name: PChar): PProtoEnt; stdcall;
+function LSGetProtoByName(name: PChar): PProtoEnt; stdcall;
-function LSGetProtoByNumber (proto: Integer): PProtoEnt; stdcall;
+function LSGetProtoByNumber(proto: Integer): PProtoEnt; stdcall;
-function LSGetHostByName (name: PChar): PHostEnt; stdcall;
+function LSGetHostByName(name: PChar): PHostEnt; stdcall;
-function LSGetHostByAddr (addr: Pointer; len, Struct: Integer): PHostEnt; stdcall;
+function LSGetHostByAddr(addr: Pointer; len, Struc: Integer): PHostEnt; stdcall;
-function LSGetHostName (name: PChar; len: Integer): Integer; stdcall;
+function LSGetHostName(name: PChar; len: Integer): Integer; stdcall;
-function LSShutdown (s: TSocket; how: Integer): Integer; stdcall;
+function LSShutdown(s: TSocket; how: Integer): Integer; stdcall;
-function LSSetSockOpt (s: TSocket; level, optname: Integer; optval: PChar; optlen: Integer): Integer; stdcall;
+function LSSetSockOpt(s: TSocket; level, optname: Integer; optval: PChar;
-function LSGetSockOpt (s: TSocket; level, optname: Integer; optval: PChar; var optlen: Integer): Integer; stdcall;
+  optlen: Integer): Integer; stdcall;
-function LSSendTo (s: TSocket; var Buf; len, flags: Integer; var addrto: TSockAddr; tolen: Integer): Integer; stdcall;
+function LSGetSockOpt(s: TSocket; level, optname: Integer; optval: PChar;
-function LSSend (s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
+  var optlen: Integer): Integer; stdcall;
-function LSRecv (s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
+function LSSendTo(s: TSocket; var Buf; len, flags: Integer;
-function LSRecvFrom (s: TSocket; var Buf; len, flags: Integer; var from: TSockAddr; var fromlen: Integer): Integer; stdcall;
+  var addrto: TSockAddr; tolen: Integer): Integer; stdcall;
-function LSntohs (netshort: u_short): u_short; stdcall;
+function LSSend(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
-function LSntohl (netlong: u_long): u_long; stdcall;
+function LSRecv(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
-function LSListen (s: TSocket; backlog: Integer): Integer; stdcall;
+function LSRecvFrom(s: TSocket; var Buf; len, flags: Integer;
-function LSIoctlSocket (s: TSocket; cmd: DWORD; var arg: u_long): Integer; stdcall;
+  var from: TSockAddr; var fromlen: Integer): Integer; stdcall;
-function LSInet_ntoa (inaddr: TInAddr): PChar; stdcall;
+function LSntohs(netshort: u_short): u_short; stdcall;
-function LSInet_addr (cp: PChar): u_long; stdcall;
+function LSntohl(netlong: u_long): u_long; stdcall;
-function LShtons (hostshort: u_short): u_short; stdcall;
+function LSListen(s: TSocket; backlog: Integer): Integer; stdcall;
-function LShtonl (hostlong: u_long): u_long; stdcall;
+function LSIoctlSocket(s: TSocket; cmd: DWORD; var arg: u_long): Integer; stdcall;
-function LSGetSockName (s: TSocket; var name: TSockAddr; var namelen: Integer): Integer; stdcall;
+function LSInet_ntoa(inaddr: TInAddr): PChar; stdcall;
-function LSGetPeerName (s: TSocket; var name: TSockAddr; var namelen: Integer): Integer; stdcall;
+function LSInet_addr(cp: PChar): u_long; stdcall;
-function LSConnect (s: TSocket; var name: TSockAddr; namelen: Integer): Integer; stdcall;
+function LShtons(hostshort: u_short): u_short; stdcall;
-function LSCloseSocket (s: TSocket): Integer; stdcall;
+function LShtonl(hostlong: u_long): u_long; stdcall;
-function LSBind (s: TSocket; var addr: TSockAddr; namelen: Integer): Integer; stdcall;
+function LSGetSockName(s: TSocket; var name: TSockAddr;
-function LSAccept (s: TSocket; addr: PSockAddr; addrlen: PInteger): TSocket; stdcall;
+  var namelen: Integer): Integer; stdcall;
-function LSSocketProc (af, Struct, protocol: Integer): TSocket; stdcall;
+function LSGetPeerName(s: TSocket; var name: TSockAddr;
-function LSSelect (nfds: Integer; readfds, writefds, exceptfds: PFDSet; timeout: PTimeVal): Longint; stdcall;
+  var namelen: Integer): Integer; stdcall;
+function LSConnect(s: TSocket; var name: TSockAddr; namelen: Integer): Integer; stdcall;
+function LSCloseSocket(s: TSocket): Integer; stdcall;
+function LSBind(s: TSocket; var addr: TSockAddr; namelen: Integer): Integer; stdcall;
+function LSAccept(s: TSocket; addr: PSockAddr; addrlen: PInteger): TSocket; stdcall;
+function LSSocketProc(af, Struc, Protocol: Integer): TSocket; stdcall;
+function LSSelect(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
+  timeout: PTimeVal): Longint; stdcall;
 {$ENDIF}
 
-
 implementation
 
 {$IFDEF LINUX}
-function LSWSAStartup (wVersionRequired: Word; var WSData: TWSAData): Integer;
+
+function LSWSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer;
 begin
-  WSData.wVersion:=wVersionRequired;
+  with WSData do
-  WSData.wHighVersion:=$101;
+  begin
-  WSData.szDescription:='Synapse Platform Independent Socket Layer';
+    wVersion := wVersionRequired;
-  WSData.szSystemStatus:='On Linux';
+    wHighVersion := $101;
-  WSData.iMaxSockets:=32768;
+    szDescription := 'Synapse Platform Independent Socket Layer';
-  WSData.iMaxUdpDg:=8192;
+    szSystemStatus := 'On Linux';
-  result:=0;
+    iMaxSockets := 32768;
+    iMaxUdpDg := 8192;
+  end;
+  Result := 0;
 end;
 
-function LSWSACleanup : Integer;
+function LSWSACleanup: Integer;
 begin
-  Result:=0;
+  Result := 0;
 end;
 
-function LSWSAGetLastError : Integer;
+function LSWSAGetLastError: Integer;
 begin
-  result:=System.GetLastError;
+  Result := System.GetLastError;
 end;
 
-function LSGetServByName (name, proto: PChar): PServEnt;
+function LSGetServByName(name, proto: PChar): PServEnt;
 begin
-  result:=libc.GetServByName(name,proto);
+  Result := libc.GetServByName(name, proto);
 end;
 
-function LSGetServByPort (port: Integer; proto: PChar): PServEnt;
+function LSGetServByPort(port: Integer; proto: PChar): PServEnt;
 begin
-  result:=libc.GetServByPort(port,proto);
+  Result := libc.GetServByPort(port, proto);
 end;
 
-function LSGetProtoByName (name: PChar): PProtoEnt;
+function LSGetProtoByName(name: PChar): PProtoEnt;
 begin
-  result:=libc.getprotobyname(Name);
+  Result := libc.GetProtoByName(Name);
 end;
 
-function LSGetProtoByNumber (proto: Integer): PProtoEnt;
+function LSGetProtoByNumber(proto: Integer): PProtoEnt;
 begin
-  result:=libc.getprotobynumber(proto);
+  Result := libc.GetProtoByNumber(proto);
 end;
 
-function LSGetHostByName (name: PChar): PHostEnt;
+function LSGetHostByName(name: PChar): PHostEnt;
 begin
-  result:=libc.GetHostByName(Name);
+  Result := libc.GetHostByName(Name);
 end;
 
-function LSGetHostByAddr (addr: Pointer; len, Struct: Integer): PHostEnt;
+function LSGetHostByAddr(addr: Pointer; len, Struc: Integer): PHostEnt;
 begin
-  Result:=libc.GetHostByAddr(Addr,len,struct);
+  Result := libc.GetHostByAddr(Addr, len, struc);
 end;
 
-function LSGetHostName (name: PChar; len: Integer): Integer;
+function LSGetHostName(name: PChar; len: Integer): Integer;
 begin
-  Result:=libc.GetHostName(Name,Len);
+  Result := libc.GetHostName(Name, Len);
 end;
 
-function LSShutdown (s: TSocket; how: Integer): Integer;
+function LSShutdown(s: TSocket; how: Integer): Integer;
 begin
-  result:=libc.Shutdown(S,How);
+  Result := libc.Shutdown(S, How);
 end;
 
-function LSSetSockOpt (s: TSocket; level, optname: Integer; optval: PChar; optlen: Integer): Integer;
+function LSSetSockOpt(s: TSocket; level, optname: Integer; optval: PChar;
+  optlen: Integer): Integer;
 begin
-  result:=libc.SetSockOpt(S,Level,OptName,OptVal,OptLen);
+  Result := libc.SetSockOpt(S, Level, OptName, OptVal, OptLen);
 end;
 
-function LSGetSockOpt (s: TSocket; level, optname: Integer; optval: PChar; var optlen: Integer): Integer;
+function LSGetSockOpt(s: TSocket; level, optname: Integer; optval: PChar;
+  var optlen: Integer): Integer;
 begin
-  result:=libc.getsockopt(s,level,optname,optval,cardinal(optlen));
+  Result := libc.getsockopt(s, level, optname, optval, cardinal(optlen));
 end;
 
-function LSSendTo (s: TSocket; var Buf; len, flags: Integer; var addrto: TSockAddr; tolen: Integer): Integer;
+function LSSendTo(s: TSocket; var Buf; len, flags: Integer;
+  var addrto: TSockAddr; tolen: Integer): Integer;
 begin
-  result:=libc.SendTo(S,Buf,Len,Flags,Addrto,Tolen);
+  Result := libc.SendTo(S, Buf, Len, Flags, Addrto, Tolen);
 end;
 
-function LSSend (s: TSocket; var Buf; len, flags: Integer): Integer;
+function LSSend(s: TSocket; var Buf; len, flags: Integer): Integer;
 begin
-  result:=libc.Send(S,Buf,Len,Flags);
+  Result := libc.Send(S, Buf, Len, Flags);
 end;
 
-function LSRecv (s: TSocket; var Buf; len, flags: Integer): Integer;
+function LSRecv(s: TSocket; var Buf; len, flags: Integer): Integer;
 begin
-  result:=libc.Recv(S,Buf,Len,Flags);
+  Result := libc.Recv(S, Buf, Len, Flags);
 end;
 
-function LSRecvFrom (s: TSocket; var Buf; len, flags: Integer; var from: TSockAddr; var fromlen: Integer): Integer;
+function LSRecvFrom(s: TSocket; var Buf; len, flags: Integer;
+  var from: TSockAddr; var fromlen: Integer): Integer;
 begin
-  result:=libc.RecvFrom(S,Buf,Len,Flags,@from,@fromlen);
+  Result := libc.RecvFrom(S, Buf, Len, Flags, @from, @fromlen);
 end;
 
-function LSntohs (netshort: u_short): u_short;
+function LSntohs(netshort: u_short): u_short;
 begin
-  Result:=libc.NToHS(netshort);
+  Result := libc.NToHS(netshort);
 end;
 
-function LSntohl (netlong: u_long): u_long;
+function LSntohl(netlong: u_long): u_long;
 begin
-  Result:=libc.NToHL(netlong);
+  Result := libc.NToHL(netlong);
 end;
 
-function LSListen (s: TSocket; backlog: Integer): Integer;
+function LSListen(s: TSocket; backlog: Integer): Integer;
 begin
-  result:=libc.Listen(S,Backlog);
+  Result := libc.Listen(S, Backlog);
 end;
 
-function LSIoctlSocket (s: TSocket; cmd: DWORD; var arg: u_long): Integer;
+function LSIoctlSocket(s: TSocket; cmd: DWORD; var arg: u_long): Integer;
 begin
-  result:=libc.ioctl(s,cmd,@arg);
+  Result := libc.ioctl(s, cmd, @arg);
 end;
 
-function LSInet_ntoa (inaddr: TInAddr): PChar;
+function LSInet_ntoa(inaddr: TInAddr): PChar;
 begin
-  result:=libc.inet_ntoa(inaddr);
+  Result := libc.inet_ntoa(inaddr);
 end;
 
-function LSInet_addr (cp: PChar): u_long;
+function LSInet_addr(cp: PChar): u_long;
 begin
-  result:=libc.inet_addr(cp);
+  Result := libc.inet_addr(cp);
 end;
 
-function LShtons (hostshort: u_short): u_short;
+function LShtons(hostshort: u_short): u_short;
 begin
-  result:=libc.HToNs(HostShort);
+  Result := libc.HToNs(HostShort);
 end;
 
-function LShtonl (hostlong: u_long): u_long;
+function LShtonl(hostlong: u_long): u_long;
 begin
-  Result:=libc.HToNL(HostLong);
+  Result := libc.HToNL(HostLong);
 end;
 
-function LSGetSockName (s: TSocket; var name: TSockAddr; var namelen: Integer): Integer;
+function LSGetSockName(s: TSocket; var name: TSockAddr; var namelen: Integer): Integer;
 begin
-  Result:=libc.GetSockName(S,Name,cardinal(namelen));
+  Result := libc.GetSockName(S, Name, cardinal(namelen));
 end;
 
-function LSGetPeerName (s: TSocket; var name: TSockAddr; var namelen: Integer): Integer;
+function LSGetPeerName(s: TSocket; var name: TSockAddr; var namelen: Integer): Integer;
 begin
-  Result:=libc.GetPeerName(S,Name,cardinal(namelen));
+  Result := libc.GetPeerName(S, Name, cardinal(namelen));
 end;
 
-function LSConnect (s: TSocket; var name: TSockAddr; namelen: Integer): Integer;
+function LSConnect(s: TSocket; var name: TSockAddr; namelen: Integer): Integer;
 begin
-  result:=libc.Connect(S,name,namelen);
+  Result := libc.Connect(S, name, namelen);
 end;
 
-function LSCloseSocket (s: TSocket): Integer;
+function LSCloseSocket(s: TSocket): Integer;
 begin
-  result:=libc.__close(s);
+  Result := libc.__close(s);
 end;
 
-function LSBind (s: TSocket; var addr: TSockAddr; namelen: Integer): Integer;
+function LSBind(s: TSocket; var addr: TSockAddr; namelen: Integer): Integer;
 begin
-  result:=libc.Bind(S,addr,namelen);
+  Result := libc.Bind(S, addr, namelen);
 end;
 
-function LSAccept (s: TSocket; addr: PSockAddr; addrlen: PInteger): TSocket;
+function LSAccept(s: TSocket; addr: PSockAddr; addrlen: PInteger): TSocket;
 begin
-  result:=libc.Accept(S,addr,psocketlength(addrlen));
+  Result := libc.Accept(S, addr, psocketlength(addrlen));
 end;
 
-function LSSocketProc (af, Struct, protocol: Integer): TSocket;
+function LSSocketProc(af, Struc, Protocol: Integer): TSocket;
 begin
-  result:=libc.Socket(Af,Struct,Protocol);
+  Result := libc.Socket(Af, Struc, Protocol);
 end;
 
-function LSSelect (nfds: Integer; readfds, writefds, exceptfds: PFDSet; timeout: PTimeVal): Longint;
+function LSSelect(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
+  timeout: PTimeVal): Longint;
 begin
-  Result:=libc.Select(nfds,readfds,writefds,exceptfds,timeout);
+  Result := libc.Select(nfds, readfds, writefds, exceptfds, timeout);
 end;
 
 {$ENDIF}
 
-
+function InitSocketInterface(stack: string): Boolean;
-function InitSocketInterface(stack:string):Boolean;
 begin
 {$IFDEF LINUX}
   Accept := LSAccept;
@@ -451,72 +461,71 @@ begin
   SetSockOpt := LSsetsockopt;
   ShutDown := LSshutdown;
   Socket := LSsocketProc;
-  GetHostByAddr := LSgethostbyaddr;
+  GetHostByAddr := LSGetHostByAddr;
-  GetHostByName := LSgethostbyname;
+  GetHostByName := LSGetHostByName;
-  GetProtoByName := LSgetprotobyname;
+  GetProtoByName := LSGetProtoByName;
-  GetProtoByNumber := LSgetprotobynumber;
+  GetProtoByNumber := LSGetProtoByNumber;
-  GetServByName := LSgetservbyname;
+  GetServByName := LSGetServByName;
-  GetServByPort := LSgetservbyport;
+  GetServByPort := LSGetServByPort;
-  GetHostName := LSgethostname;
+  GetHostName := LSGetHostName;
   WSAGetLastError := LSWSAGetLastError;
   WSAStartup := LSWSAStartup;
   WSACleanup := LSWSACleanup;
-  Result:=True;
+  Result := True;
 {$ELSE}
-  Result:=False;
+  Result := False;
-  if stack=''
+  if stack = '' then
-    then stack:=DLLStackName;
+    stack := DLLStackName;
   LibHandle := Windows.LoadLibrary(PChar(Stack));
-  if LibHandle <> 0 then begin
+  if LibHandle <> 0 then
-    Accept           := Windows.GetProcAddress (LibHandle, PChar('accept'));
+  begin
-    Bind             := Windows.GetProcAddress (LibHandle, PChar('bind'));
+    Accept := Windows.GetProcAddress(LibHandle, PChar('accept'));
-    CloseSocket      := Windows.GetProcAddress (LibHandle, PChar('closesocket'));
+    Bind := Windows.GetProcAddress(LibHandle, PChar('bind'));
-    Connect          := Windows.GetProcAddress (LibHandle, PChar('connect'));
+    CloseSocket := Windows.GetProcAddress(LibHandle, PChar('closesocket'));
-    GetPeerName      := Windows.GetProcAddress (LibHandle, PChar('getpeername'));
+    Connect := Windows.GetProcAddress(LibHandle, PChar('connect'));
-    GetSockName      := Windows.GetProcAddress (LibHandle, PChar('getsockname'));
+    GetPeerName := Windows.GetProcAddress(LibHandle, PChar('getpeername'));
-    GetSockOpt       := Windows.GetProcAddress (LibHandle, PChar('getsockopt'));
+    GetSockName := Windows.GetProcAddress(LibHandle, PChar('getsockname'));
-    Htonl            := Windows.GetProcAddress (LibHandle, PChar('htonl'));
+    GetSockOpt := Windows.GetProcAddress(LibHandle, PChar('getsockopt'));
-    Htons            := Windows.GetProcAddress (LibHandle, PChar('htons'));
+    Htonl := Windows.GetProcAddress(LibHandle, PChar('htonl'));
-    Inet_Addr        := Windows.GetProcAddress (LibHandle, PChar('inet_addr'));
+    Htons := Windows.GetProcAddress(LibHandle, PChar('htons'));
-    Inet_Ntoa        := Windows.GetProcAddress (LibHandle, PChar('inet_ntoa'));
+    Inet_Addr := Windows.GetProcAddress(LibHandle, PChar('inet_addr'));
-    IoctlSocket      := Windows.GetProcAddress (LibHandle, PChar('ioctlsocket'));
+    Inet_Ntoa := Windows.GetProcAddress(LibHandle, PChar('inet_ntoa'));
-    Listen           := Windows.GetProcAddress (LibHandle, PChar('listen'));
+    IoctlSocket := Windows.GetProcAddress(LibHandle, PChar('ioctlsocket'));
-    Ntohl            := Windows.GetProcAddress (LibHandle, PChar('ntohl'));
+    Listen := Windows.GetProcAddress(LibHandle, PChar('listen'));
-    Ntohs            := Windows.GetProcAddress (LibHandle, PChar('ntohs'));
+    Ntohl := Windows.GetProcAddress(LibHandle, PChar('ntohl'));
-    Recv             := Windows.GetProcAddress (LibHandle, PChar('recv'));
+    Ntohs := Windows.GetProcAddress(LibHandle, PChar('ntohs'));
-    RecvFrom         := Windows.GetProcAddress (LibHandle, PChar('recvfrom'));
+    Recv := Windows.GetProcAddress(LibHandle, PChar('recv'));
-    Select           := Windows.GetProcAddress (LibHandle, PChar('select'));
+    RecvFrom := Windows.GetProcAddress(LibHandle, PChar('recvfrom'));
-    Send             := Windows.GetProcAddress (LibHandle, PChar('send'));
+    Select := Windows.GetProcAddress(LibHandle, PChar('select'));
-    SendTo           := Windows.GetProcAddress (LibHandle, PChar('sendto'));
+    Send := Windows.GetProcAddress(LibHandle, PChar('send'));
-    SetSockOpt       := Windows.GetProcAddress (LibHandle, PChar('setsockopt'));
+    SendTo := Windows.GetProcAddress(LibHandle, PChar('sendto'));
-    ShutDown         := Windows.GetProcAddress (LibHandle, PChar('shutdown'));
+    SetSockOpt := Windows.GetProcAddress(LibHandle, PChar('setsockopt'));
-    Socket           := Windows.GetProcAddress (LibHandle, PChar('socket'));
+    ShutDown := Windows.GetProcAddress(LibHandle, PChar('shutdown'));
-    GetHostByAddr    := Windows.GetProcAddress (LibHandle, PChar('gethostbyaddr'));
+    Socket := Windows.GetProcAddress(LibHandle, PChar('socket'));
-    GetHostByName    := Windows.GetProcAddress (LibHandle, PChar('gethostbyname'));
+    GetHostByAddr := Windows.GetProcAddress(LibHandle, PChar('gethostbyaddr'));
-    GetProtoByName   := Windows.GetProcAddress (LibHandle, PChar('getprotobyname'));
+    GetHostByName := Windows.GetProcAddress(LibHandle, PChar('gethostbyname'));
-    GetProtoByNumber := Windows.GetProcAddress (LibHandle, PChar('getprotobynumber'));
+    GetProtoByName := Windows.GetProcAddress(LibHandle, PChar('getprotobyname'));
-    GetServByName    := Windows.GetProcAddress (LibHandle, PChar('getservbyname'));
+    GetProtoByNumber := Windows.GetProcAddress(LibHandle, PChar('getprotobynumber'));
-    GetServByPort    := Windows.GetProcAddress (LibHandle, PChar('getservbyport'));
+    GetServByName := Windows.GetProcAddress(LibHandle, PChar('getservbyname'));
-    GetHostName      := Windows.GetProcAddress (LibHandle, PChar('gethostname'));
+    GetServByPort := Windows.GetProcAddress(LibHandle, PChar('getservbyport'));
-    WSAGetLastError  := Windows.GetProcAddress (LibHandle, PChar('WSAGetLastError'));
+    GetHostName := Windows.GetProcAddress(LibHandle, PChar('gethostname'));
-    WSAStartup       := Windows.GetProcAddress (LibHandle, PChar('WSAStartup'));
+    WSAGetLastError := Windows.GetProcAddress(LibHandle, PChar('WSAGetLastError'));
-    WSACleanup       := Windows.GetProcAddress (LibHandle, PChar('WSACleanup'));
+    WSAStartup := Windows.GetProcAddress(LibHandle, PChar('WSAStartup'));
-    Result:=True;
+    WSACleanup := Windows.GetProcAddress(LibHandle, PChar('WSACleanup'));
+    Result := True;
   end;
 {$ENDIF}
 end;
 
-function DestroySocketInterface:Boolean;
+function DestroySocketInterface: Boolean;
 begin
 {$IFDEF LINUX}
 {$ELSE}
-  if LibHandle <> 0 then begin
+  if LibHandle <> 0 then
     Windows.FreeLibrary(libHandle);
-  end;
   LibHandle := 0;
 {$ENDIF}
-  Result:=True;
+  Result := True;
 end;
 
-
 end.