瀏覽代碼

update Synapse to the last sources

DmBel 2 年之前
父節點
當前提交
784482856a
共有 28 個文件被更改,包括 1011 次插入361 次删除
  1. 8 7
      asn1util.pas
  2. 14 20
      blcksock.pas
  3. 160 23
      ftpsend.pas
  4. 66 33
      httpsend.pas
  5. 2 1
      laz_synapse.pas
  6. 11 11
      mimemess.pas
  7. 27 13
      mimepart.pas
  8. 9 10
      pingsend.pas
  9. 1 1
      smtpsend.pas
  10. 17 5
      snmpsend.pas
  11. 4 0
      sntpsend.pas
  12. 15 14
      ssfpc.inc
  13. 19 9
      ssl_cryptlib.pas
  14. 25 14
      ssl_openssl.pas
  15. 86 31
      ssl_openssl_lib.pas
  16. 18 9
      sslinux.inc
  17. 58 33
      ssposix.inc
  18. 3 3
      sswin32.inc
  19. 53 7
      synachar.pas
  20. 8 8
      synacode.pas
  21. 0 1
      synacrypt.pas
  22. 5 5
      synadbg.pas
  23. 3 4
      synafpc.pas
  24. 3 3
      synaip.pas
  25. 255 44
      synamisc.pas
  26. 133 46
      synaser.pas
  27. 5 0
      synautil.pas
  28. 3 6
      synsock.pas

+ 8 - 7
asn1util.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 002.001.000 |
+| Project : Ararat Synapse                                       | 002.001.001 |
 |==============================================================================|
 | Content: support for ASN.1 BER coding and decoding                           |
 |==============================================================================|
-| Copyright (c)1999-2014, Lukas Gebauer                                        |
+| Copyright (c)1999-2021, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c) 1999-2014                |
+| Portions created by Lukas Gebauer are Copyright (c) 1999-2021                |
 | Portions created by Hernan Sanchez are Copyright (c) 2000.                   |
 | All Rights Reserved.                                                         |
 |==============================================================================|
@@ -379,9 +379,9 @@ end;
 {==============================================================================}
 function MibToId(Mib: String): AnsiString;
 var
-  x: Integer;
+  x: int64;
 
-  function WalkInt(var s: String): Integer;
+  function WalkInt(var s: String): int64;
   var
     x: Integer;
     t: AnsiString;
@@ -397,7 +397,7 @@ var
       t := Copy(s, 1, x - 1);
       s := Copy(s, x + 1, Length(s) - x);
     end;
-    Result := StrToIntDef(t, 0);
+    Result := StrToInt64Def(t, 0);
   end;
 
 begin
@@ -415,7 +415,8 @@ end;
 {==============================================================================}
 function IdToMib(const Id: AnsiString): String;
 var
-  x, y, n: Integer;
+  x, y: int64;
+  n: Integer;
 begin
   Result := '';
   n := 1;

+ 14 - 20
blcksock.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 009.010.000 |
+| Project : Ararat Synapse                                       | 009.010.002 |
 |==============================================================================|
 | Content: Library base                                                        |
 |==============================================================================|
-| Copyright (c)1999-2017, Lukas Gebauer                                        |
+| Copyright (c)1999-2021, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)1999-2017.                |
+| Portions created by Lukas Gebauer are Copyright (c)1999-2021.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -265,6 +265,7 @@ type
     LT_TLSv1,
     LT_TLSv1_1,
     LT_TLSv1_2,
+    LT_TLSv1_3,
     LT_SSHv2
     );
 
@@ -2621,12 +2622,13 @@ end;
 procedure TBlockSocket.RecvStreamSize(const Stream: TStream; Timeout: Integer; Size: int64);
 var
   s: TSynaBytes;
-  n: integer;
+  n: int64;
 {$IFDEF CIL}
   buf: TMemory;
 {$ENDIF}
 begin
-  for n := 1 to (Size div FSendMaxChunk) do
+  n := Size div int64(FSendMaxChunk);
+  while n > 0 do
   begin
     {$IFDEF CIL}
     SetLength(buf, FSendMaxChunk);
@@ -2640,8 +2642,9 @@ begin
       Exit;
     WriteStrToStream(Stream, s);
     {$ENDIF}
+    dec(n);
   end;
-  n := Size mod FSendMaxChunk;
+  n := Size mod int64(FSendMaxChunk);
   if n > 0 then
   begin
     {$IFDEF CIL}
@@ -3665,7 +3668,7 @@ begin
   end;
 end;
 
-  function TSocksBlockSocket.SocksDecode(const Value: string): integer;
+function TSocksBlockSocket.SocksDecode(const Value: string): integer;
 var
   Atyp: Byte;
   y, n: integer;
@@ -3859,7 +3862,7 @@ begin
 end;
 
 {$IFNDEF CIL}
-procedure TUDPBlockSocket.AddMulticast(const MCastIP:string);
+procedure TUDPBlockSocket.AddMulticast(const MCastIP: string);
 var
   Multicast: TIP_mreq;
   Multicast6: TIPv6_mreq;
@@ -3870,11 +3873,7 @@ begin
   begin
     ip6 := StrToIp6(MCastIP);
     for n := 0 to 15 do
-{$IFNDEF POSIX}
-      Multicast6.ipv6mr_multiaddr.u6_addr8[n] := Ip6[n];
-{$ELSE}
-      Multicast6.ipv6mr_multiaddr.s6_addr[n] := Ip6[n];
-{$ENDIF}
+      Multicast6.ipv6mr_multiaddr.{$IFDEF POSIX}s6_addr{$ELSE}u6_addr8{$ENDIF}[n] := Ip6[n];
     Multicast6.ipv6mr_interface := 0;
     SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IPV6, IPV6_JOIN_GROUP,
       Pointer(@Multicast6), SizeOf(Multicast6)));
@@ -3890,7 +3889,7 @@ begin
   ExceptCheck;
 end;
 
-procedure TUDPBlockSocket.DropMulticast(const MCastIP:string);
+procedure TUDPBlockSocket.DropMulticast(const MCastIP: string);
 var
   Multicast: TIP_mreq;
   Multicast6: TIPv6_mreq;
@@ -3901,12 +3900,7 @@ begin
   begin
     ip6 := StrToIp6(MCastIP);
     for n := 0 to 15 do
-{$IFNDEF POSIX}
-      Multicast6.ipv6mr_multiaddr.u6_addr8[n] := Ip6[n];
-{$ELSE}
-      Multicast6.ipv6mr_multiaddr.s6_addr[n] := Ip6[n];
-{$ENDIF}
-
+      Multicast6.ipv6mr_multiaddr.{$IFDEF POSIX}s6_addr{$ELSE}u6_addr8{$ENDIF}[n] := Ip6[n];
     Multicast6.ipv6mr_interface := 0;
     SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IPV6, IPV6_LEAVE_GROUP,
       Pointer(@Multicast6), SizeOf(Multicast6)));

+ 160 - 23
ftpsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 004.000.000 |
+| Project : Ararat Synapse                                       | 004.001.000 |
 |==============================================================================|
 | Content: FTP client                                                          |
 |==============================================================================|
@@ -34,10 +34,12 @@
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
 | Portions created by Lukas Gebauer are Copyright (c) 1999-2010.               |
+| Portions created by Jan Fiala are Copyright (c) 2019.                        |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
 |   Petr Esner <[email protected]>                                           |
+|   Jan Fiala                                                                  |
 |==============================================================================|
 | History: see HISTORY.HTM from distribution package                           |
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
@@ -67,6 +69,9 @@ interface
 
 uses
   SysUtils, Classes,
+  {$IfDef POSIX}
+   ,System.Generics.Collections, System.Generics.Defaults
+  {$EndIf}
   blcksock, synautil, synaip, synsock;
 
 const
@@ -122,12 +127,18 @@ type
     property Permission: string read FPermission write FPermission;
   end;
 
+  {$IFDEF POSIX}
+    TFTPRecList = TList<TFTPListRec>;
+  {$ELSE}
+    TFTPRecList = TList;
+  {$ENDIF}
+
   {:@abstract(This is TList of TFTPListRec objects.)
    This object is used for holding lististing of all files information in listed
    directory on FTP server.}
   TFTPList = class(TObject)
   protected
-    FList: TList;
+    FList: TFTPRecList;
     FLines: TStringList;
     FMasks: TStringList;
     FUnparsedLines: TStringList;
@@ -173,9 +184,13 @@ type
      @link(TFTPListRec).}
     procedure ParseLines; virtual;
 
+    {:try to parse MLSD directory listing in @link(lines) to list of
+     @link(TFTPListRec).}
+    procedure ParseMLSDLines; virtual;
+
     {:By this property you have access to list of @link(TFTPListRec).
      This is for compatibility only. Please, use @link(Items) instead.}
-    property List: TList read FList;
+    property List: TFTPRecList read FList;
 
     {:By this property you have access to list of @link(TFTPListRec).}
     property Items[Index: Integer]: TFTPListRec read GetListItem; default;
@@ -229,6 +244,7 @@ type
     FIsDataTLS: Boolean;
     FTLSonData: Boolean;
     FFullSSL: Boolean;
+    FUseMLSDList: Boolean;
     function Auth(Mode: integer): Boolean; virtual;
     function Connect: Boolean; virtual;
     function InternalStor(const Command: string; RestoreAt: int64): Boolean; virtual;
@@ -446,6 +462,9 @@ type
     {:If @true (default), then try to use SSL/TLS on data transfers too.
      If @false, then SSL/TLS is used only for control connection.}
     property TLSonData: Boolean read FTLSonData write FTLSonData;
