Release 37

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

clamsend.pas

@@ -0,0 +1,218 @@
+{==============================================================================|
+| Project : Ararat Synapse                                       | 001.000.000 |
+|==============================================================================|
+| Content: ClamAV-daemon client                                                |
+|==============================================================================|
+| Copyright (c)2005, Lukas Gebauer                                             |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2003.                     |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@abstract( ClamAV-daemon client)
+
+This unit is capable to do antivirus scan of your data by TCP channel to ClamD
+daemon from ClamAV. See more about ClamAV on @LINK(http://www.clamav.net)
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$Q-}
+{$H+}
+
+unit clamsend;
+
+interface
+
+uses
+  SysUtils, Classes,
+  synsock, blcksock, synautil;
+
+const
+  cClamProtocol = '3310';
+
+type
+
+  {:@abstract(Implementation of ClamAV-daemon client protocol)
+   By this class you can scan any your data by ClamAV opensource antivirus.
+
+   This class can connect to ClamD by TCP channel, send your data to ClamD
+   and read result.}
+  TClamSend = class(TSynaClient)
+  private
+    FSock: TTCPBlockSocket;
+    FDSock: TTCPBlockSocket;
+    FSession: boolean;
+    function Login: boolean; virtual;
+    function Logout: Boolean; virtual;
+    function OpenStream: Boolean; virtual;
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    {:Call any command to ClamD. Used internally by other methods.}
+    function DoCommand(const Value: AnsiString): AnsiString; virtual;
+
+    {:Return ClamAV version and version of loaded databases.}
+    function GetVersion: AnsiString; virtual;
+
+    {:Scan content of TStrings.}
+    function ScanStrings(const Value: TStrings): AnsiString; virtual;
+
+    {:Scan content of TStream.}
+    function ScanStream(const Value: TStream): AnsiString; virtual;
+  published
+    {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
+    property Sock: TTCPBlockSocket read FSock;
+
+    {:Socket object used for TCP data transfer operation. Good for seting OnStatus hook, etc.}
+    property DSock: TTCPBlockSocket read FDSock;
+
+    {:Can turn-on session mode of communication with ClamD. Default is @false,
+     because ClamAV developers design their TCP code very badly and session mode
+     is broken now (CVS-20051031). Maybe ClamAV developers fix their bugs
+     and this mode will be possible in future.}
+    property Session: boolean read FSession write FSession;
+  end;
+
+implementation
+
+constructor TClamSend.Create;
+begin
+  inherited Create;
+  FSock := TTCPBlockSocket.Create;
+  FDSock := TTCPBlockSocket.Create;
+  FTimeout := 60000;
+  FTargetPort := cClamProtocol;
+  FSession := false;
+end;
+
+destructor TClamSend.Destroy;
+begin
+  Logout;
+  FDSock.Free;
+  FSock.Free;
+  inherited Destroy;
+end;
+
+function TClamSend.DoCommand(const Value: AnsiString): AnsiString;
+begin
+  Result := '';
+  if not FSession then
+    FSock.CloseSocket
+  else
+    FSock.SendString(Value + LF);
+  if not FSession or (FSock.LastError <> 0) then
+  begin
+    if Login then
+      FSock.SendString(Value + LF)
+    else
+      Exit;
+  end;
+  Result := FSock.RecvTerminated(FTimeout, LF);
+end;
+
+function TClamSend.Login: boolean;
+begin
+  Result := False;
+  Sock.CloseSocket;
+  FSock.Bind(FIPInterface, cAnyPort);
+  if FSock.LastError <> 0 then
+    Exit;
+  FSock.Connect(FTargetHost, FTargetPort);
+  if FSock.LastError <> 0 then
+    Exit;
+  if FSession then
+    FSock.SendString('SESSION' + LF);
+  Result := FSock.LastError = 0;
+end;
+
+function TClamSend.Logout: Boolean;
+begin
+  FSock.SendString('END' + LF);
+  Result := FSock.LastError = 0;
+  FSock.CloseSocket;
+end;
+
+function TClamSend.GetVersion: AnsiString;
+begin
+  Result := DoCommand('VERSION');
+end;
+
+function TClamSend.OpenStream: Boolean;
+var
+  S: AnsiString;
+begin
+  Result := False;
+  s := DoCommand('STREAM');
+  if (s <> '') and (Copy(s, 1, 4) = 'PORT') then
+  begin
+    s := SeparateRight(s, ' ');
+    FDSock.CloseSocket;
+    FDSock.Bind(FIPInterface, cAnyPort);
+    if FDSock.LastError <> 0 then
+      Exit;
+    FDSock.Connect(FTargetHost, s);
+    if FDSock.LastError <> 0 then
+      Exit;
+    Result := True;
+  end;
+end;
+
+function TClamSend.ScanStrings(const Value: TStrings): AnsiString;
+begin
+  Result := '';
+  if OpenStream then
+  begin
+    DSock.SendString(Value.Text);
+    DSock.CloseSocket;
+    Result := FSock.RecvTerminated(FTimeout, LF);
+  end;
+end;
+
+function TClamSend.ScanStream(const Value: TStream): AnsiString;
+begin
+  Result := '';
+  if OpenStream then
+  begin
+    DSock.SendStreamRaw(Value);
+    DSock.CloseSocket;
+    Result := FSock.RecvTerminated(FTimeout, LF);
+  end;
+end;
+
+end.

dnssend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 002.007.000 |
+| Project : Ararat Synapse                                       | 002.007.003 |
 |==============================================================================|
 | Content: DNS client                                                          |
 |==============================================================================|
@@ -60,7 +60,7 @@ interface
 
 uses
   SysUtils, Classes,
-  blcksock, synautil, synsock;
+  blcksock, synautil, synaip, synsock;
 
 const
   cDnsProtocol = 'domain';
@@ -120,13 +120,11 @@ type
     FSock: TUDPBlockSocket;
     FTCPSock: TTCPBlockSocket;
     FUseTCP: Boolean;
-    FAnsferInfo: TStringList;
+    FAnswerInfo: TStringList;
     FNameserverInfo: TStringList;
     FAdditionalInfo: TStringList;
     FAuthoritative: Boolean;
     FTruncated: Boolean;
-    function ReverseIP(Value: AnsiString): AnsiString;
-    function ReverseIP6(Value: AnsiString): AnsiString;
     function CompressName(const Value: AnsiString): AnsiString;
     function CodeHeader: AnsiString;
     function CodeQuery(const Name: AnsiString; QType: Integer): AnsiString;
@@ -177,16 +175,16 @@ type
       4-not implemented, 5-refused.}
     property RCode: Integer read FRCode;
 
-    {:@True, if ansfer is authoritative.}
+    {:@True, if answer is authoritative.}
     property Authoritative: Boolean read FAuthoritative;
 
-    {:@True, if ansfer is truncated to 512 bytes.}
+    {:@True, if answer is truncated to 512 bytes.}
     property Truncated: Boolean read FTRuncated;
 
     {:Detailed informations from name server reply. One record per line. Record
      have comma delimited entries with type number, TTL and data filelds.
      This information contains detailed information about query reply.}
-    property AnsferInfo: TStringList read FAnsferInfo;
+    property AnswerInfo: TStringList read FAnswerInfo;
 
     {:Detailed informations from name server reply. One record per line. Record
      have comma delimited entries with type number, TTL and data filelds.
@@ -218,7 +216,7 @@ begin
   FUseTCP := False;
   FTimeout := 10000;
   FTargetPort := cDnsProtocol;
-  FAnsferInfo := TStringList.Create;
+  FAnswerInfo := TStringList.Create;
   FNameserverInfo := TStringList.Create;
   FAdditionalInfo := TStringList.Create;
   Randomize;
@@ -226,7 +224,7 @@ end;
 
 destructor TDNSSend.Destroy;
 begin
-  FAnsferInfo.Free;
+  FAnswerInfo.Free;
   FNameserverInfo.Free;
   FAdditionalInfo.Free;
   FTCPSock.Free;
@@ -234,44 +232,6 @@ begin
   inherited Destroy;
 end;
 
-function TDNSSend.ReverseIP(Value: AnsiString): AnsiString;
-var
-  x: Integer;
-begin
-  Result := '';
-  repeat
-    x := LastDelimiter('.', Value);
-    Result := Result + '.' + Copy(Value, x + 1, Length(Value) - x);
-    Delete(Value, x, Length(Value) - x + 1);
-  until x < 1;
-  if Length(Result) > 0 then
-    if Result[1] = '.' then
-      Delete(Result, 1, 1);
-end;
-
-function TDNSSend.ReverseIP6(Value: AnsiString): AnsiString;
-var
-  ip6: TSockAddrIn6;
-begin
-  ip6 := FSock.StrToIP6(Value);
-  Result := ip6.sin6_addr.S_un_b.s_b16
-    + '.' + ip6.sin6_addr.S_un_b.s_b15
-    + '.' + ip6.sin6_addr.S_un_b.s_b14
-    + '.' + ip6.sin6_addr.S_un_b.s_b13
-    + '.' + ip6.sin6_addr.S_un_b.s_b12
-    + '.' + ip6.sin6_addr.S_un_b.s_b11
-    + '.' + ip6.sin6_addr.S_un_b.s_b10
-    + '.' + ip6.sin6_addr.S_un_b.s_b9
-    + '.' + ip6.sin6_addr.S_un_b.s_b8
-    + '.' + ip6.sin6_addr.S_un_b.s_b7
-    + '.' + ip6.sin6_addr.S_un_b.s_b6
-    + '.' + ip6.sin6_addr.S_un_b.s_b5
-    + '.' + ip6.sin6_addr.S_un_b.s_b4
-    + '.' + ip6.sin6_addr.S_un_b.s_b3
-    + '.' + ip6.sin6_addr.S_un_b.s_b2
-    + '.' + ip6.sin6_addr.S_un_b.s_b1;
-end;
-
 function TDNSSend.CompressName(const Value: AnsiString): AnsiString;
 var
   n: Integer;
@@ -363,7 +323,7 @@ var
   RType, Len, j, x, y, z, n: Integer;
   R: AnsiString;
   t1, t2, ttl: integer;
-  ip6: TSockAddrIn6;
+  ip6: TIp6bytes;
 begin
   Result := '';
   R := '';
@@ -393,28 +353,9 @@ begin
         end;
       QTYPE_AAAA:
         begin
-//          FillChar(ip6, SizeOf(ip6), 0);
+          for n := 0 to 15 do
-          ip6.sin6_addr.S_un_b.s_b1 := Char(FBuffer[j]);
+            ip6[n] := ord(FBuffer[j + n]);
-          ip6.sin6_addr.S_un_b.s_b2 := Char(FBuffer[j + 1]);
+          R := IP6ToStr(ip6);
-          ip6.sin6_addr.S_un_b.s_b3 := Char(FBuffer[j + 2]);
-          ip6.sin6_addr.S_un_b.s_b4 := Char(FBuffer[j + 3]);
-          ip6.sin6_addr.S_un_b.s_b5 := Char(FBuffer[j + 4]);
-          ip6.sin6_addr.S_un_b.s_b6 := Char(FBuffer[j + 5]);
-          ip6.sin6_addr.S_un_b.s_b7 := Char(FBuffer[j + 6]);
-          ip6.sin6_addr.S_un_b.s_b8 := Char(FBuffer[j + 7]);
-          ip6.sin6_addr.S_un_b.s_b9 := Char(FBuffer[j + 8]);
-          ip6.sin6_addr.S_un_b.s_b10 := Char(FBuffer[j + 9]);
-          ip6.sin6_addr.S_un_b.s_b11 := Char(FBuffer[j + 10]);
-          ip6.sin6_addr.S_un_b.s_b12 := Char(FBuffer[j + 11]);
-          ip6.sin6_addr.S_un_b.s_b13 := Char(FBuffer[j + 12]);
-          ip6.sin6_addr.S_un_b.s_b14 := Char(FBuffer[j + 13]);
-          ip6.sin6_addr.S_un_b.s_b15 := Char(FBuffer[j + 14]);
-          ip6.sin6_addr.S_un_b.s_b16 := Char(FBuffer[j + 15]);
-          ip6.sin6_family := word(AF_INET6);
-          ip6.sin6_port := 0;
-          ip6.sin6_flowinfo := 0;
-          ip6.sin6_scope_id := 0;
-          R := FSock.IP6ToStr(ip6);
         end;
       QTYPE_NS, QTYPE_MD, QTYPE_MF, QTYPE_CNAME, QTYPE_MB,
         QTYPE_MG, QTYPE_MR, QTYPE_PTR, QTYPE_X25, QTYPE_NSAP,
@@ -514,7 +455,7 @@ var
 begin
   Result := False;
   Reply.Clear;
-  FAnsferInfo.Clear;
+  FAnswerInfo.Clear;
   FNameserverInfo.Clear;
   FAdditionalInfo.Clear;
   FAuthoritative := False;
@@ -542,7 +483,7 @@ begin
       if (ancount > 0) and (Length(Buf) > i) then // decode reply
         for n := 1 to ancount do
         begin
-          s := DecodeResource(i, FAnsferInfo, QType);
+          s := DecodeResource(i, FAnswerInfo, QType);
           if s <> '' then
             Reply.Add(s);
         end;
@@ -588,11 +529,11 @@ begin
     try
       repeat
         b := DecodeResponse(FBuffer, Reply, QType);
-        if (t.Count > 1) and (AnsferInfo.Count > 0) then  //find end of transfer
+        if (t.Count > 1) and (AnswerInfo.Count > 0) then  //find end of transfer
-          b := b and (t[0] <> AnsferInfo[AnsferInfo.count - 1]);
+          b := b and (t[0] <> AnswerInfo[AnswerInfo.count - 1]);
         if b then
         begin
-          t.AddStrings(AnsferInfo);
+          t.AddStrings(AnswerInfo);
           FBuffer := RecvTCPResponse(WorkSock);
           if FBuffer = '' then
             Break;

ftpsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 003.004.005 |
+| Project : Ararat Synapse                                       | 003.004.008 |
 |==============================================================================|
 | Content: FTP client                                                          |
 |==============================================================================|
@@ -59,7 +59,7 @@ interface
 
 uses
   SysUtils, Classes,
-  blcksock, synautil, synsock;
+  blcksock, synautil, synaip, synsock;
 
 const
   cFtpProtocol = 'ftp';
@@ -1220,6 +1220,7 @@ begin
   //VMS
   FMasks.add('v*$  DD TTT YYYY hh mm');
   FMasks.add('v*$!DD TTT YYYY hh mm');
+  FMasks.add('n*$                 YYYY MM DD hh mm$S*');
   //AS400
   FMasks.add('!S*$MM DD YY hh mm ss !n*');
   FMasks.add('!S*$DD MM YY hh mm ss !n*');
@@ -1246,7 +1247,7 @@ begin
   //tandem
   FMasks.add('nnnnnnnn                   SSSSSSS DD TTT YY hh mm ss');
   //MVS
-  FMasks.add('-             YYYY MM DD                     SSSSS   d=O  n*');
+  FMasks.add('-             YYYY MM DD                     SSSSS   d=O n*');
   //BullGCOS8
   FMasks.add('             $S* MM DD YY hh mm ss  !n*');
   FMasks.add('d            $S* MM DD YY           !n*');
@@ -1738,14 +1739,14 @@ begin
     if Value[1] = '+' then
     begin
       os := Value;
+      Delete(Value, 1, 1);
       flr := TFTPListRec.create;
+      flr.FileName := SeparateRight(Value, #9);
       s := Fetch(Value, ',');
       while s <> '' do
       begin
         if s[1] = #9 then
-        begin
+          Break;
-          flr.FileName := Copy(s, 2, Length(s) - 1);
-        end;
         case s[1] of
           '/':
             flr.Directory := true;

httpsend.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 003.010.001 |
+| Project : Ararat Synapse                                       | 003.010.005 |
 |==============================================================================|
 | Content: HTTP client                                                         |
 |==============================================================================|
-| Copyright (c)1999-2005, Lukas Gebauer                                        |
+| Copyright (c)1999-2006, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c) 1999-2005.               |
+| Portions created by Lukas Gebauer are Copyright (c) 1999-2006.               |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -58,7 +58,7 @@ interface
 
 uses
   SysUtils, Classes,
-  blcksock, synautil, synacode;
+  blcksock, synautil, synaip, synacode, synsock;
 
 const
   cHttpProtocol = '80';
@@ -97,6 +97,9 @@ type
     function ReadIdentity(Size: Integer): Boolean;
     function ReadChunked: Boolean;
     procedure ParseCookies;
+    function PrepareHeaders: string;
+    function InternalDoConnect(needssl: Boolean): Boolean;
+    function InternalConnect(needssl: Boolean): Boolean;
   public
     constructor Create;
     destructor Destroy; override;
@@ -302,6 +305,51 @@ begin
     FResultString := '';
 end;
 
+function THTTPSend.PrepareHeaders: string;
+begin
+  if FProtocol = '0.9' then
+    Result := FHeaders[0] + CRLF
+  else
+{$IFNDEF WIN32}
+    Result := AdjustLineBreaks(FHeaders.Text, tlbsCRLF);
+{$ELSE}
+    Result := FHeaders.Text;
+{$ENDIF}
+end;
+
+function THTTPSend.InternalDoConnect(needssl: Boolean): Boolean;
+begin
+  Result := False;
+  FSock.CloseSocket;
+  FSock.Bind(FIPInterface, cAnyPort);
+  if FSock.LastError <> 0 then
+    Exit;
+  FSock.Connect(FTargetHost, FTargetPort);
+  if FSock.LastError <> 0 then
+    Exit;
+  if needssl then
+  begin
+    FSock.SSLDoConnect;
+    if FSock.LastError <> 0 then
+      Exit;
+  end;
+  FAliveHost := FTargetHost;
+  FAlivePort := FTargetPort;
+  Result := True;
+end;
+
+function THTTPSend.InternalConnect(needssl: Boolean): Boolean;
+begin
+  if FSock.Socket = INVALID_SOCKET then
+    Result := InternalDoConnect(needssl)
+  else
+    if (FAliveHost <> FTargetHost) or (FAlivePort <> FTargetPort)
+      or FSock.CanRead(0) then
+      Result := InternalDoConnect(needssl)
+    else
+      Result := True;
+end;
+
 function THTTPSend.HTTPMethod(const Method, URL: string): Boolean;
 var
   Sending, Receiving: Boolean;
@@ -344,14 +392,14 @@ begin
     FSock.HTTPTunnelPass := '';
   end;
 
-  Sending := Document.Size > 0;
+  Sending := FDocument.Size > 0;
   {Headers for Sending data}
   status100 := FStatus100 and Sending and (FProtocol = '1.1');
   if status100 then
     FHeaders.Insert(0, 'Expect: 100-continue');
-  FHeaders.Insert(0, 'Content-Length: ' + IntToStr(FDocument.Size));
   if Sending then
   begin
+    FHeaders.Insert(0, 'Content-Length: ' + IntToStr(FDocument.Size));
     if FMimeType <> '' then
       FHeaders.Insert(0, 'Content-Type: ' + FMimeType);
   end;
@@ -415,91 +463,68 @@ begin
     FHeaders.Add('');
 
   { connect }
-  if (FAliveHost <> FTargetHost) or (FAlivePort <> FTargetPort) then
+  if not InternalConnect(UpperCase(Prot) = 'HTTPS') then
   begin
     FSock.CloseSocket;
-    FSock.Bind(FIPInterface, cAnyPort);
+    FAliveHost := '';
-    if FSock.LastError <> 0 then
+    FAlivePort := '';
-      Exit;
+    Exit;
-    if FSock.LastError <> 0 then
-      Exit;
-    FSock.Connect(FTargetHost, FTargetPort);
-    if FSock.LastError <> 0 then
-      Exit;
-    if UpperCase(Prot) = 'HTTPS' then
-      FSock.SSLDoConnect;
-    if FSock.LastError <> 0 then
-      Exit;
-    FAliveHost := FTargetHost;
-    FAlivePort := FTargetPort;
-  end
-  else
-  begin
-    if FSock.CanRead(0) then
-    begin
-      FSock.CloseSocket;
-      FSock.Bind(FIPInterface, cAnyPort);
-      if FSock.LastError <> 0 then
-        Exit;
-      if FSock.LastError <> 0 then
-        Exit;
-      FSock.Connect(FTargetHost, FTargetPort);
-      if FSock.LastError = 0 then
-        if UpperCase(Prot) = 'HTTPS' then
-          FSock.SSLDoConnect;
-      if FSock.LastError <> 0 then
-      begin
-        FSock.CloseSocket;
-        FAliveHost := '';
-        FAlivePort := '';
-        Exit;
-      end;
-    end;
   end;
 
-  { send Headers }
-  if FProtocol = '0.9' then
-    FSock.SendString(FHeaders[0] + CRLF)
-  else
-{$IFDEF LINUX}
-    FSock.SendString(AdjustLineBreaks(FHeaders.Text, tlbsCRLF));
-{$ELSE}
-    FSock.SendString(FHeaders.Text);
-{$ENDIF}
-  if FSock.LastError <> 0 then
-    Exit;
-
   { reading Status }
+  FDocument.Position := 0;
   Status100Error := '';
   if status100 then
   begin
+    { send Headers }
+    FSock.SendString(PrepareHeaders);
+    if FSock.LastError <> 0 then
+      Exit;
     repeat
       s := FSock.RecvString(FTimeout);
       if s <> '' then
         Break;
     until FSock.LastError <> 0;
     DecodeStatus(s);
+    Status100Error := s;
+    repeat
+      s := FSock.recvstring(FTimeout);
+      if s = '' then
+        Break;
+    until FSock.LastError <> 0;
     if (FResultCode >= 100) and (FResultCode < 200) then
-      repeat
+    begin
-        s := FSock.recvstring(FTimeout);
+      { we can upload content }
-        if s = '' then
+      Status100Error := '';
-          Break;
+      FUploadSize := FDocument.Size;
-      until FSock.LastError <> 0
+      FSock.SendBuffer(FDocument.Memory, FDocument.Size);
+    end;
+  end
+  else
+    { upload content }
+    if sending then
+    begin
+      if FDocument.Size >= c64k then
+      begin
+        FSock.SendString(PrepareHeaders);
+        FUploadSize := FDocument.Size;
+        FSock.SendBuffer(FDocument.Memory, FDocument.Size);
+      end
+      else
+      begin
+        s := PrepareHeaders + ReadStrFromStream(FDocument, FDocument.Size);
+        FUploadSize := Length(s);
+        FSock.SendString(s);
+      end;
+    end
     else
     begin
-      Sending := False;
+      { we not need to upload document, send headers only }
-      Status100Error := s;
+      FSock.SendString(PrepareHeaders);
     end;
-  end;
 
-  { send document }
+  if FSock.LastError <> 0 then
-  if Sending then
+    Exit;
-  begin
-    FUploadSize := FDocument.Size;
-    FSock.SendBuffer(FDocument.Memory, FDocument.Size);
-    if FSock.LastError <> 0 then
-      Exit;
-  end;
 
   Clear;
   Size := -1;
@@ -556,6 +581,8 @@ begin
         ToClose := True;
     until FSock.LastError <> 0;
   Result := FSock.LastError = 0;
+  if not Result then
+    Exit;
 
   {if need receive response body, read it}
   Receiving := Method <> 'HEAD';
@@ -590,7 +617,7 @@ begin
     if FSock.LastError = 0 then
       WriteStrToStream(FDocument, s);
   until FSock.LastError <> 0;
-  Result := True;
+  Result := FSock.LastError = WSAECONNRESET;
 end;
 
 function THTTPSend.ReadIdentity(Size: Integer): Boolean;

ldapsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.004.000 |
+| Project : Ararat Synapse                                       | 001.004.001 |
 |==============================================================================|
 | Content: LDAP client                                                         |
 |==============================================================================|
@@ -344,7 +344,9 @@ var
 begin
   s := Value;
   if FIsbinary then
-    s := EncodeBase64(Value);
+    s := EncodeBase64(Value)
+  else
+    s :=UnquoteStr(s, '"');
   inherited Put(Index, s);
 end;
 
@@ -1091,7 +1093,7 @@ begin
               while n < i do
               begin
                 u := ASNItem(n, t, x);
-                a.Add(UnquoteStr(u, '"'));
+                a.Add(u);
               end;
           end;
         end;

mimepart.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 002.007.002 |
+| Project : Ararat Synapse                                       | 002.007.005 |
 |==============================================================================|
 | Content: MIME support procedures and functions                               |
 |==============================================================================|
@@ -61,13 +61,7 @@ interface
 
 uses
   SysUtils, Classes,
-{$IFDEF LINUX}
-  {$IFDEF FPC}
   synafpc,
-  {$ENDIF}
-{$ELSE}
-  Windows,
-{$ENDIF}
   synachar, synacode, synautil, mimeinln;
 
 type
@@ -542,6 +536,7 @@ begin
   Result.DefaultCharset := FDefaultCharset;
   FSubParts.Add(Result);
   Result.SubLevel := FSubLevel + 1;
+  Result.MaxSubLevel := FMaxSubLevel;  
 end;
 
 {==============================================================================}
@@ -762,12 +757,16 @@ begin
   if FConvertCharset and (FPrimaryCode = MP_TEXT) then
     if (not FForcedHTMLConvert) and (uppercase(FSecondary) = 'HTML') then
     begin
+      b := false;
       t := uppercase(s);
       t := SeparateLeft(t, '</HEAD>');
-      t := SeparateRight(t, '<HEAD>');
+      if length(t) <> length(s) then
-      t := ReplaceString(t, '"', '');
+      begin
-      t := ReplaceString(t, ' ', '');
+        t := SeparateRight(t, '<HEAD>');
-      b := Pos('HTTP-EQUIV=CONTENT-TYPE', t) > 0;
+        t := ReplaceString(t, '"', '');
+        t := ReplaceString(t, ' ', '');
+        b := Pos('HTTP-EQUIV=CONTENT-TYPE', t) > 0;
+      end;
       if not b then
         s := CharsetConversion(s, FCharsetCode, FTargetCharset);
     end

pingsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 003.001.006 |
+| Project : Ararat Synapse                                       | 003.001.008 |
 |==============================================================================|
 | Content: PING sender                                                         |
 |==============================================================================|
@@ -59,16 +59,15 @@ Note: IPv6 not working under .NET. It is lack of Microsoft's .NET framework.
 {$R-}
 {$H+}
 
+{$IFDEF CIL}
+  Sorry, this unit is not for .NET!
+{$ENDIF}
+
 unit pingsend;
 
 interface
 
 uses
-{$IFDEF LINUX}
-  Libc,
-{$ELSE}
-  Windows,
-{$ENDIF}
   SysUtils,
   synsock, blcksock, synautil;
 
@@ -91,7 +90,7 @@ type
     i_checkSum: Word;
     i_Id: Word;
     i_seq: Word;
-    TimeStamp: ULong;
+    TimeStamp: integer;
   end;
 
   {:record used internally by TPingSend for compute checksum of ICMPv6 packet
@@ -274,7 +273,7 @@ begin
       break;
     if fSock.IP6used then
     begin
-{$IFDEF LINUX}
+{$IFNDEF WIN32}
       IcmpEchoHeaderPtr := Pointer(FBuffer);
 {$ELSE}
 //WinXP SP1 with networking update doing this think by another way ;-O
@@ -289,6 +288,12 @@ begin
       IpHdrLen := (IPHeadPtr^.VerLen and $0F) * 4;
       IcmpEchoHeaderPtr := @FBuffer[IpHdrLen + 1];
     end;
+  //check for timeout
+    if TickDelta(x, GetTick) > FTimeout then
+    begin
+      t := false;
+      Break;
+    end;
   //it discard sometimes possible 'echoes' of previosly sended packet
   //or other unwanted ICMP packets...
   until (IcmpEchoHeaderPtr^.i_type <> FIcmpEcho)
@@ -307,7 +312,7 @@ end;
 
 function TPINGSend.Checksum(Value: string): Word;
 var
-  CkSum: DWORD;
+  CkSum: integer;
   Num, Remain: Integer;
   n, i: Integer;
 begin
@@ -341,9 +346,8 @@ var
   ip6: TSockAddrIn6;
   x: integer;
 begin
-{$IFDEF LINUX}
   Result := 0;
-{$ELSE}
+{$IFDEF WIN32}
   s := StringOfChar(#0, SizeOf(TICMP6Packet)) + Value;
   ICMP6Ptr := Pointer(s);
   x := synsock.WSAIoctl(FSock.Socket, SIO_ROUTING_INTERFACE_QUERY,

pop3send.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 002.004.000 |
+| Project : Ararat Synapse                                       | 002.005.000 |
 |==============================================================================|
 | Content: POP3 client                                                         |
 |==============================================================================|
@@ -84,6 +84,7 @@ type
     FFullResult: TStringList;
     FStatCount: Integer;
     FStatSize: Integer;
+    FListSize: Integer;
     FTimeStamp: string;
     FAuthType: TPOP3AuthType;
     FPOP3cap: TStringList;
@@ -125,6 +126,10 @@ type
      @link(FullResult). If all OK, result is @true.}
     function Retr(Value: Integer): Boolean;
 
+    {:Send RETR command. After successful operation dowloaded message in
+     @link(Stream). If all OK, result is @true.}
+    function RetrStream(Value: Integer; Stream: TStream): Boolean;
+
     {:Send DELE command for delete specified message. If all OK, result is @true.}
     function Dele(Value: Integer): Boolean;
 
@@ -161,6 +166,9 @@ type
     {:After STAT command is there size of all messages in inbox.}
     property StatSize: Integer read  FStatSize;
 
+    {:After LIST 0 command size of all messages on server, After LIST x size of message x on server}
+    property ListSize: Integer read  FListSize;
+
     {:If server support this, after comnnect is in this property timestamp of
      remote server.}
     property TimeStamp: string read FTimeStamp;
@@ -195,6 +203,7 @@ begin
   FTargetPort := cPop3Protocol;
   FStatCount := 0;
   FStatSize := 0;
+  FListSize := 0;
   FAuthType := POP3AuthAll;
   FAutoTLS := False;
   FFullSSL := False;
@@ -351,12 +360,25 @@ begin
 end;
 
 function TPOP3Send.List(Value: Integer): Boolean;
+var
+  s: string;
+  n: integer;
 begin
   if Value = 0 then
     FSock.SendString('LIST' + CRLF)
   else
     FSock.SendString('LIST ' + IntToStr(Value) + CRLF);
   Result := ReadResult(Value = 0) = 1;
+  FListSize := 0;
+  if Result then
+    if Value <> 0 then
+    begin
+      s := SeparateRight(ResultString, '+OK ');
+      FListSize := StrToIntDef(SeparateLeft(SeparateRight(s, ' '), ' '), 0);
+    end
+    else
+      for n := 0 to FFullResult.Count - 1 do
+        FListSize := FListSize + StrToIntDef(SeparateLeft(SeparateRight(s, ' '), ' '), 0);
 end;
 
 function TPOP3Send.Retr(Value: Integer): Boolean;
@@ -365,6 +387,40 @@ begin
   Result := ReadResult(True) = 1;
 end;
 
+//based on code by Miha Vrhovnik
+function TPOP3Send.RetrStream(Value: Integer; Stream: TStream): Boolean;
+var
+  s: string;
+begin
+  Result := False;
+  FFullResult.Clear;
+  Stream.Size := 0;
+  FSock.SendString('RETR ' + IntToStr(Value) + CRLF);
+
+  s := FSock.RecvString(FTimeout);
+  if Pos('+OK', s) = 1 then
+    Result := True;
+  FResultString := s;
+  if Result then begin
+    repeat
+      s := FSock.RecvString(FTimeout);
+      if s = '.' then
+        Break;
+      if s <> '' then begin
+        if s[1] = '.' then
+          Delete(s, 1, 1);
+      end;
+      WriteStrToStream(Stream, s);
+      WriteStrToStream(Stream, CRLF);
+    until FSock.LastError <> 0;
+  end;
+
+  if Result then
+    FResultCode := 1
+  else
+    FResultCode := 0;
+end;
+
 function TPOP3Send.Dele(Value: Integer): Boolean;
 begin
   FSock.SendString('DELE ' + IntToStr(Value) + CRLF);

snmpsend.pas

@@ -62,7 +62,7 @@ interface
 
 uses
   Classes, SysUtils,
-  blcksock, synautil, asn1util, synacode;
+  blcksock, synautil, asn1util, synaip, synacode;
 
 const
   cSnmpProtocol = '161';

ssdotnet.pas

@@ -49,7 +49,7 @@
 interface
 
 uses
-  SyncObjs, SysUtils,
+  SyncObjs, SysUtils, Classes,
   System.Net,
   System.Net.Sockets;
 
@@ -73,6 +73,7 @@ type
   TMemory = Array of byte;
   TLinger = LingerOption;
   TSocket = socket;
+  TAddrFamily = AddressFamily;
 
 const
   WSADESCRIPTION_LEN     =   256;
@@ -89,33 +90,10 @@ type
 //    lpVendorInfo: PChar;
   end;
 
-  SunB6 = packed record
-    s_b1,  s_b2,  s_b3,  s_b4,
-    s_b5,  s_b6,  s_b7,  s_b8,
-    s_b9,  s_b10, s_b11, s_b12,
-    s_b13, s_b14, s_b15, s_b16: u_char;
-  end;
-
-  S6_Bytes   = SunB6;
-  S6_Addr    = SunB6;
-
-  TInAddr6 = packed record
-      S_un_b:  SunB6;
-  end;
-
-  TSockAddrIn6 = packed record
-		sin6_family:   u_short;     // AF_INET6
-		sin6_port:     u_short;     // Transport level port number
-		sin6_flowinfo: u_long;	    // IPv6 flow information
-		sin6_addr:     TInAddr6;    // IPv6 address
-		sin6_scope_id: u_long;      // Scope Id: IF number for link-local
-                                //           SITE id for site-local
-  end;
-
-
 const
   MSG_NOSIGNAL = 0;
   INVALID_SOCKET = nil;
+  AF_UNSPEC = AddressFamily.Unspecified;
   AF_INET = AddressFamily.InterNetwork;
   AF_INET6 = AddressFamily.InterNetworkV6;
   SOCKET_ERROR = integer(-1);
@@ -387,7 +365,7 @@ function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarS
   function  ntohs(netshort: u_short): u_short;
   function  ntohl(netlong: u_long): u_long;
   function  Listen(s: TSocket; backlog: Integer): Integer;
-  function  IoctlSocket(s: TSocket; cmd: DWORD; var arg: u_long): Integer;
+  function  IoctlSocket(s: TSocket; cmd: DWORD; var arg: integer): Integer;
   function  htons(hostshort: u_short): u_short;
   function  htonl(hostlong: u_long): u_long;
 //  function  GetSockName(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
@@ -414,6 +392,14 @@ function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarS
 
   function GetPortService(value: string): integer;
 
+function IsNewApi(Family: TAddrFamily): Boolean;
+function SetVarSin(var Sin: TVarSin; IP, Port: string; Family: TAddrFamily; SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+function GetSinIP(Sin: TVarSin): string;
+function GetSinPort(Sin: TVarSin): Integer;
+procedure ResolveNameToIP(Name: string; Family: TAddrFamily; SockProtocol, SockType: integer; const IPList: TStrings);
+function ResolveIPToName(IP: string; Family: TAddrFamily; SockProtocol, SockType: integer): string;
+function ResolvePort(Port: string; Family: TAddrFamily; SockProtocol, SockType: integer): Word;
+
 var
   SynSockCS: SyncObjs.TCriticalSection;
   SockEnhancedApi: Boolean;
@@ -826,7 +812,7 @@ begin
   end;
 end;
 
-function  IoctlSocket(s: TSocket; cmd: DWORD; var arg: u_long): Integer;
+function  IoctlSocket(s: TSocket; cmd: DWORD; var arg: integer): Integer;
 var
   inv, outv: TMemory;
 begin
@@ -840,7 +826,7 @@ begin
       inv := BitConverter.GetBytes(arg);
       outv := BitConverter.GetBytes(integer(0));
       s.IOControl(cmd, inv, outv);
-      arg := BitConverter.ToUInt32(outv, 0);
+      arg := BitConverter.ToInt32(outv, 0);
     end;
   except
     on e: System.Net.Sockets.SocketException do
@@ -985,6 +971,106 @@ begin
     Result := StrToIntDef(value, 0);
 end;
 
+{=============================================================================}
+function IsNewApi(Family: TAddrFamily): Boolean;
+begin
+  Result := true;
+end;
+
+function SetVarSin(var Sin: TVarSin; IP, Port: string; Family: TAddrFamily; SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+var
+  IPs: array of IPAddress;
+  n: integer;
+  ip4, ip6: string;
+  sip: string;
+begin
+  sip := '';
+  ip4 := '';
+  ip6 := '';
+  IPs := Dns.Resolve(IP).AddressList;
+  for n :=low(IPs) to high(IPs) do begin
+    if (ip4 = '') and (IPs[n].AddressFamily = AF_INET) then
+      ip4 := IPs[n].toString;
+    if (ip6 = '') and (IPs[n].AddressFamily = AF_INET6) then
+      ip6 := IPs[n].toString;
+    if (ip4 <> '') and (ip6 <> '') then
+      break;
+  end;
+  case Family of
+    AF_UNSPEC:
+      begin
+        if (ip4 <> '') and (ip6 <> '') then
+        begin
+          if PreferIP4 then
+            sip := ip4
+          else
+            Sip := ip6;
+          end
+        else
+        begin
+          sip := ip4;
+          if (ip6 <> '') then
+            sip := ip6;
+        end;
+      end;
+    AF_INET:
+      sip := ip4;
+    AF_INET6:
+      sip := ip6;
+  end;
+  sin := TVarSin.Create(IPAddress.Parse(sip), GetPortService(Port));
+end;
+
+function GetSinIP(Sin: TVarSin): string;
+begin
+  Result := Sin.Address.ToString;
+end;
+
+function GetSinPort(Sin: TVarSin): Integer;
+begin
+  Result := Sin.Port;
+end;
+
+procedure ResolveNameToIP(Name: string; Family: TAddrFamily; SockProtocol, SockType: integer; const IPList: TStrings);
+var
+  IPs :array of IPAddress;
+  n: integer;
+begin
+  IPList.Clear;
+  IPs := Dns.Resolve(Name).AddressList;
+  for n := low(IPs) to high(IPs) do
+  begin
+    if not(((Family = AF_INET6) and (IPs[n].AddressFamily = AF_INET))
+      or ((Family = AF_INET) and (IPs[n].AddressFamily = AF_INET6))) then
+    begin
+      IPList.Add(IPs[n].toString);
+    end;
+  end;
+end;
+
+function ResolvePort(Port: string; Family: TAddrFamily; SockProtocol, SockType: integer): Word;
+var
+  n: integer;
+begin
+  Result := StrToIntDef(port, 0);
+  if Result = 0 then
+  begin
+    port := Lowercase(port);
+    for n := 0 to High(Services) do
+      if services[n, 0] = port then
+      begin
+        Result := strtointdef(services[n, 1], 0);
+        break;
+      end;
+  end;
+end;
+
+function ResolveIPToName(IP: string; Family: TAddrFamily; SockProtocol, SockType: integer): string;
+begin
+  Result := Dns.GetHostByAddress(IP).HostName;
+end;
+
+
 {=============================================================================}
 function InitSocketInterface(stack: string): Boolean;
 begin

ssfpc.pas

@@ -0,0 +1,868 @@
+{==============================================================================|
+| Project : Ararat Synapse                                       | 001.000.003 |
+|==============================================================================|
+| Content: Socket Independent Platform Layer - FreePascal definition include   |
+|==============================================================================|
+| Copyright (c)2006, Lukas Gebauer                                             |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2006.                     |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@exclude}
+
+{$IFDEF FPC}
+
+//{$DEFINE FORCEOLDAPI}
+{Note about define FORCEOLDAPI:
+If you activate this compiler directive, then is allways used old socket API
+for name resolution. If you leave this directive inactive, then the new API
+is used, when running system allows it.
+
+For IPv6 support you must have new API!
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+{$ifdef FreeBSD}
+{$DEFINE SOCK_HAS_SINLEN}               // BSD definition of scoketaddr
+{$endif}
+{$ifdef darwin}
+{$DEFINE SOCK_HAS_SINLEN}               // BSD definition of scoketaddr
+{$endif}
+
+interface
+
+uses
+  SyncObjs, SysUtils, Classes,
+  synafpc, BaseUnix, Unix, termio, sockets, netdb;
+
+function InitSocketInterface(stack: string): Boolean;
+function DestroySocketInterface: Boolean;
+
+const
+  DLLStackName = '';
+  WinsockLevel = $0202;
+
+  cLocalHost = '127.0.0.1';
+  cAnyHost = '0.0.0.0';
+  c6AnyHost = '::0';
+
+type
+  TSocket = longint;
+  TAddrFamily = integer;
+
+  TMemory = pointer;
+
+
+type
+  TFDSet = Baseunix.TFDSet;
+  PFDSet = ^TFDSet;
+  Ptimeval = Baseunix.ptimeval;
+  Ttimeval = Baseunix.ttimeval;
+
+const
+  FIONREAD        = termio.FIONREAD;
+  FIONBIO         = termio.FIONBIO;
+  FIOASYNC        = termio.FIOASYNC;
+
+const
+  IPPROTO_IP     =   0;		{ Dummy					}
+  IPPROTO_ICMP   =   1;		{ Internet Control Message Protocol }
+  IPPROTO_IGMP   =   2;		{ Internet Group Management Protocol}
+  IPPROTO_TCP    =   6;		{ TCP           			}
+  IPPROTO_UDP    =   17;	{ User Datagram Protocol		}
+  IPPROTO_IPV6   =   41;
+  IPPROTO_ICMPV6 =   58;
+
+  IPPROTO_RAW    =   255;
+  IPPROTO_MAX    =   256;
+
+type
+  PInAddr = ^TInAddr;
+  TInAddr = sockets.in_addr;
+
+  PSockAddrIn = ^TSockAddrIn;
+  TSockAddrIn = sockets.TInetSockAddr;
+
+
+  TIP_mreq =  record
+    imr_multiaddr: TInAddr;     // IP multicast address of group
+    imr_interface: TInAddr;     // local IP address of interface
+  end;
+
+
+  PInAddr6 = ^TInAddr6;
+  TInAddr6 = sockets.Tin6_addr;
+
+  PSockAddrIn6 = ^TSockAddrIn6;
+  TSockAddrIn6 = sockets.TInetSockAddr6;
+
+
+  TIPv6_mreq = record
+    ipv6mr_multiaddr: TInAddr6; // IPv6 multicast address.
+    ipv6mr_interface: integer;   // Interface index.
+  end;
+
+const
+  INADDR_ANY       = $00000000;
+  INADDR_LOOPBACK  = $7F000001;
+  INADDR_BROADCAST = $FFFFFFFF;
+  INADDR_NONE      = $FFFFFFFF;
+  ADDR_ANY		 = INADDR_ANY;
+  INVALID_SOCKET		= TSocket(NOT(0));
+  SOCKET_ERROR			= -1;
+
+Const
+  IP_TOS             = sockets.IP_TOS;             { int; IP type of service and precedence.  }
+  IP_TTL             = sockets.IP_TTL;             { int; IP time to live.  }
+  IP_HDRINCL         = sockets.IP_HDRINCL;         { int; Header is included with data.  }
+  IP_OPTIONS         = sockets.IP_OPTIONS;         { ip_opts; IP per-packet options.  }
+//  IP_ROUTER_ALERT    = sockets.IP_ROUTER_ALERT;    { bool }
+  IP_RECVOPTS        = sockets.IP_RECVOPTS;        { bool }
+  IP_RETOPTS         = sockets.IP_RETOPTS;         { bool }
+//  IP_PKTINFO         = sockets.IP_PKTINFO;         { bool }
+//  IP_PKTOPTIONS      = sockets.IP_PKTOPTIONS;
+//  IP_PMTUDISC        = sockets.IP_PMTUDISC;        { obsolete name? }
+//  IP_MTU_DISCOVER    = sockets.IP_MTU_DISCOVER;    { int; see below }
+//  IP_RECVERR         = sockets.IP_RECVERR;         { bool }
+//  IP_RECVTTL         = sockets.IP_RECVTTL;         { bool }
+//  IP_RECVTOS         = sockets.IP_RECVTOS;         { bool }
+  IP_MULTICAST_IF    = sockets.IP_MULTICAST_IF;    { in_addr; set/get IP multicast i/f }
+  IP_MULTICAST_TTL   = sockets.IP_MULTICAST_TTL;   { u_char; set/get IP multicast ttl }
+  IP_MULTICAST_LOOP  = sockets.IP_MULTICAST_LOOP;  { i_char; set/get IP multicast loopback }
+  IP_ADD_MEMBERSHIP  = sockets.IP_ADD_MEMBERSHIP;  { ip_mreq; add an IP group membership }
+  IP_DROP_MEMBERSHIP = sockets.IP_DROP_MEMBERSHIP; { ip_mreq; drop an IP group membership }
+
+  SOL_SOCKET    = sockets.SOL_SOCKET;
+
+  SO_DEBUG      = sockets.SO_DEBUG;
+  SO_REUSEADDR  = sockets.SO_REUSEADDR;
+  SO_TYPE       = sockets.SO_TYPE;
+  SO_ERROR      = sockets.SO_ERROR;
+  SO_DONTROUTE  = sockets.SO_DONTROUTE;
+  SO_BROADCAST  = sockets.SO_BROADCAST;
+  SO_SNDBUF     = sockets.SO_SNDBUF;
+  SO_RCVBUF     = sockets.SO_RCVBUF;
+  SO_KEEPALIVE  = sockets.SO_KEEPALIVE;
+  SO_OOBINLINE  = sockets.SO_OOBINLINE;
+//  SO_NO_CHECK   = sockets.SO_NO_CHECK;
+//  SO_PRIORITY   = sockets.SO_PRIORITY;
+  SO_LINGER     = sockets.SO_LINGER;
+//  SO_BSDCOMPAT  = sockets.SO_BSDCOMPAT;
+//  SO_REUSEPORT  = sockets.SO_REUSEPORT;
+//  SO_PASSCRED   = sockets.SO_PASSCRED;
+//  SO_PEERCRED   = sockets.SO_PEERCRED;
+  SO_RCVLOWAT   = sockets.SO_RCVLOWAT;
+  SO_SNDLOWAT   = sockets.SO_SNDLOWAT;
+  SO_RCVTIMEO   = sockets.SO_RCVTIMEO;
+  SO_SNDTIMEO   = sockets.SO_SNDTIMEO;
+{ Security levels - as per NRL IPv6 - don't actually do anything }
+//  SO_SECURITY_AUTHENTICATION       = sockets.SO_SECURITY_AUTHENTICATION;
+//  SO_SECURITY_ENCRYPTION_TRANSPORT = sockets.SO_SECURITY_ENCRYPTION_TRANSPORT;
+//  SO_SECURITY_ENCRYPTION_NETWORK   = sockets.SO_SECURITY_ENCRYPTION_NETWORK;
+//  SO_BINDTODEVICE                  = sockets.SO_BINDTODEVICE;
+{ Socket filtering }
+//  SO_ATTACH_FILTER = sockets.SO_ATTACH_FILTER;
+//  SO_DETACH_FILTER = sockets.SO_DETACH_FILTER;
+
+  SOMAXCONN       = 1024;
+
+  IPV6_UNICAST_HOPS     = sockets.IPV6_UNICAST_HOPS;
+  IPV6_MULTICAST_IF     = sockets.IPV6_MULTICAST_IF;
+  IPV6_MULTICAST_HOPS   = sockets.IPV6_MULTICAST_HOPS;
+  IPV6_MULTICAST_LOOP   = sockets.IPV6_MULTICAST_LOOP;
+  IPV6_JOIN_GROUP       = sockets.IPV6_JOIN_GROUP;
+  IPV6_LEAVE_GROUP      = sockets.IPV6_LEAVE_GROUP;
+
+const
+  SOCK_STREAM     = 1;               { stream socket }
+  SOCK_DGRAM      = 2;               { datagram socket }
+  SOCK_RAW        = 3;               { raw-protocol interface }
+  SOCK_RDM        = 4;               { reliably-delivered message }
+  SOCK_SEQPACKET  = 5;               { sequenced packet stream }
+
+{ TCP options. }
+  TCP_NODELAY     = $0001;
+
+{ Address families. }
+
+  AF_UNSPEC       = 0;               { unspecified }
+  AF_INET         = 2;               { internetwork: UDP, TCP, etc. }
+  AF_INET6        = 10;              { Internetwork Version 6 }
+  AF_MAX          = 24;
+
+{ Protocol families, same as address families for now. }
+  PF_UNSPEC       = AF_UNSPEC;
+  PF_INET         = AF_INET;
+  PF_INET6        = AF_INET6;
+  PF_MAX          = AF_MAX;
+
+type
+{ Structure used for manipulating linger option. }
+  PLinger = ^TLinger;
+  TLinger = packed record
+    l_onoff: integer;
+    l_linger: integer;
+  end;
+
+const
+
+  MSG_OOB       = sockets.MSG_OOB;      // Process out-of-band data.
+  MSG_PEEK      = sockets.MSG_PEEK;     // Peek at incoming messages.
+  MSG_NOSIGNAL  = sockets.MSG_NOSIGNAL; // Do not generate SIGPIPE.
+
+const
+  WSAEINTR = ESysEINTR;
+  WSAEBADF = ESysEBADF;
+  WSAEACCES = ESysEACCES;
+  WSAEFAULT = ESysEFAULT;
+  WSAEINVAL = ESysEINVAL;
+  WSAEMFILE = ESysEMFILE;
+  WSAEWOULDBLOCK = ESysEWOULDBLOCK;
+  WSAEINPROGRESS = ESysEINPROGRESS;
+  WSAEALREADY = ESysEALREADY;
+  WSAENOTSOCK = ESysENOTSOCK;
+  WSAEDESTADDRREQ = ESysEDESTADDRREQ;
+  WSAEMSGSIZE = ESysEMSGSIZE;
+  WSAEPROTOTYPE = ESysEPROTOTYPE;
+  WSAENOPROTOOPT = ESysENOPROTOOPT;
+  WSAEPROTONOSUPPORT = ESysEPROTONOSUPPORT;
+  WSAESOCKTNOSUPPORT = ESysESOCKTNOSUPPORT;
+  WSAEOPNOTSUPP = ESysEOPNOTSUPP;
+  WSAEPFNOSUPPORT = ESysEPFNOSUPPORT;
+  WSAEAFNOSUPPORT = ESysEAFNOSUPPORT;
+  WSAEADDRINUSE = ESysEADDRINUSE;
+  WSAEADDRNOTAVAIL = ESysEADDRNOTAVAIL;
+  WSAENETDOWN = ESysENETDOWN;
+  WSAENETUNREACH = ESysENETUNREACH;
+  WSAENETRESET = ESysENETRESET;
+  WSAECONNABORTED = ESysECONNABORTED;
+  WSAECONNRESET = ESysECONNRESET;
+  WSAENOBUFS = ESysENOBUFS;
+  WSAEISCONN = ESysEISCONN;
+  WSAENOTCONN = ESysENOTCONN;
+  WSAESHUTDOWN = ESysESHUTDOWN;
+  WSAETOOMANYREFS = ESysETOOMANYREFS;
+  WSAETIMEDOUT = ESysETIMEDOUT;
+  WSAECONNREFUSED = ESysECONNREFUSED;
+  WSAELOOP = ESysELOOP;
+  WSAENAMETOOLONG = ESysENAMETOOLONG;
+  WSAEHOSTDOWN = ESysEHOSTDOWN;
+  WSAEHOSTUNREACH = ESysEHOSTUNREACH;
+  WSAENOTEMPTY = ESysENOTEMPTY;
+  WSAEPROCLIM = -1;
+  WSAEUSERS = ESysEUSERS;
+  WSAEDQUOT = ESysEDQUOT;
+  WSAESTALE = ESysESTALE;
+  WSAEREMOTE = ESysEREMOTE;
+  WSASYSNOTREADY = -2;
+  WSAVERNOTSUPPORTED = -3;
+  WSANOTINITIALISED = -4;
+  WSAEDISCON = -5;
+  WSAHOST_NOT_FOUND = 1;
+  WSATRY_AGAIN = 2;
+  WSANO_RECOVERY = 3;
+  WSANO_DATA = -6;
+
+const
+  WSADESCRIPTION_LEN     =   256;
+  WSASYS_STATUS_LEN      =   128;
+type
+  PWSAData = ^TWSAData;
+  TWSAData = packed record
+    wVersion: Word;
+    wHighVersion: Word;
+    szDescription: array[0..WSADESCRIPTION_LEN] of Char;
+    szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char;
+    iMaxSockets: Word;
+    iMaxUdpDg: Word;
+    lpVendorInfo: PChar;
+  end;
+
+  function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
+  function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
+  function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
+  function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
+  function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
+  function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6):boolean;
+  procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
+  procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
+
+var
+  in6addr_any, in6addr_loopback : TInAddr6;
+
+procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet);
+function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean;
+procedure FD_SET(Socket: TSocket; var FDSet: TFDSet);
+procedure FD_ZERO(var FDSet: TFDSet);
+
+{=============================================================================}
+
+var
+  SynSockCS: SyncObjs.TCriticalSection;
+  SockEnhancedApi: Boolean;
+  SockWship6Api: Boolean;
+
+type
+  TVarSin = packed record
+  {$ifdef SOCK_HAS_SINLEN}
+     sin_len     : cuchar;
+  {$endif}
+    case integer of
+      0: (AddressFamily: sa_family_t);
+      1: (
+        case sin_family: sa_family_t of
+          AF_INET: (sin_port: word;
+                    sin_addr: TInAddr;
+                    sin_zero: array[0..7] of Char);
+          AF_INET6: (sin6_port:     word;
+                		sin6_flowinfo: longword;
+      	    	      sin6_addr:     TInAddr6;
+      		          sin6_scope_id: longword);
+          );
+  end;
+
+function SizeOfVarSin(sin: TVarSin): integer;
+
+  function WSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer;
+  function WSACleanup: Integer;
+  function WSAGetLastError: Integer;
+  function GetHostName: string;
+  function Shutdown(s: TSocket; how: Integer): Integer;
+  function SetSockOpt(s: TSocket; level, optname: Integer; optval: TMemory;
+    optlen: Integer): Integer;
+  function GetSockOpt(s: TSocket; level, optname: Integer; optval: TMemory;
+    var optlen: Integer): Integer;
+  function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+  function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+  function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
+  function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
+  function ntohs(netshort: word): word;
+  function ntohl(netlong: longword): longword;
+  function Listen(s: TSocket; backlog: Integer): Integer;
+  function IoctlSocket(s: TSocket; cmd: DWORD; var arg: integer): Integer;
+  function htons(hostshort: word): word;
+  function htonl(hostlong: longword): longword;
+  function GetSockName(s: TSocket; var name: TVarSin): Integer;
+  function GetPeerName(s: TSocket; var name: TVarSin): Integer;
+  function Connect(s: TSocket; const name: TVarSin): Integer;
+  function CloseSocket(s: TSocket): Integer;
+  function Bind(s: TSocket; const addr: TVarSin): Integer;
+  function Accept(s: TSocket; var addr: TVarSin): TSocket;
+  function Socket(af, Struc, Protocol: Integer): TSocket;
+  function Select(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
+    timeout: PTimeVal): Longint;
+
+function IsNewApi(Family: integer): Boolean;
+function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+function GetSinIP(Sin: TVarSin): string;
+function GetSinPort(Sin: TVarSin): Integer;
+procedure ResolveNameToIP(Name: string;  Family, SockProtocol, SockType: integer; const IPList: TStrings);
+function ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): string;
+function ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word;
+
+
+{==============================================================================}
+implementation
+
+
+function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
+begin
+  Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
+             (a^.u6_addr32[2] = 0) and (a^.u6_addr32[3] = 0));
+end;
+
+function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
+begin
+  Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
+             (a^.u6_addr32[2] = 0) and
+             (a^.u6_addr8[12] = 0) and (a^.u6_addr8[13] = 0) and
+             (a^.u6_addr8[14] = 0) and (a^.u6_addr8[15] = 1));
+end;
+
+function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
+begin
+  Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $80));
+end;
+
+function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
+begin
+  Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $C0));
+end;
+
+function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
+begin
+  Result := (a^.u6_addr8[0] = $FF);
+end;
+
+function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6): boolean;
+begin
+  Result := (CompareMem( a, b, sizeof(TInAddr6)));
+end;
+
+procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
+begin
+  FillChar(a^, sizeof(TInAddr6), 0);
+end;
+
+procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
+begin
+  FillChar(a^, sizeof(TInAddr6), 0);
+  a^.u6_addr8[15] := 1;
+end;
+
+{=============================================================================}
+
+function WSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer;
+begin
+  with WSData do
+  begin
+    wVersion := wVersionRequired;
+    wHighVersion := $202;
+    szDescription := 'Synsock - Synapse Platform Independent Socket Layer';
+    szSystemStatus := 'Running on Unix/Linux by FreePascal';
+    iMaxSockets := 32768;
+    iMaxUdpDg := 8192;
+  end;
+  Result := 0;
+end;
+
+function WSACleanup: Integer;
+begin
+  Result := 0;
+end;
+
+function WSAGetLastError: Integer;
+begin
+  Result := fpGetErrno; 
+end;
+
+function FD_ISSET(Socket: TSocket; var fdset: TFDSet): Boolean;
+begin
+  Result := fpFD_ISSET(socket, fdset) <> 0;
+end;
+
+procedure FD_SET(Socket: TSocket; var fdset: TFDSet);
+begin
+  fpFD_SET(Socket, fdset);
+end;
+
+procedure FD_CLR(Socket: TSocket; var fdset: TFDSet);
+begin
+  fpFD_CLR(Socket, fdset);
+end;
+
+procedure FD_ZERO(var fdset: TFDSet);
+begin
+  fpFD_ZERO(fdset);
+end;
+
+{=============================================================================}
+
+function SizeOfVarSin(sin: TVarSin): integer;
+begin
+  case sin.sin_family of
+    AF_INET:
+            Result := SizeOf(TSockAddrIn);
+    AF_INET6:
+            Result := SizeOf(TSockAddrIn6);
+  else
+    Result := 0;
+  end;
+end;
+
+{=============================================================================}
+
+function Bind(s: TSocket; const addr: TVarSin): Integer;
+begin
+  if sockets.Bind(s, addr, SizeOfVarSin(addr)) then
+    Result := 0
+  else
+    Result := SOCKET_ERROR;
+end;
+
+function Connect(s: TSocket; const name: TVarSin): Integer;
+begin
+  if sockets.Connect(s, name, SizeOfVarSin(name)) then
+    Result := 0
+  else
+    Result := SOCKET_ERROR;
+end;
+
+function GetSockName(s: TSocket; var name: TVarSin): Integer;
+var
+  len: integer;
+begin
+  len := SizeOf(name);
+  FillChar(name, len, 0);
+  Result := sockets.GetSocketName(s, name, Len);
+end;
+
+function GetPeerName(s: TSocket; var name: TVarSin): Integer;
+var
+  len: integer;
+begin
+  len := SizeOf(name);
+  FillChar(name, len, 0);
+  Result := sockets.GetPeerName(s, name, Len);
+end;
+
+function GetHostName: string;
+begin
+  Result := unix.GetHostName;
+end;
+
+function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+begin
+  Result := sockets.Send(s, Buf^, len, flags);
+end;
+
+function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+begin
+  Result := sockets.Recv(s, Buf^, len, flags);
+end;
+
+function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
+begin
+  Result := sockets.SendTo(s, Buf^, len, flags, addrto, SizeOfVarSin(addrto));
+end;
+
+function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
+var
+  x: integer;
+begin
+  x := SizeOf(from);
+  Result := sockets.RecvFrom(s, Buf^, len, flags, from, x);
+end;
+
+function Accept(s: TSocket; var addr: TVarSin): TSocket;
+var
+  x: integer;
+begin
+  x := SizeOf(addr);
+  Result := sockets.Accept(s, addr, x);
+end;
+
+function Shutdown(s: TSocket; how: Integer): Integer;
+begin
+  Result := sockets.Shutdown(s, how);
+end;
+
+function SetSockOpt(s: TSocket; level, optname: Integer; optval: Tmemory;
+  optlen: Integer): Integer;
+begin
+  Result := sockets.SetSocketOptions(s, level, optname, optval^, optlen);
+end;
+
+function GetSockOpt(s: TSocket; level, optname: Integer; optval: Tmemory;
+  var optlen: Integer): Integer;
+begin
+  Result := sockets.GetSocketOptions(s, level, optname, optval^, optlen);
+end;
+
+function  ntohs(netshort: word): word;
+begin
+  Result := sockets.ntohs(NetShort);
+end;
+
+function  ntohl(netlong: longword): longword;
+begin
+  Result := sockets.ntohl(NetLong);
+end;
+
+function  Listen(s: TSocket; backlog: Integer): Integer;
+begin
+  if sockets.Listen(s, backlog) then
+    Result := 0
+  else
+    Result := SOCKET_ERROR;
+end;
+
+function  IoctlSocket(s: TSocket; cmd: DWORD; var arg: integer): Integer;
+begin
+  Result := fpIoctl(s, cmd, @arg);
+end;
+
+function  htons(hostshort: word): word;
+begin
+  Result := sockets.htons(Hostshort);
+end;
+
+function  htonl(hostlong: longword): longword;
+begin
+  Result := sockets.htonl(HostLong);
+end;
+
+function CloseSocket(s: TSocket): Integer;
+begin
+  Result := sockets.CloseSocket(s);
+end;
+
+function Socket(af, Struc, Protocol: Integer): TSocket;
+begin
+  Result := sockets.Socket(af, struc, protocol);
+end;
+
+function Select(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
+  timeout: PTimeVal): Longint;
+begin
+  Result := fpSelect(nfds, readfds, writefds, exceptfds, timeout);
+end;
+
+{=============================================================================}
+function IsNewApi(Family: integer): Boolean;
+begin
+  Result := SockEnhancedApi;
+  if not Result then
+    Result := (Family = AF_INET6) and SockWship6Api;
+end;
+
+function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+var
+  TwoPass: boolean;
+  f1, f2: integer;
+
+  function GetAddr(f:integer): integer;
+  var
+    a4: array [1..1] of in_addr;
+    a6: array [1..1] of Tin6_addr;
+  begin
+    Result := WSAEPROTONOSUPPORT;
+    case f of
+      AF_INET:
+        begin
+          if IP = cAnyHost then
+          begin
+            Sin.sin_family := AF_INET;
+            Result := 0;
+          end
+          else
+          begin
+            a4[1].s_addr := 0;
+            Result := WSAHOST_NOT_FOUND;
+            a4[1] := StrTonetAddr(IP);
+            if a4[1].s_addr = INADDR_ANY then
+              Resolvename(ip, a4);
+            if a4[1].s_addr <> INADDR_ANY then
+            begin
+              Sin.sin_family := AF_INET;
+              sin.sin_addr := a4[1];
+              Result := 0;
+            end;
+          end;
+        end;
+      AF_INET6:
+        begin
+          if IP = c6AnyHost then
+          begin
+            Sin.sin_family := AF_INET6;
+            Result := 0;
+          end
+          else
+          begin
+            Result := WSAHOST_NOT_FOUND;
+            SET_IN6_IF_ADDR_ANY(@a6[1]);
+            a6[1] := StrTonetAddr6(IP);
+            if IN6_IS_ADDR_UNSPECIFIED(@a6[1]) then
+              Resolvename6(ip, a6);
+            if IN6_IS_ADDR_UNSPECIFIED(@a6[1]) then
+            begin
+              Sin.sin_family := AF_INET6;
+              sin.sin6_addr := a6[1];
+              Result := 0;
+            end;
+          end;
+        end;
+    end;
+  end;
+begin
+  Result := 0;
+  FillChar(Sin, Sizeof(Sin), 0);
+  Sin.sin_port := Resolveport(port, family, SockProtocol, SockType);
+  TwoPass := False;
+  if Family = AF_UNSPEC then
+  begin
+    if PreferIP4 then
+    begin
+      f1 := AF_INET;
+      f2 := AF_INET6;
+      TwoPass := True;
+    end
+    else
+    begin
+      f2 := AF_INET;
+      f1 := AF_INET6;
+      TwoPass := True;
+    end;
+  end
+  else
+    f1 := Family;
+  Result := GetAddr(f1);
+  if Result <> 0 then
+    if TwoPass then
+      Result := GetAddr(f2);
+end;
+
+function GetSinIP(Sin: TVarSin): string;
+begin
+  Result := '';
+  case sin.AddressFamily of
+    AF_INET:
+      begin
+        result := NetAddrToStr(sin.sin_addr);
+      end;
+    AF_INET6:
+      begin
+        result := NetAddrToStr6(sin.sin6_addr);
+      end;
+  end;
+end;
+
+function GetSinPort(Sin: TVarSin): Integer;
+begin
+  if (Sin.sin_family = AF_INET6) then
+    Result := synsock.ntohs(Sin.sin6_port)
+  else
+    Result := synsock.ntohs(Sin.sin_port);
+end;
+
+procedure ResolveNameToIP(Name: string; Family, SockProtocol, SockType: integer; const IPList: TStrings);
+var
+  x, n: integer;
+  a4: array [1..255] of in_addr;
+  a6: array [1..255] of Tin6_addr;
+begin
+  IPList.Clear;
+  if (family = AF_INET) or (family = AF_UNSPEC) then
+  begin
+    a4[1] := StrTonetAddr(name);
+    if a4[1].s_addr = INADDR_ANY then
+      x := Resolvename(name, a4)
+    else
+      x := 1;
+    for n := 1  to x do
+      IpList.Add(netaddrToStr(a4[n]));
+  end;
+
+  if (family = AF_INET6) or (family = AF_UNSPEC) then
+  begin
+    a6[1] := StrTonetAddr6(name);
+    if IN6_IS_ADDR_UNSPECIFIED(@a6[1]) then
+      x := Resolvename6(name, a6)
+    else
+      x := 1;
+    for n := 1  to x do
+      IpList.Add(netaddrToStr6(a6[n]));
+  end;
+  
+  if IPList.Count = 0 then
+    IPList.Add(cLocalHost);
+end;
+
+function ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word;
+var
+  ProtoEnt: TProtocolEntry;
+  ServEnt: TServiceEntry;
+begin
+  Result := synsock.htons(StrToIntDef(Port, 0));
+  if Result = 0 then
+  begin
+    ProtoEnt.Name := '';
+    GetProtocolByNumber(SockProtocol, ProtoEnt);
+    ServEnt.port := 0;
+    GetServiceByName(Port, ProtoEnt.Name, ServEnt);
+    Result := ServEnt.port;  
+  end;
+end;
+
+function ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): string;
+var
+  n: integer;
+  a4: array [1..1] of in_addr;
+  a6: array [1..1] of Tin6_addr;
+  a: array [1..1] of string;
+begin
+  Result := IP;
+  a4[1] := StrToNetAddr(IP);
+  if a4[1].s_addr <> INADDR_ANY then
+  begin
+//why ResolveAddress need address in HOST order? :-O 
+    n := ResolveAddress(nettohost(a4[1]), a);
+    if n > 0 then
+      Result := a[1];
+  end
+  else
+  begin
+    a6[1] := StrToNetAddr6(IP);
+    n := ResolveAddress6(a6[1], a);
+    if n > 0 then
+      Result := a[1];
+  end;
+end;
+
+{=============================================================================}
+
+function InitSocketInterface(stack: string): Boolean;
+begin
+  SockEnhancedApi := False;
+  SockWship6Api := False;
+//  Libc.Signal(Libc.SIGPIPE, TSignalHandler(Libc.SIG_IGN));
+  Result := True;
+end;
+
+function DestroySocketInterface: Boolean;
+begin
+  Result := True;
+end;
+
+initialization
+begin
+  SynSockCS := SyncObjs.TCriticalSection.Create;
+  SET_IN6_IF_ADDR_ANY (@in6addr_any);
+  SET_LOOPBACK_ADDR6  (@in6addr_loopback);
+end;
+
+finalization
+begin
+  SynSockCS.Free;
+end;
+
+{$ENDIF}
+

