Release 32

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

asn1util.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.003.006 |
+| Project : Ararat Synapse                                       | 001.004.002 |
 |==============================================================================|
 | Content: support for ASN.1 BER coding and decoding                           |
 |==============================================================================|
@@ -45,20 +45,27 @@
 |==============================================================================}
 
 {$Q-}
+{$H+}
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
 
-unit ASN1Util;
+unit asn1util;
 
 interface
 
 uses
-  SysUtils;
+  SysUtils, Classes;
 
 const
+  ASN1_BOOL = $01;
   ASN1_INT = $02;
   ASN1_OCTSTR = $04;
   ASN1_NULL = $05;
   ASN1_OBJID = $06;
+  ASN1_ENUM = $0a;
   ASN1_SEQ = $30;
+  ASN1_SETOF = $31;
   ASN1_IPADDR = $40;
   ASN1_COUNTER = $41;
   ASN1_GAUGE = $42;
@@ -77,6 +84,7 @@ function ASNItem(var Start: Integer; const Buffer: string;
 function MibToId(Mib: string): string;
 function IdToMib(const Id: string): string;
 function IntMibToStr(const Value: string): string;
+function ASNdump(const Value: string): string;
 
 implementation
 
@@ -233,10 +241,11 @@ begin
   if (Start + ASNSize - 1) > l then
     Exit;
   if (ASNType and $20) > 0 then
-    Result := '$' + IntToHex(ASNType, 2)
+//    Result := '$' + IntToHex(ASNType, 2)
+    Result := Copy(Buffer, Start, ASNSize)
   else
     case ASNType of
-      ASN1_INT:
+      ASN1_INT, ASN1_ENUM, ASN1_BOOL:
         begin
           y := 0;
           neg := False;
@@ -297,10 +306,20 @@ begin
           end;
           Result := s;
         end;
-    else // NULL
+      ASN1_NULL:
+        begin
+          Result := '';
+          Start := Start + ASNSize;
+        end;
+    else // unknown
       begin
-        Result := '';
+        for n := 1 to ASNSize do
-        Start := Start + ASNSize;
+        begin
+          c := Char(Buffer[Start]);
+          Inc(Start);
+          s := s + c;
+        end;
+        Result := s;
       end;
     end;
 end;
@@ -372,6 +391,75 @@ begin
   Result := IntToStr(y);
 end;
 
+{==============================================================================}
+function ASNdump(const Value: string): string;
+var
+  i, at, x, n: integer;
+  s, indent: string;
+  il: TStringList;
+begin
+  il := TStringList.Create;
+  try
+    Result := '';
+    i := 1;
+    indent := '';
+    while i < Length(Value) do
+    begin
+      for n := il.Count - 1 downto 0 do
+      begin
+        x := StrToIntDef(il[n], 0);
+        if x <= i then
+        begin
+          il.Delete(n);
+          Delete(indent, 1, 2);
+        end;
+      end;
+      s := ASNItem(i, Value, at);
+      Result := Result + indent + '$' + IntToHex(at, 2);
+      if (at and $20) > 0 then
+      begin
+        x := Length(s);
+        Result := Result + ' constructed: length ' + IntToStr(x);
+        indent := indent + '  ';
+        il.Add(IntToStr(x + i - 1));
+      end
+      else
+      begin
+        case at of
+          ASN1_BOOL:
+            Result := Result + ' BOOL: ';
+          ASN1_INT:
+            Result := Result + ' INT: ';
+          ASN1_ENUM:
+            Result := Result + ' ENUM: ';
+          ASN1_COUNTER:
+            Result := Result + ' COUNTER: ';
+          ASN1_GAUGE:
+            Result := Result + ' GAUGE: ';
+          ASN1_TIMETICKS:
+            Result := Result + ' TIMETICKS: ';
+          ASN1_OCTSTR:
+            Result := Result + ' OCTSTR: ';
+          ASN1_OPAQUE:
+            Result := Result + ' OPAQUE: ';
+          ASN1_OBJID:
+            Result := Result + ' OBJID: ';
+          ASN1_IPADDR:
+            Result := Result + ' IPADDR: ';
+          ASN1_NULL:
+            Result := Result + ' NULL: ';
+        else // other
+          Result := Result + ' unknown: ';
+        end;
+        Result := Result + s;
+      end;
+      Result := Result + #$0d + #$0a;
+    end;
+  finally
+    il.Free;
+  end;
+end;
+
 {==============================================================================}
 
 end.

dnssend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.002.002 |
+| Project : Ararat Synapse                                       | 002.003.004 |
 |==============================================================================|
 | Content: DNS client                                                          |
 |==============================================================================|
@@ -44,15 +44,19 @@
 
 // RFC-1035, RFC-1183, RFC1706, RFC1712, RFC2163, RFC2230
 
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
 {$Q-}
+{$H+}
 
-unit DNSsend;
+unit dnssend;
 
 interface
 
 uses
   SysUtils, Classes,
-  blcksock, SynaUtil, synsock;
+  blcksock, synautil, synsock;
 
 const
   cDnsProtocol = 'domain';
@@ -89,7 +93,7 @@ const
   QTYPE_LOC = 29; // RFC-1876
   QTYPE_NXT = 30; // RFC-2065
 
-  QTYPE_SRV = 33; // RFC-2052
+  QTYPE_SRV = 33;
   QTYPE_NAPTR = 35; // RFC-2168
   QTYPE_KX = 36;
 
@@ -294,7 +298,7 @@ function TDNSSend.DecodeResource(var i: Integer; const Info: TStringList;
   QType: Integer): string;
 var
   Rname: string;
-  RType, Len, j, x, n: Integer;
+  RType, Len, j, x, y, z, n: Integer;
   R: string;
   t1, t2, ttl: integer;
   ip6: TSockAddrIn6;
@@ -313,7 +317,7 @@ begin
   Inc(i, 2); // i point to begin of data
   j := i;
   i := i + len; // i point to next record
-  if Length(FBuffer) >= i then
+  if Length(FBuffer) >= (i - 1) then
     case RType of
       QTYPE_A:
         begin
@@ -401,6 +405,20 @@ begin
           R := R + ',' + DecodeLabels(j);
           R := R + ',' + DecodeLabels(j);
         end;
+      QTYPE_SRV:
+      // Author: Dan <ml@mutox.org>
+        begin
+          x := DecodeInt(FBuffer, j);
+          Inc(j, 2);
+          y := DecodeInt(FBuffer, j);
+          Inc(j, 2);
+          z := DecodeInt(FBuffer, j);
+          Inc(j, 2);
+          R := IntToStr(x);                     // Priority
+          R := R + ',' + IntToStr(y);           // Weight
+          R := R + ',' + IntToStr(z);           // Port
+          R := R + ',' + DecodeLabels(j);       // Server DNS Name
+        end;
     end;
   if R <> '' then
     Info.Add(RName + ',' + IntToStr(RType) + ',' + IntToStr(ttl) + ',' + R);
@@ -433,6 +451,7 @@ begin
   FAuthoritative := False;
   if (Length(Buf) > 13) and (FID = DecodeInt(Buf, 1)) then
   begin
+    Result := True;
     flag := DecodeInt(Buf, 3);
     FRCode := Flag and $000F;
     FAuthoritative := (Flag and $0400) > 0;
@@ -463,7 +482,6 @@ begin
       if (arcount > 0) and (Length(Buf) > i) then // decode additional info
         for n := 1 to arcount do
           DecodeResource(i, FAdditionalInfo, QType);
-      Result := True;
     end;
   end;
 end;

ftpsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.006.006 |
+| Project : Ararat Synapse                                       | 002.007.000 |
 |==============================================================================|
 | Content: FTP client                                                          |
 |==============================================================================|
@@ -43,13 +43,23 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
-unit FTPsend;
+// RFC-959, RFC-2228, RFC-2428
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+unit ftpsend;
 
 interface
 
 uses
   SysUtils, Classes,
-  blcksock, SynaUtil, SynaCode;
+  {$IFDEF STREAMSEC}
+  TlsInternalServer, TlsSynaSock,
+  {$ENDIF}
+  blcksock, synautil, synacode;
 
 const
   cFtpProtocol = 'ftp';
@@ -88,8 +98,14 @@ type
   TFTPSend = class(TSynaClient)
   private
     FOnStatus: TFTPStatus;
+    {$IFDEF STREAMSEC}
+    FSock: TSsTCPBlockSocket;
+    FDSock: TSsTCPBlockSocket;
+    FTLSServer: TCustomTLSInternalServer;
+    {$ELSE}
     FSock: TTCPBlockSocket;
     FDSock: TTCPBlockSocket;
+    {$ENDIF}
     FResultCode: Integer;
     FResultString: string;
     FFullResult: TStringList;
@@ -113,6 +129,8 @@ type
     FBinaryMode: Boolean;
     FAutoTLS: Boolean;
     FIsTLS: Boolean;
+    FIsDataTLS: Boolean;
+    FTLSonData: Boolean;
     FFullSSL: Boolean;
     function Auth(Mode: integer): Boolean;
     function Connect: Boolean;
@@ -160,8 +178,14 @@ type
     property FWUsername: string read FFWUsername Write FFWUsername;
     property FWPassword: string read FFWPassword Write FFWPassword;
     property FWMode: integer read FFWMode Write FFWMode;
+{$IFDEF STREAMSEC}
+    property Sock: TSsTCPBlockSocket read FSock;
+    property DSock: TSsTCPBlockSocket read FDSock;
+    property TLSServer: TCustomTLSInternalServer read FTLSServer write FTLSServer;
+{$ELSE}
     property Sock: TTCPBlockSocket read FSock;
     property DSock: TTCPBlockSocket read FDSock;
+{$ENDIF}
     property DataStream: TMemoryStream read FDataStream;
     property DataIP: string read FDataIP;
     property DataPort: string read FDataPort;
@@ -176,6 +200,8 @@ type
     property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
     property FullSSL: Boolean read FFullSSL Write FFullSSL;
     property IsTLS: Boolean read FIsTLS;
+    property IsDataTLS: Boolean read FIsDataTLS;
+    property TLSonData: Boolean read FTLSonData write FTLSonData;
   end;
 
 function FtpGetFile(const IP, Port, FileName, LocalFile,
@@ -193,9 +219,18 @@ begin
   inherited Create;
   FFullResult := TStringList.Create;
   FDataStream := TMemoryStream.Create;
+{$IFDEF STREAMSEC}
+  FTLSServer := GlobalTLSInternalServer;
+  FSock := TSsTCPBlockSocket.Create;
+  FSock.BlockingRead := True;
+  FSock.ConvertLineEnd := True;
+  FDSock := TSsTCPBlockSocket.Create;
+  FDSock.BlockingRead := True;
+{$ELSE}
   FSock := TTCPBlockSocket.Create;
   FSock.ConvertLineEnd := True;
   FDSock := TTCPBlockSocket.Create;
+{$ENDIF}
   FFtpList := TFTPList.Create;
   FTimeout := 300000;
   FTargetPort := cFtpProtocol;
@@ -214,6 +249,8 @@ begin
   FAutoTLS := False;
   FFullSSL := False;
   FIsTLS := False;
+  FIsDataTLS := False;
+  FTLSonData := True;
 end;
 
 destructor TFTPSend.Destroy;
@@ -447,8 +484,23 @@ function TFTPSend.Connect: Boolean;
 begin
   FSock.CloseSocket;
   FSock.Bind(FIPInterface, cAnyPort);
+{$IFDEF STREAMSEC}
+  if FFullSSL then
+  begin
+    if assigned(FTLSServer) then
+      FSock.TLSServer := FTLSServer
+    else
+    begin
+      result := False;
+      Exit;
+    end;
+  end
+  else
+    FSock.TLSServer := nil;
+{$ELSE}
   if FFullSSL then
     FSock.SSLEnabled := True;
+{$ENDIF}
   if FSock.LastError = 0 then
     if FFWHost = '' then
       FSock.Connect(FTargetHost, FTargetPort)
@@ -464,19 +516,37 @@ begin
   if not Connect then
     Exit;
   FIsTLS := FFullSSL;
+  FIsDataTLS := False;
   if (ReadResult div 100) <> 2 then
     Exit;
   if FAutoTLS and not(FIsTLS) then
     if (FTPCommand('AUTH TLS') div 100) = 2 then
     begin
+{$IFDEF STREAMSEC}
+      if Assigned(FTLSServer) then
+      begin
+        Fsock.TLSServer := FTLSServer;
+        Fsock.Connect('','');
+        FIsTLS := FSock.LastError = 0;
+      end
+      else
+        Result := False;
+{$ELSE}
       FSock.SSLDoConnect;
-      FIsTLS := True;
+      FIsTLS := FSock.LastError = 0;
+      FDSock.SSLCertificateFile := FSock.SSLCertificateFile;
+      FDSock.SSLPrivateKeyFile := FSock.SSLPrivateKeyFile;
+      FDSock.SSLCertCAFile := FSock.SSLCertCAFile;
+{$ENDIF}
     end;
   if not Auth(FFWMode) then
     Exit;
   if FIsTLS then
   begin
-    FTPCommand('PROT P');
+    if FTLSonData then
+      FIsDataTLS := (FTPCommand('PROT P') div 100) = 2;
+    if not FIsDataTLS then
+      FTPCommand('PROT C');
     FTPCommand('PBSZ 0');
   end;
   FTPCommand('TYPE I');
@@ -627,8 +697,22 @@ begin
       Result := True;
     end;
   end;
-  if FIsTLS then
+  if Result and FIsDataTLS then
+  begin
+{$IFDEF STREAMSEC}
+    if Assigned(FTLSServer) then
+    begin
+      FDSock.TLSServer := FTLSServer;
+      FDSock.Connect('','');
+      Result := FDSock.LastError = 0;
+    end
+    else
+      Result := False;
+{$ELSE}
     FDSock.SSLDoConnect;
+    Result := FDSock.LastError = 0;
+{$ENDIF}
+  end;
 end;
 
 function TFTPSend.DataRead(const DestStream: TStream): Boolean;
@@ -908,7 +992,7 @@ end;
 
 procedure TFTPSend.Abort;
 begin
-  FDSock.CloseSocket;
+  FDSock.AbortSocket;
 end;
 
 {==============================================================================}
@@ -1072,6 +1156,10 @@ begin
                        else Exit;
                        if (year = 0) or (month = 0) or (mday = 0) then
                            Exit;
+                       // for date 2-29 find last leap year. (fix for non-existent year)
+                       if (month = 2) and (mday = 29) then
+                         while not IsLeapYear(year) do
+                           Dec(year);
                        flr.FileTime := t + Encodedate(year, month, mday);
                      end;
                  3 : begin

ftptsend.pas

@@ -0,0 +1,352 @@
+{==============================================================================|
+| Project : Ararat Synapse                                       | 001.000.002 |
+|==============================================================================|
+| Content: Trivial FTP (TFTP) client and server                                |
+|==============================================================================|
+| Copyright (c)1999-2003, 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/)                       |
+|==============================================================================}
+
+// RFC-1350
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$Q-}
+{$H+}
+
+unit ftptsend;
+
+interface
+
+uses
+  SysUtils, Classes,
+  blcksock, synautil;
+
+const
+  cTFTPProtocol = '69';
+
+type
+  TTFTPSend = class(TSynaClient)
+  private
+    FSock: TUDPBlockSocket;
+    FErrorCode: integer;
+    FErrorString: string;
+    FData: TMemoryStream;
+    FRequestIP: string;
+    FRequestPort: string;
+    function SendPacket(Cmd: word; Serial: word; const Value: string): Boolean;
+    function RecvPacket(Serial: word; var Value: string): Boolean;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    function SendFile(const Filename: string): Boolean;
+    function RecvFile(const Filename: string): Boolean;
+    function WaitForRequest(var Req: word; var filename: string): Boolean;
+    procedure ReplyError(Error: word; Description: string);
+    function ReplyRecv: Boolean;
+    function ReplySend: Boolean;
+  published
+    property ErrorCode: integer read FErrorCode;
+    property ErrorString: string read FErrorString;
+    property Data: TMemoryStream read FData;
+    property RequestIP: string read FRequestIP write FRequestIP;
+    property RequestPort: string read FRequestPort write FRequestPort;
+  end;
+
+implementation
+
+constructor TTFTPSend.Create;
+begin
+  inherited Create;
+  FSock := TUDPBlockSocket.Create;
+  FTargetPort := cTFTPProtocol;
+  FData := TMemoryStream.Create;
+  FErrorCode := 0;
+  FErrorString := '';
+end;
+
+destructor TTFTPSend.Destroy;
+begin
+  FSock.Free;
+  FData.Free;
+  inherited Destroy;
+end;
+
+function TTFTPSend.SendPacket(Cmd: word; Serial: word; const Value: string): Boolean;
+var
+  s, sh: string;
+begin
+  FErrorCode := 0;
+  FErrorString := '';
+  Result := false;
+  if Cmd <> 2 then
+    s := CodeInt(Cmd) + CodeInt(Serial) + Value
+  else
+    s := CodeInt(Cmd) + Value;
+  FSock.SendString(s);
+  s := FSock.RecvPacket(FTimeout);
+  if FSock.LastError = 0 then
+    if length(s) >= 4 then
+    begin
+      sh := CodeInt(4) + CodeInt(Serial);
+      if Pos(sh, s) = 1 then
+        Result := True
+      else
+        if s[1] = #5 then
+        begin
+          FErrorCode := DecodeInt(s, 3);
+          Delete(s, 1, 4);
+          FErrorString := SeparateLeft(s, #0);
+        end;
+    end;
+end;
+
+function TTFTPSend.RecvPacket(Serial: word; var Value: string): Boolean;
+var
+  s: string;
+  ser: word;
+begin
+  FErrorCode := 0;
+  FErrorString := '';
+  Result := False;
+  Value := '';
+  s := FSock.RecvPacket(FTimeout);
+  if FSock.LastError = 0 then
+    if length(s) >= 4 then
+      if DecodeInt(s, 1) = 3 then
+      begin
+        ser := DecodeInt(s, 3);
+        if ser = Serial then
+        begin
+          Delete(s, 1, 4);
+          Value := s;
+          S := CodeInt(4) + CodeInt(ser);
+          FSock.SendString(s);
+          Result := FSock.LastError = 0;
+        end
+        else
+        begin
+          S := CodeInt(5) + CodeInt(5) + 'Unexcepted serial#' + #0;
+          FSock.SendString(s);
+        end;
+      end;
+      if DecodeInt(s, 1) = 5 then
+      begin
+        FErrorCode := DecodeInt(s, 3);
+        Delete(s, 1, 4);
+        FErrorString := SeparateLeft(s, #0);
+      end;
+end;
+
+function TTFTPSend.SendFile(const Filename: string): Boolean;
+var
+  s: string;
+  ser: word;
+  n, n1, n2: integer;
+begin
+  Result := False;
+  FErrorCode := 0;
+  FErrorString := '';
+  FSock.CloseSocket;
+  FSock.Connect(FTargetHost, FTargetPort);
+  try
+    if FSock.LastError = 0 then
+    begin
+      s := Filename + #0 + 'octet' + #0;
+      if not Sendpacket(2, 0, s) then
+        Exit;
+      ser := 1;
+      FData.Position := 0;
+      n1 := FData.Size div 512;
+      n2 := FData.Size mod 512;
+      for n := 1 to n1 do
+      begin
+        SetLength(s, 512);
+        FData.Read(pointer(s)^, 512);
+        if not Sendpacket(3, ser, s) then
+          Exit;
+        inc(ser);
+      end;
+      SetLength(s, n2);
+      FData.Read(pointer(s)^, n2);
+      if not Sendpacket(3, ser, s) then
+        Exit;
+      Result := True;
+    end;
+  finally
+    FSock.CloseSocket;
+  end;
+end;
+
+function TTFTPSend.RecvFile(const Filename: string): Boolean;
+var
+  s: string;
+  ser: word;
+begin
+  Result := False;
+  FErrorCode := 0;
+  FErrorString := '';
+  FSock.CloseSocket;
+  FSock.Connect(FTargetHost, FTargetPort);
+  try
+    if FSock.LastError = 0 then
+    begin
+      s := CodeInt(1) + Filename + #0 + 'octet' + #0;
+      FSock.SendString(s);
+      if FSock.LastError <> 0 then
+        Exit;
+      FData.Clear;
+      ser := 1;
+      repeat
+        if not RecvPacket(ser, s) then
+          Exit;
+        inc(ser);
+        FData.Write(pointer(s)^, length(s));
+      until length(s) <> 512;
+      FData.Position := 0;
+      Result := true;
+    end;
+  finally
+    FSock.CloseSocket;
+  end;
+end;
+
+function TTFTPSend.WaitForRequest(var Req: word; var filename: string): Boolean;
+var
+  s: string;
+begin
+  Result := False;
+  FErrorCode := 0;
+  FErrorString := '';
+  FSock.CloseSocket;
+  FSock.Bind('0.0.0.0', FTargetPort);
+  if FSock.LastError = 0 then
+  begin
+    s := FSock.RecvPacket(FTimeout);
+    if FSock.LastError = 0 then
+      if Length(s) >= 4 then
+      begin
+        FRequestIP := FSock.GetRemoteSinIP;
+        FRequestPort := IntToStr(FSock.GetRemoteSinPort);
+        Req := DecodeInt(s, 1);
+        delete(s, 1, 2);
+        filename := SeparateLeft(s, #0);
+        s := SeparateRight(s, #0);
+        s := SeparateLeft(s, #0);
+        Result := lowercase(s) = 'octet';
+      end;
+  end;
+end;
+
+procedure TTFTPSend.ReplyError(Error: word; Description: string);
+var
+  s: string;
+begin
+  FSock.CloseSocket;
+  FSock.Connect(FRequestIP, FRequestPort);
+  s := CodeInt(5) + CodeInt(Error) + Description + #0;
+  FSock.SendString(s);
+  FSock.CloseSocket;
+end;
+
+function TTFTPSend.ReplyRecv: Boolean;
+var
+  s: string;
+  ser: integer;
+begin
+  Result := False;
+  FErrorCode := 0;
+  FErrorString := '';
+  FSock.CloseSocket;
+  FSock.Connect(FRequestIP, FRequestPort);
+  try
+    s := CodeInt(4) + CodeInt(0);
+    FSock.SendString(s);
+    FData.Clear;
+    ser := 1;
+    repeat
+      if not RecvPacket(ser, s) then
+        Exit;
+      inc(ser);
+      FData.Write(pointer(s)^, length(s));
+    until length(s) <> 512;
+    FData.Position := 0;
+    Result := true;
+  finally
+    FSock.CloseSocket;
+  end;
+end;
+
+function TTFTPSend.ReplySend: Boolean;
+var
+  s: string;
+  ser: word;
+  n, n1, n2: integer;
+begin
+  Result := False;
+  FErrorCode := 0;
+  FErrorString := '';
+  FSock.CloseSocket;
+  FSock.Connect(FRequestIP, FRequestPort);
+  try
+    ser := 1;
+    FData.Position := 0;
+    n1 := FData.Size div 512;
+    n2 := FData.Size mod 512;
+    for n := 1 to n1 do
+    begin
+      SetLength(s, 512);
+      FData.Read(pointer(s)^, 512);
+      if not Sendpacket(3, ser, s) then
+        Exit;
+      inc(ser);
+    end;
+    SetLength(s, n2);
+    FData.Read(pointer(s)^, n2);
+    if not Sendpacket(3, ser, s) then
+      Exit;
+    Result := True;
+  finally
+    FSock.CloseSocket;
+  end;
+end;
+
+{==============================================================================}
+
+end.

httpsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 003.006.004 |
+| Project : Ararat Synapse                                       | 003.006.007 |
 |==============================================================================|
 | Content: HTTP client                                                         |
 |==============================================================================|
@@ -42,7 +42,14 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
-unit HTTPSend;
+//RFC-1867, RFC-1947, RFC-2388, RFC-2616 
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+unit httpsend;
 
 interface
 
@@ -51,7 +58,7 @@ uses
   {$IFDEF STREAMSEC}
   TlsInternalServer, TlsSynaSock,
   {$ENDIF}
-  blcksock, SynaUtil, SynaCode;
+  blcksock, synautil, synacode;
 
 const
   cHttpProtocol = '80';
@@ -530,7 +537,7 @@ end;
 
 procedure THTTPSend.Abort;
 begin
-  FSock.CloseSocket;
+  FSock.AbortSocket;
 end;
 
 {==============================================================================}

imapsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.003.005 |
+| Project : Ararat Synapse                                       | 002.004.002 |
 |==============================================================================|
 | Content: IMAP4rev1 client                                                    |
 |==============================================================================|
@@ -42,10 +42,14 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
-//RFC-2060
+//RFC-2060, RFC-2595
-//RFC-2595
 
-unit IMAPsend;
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+unit imapsend;
 
 interface
 
@@ -54,7 +58,7 @@ uses
   {$IFDEF STREAMSEC}
   TlsInternalServer, TlsSynaSock,
   {$ENDIF}
-  blcksock, SynaUtil, SynaCode;
+  blcksock, synautil, synacode;
 
 const
   cIMAPProtocol = '143';
@@ -121,6 +125,8 @@ type
     function SearchMess(Criteria: string; const FoundMess: TStrings): Boolean;
     function SetFlagsMess(MessID: integer; Flags: string): Boolean;
     function GetFlagsMess(MessID: integer; var Flags: string): Boolean;
+    function AddFlagsMess(MessID: integer; Flags: string): Boolean;
+    function DelFlagsMess(MessID: integer; Flags: string): Boolean;
     function StartTLS: Boolean;
     function GetUID(MessID: integer; var UID : Integer): Boolean;
     function FindCap(const Value: string): string;
@@ -556,7 +562,8 @@ begin
     ProcessLiterals;
     for n := 0 to FFullResult.Count - 1 do
     begin
-      s := UpperCase(FFullResult[n]);
+      s := FFullResult[n];
+//      s := UpperCase(FFullResult[n]);
       if (Pos('* ', s) = 1) and (Pos(FolderName, s) >= 1) and (Pos(Value, s) > 0 ) then
       begin
         t := SeparateRight(s, Value);
@@ -674,6 +681,26 @@ begin
   Result := IMAPcommand(s) = 'OK';
 end;
 
+function TIMAPSend.AddFlagsMess(MessID: integer; Flags: string): Boolean;
+var
+  s: string;
+begin
+  s := 'STORE ' + IntToStr(MessID) + ' +FLAGS.SILENT (' + Flags + ')';
+  if FUID then
+    s := 'UID ' + s;
+  Result := IMAPcommand(s) = 'OK';
+end;
+
+function TIMAPSend.DelFlagsMess(MessID: integer; Flags: string): Boolean;
+var
+  s: string;
+begin
+  s := 'STORE ' + IntToStr(MessID) + ' -FLAGS.SILENT (' + Flags + ')';
+  if FUID then
+    s := 'UID ' + s;
+  Result := IMAPcommand(s) = 'OK';
+end;
+
 function TIMAPSend.GetFlagsMess(MessID: integer; var Flags: string): Boolean;
 var
   s: string;

mimeinln.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.000.007 |
+| Project : Ararat Synapse                                       | 001.001.002 |
 |==============================================================================|
 | Content: Inline MIME support procedures and functions                        |
 |==============================================================================|
@@ -42,18 +42,27 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
-unit MIMEinLn;
+//RFC-1522
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+unit mimeinln;
 
 interface
 
 uses
   SysUtils, Classes,
-  SynaChar, SynaCode, SynaUtil;
+  synachar, synacode, synautil;
 
 function InlineDecode(const Value: string; CP: TMimeChar): string;
 function InlineEncode(const Value: string; CP, MimeP: TMimeChar): string;
 function NeedInline(const Value: string): boolean;
+function InlineCodeEx(const Value: string; FromCP: TMimeChar): string;
 function InlineCode(const Value: string): string;
+function InlineEmailEx(const Value: string; FromCP: TMimeChar): string;
 function InlineEmail(const Value: string): string;
 
 implementation
@@ -166,16 +175,16 @@ end;
 
 {==============================================================================}
 
-function InlineCode(const Value: string): string;
+function InlineCodeEx(const Value: string; FromCP: TMimeChar): string;
 var
   c: TMimeChar;
 begin
   if NeedInline(Value) then
   begin
-    c := IdealCharsetCoding(Value, GetCurCP,
+    c := IdealCharsetCoding(Value, FromCP,
       [ISO_8859_1, ISO_8859_2, ISO_8859_3, ISO_8859_4, ISO_8859_5,
       ISO_8859_6, ISO_8859_7, ISO_8859_8, ISO_8859_9, ISO_8859_10]);
-    Result := InlineEncode(Value, GetCurCP, c);
+    Result := InlineEncode(Value, FromCP, c);
   end
   else
     Result := Value;
@@ -183,7 +192,14 @@ end;
 
 {==============================================================================}
 
-function InlineEmail(const Value: string): string;
+function InlineCode(const Value: string): string;
+begin
+  Result := InlineCodeEx(Value, GetCurCP);
+end;
+
+{==============================================================================}
+
+function InlineEmailEx(const Value: string; FromCP: TMimeChar): string;
 var
   sd, se: string;
 begin
@@ -192,7 +208,14 @@ begin
   if sd = '' then
     Result := se
   else
-    Result := '"' + InlineCode(sd) + '"<' + se + '>';
+    Result := '"' + InlineCodeEx(sd, FromCP) + '"<' + se + '>';
+end;
+
+{==============================================================================}
+
+function InlineEmail(const Value: string): string;
+begin
+  Result := InlineEmailEx(Value, GetCurCP);
 end;
 
 end.

mimemess.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.001.003 |
+| Project : Ararat Synapse                                       | 002.002.003 |
 |==============================================================================|
 | Content: MIME message object                                                 |
 |==============================================================================|
@@ -42,13 +42,18 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
-unit MIMEmess;
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+unit mimemess;
 
 interface
 
 uses
   Classes, SysUtils,
-  MIMEpart, SynaChar, SynaUtil, MIMEinLn;
+  mimepart, synachar, synautil, mimeinln;
 
 type
   TMessHeader = class(TObject)
@@ -61,6 +66,7 @@ type
     FCustomHeaders: TStringList;
     FDate: TDateTime;
     FXMailer: string;
+    FCharsetCode: TMimeChar;
   public
     constructor Create;
     destructor Destroy; override;
@@ -78,6 +84,7 @@ type
     property CustomHeaders: TStringList read FCustomHeaders;
     property Date: TDateTime read FDate Write FDate;
     property XMailer: string read FXMailer Write FXMailer;
+    property CharsetCode: TMimeChar read FCharsetCode Write FCharsetCode;
   end;
 
   TMimeMess = class(TObject)
@@ -117,6 +124,7 @@ begin
   FToList := TStringList.Create;
   FCCList := TStringList.Create;
   FCustomHeaders := TStringList.Create;
+  FCharsetCode := GetCurCP;
 end;
 
 destructor TMessHeader.Destroy;
@@ -157,27 +165,27 @@ begin
     Value.Insert(0, 'X-mailer: ' + FXMailer);
   Value.Insert(0, 'MIME-Version: 1.0 (produced by Synapse)');
   if FOrganization <> '' then
-    Value.Insert(0, 'Organization: ' + InlineCode(FOrganization));
+    Value.Insert(0, 'Organization: ' + InlineCodeEx(FOrganization, FCharsetCode));
   s := '';
   for n := 0 to FCCList.Count - 1 do
     if s = '' then
-      s := InlineEmail(FCCList[n])
+      s := InlineEmailEx(FCCList[n], FCharsetCode)
     else
-      s := s + ' , ' + InlineEmail(FCCList[n]);
+      s := s + ' , ' + InlineEmailEx(FCCList[n], FCharsetCode);
   if s <> '' then
     Value.Insert(0, 'CC: ' + s);
   Value.Insert(0, 'Date: ' + Rfc822DateTime(FDate));
   if FSubject <> '' then
-    Value.Insert(0, 'Subject: ' + InlineCode(FSubject));
+    Value.Insert(0, 'Subject: ' + InlineCodeEx(FSubject, FCharsetCode));
   s := '';
   for n := 0 to FToList.Count - 1 do
     if s = '' then
-      s := InlineEmail(FToList[n])
+      s := InlineEmailEx(FToList[n], FCharsetCode)
     else
-      s := s + ' , ' + InlineEmail(FToList[n]);
+      s := s + ' , ' + InlineEmailEx(FToList[n], FCharsetCode);
   if s <> '' then
     Value.Insert(0, 'To: ' + s);
-  Value.Insert(0, 'From: ' + InlineEmail(FFrom));
+  Value.Insert(0, 'From: ' + InlineEmailEx(FFrom, FCharsetCode));
 end;
 
 procedure TMessHeader.DecodeHeaders(const Value: TStrings);
@@ -186,7 +194,7 @@ var
   x: Integer;
   cp: TMimeChar;
 begin
-  cp := GetCurCP;
+  cp := FCharsetCode;
   Clear;
   x := 0;
   while Value.Count > x do
@@ -218,7 +226,7 @@ begin
     begin
       s := SeparateRight(s, ':');
       repeat
-        t := InlineDecode(fetch(s, ','), cp);
+        t := InlineDecode(FetchEx(s, ',', '"'), cp);
         if t <> '' then
           FToList.Add(t);
       until s = '';
@@ -228,7 +236,7 @@ begin
     begin
       s := SeparateRight(s, ':');
       repeat
-        t := InlineDecode(fetch(s, ','), cp);
+        t := InlineDecode(FetchEx(s, ',', '"'), cp);
         if t <> '' then
           FCCList.Add(t);
       until s = '';

mimepart.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.003.004 |
+| Project : Ararat Synapse                                       | 002.004.008 |
 |==============================================================================|
 | Content: MIME support procedures and functions                               |
 |==============================================================================|
@@ -42,16 +42,25 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
-unit MIMEpart;
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+unit mimepart;
 
 interface
 
 uses
   SysUtils, Classes,
-{$IFNDEF LINUX}
+{$IFDEF LINUX}
+  {$IFDEF FPC}
+  synafpc,
+  {$ENDIF}
+{$ELSE}
   Windows,
 {$ENDIF}
-  SynaChar, SynaCode, SynaUtil, MIMEinLn;
+  synachar, synacode, synautil, mimeinln;
 
 type
 
@@ -89,9 +98,13 @@ type
     FSubParts: TList;
     FOnWalkPart: THookWalkPart;
     FMaxLineLength: integer;
+    FSubLevel: integer;
+    FMaxSubLevel: integer;
+    FAttachInside: boolean;
     procedure SetPrimary(Value: string);
     procedure SetEncoding(Value: string);
     procedure SetCharset(Value: string);
+    function IsUUcode(Value: string): boolean;
   public
     constructor Create;
     destructor Destroy; override;
@@ -111,6 +124,7 @@ type
     procedure DecomposeParts;
     procedure ComposeParts;
     procedure WalkPart;
+    function CanSubPart: boolean;
   published
     property Primary: string read FPrimary write SetPrimary;
     property Encoding: string read FEncoding write SetEncoding;
@@ -132,6 +146,9 @@ type
     property PrePart: TStringList read FPrePart;
     property PostPart: TStringList read FPostPart;
     property DecodedLines: TMemoryStream read FDecodedLines;
+    property SubLevel: integer read FSubLevel write FSubLevel;
+    property MaxSubLevel: integer read FMaxSubLevel write FMaxSubLevel;
+    property AttachInside: boolean read FAttachInside;
     property OnWalkPart: THookWalkPart read FOnWalkPart write FOnWalkPart;
     property MaxLineLength: integer read FMaxLineLength Write FMaxLineLength;
   end;
@@ -216,6 +233,9 @@ begin
   FTargetCharset := GetCurCP;
   FDefaultCharset := 'US-ASCII';
   FMaxLineLength := 78;
+  FSubLevel := 0;
+  FMaxSubLevel := -1;
+  FAttachInside := false;
 end;
 
 destructor TMIMEPart.Destroy;
@@ -248,6 +268,7 @@ begin
   FDescription := '';
   FBoundary := '';
   FFileName := '';
+  FAttachInside := False;
   FPartBody.Clear;
   FHeaders.Clear;
   FPrePart.Clear;
@@ -280,6 +301,7 @@ begin
   PrePart.Assign(Value.PrePart);
   PostPart.Assign(Value.PostPart);
   MaxLineLength := Value.MaxLineLength;
+  FAttachInside := Value.AttachInside;
 end;
 
 {==============================================================================}
@@ -342,6 +364,7 @@ begin
   Result := TMimePart.Create;
   Result.DefaultCharset := FDefaultCharset;
   FSubParts.Add(Result);
+  Result.SubLevel := FSubLevel + 1;
 end;
 
 {==============================================================================}
@@ -374,7 +397,6 @@ begin
       Break;
     FHeaders.Add(s);
   end;
-  StringsTrim(FHeaders);
   DecodePartHeader;
   //extract prepart
   if FPrimaryCode = MP_MULTIPART then
@@ -387,29 +409,39 @@ begin
       if s = '--' + FBoundary then
         Break;
       FPrePart.Add(s);
+      if not FAttachInside then
+        FAttachInside := IsUUcode(s);
     end;
-    StringsTrim(FPrePart);
   end;
   //extract body part
   if FPrimaryCode = MP_MULTIPART then
   begin
     repeat
-      Mime := AddSubPart;
+      if CanSubPart then
-      while FLines.Count > x do
+      begin
+        Mime := AddSubPart;
+        while FLines.Count > x do
+        begin
+          s := FLines[x];
+          Inc(x);
+          if Pos('--' + FBoundary, s) = 1 then
+            Break;
+          Mime.Lines.Add(s);
+        end;
+        StringsTrim(Mime.Lines);
+        Mime.DecomposeParts;
+      end
+      else
       begin
         s := FLines[x];
         Inc(x);
-        if Pos('--' + FBoundary, s) = 1 then
+        FPartBody.Add(s);
-          Break;
-        Mime.Lines.Add(s);
       end;
-      StringsTrim(Mime.Lines);
-      Mime.DecomposeParts;
       if x >= FLines.Count then
         break;
     until s = '--' + FBoundary + '--';
   end;
-  if FPrimaryCode = MP_MESSAGE then
+  if (FPrimaryCode = MP_MESSAGE) and CanSubPart then
   begin
     Mime := AddSubPart;
     SkipEmpty;
@@ -430,6 +462,8 @@ begin
       s := TrimRight(FLines[x]);
       Inc(x);
       FPartBody.Add(s);
+      if not FAttachInside then
+        FAttachInside := IsUUcode(s);
     end;
     StringsTrim(FPartBody);
   end;
@@ -442,6 +476,8 @@ begin
       s := TrimRight(FLines[x]);
       Inc(x);
       FPostPart.Add(s);
+      if not FAttachInside then
+        FAttachInside := IsUUcode(s);
     end;
     StringsTrim(FPostPart);
   end;
@@ -502,14 +538,12 @@ begin
   if FPrimaryCode = MP_MULTIPART then
   begin
     Flines.AddStrings(FPrePart);
-    Flines.Add('');
     for n := 0 to GetSubPartCount - 1 do
     begin
       Flines.Add('--' + FBoundary);
       mime := GetSubPart(n);
       mime.ComposeParts;
       FLines.AddStrings(mime.Lines);
-      Flines.Add('');
     end;
     Flines.Add('--' + FBoundary + '--');
     Flines.AddStrings(FPostPart);
@@ -522,70 +556,43 @@ begin
       mime := GetSubPart(0);
       mime.ComposeParts;
       FLines.AddStrings(mime.Lines);
-      Flines.Add('');
     end;
   end
   else
   //if normal part
   begin
     FLines.AddStrings(FPartBody);
-    Flines.Add('');
   end;
 end;
 
 {==============================================================================}
 
 procedure TMIMEPart.DecodePart;
-const
-  CRLF = #13#10;
 var
   n: Integer;
   s: string;
 begin
   FDecodedLines.Clear;
-  for n := 0 to FPartBody.Count - 1 do
+  case FEncodingCode of
-  begin
+    ME_QUOTED_PRINTABLE:
-    s := FPartBody[n];
+      s := DecodeQuotedPrintable(FPartBody.Text);
-    case FEncodingCode of
+    ME_BASE64:
-      ME_7BIT:
+      s := DecodeBase64(FPartBody.Text);
-        begin
+    ME_UU, ME_XX:
-          if FPrimaryCode = MP_TEXT then
+      begin
-            s := CharsetConversion(s, FCharsetCode, FTargetCharset);
+        s := '';
-          s := s + CRLF;
+        for n := 0 to FPartBody.Count - 1 do
-        end;
+          if FEncodingCode = ME_UU then
-      ME_8BIT:
+            s := s + DecodeUU(FPartBody[n])
-        begin
-          if FPrimaryCode = MP_TEXT then
-            s := CharsetConversion(s, FCharsetCode, FTargetCharset);
-          s := s + CRLF;
-        end;
-      ME_QUOTED_PRINTABLE:
-        begin
-          if s = '' then
-            s := CRLF
           else
-            if s[Length(s)] <> '=' then
+            s := s + DecodeXX(FPartBody[n]);
-              s := s + CRLF;
+      end;
-          s := DecodeQuotedPrintable(s);
+  else
-          if FPrimaryCode = MP_TEXT then
+    s := FPartBody.Text;
-            s := CharsetConversion(s, FCharsetCode, FTargetCharset);
-        end;
-      ME_BASE64:
-        begin
-          if s <> '' then
-            s := DecodeBase64(s);
-          if FPrimaryCode = MP_TEXT then
-            s := CharsetConversion(s, FCharsetCode, FTargetCharset);
-        end;
-      ME_UU:
-        if s <> '' then
-          s := DecodeUU(s);
-      ME_XX:
-        if s <> '' then
-          s := DecodeXX(s);
-    end;
-    FDecodedLines.Write(Pointer(s)^, Length(s));
   end;
+  if FPrimaryCode = MP_TEXT then
+    s := CharsetConversion(s, FCharsetCode, FTargetCharset);
+  FDecodedLines.Write(Pointer(s)^, Length(s));
   FDecodedLines.Seek(0, soFromBeginning);
 end;
 
@@ -647,9 +654,9 @@ begin
       if Pos('CONTENT-ID:', su) = 1 then
         FContentID := SeparateRight(s, ':');
     end;
-  if (PrimaryCode = MP_BINARY) and (FFileName = '') then
+  if FFileName = '' then
     FFileName := fn;
-  FFileName := InlineDecode(FFileName, getCurCP);
+  FFileName := InlineDecode(FFileName, FTargetCharset);
   FFileName := ExtractFileName(FFileName);
 end;
 
@@ -687,7 +694,15 @@ begin
         end
         else
         begin
-          l.LoadFromStream(FDecodedLines);
+          if FPrimaryCode = MP_BINARY then
+          begin
+            SetLength(s, FDecodedLines.Size);
+            x := FDecodedLines.Read(pointer(s)^, FDecodedLines.Size);
+            Setlength(s, x);
+            l.Add(s);
+          end
+          else
+            l.LoadFromStream(FDecodedLines);
           for n := 0 to l.Count - 1 do
           begin
             s := l[n];
@@ -695,8 +710,10 @@ begin
               s := CharsetConversion(s, FTargetCharset, FCharsetCode);
             if FEncodingCode = ME_QUOTED_PRINTABLE then
             begin
-              s := EncodeTriplet(s, '=', [Char(1)..Char(31), '=', Char(128)..Char(255)]);
+              if FPrimaryCode = MP_BINARY then
-//              s := EncodeQuotedPrintable(s);
+                s := EncodeQuotedPrintable(s)
+              else
+                s := EncodeTriplet(s, '=', [Char(0)..Char(31), '=', Char(127)..Char(255)]);
               repeat
                 if Length(s) < FMaxLineLength then
                 begin
@@ -717,7 +734,7 @@ begin
                   if x = 0 then
                     x := FMaxLineLength;
                   t := Copy(s, 1, x);
-                  s := Copy(s, x + 1, Length(s) - x);
+                  Delete(s, 1, x);
                   if s <> '' then
                     t := t + '=';
                 end;
@@ -727,6 +744,9 @@ begin
             else
               FPartBody.Add(s);
           end;
+          if (FPrimaryCode = MP_BINARY)
+            and (FEncodingCode = ME_QUOTED_PRINTABLE) then
+            FPartBody[FPartBody.Count - 1] := FPartBody[FPartBody.Count - 1] + '=';
         end;
     end;
   finally
@@ -758,7 +778,7 @@ begin
   begin
     s := '';
     if FFileName <> '' then
-      s := '; FileName="' + InlineCode(FFileName) + '"';
+      s := '; FileName="' + InlineCodeEx(FileName, FTargetCharset) + '"';
     FHeaders.Insert(0, 'Content-Disposition: ' + LowerCase(FDisposition) + s);
   end;
   if FContentID <> '' then
@@ -783,11 +803,11 @@ begin
       s := FPrimary + '/' + FSecondary + '; charset=' + GetIDfromCP(FCharsetCode);
     MP_MULTIPART:
       s := FPrimary + '/' + FSecondary + '; boundary="' + FBoundary + '"';
-    MP_MESSAGE:
+    MP_MESSAGE, MP_BINARY:
-      s := FPrimary + '/' + FSecondary + '';
+      s := FPrimary + '/' + FSecondary;
-    MP_BINARY:
-      s := FPrimary + '/' + FSecondary + '; name="' + FFileName + '"';
   end;
+  if FFileName <> '' then
+    s := s + '; name="' + InlineCodeEx(FileName, FTargetCharset) + '"';
   FHeaders.Insert(0, 'Content-type: ' + s);
 end;
 
@@ -878,16 +898,35 @@ begin
   FCharsetCode := GetCPFromID(Value);
 end;
 
+function TMIMEPart.CanSubPart: boolean;
+begin
+  Result := True;
+  if FMaxSubLevel <> -1 then
+    Result := FMaxSubLevel > FSubLevel;
+end;
+
+function TMIMEPart.IsUUcode(Value: string): boolean;
+begin
+  Value := UpperCase(Value);
+  Result := (pos('BEGIN ', Value) = 1) and (SeparateRight(Value, ' ') <> '');
+end;
+
 {==============================================================================}
 
 function GenerateBoundary: string;
 var
-  x: Integer;
+  x, y: Integer;
 begin
-  Sleep(1);
+  y := GetTick;
+  x := y;
+  while TickDelta(y, x) = 0 do
+  begin
+    Sleep(1);
+    x := GetTick;
+  end;
   Randomize;
-  x := Random(MaxInt);
+  y := Random(MaxInt);
-  Result := IntToHex(x, 8) + '_Synapse_message_boundary';
+  Result := IntToHex(x, 8) + '_' + IntToHex(y, 8) + '_Synapse_boundary';
 end;
 
 end.

nntpsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.003.001 |
+| Project : Ararat Synapse                                       | 001.003.003 |
 |==============================================================================|
 | Content: NNTP client                                                         |
 |==============================================================================|
@@ -42,7 +42,14 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
-unit NNTPsend;
+//RFC-977, RFC-2980
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+unit nntpsend;
 
 interface
 
@@ -51,7 +58,7 @@ uses
   {$IFDEF STREAMSEC}
   TlsInternalServer, TlsSynaSock,
   {$ENDIF}
-  blcksock, SynaUtil, SynaCode;
+  blcksock, synautil, synacode;
 
 const
   cNNTPProtocol = 'nntp';

pingsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 003.000.002 |
+| Project : Ararat Synapse                                       | 003.001.005 |
 |==============================================================================|
 | Content: PING sender                                                         |
 |==============================================================================|
@@ -42,10 +42,14 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
 {$Q-}
 {$R-}
+{$H+}
 
-unit PINGsend;
+unit pingsend;
 
 interface
 
@@ -56,13 +60,18 @@ uses
   Windows,
 {$ENDIF}
   SysUtils,
-  synsock, blcksock, SynaUtil;
+  synsock, blcksock, synautil;
 
 const
   ICMP_ECHO = 8;
   ICMP_ECHOREPLY = 0;
+  ICMP_UNREACH = 3;
+  ICMP_TIME_EXCEEDED = 11;
+//rfc-2292
   ICMP6_ECHO = 128;
   ICMP6_ECHOREPLY = 129;
+  ICMP6_UNREACH = 1;
+  ICMP6_TIME_EXCEEDED = 3;
 
 type
   TIcmpEchoHeader = record
@@ -84,6 +93,17 @@ type
     proto: Byte;
   end;
 
+  TICMPError = (
+    IE_NoError,
+    IE_Other,
+    IE_TTLExceed,
+    IE_UnreachOther,
+    IE_UnreachRoute,
+    IE_UnreachAdmin,
+    IE_UnreachAddr,
+    IE_UnreachPort
+    );
+
   TPINGSend = class(TSynaClient)
   private
     FSock: TICMPBlockSocket;
@@ -94,9 +114,16 @@ type
     FPingTime: Integer;
     FIcmpEcho: Byte;
     FIcmpEchoReply: Byte;
+    FIcmpUnreach: Byte;
+    FReplyFrom: string;
+    FReplyType: byte;
+    FReplyCode: byte;
+    FReplyError: TICMPError;
+    FReplyErrorDesc: string;
     function Checksum(Value: string): Word;
     function Checksum6(Value: string): Word;
     function ReadPacket: Boolean;
+    procedure TranslateError;
   public
     function Ping(const Host: string): Boolean;
     constructor Create;
@@ -104,10 +131,16 @@ type
   published
     property PacketSize: Integer read FPacketSize Write FPacketSize;
     property PingTime: Integer read FPingTime;
+    property ReplyFrom: string read FReplyFrom;
+    property ReplyType: byte read FReplyType;
+    property ReplyCode: byte read FReplyCode;
+    property ReplyError: TICMPError read FReplyError;
+    property ReplyErrorDesc: string read FReplyErrorDesc;
     property Sock: TICMPBlockSocket read FSock;
   end;
 
 function PingHost(const Host: string): Integer;
+function TraceRouteHost(const Host: string): string;
 
 implementation
 
@@ -140,11 +173,16 @@ var
   IPHeadPtr: ^TIPHeader;
   IpHdrLen: Integer;
   IcmpEchoHeaderPtr: ^TICMPEchoHeader;
-  n: Integer;
   t: Boolean;
+  x: cardinal;
 begin
   Result := False;
   FPingTime := -1;
+  FReplyFrom := '';
+  FReplyType := 0;
+  FReplyCode := 0;
+  FReplyError := IE_NoError;
+  FReplyErrorDesc := '';
   FSock.Bind(FIPInterface, cAnyPort);
   FSock.Connect(Host, '0');
   if FSock.LastError <> 0 then
@@ -154,32 +192,33 @@ begin
   begin
     FIcmpEcho := ICMP6_ECHO;
     FIcmpEchoReply := ICMP6_ECHOREPLY;
+    FIcmpUnreach := ICMP6_UNREACH;
   end
   else
   begin
     FIcmpEcho := ICMP_ECHO;
     FIcmpEchoReply := ICMP_ECHOREPLY;
+    FIcmpUnreach := ICMP_UNREACH;
   end;
-  FBuffer := StringOfChar(#0, SizeOf(TICMPEchoHeader) + FPacketSize);
+  FBuffer := StringOfChar(#55, SizeOf(TICMPEchoHeader) + FPacketSize);
   IcmpEchoHeaderPtr := Pointer(FBuffer);
   with IcmpEchoHeaderPtr^ do
   begin
     i_type := FIcmpEcho;
     i_code := 0;
     i_CheckSum := 0;
-    FId := Random(32767);
+    FId := System.Random(32767);
     i_Id := FId;
     TimeStamp := GetTick;
     Inc(FSeq);
     i_Seq := FSeq;
-    for n := Succ(SizeOf(TIcmpEchoHeader)) to Length(FBuffer) do
+    if fSock.IP6used then
-      FBuffer[n] := #$55;
+      i_CheckSum := CheckSum6(FBuffer)
+    else
+      i_CheckSum := CheckSum(FBuffer);
   end;
-  if fSock.IP6used then
-    IcmpEchoHeaderPtr^.i_CheckSum := CheckSum6(FBuffer)
-  else
-    IcmpEchoHeaderPtr^.i_CheckSum := CheckSum(FBuffer);
   FSock.SendString(FBuffer);
+  x := GetTick;
   repeat
     t := ReadPacket;
     if not t then
@@ -200,31 +239,35 @@ begin
       IpHdrLen := (IPHeadPtr^.VerLen and $0F) * 4;
       IcmpEchoHeaderPtr := @FBuffer[IpHdrLen + 1];
     end;
-  until (IcmpEchoHeaderPtr^.i_type <> FIcmpEcho) and (IcmpEchoHeaderPtr^.i_id = FId);
+  until (IcmpEchoHeaderPtr^.i_type <> FIcmpEcho)
+    and ((IcmpEchoHeaderPtr^.i_id = FId) or (IcmpEchoHeaderPtr^.i_id = 0));
   //it discard sometimes possible 'echoes' of previosly sended packet...
   if t then
-    if (IcmpEchoHeaderPtr^.i_type = FIcmpEchoReply) then
     begin
-      FPingTime := TickDelta(IcmpEchoHeaderPtr^.TimeStamp, GetTick);
+      FPingTime := TickDelta(x, GetTick);
+      FReplyFrom := FSock.GetRemoteSinIP;
+      FReplyType := IcmpEchoHeaderPtr^.i_type;
+      FReplyCode := IcmpEchoHeaderPtr^.i_code;
+      TranslateError;
       Result := True;
     end;
 end;
 
 function TPINGSend.Checksum(Value: string): Word;
-type
-  TWordArray = array[0..0] of Word;
 var
-  WordArr: ^TWordArray;
   CkSum: DWORD;
   Num, Remain: Integer;
-  n: Integer;
+  n, i: Integer;
 begin
   Num := Length(Value) div 2;
   Remain := Length(Value) mod 2;
-  WordArr := Pointer(Value);
   CkSum := 0;
+  i := 1;
   for n := 0 to Num - 1 do
-    CkSum := CkSum + WordArr^[n];
+  begin
+    CkSum := CkSum + Synsock.HtoNs(DecodeInt(Value, i));
+    inc(i, 2);
+  end;
   if Remain <> 0 then
     CkSum := CkSum + Ord(Value[Length(Value)]);
   CkSum := (CkSum shr 16) + (CkSum and $FFFF);
@@ -252,30 +295,134 @@ begin
   s := StringOfChar(#0, SizeOf(TICMP6Packet)) + Value;
   ICMP6Ptr := Pointer(s);
   x := synsock.WSAIoctl(FSock.Socket, SIO_ROUTING_INTERFACE_QUERY,
-    @FSock.RemoteSin.IP6, SizeOf(FSock.RemoteSin.IP6),
+    @FSock.RemoteSin, SizeOf(FSock.RemoteSin),
     @ip6, SizeOf(ip6), @b, nil, nil);
   if x <> -1 then
     ICMP6Ptr^.in_dest := ip6.sin6_addr
   else
-    ICMP6Ptr^.in_dest := FSock.LocalSin.IP6.sin6_addr;
+    ICMP6Ptr^.in_dest := FSock.LocalSin.sin6_addr;
-  ICMP6Ptr^.in_source := FSock.RemoteSin.IP6.sin6_addr;
+  ICMP6Ptr^.in_source := FSock.RemoteSin.sin6_addr;
   ICMP6Ptr^.Length := synsock.htonl(Length(Value));
   ICMP6Ptr^.proto := IPPROTO_ICMPV6;
   Result := Checksum(s);
 {$ENDIF}
 end;
 
+procedure TPINGSend.TranslateError;
+begin
+  if fSock.IP6used then
+  begin
+    case FReplyType of
+      ICMP6_ECHOREPLY:
+        FReplyError := IE_NoError;
+      ICMP6_TIME_EXCEEDED:
+        FReplyError := IE_TTLExceed;
+      ICMP6_UNREACH:
+        case FReplyCode of
+          0:
+            FReplyError := IE_UnreachRoute;
+          3:
+            FReplyError := IE_UnreachAddr;
+          4:
+            FReplyError := IE_UnreachPort;
+          1:
+            FReplyError := IE_UnreachAdmin;
+        else
+          FReplyError := IE_UnreachOther;
+        end;
+    else
+      FReplyError := IE_Other;
+    end;
+  end
+  else
+  begin
+    case FReplyType of
+      ICMP_ECHOREPLY:
+        FReplyError := IE_NoError;
+      ICMP_TIME_EXCEEDED:
+        FReplyError := IE_TTLExceed;
+      ICMP_UNREACH:
+        case FReplyCode of
+          0:
+            FReplyError := IE_UnreachRoute;
+          1:
+            FReplyError := IE_UnreachAddr;
+          3:
+            FReplyError := IE_UnreachPort;
+          13:
+            FReplyError := IE_UnreachAdmin;
+        else
+          FReplyError := IE_UnreachOther;
+        end;
+    else
+      FReplyError := IE_Other;
+    end;
+  end;
+  case FReplyError of
+    IE_NoError:
+      FReplyErrorDesc := '';
+    IE_Other:
+      FReplyErrorDesc := 'Unknown error';
+    IE_TTLExceed:
+      FReplyErrorDesc := 'TTL Exceeded';
+    IE_UnreachOther:
+      FReplyErrorDesc := 'Unknown unreachable';
+    IE_UnreachRoute:
+      FReplyErrorDesc := 'No route to destination';
+    IE_UnreachAdmin:
+      FReplyErrorDesc := 'Administratively prohibited';
+    IE_UnreachAddr:
+      FReplyErrorDesc := 'Address unreachable';
+    IE_UnreachPort:
+      FReplyErrorDesc := 'Port unreachable';
+  end;
+end;
+
 {==============================================================================}
 
 function PingHost(const Host: string): Integer;
 begin
   with TPINGSend.Create do
   try
-    Ping(Host);
+    Result := -1;
-    Result := PingTime;
+    if Ping(Host) then
+      if ReplyError = IE_NoError then
+        Result := PingTime;
   finally
     Free;
   end;
 end;
 
+function TraceRouteHost(const Host: string): string;
+var
+  Ping: TPingSend;
+  ttl : byte;
+begin
+  Result := '';
+  Ping := TPINGSend.Create;
+  try
+    ttl := 1;
+    repeat
+      ping.Sock.TTL := ttl;
+      inc(ttl);
+      if ttl > 30 then
+        Break;
+      if not ping.Ping(Host) then
+      begin
+        Result := Result + cAnyHost+ ' Timeout' + CRLF;
+        continue;
+      end;
+      if (ping.ReplyError <> IE_NoError)
+        and (ping.ReplyError <> IE_TTLExceed) then
+      begin
+        Result := Result + Ping.ReplyFrom + ' ' + Ping.ReplyErrorDesc + CRLF;
+        break;
+      end;
+      Result := Result + Ping.ReplyFrom + ' ' + IntToStr(Ping.PingTime) + CRLF;
+    until ping.ReplyError = IE_NoError;
+  finally
+    Ping.Free;
+  end;
+end;
+
 end.

pop3send.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.001.008 |
+| Project : Ararat Synapse                                       | 002.001.010 |
 |==============================================================================|
 | Content: POP3 client                                                         |
 |==============================================================================|
@@ -42,13 +42,14 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
-//RFC-1734
+//RFC-1734, RFC-1939, RFC-2195, RFC-2449, RFC-2595
-//RFC-1939
-//RFC-2195
-//RFC-2449
-//RFC-2595
 
-unit POP3send;
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+unit pop3send;
 
 interface
 
@@ -57,7 +58,7 @@ uses
   {$IFDEF STREAMSEC}
   TlsInternalServer, TlsSynaSock,
   {$ENDIF}
-  blcksock, SynaUtil, SynaCode;
+  blcksock, synautil, synacode;
 
 const
   cPop3Protocol = 'pop3';

slogsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.001.004 |
+| Project : Ararat Synapse                                       | 001.001.006 |
 |==============================================================================|
 | Content: SysLog client                                                       |
 |==============================================================================|
@@ -44,15 +44,19 @@
 
 // RFC-3164
 
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
 {$Q-}
+{$H+}
 
-unit SLogSend;
+unit slogsend;
 
 interface
 
 uses
   SysUtils, Classes,
-  blcksock, SynaUtil;
+  blcksock, synautil;
 
 const
   cSysLogProtocol = '514';

smtpsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 003.002.008 |
+| Project : Ararat Synapse                                       | 003.002.011 |
 |==============================================================================|
 | Content: SMTP client                                                         |
 |==============================================================================|
@@ -42,7 +42,15 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
-unit SMTPsend;
+//RFC-1869, RFC-1870, RFC-1893, RFC-2034, RFC-2104, RFC-2195, RFC-2487,
+//RFC-2554, RFC-2821
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+unit smtpsend;
 
 interface
 
@@ -51,7 +59,7 @@ uses
   {$IFDEF STREAMSEC}
   TlsInternalServer, TlsSynaSock,
   {$ENDIF}
-  blcksock, SynaUtil, SynaCode;
+  blcksock, synautil, synacode;
 
 const
   cSmtpProtocol = 'smtp';
@@ -561,7 +569,7 @@ begin
       begin
         s := MailTo;
         repeat
-          t := GetEmailAddr(fetch(s, ','));
+          t := GetEmailAddr(FetchEx(s, ',', '"'));
           if t <> '' then
             Result := SMTP.MailTo(t);
           if not Result then

snmpsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.006.002 |
+| Project : Ararat Synapse                                       | 002.006.004 |
 |==============================================================================|
 | Content: SNMP client                                                         |
 |==============================================================================|
@@ -43,15 +43,19 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
 {$Q-}
+{$H+}
 
-unit SNMPSend;
+unit snmpsend;
 
 interface
 
 uses
   Classes, SysUtils,
-  blckSock, SynaUtil, ASN1Util;
+  blcksock, synautil, asn1util;
 
 const
   cSnmpProtocol = '161';

snmptrap.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.003.002 |
+| Project : Ararat Synapse                                       | 002.003.004 |
 |==============================================================================|
 | Content: SNMP traps                                                          |
 |==============================================================================|
@@ -43,15 +43,19 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
 {$Q-}
+{$H+}
 
-unit SNMPTrap;
+unit snmptrap;
 
 interface
 
 uses
   Classes, SysUtils,
-  blckSock, SynaUtil, ASN1Util, SNMPSend;
+  blcksock, synautil, asn1util, snmpsend;
 
 const
   cSnmpTrapProtocol = '162';

sntpsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.002.003 |
+| Project : Ararat Synapse                                       | 002.002.007 |
 |==============================================================================|
 | Content: SNTP client                                                         |
 |==============================================================================|
@@ -43,15 +43,19 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
 {$Q-}
+{$H+}
 
-unit SNTPsend;
+unit sntpsend;
 
 interface
 
 uses
   SysUtils,
-  synsock, blcksock, SynaUtil;
+  synsock, blcksock, synautil;
 
 const
   cNtpProtocol = 'ntp';
@@ -95,8 +99,8 @@ type
     function GetSNTP: Boolean;
     function GetNTP: Boolean;
     function GetBroadcastNTP: Boolean;
-  published
     property NTPReply: TNtp read FNTPReply;
+  published
     property NTPTime: TDateTime read FNTPTime;
     property NTPOffset: Double read FNTPOffset;
     property NTPDelay: Double read FNTPDelay;
@@ -171,12 +175,12 @@ var
   x: Integer;
 begin
   Result := False;
-  FSock.Bind(FIPInterface, cAnyPort);
+  FSock.Bind(FIPInterface, FTargetPort);
   FBuffer := FSock.RecvPacket(FTimeout);
   if FSock.LastError = 0 then
   begin
     x := Length(FBuffer);
-    if (FTargetHost = '0.0.0.0') or (FSock.GetRemoteSinIP = FTargetHost) then
+    if (FTargetHost = '0.0.0.0') or (FSock.GetRemoteSinIP = FSock.ResolveName(FTargetHost)) then
       if x >= SizeOf(NTPReply) then
       begin
         NtpPtr := Pointer(FBuffer);

synachar.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 004.000.005 |
+| Project : Ararat Synapse                                       | 004.000.008 |
 |==============================================================================|
 | Content: Charset conversion support                                          |
 |==============================================================================|
@@ -42,9 +42,13 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
 {$Q-}
+{$H+}
 
-unit SynaChar;
+unit synachar;
 
 interface
 
@@ -644,7 +648,7 @@ const
     (0);
 
   //remove diakritics from Czech
-  Replace_Czech: array[0..55] of Word =
+ Replace_Czech: array[0..59] of Word =
     (
       $00E1, $0061,
       $010D, $0063,
@@ -653,6 +657,7 @@ const
       $00E9, $0065,
       $011B, $0065,
       $00ED, $0069,
+      $0148, $006E,
       $00F3, $006F,
       $0159, $0072,
       $0161, $0073,
@@ -666,10 +671,11 @@ const
       $00C9, $0045,
       $011A, $0045,
       $00CD, $0049,
+      $0147, $004E,
       $00D3, $004F,
       $0158, $0052,
       $0160, $0053,
-      $0164, $0053,
+      $0164, $0054,
       $00DA, $0055,
       $016E, $0055,
       $00DD, $0059,
@@ -701,7 +707,7 @@ uses
   Windows,
 {$ENDIF}
   SysUtils,
-  SynaUtil, SynaCode;
+  synautil, synacode;
 
 const
   NotFoundChar = '_';

synacode.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.007.001 |
+| Project : Ararat Synapse                                       | 001.008.007 |
 |==============================================================================|
 | Content: Coding and decoding support                                         |
 |==============================================================================|
@@ -42,9 +42,14 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
 {$Q-}
+{$R-}
+{$H+}
 
-unit SynaCode;
+unit synacode;
 
 interface
 
@@ -241,29 +246,72 @@ type
 
 function DecodeTriplet(const Value: string; Delimiter: Char): string;
 var
-  x, l: Integer;
+  x, l, lv: Integer;
   c: Char;
-  s: string;
+  b: Byte;
+  bad: Boolean;
 begin
-  SetLength(Result, Length(Value));
+  lv := Length(Value);
+  SetLength(Result, lv);
   x := 1;
   l := 1;
-  while x <= Length(Value) do
+  while x <= lv do
   begin
     c := Value[x];
     Inc(x);
     if c <> Delimiter then
-      Result[l] := c
+    begin
+      Result[l] := c;
+      Inc(l);
+    end
     else
-      if x < Length(Value) then
+      if x < lv then
       begin
-        s := Copy(Value, x, 2);
+        Case Value[x] Of
-        Inc(x, 2);
+          #13:
-        Result[l] := Char(StrToIntDef('$' + s, 32))
+            if (Value[x + 1] = #10) then
+              Inc(x, 2)
+            else
+              Inc(x);
+          #10:
+            if (Value[x + 1] = #13) then
+              Inc(x, 2)
+            else
+              Inc(x);
+        else
+          begin
+            bad := False;
+            Case Value[x] Of
+              '0'..'9': b := (Byte(Value[x]) - 48) Shl 4;
+              'a'..'f', 'A'..'F': b := ((Byte(Value[x]) And 7) + 9) shl 4;
+            else
+              begin
+                b := 0;
+                bad := True;
+              end;
+            end;
+            Case Value[x + 1] Of
+              '0'..'9': b := b Or (Byte(Value[x + 1]) - 48);
+              'a'..'f', 'A'..'F': b := b Or ((Byte(Value[x + 1]) And 7) + 9);
+            else
+              bad := True;
+            end;
+            if bad then
+            begin
+              Result[l] := c;
+              Inc(l);
+            end
+            else
+            begin
+              Inc(x, 2);
+              Result[l] := Char(b);
+              Inc(l);
+            end;
+          end;
+        end;
       end
       else
         break;
-    Inc(l);
   end;
   Dec(l);
   SetLength(Result, l);
@@ -322,7 +370,7 @@ end;
 function EncodeQuotedPrintable(const Value: string): string;
 begin
   Result := EncodeTriplet(Value, '=', SpecialChar +
-    [Char(1)..Char(31), Char(128)..Char(255)]);
+    [Char(0)..Char(31), Char(127)..Char(255)]);
 end;
 
 {==============================================================================}
@@ -349,7 +397,7 @@ begin
   SetLength(Result, Length(Value));
   x := 1;
   l := 1;
-  while x < Length(Value) do
+  while x <= Length(Value) do
   begin
     for n := 0 to 3 do
     begin
@@ -382,45 +430,66 @@ begin
 end;
 
 {==============================================================================}
-
 function Decode4to3Ex(const Value, Table: string): string;
-var
+type
-  x, y, n, l: Integer;
+  TDconvert = record
-  d: array[0..3] of Byte;
+    case byte of
-begin
+      0: (a0, a1, a2, a3: char);
-  SetLength(Result, Length(Value));
+      1: (i: integer);
-  x := 1;
-  l := 1;
-  while x < Length(Value) do
-  begin
-    for n := 0 to 3 do
-    begin
-      if x > Length(Value) then
-        d[n] := 64
-      else
-      begin
-        y := Ord(Value[x]);
-        if (y < 33) or (y > 127) then
-          d[n] := 64
-        else
-          d[n] := Ord(Table[y - 32]);
-      end;
-      Inc(x);
-    end;
-    Result[l] := Char((D[0] and $3F) shl 2 + (D[1] and $30) shr 4);
-    Inc(l);
-    if d[2] <> 64 then
-    begin
-      Result[l] := Char((D[1] and $0F) shl 4 + (D[2] and $3C) shr 2);
-      Inc(l);
-      if d[3] <> 64 then
-      begin
-        Result[l] := Char((D[2] and $03) shl 6 + (D[3] and $3F));
-        Inc(l);
-      end;
-    end;
   end;
-  Dec(l);
+var
+  x, y, l, lv: Integer;
+  d: TDconvert;
+  dl: integer;
+  c: byte;
+  p: ^char;
+begin
+  lv := Length(Value);
+  SetLength(Result, lv);
+  x := 1;
+  dl := 4;
+  d.i := 0;
+  p := pointer(result);
+  while x <= lv do
+  begin
+    y := Ord(Value[x]);
+    if y in [33..127] then
+      c := Ord(Table[y - 32])
+    else
+      c := 64;
+    Inc(x);
+    if c > 63 then
+      continue;
+    d.i := (d.i shl 6) or c;
+    dec(dl);
+    if dl <> 0 then
+      continue;
+    p^ := d.a2;
+    inc(p);
+    p^ := d.a1;
+    inc(p);
+    p^ := d.a0;
+    inc(p);
+    d.i := 0;
+    dl := 4;
+  end;
+  case dl of
+    1:
+      begin
+        d.i := d.i shr 2;
+        p^ := d.a1;
+        inc(p);
+        p^ := d.a0;
+        inc(p);
+      end;
+    2:
+      begin
+        d.i := d.i shr 4;
+        p^ := d.a0;
+        inc(p);
+      end;
+  end;
+  l := integer(p) - integer(pointer(result));
   SetLength(Result, l);
 end;
 
@@ -516,6 +585,7 @@ begin
   s := Copy(Value, 2, x);
   if s = '' then
     Exit;
+  s := s + StringOfChar(' ', x - length(s));
   Result := Decode4to3(s, uut);
 end;
 
@@ -554,6 +624,7 @@ begin
   s := Copy(Value, 2, x);
   if s = '' then
     Exit;
+  s := s + StringOfChar(' ', x - length(s));
   Result := Decode4to3(s, TableXX);
 end;
 
@@ -772,7 +843,7 @@ begin
       Dec(Len, T);
       Index := T;
     end;
-    while Len >= 64 do
+    while Len > 64 do
     begin
       Move(Data[Index + 1], Bufchar, 64);
       MD5Transform(State, Buflong);
@@ -799,14 +870,15 @@ begin
     BufChar[P] := $80;
     Inc(P);
     Cnt := 64 - 1 - Cnt;
-    if Cnt < 8 then
+    if Cnt > 0 then
-    begin
+      if Cnt < 8 then
-      FillChar(BufChar[P], Cnt, #0);
+      begin
-      MD5Transform(State, BufLong);
+        FillChar(BufChar[P], Cnt, #0);
-      FillChar(BufChar, 56, #0);
+        MD5Transform(State, BufLong);
-    end
+        FillChar(BufChar, 56, #0);
-    else
+      end
-      FillChar(BufChar[P], Cnt - 8, #0);
+      else
+        FillChar(BufChar[P], Cnt - 8, #0);
     BufLong[14] := Count[0];
     BufLong[15] := Count[1];
     MD5Transform(State, BufLong);

synafpc.pas

@@ -0,0 +1,106 @@
+{==============================================================================|
+| Project : Ararat Synapse                                       | 001.000.000 |
+|==============================================================================|
+| Content: Utils for FreePascal compatibility                                  |
+|==============================================================================|
+| Copyright (c)1999-2003, 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/)                       |
+|==============================================================================}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+unit synafpc;
+
+interface
+
+{$IFDEF LINUX}
+  {$IFDEF FPC}
+uses
+  Libc,
+  dynlibs;
+
+type
+  HMODULE = Longint;
+
+function LoadLibrary(ModuleName: PChar): HMODULE;
+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}
+
+
+implementation
+
+{==============================================================================}
+{$IFDEF LINUX}
+  {$IFDEF FPC}
+function LoadLibrary(ModuleName: PChar): HMODULE;
+begin
+  Result := HMODULE(dynlibs.LoadLibrary(Modulename));
+end;
+
+function FreeLibrary(Module: HMODULE): LongBool;
+begin
+  Result := dynlibs.UnloadLibrary(pointer(Module));
+end;
+
+function GetProcAddress(Module: HMODULE; Proc: PChar): Pointer;
+begin
+  Result := dynlibs.GetProcedureAddress(pointer(Module), Proc);
+end;
+
+function GetModuleFileName(Module: HMODULE; Buffer: PChar; BufLen: Integer): Integer;
+begin
+  Result := 0;
+end; 
+
+procedure Sleep(milliseconds: Cardinal);
+begin
+  usleep(milliseconds * 1000);  // usleep is in microseconds
+end;
+ 
+  {$ENDIF}
+{$ENDIF}
+
+end.

synamisc.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.000.006 |
+| Project : Ararat Synapse                                       | 001.001.002 |
 |==============================================================================|
 | Content: misc. procedures and functions                                      |
 |==============================================================================|
@@ -42,9 +42,13 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
 {$Q-}
+{$H+}
 
-unit SynaMisc;
+unit synamisc;
 
 interface
 
@@ -57,11 +61,16 @@ interface
 {$ENDIF}
 
 uses
-  SynaUtil, blcksock, SysUtils, Classes,
+  synautil, blcksock, SysUtils, Classes,
 {$IFDEF LINUX}
   Libc;
 {$ELSE}
-  Windows, Wininet;
+{$IFDEF FPC}
+  winver,
+{$ELSE}
+  Wininet,
+{$ENDIF}
+  Windows;
 {$ENDIF}
 
 Type
@@ -258,6 +267,13 @@ begin
   Result.Bypass := '';
 end;
 {$ELSE}
+{$IFDEF FPC}
+begin
+  Result.Host := '';
+  Result.Port := '';
+  Result.Bypass := '';
+end;
+{$ELSE}
 var
   ProxyInfo: PInternetProxyInfo;
   Err: Boolean;
@@ -308,6 +324,7 @@ begin
   end;
 end;
 {$ENDIF}
+{$ENDIF}
 
 {==============================================================================}
 

synautil.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 003.005.001 |
+| Project : Ararat Synapse                                       | 004.000.002 |
 |==============================================================================|
 | Content: support procedures and functions                                    |
 |==============================================================================|
@@ -44,10 +44,14 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
 {$Q-}
 {$R-}
+{$H+}
 
-unit SynaUtil;
+unit synautil;
 
 interface
 
@@ -78,11 +82,14 @@ function DecodeInt(const Value: string; Index: Integer): Word;
 function IsIP(const Value: string): Boolean;
 function IsIP6(const Value: string): Boolean;
 function IPToID(Host: string): string;
+function DumpStr(const Buffer: string): string;
+function DumpExStr(const Buffer: string): string;
 procedure Dump(const Buffer, DumpFile: string);
 procedure DumpEx(const Buffer, DumpFile: string);
 function SeparateLeft(const Value, Delimiter: string): string;
 function SeparateRight(const Value, Delimiter: string): string;
 function GetParameter(const Value, Parameter: string): string;
+procedure ParseParametersEx(Value, Delimiter: string; const Parameters: TStrings);
 procedure ParseParameters(Value: string; const Parameters: TStrings);
 function IndexByBegin(Value: string; const List: TStrings): integer;
 function GetEmailAddr(const Value: string): string;
@@ -96,11 +103,15 @@ function ReplaceString(Value, Search, Replace: string): string;
 function RPosEx(const Sub, Value: string; From: integer): Integer;
 function RPos(const Sub, Value: String): Integer;
 function Fetch(var Value: string; const Delimiter: string): string;
+function FetchEx(var Value: string; const Delimiter, Quotation: string): string;
 function IsBinaryString(const Value: string): Boolean;
 function PosCRLF(const Value: string; var Terminator: string): integer;
 Procedure StringsTrim(const value: TStrings);
 function PosFrom(const SubStr, Value: String; From: integer): integer;
 function IncPoint(const p: pointer; Value: integer): pointer;
+function GetBetween(const PairBegin, PairEnd, Value: string): string;
+function CountOfChar(const Value: string; Chr: char): integer;
+function UnquoteStr(const Value: string; Quote: Char): string;
 
 implementation
 
@@ -121,8 +132,13 @@ var
   t: TTime_T;
   UT: TUnixTime;
 begin
+{$IFNDEF FPC}
   __time(@T);
   localtime_r(@T, UT);
+{$ELSE}
+  __time(T);
+  localtime_r(T, UT);
+{$ENDIF}
   Result := ut.__tm_gmtoff div 60;
 {$ELSE}
 var
@@ -430,6 +446,9 @@ begin
     day := 1;
   Result := Result + Encodedate(year, month, day);
   zone := zone - TimeZoneBias;
+  x := zone div 1440;
+  Result := Result - x;
+  zone := zone mod 1440;
   t := EncodeTime(Abs(zone) div 60, Abs(zone) mod 60, 0, 0);
   if zone < 0 then
     t := 0 - t;
@@ -440,17 +459,36 @@ end;
 
 function GetUTTime: TDateTime;
 {$IFNDEF LINUX}
+{$IFNDEF FPC}
 var
   st: TSystemTime;
 begin
- GetSystemTime(st);
+  GetSystemTime(st);
- result:=SystemTimeToDateTime(st);
+  result := SystemTimeToDateTime(st);
+{$ELSE}
+var
+  st: SysUtils.TSystemTime;
+  stw: Windows.TSystemTime;
+begin
+  GetSystemTime(stw);
+  st.Year := stw.wYear;
+  st.Month := stw.wMonth;
+  st.Day := stw.wDay;
+  st.Hour := stw.wHour;
+  st.Minute := stw.wMinute;
+  st.Second := stw.wSecond;
+  st.Millisecond := stw.wMilliseconds;
+  result := SystemTimeToDateTime(st);
+{$ENDIF}
 {$ELSE}
 var
   TV: TTimeVal;
+  TZ: Ttimezone;
 begin
-  gettimeofday(TV, nil);
+  TZ.tz_minuteswest := 0;
-  Result:=UnixDateDelta + (TV.tv_sec + TV.tv_usec / 1000000) / 86400;
+  TZ.tz_dsttime := 0;
+  gettimeofday(TV, TZ);
+  Result := UnixDateDelta + (TV.tv_sec + TV.tv_usec / 1000000) / 86400;
 {$ENDIF}
 end;
 
@@ -458,11 +496,27 @@ end;
 
 function SetUTTime(Newdt: TDateTime): Boolean;
 {$IFNDEF LINUX}
+{$IFNDEF FPC}
 var
   st: TSystemTime;
 begin
- DateTimeToSystemTime(newdt,st);
+  DateTimeToSystemTime(newdt,st);
- Result:=SetSystemTime(st);
+  Result := SetSystemTime(st);
+{$ELSE}
+var
+  st: SysUtils.TSystemTime;
+  stw: Windows.TSystemTime;
+begin
+  DateTimeToSystemTime(newdt,st);
+  stw.wYear := st.Year;
+  stw.wMonth := st.Month;
+  stw.wDay := st.Day;
+  stw.wHour := st.Hour;
+  stw.wMinute := st.Minute;
+  stw.wSecond := st.Second;
+  stw.wMilliseconds := st.Millisecond;
+  Result := SetSystemTime(stw);
+{$ENDIF}
 {$ELSE}
 var
   TV: TTimeVal;
@@ -470,6 +524,8 @@ var
   TZ: Ttimezone;
 begin
   Result := false;
+  TZ.tz_minuteswest := 0;
+  TZ.tz_dsttime := 0;
   gettimeofday(TV, TZ);
   d := (newdt - UnixDateDelta) * 86400;
   TV.tv_sec := trunc(d);
@@ -642,21 +698,45 @@ end;
 
 {==============================================================================}
 
-procedure Dump(const Buffer, DumpFile: string);
+function DumpStr(const Buffer: string): string;
 var
   n: Integer;
-  s: string;
+begin
+  Result := '';
+  for n := 1 to Length(Buffer) do
+    Result := Result + ' +#$' + IntToHex(Ord(Buffer[n]), 2);
+end;
+
+{==============================================================================}
+
+function DumpExStr(const Buffer: string): string;
+var
+  n: Integer;
+  x: Byte;
+begin
+  Result := '';
+  for n := 1 to Length(Buffer) do
+  begin
+    x := Ord(Buffer[n]);
+    if x in [65..90, 97..122] then
+      Result := Result + ' +''' + char(x) + ''''
+    else
+      Result := Result + ' +#$' + IntToHex(Ord(Buffer[n]), 2);
+  end;
+end;
+
+{==============================================================================}
+
+procedure Dump(const Buffer, DumpFile: string);
+var
   f: Text;
 begin
-  s := '';
-  for n := 1 to Length(Buffer) do
-    s := s + ' +#$' + IntToHex(Ord(Buffer[n]), 2);
   AssignFile(f, DumpFile);
   if FileExists(DumpFile) then
     DeleteFile(PChar(DumpFile));
   Rewrite(f);
   try
-    Writeln(f, s);
+    Writeln(f, DumpStr(Buffer));
   finally
     CloseFile(f);
   end;
@@ -666,26 +746,14 @@ end;
 
 procedure DumpEx(const Buffer, DumpFile: string);
 var
-  n: Integer;
-  x: Byte;
-  s: string;
   f: Text;
 begin
-  s := '';
-  for n := 1 to Length(Buffer) do
-  begin
-    x := Ord(Buffer[n]);
-    if x in [65..90, 97..122] then
-      s := s + ' +''' + char(x) + ''''
-    else
-      s := s + ' +#$' + IntToHex(Ord(Buffer[n]), 2);
-  end;
   AssignFile(f, DumpFile);
   if FileExists(DumpFile) then
     DeleteFile(PChar(DumpFile));
   Rewrite(f);
   try
-    Writeln(f, s);
+    Writeln(f, DumpExStr(Buffer));
   finally
     CloseFile(f);
   end;
@@ -720,7 +788,7 @@ end;
 
 function GetParameter(const Value, Parameter: string): string;
 var
-  x, x1: Integer;
+  x: Integer;
   s: string;
 begin
   x := Pos(UpperCase(Parameter), UpperCase(Value));
@@ -730,43 +798,39 @@ begin
     s := Copy(Value, x + Length(Parameter), Length(Value)
       - (x + Length(Parameter)) + 1);
     s := Trim(s);
-    x1 := Length(s);
     if Length(s) > 1 then
     begin
-      if s[1] = '"' then
+      x := pos(';', s);
-      begin
+      if x > 0 then
-        s := Copy(s, 2, Length(s) - 1);
+        s := Copy(s, 1, x - 1);
-        x := Pos('"', s);
+      Result := UnquoteStr(s, '"');
-        if x > 0 then
-          x1 := x - 1;
-      end
-      else
-      begin
-        x := Pos(' ', s);
-        if x > 0 then
-          x1 := x - 1;
-      end;
     end;
-    Result := Copy(s, 1, x1);
   end;
 end;
 
 {==============================================================================}
 
-procedure ParseParameters(Value: string; const Parameters: TStrings);
+procedure ParseParametersEx(Value, Delimiter: string; const Parameters: TStrings);
 var
   s: string;
 begin
   Parameters.Clear;
   while Value <> '' do
   begin
-    s := Fetch(Value, ';');
+    s := Fetch(Value, Delimiter);
     Parameters.Add(s);
   end;
 end;
 
 {==============================================================================}
 
+procedure ParseParameters(Value: string; const Parameters: TStrings);
+begin
+  ParseParametersEx(Value, ';', Parameters);
+end;
+
+{==============================================================================}
+
 function IndexByBegin(Value: string; const List: TStrings): integer;
 var
   n: integer;
@@ -1033,6 +1097,40 @@ end;
 
 {==============================================================================}
 
+function FetchEx(var Value: string; const Delimiter, Quotation: string): string;
+var
+  n: integer;
+  b: Boolean;
+begin
+  Result := '';
+  b := False;
+  n := 1;
+  while n <= Length(Value) do
+  begin
+    if b then
+    begin
+      if Pos(Quotation, Value) = 1 then
+        b := False;
+      Result := Result + Value[1];
+      Delete(Value, 1, 1);
+    end
+    else
+    begin
+      if Pos(Delimiter, Value) = 1 then
+      begin
+        Delete(Value, 1, Length(delimiter));
+        break;
+      end;
+      b := Pos(Quotation, Value) = 1;
+      Result := Result + Value[1];
+      Delete(Value, 1, 1);
+    end;
+  end;
+  Result := Trim(Result);
+end;
+
+{==============================================================================}
+
 function IsBinaryString(const Value: string): Boolean;
 var
   n: integer;
@@ -1132,4 +1230,53 @@ end;
 
 {==============================================================================}
 
+function GetBetween(const PairBegin, PairEnd, Value: string): string;
+var
+  n: integer;
+  x: integer;
+  s: string;
+begin
+  Result := '';
+  s := SeparateRight(Value, PairBegin);
+  x := 1;
+  for n := 1 to Length(s) do
+  begin
+    if s[n] = PairBegin then
+      Inc(x);
+    if s[n] = PairEnd then
+    begin
+      Dec(x);
+      if x <= 0 then
+        Break;
+    end;
+    Result := Result + s[n];
+  end;
+end;
+
+{==============================================================================}
+
+function CountOfChar(const Value: string; Chr: char): integer;
+var
+  n: integer;
+begin
+  Result := 0;
+  for n := 1 to Length(Value) do
+    if Value[n] = chr then
+      Inc(Result);
+end;
+
+{==============================================================================}
+
+function UnquoteStr(const Value: string; Quote: Char): string;
+var
+  LText: PChar;
+begin
+  LText := PChar(Value);
+  Result := AnsiExtractQuotedStr(LText, Quote);
+  if Result = '' then
+    Result := Value;
+end;
+
+{==============================================================================}
+
 end.

synsock.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 003.001.003 |
+| Project : Ararat Synapse                                       | 004.001.000 |
 |==============================================================================|
 | Content: Socket Independent Platform Layer                                   |
 |==============================================================================|
@@ -56,12 +56,16 @@ On Linux is level 2.2 always used!
 //{$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 when new 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 VER125}
   {$DEFINE BCB}
 {$ENDIF}
@@ -234,6 +238,9 @@ interface
 uses
   SyncObjs, SysUtils,
 {$IFDEF LINUX}
+  {$IFDEF FPC}
+  synafpc,
+  {$ENDIF}
   Libc;
 {$ELSE}
   Windows;
@@ -574,6 +581,15 @@ Const
 
   MSG_NOSIGNAL  = $4000;                // Do not generate SIGPIPE.
 
+  // getnameinfo constants
+  NI_MAXHOST	   = 1025;
+  NI_MAXSERV	   = 32;
+  NI_NOFQDN 	   = $4;
+  NI_NUMERICHOST = $1;
+  NI_NAMEREQD	   = $8;
+  NI_NUMERICSERV = $2;
+  NI_DGRAM       = $10;
+
 {=============================================================================}
 {$ELSE}
 Const
@@ -654,6 +670,15 @@ Const
 
   MSG_NOSIGNAL  = 0;
 
+  // getnameinfo constants
+  NI_MAXHOST	   = 1025;
+  NI_MAXSERV	   = 32;
+  NI_NOFQDN 	   = $1;
+  NI_NUMERICHOST = $2;
+  NI_NAMEREQD	   = $4;
+  NI_NUMERICSERV = $8;
+  NI_DGRAM       = $10;
+
 {$ENDIF}
 {=============================================================================}
 
@@ -721,15 +746,6 @@ const
   AI_CANONNAME   = $2;  // Return canonical name in first ai_canonname.
   AI_NUMERICHOST = $4;  // Nodename must be a numeric address string.
 
-  // getnameinfo constants
-  NI_MAXHOST	   = 1025;
-  NI_MAXSERV	   = 32;
-  NI_NOFQDN 	   = $1;
-  NI_NUMERICHOST = $2;
-  NI_NAMEREQD	   = $4;
-  NI_NUMERICSERV = $8;
-  NI_DGRAM       = $10;
-
 type
 { Structure used for manipulating linger option. }
   PLinger = ^TLinger;
@@ -971,87 +987,133 @@ const
 {=============================================================================}
 var
   WSAStartup: function(wVersionRequired: Word; var WSData: TWSAData): Integer
-    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   WSACleanup: function: Integer
-    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   WSAGetLastError: function: Integer
-    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   GetServByName: function(name, proto: PChar): PServEnt
-    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   GetServByPort: function(port: Integer; proto: PChar): PServEnt
-    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   GetProtoByName: function(name: PChar): PProtoEnt
-    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   GetProtoByNumber: function(proto: Integer): PProtoEnt
-    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   GetHostByName: function(name: PChar): PHostEnt
-    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   GetHostByAddr: function(addr: Pointer; len, Struc: Integer): PHostEnt
-    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   GetHostName: function(name: PChar; len: Integer): Integer
-    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   Shutdown: function(s: TSocket; how: Integer): Integer
-    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   SetSockOpt: function(s: TSocket; level, optname: Integer; optval: PChar;
-    optlen: Integer): Integer {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    optlen: Integer): Integer
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   GetSockOpt: function(s: TSocket; level, optname: Integer; optval: PChar;
-    var optlen: Integer): Integer {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    var optlen: Integer): Integer
-  SendTo: function(s: TSocket; var Buf; len, flags: Integer; addrto: PSockAddr;
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
-    tolen: Integer): Integer {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
-  Send: function(s: TSocket; var Buf; len, flags: Integer): Integer
+  SendTo: function(s: TSocket; const Buf; len, flags: Integer; addrto: PSockAddr;
-    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    tolen: Integer): Integer
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
+  Send: function(s: TSocket; const Buf; len, flags: Integer): Integer
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   Recv: function(s: TSocket; var Buf; len, flags: Integer): Integer
-    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   RecvFrom: function(s: TSocket; var Buf; len, flags: Integer; from: PSockAddr;
-    var fromlen: Integer): Integer {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    var fromlen: Integer): Integer
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   ntohs: function(netshort: u_short): u_short
-    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   ntohl: function(netlong: u_long): u_long
-    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   Listen: function(s: TSocket; backlog: Integer): Integer
-    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   IoctlSocket: function(s: TSocket; cmd: DWORD; var arg: u_long): Integer
-    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   Inet_ntoa: function(inaddr: TInAddr): PChar
-    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   Inet_addr: function(cp: PChar): u_long
-    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   htons: function(hostshort: u_short): u_short
-    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   htonl: function(hostlong: u_long): u_long
-    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   GetSockName: function(s: TSocket; name: PSockAddr; var namelen: Integer): Integer
-    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   GetPeerName: function(s: TSocket; name: PSockAddr; var namelen: Integer): Integer
-    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   Connect: function(s: TSocket; name: PSockAddr; namelen: Integer): Integer
-    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   CloseSocket: function(s: TSocket): Integer
-    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   Bind: function(s: TSocket; addr: PSockAddr; namelen: Integer): Integer
-    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   Accept: function(s: TSocket; addr: PSockAddr; var addrlen: Integer): TSocket
-    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   Socket: function(af, Struc, Protocol: Integer): TSocket
-    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   Select: function(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
-    timeout: PTimeVal): Longint {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    timeout: PTimeVal): Longint
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
 
   GetAddrInfo: function(NodeName: PChar; ServName: PChar; Hints: PAddrInfo;
     var Addrinfo: PAddrInfo): integer
-    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   FreeAddrInfo: procedure(ai: PAddrInfo)
-    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
   GetNameInfo: function( addr: PSockAddr; namelen: Integer; host: PChar;
     hostlen: DWORD; serv: PChar; servlen: DWORD; flags: integer): integer
-    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$IFNDEF FPC}{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil;
+    {$ELSE}= nil;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};{$ENDIF}
 
 {$IFNDEF LINUX}
-  __WSAFDIsSet: function (s: TSocket; var FDSet: TFDSet): Bool stdcall = nil;
+  __WSAFDIsSet: function (s: TSocket; var FDSet: TFDSet): Bool
+    {$IFNDEF FPC}stdcall = nil;
+    {$ELSE}= nil; stdcall;{$ENDIF}
+
   WSAIoctl: function (s: TSocket; dwIoControlCode: DWORD; lpvInBuffer: Pointer;
     cbInBuffer: DWORD; lpvOutBuffer: Pointer; cbOutBuffer: DWORD;
     lpcbBytesReturned: PDWORD; lpOverlapped: Pointer;
-    lpCompletionRoutine: pointer): u_int stdcall = nil;
+    lpCompletionRoutine: pointer): u_int
+    {$IFNDEF FPC}stdcall = nil;
+    {$ELSE}= nil; stdcall;{$ENDIF}
 {$ENDIF}
 
 {$IFDEF LINUX}
@@ -1061,10 +1123,24 @@ function LSWSAGetLastError: Integer; cdecl;
 {$ENDIF}
 
 var
-  SynSockCS: TCriticalSection;
+  SynSockCS: SyncObjs.TCriticalSection;
   SockEnhancedApi: Boolean;
   SockWship6Api: Boolean;
 
+type
+  TVarSin = packed record
+    case sin_family: u_short of
+      AF_INET: (sin_port: u_short;
+                sin_addr: TInAddr;
+                sin_zero: array[0..7] of Char);
+      AF_INET6: (sin6_port:     u_short;
+            		sin6_flowinfo: u_long;
+      		      sin6_addr:     TInAddr6;
+      		      sin6_scope_id: u_long);
+  end;
+
+function SizeOfVarSin(sin: TVarSin): integer;
+
 const
 {$IFDEF LINUX}
   DLLStackName = 'libc.so.6';
@@ -1132,7 +1208,11 @@ end;
 {=============================================================================}
 {$IFDEF LINUX}
 var
+{$IFNDEF FPC}
   errno_loc: function: PInteger cdecl = nil;
+{$ELSE}
+  errno_loc: function: PInteger = nil; cdecl;
+{$ENDIF}
 
 function LSWSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer;
 begin
@@ -1154,8 +1234,11 @@ begin
 end;
 
 function LSWSAGetLastError: Integer;
+var
+  p: PInteger;
 begin
-  Result := errno_loc^;
+  p := errno_loc;
+  Result := p^;
 end;
 
 function __FDELT(Socket: TSocket): Integer;
@@ -1237,6 +1320,19 @@ 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 InitSocketInterface(stack: string): Boolean;
 begin
   Result := False;
@@ -1251,10 +1347,8 @@ begin
       SockWship6Api := False;
 {$IFDEF LINUX}
       Libc.Signal(Libc.SIGPIPE, TSignalHandler(Libc.SIG_IGN));
-      LibHandle := HMODULE(dlopen(PChar(Stack), RTLD_GLOBAL));
-{$ELSE}
-      LibHandle := LoadLibrary(PChar(Stack));
 {$ENDIF}
+      LibHandle := LoadLibrary(PChar(Stack));
       if LibHandle <> 0 then
       begin
 {$IFDEF LINUX}
@@ -1362,7 +1456,7 @@ end;
 
 initialization
 begin
-  SynSockCS:= TCriticalSection.Create;
+  SynSockCS := SyncObjs.TCriticalSection.Create;
   SET_IN6_IF_ADDR_ANY (@in6addr_any);
   SET_LOOPBACK_ADDR6  (@in6addr_loopback);
 end;

tlntsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.001.001 |
+| Project : Ararat Synapse                                       | 001.001.003 |
 |==============================================================================|
 | Content: TELNET client                                                       |
 |==============================================================================|
@@ -44,13 +44,18 @@
 
 //RFC-854
 
-unit TlntSend;
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+unit tlntsend;
 
 interface
 
 uses
   SysUtils, Classes,
-  blcksock, SynaUtil;
+  blcksock, synautil;
 
 const
   cTelnetProtocol = 'telnet';