+
+    {:Enable MLSD support for directory list.}
+    property UseMLSDList: Boolean read FUseMLSDList write FUseMLSDList;
   end;
 
 {:A very useful function, and example of use can be found in the TFtpSend object.
@@ -497,6 +516,7 @@ begin
   FIsTLS := False;
   FIsDataTLS := False;
   FTLSonData := True;
+  UseMLSDList := false;
 end;
 
 destructor TFTPSend.Destroy;
@@ -986,7 +1006,10 @@ begin
   if NameList then
     x := FTPCommand('NLST' + Directory)
   else
-    x := FTPCommand('LIST' + Directory);
+    if FUseMLSDList then
+      x := FTPCommand('MLSD' + Directory)
+    else
+      x := FTPCommand('LIST' + Directory);
   if (x div 100) <> 1 then
     Exit;
   Result := DataRead(FDataStream);
@@ -994,7 +1017,10 @@ begin
   begin
     FDataStream.Position := 0;
     FFTPList.Lines.LoadFromStream(FDataStream);
-    FFTPList.ParseLines;
+    if FUseMLSDList then
+      FFTPList.ParseMLSDLines
+    else
+      FFTPList.ParseLines;
   end;
   FDataStream.Position := 0;
 end;
@@ -1217,13 +1243,13 @@ end;
 constructor TFTPList.Create;
 begin
   inherited Create;
-  FList := TList.Create;
+  FList := TFTPRecList.Create;
   FLines := TStringList.Create;
   FMasks := TStringList.Create;
   FUnparsedLines := TStringList.Create;
   //various UNIX
-  FMasks.add('pppppppppp $!!!S*$TTT$DD$hh mm ss$YYYY$n*');
-  FMasks.add('pppppppppp $!!!S*$DD$TTT$hh mm ss$YYYY$n*');
+  FMasks.add('pppppppppp $!!!S*$TTT$DD$hh:mm:ss$YYYY$n*');                      //Fiala - pridany dvojtecky do casu
+  FMasks.add('pppppppppp $!!!S*$DD$TTT$hh:mm:ss$YYYY$n*');                      //Fiala - pridany dvojtecky do casu
   FMasks.add('pppppppppp $!!!S*$TTT$DD$UUUUU$n*');  //mostly used UNIX format
   FMasks.add('pppppppppp $!!!S*$DD$TTT$UUUUU$n*');
   //MacOS
@@ -1240,8 +1266,20 @@ begin
   FMasks.add('DD MM YYYY  hh mmH $ d!n*');
   //VMS
   FMasks.add('v*$  DD TTT YYYY hh mm');
+  FMasks.add('v*$DD TTT YYYY hh mm ss');
+  FMasks.add('v*$D TTT YYYY hh mm');                                            //Fiala
+  FMasks.add('v*$!DD TTT YYYY hh mm ss');
+  //sample:   ABB.DIR;1                1/35         18-SEP-2007 10:46:39  [STEVEH]               (RWE,RWE,RWE,RWE)
+  FMasks.add('v*\$!DD TTT YYYY hh mm ss');
+  //sample:   DELMAS.SQL;7             0/0           6-DEC-2007 10:43:44  [STEVEH]               (RWED,RWED,RWED,RWED)
+  FMasks.add('v*$!D TTT YYYY hh mm ss');                                        //Fiala
+  FMasks.add('v*\$!D TTT YYYY hh mm ss');                                       //Fiala
+  FMasks.add('v*$!D TTT YYYY hh mm ss');                                        //Fiala
+  FMasks.add('n*$                 YYYY MM DD hh mm$S*');                        //Fiala
+  //sample:   STANS_DIFF.DIR;1            1  13-APR-2006 13:27 [AGR4] (RWE,RWE,RE,E)
   FMasks.add('v*$!DD TTT YYYY hh mm');
-  FMasks.add('n*$                 YYYY MM DD hh mm$S*');
+//  FMasks.add('n*$                 YYYY MM DD hh mm$S*');
+  FMasks.add('$!: :n*');
   //AS400
   FMasks.add('!S*$MM DD YY hh mm ss !n*');
   FMasks.add('!S*$DD MM YY hh mm ss !n*');
@@ -1272,9 +1310,35 @@ begin
   //BullGCOS8
   FMasks.add('             $S* MM DD YY hh mm ss  !n*');
   FMasks.add('d            $S* MM DD YY           !n*');
+  //IBM AIXs
+  // sample:  -rw----      1 ITINERA      DAT       58 JAN 09  2008 TSITIS009VAJ_COB
+  FMasks.add('ppppppp $!!!S*$TTT$DD$YYYY$n*');                                  //Fiala
+
+  FMasks.add('pppppppppp                        SSSSSSSSSS DD !YYYY n*');       //Fiala
+  FMasks.add('pppppppppp                        SSSSSSSSSS DD !hh mm n*');      //Fiala
+  //          drwxr-xr-x  10 hol      prog          45056 20  8 10:00 adis30161
+  FMasks.add('pppppppppp                       SSSSSSSSSS DD MM!hh mm n*');     //Fiala
+  //          drwxr-xr-x   2 hol      prog           4096 20  1 2005  bin
+  FMasks.add('pppppppppp                       SSSSSSSSSS DD MM YYYY  n*');     //Fiala
+
+  //IBM VM                                                                      //Fiala
+  //          MQ_REPTS TESTVIEW V         72        139          1 2009-01-28 11:58:07 -
+  //          NEW               DIR        -          -          - 2009-11-04 18:31:50 -
+  FMasks.add('n*.$n*$             SSSSSSSSSS            YYYY-MM-DD hh:mm:ss -');
+  FMasks.add('nnnnnnnnnnnnnnnnn d          -          -          - YYYY-MM-DD hh:mm:ss -');
+  //sample:   Migrated                                                $SRC.AFLG
+  FMasks.add('       dxx                                              n*');     //Fiala
+  //VMS - new untouched files (name only)
+  //          ADR10AI2
+  FMasks.Add('n*§');                                                            //Fiala
+  //IBM VM
+  //          MQ_REPTS TESTVIEW V         72        139          1 2009-01-28 11:58:07 -
+  //          NEW               DIR        -          -          - 2009-11-04 18:31:50 -
+  FMasks.add('nnnnnnnnnnnnnnnnn  x           SSSSSSSSSS            YYYY-MM-DD hh:mm:ss -');
+  FMasks.add('nnnnnnnnnnnnnnnnn d          -          -          - YYYY-MM-DD hh:mm:ss -');
   //BullGCOS7
-  FMasks.add('                                         TTT DD  YYYY n*');
-  FMasks.add('  d                                                   n*');
+//  FMasks.add('                                         TTT DD  YYYY n*');
+//  FMasks.add('  d                                                   n*');
 end;
 
 destructor TFTPList.Destroy;
@@ -1366,16 +1430,17 @@ begin
   IMask := 1;
   Result := 1;
   LastMaskC := ' ';
+  Value := TrimRight(Value);                                                    //Fiala
   while Imask <= Length(mask) do
   begin
-    if (Mask[Imask] <> '*') and (Ivalue > Length(Value)) then
+    if not (Mask[Imask] in ['*', '\', '§']) and (Ivalue > Length(Value)) then   //Fiala
     begin
       Result := 0;
       Exit;
     end;
     MaskC := Mask[Imask];
-    if Ivalue > Length(Value) then
-      Exit;
+//    if Ivalue > Length(Value) then
+//      Exit;
     c := Value[Ivalue];
     case MaskC of
       'n':
@@ -1422,6 +1487,8 @@ begin
             Result := 0;
             Exit;
           end;
+      'y':                                                                        //Fiala
+        if c <> ' ' then Result := 0;
       '*':
         begin
           s := '';
@@ -1474,6 +1541,12 @@ begin
           end;
           Dec(IValue);
         end;
+      '§':                                                                      //Fiala
+        if IValue < Length(Value) then
+        begin
+          Result := 0;
+          Break;
+        end;
       '$':
         begin
           while IValue <= Length(Value) do
@@ -1512,6 +1585,12 @@ begin
               end;
           end;
         end;
+      ':':                                                                      //Fiala
+        if c <> ':' then
+        begin
+          Result := 0;
+          Exit;
+        end;
       '\':
         begin
           Value := NextValue;
@@ -1530,6 +1609,7 @@ var
   x, n: integer;
 begin
   Result := false;
+  if (Trim(FileName) = '') and (Trim(VMSFileName) = '') then Exit;              //Fiala
   if FileName <> '' then
   begin
     if pos('?', VMSFilename) > 0 then
@@ -1540,15 +1620,15 @@ begin
   if VMSFileName <> '' then
     if pos(';', VMSFilename) <= 0 then
       Exit;
-  if (FileName = '') and (VMSFileName = '') then
-    Exit;
+//  if (FileName = '') and (VMSFileName = '') then
+//    Exit;
   if Permissions <> '' then
   begin
-    if length(Permissions) <> 10 then
+    if (length(Permissions) <> 10) and (length(Permissions) <> 7) then          //Fiala
       Exit;
-    for n := 1 to 10 do
-      if not(Permissions[n] in
-        ['a', 'b', 'c', 'd', 'h', 'l', 'p', 'r', 's', 't', 'w', 'x', 'y', '-']) then
+    for n := 1 to length(Permissions) do                                        //Fiala
+      if not (Permissions[n] in 
+        ['a', 'b', 'c', 'd', 'h', 'l', 'p', 'r', 's', 't', 'w', 'x', 'y', '-', 'S']) then  //Fiala
         Exit;
   end;
   if Day <> '' then
@@ -1690,6 +1770,9 @@ begin
   {$ENDIF}
 
   DecodeDate(Date,myear,mmonth,mday);
+  myear := YearOf(Date);                                                        //Fiala
+  mMonth := 1;                                                                  //Fiala
+  mDay := 1;                                                                    //Fiala
   mhours := 0;
   mminutes := 0;
   mseconds := 0;
@@ -1718,9 +1801,13 @@ begin
       YearTime := TrimSP(YearTime);
       mhours := StrToIntDef(Separateleft(YearTime, ':'), 0);
       mminutes := StrToIntDef(SeparateRight(YearTime, ':'), 0);
-      if (Encodedate(myear, mmonth, mday)
-        + EncodeTime(mHours, mminutes, 0, 0)) > now then
-        Dec(mYear);
+      try   { osetreni spatneho formatu data }                                  //Fiala
+        if (Encodedate(myear, mmonth, mday)   //tohle kvuli spatnemu casu na FTP serveru
+          + EncodeTime(mHours, mminutes, 0, 0)) > now then
+          Dec(mYear);
+      except                                                                    //Fiala
+        mYear := YearOf(Date());                                                //Fiala
+      end;
     end
     else
       myear := StrToIntDef(YearTime, 0);
@@ -1737,6 +1824,10 @@ begin
         if mHours <> 12 then
           mHours := MHours + 12;
   end;
+  { osetrime prechodne roky }                                                   //Fiala
+  if (mday = 29) and (mmonth = 2) and not IsLeapYear(myear) then
+    Dec(Mday);
+
   Value.FileTime := Encodedate(myear, mmonth, mday)
     + EncodeTime(mHours, mminutes, mseconds, 0);
   if Permissions <> '' then
@@ -1961,4 +2052,50 @@ begin
   end;
 end;
 
+procedure TFTPList.ParseMLSDLines;
+var
+  flr: TFTPListRec;
+  i: Integer;
+  s: string;
+  ye,mo,da,ho,mi,se: Word;
+
+  function GetPart(const ALine, AName: string): string;
+  var
+    i, j: Integer;
+  begin
+    i := Pos(AnsiUpperCase(AName), AnsiUpperCase(ALine));
+    i := i + Length(AName);
+    j := PosEx(';', ALine, i);
+    if j < 1 then j := MaxInt;
+    Result := Copy(ALine, i, j-i);
+  end;
+
+begin
+  for i := 0 to Lines.Count - 1 do
+  begin
+    s := GetPart(Lines[i], 'modify=');
+    ye := StrToIntDef(Copy(s, 1, 4), 1970);
+    mo := StrToIntDef(Copy(s, 5, 2), 1);
+    da := StrToIntDef(Copy(s, 7, 2), 1);
+    ho := StrToIntDef(Copy(s, 9, 2), 0);
+    mi := StrToIntDef(Copy(s, 11, 2), 0);
+    se := StrToIntDef(Copy(s, 13, 2), 0);
+
+    flr := TFTPListRec.create;
+    flr.OriginalLine := Lines[i];
+    { osetrime kraviny, protoze autori FTP serveru nerespektuji RFC, tykajici se MLSD prikazu }
+    try
+      flr.FFileTime := EncodeDateTime(ye,mo,da,ho,mi,se, 0);
+    except
+      flr.FFileTime := EncodeDateTime(1970,1,1,0,0,0, 0);
+    end;
+    flr.FDirectory := AnsiSameText(GetPart(Lines[i], 'type='), 'dir') or AnsiSameText(GetPart(Lines[i], 'type='), 'cdir');
+    flr.FFileSize := StrToInt64Def(GetPart(Lines[i], 'size='), 0);
+    flr.FPermission := GetPart(Lines[i], 'mode=');
+    s := flr.FPermission;
+    flr.FFileName := GetPart(Lines[i], '; ');
+    Flist.Add(flr);
+  end;
+end;
+
 end.

+ 66 - 33
httpsend.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 003.012.009 |
+| Project : Ararat Synapse                                       | 003.013.000 |
 |==============================================================================|
 | Content: HTTP client                                                         |
 |==============================================================================|
-| Copyright (c)1999-2015, Lukas Gebauer                                        |
+| Copyright (c)1999-2021, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,8 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c) 1999-2015.               |
+| Portions created by Lukas Gebauer are Copyright (c) 1999-2021.               |
+| Portions created by Pepak are Copyright (c) 2020-2021.                       |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -63,6 +64,10 @@ Used RFC: RFC-1867, RFC-1947, RFC-2388, RFC-2616
   {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
 {$ENDIF}
 
+{$IFDEF NEXTGEN}
+  {$ZEROBASEDSTRINGS OFF}
+{$ENDIF}
+
 unit httpsend;
 
 interface
@@ -104,18 +109,21 @@ type
     FResultString: string;
     FUserAgent: string;
     FCookies: TStringList;
-    FDownloadSize: integer;
-    FUploadSize: integer;
-    FRangeStart: integer;
-    FRangeEnd: integer;
+    FDownloadSize: int64;
+    FUploadSize: int64;
+    FRangeStart: int64;
+    FRangeEnd: int64;
     FAddPortNumberToHost: Boolean;
+    FInputStream, FOutputStream: TStream;
     function ReadUnknown: Boolean; virtual;
-    function ReadIdentity(Size: Integer): Boolean; virtual;
+    function ReadIdentity(Size: int64): Boolean; virtual;
     function ReadChunked: Boolean; virtual;
     procedure ParseCookies;
     function PrepareHeaders: String;
     function InternalDoConnect(needssl: Boolean): Boolean;
     function InternalConnect(needssl: Boolean): Boolean;
+    function InputDocument: TStream;
+    function OutputDocument: TStream;
   public
     constructor Create;
     destructor Destroy; override;
@@ -161,13 +169,13 @@ type
 
     {:If you need to download only part of a requested document, specify here
      the position of subpart begin. If 0, the full document is requested.}
-    property RangeStart: integer read FRangeStart Write FRangeStart;
+    property RangeStart: int64 read FRangeStart Write FRangeStart;
 
     {:If you need to download only part of a requested document, specify here
      the position of subpart end. If 0, the document from rangeStart to end of
      document is requested.
      (Useful for resuming broken downloads, for example.)}
-    property RangeEnd: integer read FRangeEnd Write FRangeEnd;
+    property RangeEnd: int64 read FRangeEnd Write FRangeEnd;
 
     {:Mime type of sending data. Default is: 'text/html'.}
     property MimeType: string read FMimeType Write FMimeType;
@@ -212,12 +220,12 @@ type
     {:if this value is not 0, then data download is pending. In this case you
      have here the total size of downloaded data. Useful for drawing download
      progressbar from OnStatus event.}
-    property DownloadSize: integer read FDownloadSize;
+    property DownloadSize: int64 read FDownloadSize;
 
     {:if this value is not 0, then data upload is pending. In this case you have
      here the total size of uploaded data. Useful for drawing upload progressbar
      from OnStatus event.}
-    property UploadSize: integer read FUploadSize;
+    property UploadSize: int64 read FUploadSize;
 
     {:Socket object used for TCP/IP operation.
      Good for setting OnStatus hook, etc.}
@@ -226,6 +234,12 @@ type
     {:Allows to switch off port number in 'Host:' HTTP header. By default @TRUE.
      Some buggy servers do not like port informations in this header.}
     property AddPortNumberToHost: Boolean read FAddPortNumberToHost write FAddPortNumberToHost;
+  public
+    {:for direct sending from any TStream. Defalut nil = use Document property instead.}
+    property InputStream: TStream read FInputStream write FInputStream;
+
+    {:for direct dovnloading into any TStream. Defalut nil = use Document property instead.}
+    property OutputStream: TStream read FOutputStream write FOutputStream;
 
     property ConnectionTimeOut: Integer read FConnectionTimeOut
       write FConnectionTimeOut;
@@ -304,7 +318,8 @@ begin
   FUploadSize := 0;
   FAddPortNumberToHost := true;
   FKeepAliveTimeout := 300;
-
+  FInputStream := nil;
+  FOutputStream := nil;
   FConnectionTimeOut := 0;
   Clear;
 end;
@@ -318,11 +333,29 @@ begin
   inherited Destroy;
 end;
 
+function THTTPSend.InputDocument: TStream;
+begin
+  if InputStream <> nil then
+    Result := InputStream
+  else
+    Result := Document;
+end;
+
+function THTTPSend.OutputDocument: TStream;
+begin
+  if OutputStream <> nil then
+    Result := OutputStream
+  else
+    Result := Document;
+end;
+
 procedure THTTPSend.Clear;
 begin
   FRangeStart := 0;
   FRangeEnd := 0;
   FDocument.Clear;
+  InputDocument.Size := 0;
+  OutputDocument.Size := 0;
   FHeaders.Clear;
   FMimeType := 'text/html';
 end;
@@ -395,7 +428,7 @@ var
   status100: Boolean;
   status100error: string;
   ToClose: Boolean;
-  Size: Integer;
+  Size: int64;
   Prot, User, Pass, Host, Port, Path, Para, URI: string;
   s, su: String;
   HttpTunnel: Boolean;
@@ -412,7 +445,7 @@ begin
   FDownloadSize := 0;
   FUploadSize := 0;
 
-  URI := ParseURL(URL, Prot, User, Pass, Host, Port, Path, Para);
+  URI := ParseURL(trim(URL), Prot, User, Pass, Host, Port, Path, Para);
   User := DecodeURL(user);
   Pass := DecodeURL(pass);
   if User = '' then
@@ -437,14 +470,14 @@ begin
     FSock.HTTPTunnelPass := '';
   end;
   UsingProxy := (FProxyHost <> '') and not(HttpTunnel);
-  Sending := FDocument.Size > 0;
+  Sending := InputDocument.Size > 0;
   {Headers for Sending data}
   status100 := FStatus100 and Sending and (FProtocol = '1.1');
   if status100 then
     FHeaders.Insert(0, 'Expect: 100-continue');
   if Sending then
   begin
-    FHeaders.Insert(0, 'Content-Length: ' + IntToStr(FDocument.Size));
+    FHeaders.Insert(0, 'Content-Length: ' + IntToStr(InputDocument.Size));
     if FMimeType <> '' then
       FHeaders.Insert(0, 'Content-Type: ' + FMimeType);
   end;
@@ -526,7 +559,7 @@ begin
   end;
 
   { reading Status }
-  FDocument.Position := 0;
+  InputDocument.Position := 0;
   Status100Error := '';
   if status100 then
   begin
@@ -550,23 +583,23 @@ begin
     begin
       { we can upload content }
       Status100Error := '';
-      FUploadSize := FDocument.Size;
-      FSock.SendBuffer(FDocument.Memory, FDocument.Size);
+      FUploadSize := InputDocument.Size;
+      FSock.SendStreamRaw(InputDocument);
     end;
   end
   else
     { upload content }
     if sending then
     begin
-      if FDocument.Size >= c64k then
+      if InputDocument.Size >= c64k then
       begin
         FSock.SendString(PrepareHeaders);
-        FUploadSize := FDocument.Size;
-        FSock.SendBuffer(FDocument.Memory, FDocument.Size);
+        FUploadSize := InputDocument.Size;
+        FSock.SendStreamRaw(InputDocument);
       end
       else
       begin
-        s := PrepareHeaders + ReadStrFromStream(FDocument, FDocument.Size);
+        s := PrepareHeaders + ReadStrFromStream(InputDocument, InputDocument.Size);
         FUploadSize := Length(s);
         FSock.SendString(s);
       end;
@@ -602,7 +635,7 @@ begin
       begin
         { old HTTP 0.9 and some buggy servers not send result }
         s := s + CRLF;
-        WriteStrToStream(FDocument, s);
+        WriteStrToStream(OutputDocument, s);
         FResultCode := 0;
       end;
     until (FSock.LastError <> 0) or (FResultCode <> 100);
@@ -630,7 +663,7 @@ begin
         su := UpperCase(s);
         if Pos('CONTENT-LENGTH:', su) = 1 then
         begin
-          Size := StrToIntDef(Trim(SeparateRight(s, ':')), -1);
+          Size := StrToInt64Def(Trim(SeparateRight(s, ':')), -1);
           if (Size <> -1) and (FTransferEncoding = TE_UNKNOWN) then
             FTransferEncoding := TE_IDENTITY;
         end;
@@ -683,7 +716,7 @@ begin
         Result := ReadChunked;
     end;
 
-  FDocument.Position := 0;
+  OutputDocument.Position := 0;
   if ToClose then
   begin
     FSock.CloseSocket;
@@ -701,7 +734,7 @@ begin
   repeat
     s := FSock.RecvPacket(FTimeout);
     if FSock.LastError = 0 then
-      WriteStrToStream(FDocument, s);
+      WriteStrToStream(OutputDocument, s);
   until FSock.LastError <> 0;
   if FSock.LastError = WSAECONNRESET then
   begin
@@ -710,13 +743,13 @@ begin
   end;
 end;
 
-function THTTPSend.ReadIdentity(Size: Integer): Boolean;
+function THTTPSend.ReadIdentity(Size: int64): Boolean;
 begin
   if Size > 0 then
   begin
     FDownloadSize := Size;
-    FSock.RecvStreamSize(FDocument, FTimeout, Size);
-    FDocument.Position := FDocument.Size;
+    FSock.RecvStreamSize(OutputDocument, FTimeout, Size);
+    OutputDocument.Position := OutputDocument.Size;
     Result := FSock.LastError = 0;
   end
   else
@@ -726,7 +759,7 @@ end;
 function THTTPSend.ReadChunked: Boolean;
 var
   s: string;
-  Size: Integer;
+  Size: int64;
 begin
   repeat
     repeat
@@ -736,7 +769,7 @@ begin
       Break;
     s := Trim(SeparateLeft(s, ' '));
     s := Trim(SeparateLeft(s, ';'));
-    Size := StrToIntDef('$' + s, 0);
+    Size := StrToInt64Def('$' + s, 0);
     if Size = 0 then
       Break;
     if not ReadIdentity(Size) then

+ 2 - 1
laz_synapse.pas

@@ -4,6 +4,7 @@
 
 unit laz_synapse;
 
+{$warn 5023 off : no warning about unused units}
 interface
 
 uses
@@ -11,7 +12,7 @@ uses
   imapsend, ldapsend, mimeinln, mimemess, mimepart, nntpsend, pingsend, 
   pop3send, slogsend, smtpsend, snmpsend, sntpsend, synachar, synacode, 
   synacrypt, synadbg, synafpc, synaicnv, synaip, synamisc, synaser, synautil, 
-  synsock, tlntsend;
+  synsock, tlntsend, ssl_openssl, ssl_openssl_lib;
 
 implementation
 

+ 11 - 11
mimemess.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 002.006.000 |
+| Project : Ararat Synapse                                       | 002.006.001 |
 |==============================================================================|
 | Content: MIME message object                                                 |
 |==============================================================================|
-| Copyright (c)1999-2012, Lukas Gebauer                                        |
+| Copyright (c)1999-2021, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2000-2012.                |
+| Portions created by Lukas Gebauer are Copyright (c)2000-2021.                |
 | Portions created by Petr Fejfar are Copyright (c)2011-2012.                  |
 | All Rights Reserved.                                                         |
 |==============================================================================|
@@ -306,9 +306,9 @@ implementation
 constructor TMessHeader.Create;
 begin
   inherited Create;
-  FToList := TStringList.Create;
-  FCCList := TStringList.Create;
-  FCustomHeaders := TStringList.Create;
+  FToList := CreateStringList;
+  FCCList := CreateStringList;
+  FCustomHeaders := CreateStringList;
   FCharsetCode := GetCurCP;
 end;
 
@@ -583,7 +583,7 @@ constructor TMimeMess.CreateAltHeaders(HeadClass: TMessHeaderClass);
 begin
   inherited Create;
   FMessagePart := TMimePart.Create;
-  FLines := TStringList.Create;
+  FLines := CreateStringList;
   FHeader := HeadClass.Create;
 end;
 
@@ -687,7 +687,7 @@ function TMimeMess.AddPartTextFromFile(const FileName: String; const PartParent:
 var
   tmp: TStrings;
 begin
-  tmp := TStringList.Create;
+  tmp := CreateStringList;
   try
     tmp.LoadFromFile(FileName);
     Result := AddPartText(tmp, PartParent);
@@ -700,7 +700,7 @@ function TMimeMess.AddPartHTMLFromFile(const FileName: String; const PartParent:
 var
   tmp: TStrings;
 begin
-  tmp := TStringList.Create;
+  tmp := CreateStringList;
   try
     tmp.LoadFromFile(FileName);
     Result := AddPartHTML(tmp, PartParent);
@@ -784,7 +784,7 @@ function TMimeMess.AddPartMessFromFile(const FileName: String; const PartParent:
 var
   tmp: TStrings;
 begin
-  tmp := TStringList.Create;
+  tmp := CreateStringList;
   try
     tmp.LoadFromFile(FileName);
     Result := AddPartMess(tmp, PartParent);
@@ -801,7 +801,7 @@ var
   x: integer;
 begin
   //merge headers from THeaders and header field from MessagePart
-  l := TStringList.Create;
+  l := CreateStringList;
   try
     FHeader.EncodeHeaders(l);
     x := IndexByBegin('CONTENT-TYPE', FMessagePart.Headers);

+ 27 - 13
mimepart.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 002.009.000 |
+| Project : Ararat Synapse                                       | 002.009.002 |
 |==============================================================================|
 | Content: MIME support procedures and functions                               |
 |==============================================================================|
-| Copyright (c)1999-200812                                                         |
+| Copyright (c)1999-2021                                                       |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
 | modification, are permitted provided that the following conditions are met:  |
@@ -32,7 +32,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2000-2012.                |
+| Portions created by Lukas Gebauer are Copyright (c)2000-2021.                |
 | Portions created by Petr Fejfar are Copyright (c)2011-2012.                  |
 | All Rights Reserved.                                                         |
 |==============================================================================|
@@ -370,6 +370,8 @@ const
 
 {:Generates a unique boundary string.}
 function GenerateBoundary: string;
+{:Generates a stringlist that does not write a BOM character.}
+Function CreateStringList : TStringList;
 
 implementation
 
@@ -379,11 +381,11 @@ constructor TMIMEPart.Create;
 begin
   inherited Create;
   FOnWalkPart := nil;
-  FLines := TStringList.Create;
-  FPartBody := TStringList.Create;
-  FHeaders := TStringList.Create;
-  FPrePart := TStringList.Create;
-  FPostPart := TStringList.Create;
+  FLines := CreateStringList;
+  FPartBody := CreateStringList;
+  FHeaders := CreateStringList;
+  FPrePart := CreateStringList;
+  FPostPart := CreateStringList;
   FDecodedLines := TMemoryStream.Create;
   FSubParts := TList.Create;
   FTargetCharset := GetCurCP;
@@ -891,7 +893,7 @@ begin
     else
       s := CharsetConversion(s, FCharsetCode, FTargetCharset);
   WriteStrToStream(FDecodedLines, s);
-  FDecodedLines.Seek(0, soFromBeginning);
+  FDecodedLines.Position := 0;
 end;
 
 {==============================================================================}
@@ -964,15 +966,19 @@ end;
 procedure TMIMEPart.EncodePart;
 var
   l: TStringList;
-  s, t: string;
+{$IFDEF UNICODE}
+  s, t: RawByteString;
+{$ELSE}
+   s, t: string;
+{$ENDIF}
   n, x: Integer;
   d1, d2: integer;
 begin
   if (FEncodingCode = ME_UU) or (FEncodingCode = ME_XX) then
     Encoding := 'base64';
-  l := TStringList.Create;
+  l := CreateStringList;
   FPartBody.Clear;
-  FDecodedLines.Seek(0, soFromBeginning);
+  FDecodedLines.Position := 0;
   try
     case FPrimaryCode of
       MP_MULTIPART, MP_MESSAGE:
@@ -1074,7 +1080,7 @@ begin
     FHeaders.Insert(0, 'Content-Disposition: ' + LowerCase(FDisposition) + s);
   end;
   if FContentID <> '' then
-    FHeaders.Insert(0, 'Content-ID: ' + FContentID);
+    FHeaders.Insert(0, 'Content-ID: <' + FContentID + '>');
 
   case FEncodingCode of
     ME_7BIT:
@@ -1224,4 +1230,12 @@ begin
   Result := IntToHex(x, 8) + '_' + IntToHex(y, 8) + '_Synapse_boundary';
 end;
 
+function CreateStringList: TStringList;
+begin
+  Result := TStringList.Create;
+{$IFDEF UNICODE}
+  Result.WriteBOM := False;
+{$ENDIF}
+end;
+
 end.

+ 9 - 10
pingsend.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 004.000.002 |
+| Project : Ararat Synapse                                       | 004.000.004 |
 |==============================================================================|
 | Content: PING sender                                                         |
 |==============================================================================|
-| Copyright (c)1999-2010, Lukas Gebauer                                        |
+| Copyright (c)1999-2023, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2000-2010.                |
+| Portions created by Lukas Gebauer are Copyright (c)2000-2023.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -247,14 +247,14 @@ type
   end;
   PICMPV6_ECHO_REPLY = ^TICMPV6_ECHO_REPLY;
 
-  TIcmpCreateFile = function: integer; stdcall;
-  TIcmpCloseHandle = function(handle: integer): boolean; stdcall;
-  TIcmpSendEcho2 = function(handle: integer; Event: pointer; ApcRoutine: pointer;
+  TIcmpCreateFile = function: THandle; stdcall;
+  TIcmpCloseHandle = function(handle: THandle): boolean; stdcall;
+  TIcmpSendEcho2 = function(handle: THandle; Event: pointer; ApcRoutine: pointer;
     ApcContext: pointer; DestinationAddress: TInAddr; RequestData: pointer;
     RequestSize: integer; RequestOptions: PIP_OPTION_INFORMATION;
     ReplyBuffer: pointer; ReplySize: integer; Timeout: Integer): integer; stdcall;
-  TIcmp6CreateFile = function: integer; stdcall;
-  TIcmp6SendEcho2 = function(handle: integer; Event: pointer; ApcRoutine: pointer;
+  TIcmp6CreateFile = function: THandle; stdcall;
+  TIcmp6SendEcho2 = function(handle: THandle; Event: pointer; ApcRoutine: pointer;
     ApcContext: pointer; SourceAddress: PSockAddrIn6; DestinationAddress: PSockAddrIn6;
     RequestData: pointer; RequestSize: integer; RequestOptions: PIP_OPTION_INFORMATION;
     ReplyBuffer: pointer; ReplySize: integer; Timeout: Integer): integer; stdcall;
@@ -588,7 +588,7 @@ function TPINGSend.InternalPingIpHlp(const Host: string): Boolean;
 {$IFDEF MSWINDOWS}
 var
   PingIp6: boolean;
-  PingHandle: integer;
+  PingHandle: THandle;
   r: integer;
   ipo: TIP_OPTION_INFORMATION;
   RBuff: Ansistring;
@@ -618,7 +618,6 @@ begin
           PAnsichar(FBuffer), length(FBuffer), @ipo, pAnsichar(RBuff), length(RBuff), FTimeout);
         if r > 0 then
         begin
-          RBuff := #0 + #0 + RBuff;
           ip6reply := PICMPV6_ECHO_REPLY(pointer(RBuff));
           FPingTime := ip6reply^.RoundTripTime;
           ip6reply^.Address.sin6_family := AF_INET6;

+ 1 - 1
smtpsend.pas

@@ -589,7 +589,7 @@ end;
 function TSMTPSend.MailTo(const Value: string): Boolean;
 begin
   FSock.SendString('RCPT TO: <' + Value + '>' + CRLF);
-  Result := ReadResult = 250;
+  Result := ReadResult div 100 = 2;
 end;
 
 function TSMTPSend.MailData(const Value: TStrings): Boolean;

+ 17 - 5
snmpsend.pas

@@ -62,6 +62,7 @@ Supported Privacy encryptions: DES, 3DES, AES
 {$IFDEF UNICODE}
   {$WARN IMPLICIT_STRING_CAST OFF}
   {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+  {$TYPEINFO ON}
 {$ENDIF}
 
 unit snmpsend;
@@ -70,7 +71,13 @@ interface
 
 uses
   Classes, SysUtils,
-  blcksock, synautil, asn1util, synaip, synacode, synacrypt;
+  blcksock, synautil, asn1util, synaip, synacode, synacrypt
+  {$IfDef POSIX}
+   ,System.Generics.Collections, System.Generics.Defaults
+  {$EndIf}
+  {$IfDef NEXTGEN}
+   ,synafpc
+  {$EndIf};
 
 const
   cSnmpProtocol = '161';
@@ -161,6 +168,12 @@ type
     EngineStamp: Cardinal;
   end;
 
+  {$IFDEF POSIX}
+    TSNMPMibList = TList<TSNMPMib>;
+  {$ELSE}
+    TSNMPMibList = TList;
+  {$ENDIF}
+
   {:@abstract(Data object abstracts SNMP data packet)}
   TSNMPRec = class(TObject)
   protected
@@ -170,7 +183,7 @@ type
     FErrorStatus: Integer;
     FErrorIndex: Integer;
     FCommunity: AnsiString;
-    FSNMPMibList: TList;
+    FSNMPMibList: TSNMPMibList;
     FMaxSize: Integer;
     FFlags: TV3Flags;
     FFlagReportable: Boolean;
@@ -227,7 +240,7 @@ type
     function MIBByIndex(Index: Integer): TSNMPMib;
 
     {:List of @link(TSNMPMib) objects.}
-    property SNMPMibList: TList read FSNMPMibList;
+    property SNMPMibList: TSNMPMibList read FSNMPMibList;
   published
     {:Version of SNMP packet. Default value is 0 (SNMP ver. 1). You can use
      value 1 for SNMPv2c or value 3 for SNMPv3.}
@@ -435,7 +448,7 @@ implementation
 constructor TSNMPRec.Create;
 begin
   inherited Create;
-  FSNMPMibList := TList.Create;
+  FSNMPMibList := TSNMPMibList.Create;
   Clear;
   FAuthMode := AuthMD5;
   FPassword := '';
@@ -1003,7 +1016,6 @@ function TSNMPSend.SendRequest: Boolean;
 var
   sync: TV3Sync;
 begin
-  Result := False;
   if FQuery.FVersion = 3 then
   begin
     sync := GetV3Sync;

+ 4 - 0
sntpsend.pas

@@ -54,6 +54,10 @@ Used RFC: RFC-1305, RFC-2030
 {$Q-}
 {$H+}
 
+{$IFDEF NEXTGEN}
+  {$ZEROBASEDSTRINGS OFF}
+{$ENDIF}
+
 unit sntpsend;
 
 interface

+ 15 - 14
ssfpc.inc

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.001.005 |
+| Project : Ararat Synapse                                       | 001.001.008 |
 |==============================================================================|
 | Content: Socket Independent Platform Layer - FreePascal definition include   |
 |==============================================================================|
-| Copyright (c)2006-2013, Lukas Gebauer                                        |
+| Copyright (c)2006-2021, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2006-2013.                |
+| Portions created by Lukas Gebauer are Copyright (c)2006-2021.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -255,9 +255,8 @@ const
   MSG_OOB       = sockets.MSG_OOB;      // Process out-of-band data.
   MSG_PEEK      = sockets.MSG_PEEK;     // Peek at incoming messages.
   {$ifdef DARWIN}
-  MSG_NOSIGNAL  = $20000;  // Do not generate SIGPIPE.
-                           // Works under MAC OS X, but is undocumented,
-                           // So FPC doesn't include it
+  MSG_NOSIGNAL  = 0;  // Signal is disabled by SO_NOSIGPIPE socket option instead
+    //was $20000 as undocumented option for Mac OS X
   {$else}
    MSG_NOSIGNAL  = sockets.MSG_NOSIGNAL; // Do not generate SIGPIPE.
   {$endif}
@@ -366,7 +365,7 @@ type
         case sin_family: sa_family_t of
           AF_INET: (sin_port: word;
                     sin_addr: TInAddr;
-                    sin_zero: array[0..7] of Char);
+                    sin_zero: array[0..7] of byte);
           AF_INET6: (sin6_port:     word;
                 		sin6_flowinfo: FixedUInt;
       	    	      sin6_addr:     TInAddr6;
@@ -756,7 +755,7 @@ var
 begin
   Result := 0;
   FillChar(Sin, Sizeof(Sin), 0);
-  Sin.sin_port := Resolveport(port, family, SockProtocol, SockType);
+  Sin.sin_port := synsock.htons(Resolveport(port, family, SockProtocol, SockType));
   TwoPass := False;
   if Family = AF_UNSPEC then
   begin
@@ -851,7 +850,7 @@ begin
   end;
 
   if IPList.Count = 0 then
-    IPList.Add(cLocalHost);
+    IPList.Add(cAnyHost);
 end;
 
 function ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word;
@@ -859,14 +858,16 @@ var
   ProtoEnt: TProtocolEntry;
   ServEnt: TServiceEntry;
 begin
-  Result := synsock.htons(StrToIntDef(Port, 0));
+  Result := StrToIntDef(Port, 0);
   if Result = 0 then
   begin
     ProtoEnt.Name := '';
-    GetProtocolByNumber(SockProtocol, ProtoEnt);
-    ServEnt.port := 0;
-    GetServiceByName(Port, ProtoEnt.Name, ServEnt);
-    Result := ServEnt.port;  
+    if GetProtocolByNumber(SockProtocol, ProtoEnt) then
+    begin
+      ServEnt.port := 0;
+      if GetServiceByName(Port, ProtoEnt.Name, ServEnt) then
+        Result := synsock.ntohs(ServEnt.port);
+    end;
   end;
 end;
 

+ 19 - 9
ssl_cryptlib.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.001.001 |
+| Project : Ararat Synapse                                       | 001.001.002 |
 |==============================================================================|
 | Content: SSL/SSH support by Peter Gutmann's CryptLib                         |
 |==============================================================================|
@@ -79,6 +79,10 @@ and @link(TCustomSSL.password). You can use special SSH channels too, see
 {$ENDIF}
 {$H+}
 
+{$IFDEF NEXTGEN}
+  {$ZEROBASEDSTRINGS OFF}
+{$ENDIF}
+
 unit ssl_cryptlib;
 
 interface
@@ -296,7 +300,7 @@ begin
   FcryptSession := CRYPT_SESSION(CRYPT_SESSION_NONE);
   if server then
     case FSSLType of
-      LT_all, LT_SSLv3, LT_TLSv1, LT_TLSv1_1:
+      LT_all, LT_SSLv3, LT_TLSv1, LT_TLSv1_1, LT_TLSv1_2, LT_TLSv1_3:
         st := CRYPT_SESSION_SSL_SERVER;
       LT_SSHv2:
         st := CRYPT_SESSION_SSH_SERVER;
@@ -305,7 +309,7 @@ begin
     end
   else
     case FSSLType of
-      LT_all, LT_SSLv3, LT_TLSv1, LT_TLSv1_1:
+      LT_all, LT_SSLv3, LT_TLSv1, LT_TLSv1_1, LT_TLSv1_2, LT_TLSv1_3:
         st := CRYPT_SESSION_SSL;
       LT_SSHv2:
         st := CRYPT_SESSION_SSH;
@@ -322,6 +326,10 @@ begin
       x := 1;
     LT_TLSv1_1:
       x := 2;
+    LT_TLSv1_2:
+      x := 3;
+    LT_TLSv1_3:
+      x := 4;
   end;
   if x >= 0 then
     if not SSLCheck(cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_VERSION, x)) then
@@ -337,9 +345,9 @@ begin
     aUserName := fUserName;
     aPassword := fPassword;
     cryptSetAttributeString(FcryptSession, CRYPT_SESSINFO_USERNAME,
-      Pointer(FUsername), Length(FUsername));
+      Pointer(aUsername), Length(aUsername));
     cryptSetAttributeString(FcryptSession, CRYPT_SESSINFO_PASSWORD,
-      Pointer(FPassword), Length(FPassword));
+      Pointer(aPassword), Length(aPassword));
   end;
   if FSSLType = LT_SSHv2 then
     if FSSHChannelType <> '' then
@@ -507,7 +515,7 @@ begin
   if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then
     Exit;
   cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_VERSION, x);
-  if FSSLType in [LT_SSLv3, LT_TLSv1, LT_TLSv1_1, LT_all] then
+  if FSSLType in [LT_SSLv3, LT_TLSv1, LT_TLSv1_1, LT_TLSv1_2, LT_TLSv1_3, LT_all] then
     case x of
       0:
         Result := 'SSLv3';
@@ -515,6 +523,10 @@ begin
         Result := 'TLSv1';
       2:
         Result := 'TLSv1.1';
+      3:
+        Result := 'TLSv1.2';
+      4:
+        Result := 'TLSv1.3';
     end;
   if FSSLType in [LT_SSHv2] then
     case x of
@@ -676,6 +688,4 @@ initialization
   end;
 finalization
   cryptEnd;
-end.
-
-
+end.

+ 25 - 14
ssl_openssl.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.003.000 |
+| Project : Ararat Synapse                                       | 001.004.000 |
 |==============================================================================|
 | Content: SSL support by OpenSSL                                              |
 |==============================================================================|
@@ -35,6 +35,7 @@
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
 | Portions created by Lukas Gebauer are Copyright (c)2005-2017.                |
 | Portions created by Petr Fejfar are Copyright (c)2011-2012.                  |
+| Portions created by Pepak are Copyright (c)2018.                             |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -86,7 +87,7 @@ accepting of new connections!
   {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
 {$ENDIF}
 
-unit ssl_openssl;
+unit ssl_openssl{$IFDEF SUPPORTS_DEPRECATED} deprecated{$IFDEF SUPPORTS_DEPRECATED_DETAILS} 'Use ssl_openssl3 with OpenSSL 3.0 instead'{$ENDIF}{$ENDIF};
 
 interface
 
@@ -104,16 +105,20 @@ type
    Instance of this class will be created for each @link(TTCPBlockSocket).
    You not need to create instance of this class, all is done by Synapse itself!}
   TSSLOpenSSL = class(TCustomSSL)
+  private
+    FServer: boolean;
   protected
     FSsl: PSSL;
     Fctx: PSSL_CTX;
+    function NeedSigningCertificate: boolean; virtual;
     function SSLCheck: Boolean;
-    function SetSslKeys: boolean;
-    function Init(server:Boolean): Boolean;
+    function SetSslKeys: boolean; virtual;
+    function Init: Boolean;
     function DeInit: Boolean;
-    function Prepare(server:Boolean): Boolean;
+    function Prepare: Boolean;
     function LoadPFX(pfxdata: TSynaBytes): Boolean;
     function CreateSelfSignedCert(Host: string): Boolean; override;
+    property Server: boolean read FServer;
   public
     {:See @inherited}
     constructor Create(const Value: TTCPBlockSocket); override;
@@ -278,7 +283,7 @@ begin
   pk := EvpPkeynew;
   x := X509New;
   try
-    rsa := RsaGenerateKey(1024, $10001, nil, nil);
+    rsa := RsaGenerateKey(2048, $10001, nil, nil);
     EvpPkeyAssign(pk, EVP_PKEY_RSA, rsa);
     X509SetVersion(x, 2);
     Asn1IntegerSet(X509getSerialNumber(x), 0);
@@ -448,7 +453,12 @@ begin
   end;
 end;
 
-function TSSLOpenSSL.Init(server:Boolean): Boolean;
+function TSSLOpenSSL.NeedSigningCertificate: boolean;
+begin
+  Result := (FCertificateFile = '') and (FCertificate = '') and (FPFXfile = '') and (FPFX = '');
+end;
+
+function TSSLOpenSSL.Init: Boolean;
 var
   s: TSynabytes;
   buf: PByte;
@@ -502,8 +512,7 @@ begin
     SslCtxSetDefaultPasswdCbUserdata(FCtx, self);
 {$ENDIF}
 
-    if server and (FCertificateFile = '') and (FCertificate = '')
-      and (FPFXfile = '') and (FPFX = '') then
+    if server and NeedSigningCertificate then
     begin
       CreateSelfSignedcert(FSocket.ResolveIPToName(FSocket.GetRemoteSinIP));
     end;
@@ -539,11 +548,11 @@ begin
   FSSLEnabled := False;
 end;
 
-function TSSLOpenSSL.Prepare(server:Boolean): Boolean;
+function TSSLOpenSSL.Prepare: Boolean;
 begin
   Result := false;
   DeInit;
-  if Init(server) then
+  if Init then
     Result := true
   else
     DeInit;
@@ -560,7 +569,8 @@ begin
   Result := False;
   if FSocket.Socket = INVALID_SOCKET then
     Exit;
-  if Prepare(False) then
+  FServer := False;
+  if Prepare then
   begin
 {$IFDEF CIL}
     if sslsetfd(FSsl, FSocket.Socket.Handle.ToInt32) < 1 then
@@ -626,7 +636,8 @@ begin
   Result := False;
   if FSocket.Socket = INVALID_SOCKET then
     Exit;
-  if Prepare(True) then
+  FServer := True;
+  if Prepare then
   begin
 {$IFDEF CIL}
     if sslsetfd(FSsl, FSocket.Socket.Handle.ToInt32) < 1 then
@@ -1001,7 +1012,7 @@ end;
 {==============================================================================}
 
 initialization
-  if InitSSLInterface then
+//  if InitSSLInterface then
     SSLImplementation := TSSLOpenSSL;
 
 end.

+ 86 - 31
ssl_openssl_lib.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 003.008.000 |
+| Project : Ararat Synapse                                       | 003.009.000 |
 |==============================================================================|
 | Content: SSL support by OpenSSL                                              |
 |==============================================================================|
@@ -35,10 +35,12 @@
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
 | Portions created by Lukas Gebauer are Copyright (c)2002-2017.                |
 | Portions created by Petr Fejfar are Copyright (c)2011-2012.                  |
+| Portions created by Pepak are Copyright (c)2018.                             |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
 |   Tomas Hajny (OS2 support)                                                  |
+|   Pepak (multiversion support)                                               |
 |==============================================================================|
 | History: see HISTORY.HTM from distribution package                           |
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
@@ -100,6 +102,7 @@ uses
   {$ENDIF}
   SysUtils;
 {$ELSE}
+  SysUtils,
   Windows;
 {$ENDIF}
 
@@ -137,11 +140,59 @@ var
   DLLSSLName: string = 'ssleay32.dll';
   DLLSSLName2: string = 'libssl32.dll';
   DLLUtilName: string = 'libeay32.dll';
-
-  DLL_LIBCRYPTO_1_1: string = 'libcrypto-1_1.dll';
-  DLL_LIBSSL_1_1: string = 'libssl-1_1.dll';
-
   {$ENDIF}
+{$IFDEF MSWINDOWS}
+const
+  LibCount = 5;
+  SSLLibNames: array[0..LibCount-1] of string = (
+    // OpenSSL v3.0
+    {$IFDEF WIN64}
+    'libssl-3-x64.dll',
+    {$ELSE}
+    'libssl-3.dll',
+    {$ENDIF}
+    // OpenSSL v1.1.x
+    {$IFDEF WIN64}
+    'libssl-1_1-x64.dll',
+    {$ELSE}
+    'libssl-1_1.dll',
+    {$ENDIF}
+    // OpenSSL v1.0.2 distinct names for x64 and x86
+    {$IFDEF WIN64}
+    'ssleay32-x64.dll',
+    {$ELSE}
+    'ssleay32-x86.dll',
+    {$ENDIF}
+    // OpenSSL v1.0.2
+    'ssleay32.dll',
+    // OpenSSL (ancient)
+    'libssl32.dll'
+  );
+  CryptoLibNames: array[0..LibCount-1] of string = (
+    // OpenSSL v3.0
+    {$IFDEF WIN64}
+    'libcrypto-3-x64.dll',
+    {$ELSE}
+    'libcrypto-3.dll',
+    {$ENDIF}
+    // OpenSSL v1.1.x
+    {$IFDEF WIN64}
+    'libcrypto-1_1-x64.dll',
+    {$ELSE}
+    'libcrypto-1_1.dll',
+    {$ENDIF}
+    // OpenSSL v1.0.2 distinct names for x64 and x86
+    {$IFDEF WIN64}
+    'libeay32-x64.dll',
+    {$ELSE}
+    'libeay32-x86.dll',
+    {$ENDIF}
+    // OpenSSL v1.0.2
+    'libeay32.dll',
+    // OpenSSL (ancient)
+    'libeay32.dll'
+  );
+{$ENDIF}
 {$ENDIF}
 
 type
@@ -1171,7 +1222,6 @@ var
 {$ENDIF}
 {$ENDIF}
 
-
 var
   SSLCS: TCriticalSection;
   SSLloaded: boolean = false;
@@ -1938,7 +1988,7 @@ end;
 function d2iX509bio(b: PBIO; x: PX509): PX509; {pf}
 begin
   if InitSSLInterface {$IFNDEF STATIC}and Assigned(_d2iX509bio){$ENDIF} then
-    Result := _d2iX509bio(x,b)
+    Result := _d2iX509bio(b, x)
   else
     Result := nil;
 end;
@@ -2080,10 +2130,22 @@ begin
 end;
 {$ENDIF}
 
+function GetLibFileName(Handle: THandle): string;
+var
+  n: integer;
+begin
+  n := MAX_PATH + 1024;
+  SetLength(Result, n);
+  n := GetModuleFilename(Handle, PChar(Result), n);
+  SetLength(Result, n);
+end;
+
 function InitSSLInterface: Boolean;
+{$IFDEF MSWINDOWS}
 var
   s: string;
-  x: integer;
+  i: integer;
+{$ENDIF}
 begin
   {pf}
   if SSLLoaded then
@@ -2103,25 +2165,24 @@ begin
       SSLLibHandle := 1;
       SSLUtilHandle := 1;
 {$ELSE}
-
-    {$IFDEF MSWINDOWS}
-      SSLUtilHandle := LoadLib(DLL_LIBCRYPTO_1_1);
-      SSLLibHandle := LoadLib(DLL_LIBSSL_1_1);
-
-      if (SSLUtilHandle = 0) or (SSLLibHandle = 0) then
+      // Note: It's important to ensure that the libraries both come from the
+      // same directory, preferably the one of the executable. Otherwise a
+      // version mismatch could easily occur.
+      {$IFDEF MSWINDOWS}
+      for i := 0 to Pred(LibCount) do
       begin
-        FreeLibrary(SSLLibHandle);
-        FreeLibrary(SSLUtilHandle);
-        
-        SSLUtilHandle := LoadLib(DLLUtilName);
-        SSLLibHandle := LoadLib(DLLSSLName);
-        if (SSLLibHandle = 0) then
-          SSLLibHandle := LoadLib(DLLSSLName2);
+        SSLUtilHandle := LoadLib(CryptoLibNames[i]);
+        if SSLUtilHandle <> 0 then
+        begin
+          s := ExtractFilePath(GetLibFileName(SSLUtilHandle));
+          SSLLibHandle := LoadLib(s + SSLLibNames[i]);
+          Break;
+        end;
       end;
-    {$ELSE}
+      {$ELSE}
       SSLUtilHandle := LoadLib(DLLUtilName);
       SSLLibHandle := LoadLib(DLLSSLName);
-    {$ENDIF}
+      {$ENDIF}
 {$ENDIF}
       if (SSLLibHandle <> 0) and (SSLUtilHandle <> 0) then
       begin
@@ -2240,14 +2301,8 @@ begin
         OPENSSLaddallalgorithms;
         RandScreen;
 {$ELSE}
-        SetLength(s, 1024);
-        x := GetModuleFilename(SSLLibHandle,PChar(s),Length(s));
-        SetLength(s, x);
-        SSLLibFile := s;
-        SetLength(s, 1024);
-        x := GetModuleFilename(SSLUtilHandle,PChar(s),Length(s));
-        SetLength(s, x);
-        SSLUtilFile := s;
+        SSLLibFile := GetLibFileName(SSLLibHandle);
+        SSLUtilFile := GetLibFileName(SSLUtilHandle);
         //init library
         {$IFNDEF STATIC}if assigned(_SslLibraryInit) then{$ENDIF}
           _SslLibraryInit;

+ 18 - 9
sslinux.inc

@@ -64,11 +64,13 @@ interface
 uses
   SyncObjs, SysUtils, Classes,
   synafpc,
-  {$IFNDEF FPC}
-  Libc;
-  {$ELSE FPC}
-  libclite;
-  {$ENDIF ~FPC}
+  {$IFDEF POSIX} //even POSIX should use new ssPosix module instead...
+    Posix.Errno,
+    Posix.Signal,
+    Posix.NetDB
+  {$ELSE}
+    Libc
+  {$ENDIF};
 
 function InitSocketInterface(stack: string): Boolean;
 function DestroySocketInterface: Boolean;
@@ -83,6 +85,9 @@ type
   u_long = Longint;
   pu_long = ^u_long;
   pu_short = ^u_short;
+  {$IFDEF POSIX}
+    uint32_t = UInt32;
+  {$ENDIF}
   TSocket = u_int;
   TAddrFamily = integer;
 
@@ -152,9 +157,9 @@ type
       0: (sin_family: u_short;
           sin_port: u_short;
           sin_addr: TInAddr;
-          sin_zero: array[0..7] of Char);
+          sin_zero: array[0..7] of byte);
       1: (sa_family: u_short;
-          sa_data: array[0..13] of Char)
+          sa_data: array[0..13] of byte)
   end;
 
   TIP_mreq =  record
@@ -607,7 +612,7 @@ type
         case sin_family: u_short of
           AF_INET: (sin_port: u_short;
                     sin_addr: TInAddr;
-                    sin_zero: array[0..7] of Char);
+                    sin_zero: array[0..7] of byte);
           AF_INET6: (sin6_port:     u_short;
                 		sin6_flowinfo: u_long;
       	    	      sin6_addr:     TInAddr6;
@@ -1219,7 +1224,11 @@ begin
     begin
       SockEnhancedApi := False;
       SockWship6Api := False;
-      Signal(SIGPIPE, TSignalHandler(SIG_IGN));
+      {$IfDef POSIX}
+        Signal(SIGPIPE, TSignalHandler(SIG_IGN));
+      {$Else}
+        Libc.Signal(Libc.SIGPIPE, TSignalHandler(Libc.SIG_IGN));
+      {$EndIf}
       LibHandle := LoadLibrary(PChar(Stack));
       if LibHandle <> 0 then
       begin

+ 58 - 33
ssposix.inc

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.001.004 |
+| Project : Ararat Synapse                                       | 001.001.005 |
 |==============================================================================|
 | Content: Socket Independent Platform Layer - Delphi Posix definition include |
 |==============================================================================|
@@ -45,11 +45,12 @@
 
 {:@exclude}
 
+{$WARN UNIT_PLATFORM OFF}
+{$WARN SYMBOL_PLATFORM OFF}
+
 {$IFDEF POSIX}
 {for delphi XE2+}
 
-{$WARN SYMBOL_PLATFORM OFF}
-
 //{$DEFINE FORCEOLDAPI}
 {Note about define FORCEOLDAPI:
 If you activate this compiler directive, then is allways used old socket API
@@ -66,7 +67,6 @@ partially compatible with NextGen Delphi compiler - iOS
 
 }
 
-
 interface
 
 uses
@@ -92,10 +92,8 @@ const
 type
   TSocket = longint;
   TAddrFamily = integer;
-
   TMemory = pointer;
 
-
 type
   TFDSet = fd_set;
   PFDSet = Pfd_set;
@@ -242,7 +240,11 @@ const
   AF_UNSPEC       = Posix.SysSocket.AF_UNSPEC;// 0;               { unspecified }
   AF_INET         = Posix.SysSocket.AF_INET;  // 2;               { internetwork: UDP, TCP, etc. }
   AF_INET6        = Posix.SysSocket.AF_INET6; // !! 30            { Internetwork Version 6 }
+  {$IF DECLARED(Posix.SysSocket.AF_MAX)}
   AF_MAX          = Posix.SysSocket.AF_MAX;   // !! - variable by OS
+  {$Else}
+  AF_MAX = 43; //not declared for Android
+  {$IfEnd}
 
 { Protocol families, same as address families for now. }
   PF_UNSPEC       = AF_UNSPEC;
@@ -359,9 +361,13 @@ var
   SockEnhancedApi: Boolean;
   SockWship6Api: Boolean;
 
+{$IFDEF MACOS}
+   {$DEFINE SOCK_HAS_SINLEN} // OSX
+{$ENDIF}
+
 type
   TVarSin = packed record
-  {$IF defined(MACOS32) OR defined(IOS))}
+  {$ifdef SOCK_HAS_SINLEN}
      sin_len     : UInt8;
   {$endif}
 
@@ -371,7 +377,7 @@ type
         case sin_family: sa_family_t of
           AF_INET: (sin_port: word;
                     sin_addr: TInAddr;
-                    sin_zero: array[0..7] of Byte);
+                    sin_zero: array[0..7] of byte);
           AF_INET6: (sin6_port:     word;
                 		sin6_flowinfo: FixedUInt;
       	    	      sin6_addr:     TInAddr6;
@@ -474,6 +480,13 @@ begin
   a^.s6_addr[15] := 1;
 end;
 
+{$IFDEF NEXTGEN}
+function GetHostByName(const name: string):Phostent;
+begin
+  Result := Posix.NetDB.gethostbyname(MarshaledAString(TMarshal.AsAnsi(name)));
+end;
+{$ENDIF}
+
 {=============================================================================}
 
 function WSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer;
@@ -571,14 +584,27 @@ begin
 end;
 
 function GetHostName: string;
+const
+  cMaxHostLength = 255;
+{$IFDEF NEXTGEN}
 var
-  name: TBytes;
+  name: TArray<Byte>;
 begin
-  SetLength(name, 256);
-  fillchar(name[0],sizeof(name),0);
-  if Posix.Unistd.GetHostName(@name[0], length(name))=0 then
-   result := Uppercase(StringOf(name)) else
-   result := 'LOCALHOST';
+  Result := '';
+  SetLength(name, cMaxHostLength);
+  if Posix.Unistd.GetHostName(MarshaledAString(name), cMaxHostLength) = 0 then
+    Result := TEncoding.UTF8.GetString(name).ToUpper
+{$ELSE}
+var
+  s: AnsiString;
+begin
+  Result := '';
+  setlength(s, cMaxHostLength);
+  Posix.Unistd.GetHostName(PAnsiChar(s), Length(s) - 1);
+  Result := PChar(string(s));
+{$ENDIF}
+  if Result = '' then
+    Result := cLocalHostStr;
 end;
 
 function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
@@ -694,12 +720,6 @@ begin
     Result := (Family = AF_INET6) and SockWship6Api;
 end;
 
-function gethostbyname(name: pointer): PHostEnt; cdecl;
-  external libc name _PU + 'gethostbyname';
-
-function gethostbyaddr(var addr; len: socklen_t; atype: integer): PHostEnt; cdecl;
-  external libc name _PU + 'gethostbyaddr';
-
 function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
 var
   ProtoEnt: PProtoEnt;
@@ -713,7 +733,10 @@ var
   function GetAddr(const IP, port: string; Hints: AddrInfo; var Sin: TVarSin): integer;
   var
     Addr: PAddrInfo;
+    aIP,aPort : AnsiString;
   begin
+    aIP:=Utf8Encode(IP);
+    aPort:=Utf8Encode(Port);
     Addr := nil;
     try
       FillChar(Sin, Sizeof(Sin), 0);
@@ -721,23 +744,25 @@ var
       begin
         Hints.ai_socktype := 0;
         Hints.ai_protocol := 0;
-        Result := GetAddrInfo(MarshaledAString(TMarshal.AsAnsi(IP)), nil, Hints, Addr);
+        Result := GetAddrInfo(PAnsiChar(aIP), nil, Hints, Addr);
       end
       else
       begin
         if (IP = cAnyHost) or (IP = c6AnyHost) then
         begin
           Hints.ai_flags := AI_PASSIVE;
-          Result := GetAddrInfo(nil, MarshaledAString(TMarshal.AsAnsi(Port)), Hints, Addr);
+          Result := GetAddrInfo(nil, PAnsiChar(aPort), Hints, Addr);
         end
         else
           if (IP = cLocalhost) or (IP = c6Localhost) then
           begin
-            Result := GetAddrInfo(nil, MarshaledAString(TMarshal.AsAnsi(Port)), Hints, Addr);
+            Result := GetAddrInfo(nil, PAnsiChar(aPort), Hints, Addr);
           end
           else
           begin
-            Result := GetAddrInfo(MarshaledAString(TMarshal.AsAnsi(IP)), MarshaledAString(TMarshal.AsAnsi(Port)), Hints, Addr);
+            //for Android see code in System.Net.Socket TIPAddress.LookupName
+           // Result :=  getaddrinfo(M.AsUTF8(TURI.UnicodeToIDNA(aIP)).ToPointer, nil, Hints, Addr);
+            Result := GetAddrInfo(PAnsiChar(aIP), PAnsiChar(aPort), Hints, Addr);
           end;
       end;
       if Result = 0 then
@@ -838,12 +863,12 @@ end;
 
 function GetSinIP(Sin: TVarSin): string;
 var
-  p: pointer;
+  p: PAnsiChar;
   hostlen, servlen: integer;
   r: integer;
   sa:sockaddr absolute Sin;
   byHost, byServ: TBytes;
-  HostWrapper, ServWrapper: Pointer;
+  HostWrapper, ServWrapper: TPtrWrapper;
 begin
   Result := '';
   if not IsNewApi(Sin.AddressFamily) then
@@ -859,12 +884,12 @@ begin
     servlen := NI_MAXSERV;
     Setlength(byHost, hostLen);
     Setlength(byServ, hostLen);
-    HostWrapper := @byHost[0];
-    ServWrapper := @byServ[0];
-    r := getnameinfo(sa, SizeOfVarSin(sin), HostWrapper, hostlen,
-      ServWrapper, servlen, NI_NUMERICHOST + NI_NUMERICSERV);
+    HostWrapper := TPtrWrapper.Create(@byHost[0]);
+    ServWrapper := TPtrWrapper.Create(@byServ[0]);
+    r := getnameinfo(sa, SizeOfVarSin(sin), HostWrapper.ToPointer, hostlen,
+      ServWrapper.ToPointer, servlen, NI_NUMERICHOST + NI_NUMERICSERV);
     if r = 0 then
-      Result := MarshaledAString(HostWrapper);
+      Result := TMarshal.ReadStringAsAnsi(HostWrapper{, NI_MAXHOST});
   end;
 end;
 
@@ -981,7 +1006,7 @@ var
   ServEnt: PServEnt;
   Hints: AddrInfo;
   Addr: PAddrInfo;
-  _Addr: AddrInfo;
+  //_Addr: AddrInfo;
   r: integer;
 begin
   Result := 0;
@@ -1029,7 +1054,7 @@ function ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): s
 var
   Hints: AddrInfo;
   Addr: PAddrInfo;