ssl_cryptlib.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.000.002 |
+| Project : Ararat Synapse                                       | 001.001.000 |
 |==============================================================================|
 | Content: SSL/SSH support by Peter Gutmann's CryptLib                         |
 |==============================================================================|
@@ -97,12 +97,14 @@ type
     FCryptSession: CRYPT_SESSION;
     FPrivateKeyLabel: string;
     FDelCert: Boolean;
+    FReadBuffer: string;
     function SSLCheck(Value: integer): Boolean;
     function Init(server:Boolean): Boolean;
     function DeInit: Boolean;
     function Prepare(server:Boolean): Boolean;
     function GetString(const cryptHandle: CRYPT_HANDLE; const attributeType: CRYPT_ATTRIBUTE_TYPE): string;
     function CreateSelfSignedCert(Host: string): Boolean; override;
+    function PopAll: string;
   public
     {:See @inherited}
     constructor Create(const Value: TTCPBlockSocket); override;
@@ -203,6 +205,8 @@ function TSSLCryptLib.SSLCheck(Value: integer): Boolean;
 begin
   Result := true;
   FLastErrorDesc := '';
+  if Value = CRYPT_ERROR_COMPLETE then
+    Value := 0;
   FLastError := Value;
   if FLastError <> 0 then
   begin