-  _Addr: AddrInfo;
+  //_Addr: AddrInfo;
   r: integer;
   host, serv: TBytes;
   hostlen, servlen: integer;

+ 3 - 3
sswin32.inc

@@ -1455,7 +1455,7 @@ begin
       if ServEnt = nil then
         Result := StrToIntDef(string(Port), 0)
       else
-        Result := synsock.htons(ServEnt^.s_port);
+        Result := synsock.ntohs(ServEnt^.s_port);
     finally
       SynSockCS.Leave;
     end;
@@ -1473,9 +1473,9 @@ begin
       if (r = 0) and Assigned(Addr) then
       begin
         if Addr^.ai_family = AF_INET then
-          Result := synsock.htons(Addr^.ai_addr^.sin_port);
+          Result := synsock.ntohs(Addr^.ai_addr^.sin_port);
         if Addr^.ai_family = AF_INET6 then
-          Result := synsock.htons(PSockAddrIn6(Addr^.ai_addr)^.sin6_port);
+          Result := synsock.ntohs(PSockAddrIn6(Addr^.ai_addr)^.sin6_port);
       end;
     finally
       if Assigned(Addr) then

+ 53 - 7
synachar.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 005.002.004 |
+| Project : Ararat Synapse                                       | 005.002.005 |
 |==============================================================================|
 | Content: Charset conversion support                                          |
 |==============================================================================|
@@ -72,6 +72,11 @@ Internal routines knows all major charsets for Europe or America. For East-Asian
   {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
 {$ENDIF}
 
+{$IFDEF NEXTGEN}
+  {$LEGACYIFEND ON}
+  {$ZEROBASEDSTRINGS OFF}
+{$ENDIF}
+
 unit synachar;
 
 interface
@@ -79,6 +84,11 @@ interface
 uses
 {$IFNDEF MSWINDOWS}
   {$IFNDEF FPC}
+    {$IFNDEF POSIX}
+      Libc,
+    {$ELSE}
+      Posix.Langinfo,
+    {$ENDIF}
   {$ENDIF}
 {$ELSE}
   Windows,
@@ -1378,6 +1388,9 @@ var
   NotNeedTransform: Boolean;
   FromID, ToID: string;
 begin
+  if not synaicnv.InitIconvInterface then
+    DisableIconv := True;
+
   NotNeedTransform := (High(TransformTable) = 0);
   if (CharFrom = CharTo) and NotNeedTransform then
   begin
@@ -1502,8 +1515,16 @@ end;
 
 function GetCurCP: TMimeChar;
 begin
-  {$IFNDEF LINUX}
+  {$IFNDEF FPC}
+    {$IFNDEF POSIX}
   Result := GetCPFromID(nl_langinfo(_NL_CTYPE_CODESET_NAME));
+    {$ELSE}
+      {$IFNDEF ANDROID}
+  Result := GetCPFromID(nl_langinfo(CODESET));
+      {$ELSE}
+  Result := UTF_8;
+      {$ENDIF}
+    {$ENDIF}
   {$ELSE}
   //How to get system codepage without LIBC?
   Result := UTF_8;
@@ -1738,15 +1759,40 @@ begin
   Result := '';
   case Value of
     UCS_2:
-      Result := #$fe + #$ff;
+    begin
+      SetLength(Result, 2);
+      Result[1] := #$fe;
+      Result[2] := #$ff;
+    end;
     UCS_4:
-      Result := #$00 + #$00 + #$fe + #$ff;
+    begin
+      SetLength(Result, 4);
+      Result[1] := #$00;
+      Result[2] := #$00;
+      Result[3] := #$fe;
+      Result[4] := #$ff;
+    end;
     UCS_2LE:
-      Result := #$ff + #$fe;
+    begin
+      SetLength(Result, 2);
+      Result[1] := #$ff;
+      Result[2] := #$fe;
+    end;
     UCS_4LE:
-      Result := #$ff + #$fe + #$00 + #$00;
+    begin
+      SetLength(Result, 4);
+      Result[1] := #$ff;
+      Result[2] := #$fe;
+      Result[3] := #$00;
+      Result[4] := #$00;
+    end;
     UTF_8:
-      Result := #$ef + #$bb + #$bf;
+    begin
+      SetLength(Result, 3);
+      Result[1] := #$ef;
+      Result[2] := #$bb;
+      Result[3] := #$bf;
+    end;
   end;
 end;
 

+ 8 - 8
synacode.pas

@@ -201,10 +201,10 @@ function DecodeXX(const Value: String): String;
 function DecodeYEnc(const Value: String): String;
 
 {:Returns a new CRC32 value after adding a new byte of data.}
-function UpdateCrc32(Value: Byte; Crc32: Integer): Integer;
+function UpdateCrc32(Value: Byte; Crc32: Cardinal): Cardinal;
 
 {:return CRC32 from a value string.}
-function Crc32(const Value: String): Integer;
+function Crc32(const Value: String): Cardinal;
 
 {:Returns a new CRC16 value after adding a new byte of data.}
 function UpdateCrc16(Value: Byte; Crc16: Word): Word;
@@ -827,19 +827,19 @@ end;
 
 {==============================================================================}
 
-function UpdateCrc32(Value: Byte; Crc32: Integer): Integer;
+function UpdateCrc32(Value: Byte; Crc32: Cardinal): Cardinal;
 begin
   Result := (Crc32 shr 8)
-    xor crc32tab[Byte(Value xor (Crc32 and Integer($000000FF)))];
+    xor Cardinal(crc32tab[Byte(Value xor (Crc32 and Cardinal($000000FF)))]);
 end;
 
 {==============================================================================}
 
-function Crc32(const Value: String): Integer;
+function Crc32(const Value: String): Cardinal;
 var
   n: Integer;
 begin
-  Result := Integer($FFFFFFFF);
+  Result := $FFFFFFFF;
   for n := 1 to Length(Value) do
     Result := UpdateCrc32(Ord(Value[n]), Result);
   Result := not Result;
@@ -882,7 +882,7 @@ begin
   MDContext.State[3] := Integer($10325476);
 end;
 
-procedure MD5Transform(var Buf: array of LongInt; const Data: array of LongInt);
+procedure MD5Transform(var Buf: array of Integer; const Data: array of Integer);
 var
   A, B, C, D: LongInt;
 
@@ -1387,7 +1387,7 @@ end;
 
 {==============================================================================}
 
-procedure MD4Transform(var Buf: array of LongInt; const Data: array of LongInt);
+procedure MD4Transform(var Buf: array of Integer; const Data: array of Integer);
 var
   A, B, C, D: LongInt;
   function LRot32(a, b: longint): longint;

+ 0 - 1
synacrypt.pas

@@ -1989,7 +1989,6 @@ var
   Size: integer;
   KC, ROUNDS, j, r, t, rconpointer: FixedUInt;
   tk: array[0..MAXKC-1,0..3] of byte;
-  //n: integer;
 begin
   FillChar(tk,Sizeof(tk),0);
   //key must have at least 128 bits and max 256 bits

+ 5 - 5
synadbg.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.001.002 |
+| Project : Ararat Synapse                                       | 001.001.003 |
 |==============================================================================|
 | Content: Socket debug tools                                                  |
 |==============================================================================|
-| Copyright (c)2008-2011, Lukas Gebauer                                        |
+| Copyright (c)2008-2021, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2008-2011.                |
+| Portions created by Lukas Gebauer are Copyright (c)2008-2021.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -130,7 +130,7 @@ begin
   else
     s := '-unknown-';
   end;
-  s := inttohex(PtrInt(Sender), 8) + s + ': ' + value + CRLF;
+  s := inttohex(PtrInt(Sender), 2 * SizeOf(PtrInt)) + s + ': ' + value + CRLF;
   AppendToLog(s);
 end;
 
@@ -144,7 +144,7 @@ begin
     d := '-> '
   else
     d := '<- ';
-  s :=inttohex(PtrInt(Sender), 8) + d + s + CRLF;
+  s :=inttohex(PtrInt(Sender), 2 * SizeOf(PtrInt)) + d + s + CRLF;
   AppendToLog(s);
 end;
 

+ 3 - 4
synafpc.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.003.001 |
+| Project : Ararat Synapse                                       | 001.004.000 |
 |==============================================================================|
 | Content: Utils for FreePascal compatibility                                  |
 |==============================================================================|
-| Copyright (c)1999-2013, Lukas Gebauer                                        |
+| Copyright (c)1999-2022, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -38,6 +38,7 @@
 |==============================================================================|
 | Contributor(s):                                                              |
 |   Tomas Hajny (OS2 support)                                                  |
+|   Projeto ACBr                                                               |
 |==============================================================================|
 | History: see HISTORY.HTM from distribution package                           |
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
@@ -131,7 +132,6 @@ function GetModuleFileName(Module: TLibHandle; Buffer: PChar; BufLen: Integer):
 begin
   Result := 0;
 end;
-
 {$ELSE}
 {$ENDIF}
 
@@ -146,7 +146,6 @@ begin
 {$ELSE}
   sysutils.sleep(milliseconds);
 {$ENDIF}
-
 end;
 
 end.

+ 3 - 3
synaip.pas

@@ -42,7 +42,7 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
-{:@abstract(IP address support procedures and functions)}
+{:@abstract(IP adress support procedures and functions)}
 
 {$IFDEF FPC}
   {$MODE DELPHI}
@@ -65,9 +65,9 @@ uses
   SysUtils, SynaUtil;
 
 type
-{:binary form of IPv6 address (for string conversion routines)}
+{:binary form of IPv6 adress (for string conversion routines)}
   TIp6Bytes = array [0..15] of Byte;
-{:binary form of IPv6 address (for string conversion routines)}
+{:binary form of IPv6 adress (for string conversion routines)}
   TIp6Words = array [0..7] of Word;
 
 {:Returns @TRUE, if "Value" is a valid IPv4 address. Cannot be a symbolic Name!}

+ 255 - 44
synamisc.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.003.001 |
+| Project : Ararat Synapse                                       | 001.004.000 |
 |==============================================================================|
 | Content: misc. procedures and functions                                      |
 |==============================================================================|
-| Copyright (c)1999-2014, Lukas Gebauer                                        |
+| Copyright (c)1999-2022, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c) 2002-2010.               |
+| Portions created by Lukas Gebauer are Copyright (c) 2002-2022.               |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -111,13 +111,15 @@ Type
     Host: string;
     Port: string;
     Bypass: string;