@@ -243,6 +247,28 @@ begin
   Result := True;
 end;
 
+function TSSLCryptLib.PopAll: string;
+const
+  BufferMaxSize = 32768;
+var
+  Outbuffer: string;
+  WriteLen: integer;
+begin
+  Result := '';
+  repeat
+    setlength(outbuffer, BufferMaxSize);
+    Writelen := 0;
+    SSLCheck(CryptPopData(FCryptSession, @OutBuffer[1], BufferMaxSize, Writelen));
+    if FLastError <> 0 then
+      Break;
+    if WriteLen > 0 then
+    begin
+      setlength(outbuffer, WriteLen);
+      Result := Result + outbuffer;
+    end;
+  until WriteLen = 0;
+end;
+
 function TSSLCryptLib.Init(server:Boolean): Boolean;
 var
   st: CRYPT_SESSION_TYPE;
@@ -385,6 +411,7 @@ begin
       Exit;
     FSSLEnabled := True;
     Result := True;
+    FReadBuffer := '';
   end;
 end;
 
@@ -401,6 +428,7 @@ begin
       Exit;
     FSSLEnabled := True;
     Result := True;
+    FReadBuffer := '';
   end;
 end;
 
@@ -414,6 +442,7 @@ begin
   if FcryptSession <> CRYPT_SESSION(CRYPT_SESSION_NONE) then
     cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_ACTIVE, 0);
   DeInit;