+    ResultCode: integer;
+    Autodetected: boolean;
   end;
 
 {:With this function you can turn on a computer on the network, if this computer
- supports Wake-on-LAN feature. You need the MAC address 
- (network card identifier) of the computer. You can also assign a target IP 
- addres. If you do not specify it, then broadcast is used to deliver magic 
- wake-on-LAN packet. 
+ supports Wake-on-LAN feature. You need the MAC address
+ (network card identifier) of the computer. You can also assign a target IP
+ addres. If you do not specify it, then broadcast is used to deliver magic
+ wake-on-LAN packet.
  However broadcasts work only on your local network. When you need to wake-up a
  computer on another network, you must specify any existing IP addres on same
  network segment as targeting computer.}
@@ -127,14 +129,23 @@ procedure WakeOnLan(MAC, IP: string);
  is defined, then the result is comma-delimited.}
 function GetDNS: string;
 
-{:Autodetect InternetExplorer proxy setting for given protocol. This function
+{:Read InternetExplorer 5.0+ proxy setting for given protocol. This function
 works only on windows!}
 function GetIEProxy(protocol: string): TProxySetting;
 
-{:Return all known IP addresses on the local system. Addresses are divided by 
+{:Return all known IP addresses of required type on the local system. Addresses are divided by
 comma/comma-delimited.}
-procedure GetLocalIPs(iplist: TStrings; ipfamily: Integer); overload;
-function GetLocalIPs: string; overload
+function GetLocalIPsFamily(value: TSocketFamily): string;
+
+{:Return all known IP addresses on the local system. Addresses are divided by
+comma/comma-delimited.}
+function GetLocalIPs: string;
+
+{$IFDEF MSWINDOWS}
+{:Autodetect system proxy setting for specified URL. This function
+works only on windows!}
+function GetProxyForURL(const AURL: WideString): TProxySetting;
+{$ENDIF}
 
 implementation
 
@@ -359,22 +370,53 @@ begin
   Result.Host := '';
   Result.Port := '';
   Result.Bypass := '';
+  Result.ResultCode := -1;
+  Result.Autodetected := false;
 end;
 {$ELSE}
 type
-  PInternetProxyInfo = ^TInternetProxyInfo;
-  TInternetProxyInfo = packed record
-    dwAccessType: DWORD;
-    lpszProxy: LPCSTR;
-    lpszProxyBypass: LPCSTR;
+  PInternetPerConnOption = ^INTERNET_PER_CONN_OPTION;
+  INTERNET_PER_CONN_OPTION = record
+    dwOption: DWORD;
+    case Integer of
+      0: (dwValue: DWORD);
+//      1: (pszValue:LPTSTR);
+      1: (pszValue:PAnsiChar);
+      2: (ftValue: FILETIME);
+    end;
+
+  PInternetPerConnOptionList = ^INTERNET_PER_CONN_OPTION_LIST;
+  INTERNET_PER_CONN_OPTION_LIST = record
+    dwSize        :DWORD;
+//    pszConnection :LPTSTR;
+    pszConnection :PAnsiChar;
+    dwOptionCount :DWORD;
+    dwOptionError :DWORD;
+    pOptions      :PInternetPerConnOption;
   end;
 const
-  INTERNET_OPTION_PROXY = 38;
-  INTERNET_OPEN_TYPE_PROXY = 3;
+  INTERNET_PER_CONN_FLAGS               = 1;
+  INTERNET_PER_CONN_PROXY_SERVER        = 2;
+  INTERNET_PER_CONN_PROXY_BYPASS        = 3;
+  INTERNET_PER_CONN_AUTOCONFIG_URL      = 4;
+  INTERNET_PER_CONN_AUTODISCOVERY_FLAGS = 5;
+  PROXY_TYPE_DIRECT         = $00000001;   // direct to net
+  PROXY_TYPE_PROXY          = $00000002;   // via named proxy
+  PROXY_TYPE_AUTO_PROXY_URL = $00000004;   // autoproxy URL
+  PROXY_TYPE_AUTO_DETECT    = $00000008;   // use autoproxy detection
+  AUTO_PROXY_FLAG_USER_SET                  =      $00000001;   // user changed this setting
+  AUTO_PROXY_FLAG_ALWAYS_DETECT             =      $00000002;   // force detection even when its not needed
+  AUTO_PROXY_FLAG_DETECTION_RUN             =      $00000004;   // detection has been run
+  AUTO_PROXY_FLAG_MIGRATED                  =      $00000008;   // migration has just been done
+  AUTO_PROXY_FLAG_DONT_CACHE_PROXY_RESULT   =      $00000010;   // don't cache result of host=proxy name
+  AUTO_PROXY_FLAG_CACHE_INIT_RUN            =      $00000020;   // don't initalize and run unless URL expired
+  AUTO_PROXY_FLAG_DETECTION_SUSPECT         =      $00000040;   // if we're on a LAN & Modem, with only one IP, bad?!?
+  INTERNET_OPTION_PER_CONNECTION_OPTION   = 75;
   WininetDLL = 'WININET.DLL';
 var
   WininetModule: THandle;
-  ProxyInfo: PInternetProxyInfo;
+  Option : array[0..4] of INTERNET_PER_CONN_OPTION;
+  List   : INTERNET_PER_CONN_OPTION_LIST;
   Err: Boolean;
   Len: DWORD;
   Proxy: string;
@@ -387,6 +429,8 @@ begin
   Result.Host := '';
   Result.Port := '';
   Result.Bypass := '';
+  Result.ResultCode := 0;
+  Result.Autodetected := false;
   WininetModule := LoadLibrary(WininetDLL);
   if WininetModule = 0 then
     exit;
@@ -397,15 +441,25 @@ begin
 
     if protocol = '' then
       protocol := 'http';
-    Len := 4096;
-    GetMem(ProxyInfo, Len);
     ProxyList := TStringList.Create;
     try
-      Err := InternetQueryOption(nil, INTERNET_OPTION_PROXY, ProxyInfo, Len);
+      Option[0].dwOption := INTERNET_PER_CONN_AUTOCONFIG_URL;
+      Option[1].dwOption := INTERNET_PER_CONN_AUTODISCOVERY_FLAGS;
+      Option[2].dwOption := INTERNET_PER_CONN_FLAGS;
+      Option[3].dwOption := INTERNET_PER_CONN_PROXY_BYPASS;
+      Option[4].dwOption := INTERNET_PER_CONN_PROXY_SERVER;
+
+      List.dwSize        := SizeOf(INTERNET_PER_CONN_OPTION_LIST);
+      List.pszConnection := nil;      // LAN
+      List.dwOptionCount := 5;
+      List.dwOptionError := 0;
+      List.pOptions      := @Option;
+
+
+      Err := InternetQueryOption(nil, INTERNET_OPTION_PER_CONNECTION_OPTION, @List, List.dwSize);
       if Err then
-        if ProxyInfo^.dwAccessType = INTERNET_OPEN_TYPE_PROXY then
         begin
-          ProxyList.CommaText := ReplaceString(ProxyInfo^.lpszProxy, ' ', ',');
+          ProxyList.CommaText := ReplaceString(Option[4].pszValue, ' ', ',');
           Proxy := '';
           DefProxy := '';
           for n := 0 to ProxyList.Count -1 do
@@ -425,11 +479,10 @@ begin
             Result.Host := Trim(SeparateLeft(Proxy, ':'));
             Result.Port := Trim(SeparateRight(Proxy, ':'));
           end;
-          Result.Bypass := ReplaceString(ProxyInfo^.lpszProxyBypass, ' ', ',');
+          Result.Bypass := ReplaceString(Option[3].pszValue, ' ', ',');
         end;
     finally
       ProxyList.Free;
-      FreeMem(ProxyInfo);
     end;
   finally
     FreeLibrary(WininetModule);
@@ -440,23 +493,7 @@ end;
 
 {==============================================================================}
 
-procedure GetLocalIPs(iplist: TStrings; ipfamily: Integer);
-var
-  TcpSock: TTCPBlockSocket;
-begin
-    TcpSock := TTCPBlockSocket.create;
-    case ipfamily of
-      1 : TcpSock.family:=SF_IP4;
-      2 : TcpSock.family:=SF_IP6;
-    end;
-    try
-      TcpSock.ResolveNameToIP(TcpSock.LocalName, ipList);
-    finally
-      TcpSock.Free;
-    end;
-end;
-
-function GetLocalIPs: string;
+function GetLocalIPsFamily(value: TSocketFamily): string;
 var
   TcpSock: TTCPBlockSocket;
   ipList: TStringList;
@@ -465,8 +502,9 @@ begin
   ipList := TStringList.Create;
   try
     TcpSock := TTCPBlockSocket.create;
-    TcpSock.family:=SF_IP4;
     try
+      if value <> SF_Any then
+        TcpSock.family := value;
       TcpSock.ResolveNameToIP(TcpSock.LocalName, ipList);
       Result := ipList.CommaText;
     finally
@@ -477,6 +515,179 @@ begin
   end;
 end;
 
+function GetLocalIPs: string;
+begin
+  Result := GetLocalIPsFamily(SF_Any);
+end;
+
 {==============================================================================}
 
+{$IFDEF MSWINDOWS}
+function GetProxyForURL(const AURL: WideString): TProxySetting;
+type
+  HINTERNET = Pointer;
+  INTERNET_PORT = Word;
+  PWinHTTPProxyInfo = ^TWinHTTPProxyInfo;
+  WINHTTP_PROXY_INFO = record
+    dwAccessType: DWORD;
+    lpszProxy: LPWSTR;
+    lpszProxyBypass: LPWSTR;
+  end;
+  TWinHTTPProxyInfo = WINHTTP_PROXY_INFO;
+  LPWINHTTP_PROXY_INFO = PWinHTTPProxyInfo;
+  PWinHTTPAutoProxyOptions = ^TWinHTTPAutoProxyOptions;
+  WINHTTP_AUTOPROXY_OPTIONS = record
+    dwFlags: DWORD;
+    dwAutoDetectFlags: DWORD;
+    lpszAutoConfigUrl: LPCWSTR;
+    lpvReserved: Pointer;
+    dwReserved: DWORD;
+    fAutoLogonIfChallenged: BOOL;
+  end;
+  TWinHTTPAutoProxyOptions = WINHTTP_AUTOPROXY_OPTIONS;
+  LPWINHTTP_AUTOPROXY_OPTIONS = PWinHTTPAutoProxyOptions;
+  PWinHTTPCurrentUserIEProxyConfig = ^TWinHTTPCurrentUserIEProxyConfig;
+  WINHTTP_CURRENT_USER_IE_PROXY_CONFIG = record
+    fAutoDetect: BOOL;
+    lpszAutoConfigUrl: LPWSTR;
+    lpszProxy: LPWSTR;
+    lpszProxyBypass: LPWSTR;
+  end;
+  TWinHTTPCurrentUserIEProxyConfig = WINHTTP_CURRENT_USER_IE_PROXY_CONFIG;
+  LPWINHTTP_CURRENT_USER_IE_PROXY_CONFIG = PWinHTTPCurrentUserIEProxyConfig;
+const
+  WINHTTP_NO_REFERER = nil;
+  WINHTTP_NO_PROXY_NAME = nil;
+  WINHTTP_NO_PROXY_BYPASS = nil;
+  WINHTTP_DEFAULT_ACCEPT_TYPES = nil;
+  WINHTTP_ACCESS_TYPE_DEFAULT_PROXY = 0;
+  WINHTTP_ACCESS_TYPE_NO_PROXY = 1;
+  WINHTTP_OPTION_PROXY = 38;
+  WINHTTP_OPTION_PROXY_USERNAME = $1002;
+  WINHTTP_OPTION_PROXY_PASSWORD = $1003;
+  WINHTTP_AUTOPROXY_AUTO_DETECT = $00000001;
+  WINHTTP_AUTOPROXY_CONFIG_URL = $00000002;
+  WINHTTP_AUTO_DETECT_TYPE_DHCP = $00000001;
+  WINHTTP_AUTO_DETECT_TYPE_DNS_A = $00000002;
+  WINHTTP_FLAG_BYPASS_PROXY_CACHE = $00000100;
+  WINHTTP_FLAG_REFRESH = WINHTTP_FLAG_BYPASS_PROXY_CACHE;
+var
+  WinHttpModule: THandle;
+  Session: HINTERNET;
+  AutoDetectProxy: Boolean;
+  WinHttpProxyInfo: TWinHTTPProxyInfo;
+  AutoProxyOptions: TWinHTTPAutoProxyOptions;
+  IEProxyConfig: TWinHTTPCurrentUserIEProxyConfig;
+  WinHttpOpen: function (pwszUserAgent: LPCWSTR; dwAccessType: DWORD;
+    pwszProxyName, pwszProxyBypass: LPCWSTR; dwFlags: DWORD): HINTERNET; stdcall;
+  WinHttpConnect: function(hSession: HINTERNET; pswzServerName: LPCWSTR;
+    nServerPort: INTERNET_PORT; dwReserved: DWORD): HINTERNET; stdcall;
+  WinHttpOpenRequest: function(hConnect: HINTERNET; pwszVerb: LPCWSTR;
+    pwszObjectName: LPCWSTR; pwszVersion: LPCWSTR; pwszReferer: LPCWSTR;
+    ppwszAcceptTypes: PLPWSTR; dwFlags: DWORD): HINTERNET; stdcall;
+  WinHttpQueryOption: function(hInet: HINTERNET; dwOption: DWORD;
+    lpBuffer: Pointer; var lpdwBufferLength: DWORD): BOOL; stdcall;
+  WinHttpGetProxyForUrl: function(hSession: HINTERNET; lpcwszUrl: LPCWSTR;
+    pAutoProxyOptions: LPWINHTTP_AUTOPROXY_OPTIONS;
+    var pProxyInfo: WINHTTP_PROXY_INFO): BOOL; stdcall;
+  WinHttpGetIEProxyConfigForCurrentUser: function(
+    var pProxyInfo: WINHTTP_CURRENT_USER_IE_PROXY_CONFIG): BOOL; stdcall;
+  WinHttpCloseHandle: function(hInternet: HINTERNET): BOOL; stdcall;
+begin
+  Result.Host := '';
+  Result.Port := '';
+  Result.Bypass := '';
+  Result.ResultCode := 0;
+  Result.Autodetected := false;
+  WinHttpModule := LoadLibrary('winhttp.dll');
+  if WinHttpModule = 0 then
+    exit;
+  try
+    WinHttpOpen := GetProcAddress(WinHttpModule,PAnsiChar(AnsiString('WinHttpOpen')));
+    if @WinHttpOpen = nil then
+      Exit;
+    WinHttpConnect := GetProcAddress(WinHttpModule,PAnsiChar(AnsiString('WinHttpConnect')));
+    if @WinHttpConnect = nil then
+      Exit;
+    WinHttpOpenRequest := GetProcAddress(WinHttpModule,PAnsiChar(AnsiString('WinHttpOpenRequest')));
+    if @WinHttpOpenRequest = nil then
+      Exit;
+    WinHttpQueryOption := GetProcAddress(WinHttpModule,PAnsiChar(AnsiString('WinHttpQueryOption')));
+    if @WinHttpQueryOption = nil then
+      Exit;
+    WinHttpGetProxyForUrl := GetProcAddress(WinHttpModule,PAnsiChar(AnsiString('WinHttpGetProxyForUrl')));
+    if @WinHttpGetProxyForUrl = nil then
+      Exit;
+    WinHttpGetIEProxyConfigForCurrentUser := GetProcAddress(WinHttpModule,PAnsiChar(AnsiString('WinHttpGetIEProxyConfigForCurrentUser')));
+    if @WinHttpGetIEProxyConfigForCurrentUser = nil then
+      Exit;
+    WinHttpCloseHandle := GetProcAddress(WinHttpModule,PAnsiChar(AnsiString('WinHttpCloseHandle')));
+    if @WinHttpCloseHandle = nil then
+      Exit;
+
+    AutoDetectProxy := False;
+    FillChar(AutoProxyOptions, SizeOf(AutoProxyOptions), 0);
+    if WinHttpGetIEProxyConfigForCurrentUser(IEProxyConfig) then
+    begin
+      if IEProxyConfig.fAutoDetect then
+      begin
+        AutoProxyOptions.dwFlags := WINHTTP_AUTOPROXY_AUTO_DETECT;
+        AutoProxyOptions.dwAutoDetectFlags := WINHTTP_AUTO_DETECT_TYPE_DHCP or
+          WINHTTP_AUTO_DETECT_TYPE_DNS_A;
+        AutoDetectProxy := True;
+      end;
+      if IEProxyConfig.lpszAutoConfigURL <> '' then
+      begin
+        AutoProxyOptions.dwFlags := AutoProxyOptions.dwFlags or
+          WINHTTP_AUTOPROXY_CONFIG_URL;
+        AutoProxyOptions.lpszAutoConfigUrl := IEProxyConfig.lpszAutoConfigUrl;
+        AutoDetectProxy := True;
+      end;
+      if not AutoDetectProxy then
+      begin
+        Result.Host := IEProxyConfig.lpszProxy;
+        Result.Bypass := IEProxyConfig.lpszProxyBypass;
+        Result.Autodetected := false;
+      end;
+    end
+    else
+    begin
+      AutoProxyOptions.dwFlags := WINHTTP_AUTOPROXY_AUTO_DETECT;
+      AutoProxyOptions.dwAutoDetectFlags := WINHTTP_AUTO_DETECT_TYPE_DHCP or
+        WINHTTP_AUTO_DETECT_TYPE_DNS_A;
+      AutoDetectProxy := True;
+    end;
+    if AutoDetectProxy then
+    begin
+      Session := WinHttpOpen(nil, WINHTTP_ACCESS_TYPE_DEFAULT_PROXY,
+        WINHTTP_NO_PROXY_NAME, WINHTTP_NO_PROXY_BYPASS, 0);
+      if Assigned(Session) then
+      try
+        if WinHttpGetProxyForUrl(Session, LPCWSTR(AURL),
+          @AutoProxyOptions, WinHttpProxyInfo) then
+        begin
+          Result.Host := WinHttpProxyInfo.lpszProxy;
+          Result.Bypass := WinHttpProxyInfo.lpszProxyBypass;
+          Result.Autodetected := True;
+        end
+        else
+          Result.ResultCode := GetLastError;
+      finally
+        WinHttpCloseHandle(Session);
+      end
+      else
+        Result.ResultCode := GetLastError;
+    end;
+    if Result.Host <> '' then
+    begin
+      Result.Port := Trim(SeparateRight(Result.Host, ':'));
+      Result.Host := Trim(SeparateLeft(Result.Host, ':'));
+    end;
+  finally
+    FreeLibrary(WinHttpModule);
+  end;
+end;
+{$ENDIF}
+
+
 end.

+ 133 - 46
synaser.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 007.006.001 |
+| Project : Ararat Synapse                                       | 007.007.001 |
 |==============================================================================|
 | Content: Serial port support                                                 |
 |==============================================================================|
-| Copyright (c)2001-2017, Lukas Gebauer                                        |
+| Copyright (c)2001-2023, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2001-2017.                |
+| Portions created by Lukas Gebauer are Copyright (c)2001-2023.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -83,6 +83,15 @@ case with my USB modem):
   {$ENDIF}
 {$ENDIF}
 
+{$IFDEF UNIX}
+  {$DEFINE USE_LINUX_LOCK}
+{$ENDIF}
+
+{$IFDEF ANDROID}
+  {$DEFINE UNIX}
+  {$UNDEF USE_LINUX_LOCK}
+{$ENDIF}
+
 {$IFDEF FPC}
   {$MODE DELPHI}
   {$IFDEF MSWINDOWS}
@@ -91,6 +100,17 @@ case with my USB modem):
   {define working mode w/o LIBC for fpc}
   {$DEFINE NO_LIBC}
 {$ENDIF}