+  FReadBuffer := '';
   Result := True;
 end;
 
@@ -434,13 +463,18 @@ var
 begin
   FLastError := 0;
   FLastErrorDesc := '';
-  SSLCheck(cryptPopData(FCryptSession, Buffer, Len, L));
+  if Length(FReadBuffer) = 0 then
-  Result := l;
+    FReadBuffer := PopAll;
+  if Len > Length(FReadBuffer) then
+    Len := Length(FReadBuffer);
+  Move(Pointer(FReadBuffer)^, buffer^, Len);
+  Delete(FReadBuffer, 1, Len);
+  Result := Len;
 end;
 
 function TSSLCryptLib.WaitingData: Integer;
 begin
-  Result := 0;
+  Result := Length(FReadBuffer);
 end;
 
 function TSSLCryptLib.GetSSLVersion: string;

ssl_openssl.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.000.003 |
+| Project : Ararat Synapse                                       | 001.000.004 |
 |==============================================================================|
 | Content: SSL support by OpenSSL                                              |
 |==============================================================================|
@@ -643,6 +643,11 @@ begin
     Exit;
   end;
   cert := SSLGetPeerCertificate(Fssl);
+  if not assigned(cert) then
+  begin
+    Result := '';
+    Exit;
+  end;
 {$IFDEF CIL}
   sb := StringBuilder.Create(4096);
   Result := X509NameOneline(X509GetSubjectName(cert), sb, 4096);
@@ -676,6 +681,11 @@ begin
     Exit;
   end;
   cert := SSLGetPeerCertificate(Fssl);
+  if not assigned(cert) then
+  begin
+    Result := '';
+    Exit;
+  end;
 {$IFDEF CIL}
   sb := StringBuilder.Create(4096);
   Result := X509NameOneline(X509GetIssuerName(cert), sb, 4096);
@@ -700,6 +710,11 @@ begin
     Exit;
   end;
   cert := SSLGetPeerCertificate(Fssl);
+  if not assigned(cert) then
+  begin
+    Result := '';
+    Exit;
+  end;
 {$IFDEF CIL}
   sb := StringBuilder.Create(EVP_MAX_MD_SIZE);
   X509Digest(cert, EvpGetDigestByName('MD5'), sb, x);
@@ -729,6 +744,11 @@ begin
     Exit;
   end;
   cert := SSLGetPeerCertificate(Fssl);
+  if not assigned(cert) then
+  begin
+    Result := '';
+    Exit;
+  end;
   b := BioNew(BioSMem);
   try
     X509Print(b, cert);

ssl_openssl_lib.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 003.004.000 |
+| Project : Ararat Synapse                                       | 003.004.001 |
 |==============================================================================|
 | Content: SSL support by OpenSSL                                              |
 |==============================================================================|
@@ -76,10 +76,8 @@ uses
   System.Text,
 {$ENDIF}
   Classes,
-{$IFDEF LINUX}
-  {$IFDEF FPC}
   synafpc,
-  {$ENDIF}
+{$IFNDEF WIN32}
   Libc, SysUtils;
 {$ELSE}
   Windows;
@@ -97,7 +95,7 @@ const
   {$ENDIF}
 {$ELSE}
 var
-  {$IFDEF LINUX}
+  {$IFNDEF WIN32}
   DLLSSLName: string = 'libssl.so';
   DLLUtilName: string = 'libcrypto.so';
   {$ELSE}
@@ -205,8 +203,8 @@ const
   EVP_PKEY_RSA = 6;
 
 var
-  SSLLibHandle: Integer = 0;
+  SSLLibHandle: TLibHandle = 0;
-  SSLUtilHandle: Integer = 0;
+  SSLUtilHandle: TLibHandle = 0;
   SSLLibFile: string = '';
   SSLUtilFile: string = '';
 

ssl_sbb.pas

@@ -0,0 +1,594 @@
+{==============================================================================|
+| Project : Ararat Synapse                                       | 001.000.001 |
+|==============================================================================|
+| Content: SSL support for SecureBlackBox                                     |
+|==============================================================================|
+| Copyright (c)1999-2005, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2005.                     |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|   Allen Drennan (adrennan@wiredred.com)                                      |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@abstract(SSL plugin for Eldos SecureBlackBox)
+
+For handling keys and certificates you can use this properties:
+@link(TCustomSSL.CertCAFile), @link(TCustomSSL.CertCA),
+@link(TCustomSSL.TrustCertificateFile), @link(TCustomSSL.TrustCertificate),
+@link(TCustomSSL.PrivateKeyFile), @link(TCustomSSL.PrivateKey),
+@link(TCustomSSL.CertificateFile), @link(TCustomSSL.Certificate),
+@link(TCustomSSL.PFXFile). For usage of this properties and for possible formats
+of keys and certificates refer to SecureBlackBox documentation.
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+unit ssl_sbb;
+
+interface
+
+uses
+  SysUtils, Classes, Windows, blcksock, synsock, synautil, synacode,
+  SBClient, SBServer, SBX509, SBWinCertStorage, SBCustomCertStorage,
+  SBUtils, SBConstants, SBSessionPool;
+
+const
+  DEFAULT_RECV_BUFFER=32768;  
+
+type
+  {:@abstract(class implementing SecureBlackbox SSL plugin.)
+   Instance of this class will be created for each @link(TTCPBlockSocket).
+   You not need to create instance of this class, all is done by Synapse itself!}
+  TSSLSBB=class(TCustomSSL)
+  protected
+    FServer: Boolean;
+    FElSecureClient:TElSecureClient;
+    FElSecureServer:TElSecureServer;
+    FElCertStorage:TElMemoryCertStorage;
+    FElX509Certificate:TElX509Certificate;
+  private
+    FRecvBuffer:String;
+    FRecvBuffers:String;
+    FRecvDecodedBuffers:String;
+    function Init(Server:Boolean):Boolean;
+    function DeInit:Boolean;
+    function Prepare(Server:Boolean):Boolean;
+    procedure OnError(Sender:TObject; ErrorCode:Integer; Fatal:Boolean; Remote:Boolean);
+    procedure OnSend(Sender:TObject;Buffer:Pointer;Size:LongInt);
+    procedure OnReceive(Sender:TObject;Buffer:Pointer;MaxSize:LongInt;out Written:LongInt);
+    procedure OnData(Sender:TObject;Buffer:Pointer;Size:LongInt);
+  public
+    constructor Create(const Value: TTCPBlockSocket); override;
+    destructor Destroy; override;
+    {:See @inherited}
+    function LibVersion: String; override;
+    {:See @inherited}
+    function LibName: String; override;
+    {:See @inherited and @link(ssl_sbb) for more details.}
+    function Connect: boolean; override;
+    {:See @inherited and @link(ssl_sbb) for more details.}
+    function Accept: boolean; override;
+    {:See @inherited}
+    function Shutdown: boolean; override;
+    {:See @inherited}
+    function BiShutdown: boolean; override;
+    {:See @inherited}
+    function SendBuffer(Buffer: TMemory; Len: Integer): Integer; override;
+    {:See @inherited}
+    function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; override;
+    {:See @inherited}
+    function WaitingData: Integer; override;
+    {:See @inherited}
+    function GetSSLVersion: string; override;
+    {:See @inherited}
+    function GetPeerSubject: string; override;
+    {:See @inherited}
+    function GetPeerIssuer: string; override;
+    {:See @inherited}
+    function GetPeerName: string; override;
+    {:See @inherited}
+    function GetPeerFingerprint: string; override;
+    {:See @inherited}
+    function GetCertInfo: string; override;
+  published
+    property ELSecureClient:TElSecureClient read FElSecureClient write FElSecureClient;
+    property ELSecureServer:TElSecureServer read FElSecureServer write FElSecureServer;
+  end;
+
+implementation
+
+// on error
+procedure TSSLSBB.OnError(Sender:TObject; ErrorCode:Integer; Fatal:Boolean; Remote:Boolean);
+
+begin
+  FLastErrorDesc:='';
+  FLastError:=ErrorCode;
+end;
+
+// on send
+procedure TSSLSBB.OnSend(Sender:TObject;Buffer:Pointer;Size:LongInt);
+
+var
+  lResult:Integer;
+
+begin
+  lResult:=Send(FSocket.Socket,Buffer,Size,0);
+  if lResult=SOCKET_ERROR then
+    begin
+      FLastErrorDesc:='';
+      FLastError:=WSAGetLastError;
+    end;
+end;
+
+// on receive
+procedure TSSLSBB.OnReceive(Sender:TObject;Buffer:Pointer;MaxSize:LongInt;out Written:LongInt);
+
+begin
+  if Length(FRecvBuffers)<=MaxSize then
+    begin
+      Written:=Length(FRecvBuffers);
+      Move(FRecvBuffers[1],Buffer^,Written);
+      FRecvBuffers:='';
+    end
+  else
+    begin
+      Written:=MaxSize;
+      Move(FRecvBuffers[1],Buffer^,Written);
+      Delete(FRecvBuffers,1,Written);
+    end;
+end;
+
+// on data
+procedure TSSLSBB.OnData(Sender:TObject;Buffer:Pointer;Size:LongInt);
+
+var
+  lString:String;
+
+begin
+  SetLength(lString,Size);
+  Move(Buffer^,lString[1],Size);
+  FRecvDecodedBuffers:=FRecvDecodedBuffers+lString;
+end;
+
+{ inherited }
+
+constructor TSSLSBB.Create(const Value: TTCPBlockSocket);
+
+begin
+  inherited Create(Value);
+  FServer:=FALSE;
+  FElSecureClient:=NIL;
+  FElSecureServer:=NIL;
+  FElCertStorage:=NIL;
+  FElX509Certificate:=NIL;
+  SetLength(FRecvBuffer,DEFAULT_RECV_BUFFER);
+  FRecvBuffers:='';
+  FRecvDecodedBuffers:='';
+end;
+
+destructor TSSLSBB.Destroy;
+
+begin
+  DeInit;
+  inherited Destroy;
+end;
+
+function TSSLSBB.LibVersion: String;
+
+begin
+  Result:='SecureBlackBox';
+end;
+
+function TSSLSBB.LibName: String;
+
+begin
+  Result:='ssl_sbb';
+end;
+
+function FileToString(lFile:String):String;
+
+var
+  lStream:TMemoryStream;
+
+begin
+  Result:='';
+  lStream:=TMemoryStream.Create;
+  if lStream<>NIL then
+    begin
+      lStream.LoadFromFile(lFile);
+      if lStream.Size>0 then
+        begin
+          lStream.Position:=0;
+          SetLength(Result,lStream.Size);
+          Move(lStream.Memory^,Result[1],lStream.Size);
+        end;
+      lStream.Free;
+    end;
+end;
+
+function TSSLSBB.Init(Server:Boolean):Boolean;
+
+var
+  loop1:Integer;
+  lStream:TMemoryStream;
+  lCertificate,lPrivateKey:String;
+
+begin
+  Result:=FALSE;
+  FServer:=Server;
+
+  // init, certificate
+  if FCertificateFile<>'' then
+    lCertificate:=FileToString(FCertificateFile)
+  else
+    lCertificate:=FCertificate;
+  if FPrivateKeyFile<>'' then
+    lPrivateKey:=FileToString(FPrivateKeyFile)
+  else
+    lPrivateKey:=FPrivateKey;
+  if (lCertificate<>'') and (lPrivateKey<>'') then
+    begin
+      FElX509Certificate:=TElX509Certificate.Create(NIL);
+      if FElX509Certificate<>NIL then
+        begin
+          with FElX509Certificate do
+            begin
+              lStream:=TMemoryStream.Create;
+              try
+                WriteStrToStream(lStream,lCertificate);
+                lStream.Seek(0,soFromBeginning);
+                LoadFromStream(lStream);
+              finally
+                lStream.Free;
+              end;
+              lStream:=TMemoryStream.Create;
+              try
+                WriteStrToStream(lStream,lPrivateKey);
+                lStream.Seek(0,soFromBeginning);
+                LoadKeyFromStream(lStream);
+              finally
+                lStream.Free;
+              end;
+              FElCertStorage:=TElMemoryCertStorage.Create(NIL);
+              if FElCertStorage<>NIL then
+                begin
+                  FElCertStorage.Clear;
+                  FElCertStorage.Add(FElX509Certificate);
+                end;
+            end;
+        end;
+    end;
+
+  // init, as server
+  if FServer then
+    begin
+      FElSecureServer:=TElSecureServer.Create(NIL);
+      if FElSecureServer<>NIL then
+        begin
+          // init, ciphers
+          for loop1:=SB_SUITE_FIRST to SB_SUITE_LAST do
+            FElSecureServer.CipherSuites[loop1]:=TRUE;
+          FElSecureServer.Versions:=[sbSSL2,sbSSL3,sbTLS1];
+          FElSecureServer.ClientAuthentication:=FALSE;
+          FElSecureServer.OnError:=OnError;
+          FElSecureServer.OnSend:=OnSend;
+          FElSecureServer.OnReceive:=OnReceive;
+          FElSecureServer.OnData:=OnData;
+          FElSecureServer.CertStorage:=FElCertStorage;
+          Result:=TRUE;
+        end;
+    end
+  else
+    // init, as client
+    begin
+      FElSecureClient:=TElSecureClient.Create(NIL);
+      if FElSecureClient<>NIL then
+        begin
+          // init, ciphers
+          for loop1:=SB_SUITE_FIRST to SB_SUITE_LAST do
+            FElSecureClient.CipherSuites[loop1]:=TRUE;
+          FElSecureClient.Versions:=[sbSSL3,sbTLS1];
+          FElSecureClient.OnError:=OnError;
+          FElSecureClient.OnSend:=OnSend;
+          FElSecureClient.OnReceive:=OnReceive;
+          FElSecureClient.OnData:=OnData;
+          FElSecureClient.CertStorage:=FElCertStorage;
+          Result:=TRUE;
+        end;
+    end;
+end;
+
+function TSSLSBB.DeInit:Boolean;
+
+begin
+  Result:=TRUE;
+  if FElSecureServer<>NIL then
+    FreeAndNIL(FElSecureServer);
+  if FElSecureClient<>NIL then
+    FreeAndNIL(FElSecureClient);
+  if FElX509Certificate<>NIL then
+    FreeAndNIL(FElX509Certificate);
+  if FElCertStorage<>NIL then
+    FreeAndNIL(FElCertStorage);
+  FSSLEnabled:=FALSE;
+end;
+
+function TSSLSBB.Prepare(Server:Boolean): Boolean;
+
+begin
+  Result:=FALSE;
+  DeInit;
+  if Init(Server) then
+    Result:=TRUE
+  else
+    DeInit;
+end;
+
+function TSSLSBB.Connect: boolean;
+
+var
+  lResult:Integer;
+
+begin
+  Result:=FALSE;
+  if FSocket.Socket=INVALID_SOCKET then
+    Exit;
+  if Prepare(FALSE) then
+    begin
+      FElSecureClient.Open;
+
+      // wait for open or error
+      while (not FElSecureClient.Active) and
+        (FLastError=0) do
+        begin
+          // data available?
+          if FRecvBuffers<>'' then
+            FElSecureClient.DataAvailable
+          else
+            begin
+              // socket recv
+              lResult:=Recv(FSocket.Socket,@FRecvBuffer[1],Length(FRecvBuffer),0);
+              if lResult=SOCKET_ERROR then
+                begin
+                  FLastErrorDesc:='';
+                  FLastError:=WSAGetLastError;
+                end
+              else
+                begin
+                  if lResult>0 then
+                    FRecvBuffers:=FRecvBuffers+Copy(FRecvBuffer,1,lResult)
+                  else
+                    Break;
+                end;
+            end;
+        end;
+      if FLastError<>0 then
+        Exit;
+      FSSLEnabled:=FElSecureClient.Active;
+      Result:=FSSLEnabled;
+    end;
+end;
+
+function TSSLSBB.Accept: boolean;
+
+var
+  lResult:Integer;
+
+begin
+  Result:=FALSE;
+  if FSocket.Socket=INVALID_SOCKET then
+    Exit;
+  if Prepare(TRUE) then
+    begin
+      FElSecureServer.Open;
+
+      // wait for open or error
+      while (not FElSecureServer.Active) and
+        (FLastError=0) do
+        begin
+          // data available?
+          if FRecvBuffers<>'' then
+            FElSecureServer.DataAvailable
+          else
+            begin
+              // socket recv
+              lResult:=Recv(FSocket.Socket,@FRecvBuffer[1],Length(FRecvBuffer),0);
+              if lResult=SOCKET_ERROR then
+                begin
+                  FLastErrorDesc:='';
+                  FLastError:=WSAGetLastError;
+                end
+              else
+                begin
+                  if lResult>0 then
+                    FRecvBuffers:=FRecvBuffers+Copy(FRecvBuffer,1,lResult)
+                  else
+                    Break;
+                end;
+            end;
+        end;
+      if FLastError<>0 then
+        Exit;
+      FSSLEnabled:=FElSecureServer.Active;
+      Result:=FSSLEnabled;
+    end;
+end;
+
+function TSSLSBB.Shutdown: boolean;
+
+begin
+  Result:=BiShutdown;
+end;
+
+function TSSLSBB.BiShutdown: boolean;
+
+begin
+  DeInit;
+  Result:=TRUE;
+end;
+
+function TSSLSBB.SendBuffer(Buffer: TMemory; Len: Integer): Integer;
+
+begin
+  if FServer then
+    FElSecureServer.SendData(Buffer,Len)
+  else
+    FElSecureClient.SendData(Buffer,Len);
+  Result:=Len;
+end;
+
+function TSSLSBB.RecvBuffer(Buffer: TMemory; Len: Integer): Integer;
+
+begin
+  if Length(FRecvDecodedBuffers)<Len then
+    begin
+      Result:=Length(FRecvDecodedBuffers);
+      Move(FRecvDecodedBuffers[1],Buffer^,Result);
+      FRecvDecodedBuffers:='';
+    end
+  else
+    begin
+      Result:=Len;
+      Move(FRecvDecodedBuffers[1],Buffer^,Result);
+      Delete(FRecvDecodedBuffers,1,Result);
+    end;
+end;
+
+function TSSLSBB.WaitingData: Integer;
+
+var
+  lResult:Integer;
+
+begin
+  // data available?
+  if FRecvBuffers<>'' then
+    begin
+      if FServer then
+        FElSecureServer.DataAvailable
+      else
+        FElSecureClient.DataAvailable;
+    end
+  else
+    begin
+      // socket recv
+      lResult:=Recv(FSocket.Socket,@FRecvBuffer[1],Length(FRecvBuffer),0);
+      if lResult=SOCKET_ERROR then
+        begin
+          FLastErrorDesc:='';
+          FLastError:=WSAGetLastError;
+        end
+      else
+        FRecvBuffers:=FRecvBuffers+Copy(FRecvBuffer,1,lResult);
+
+      // data available?
+      if FRecvBuffers<>'' then
+        begin
+          if FServer then
+            FElSecureServer.DataAvailable
+          else
+            FElSecureClient.DataAvailable;
+        end;
+    end;
+  Result:=Length(FRecvDecodedBuffers);
+end;
+
+function TSSLSBB.GetSSLVersion: string;
+
+begin
+  Result:='SSLv3 or TLSv1';
+end;
+
+function TSSLSBB.GetPeerSubject: string;
+
+begin
+  Result := '';
+//  if FServer then
+    // must return subject of the client certificate
+//  else
+    // must return subject of the server certificate
+end;
+
+function TSSLSBB.GetPeerName: string;
+
+begin
+  Result := '';
+//  if FServer then
+    // must return commonname of the client certificate
+//  else
+    // must return commonname of the server certificate
+end;
+
+function TSSLSBB.GetPeerIssuer: string;
+
+begin
+  Result := '';
+//  if FServer then
+    // must return issuer of the client certificate
+//  else
+    // must return issuer of the server certificate
+end;
+
+function TSSLSBB.GetPeerFingerprint: string;
+
+begin
+  Result := '';
+//  if FServer then
+    // must return a unique hash string of the client certificate
+//  else
+    // must return a unique hash string of the server certificate
+end;
+
+function TSSLSBB.GetCertInfo: string;
+
+begin
+  Result := '';
+//  if FServer then
+    // must return a text representation of the ASN of the client certificate
+//  else
+    // must return a text representation of the ASN of the server certificate
+end;
+
+{==============================================================================}
+
+initialization
+  SSLImplementation := TSSLSBB;
+
+finalization
+
+end.

sslinux.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 002.000.005 |
+| Project : Ararat Synapse                                       | 002.000.007 |
 |==============================================================================|
 | Content: Socket Independent Platform Layer - Linux definition include        |
 |==============================================================================|
@@ -62,10 +62,8 @@ For IPv6 support you must have new API!
 interface
 
 uses
-  SyncObjs, SysUtils,
+  SyncObjs, SysUtils, Classes,
-  {$IFDEF FPC}
   synafpc,
-  {$ENDIF}
   Libc;
 
 function InitSocketInterface(stack: string): Boolean;
@@ -82,6 +80,7 @@ type
   pu_long = ^u_long;
   pu_short = ^u_short;
   TSocket = u_int;
+  TAddrFamily = integer;
 
   TMemory = pointer;
 
@@ -89,6 +88,14 @@ type
 const
   DLLStackName = 'libc.so.6';
 
+  cLocalhost = '127.0.0.1';
+  cAnyHost = '0.0.0.0';
+  cBroadcast = '255.255.255.255';
+  c6Localhost = '::1';
+  c6AnyHost = '::0';
+  c6Broadcast = 'ffff::1';
+  cAnyPort = '0';
+
 type
   DWORD = Integer;
   __fd_mask = LongWord;
@@ -127,20 +134,11 @@ const
   IPPROTO_MAX    =   256;
 
 type
-  SunB = packed record
-    s_b1, s_b2, s_b3, s_b4: u_char;
-  end;
-
-  SunW = packed record
-    s_w1, s_w2: u_short;
-  end;
-
   PInAddr = ^TInAddr;
   TInAddr = packed record
     case integer of
-      0: (S_un_b: SunB);
+      0: (S_bytes: packed array [0..3] of byte);
-      1: (S_un_w: SunW);
+      1: (S_addr: u_long);
-      2: (S_addr: u_long);
   end;
 
   PSockAddrIn = ^TSockAddrIn;
@@ -159,33 +157,13 @@ type
     imr_interface: TInAddr;     { local IP address of interface }
   end;
 
-  SunB6 = packed record
-    s_b1,  s_b2,  s_b3,  s_b4,
-    s_b5,  s_b6,  s_b7,  s_b8,
-    s_b9,  s_b10, s_b11, s_b12,
-    s_b13, s_b14, s_b15, s_b16: u_char;
-  end;
-
-  SunW6 = packed record
-    s_w1, s_w2, s_w3, s_w4,
-    s_w5, s_w6, s_w7, s_w8: u_short;
-  end;
-
-  SunDW6 = packed record
-    s_dw1, s_dw2, s_dw3, s_dw4: longint;
-  end;
-
-  S6_Bytes   = SunB6;
-  S6_Words   = SunW6;
-  S6_DWords  = SunDW6;
-  S6_Addr    = SunB6;
-
   PInAddr6 = ^TInAddr6;
   TInAddr6 = packed record
     case integer of
-      0: (S_un_b:  SunB6);
+      0: (S6_addr: packed array [0..15] of byte);
-      1: (S_un_w:  SunW6);
+      1: (u6_addr8: packed array [0..15] of byte);
-      2: (S_un_dw: SunDW6);
+      2: (u6_addr16: packed array [0..7] of word);
+      3: (u6_addr32: packed array [0..7] of integer);
   end;
 
   PSockAddrIn6 = ^TSockAddrIn6;
@@ -200,7 +178,7 @@ type
 
   TIPv6_mreq = record
     ipv6mr_multiaddr: TInAddr6; // IPv6 multicast address.
-    ipv6mr_interface: u_long;   // Interface index.
+    ipv6mr_interface: integer;   // Interface index.
     padding: u_long;
   end;
 
@@ -378,8 +356,8 @@ type
 { Structure used for manipulating linger option. }
   PLinger = ^TLinger;
   TLinger = packed record
-    l_onoff: u_short;
+    l_onoff: integer;
-    l_linger: u_short;
+    l_linger: integer;
   end;
 
 const
@@ -530,7 +508,7 @@ type
     cdecl;
   TListen = function(s: TSocket; backlog: Integer): Integer;
     cdecl;
-  TIoctlSocket = function(s: TSocket; cmd: DWORD; var arg: u_long): Integer;
+  TIoctlSocket = function(s: TSocket; cmd: DWORD; var arg: integer): Integer;
     cdecl;
   TInet_ntoa = function(inaddr: TInAddr): PChar;
     cdecl;
@@ -644,41 +622,49 @@ function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin):
 function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
 function Accept(s: TSocket; var addr: TVarSin): TSocket;
 
+function IsNewApi(Family: integer): Boolean;
+function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+function GetSinIP(Sin: TVarSin): string;
+function GetSinPort(Sin: TVarSin): Integer;
+procedure ResolveNameToIP(Name: string;  Family, SockProtocol, SockType: integer; const IPList: TStrings);
+function ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): string;
+function ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word;
+
 {==============================================================================}
 implementation
 
 var
   SynSockCount: Integer = 0;
-  LibHandle: THandle = 0;
+  LibHandle: TLibHandle = 0;
-  Libwship6Handle: THandle = 0;
+  Libwship6Handle: TLibHandle = 0;
 
 function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
 begin
-  Result := ((a^.s_un_dw.s_dw1 = 0) and (a^.s_un_dw.s_dw2 = 0) and
+  Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
-             (a^.s_un_dw.s_dw3 = 0) and (a^.s_un_dw.s_dw4 = 0));
+             (a^.u6_addr32[2] = 0) and (a^.u6_addr32[3] = 0));
 end;
 
 function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
 begin
-  Result := ((a^.s_un_dw.s_dw1 = 0) and (a^.s_un_dw.s_dw2 = 0) and
+  Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
-             (a^.s_un_dw.s_dw3 = 0) and
+             (a^.u6_addr32[2] = 0) and
-             (a^.s_un_b.s_b13 = char(0)) and (a^.s_un_b.s_b14 = char(0)) and
+             (a^.u6_addr8[12] = 0) and (a^.u6_addr8[13] = 0) and
-             (a^.s_un_b.s_b15 = char(0)) and (a^.s_un_b.s_b16 = char(1)));
+             (a^.u6_addr8[14] = 0) and (a^.u6_addr8[15] = 1));
 end;
 
 function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
 begin
-  Result := ((a^.s_un_b.s_b1 = u_char($FE)) and (a^.s_un_b.s_b2 = u_char($80)));
+  Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $80));
 end;
 
 function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
 begin
-  Result := ((a^.s_un_b.s_b1 = u_char($FE)) and (a^.s_un_b.s_b2 = u_char($C0)));
+  Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $C0));
 end;
 
 function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
 begin
-  Result := (a^.s_un_b.s_b1 = char($FF));
+  Result := (a^.u6_addr8[0] = $FF);
 end;
 
 function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6): boolean;
@@ -694,7 +680,7 @@ end;
 procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
 begin
   FillChar(a^, sizeof(TInAddr6), 0);
-  a^.s_un_b.s_b16 := char(1);
+  a^.u6_addr8[15] := 1;
 end;
 
 {=============================================================================}
@@ -851,6 +837,369 @@ begin
   Result := ssAccept(s, @addr, x);
 end;
 