+
+{$IFDEF POSIX}
+  {$WARN UNIT_PLATFORM OFF}
+  {$WARN SYMBOL_PLATFORM OFF}
+{$ENDIF}
+
+{$IFDEF NEXTGEN}
+  {$LEGACYIFEND ON}
+  {$ZEROBASEDSTRINGS OFF}
+{$ENDIF}
+
 {$Q-}
 {$H+}
 {$M+}
@@ -134,6 +154,7 @@ const
 
   LockfileDirectory = '/var/lock'; {HGJ}
   PortIsClosed = -1;               {HGJ}
+  ErrAccessDenied = 9990;          {DSA}
   ErrAlreadyOwned = 9991;          {HGJ}
   ErrAlreadyInUse = 9992;          {HGJ}
   ErrWrongParameter = 9993;        {HGJ}
@@ -208,9 +229,13 @@ type
 const
 {$IFDEF UNIX}
   {$IFDEF BSD}
-  MaxRates = 18;  //MAC
+    MaxRates = 18;  //MAC
   {$ELSE}
-   MaxRates = 30; //UNIX
+    {$IFDEF CPUARM}
+    MaxRates = 19; //CPUARM
+    {$ELSE}
+    MaxRates = 30; //UNIX
+    {$ENDIF}
   {$ENDIF}
 {$ELSE}
   MaxRates = 19;  //WIN