+{=============================================================================}
+function IsNewApi(Family: integer): Boolean;
+begin
+  Result := SockEnhancedApi;
+  if not Result then
+    Result := (Family = AF_INET6) and SockWship6Api;
+end;
+
+function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+type
+  pu_long = ^u_long;
+var
+  ProtoEnt: PProtoEnt;
+  ServEnt: PServEnt;
+  HostEnt: PHostEnt;
+  r: integer;
+  Hints1, Hints2: TAddrInfo;
+  Sin1, Sin2: TVarSin;
+  TwoPass: boolean;
+
+  function GetAddr(const IP, port: string; Hints: TAddrInfo; var Sin: TVarSin): integer;
+  var
+    Addr: PAddrInfo;
+  begin
+    Addr := nil;
+    try
+      FillChar(Sin, Sizeof(Sin), 0);
+      if Hints.ai_socktype = SOCK_RAW then
+      begin
+        Hints.ai_socktype := 0;
+        Hints.ai_protocol := 0;
+        Result := synsock.GetAddrInfo(PChar(IP), nil, @Hints, Addr);
+      end
+      else
+      begin
+        if (IP = cAnyHost) or (IP = c6AnyHost) then
+        begin
+          Hints.ai_flags := AI_PASSIVE;
+          Result := synsock.GetAddrInfo(nil, PChar(Port), @Hints, Addr);
+        end
+        else
+          if (IP = cLocalhost) or (IP = c6Localhost) then
+          begin
+            Result := synsock.GetAddrInfo(nil, PChar(Port), @Hints, Addr);
+          end
+          else
+          begin
+            Result := synsock.GetAddrInfo(PChar(IP), PChar(Port), @Hints, Addr);
+          end;
+      end;
+      if Result = 0 then
+        if (Addr <> nil) then
+          Move(Addr^.ai_addr^, Sin, Addr^.ai_addrlen);
+    finally
+      if Assigned(Addr) then
+        synsock.FreeAddrInfo(Addr);
+    end;
+  end;
+
+begin
+  Result := 0;
+  FillChar(Sin, Sizeof(Sin), 0);
+  if not IsNewApi(family) then
+  begin
+    SynSockCS.Enter;
+    try
+      Sin.sin_family := AF_INET;
+      ProtoEnt := synsock.GetProtoByNumber(SockProtocol);
+      ServEnt := nil;
+      if ProtoEnt <> nil then
+        ServEnt := synsock.GetServByName(PChar(Port), ProtoEnt^.p_name);
+      if ServEnt = nil then
+        Sin.sin_port := synsock.htons(StrToIntDef(Port, 0))
+      else
+        Sin.sin_port := ServEnt^.s_port;
+      if IP = cBroadcast then
+        Sin.sin_addr.s_addr := u_long(INADDR_BROADCAST)
+      else
+      begin
+        Sin.sin_addr.s_addr := synsock.inet_addr(PChar(IP));
+        if Sin.sin_addr.s_addr = u_long(INADDR_NONE) then
+        begin
+          HostEnt := synsock.GetHostByName(PChar(IP));
+          Result := synsock.WSAGetLastError;
+          if HostEnt <> nil then
+            Sin.sin_addr.S_addr := u_long(Pu_long(HostEnt^.h_addr_list^)^);
+        end;
+      end;
+    finally
+      SynSockCS.Leave;
+    end;
+  end
+  else
+  begin
+    FillChar(Hints1, Sizeof(Hints1), 0);
+    FillChar(Hints2, Sizeof(Hints2), 0);
+    TwoPass := False;
+    if Family = AF_UNSPEC then
+    begin
+      if PreferIP4 then
+      begin
+        Hints1.ai_family := AF_INET;
+        Hints2.ai_family := AF_INET6;
+        TwoPass := True;
+      end
+      else
+      begin
+        Hints2.ai_family := AF_INET;
+        Hints1.ai_family := AF_INET6;
+        TwoPass := True;
+      end;
+    end
+    else
+      Hints1.ai_family := Family;
+
+    Hints1.ai_socktype := SockType;
+    Hints1.ai_protocol := SockProtocol;
+    Hints2.ai_socktype := Hints1.ai_socktype;
+    Hints2.ai_protocol := Hints1.ai_protocol;
+
+    r := GetAddr(IP, Port, Hints1, Sin1);
+    Result := r;
+    sin := sin1;
+    if r <> 0 then
+      if TwoPass then
+      begin
+        r := GetAddr(IP, Port, Hints2, Sin2);
+        Result := r;
+        if r = 0 then
+          sin := sin2;
+      end;
+  end;
+end;
+
+function GetSinIP(Sin: TVarSin): string;
+var
+  p: PChar;
+  host, serv: string;
+  hostlen, servlen: integer;
+  r: integer;
+begin
+  Result := '';
+  if not IsNewApi(Sin.AddressFamily) then
+  begin
+    p := synsock.inet_ntoa(Sin.sin_addr);
+    if p <> nil then
+      Result := p;
+  end
+  else
+  begin
+    hostlen := NI_MAXHOST;
+    servlen := NI_MAXSERV;
+    setlength(host, hostlen);
+    setlength(serv, servlen);
+    r := getnameinfo(@sin, SizeOfVarSin(sin), PChar(host), hostlen,
+      PChar(serv), servlen, NI_NUMERICHOST + NI_NUMERICSERV);
+    if r = 0 then
+      Result := PChar(host);
+  end;
+end;
+
+function GetSinPort(Sin: TVarSin): Integer;
+begin
+  if (Sin.sin_family = AF_INET6) then
+    Result := synsock.ntohs(Sin.sin6_port)
+  else
+    Result := synsock.ntohs(Sin.sin_port);
+end;
+
+procedure ResolveNameToIP(Name: string; Family, SockProtocol, SockType: integer; const IPList: TStrings);
+type
+  TaPInAddr = array[0..250] of PInAddr;
+  PaPInAddr = ^TaPInAddr;
+var
+  Hints: TAddrInfo;
+  Addr: PAddrInfo;
+  AddrNext: PAddrInfo;
+  r: integer;
+  host, serv: string;
+  hostlen, servlen: integer;
+  RemoteHost: PHostEnt;
+  IP: u_long;
+  PAdrPtr: PaPInAddr;
+  i: Integer;
+  s: string;
+  InAddr: TInAddr;
+begin
+  IPList.Clear;
+  if not IsNewApi(Family) then
+  begin
+    IP := synsock.inet_addr(PChar(Name));
+    if IP = u_long(INADDR_NONE) then
+    begin
+      SynSockCS.Enter;
+      try
+        RemoteHost := synsock.GetHostByName(PChar(Name));
+        if RemoteHost <> nil then
+        begin
+          PAdrPtr := PAPInAddr(RemoteHost^.h_addr_list);
+          i := 0;
+          while PAdrPtr^[i] <> nil do
+          begin
+            InAddr := PAdrPtr^[i]^;
+            s := Format('%d.%d.%d.%d', [InAddr.S_bytes[0], InAddr.S_bytes[1],
+              InAddr.S_bytes[2], InAddr.S_bytes[3]]);
+            IPList.Add(s);
+            Inc(i);
+          end;
+        end;
+      finally
+        SynSockCS.Leave;
+      end;
+    end
+    else
+      IPList.Add(Name);
+  end
+  else
+  begin
+    Addr := nil;
+    try
+      FillChar(Hints, Sizeof(Hints), 0);
+      Hints.ai_family := AF_UNSPEC;
+      Hints.ai_socktype := SockType;
+      Hints.ai_protocol := SockProtocol;
+      Hints.ai_flags := 0;
+      r := synsock.GetAddrInfo(PChar(Name), nil, @Hints, Addr);
+      if r = 0 then
+      begin
+        AddrNext := Addr;
+        while not(AddrNext = nil) do
+        begin
+          if not(((Family = AF_INET6) and (AddrNext^.ai_family = AF_INET))
+            or ((Family = AF_INET) and (AddrNext^.ai_family = AF_INET6))) then
+          begin
+            hostlen := NI_MAXHOST;
+            servlen := NI_MAXSERV;
+            setlength(host, hostlen);
+            setlength(serv, servlen);
+            r := getnameinfo(AddrNext^.ai_addr, AddrNext^.ai_addrlen,
+              PChar(host), hostlen, PChar(serv), servlen,
+              NI_NUMERICHOST + NI_NUMERICSERV);
+            if r = 0 then
+            begin
+              host := PChar(host);
+              IPList.Add(host);
+            end;
+          end;
+          AddrNext := AddrNext^.ai_next;
+        end;
+      end;
+    finally
+      if Assigned(Addr) then
+        synsock.FreeAddrInfo(Addr);
+    end;
+  end;
+  if IPList.Count = 0 then
+    IPList.Add(cAnyHost);
+end;
+
+function ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word;
+var
+  ProtoEnt: PProtoEnt;
+  ServEnt: PServEnt;
+  Hints: TAddrInfo;
+  Addr: PAddrInfo;
+  r: integer;
+begin
+  Result := 0;
+  if not IsNewApi(Family) then
+  begin
+    SynSockCS.Enter;
+    try
+      ProtoEnt := synsock.GetProtoByNumber(SockProtocol);
+      ServEnt := nil;
+      if ProtoEnt <> nil then
+        ServEnt := synsock.GetServByName(PChar(Port), ProtoEnt^.p_name);
+      if ServEnt = nil then
+        Result := StrToIntDef(Port, 0)
+      else
+        Result := synsock.htons(ServEnt^.s_port);
+    finally
+      SynSockCS.Leave;
+    end;
+  end
+  else
+  begin
+    Addr := nil;
+    try
+      FillChar(Hints, Sizeof(Hints), 0);
+      Hints.ai_family := AF_UNSPEC;
+      Hints.ai_socktype := SockType;
+      Hints.ai_protocol := Sockprotocol;
+      Hints.ai_flags := AI_PASSIVE;
+      r := synsock.GetAddrInfo(nil, PChar(Port), @Hints, Addr);
+      if (r = 0) and Assigned(Addr) then
+      begin
+        if Addr^.ai_family = AF_INET then
+          Result := synsock.htons(Addr^.ai_addr^.sin_port);
+        if Addr^.ai_family = AF_INET6 then
+          Result := synsock.htons(PSockAddrIn6(Addr^.ai_addr)^.sin6_port);
+      end;
+    finally
+      if Assigned(Addr) then
+        synsock.FreeAddrInfo(Addr);
+    end;
+  end;
+end;
+
+function ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): string;
+var
+  Hints: TAddrInfo;
+  Addr: PAddrInfo;
+  r: integer;
+  host, serv: string;
+  hostlen, servlen: integer;
+  RemoteHost: PHostEnt;
+  IPn: u_long;
+begin
+  Result := IP;
+  if not IsNewApi(Family) then
+  begin
+    IPn := synsock.inet_addr(PChar(IP));
+    if IPn <> u_long(INADDR_NONE) then
+    begin
+      SynSockCS.Enter;
+      try
+        RemoteHost := GetHostByAddr(@IPn, SizeOf(IPn), AF_INET);
+        if RemoteHost <> nil then
+          Result := RemoteHost^.h_name;
+      finally
+        SynSockCS.Leave;
+      end;
+    end;
+  end
+  else
+  begin
+    Addr := nil;
+    try
+      FillChar(Hints, Sizeof(Hints), 0);
+      Hints.ai_family := AF_UNSPEC;
+      Hints.ai_socktype := SockType;
+      Hints.ai_protocol := SockProtocol;
+      Hints.ai_flags := 0;
+      r := synsock.GetAddrInfo(PChar(IP), nil, @Hints, Addr);
+      if (r = 0) and Assigned(Addr)then
+      begin
+        hostlen := NI_MAXHOST;
+        servlen := NI_MAXSERV;
+        setlength(host, hostlen);
+        setlength(serv, servlen);
+        r := getnameinfo(Addr^.ai_addr, Addr^.ai_addrlen,
+          PChar(host), hostlen, PChar(serv), servlen,
+          NI_NUMERICSERV);
+        if r = 0 then
+          Result := PChar(host);
+      end;
+    finally
+      if Assigned(Addr) then
+        synsock.FreeAddrInfo(Addr);
+    end;
+  end;
+end;
+
 {=============================================================================}
 
 function InitSocketInterface(stack: string): Boolean;

sswin32.pas

@@ -241,7 +241,7 @@ For IPv6 support you must have new API!
 interface
 
 uses
-  SyncObjs, SysUtils,
+  SyncObjs, SysUtils, Classes,
   Windows;
 
 function InitSocketInterface(stack: string): Boolean;
@@ -262,6 +262,7 @@ type
   pu_long = ^u_long;
   pu_short = ^u_short;
   TSocket = u_int;
+  TAddrFamily = integer;
 
   TMemory = pointer;
 
@@ -273,6 +274,15 @@ const
   {$ENDIF}
   DLLwship6 = 'wship6.dll';
 
+  cLocalhost = '127.0.0.1';
+  cAnyHost = '0.0.0.0';
+  cBroadcast = '255.255.255.255';
+  c6Localhost = '::1';
+  c6AnyHost = '::0';
+  c6Broadcast = 'ffff::1';
+  cAnyPort = '0';
+  
+
 const
   FD_SETSIZE     =   64;
 type
@@ -307,20 +317,12 @@ const
   IPPROTO_MAX    =   256;
 
 type
-  SunB = packed record
-    s_b1, s_b2, s_b3, s_b4: u_char;
-  end;
-
-  SunW = packed record
-    s_w1, s_w2: u_short;
-  end;
 
   PInAddr = ^TInAddr;
   TInAddr = packed record
     case integer of
-      0: (S_un_b: SunB);
+      0: (S_bytes: packed array [0..3] of byte);
-      1: (S_un_w: SunW);
+      1: (S_addr: u_long);
-      2: (S_addr: u_long);
   end;
 
   PSockAddrIn = ^TSockAddrIn;
@@ -339,33 +341,13 @@ type
     imr_interface: TInAddr;     { local IP address of interface }
   end;
 
-  SunB6 = packed record
-    s_b1,  s_b2,  s_b3,  s_b4,
-    s_b5,  s_b6,  s_b7,  s_b8,
-    s_b9,  s_b10, s_b11, s_b12,
-    s_b13, s_b14, s_b15, s_b16: u_char;
-  end;
-
-  SunW6 = packed record
-    s_w1, s_w2, s_w3, s_w4,
-    s_w5, s_w6, s_w7, s_w8: u_short;
-  end;
-
-  SunDW6 = packed record
-    s_dw1, s_dw2, s_dw3, s_dw4: longint;
-  end;
-
-  S6_Bytes   = SunB6;
-  S6_Words   = SunW6;
-  S6_DWords  = SunDW6;
-  S6_Addr    = SunB6;
-
   PInAddr6 = ^TInAddr6;
   TInAddr6 = packed record
     case integer of
-      0: (S_un_b:  SunB6);
+      0: (S6_addr: packed array [0..15] of byte);
-      1: (S_un_w:  SunW6);
+      1: (u6_addr8: packed array [0..15] of byte);
-      2: (S_un_dw: SunDW6);
+      2: (u6_addr16: packed array [0..7] of word);
+      3: (u6_addr32: packed array [0..7] of integer);
   end;
 
   PSockAddrIn6 = ^TSockAddrIn6;
@@ -380,8 +362,8 @@ type
 
   TIPv6_mreq = record
     ipv6mr_multiaddr: TInAddr6; // IPv6 multicast address.
-    ipv6mr_interface: u_long;   // Interface index.
+    ipv6mr_interface: integer;   // Interface index.
-    padding: u_long;
+    padding: integer;
   end;
 
   PHostEnt = ^THostEnt;
@@ -807,7 +789,7 @@ type
     stdcall;
   TListen = function(s: TSocket; backlog: Integer): Integer;
     stdcall;
-  TIoctlSocket = function(s: TSocket; cmd: DWORD; var arg: u_long): Integer;
+  TIoctlSocket = function(s: TSocket; cmd: DWORD; var arg: Integer): Integer;
     stdcall;
   TInet_ntoa = function(inaddr: TInAddr): PChar;
     stdcall;
@@ -930,6 +912,14 @@ function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin):
 function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
 function Accept(s: TSocket; var addr: TVarSin): TSocket;
 
+function IsNewApi(Family: integer): Boolean;
+function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+function GetSinIP(Sin: TVarSin): string;
+function GetSinPort(Sin: TVarSin): Integer;
+procedure ResolveNameToIP(Name: string;  Family, SockProtocol, SockType: integer; const IPList: TStrings);
+function ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): string;
+function ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word;
+
 {==============================================================================}
 implementation
 
@@ -940,31 +930,31 @@ var
 
 function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
 begin
-  Result := ((a^.s_un_dw.s_dw1 = 0) and (a^.s_un_dw.s_dw2 = 0) and
+  Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
-             (a^.s_un_dw.s_dw3 = 0) and (a^.s_un_dw.s_dw4 = 0));
+             (a^.u6_addr32[2] = 0) and (a^.u6_addr32[3] = 0));
 end;
 
 function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
 begin
-  Result := ((a^.s_un_dw.s_dw1 = 0) and (a^.s_un_dw.s_dw2 = 0) and
+  Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
-             (a^.s_un_dw.s_dw3 = 0) and
+             (a^.u6_addr32[2] = 0) and
-             (a^.s_un_b.s_b13 = char(0)) and (a^.s_un_b.s_b14 = char(0)) and
+             (a^.u6_addr8[12] = 0) and (a^.u6_addr8[13] = 0) and
-             (a^.s_un_b.s_b15 = char(0)) and (a^.s_un_b.s_b16 = char(1)));
+             (a^.u6_addr8[14] = 0) and (a^.u6_addr8[15] = 1));
 end;
 
 function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
 begin
-  Result := ((a^.s_un_b.s_b1 = u_char($FE)) and (a^.s_un_b.s_b2 = u_char($80)));
+  Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $80));
 end;
 
 function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
 begin
-  Result := ((a^.s_un_b.s_b1 = u_char($FE)) and (a^.s_un_b.s_b2 = u_char($C0)));
+  Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $C0));
 end;
 
 function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
 begin
-  Result := (a^.s_un_b.s_b1 = char($FF));
+  Result := (a^.u6_addr8[0] = $FF);
 end;
 
 function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6): boolean;
@@ -980,7 +970,7 @@ end;
 procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
 begin
   FillChar(a^, sizeof(TInAddr6), 0);
-  a^.s_un_b.s_b16 := char(1);
+  a^.u6_addr8[15] := 1;
 end;
 
 {=============================================================================}
@@ -1109,6 +1099,369 @@ begin
   Result := ssAccept(s, @addr, x);
 end;
 
+{=============================================================================}
+function IsNewApi(Family: integer): Boolean;
+begin
+  Result := SockEnhancedApi;
+  if not Result then
+    Result := (Family = AF_INET6) and SockWship6Api;
+end;
+
+function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+type
+  pu_long = ^u_long;
+var
+  ProtoEnt: PProtoEnt;
+  ServEnt: PServEnt;
+  HostEnt: PHostEnt;
+  r: integer;
+  Hints1, Hints2: TAddrInfo;
+  Sin1, Sin2: TVarSin;
+  TwoPass: boolean;
+
+  function GetAddr(const IP, port: string; Hints: TAddrInfo; var Sin: TVarSin): integer;
+  var
+    Addr: PAddrInfo;
+  begin
+    Addr := nil;
+    try
+      FillChar(Sin, Sizeof(Sin), 0);
+      if Hints.ai_socktype = SOCK_RAW then
+      begin
+        Hints.ai_socktype := 0;
+        Hints.ai_protocol := 0;
+        Result := synsock.GetAddrInfo(PChar(IP), nil, @Hints, Addr);
+      end
+      else
+      begin
+        if (IP = cAnyHost) or (IP = c6AnyHost) then
+        begin
+          Hints.ai_flags := AI_PASSIVE;
+          Result := synsock.GetAddrInfo(nil, PChar(Port), @Hints, Addr);
+        end
+        else
+          if (IP = cLocalhost) or (IP = c6Localhost) then
+          begin
+            Result := synsock.GetAddrInfo(nil, PChar(Port), @Hints, Addr);
+          end
+          else
+          begin
+            Result := synsock.GetAddrInfo(PChar(IP), PChar(Port), @Hints, Addr);
+          end;
+      end;
+      if Result = 0 then
+        if (Addr <> nil) then
+          Move(Addr^.ai_addr^, Sin, Addr^.ai_addrlen);
+    finally
+      if Assigned(Addr) then
+        synsock.FreeAddrInfo(Addr);
+    end;
+  end;
+
+begin
+  Result := 0;
+  FillChar(Sin, Sizeof(Sin), 0);
+  if not IsNewApi(family) then
+  begin
+    SynSockCS.Enter;
+    try
+      Sin.sin_family := AF_INET;
+      ProtoEnt := synsock.GetProtoByNumber(SockProtocol);
+      ServEnt := nil;
+      if ProtoEnt <> nil then
+        ServEnt := synsock.GetServByName(PChar(Port), ProtoEnt^.p_name);
+      if ServEnt = nil then
+        Sin.sin_port := synsock.htons(StrToIntDef(Port, 0))
+      else
+        Sin.sin_port := ServEnt^.s_port;
+      if IP = cBroadcast then
+        Sin.sin_addr.s_addr := u_long(INADDR_BROADCAST)
+      else
+      begin
+        Sin.sin_addr.s_addr := synsock.inet_addr(PChar(IP));
+        if Sin.sin_addr.s_addr = u_long(INADDR_NONE) then
+        begin
+          HostEnt := synsock.GetHostByName(PChar(IP));
+          Result := synsock.WSAGetLastError;
+          if HostEnt <> nil then
+            Sin.sin_addr.S_addr := u_long(Pu_long(HostEnt^.h_addr_list^)^);
+        end;
+      end;
+    finally
+      SynSockCS.Leave;
+    end;
+  end
+  else
+  begin
+    FillChar(Hints1, Sizeof(Hints1), 0);
+    FillChar(Hints2, Sizeof(Hints2), 0);
+    TwoPass := False;
+    if Family = AF_UNSPEC then
+    begin
+      if PreferIP4 then
+      begin
+        Hints1.ai_family := AF_INET;
+        Hints2.ai_family := AF_INET6;
+        TwoPass := True;
+      end
+      else
+      begin
+        Hints2.ai_family := AF_INET;
+        Hints1.ai_family := AF_INET6;
+        TwoPass := True;
+      end;
+    end
+    else
+      Hints1.ai_family := Family;
+
+    Hints1.ai_socktype := SockType;
+    Hints1.ai_protocol := SockProtocol;
+    Hints2.ai_socktype := Hints1.ai_socktype;
+    Hints2.ai_protocol := Hints1.ai_protocol;
+
+    r := GetAddr(IP, Port, Hints1, Sin1);
+    Result := r;
+    sin := sin1;
+    if r <> 0 then
+      if TwoPass then
+      begin
+        r := GetAddr(IP, Port, Hints2, Sin2);
+        Result := r;
+        if r = 0 then
+          sin := sin2;
+      end;
+  end;
+end;
+
+function GetSinIP(Sin: TVarSin): string;
+var
+  p: PChar;
+  host, serv: string;
+  hostlen, servlen: integer;
+  r: integer;
+begin
+  Result := '';
+  if not IsNewApi(Sin.AddressFamily) then
+  begin
+    p := synsock.inet_ntoa(Sin.sin_addr);
+    if p <> nil then
+      Result := p;
+  end
+  else
+  begin
+    hostlen := NI_MAXHOST;
+    servlen := NI_MAXSERV;
+    setlength(host, hostlen);
+    setlength(serv, servlen);
+    r := getnameinfo(@sin, SizeOfVarSin(sin), PChar(host), hostlen,
+      PChar(serv), servlen, NI_NUMERICHOST + NI_NUMERICSERV);
+    if r = 0 then
+      Result := PChar(host);
+  end;
+end;
+
+function GetSinPort(Sin: TVarSin): Integer;
+begin
+  if (Sin.sin_family = AF_INET6) then
+    Result := synsock.ntohs(Sin.sin6_port)
+  else
+    Result := synsock.ntohs(Sin.sin_port);
+end;
+
+procedure ResolveNameToIP(Name: string; Family, SockProtocol, SockType: integer; const IPList: TStrings);
+type
+  TaPInAddr = array[0..250] of PInAddr;
+  PaPInAddr = ^TaPInAddr;
+var
+  Hints: TAddrInfo;
+  Addr: PAddrInfo;
+  AddrNext: PAddrInfo;
+  r: integer;
+  host, serv: string;
+  hostlen, servlen: integer;
+  RemoteHost: PHostEnt;
+  IP: u_long;
+  PAdrPtr: PaPInAddr;
+  i: Integer;
+  s: string;
+  InAddr: TInAddr;
+begin
+  IPList.Clear;
+  if not IsNewApi(Family) then
+  begin
+    IP := synsock.inet_addr(PChar(Name));
+    if IP = u_long(INADDR_NONE) then
+    begin
+      SynSockCS.Enter;
+      try
+        RemoteHost := synsock.GetHostByName(PChar(Name));
+        if RemoteHost <> nil then
+        begin
+          PAdrPtr := PAPInAddr(RemoteHost^.h_addr_list);
+          i := 0;
+          while PAdrPtr^[i] <> nil do
+          begin
+            InAddr := PAdrPtr^[i]^;
+            s := Format('%d.%d.%d.%d', [InAddr.S_bytes[0], InAddr.S_bytes[1],
+              InAddr.S_bytes[2], InAddr.S_bytes[3]]);
+            IPList.Add(s);
+            Inc(i);
+          end;
+        end;
+      finally
+        SynSockCS.Leave;
+      end;
+    end
+    else
+      IPList.Add(Name);
+  end
+  else
+  begin
+    Addr := nil;
+    try
+      FillChar(Hints, Sizeof(Hints), 0);
+      Hints.ai_family := AF_UNSPEC;
+      Hints.ai_socktype := SockType;
+      Hints.ai_protocol := SockProtocol;
+      Hints.ai_flags := 0;
+      r := synsock.GetAddrInfo(PChar(Name), nil, @Hints, Addr);
+      if r = 0 then
+      begin
+        AddrNext := Addr;
+        while not(AddrNext = nil) do
+        begin
+          if not(((Family = AF_INET6) and (AddrNext^.ai_family = AF_INET))
+            or ((Family = AF_INET) and (AddrNext^.ai_family = AF_INET6))) then
+          begin
+            hostlen := NI_MAXHOST;
+            servlen := NI_MAXSERV;
+            setlength(host, hostlen);
+            setlength(serv, servlen);
+            r := getnameinfo(AddrNext^.ai_addr, AddrNext^.ai_addrlen,
+              PChar(host), hostlen, PChar(serv), servlen,
+              NI_NUMERICHOST + NI_NUMERICSERV);
+            if r = 0 then
+            begin
+              host := PChar(host);
+              IPList.Add(host);
+            end;
+          end;
+          AddrNext := AddrNext^.ai_next;
+        end;
+      end;
+    finally
+      if Assigned(Addr) then
+        synsock.FreeAddrInfo(Addr);
+    end;
+  end;
+  if IPList.Count = 0 then
+    IPList.Add(cAnyHost);
+end;
+
+function ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word;
+var
+  ProtoEnt: PProtoEnt;
+  ServEnt: PServEnt;
+  Hints: TAddrInfo;
+  Addr: PAddrInfo;
+  r: integer;
+begin
+  Result := 0;
+  if not IsNewApi(Family) then
+  begin
+    SynSockCS.Enter;
+    try
+      ProtoEnt := synsock.GetProtoByNumber(SockProtocol);
+      ServEnt := nil;
+      if ProtoEnt <> nil then
+        ServEnt := synsock.GetServByName(PChar(Port), ProtoEnt^.p_name);
+      if ServEnt = nil then
+        Result := StrToIntDef(Port, 0)
+      else
+        Result := synsock.htons(ServEnt^.s_port);
+    finally
+      SynSockCS.Leave;
+    end;
+  end
+  else
+  begin
+    Addr := nil;
+    try
+      FillChar(Hints, Sizeof(Hints), 0);
+      Hints.ai_family := AF_UNSPEC;
+      Hints.ai_socktype := SockType;
+      Hints.ai_protocol := Sockprotocol;
+      Hints.ai_flags := AI_PASSIVE;
+      r := synsock.GetAddrInfo(nil, PChar(Port), @Hints, Addr);
+      if (r = 0) and Assigned(Addr) then
+      begin
+        if Addr^.ai_family = AF_INET then
+          Result := synsock.htons(Addr^.ai_addr^.sin_port);
+        if Addr^.ai_family = AF_INET6 then
+          Result := synsock.htons(PSockAddrIn6(Addr^.ai_addr)^.sin6_port);
+      end;
+    finally
+      if Assigned(Addr) then
+        synsock.FreeAddrInfo(Addr);
+    end;
+  end;
+end;
+
+function ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): string;
+var
+  Hints: TAddrInfo;
+  Addr: PAddrInfo;
+  r: integer;
+  host, serv: string;
+  hostlen, servlen: integer;
+  RemoteHost: PHostEnt;
+  IPn: u_long;
+begin
+  Result := IP;
+  if not IsNewApi(Family) then
+  begin
+    IPn := synsock.inet_addr(PChar(IP));
+    if IPn <> u_long(INADDR_NONE) then
+    begin
+      SynSockCS.Enter;
+      try
+        RemoteHost := GetHostByAddr(@IPn, SizeOf(IPn), AF_INET);
+        if RemoteHost <> nil then
+          Result := RemoteHost^.h_name;
+      finally
+        SynSockCS.Leave;
+      end;
+    end;
+  end
+  else
+  begin
+    Addr := nil;
+    try
+      FillChar(Hints, Sizeof(Hints), 0);
+      Hints.ai_family := AF_UNSPEC;
+      Hints.ai_socktype := SockType;
+      Hints.ai_protocol := SockProtocol;
+      Hints.ai_flags := 0;
+      r := synsock.GetAddrInfo(PChar(IP), nil, @Hints, Addr);
+      if (r = 0) and Assigned(Addr)then
+      begin
+        hostlen := NI_MAXHOST;
+        servlen := NI_MAXSERV;
+        setlength(host, hostlen);
+        setlength(serv, servlen);
+        r := getnameinfo(Addr^.ai_addr, Addr^.ai_addrlen,
+          PChar(host), hostlen, PChar(serv), servlen,
+          NI_NUMERICSERV);
+        if r = 0 then
+          Result := PChar(host);
+      end;
+    finally
+      if Assigned(Addr) then
+        synsock.FreeAddrInfo(Addr);
+    end;
+  end;
+end;
+
 {=============================================================================}
 
 function InitSocketInterface(stack: string): Boolean;

synachar.pas

@@ -65,7 +65,7 @@ unit synachar;
 interface
 
 uses
-{$IFDEF LINUX}
+{$IFNDEF WIN32}
   Libc,
 {$ELSE}
   Windows,
@@ -1469,7 +1469,7 @@ begin
 end;
 
 {==============================================================================}
-{$IFDEF LINUX}
+{$IFNDEF WIN32}
 
 function GetCurCP: TMimeChar;
 begin

synafpc.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.000.000 |
+| Project : Ararat Synapse                                       | 001.001.000 |
 |==============================================================================|
 | Content: Utils for FreePascal compatibility                                  |
 |==============================================================================|
-| Copyright (c)1999-2003, Lukas Gebauer                                        |
+| Copyright (c)1999-2006, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2003.                     |
+| Portions created by Lukas Gebauer are Copyright (c)2003-2006.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -53,56 +53,79 @@ unit synafpc;
 
 interface
 
-{$IFDEF LINUX}
-  {$IFDEF FPC}
 uses
-  Libc,
+{$IFDEF FPC}
-  dynlibs;
+  dynlibs, sysutils;
-
+{$ELSE}
-type
+  {$IFDEF WIN32}
-  HMODULE = Longint;
+  Windows;
-
+  {$ELSE}
-function LoadLibrary(ModuleName: PChar): HMODULE;
+  Sysutils;
-function FreeLibrary(Module: HMODULE): LongBool;
-function GetProcAddress(Module: HMODULE; Proc: PChar): Pointer;
-function GetModuleFileName(Module: HMODULE; Buffer: PChar; BufLen: Integer): Integer;
-procedure Sleep(milliseconds: Cardinal);
-
   {$ENDIF}
 {$ENDIF}
 
+{$IFDEF FPC}
+type
+  TLibHandle = dynlibs.TLibHandle;
+  
+function LoadLibrary(ModuleName: PChar): TLibHandle;
+function FreeLibrary(Module: TLibHandle): LongBool;
+function GetProcAddress(Module: TLibHandle; Proc: PChar): Pointer;
+function GetModuleFileName(Module: TLibHandle; Buffer: PChar; BufLen: Integer): Integer;
+{$ELSE}
+type
+  {$IFDEF CIL}
+  TLibHandle = Integer;
+  {$ELSE}
+  TLibHandle = HModule;
+  {$ENDIF}
+  {$IFDEF VER100}
+  LongWord = DWord;
+  {$ENDIF}
+{$ENDIF}
+
+procedure Sleep(milliseconds: Cardinal);
+
 
 implementation
 
 {==============================================================================}
-{$IFDEF LINUX}
+{$IFDEF FPC}
-  {$IFDEF FPC}
+function LoadLibrary(ModuleName: PChar): TLibHandle;
-function LoadLibrary(ModuleName: PChar): HMODULE;
-begin
-  Result := HMODULE(dynlibs.LoadLibrary(Modulename));
-end;
-
-function FreeLibrary(Module: HMODULE): LongBool;
 begin
-  Result := dynlibs.UnloadLibrary(pointer(Module));
+  Result := dynlibs.LoadLibrary(Modulename);
 end;
 
-function GetProcAddress(Module: HMODULE; Proc: PChar): Pointer;
+function FreeLibrary(Module: TLibHandle): LongBool;
 begin
-  Result := dynlibs.GetProcedureAddress(pointer(Module), Proc);
+  Result := dynlibs.UnloadLibrary(Module);
 end;
 
-function GetModuleFileName(Module: HMODULE; Buffer: PChar; BufLen: Integer): Integer;
+function GetProcAddress(Module: TLibHandle; Proc: PChar): Pointer;
-begin
+begin
-  Result := 0;
+  Result := dynlibs.GetProcedureAddress(Module, Proc);
-end; 
-
-procedure Sleep(milliseconds: Cardinal);
-begin
-  usleep(milliseconds * 1000);  // usleep is in microseconds
 end;
- 
+
-  {$ENDIF}
+function GetModuleFileName(Module: TLibHandle; Buffer: PChar; BufLen: Integer): Integer;
+begin
+  Result := 0;
+end;
+
+{$ELSE}
 {$ENDIF}
 
+procedure Sleep(milliseconds: Cardinal);
+begin
+{$IFDEF WIN32}
+  {$IFDEF FPC}
+  sysutils.sleep(milliseconds);
+  {$ELSE}
+  windows.sleep(milliseconds);
+  {$ENDIF}
+{$ELSE}
+  sysutils.sleep(milliseconds);
+{$ENDIF}
+
+end;
+
 end.

synaicnv.pas

@@ -62,10 +62,8 @@ uses
   System.Runtime.InteropServices,
   System.Text,
 {$ENDIF}
-{$IFDEF LINUX}
-  {$IFDEF FPC}
   synafpc,
-  {$ENDIF}
+{$IFNDEF WIN32}
   Libc, SysUtils;
 {$ELSE}
   Windows;
@@ -73,7 +71,7 @@ uses
 
 
 const
-  {$IFDEF LINUX}
+  {$IFNDEF WIN32}
   DLLIconvName = 'libiconv.so';
   {$ELSE}
   DLLIconvName = 'iconv.dll';
@@ -89,7 +87,7 @@ type
   argptr = iconv_t;
 
 var
-  iconvLibHandle: Integer = 0;
+  iconvLibHandle: TLibHandle = 0;
 
 function SynaIconvOpen(const tocode, fromcode: string): iconv_t;
 function SynaIconvOpenTranslit(const tocode, fromcode: string): iconv_t;

synaip.pas

@@ -0,0 +1,390 @@
+{==============================================================================|
+| Project : Ararat Synapse                                       | 001.000.000 |
+|==============================================================================|
+| Content: IP address support procedures and functions                         |
+|==============================================================================|
+| Copyright (c)2006, Lukas Gebauer                                             |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c) 2006.                    |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@abstract(IP adress support procedures and functions)}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$Q-}
+{$R-}
+{$H+}
+
+unit synaip;
+
+interface
+
+uses
+  SysUtils, SynaUtil;
+
+type
+{:binary form of IPv6 adress (for string conversion routines)}
+  TIp6Bytes = array [0..15] of Byte;
+{:binary form of IPv6 adress (for string conversion routines)}
+  TIp6Words = array [0..7] of Word;
+
+{:Returns @TRUE, if "Value" is a valid IPv4 address. Cannot be a symbolic Name!}
+function IsIP(const Value: string): Boolean;
+
+{:Returns @TRUE, if "Value" is a valid IPv6 address. Cannot be a symbolic Name!}
+function IsIP6(const Value: string): Boolean;
+
+{:Returns a string with the "Host" ip address converted to binary form.}
+function IPToID(Host: string): string;
+
+{:Convert IPv6 address from their string form to binary byte array.}
+function StrToIp6(value: string): TIp6Bytes;
+
+{:Convert IPv6 address from binary byte array to string form.}
+function Ip6ToStr(value: TIp6Bytes): string;
+
+{:Convert IPv4 address from their string form to binary.}
+function StrToIp(value: string): integer;
+
+{:Convert IPv4 address from binary to string form.}
+function IpToStr(value: integer): string;
+
+{:Convert IPv4 address to reverse form.}
+function ReverseIP(Value: AnsiString): AnsiString;
+
+{:Convert IPv6 address to reverse form.}
+function ReverseIP6(Value: AnsiString): AnsiString;
+
+
+implementation
+
+{==============================================================================}
+
+function IsIP(const Value: string): Boolean;
+var
+  TempIP: string;
+  function ByteIsOk(const Value: string): Boolean;
+  var
+    x, n: integer;
+  begin
+    x := StrToIntDef(Value, -1);
+    Result := (x >= 0) and (x < 256);
+    // X may be in correct range, but value still may not be correct value!
+    // i.e. "$80"
+    if Result then
+      for n := 1 to length(Value) do
+        if not (Value[n] in ['0'..'9']) then
+        begin
+          Result := False;
+          Break;
+        end;
+  end;
+begin
+  TempIP := Value;
+  Result := False;
+  if not ByteIsOk(Fetch(TempIP, '.')) then
+    Exit;
+  if not ByteIsOk(Fetch(TempIP, '.')) then
+    Exit;
+  if not ByteIsOk(Fetch(TempIP, '.')) then
+    Exit;
+  if ByteIsOk(TempIP) then
+    Result := True;
+end;
+
+{==============================================================================}
+
+function IsIP6(const Value: string): Boolean;
+var
+  TempIP: string;
+  s,t: string;
+  x: integer;
+  partcount: integer;
+  zerocount: integer;
+  First: Boolean;
+begin
+  TempIP := Value;
+  Result := False;
+  if Value = '::' then
+  begin
+    Result := True;
+    Exit;
+  end;
+  partcount := 0;
+  zerocount := 0;
+  First := True;
+  while tempIP <> '' do
+  begin
+    s := fetch(TempIP, ':');
+    if not(First) and (s = '') then
+      Inc(zerocount);
+    First := False;
+    if zerocount > 1 then
+      break;
+    Inc(partCount);
+    if s = '' then
+      Continue;
+    if partCount > 8 then
+      break;
+    if tempIP = '' then
+    begin
+      t := SeparateRight(s, '%');
+      s := SeparateLeft(s, '%');
+      x := StrToIntDef('$' + t, -1);
+      if (x < 0) or (x > $ffff) then
+        break;
+    end;
+    x := StrToIntDef('$' + s, -1);
+    if (x < 0) or (x > $ffff) then
+      break;
+    if tempIP = '' then
+      if not((PartCount = 1) and (ZeroCount = 0)) then
+        Result := True;
+  end;
+end;
+
+{==============================================================================}
+function IPToID(Host: string): string;
+var
+  s: string;
+  i, x: Integer;
+begin
+  Result := '';
+  for x := 0 to 3 do
+  begin
+    s := Fetch(Host, '.');
+    i := StrToIntDef(s, 0);
+    Result := Result + Chr(i);
+  end;
+end;
+
+{==============================================================================}
+
+function StrToIp(value: string): integer;
+var
+  s: string;
+  i, x: Integer;
+begin
+  Result := 0;
+  for x := 0 to 3 do
+  begin
+    s := Fetch(value, '.');
+    i := StrToIntDef(s, 0);
+    Result := (256 * Result) + i;
+  end;
+end;
+
+{==============================================================================}
+
+function IpToStr(value: integer): string;
+var
+  x1, x2: word;
+  y1, y2: byte;
+begin
+  Result := '';
+  x1 := value div $10000;
+  x2 := value mod $10000;
+  y1 := x1 div $100;
+  y2 := x1 mod $100;
+  Result := inttostr(y1) + '.' + inttostr(y2) + '.';
+  y1 := x2 div $100;
+  y2 := x2 mod $100;
+  Result := Result + inttostr(y1) + '.' + inttostr(y2);
+end;
+
+{==============================================================================}
+
+function StrToIp6(Value: string): TIp6Bytes;
+var
+ IPv6: TIp6Words;
+ Index: Integer;
+ ZeroAt: Integer;
+ n: integer;
+ b1, b2: byte;
+ s: string;
+ x: integer;
+begin
+  for n := 0 to 15 do
+    Result[n] := 0;
+  for n := 0 to 7 do
+    Ipv6[n] := 0;
+  Index := 0;
+  ZeroAt := -1;
+
+  while Value <> '' do
+  begin
+    if Index > 7 then
+      Exit;
+    s := fetch(value, ':');
+    if s = '@' then
+      break;
+    if s = '' then
+    begin
+      ZeroAt := Index;
+      IPv6[Index] := 0;
+    end
+    else
+    begin
+      x := StrToIntDef('$' + s, -1);
+      if (x > 65535) or (x < 0) then
+        Exit;
+      IPv6[Index] := x;
+    end;
+    Inc(Index);
+  end;
+  if ZeroAt >= 0 then
+  Begin
+    x := Index - ZeroAt - 1;
+    for n := 1 to x do
+      IPv6[7 - n + 1] := Ipv6[ZeroAt + x - 1 + n];
+    for n := ZeroAt + 1 to Index - 1 do
+      IPv6[n] := 0;
+  End;
+  for n := 0 to 7 do
+  begin
+    b1 := ipv6[n] div 256;
+    b2 := ipv6[n] mod 256;
+    Result[n * 2] := b1;
+    Result[(n * 2) + 1] := b2;
+  end;
+end;
+
+{==============================================================================}
+//based on routine by the Free Pascal development team
+function Ip6ToStr(value: TIp6Bytes): string;
+var
+  i, x: byte;
+  zr1,zr2: set of byte;
+  zc1,zc2: byte;
+  have_skipped: boolean;
+  ip6w: TIp6words;
+begin
+  zr1 := [];
+  zr2 := [];
+  zc1 := 0;
+  zc2 := 0;
+  for i := 0 to 7 do
+  begin
+    x := i * 2;
+    ip6w[i] := value[x] * 256 + value[x + 1];
+    if ip6w[i] = 0 then
+    begin
+      include(zr2, i);
+      inc(zc2);
+    end
+    else
+    begin
+      if zc1 < zc2 then
+      begin
+        zc1 := zc2;
+        zr1 := zr2;
+        zc2 := 0;
+        zr2 := [];
+      end;
+    end;
+  end;
+  if zc1 < zc2 then
+  begin
+    zr1 := zr2;
+  end;
+  SetLength(Result, 8*5-1);
+  SetLength(Result, 0);
+  have_skipped := false;
+  for i := 0 to 7 do
+  begin
+    if not(i in zr1) then
+    begin
+      if have_skipped then
+      begin
+        if Result = '' then
+          Result := '::'
+        else
+          Result := Result + ':';
+        have_skipped := false;
+      end;
+      Result := Result + IntToHex(Ip6w[i], 1) + ':';
+    end
+    else
+    begin
+      have_skipped := true;
+    end;
+  end;
+  if have_skipped then
+    if Result = '' then
+      Result := '::0'
+    else
+      Result := Result + ':';
+
+  if Result = '' then
+    Result := '::0';
+  if not (7 in zr1) then
+    SetLength(Result, Length(Result)-1);
+  Result := LowerCase(result);
+end;
+
+{==============================================================================}
+function ReverseIP(Value: AnsiString): AnsiString;
+var
+  x: Integer;
+begin
+  Result := '';
+  repeat
+    x := LastDelimiter('.', Value);
+    Result := Result + '.' + Copy(Value, x + 1, Length(Value) - x);
+    Delete(Value, x, Length(Value) - x + 1);
+  until x < 1;
+  if Length(Result) > 0 then
+    if Result[1] = '.' then
+      Delete(Result, 1, 1);
+end;
+
+{==============================================================================}
+function ReverseIP6(Value: AnsiString): AnsiString;
+var
+  ip6: TIp6bytes;
+  n: integer;
+begin
+  ip6 := StrToIP6(Value);
+  Result := char(ip6[15]);
+  for n := 14 downto 0 do
+    Result := Result + '.' + char(ip6[n]);
+end;
+
+{==============================================================================}
+end.