@@ -239,6 +264,7 @@ const
 {$IFNDEF BSD}
     ,(460800, B460800)
   {$IFDEF UNIX}
+    {$IFNDEF CPUARM}
     ,(500000, B500000),
     (576000, B576000),
     (921600, B921600),
@@ -250,6 +276,7 @@ const
     (3000000, B3000000),
     (3500000, B3500000),
     (4000000, B4000000)
+    {$ENDIF}
   {$ENDIF}
 {$ENDIF}
     );
@@ -261,10 +288,27 @@ const // From fcntl.h
   O_SYNC = $0080;  { synchronous writes }
 {$ENDIF}
 
+{$IFDEF ANDROID}
+const
+  TIOCMSET = $5418;
+  TIOCMGET = $5415;
+  TCSBRK   = $5409;
+{$ENDIF}
+
 const
   sOK = 0;
   sErr = integer(-1);
 
+{$IFDEF POSIX}
+const
+  TIOCM_DTR = $002;
+  TIOCM_RTS = $004;
+  TIOCM_CTS = $020;
+  TIOCM_CAR = $040;
+  TIOCM_RNG = $080;
+  TIOCM_DSR = $100;
+{$ENDIF}
+
 type
 
   {:Possible status event types for @link(THookSerialStatus)}
@@ -345,9 +389,11 @@ type
     procedure GetComNr(Value: string); virtual;
     function PreTestFailing: boolean; virtual;{HGJ}
     function TestCtrlLine: Boolean; virtual;