synamisc.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.001.003 |
+| Project : Ararat Synapse                                       | 001.001.004 |
 |==============================================================================|
 | Content: misc. procedures and functions                                      |
 |==============================================================================|
@@ -67,9 +67,6 @@ uses
 {$IFDEF LINUX}
   Libc;
 {$ELSE}
-{$IFDEF FPC}
-  winver,
-{$ENDIF}
   Windows;
 {$ENDIF}
 

synautil.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 004.008.001 |
+| Project : Ararat Synapse                                       | 004.010.001 |
 |==============================================================================|
 | Content: support procedures and functions                                    |
 |==============================================================================|
-| Copyright (c)1999-2004, Lukas Gebauer                                        |
+| Copyright (c)1999-2005, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c) 1999-2004.               |
+| Portions created by Lukas Gebauer are Copyright (c) 1999-2005.               |
 | Portions created by Hernan Sanchez are Copyright (c) 2000.                   |
 | All Rights Reserved.                                                         |
 |==============================================================================|
@@ -58,15 +58,19 @@ unit synautil;
 interface
 
 uses
-{$IFDEF LINUX}
+{$IFDEF WIN32}
-  Libc,
-{$ELSE}
   Windows,
+{$ELSE}
+  {$IFDEF FPC}
+  UnixUtil, Unix, BaseUnix,
+  {$ELSE}
+  Libc,
+  {$ENDIF}
 {$ENDIF}
 {$IFDEF CIL}
   System.IO,
 {$ENDIF}
-  SysUtils, Classes;
+  SysUtils, Classes, SynaFpc;
 
 {:Return your timezone bias from UTC time in minutes.}
 function TimeZoneBias: integer;
@@ -131,11 +135,11 @@ function SetUTTime(Newdt: TDateTime): Boolean;
 
 {:Return current value of system timer with precizion 1 millisecond. Good for
  measure time difference.}
-function GetTick: ULong;
+function GetTick: LongWord;
 
 {:Return difference between two timestamps. It working fine only for differences
  smaller then maxint. (difference must be smaller then 24 days.)}
-function TickDelta(TickOld, TickNew: ULong): ULong;
+function TickDelta(TickOld, TickNew: LongWord): LongWord;
 
 {:Return two characters, which ordinal values represents the value in byte
  format. (High-endian)}
@@ -153,15 +157,6 @@ function CodeLongInt(Value: LongInt): Ansistring;
  string to LongInt values.}
 function DecodeLongInt(const Value: Ansistring; Index: Integer): LongInt;
 
-{:Returns @TRUE, if "Value" is a valid IPv4 address. Cannot be a symbolic Name!}
-function IsIP(const Value: string): Boolean;
-
-{:Returns @TRUE, if "Value" is a valid IPv6 address. Cannot be a symbolic Name!}
-function IsIP6(const Value: string): Boolean;
-
-{:Returns a string with the "Host" ip address converted to binary form.}
-function IPToID(Host: string): string;
-
 {:Dump binary buffer stored in a string to a result string.}
 function DumpStr(const Buffer: Ansistring): string;
 
@@ -341,19 +336,18 @@ var
 {==============================================================================}
 
 function TimeZoneBias: integer;
-{$IFDEF LINUX}
+{$IFNDEF WIN32}
+{$IFNDEF FPC}
 var
   t: TTime_T;
   UT: TUnixTime;
 begin
-{$IFNDEF FPC}
   __time(@T);
   localtime_r(@T, UT);
   Result := ut.__tm_gmtoff div 60;
 {$ELSE}
-  __time(T);
+begin
-  localtime_r(T, UT);
+  Result := TZSeconds div 60;
-  Result := ut.tm_gmtoff div 60;
 {$ENDIF}
 {$ELSE}
 var
@@ -688,7 +682,7 @@ end;
 {==============================================================================}
 
 function GetUTTime: TDateTime;
-{$IFNDEF LINUX}
+{$IFDEF WIN32}
 {$IFNDEF FPC}
 var
   st: TSystemTime;
@@ -711,23 +705,26 @@ begin
   result := SystemTimeToDateTime(st);
 {$ENDIF}
 {$ELSE}
+{$IFNDEF FPC}
 var
   TV: TTimeVal;
-  TZ: Ttimezone;
-  PZ: PTimeZone;
 begin
-  TZ.tz_minuteswest := 0;
+  gettimeofday(TV, nil);
-  TZ.tz_dsttime := 0;
-  PZ := @TZ;
-  gettimeofday(TV, PZ);
   Result := UnixDateDelta + (TV.tv_sec + TV.tv_usec / 1000000) / 86400;
+{$ELSE}
+var
+  TV: TimeVal;
+begin
+  fpgettimeofday(@TV, nil);
+  Result := UnixDateDelta + (TV.tv_sec + TV.tv_usec / 1000000) / 86400;
+{$ENDIF}
 {$ENDIF}
 end;
 
 {==============================================================================}
 
 function SetUTTime(Newdt: TDateTime): Boolean;
-{$IFNDEF LINUX}
+{$IFDEF WIN32}
 {$IFNDEF FPC}
 var
   st: TSystemTime;
@@ -750,6 +747,7 @@ begin
   Result := SetSystemTime(stw);
 {$ENDIF}
 {$ELSE}
+{$IFNDEF FPC}
 var
   TV: TTimeVal;
   d: double;
@@ -764,13 +762,23 @@ begin
   TV.tv_sec := trunc(d);
   TV.tv_usec := trunc(frac(d) * 1000000);
   Result := settimeofday(TV, TZ) <> -1;
+{$ELSE}
+var
+  TV: TimeVal;
+  d: double;
+begin
+  d := (newdt - UnixDateDelta) * 86400;
+  TV.tv_sec := trunc(d);
+  TV.tv_usec := trunc(frac(d) * 1000000);
+  Result := fpsettimeofday(@TV, nil) <> -1;
+{$ENDIF}
 {$ENDIF}
 end;
 
 {==============================================================================}
 
-{$IFDEF LINUX}
+{$IFNDEF WIN32}
-function GetTick: ULong;
+function GetTick: LongWord;
 var
   Stamp: TTimeStamp;
 begin
@@ -778,15 +786,31 @@ begin
   Result := Stamp.Time;
 end;
 {$ELSE}
-function GetTick: ULong;
+function GetTick: LongWord;
+var
+  tick, freq: TLargeInteger;
+{$IFDEF VER100}
+  x: TLargeInteger;
+{$ENDIF}
 begin
-  Result := Windows.GetTickCount;
+  if Windows.QueryPerformanceFrequency(freq) then
+  begin
+    Windows.QueryPerformanceCounter(tick);
+{$IFDEF VER100}
+    x.QuadPart := (tick.QuadPart / freq.QuadPart) * 1000;
+    Result := x.LowPart;
+{$ELSE}
+    Result := Trunc((tick / freq) * 1000) and High(LongWord)
+{$ENDIF}
+  end
+  else
+    Result := Windows.GetTickCount;
 end;
 {$ENDIF}
 
 {==============================================================================}
 
-function TickDelta(TickOld, TickNew: ULong): ULong;
+function TickDelta(TickOld, TickNew: LongWord): LongWord;
 begin
 //if DWord is signed type (older Deplhi),
 // then it not work properly on differencies larger then maxint!
@@ -795,8 +819,8 @@ begin
   begin
     if TickNew < TickOld then
     begin
-      TickNew := TickNew + ULong(MaxInt) + 1;
+      TickNew := TickNew + LongWord(MaxInt) + 1;
-      TickOld := TickOld + ULong(MaxInt) + 1;
+      TickOld := TickOld + LongWord(MaxInt) + 1;
     end;
     Result := TickNew - TickOld;
     if TickNew < TickOld then
@@ -876,103 +900,6 @@ end;
 
 {==============================================================================}
 
-function IsIP(const Value: string): Boolean;
-var
-  TempIP: string;
-  function ByteIsOk(const Value: string): Boolean;
-  var
-    x, n: integer;
-  begin
-    x := StrToIntDef(Value, -1);
-    Result := (x >= 0) and (x < 256);
-    // X may be in correct range, but value still may not be correct value!
-    // i.e. "$80"
-    if Result then
-      for n := 1 to length(Value) do
-        if not (Value[n] in ['0'..'9']) then
-        begin
-          Result := False;
-          Break;
-        end;
-  end;
-begin
-  TempIP := Value;
-  Result := False;
-  if not ByteIsOk(Fetch(TempIP, '.')) then
-    Exit;
-  if not ByteIsOk(Fetch(TempIP, '.')) then
-    Exit;
-  if not ByteIsOk(Fetch(TempIP, '.')) then
-    Exit;
-  if ByteIsOk(TempIP) then
-    Result := True;
-end;
-
-{==============================================================================}
-
-function IsIP6(const Value: string): Boolean;
-var
-  TempIP: string;
-  s,t: string;
-  x: integer;
-  partcount: integer;
-  zerocount: integer;
-  First: Boolean;
-begin
-  TempIP := Value;
-  Result := False;
-  partcount := 0;
-  zerocount := 0;
-  First := True;
-  while tempIP <> '' do
-  begin
-    s := fetch(TempIP, ':');
-    if not(First) and (s = '') then
-      Inc(zerocount);
-    First := False;
-    if zerocount > 1 then
-      break;
-    Inc(partCount);
-    if s = '' then
-      Continue;
-    if partCount > 8 then
-      break;
-    if tempIP = '' then
-    begin
-      t := SeparateRight(s, '%');
-      s := SeparateLeft(s, '%');
-      x := StrToIntDef('$' + t, -1);
-      if (x < 0) or (x > $ffff) then
-        break;
-    end;
-    x := StrToIntDef('$' + s, -1);
-    if (x < 0) or (x > $ffff) then
-      break;
-    if tempIP = '' then
-      Result := True;
-  end;
-end;
-
-{==============================================================================}
-//Hernan Sanchez
-function IPToID(Host: string): string;
-var
-  s: string;
-  i, x: Integer;
-begin
-  Result := '';
-  for x := 1 to 3 do
-  begin
-    s := Fetch(Host, '.');
-    i := StrToIntDef(s, 0);
-    Result := Result + Chr(i);
-  end;
-  i := StrToIntDef(Host, 0);
-  Result := Result + Chr(i);
-end;
-
-{==============================================================================}
-
 function DumpStr(const Buffer: Ansistring): string;
 var
   n: Integer;
@@ -1040,6 +967,9 @@ function TrimSPLeft(const S: string): string;
 var
   I, L: Integer;
 begin
+  Result := '';
+  if S = '' then
+    Exit;
   L := Length(S);
   I := 1;
   while (I <= L) and (S[I] = ' ') do
@@ -1053,6 +983,9 @@ function TrimSPRight(const S: string): string;
 var
   I: Integer;
 begin
+  Result := '';
+  if S = '' then
+    Exit;
   I := Length(S);
   while (I > 0) and (S[I] = ' ') do
     Dec(I);
@@ -1471,38 +1404,26 @@ end;
 
 function PosCRLF(const Value: AnsiString; var Terminator: AnsiString): integer;
 var
-  p1, p2, p3, p4: integer;
+  n, l: integer;
-const
-  t1 = #$0d + #$0a;
-  t2 = #$0a + #$0d;
-  t3 = #$0d;
-  t4 = #$0a;
 begin
+  Result := -1;
   Terminator := '';
-  p1 := Pos(t1, Value);
+  l := length(value);
-  p2 := Pos(t2, Value);
+  for n := 1 to l do
-  p3 := Pos(t3, Value);
+    if value[n] in [#$0d, #$0a] then
-  p4 := Pos(t4, Value);
-  if p1 > 0 then
-    Terminator := t1;
-  Result := p1;
-  if (p2 > 0) then
-    if (Result = 0) or (p2 < Result) then
     begin
-      Result := p2;
+      Result := n;
-      Terminator := t2;
+      Terminator := Value[n];
-    end;
+      if n <> l then
-  if (p3 > 0) then
+        case value[n] of
-    if (Result = 0) or (p3 < Result) then
+          #$0d:
-    begin
+            if value[n + 1] = #$0a then
-      Result := p3;
+              Terminator := #$0d + #$0a;
-      Terminator := t3;
+          #$0a:
-    end;
+            if value[n + 1] = #$0d then
-  if (p4 > 0) then
+              Terminator := #$0a + #$0d;
-    if (Result = 0) or (p4 < Result) then
+        end;
-    begin
+      Break;
-      Result := p4;
-      Terminator := t4;
     end;
 end;
 
@@ -1553,7 +1474,7 @@ end;
 {$IFNDEF CIL}
 function IncPoint(const p: pointer; Value: integer): pointer;
 begin
-  Result := pointer(integer(p) + Value);
+  Result := PChar(p) + Value;
 end;
 {$ENDIF}
 
@@ -1686,7 +1607,7 @@ end;
 
 procedure HeadersToList(const Value: TStrings);
 var
-  n, x: integer;
+  n, x, y: integer;
   s: string;
 begin
   for n := 0 to Value.Count -1 do
@@ -1695,8 +1616,12 @@ begin
     x := Pos(':', s);
     if x > 0 then
     begin
-      s[x] := '=';
+      y:= Pos('=',s); 
-      Value[n] := s;
+      if not ((y > 0) and (y < x)) then
+      begin
+        s[x] := '=';
+        Value[n] := s;
+      end;
     end;
   end;
 end;
@@ -1775,7 +1700,7 @@ end;
 {==============================================================================}
 function GetTempFile(const Dir, prefix: AnsiString): AnsiString;
 {$IFNDEF FPC}
-{$IFNDEF LINUX}
+{$IFDEF WIN32}
 var
   Path: AnsiString;
   x: integer;
@@ -1785,7 +1710,7 @@ begin
 {$IFDEF FPC}
   Result := GetTempFileName(Dir, Prefix);
 {$ELSE}
-  {$IFDEF LINUX}
+  {$IFNDEF WIN32}
     Result := tempnam(Pointer(Dir), Pointer(prefix));
   {$ELSE}
     {$IFDEF CIL}

synsock.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 005.000.000 |
+| Project : Ararat Synapse                                       | 005.001.000 |
 |==============================================================================|
 | Content: Socket Independent Platform Layer                                   |
 |==============================================================================|
@@ -52,13 +52,16 @@ unit synsock;
   {$I ssdotnet.pas}
 {$ENDIF}
 
-{$IFDEF LINUX}
-  {$I sslinux.pas}
-{$ENDIF}
-
 {$IFDEF WIN32}
   {$I sswin32.pas}
+{$ELSE}
+  {$IFDEF FPC}
+    {$I ssfpc.pas}
+  {$ELSE}
+    {$I sslinux.pas}
+  {$ENDIF}
 {$ENDIF}
 
+
 end.
 

winver.pp

@@ -1,76 +0,0 @@
-{
-    $Id: header,v 1.1.2.1 2003/01/05 20:47:31 michael Exp $
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 2003 by the Free Pascal development team
-
-    Windows Version detection functionality.
-    
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{$mode objfpc}
-unit winver;
-
-Interface
-
-Uses Windows;
-
-const  
-  Win32Platform     : Integer = 0;
-  Win32MajorVersion : Integer = 0;
-  Win32MinorVersion : Integer = 0;
-  Win32BuildNumber  : Integer = 0;
-                          
-  Win32CSDVersion   : string = '';
- 
-function CheckWin32Version(Major,Minor : Integer ): Boolean;
-function CheckWin32Version(Major : Integer): Boolean;
-
-Implementation
-
-
-uses sysutils;
-
-procedure InitVersion;
-
-var
-  Info: TOSVersionInfo;
-  
-begin
-  Info.dwOSVersionInfoSize := SizeOf(Info);
-  if GetVersionEx(Info) then
-    with Info do
-      begin
-      Win32Platform:=dwPlatformId;
-      Win32MajorVersion:=dwMajorVersion;
-      Win32MinorVersion:=dwMinorVersion;
-      if (Win32Platform=VER_PLATFORM_WIN32_WINDOWS) then
-        Win32BuildNumber:=dwBuildNumber and $FFFF
-      else
-        Win32BuildNumber := dwBuildNumber;
-      Win32CSDVersion := StrPas(szCSDVersion);
-      end;
-end;
-
-function CheckWin32Version(Major : Integer): Boolean;
-
-begin
-  Result:=CheckWin32Version(Major,0)
-end;
-
-function CheckWin32Version(Major,Minor: Integer): Boolean;
-
-begin
-  Result := (Win32MajorVersion>Major) or
-            ((Win32MajorVersion=Major) and (Win32MinorVersion>=Minor));
-end;
-
-initialization
-  InitVersion;
-end.