-{$IFDEF UNIX}    
+{$IFNDEF MSWINDOWS}
     procedure DcbToTermios(const dcb: TDCB; var term: termios); virtual;
     procedure TermiosToDcb(const term: termios; var dcb: TDCB); virtual;
+{$ENDIF}
+{$IFDEF USE_LINUX_LOCK}
     function ReadLockfile: integer; virtual;
     function LockfileName: String; virtual;
     procedure CreateLockfile(PidNr: integer); virtual;
@@ -358,7 +404,7 @@ type
     {: data Control Block with communication parameters. Usable only when you
      need to call API directly.}
     DCB: Tdcb;
-{$IFDEF UNIX}
+{$IFNDEF MSWINDOWS}
     TermiosStruc: termios;
 {$ENDIF}
     {:Object constructor.}
@@ -636,7 +682,7 @@ type
 
     {:Raise Synaser error with ErrNumber code. Usually used by internal routines.}
     procedure RaiseSynaError(ErrNumber: integer); virtual;
-{$IFDEF UNIX}
+{$IFDEF USE_LINUX_LOCK}
     function  cpomComportAccessible: boolean; virtual;{HGJ}
     procedure cpomReleaseComport; virtual; {HGJ}
 {$ENDIF}
@@ -828,7 +874,7 @@ begin
   end;
   if InstanceActive then
   begin
-    {$IFDEF UNIX}
+    {$IFDEF USE_LINUX_LOCK}
     if FLinuxLock then
       cpomReleaseComport;
     {$ENDIF}
@@ -908,7 +954,7 @@ begin
         sleep(x);
       end;
     end;
-    Next := GetTick + Trunc((Length / MaxB) * 1000);
+    Next := GetTick + LongWord(Trunc((Length / MaxB) * 1000));
   end;
 end;
 
@@ -981,23 +1027,34 @@ begin
 {$IFNDEF ULTIBO}
   if FComNr <> PortIsClosed then
     FDevice := '/dev/ttyS' + IntToStr(FComNr);
-  // Comport already owned by another process?          {HGJ}
-  if FLinuxLock then
-    if not cpomComportAccessible then
-    begin
-      RaiseSynaError(ErrAlreadyOwned);
-      Exit;
-    end;
+  {$IFDEF USE_LINUX_LOCK}
+    // Comport already owned by another process?          {HGJ}
+    if FLinuxLock then
+      if not cpomComportAccessible then
+      begin
+        if FileExists(LockfileName) then
+          RaiseSynaError(ErrAlreadyOwned)
+        else
+          RaiseSynaError(ErrAccessDenied);
+
+        Exit;
+      end;
+  {$ENDIF}
+
   {$IFNDEF FPC}
-  FHandle := THandle(Libc.open(pchar(FDevice), O_RDWR or O_SYNC));
+    {$IFDEF POSIX}
+      FHandle := open(MarshaledAString(AnsiString(FDevice)), O_RDWR or O_SYNC);
+    {$ELSE}
+      FHandle := THandle(Libc.open(pchar(FDevice), O_RDWR or O_SYNC));
+    {$ENDIF}
   {$ELSE}
-  FHandle := THandle(fpOpen(FDevice, O_RDWR or O_SYNC));
+    FHandle := THandle(fpOpen(FDevice, O_RDWR or O_SYNC));
   {$ENDIF}
   if FHandle = INVALID_HANDLE_VALUE then  //because THandle is not integer on all platforms!
     SerialCheck(-1)
   else
     SerialCheck(0);
-  {$IFDEF UNIX}
+  {$IFDEF USE_LINUX_LOCK}
   if FLastError <> sOK then
     if FLinuxLock then
       cpomReleaseComport;
@@ -1066,7 +1123,7 @@ begin
     {$ELSE}
     FileClose(FHandle);         {HGJ}
     {$ENDIF}
-    {$IFDEF UNIX}
+    {$IFDEF USE_LINUX_LOCK}
     if FLinuxLock then
       cpomReleaseComport;                {HGJ}
     {$ENDIF}                             {HGJ}
@@ -1786,7 +1843,11 @@ end;
 procedure TBlockSerial.SetCommState;
 begin
   DcbToTermios(dcb, termiosstruc);
-  SerialCheck(tcsetattr(FHandle, TCSANOW, termiosstruc));
+  {$IfDef POSIX}
+    ioctl(Fhandle, TCSANOW, PInteger(@TermiosStruc));
+  {$Else}
+    SerialCheck(tcsetattr(FHandle, TCSANOW, termiosstruc));
+  {$EndIf}
   ExceptCheck;
 end;
 {$ELSE}
@@ -2101,7 +2162,7 @@ end;
 {$IFNDEF ULTIBO}
 function TBlockSerial.CanRead(Timeout: integer): boolean;
 var
-  FDSet: TFDSet;
+  FDSet: {$IFDEF POSIX}FD_Set{$ELSE}TFDSet{$ENDIF};
   TimeVal: PTimeVal;
   TimeV: TTimeVal;
   x: Integer;
@@ -2113,7 +2174,7 @@ begin
     TimeVal := nil;
   {$IFNDEF FPC}
   FD_ZERO(FDSet);
-  FD_SET(FHandle, FDSet);
+  {$IFDEF POSIX}_FD_SET{$ELSE}FD_SET{$ENDIF}(FHandle, FDSet);
   x := Select(FHandle + 1, @FDSet, nil, nil, TimeVal);
   {$ELSE}
   fpFD_ZERO(FDSet);
@@ -2164,7 +2225,7 @@ end;
 {$IFNDEF ULTIBO}
 function TBlockSerial.CanWrite(Timeout: integer): boolean;
 var
-  FDSet: TFDSet;
+  FDSet: {$IFDEF POSIX}FD_Set{$ELSE}TFDSet{$ENDIF};
   TimeVal: PTimeVal;
   TimeV: TTimeVal;
   x: Integer;
@@ -2176,7 +2237,7 @@ begin
     TimeVal := nil;
   {$IFNDEF FPC}
   FD_ZERO(FDSet);
-  FD_SET(FHandle, FDSet);
+  {$IFDEF POSIX}_FD_SET{$ELSE}FD_SET{$ENDIF}(FHandle, FDSet);
   x := Select(FHandle + 1, nil, @FDSet, nil, TimeVal);
   {$ELSE}
   fpFD_ZERO(FDSet);
@@ -2277,17 +2338,20 @@ begin
 end;
 
 procedure TBlockSerial.Flush;
+var
+  Data : Integer;
 begin
 {$IFNDEF MSWINDOWS}
-{$IFNDEF ULTIBO}
-  SerialCheck(tcdrain(FHandle));
-{$ELSE}
-  SetSynaError(sOK);
-  while SendingData > 0 do
-  begin
-   Sleep(0);
-  end;
-{$ENDIF}    
+  {$IFDEF ANDROID}
+    Data := 1;
+    {$IFNDEF FPC}
+    ioctl(FHandle, TCSBRK, 1);
+    {$ELSE}
+    FpIOCtl(FHandle, TCSBRK, @Data);
+    {$ENDIF}    
+  {$ELSE}
+    SerialCheck(tcdrain(FHandle));
+  {$ENDIF}
 {$ELSE}
   SetSynaError(sOK);
   if not Flushfilebuffers(FHandle) then
@@ -2568,7 +2632,7 @@ end;
   Ownership Manager.
 }
 
-{$IFDEF UNIX}
+{$IFDEF USE_LINUX_LOCK}
 
 function TBlockSerial.LockfileName: String;
 var
@@ -2580,8 +2644,13 @@ end;
 
 procedure TBlockSerial.CreateLockfile(PidNr: integer);
 var
-  f: TextFile;
   s: string;
+{$IFDEF FPC}
+  m: Word;
+  FS: TFileStream;
+{$ELSE}
+  f: TextFile;
+{$ENDIF}
 begin
   // Create content for file
   s := IntToStr(PidNr);
@@ -2589,6 +2658,7 @@ begin
     s := ' ' + s;
   // Create file
   try
+{$IFNDEF FPC}
     AssignFile(f, LockfileName);
     try
       Rewrite(f);
@@ -2596,6 +2666,21 @@ begin
     finally
       CloseFile(f);
     end;
+{$ELSE}
+    s := s + sLineBreak;
+    if FileExists(LockfileName) then
+      m := fmOpenReadWrite
+    else
+      m := fmCreate;
+    FS := TFileStream.Create(LockfileName, m or fmShareDenyWrite);
+    try
+      FS.Seek(0, soEnd);
+      FS.Write(Pointer(s)^, Length(s));
+    finally
+      FS.Free ;
+    end;
+{$ENDIF}
+
     // Allow all users to enjoy the benefits of cpom
     s := 'chmod a+rw ' + LockfileName;
   {$IFNDEF FPC}
@@ -2642,10 +2727,10 @@ begin
   if not DirectoryExists(LockfileDirectory) then
     CreateDir(LockfileDirectory);
   // Check the Lockfile
-  if not FileExists (Filename) then
+  if not FileExists(Filename) then
   begin // comport is not locked. Lock it for us.
     CreateLockfile(MyPid);
-    result := true;
+    result := FileExists(Filename);
     exit;  // done.
   end;
   // Is port owned by orphan? Then it's time for error recovery.
@@ -2655,7 +2740,7 @@ begin
   begin //  Lockfile was left from former desaster
     DeleteFile(Filename); // error recovery
     CreateLockfile(MyPid);
-    result := true;
+    result := FileExists(Filename);
     exit;
   end;
   {$ENDIF}
@@ -2702,13 +2787,15 @@ end;
 {$IFNDEF MSWINDOWS}
 {$IFNDEF ULTIBO}
 function GetSerialPortNames: string;
+const
+  ATTR = {$IFDEF POSIX}$7FFFFFFF{$ELSE}$FFFFFFFF{$ENDIF};
 var
   sr : TSearchRec;
 begin
   Result := '';
-  if FindFirst('/dev/ttyS*', $FFFFFFFF, sr) = 0 then
+  if FindFirst('/dev/ttyS*', ATTR, sr) = 0 then
     repeat
-      if (sr.Attr and $FFFFFFFF) = Sr.Attr then
+      if (sr.Attr and ATTR) = Sr.Attr then
       begin
         if Result <> '' then
           Result := Result + ',';
@@ -2716,18 +2803,18 @@ begin
       end;
     until FindNext(sr) <> 0;
   FindClose(sr);
-  if FindFirst('/dev/ttyUSB*', $FFFFFFFF, sr) = 0 then begin
+  if FindFirst('/dev/ttyUSB*', ATTR, sr) = 0 then begin
     repeat
-      if (sr.Attr and $FFFFFFFF) = Sr.Attr then begin
+      if (sr.Attr and ATTR) = Sr.Attr then begin
         if Result <> '' then Result := Result + ',';
         Result := Result + '/dev/' + sr.Name;
       end;
     until FindNext(sr) <> 0;
   end;
   FindClose(sr);
-  if FindFirst('/dev/ttyAM*', $FFFFFFFF, sr) = 0 then begin
+  if FindFirst('/dev/ttyAM*', ATTR, sr) = 0 then begin
     repeat
-      if (sr.Attr and $FFFFFFFF) = Sr.Attr then begin
+      if (sr.Attr and ATTR) = Sr.Attr then begin
         if Result <> '' then Result := Result + ',';
         Result := Result + '/dev/' + sr.Name;
       end;

+ 5 - 0
synautil.pas

@@ -59,6 +59,11 @@
   {$WARN IMPLICIT_STRING_CAST OFF}
   {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
   {$WARN SUSPICIOUS_TYPECAST OFF}
+  {$WARN SYMBOL_DEPRECATED OFF}
+{$ENDIF}
+
+{$IFDEF NEXTGEN}
+  {$ZEROBASEDSTRINGS OFF}
 {$ENDIF}
 
 unit synautil;

+ 3 - 6
synsock.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 005.002.003 |
+| Project : Ararat Synapse                                       | 005.002.004 |
 |==============================================================================|
 | Content: Socket Independent Platform Layer                                   |
 |==============================================================================|
-| Copyright (c)1999-2013, Lukas Gebauer                                        |
+| Copyright (c)1999-2022, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2001-2013.                |
+| Portions created by Lukas Gebauer are Copyright (c)2001-2022.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -85,9 +85,6 @@ unit synsock;
     {$ENDIF}
   {$ENDIF}
 {$ENDIF}
-//{$IFDEF POSIX}
-//   {$I ssposix.inc} //experimental!
-//{$ENDIF}
 
 end.