Release 31

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

asn1util.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.003.005 |
+| Project : Delphree - Synapse                                   | 001.003.006 |
 |==============================================================================|
 | Content: support for ASN.1 BER coding and decoding                           |
 |==============================================================================|
@@ -45,7 +45,6 @@
 |==============================================================================}
 
 {$Q-}
-{$WEAKPACKAGEUNIT ON}
 
 unit ASN1Util;
 

dnssend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.001.001 |
+| Project : Delphree - Synapse                                   | 002.002.002 |
 |==============================================================================|
 | Content: DNS client                                                          |
 |==============================================================================|
@@ -45,7 +45,6 @@
 // RFC-1035, RFC-1183, RFC1706, RFC1712, RFC2163, RFC2230
 
 {$Q-}
-{$WEAKPACKAGEUNIT ON}
 
 unit DNSsend;
 
@@ -53,7 +52,7 @@ interface
 
 uses
   SysUtils, Classes,
-  blcksock, SynaUtil;
+  blcksock, SynaUtil, synsock;
 
 const
   cDnsProtocol = 'domain';
@@ -86,7 +85,7 @@ const
   QTYPE_KEY = 25; // RFC-2065
   QTYPE_PX = 26;
   QTYPE_GPOS = 27;
-  QTYPE_AAAA = 28; // IP6 Address  [Susan Thomson]
+  QTYPE_AAAA = 28;
   QTYPE_LOC = 29; // RFC-1876
   QTYPE_NXT = 30; // RFC-2065
 
@@ -112,6 +111,8 @@ type
     FNameserverInfo: TStringList;
     FAdditionalInfo: TStringList;
     FAuthoritative: Boolean;
+    function ReverseIP(Value: string): string;
+    function ReverseIP6(Value: string): string;
     function CompressName(const Value: string): string;
     function CodeHeader: string;
     function CodeQuery(const Name: string; QType: Integer): string;
@@ -167,6 +168,44 @@ begin
   inherited Destroy;
 end;
 
+function TDNSSend.ReverseIP(Value: string): string;
+var
+  x: Integer;
+begin
+  Result := '';
+  repeat
+    x := LastDelimiter('.', Value);
+    Result := Result + '.' + Copy(Value, x + 1, Length(Value) - x);
+    Delete(Value, x, Length(Value) - x + 1);
+  until x < 1;
+  if Length(Result) > 0 then
+    if Result[1] = '.' then
+      Delete(Result, 1, 1);
+end;
+
+function TDNSSend.ReverseIP6(Value: string): string;
+var
+  ip6: TSockAddrIn6;
+begin
+  ip6 := FSock.StrToIP6(Value);
+  Result := ip6.sin6_addr.S_un_b.s_b16
+    + '.' + ip6.sin6_addr.S_un_b.s_b15
+    + '.' + ip6.sin6_addr.S_un_b.s_b14
+    + '.' + ip6.sin6_addr.S_un_b.s_b13
+    + '.' + ip6.sin6_addr.S_un_b.s_b12
+    + '.' + ip6.sin6_addr.S_un_b.s_b11
+    + '.' + ip6.sin6_addr.S_un_b.s_b10
+    + '.' + ip6.sin6_addr.S_un_b.s_b9
+    + '.' + ip6.sin6_addr.S_un_b.s_b8
+    + '.' + ip6.sin6_addr.S_un_b.s_b7
+    + '.' + ip6.sin6_addr.S_un_b.s_b6
+    + '.' + ip6.sin6_addr.S_un_b.s_b5
+    + '.' + ip6.sin6_addr.S_un_b.s_b4
+    + '.' + ip6.sin6_addr.S_un_b.s_b3
+    + '.' + ip6.sin6_addr.S_un_b.s_b2
+    + '.' + ip6.sin6_addr.S_un_b.s_b1;
+end;
+
 function TDNSSend.CompressName(const Value: string): string;
 var
   n: Integer;
@@ -258,6 +297,7 @@ var
   RType, Len, j, x, n: Integer;
   R: string;
   t1, t2, ttl: integer;
+  ip6: TSockAddrIn6;
 begin
   Result := '';
   R := '';
@@ -273,72 +313,95 @@ begin
   Inc(i, 2); // i point to begin of data
   j := i;
   i := i + len; // i point to next record
-  case RType of
+  if Length(FBuffer) >= i then
-    QTYPE_A:
+    case RType of
-      begin
+      QTYPE_A:
-        R := IntToStr(Ord(FBuffer[j]));
-        Inc(j);
-        R := R + '.' + IntToStr(Ord(FBuffer[j]));
-        Inc(j);
-        R := R + '.' + IntToStr(Ord(FBuffer[j]));
-        Inc(j);
-        R := R + '.' + IntToStr(Ord(FBuffer[j]));
-      end;
-    QTYPE_NS, QTYPE_MD, QTYPE_MF, QTYPE_CNAME, QTYPE_MB,
-      QTYPE_MG, QTYPE_MR, QTYPE_PTR, QTYPE_X25, QTYPE_NSAP,
-      QTYPE_NSAPPTR:
-      R := DecodeLabels(j);
-    QTYPE_SOA:
-      begin
-        R := DecodeLabels(j);
-        R := R + ',' + DecodeLabels(j);
-        for n := 1 to 5 do
         begin
-          x := DecodeInt(FBuffer, j) * 65536 + DecodeInt(FBuffer, j + 2);
+          R := IntToStr(Ord(FBuffer[j]));
-          Inc(j, 4);
+          Inc(j);
-          R := R + ',' + IntToStr(x);
+          R := R + '.' + IntToStr(Ord(FBuffer[j]));
+          Inc(j);
+          R := R + '.' + IntToStr(Ord(FBuffer[j]));
+          Inc(j);
+          R := R + '.' + IntToStr(Ord(FBuffer[j]));
         end;
-      end;
+      QTYPE_AAAA:
-    QTYPE_NULL:
+        begin
-      begin
+          FillChar(ip6, SizeOf(ip6), 0);
-      end;
+          ip6.sin6_addr.S_un_b.s_b1 := FBuffer[j];
-    QTYPE_WKS:
+          ip6.sin6_addr.S_un_b.s_b2 := FBuffer[j + 1];
-      begin
+          ip6.sin6_addr.S_un_b.s_b3 := FBuffer[j + 2];
-      end;
+          ip6.sin6_addr.S_un_b.s_b4 := FBuffer[j + 3];
-    QTYPE_HINFO:
+          ip6.sin6_addr.S_un_b.s_b5 := FBuffer[j + 4];
-      begin
+          ip6.sin6_addr.S_un_b.s_b6 := FBuffer[j + 5];
+          ip6.sin6_addr.S_un_b.s_b7 := FBuffer[j + 6];
+          ip6.sin6_addr.S_un_b.s_b8 := FBuffer[j + 7];
+          ip6.sin6_addr.S_un_b.s_b9 := FBuffer[j + 8];
+          ip6.sin6_addr.S_un_b.s_b10 := FBuffer[j + 9];
+          ip6.sin6_addr.S_un_b.s_b11 := FBuffer[j + 10];
+          ip6.sin6_addr.S_un_b.s_b12 := FBuffer[j + 11];
+          ip6.sin6_addr.S_un_b.s_b13 := FBuffer[j + 12];
+          ip6.sin6_addr.S_un_b.s_b14 := FBuffer[j + 13];
+          ip6.sin6_addr.S_un_b.s_b15 := FBuffer[j + 14];
+          ip6.sin6_addr.S_un_b.s_b16 := FBuffer[j + 15];
+          ip6.sin6_family := AF_INET6;
+          R := FSock.IP6ToStr(ip6);
+        end;
+      QTYPE_NS, QTYPE_MD, QTYPE_MF, QTYPE_CNAME, QTYPE_MB,
+        QTYPE_MG, QTYPE_MR, QTYPE_PTR, QTYPE_X25, QTYPE_NSAP,
+        QTYPE_NSAPPTR:
+        R := DecodeLabels(j);
+      QTYPE_SOA:
+        begin
+          R := DecodeLabels(j);
+          R := R + ',' + DecodeLabels(j);
+          for n := 1 to 5 do
+          begin
+            x := DecodeInt(FBuffer, j) * 65536 + DecodeInt(FBuffer, j + 2);
+            Inc(j, 4);
+            R := R + ',' + IntToStr(x);
+          end;
+        end;
+      QTYPE_NULL:
+        begin
+        end;
+      QTYPE_WKS:
+        begin
+        end;
+      QTYPE_HINFO:
+        begin
+          R := DecodeString(j);
+          R := R + ',' + DecodeString(j);
+        end;
+      QTYPE_MINFO, QTYPE_RP, QTYPE_ISDN:
+        begin
+          R := DecodeLabels(j);
+          R := R + ',' + DecodeLabels(j);
+        end;
+      QTYPE_MX, QTYPE_AFSDB, QTYPE_RT, QTYPE_KX:
+        begin
+          x := DecodeInt(FBuffer, j);
+          Inc(j, 2);
+          R := IntToStr(x);
+          R := R + ',' + DecodeLabels(j);
+        end;
+      QTYPE_TXT:
         R := DecodeString(j);
-        R := R + ',' + DecodeString(j);
+      QTYPE_GPOS:
-      end;
+        begin
-    QTYPE_MINFO, QTYPE_RP, QTYPE_ISDN:
+          R := DecodeLabels(j);
-      begin
+          R := R + ',' + DecodeLabels(j);
-        R := DecodeLabels(j);
+          R := R + ',' + DecodeLabels(j);
-        R := R + ',' + DecodeLabels(j);
+        end;
-      end;
+      QTYPE_PX:
-    QTYPE_MX, QTYPE_AFSDB, QTYPE_RT, QTYPE_KX:
+        begin
-      begin
+          x := DecodeInt(FBuffer, j);
-        x := DecodeInt(FBuffer, j);
+          Inc(j, 2);
-        Inc(j, 2);
+          R := IntToStr(x);
-        R := IntToStr(x);
+          R := R + ',' + DecodeLabels(j);
-        R := R + ',' + DecodeLabels(j);
+          R := R + ',' + DecodeLabels(j);
-      end;
+        end;
-    QTYPE_TXT:
+    end;
-      R := DecodeString(j);
-    QTYPE_GPOS:
-      begin
-        R := DecodeLabels(j);
-        R := R + ',' + DecodeLabels(j);
-        R := R + ',' + DecodeLabels(j);
-      end;
-    QTYPE_PX:
-      begin
-        x := DecodeInt(FBuffer, j);
-        Inc(j, 2);
-        R := IntToStr(x);
-        R := R + ',' + DecodeLabels(j);
-        R := R + ',' + DecodeLabels(j);
-      end;
-  end;
   if R <> '' then
     Info.Add(RName + ',' + IntToStr(RType) + ',' + IntToStr(ttl) + ',' + R);
   if QType = RType then
@@ -415,6 +478,8 @@ begin
   Result := False;
   if IsIP(Name) then
     Name := ReverseIP(Name) + '.in-addr.arpa';
+  if IsIP6(Name) then
+    Name := ReverseIP6(Name) + '.ip6.int';
   FBuffer := CodeHeader + CodeQuery(Name, QType);
   if FUseTCP then
     WorkSock := FTCPSock

ftpsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.005.004 |
+| Project : Delphree - Synapse                                   | 002.006.006 |
 |==============================================================================|
 | Content: FTP client                                                          |
 |==============================================================================|
@@ -43,8 +43,6 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
-{$WEAKPACKAGEUNIT ON}
-
 unit FTPsend;
 
 interface
@@ -121,8 +119,6 @@ type
     function InternalStor(const Command: string; RestoreAt: integer): Boolean;
     function DataSocket: Boolean;
     function AcceptDataSocket: Boolean;
-    function DataRead(const DestStream: TStream): Boolean;
-    function DataWrite(const SourceStream: TStream): Boolean;
   protected
     procedure DoStatus(Response: Boolean; const Value: string);
   public
@@ -131,12 +127,13 @@ type
     destructor Destroy; override;
     function ReadResult: Integer;
     procedure ParseRemote(Value: string);
+    procedure ParseRemoteEPSV(Value: string);
     function FTPCommand(const Value: string): integer;
     function Login: Boolean;
     procedure Logout;
     procedure Abort;
     function List(Directory: string; NameList: Boolean): Boolean;
-    function RetriveFile(const FileName: string; Restore: Boolean): Boolean;
+    function RetrieveFile(const FileName: string; Restore: Boolean): Boolean;
     function StoreFile(const FileName: string; Restore: Boolean): Boolean;
     function StoreUniqueFile: Boolean;
     function AppendFile(const FileName: string): Boolean;
@@ -149,6 +146,8 @@ type
     function DeleteDir(const Directory: string): Boolean;
     function CreateDir(const Directory: string): Boolean;
     function GetCurrentDir: String;
+    function DataRead(const DestStream: TStream): Boolean;
+    function DataWrite(const SourceStream: TStream): Boolean;
   published
     property ResultCode: Integer read FResultCode;
     property ResultString: string read FResultString;
@@ -447,14 +446,14 @@ end;
 function TFTPSend.Connect: Boolean;
 begin
   FSock.CloseSocket;
-  FSock.CreateSocket;
+  FSock.Bind(FIPInterface, cAnyPort);
   if FFullSSL then
     FSock.SSLEnabled := True;
-  FSock.Bind(FIPInterface, cAnyPort);
+  if FSock.LastError = 0 then
-  if FFWHost = '' then
+    if FFWHost = '' then
-    FSock.Connect(FTargetHost, FTargetPort)
+      FSock.Connect(FTargetHost, FTargetPort)
-  else
+    else
-    FSock.Connect(FFWHost, FFWPort);
+      FSock.Connect(FFWHost, FFWPort);
   Result := FSock.LastError = 0;
 end;
 
@@ -527,6 +526,24 @@ begin
   FDataPort := IntToStr(x);
 end;
 
+procedure TFTPSend.ParseRemoteEPSV(Value: string);
+var
+  n: integer;
+  s, v: string;
+begin
+  s := SeparateRight(Value, '(');
+  s := SeparateLeft(s, ')');
+  Delete(s, Length(s), 1);
+  v := '';
+  for n := Length(s) downto 1 do
+    if s[n] in ['0'..'9'] then
+      v := s[n] + v
+    else
+      Break;
+  FDataPort := v;
+  FDataIP := FTargetHost;
+end;
+
 function TFTPSend.DataSocket: boolean;
 var
   s: string;
@@ -534,19 +551,31 @@ begin
   Result := False;
   if FPassiveMode then
   begin
-    if (FTPCommand('PASV') div 100) <> 2 then
+    if FSock.IP6used then
-      Exit;
+      s := '2'
-    ParseRemote(FResultString);
+    else
+      s := '1';
+    if (FTPCommand('EPSV ' + s) div 100) = 2 then
+    begin
+      ParseRemoteEPSV(FResultString);
+    end
+    else
+      if FSock.IP6used then
+        Exit
+      else
+      begin
+        if (FTPCommand('PASV') div 100) <> 2 then
+          Exit;
+        ParseRemote(FResultString);
+      end;
     FDSock.CloseSocket;
-    FDSock.CreateSocket;
+    FDSock.Bind(FIPInterface, cAnyPort);
-    FSock.Bind(FIPInterface, cAnyPort);
     FDSock.Connect(FDataIP, FDataPort);
     Result := FDSock.LastError = 0;
   end
   else
   begin
     FDSock.CloseSocket;
-    FDSock.CreateSocket;
     if FForceDefaultPort then
       s := cFtpDataProtocol
     else
@@ -555,7 +584,7 @@ begin
     if FIPInterface = cAnyHost then
       FDSock.Bind(FDSock.LocalName, s)
     else
-      FSock.Bind(FIPInterface, s);
+      FDSock.Bind(FIPInterface, s);
     if FDSock.LastError <> 0 then
       Exit;
     FDSock.SetLinger(True, 10);
@@ -564,10 +593,19 @@ begin
     FDataIP := FDSock.GetLocalSinIP;
     FDataIP := FDSock.ResolveName(FDataIP);
     FDataPort := IntToStr(FDSock.GetLocalSinPort);
-    s := ReplaceString(FDataIP, '.', ',');
+    if IsIp6(FDataIP) then
-    s := 'PORT ' + s + ',' + IntToStr(FDSock.GetLocalSinPort div 256)
+      s := '2'
-      + ',' + IntToStr(FDSock.GetLocalSinPort mod 256);
+    else
+      s := '1';
+    s := 'EPRT |' + s +'|' + FDataIP + '|' + FDataPort + '|';
     Result := (FTPCommand(s) div 100) = 2;
+    if not Result and IsIP(FDataIP) then
+    begin
+      s := ReplaceString(FDataIP, '.', ',');
+      s := 'PORT ' + s + ',' + IntToStr(FDSock.GetLocalSinPort div 256)
+        + ',' + IntToStr(FDSock.GetLocalSinPort mod 256);
+      Result := (FTPCommand(s) div 100) = 2;
+    end;
   end;
 end;
 
@@ -687,7 +725,7 @@ begin
   FDataStream.Seek(0, soFromBeginning);
 end;
 
-function TFTPSend.RetriveFile(const FileName: string; Restore: Boolean): Boolean;
+function TFTPSend.RetrieveFile(const FileName: string; Restore: Boolean): Boolean;
 var
   RetrStream: TStream;
 begin
@@ -1156,7 +1194,7 @@ begin
       Exit;
     DirectFileName := LocalFile;
     DirectFile:=True;
-    Result := RetriveFile(FileName, False);
+    Result := RetrieveFile(FileName, False);
     Logout;
   finally
     Free;

httpsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 003.004.004 |
+| Project : Delphree - Synapse                                   | 003.006.004 |
 |==============================================================================|
 | Content: HTTP client                                                         |
 |==============================================================================|
@@ -42,14 +42,15 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
-{$WEAKPACKAGEUNIT ON}
-
 unit HTTPSend;
 
 interface
 
 uses
   SysUtils, Classes,
+  {$IFDEF STREAMSEC}
+  TlsInternalServer, TlsSynaSock,
+  {$ENDIF}
   blcksock, SynaUtil, SynaCode;
 
 const
@@ -60,7 +61,12 @@ type
 
   THTTPSend = class(TSynaClient)
   private
+    {$IFDEF STREAMSEC}
+    FSock: TSsTCPBlockSocket;
+    FTLSServer: TCustomTLSInternalServer;
+    {$ELSE}
     FSock: TTCPBlockSocket;
+    {$ENDIF}
     FTransferEncoding: TTransferEncoding;
     FAliveHost: string;
     FAlivePort: string;
@@ -69,6 +75,7 @@ type
     FMimeType: string;
     FProtocol: string;
     FKeepAlive: Boolean;
+    FStatus100: Boolean;
     FProxyHost: string;
     FProxyPort: string;
     FProxyUser: string;
@@ -101,6 +108,7 @@ type
     property MimeType: string read FMimeType Write FMimeType;
     property Protocol: string read FProtocol Write FProtocol;
     property KeepAlive: Boolean read FKeepAlive Write FKeepAlive;
+    property Status100: Boolean read FStatus100 Write FStatus100;
     property ProxyHost: string read FProxyHost Write FProxyHost;
     property ProxyPort: string read FProxyPort Write FProxyPort;
     property ProxyUser: string read FProxyUser Write FProxyUser;
@@ -110,7 +118,12 @@ type
     property ResultString: string read FResultString;
     property DownloadSize: integer read FDownloadSize;
     property UploadSize: integer read FUploadSize;
+{$IFDEF STREAMSEC}                            
+    property Sock: TSsTCPBlockSocket read FSock;
+    property TLSServer: TCustomTLSInternalServer read FTLSServer write FTLSServer;
+{$ELSE}
     property Sock: TTCPBlockSocket read FSock;
+{$ENDIF}
   end;
 
 function HttpGetText(const URL: string; const Response: TStrings): Boolean;
@@ -128,11 +141,17 @@ begin
   FHeaders := TStringList.Create;
   FCookies := TStringList.Create;
   FDocument := TMemoryStream.Create;
+{$IFDEF STREAMSEC}           
+  FTLSServer := GlobalTLSInternalServer;     
+  FSock := TSsTCPBlockSocket.Create;
+  FSock.BlockingRead := True;
+{$ELSE}
   FSock := TTCPBlockSocket.Create;
+{$ENDIF}
   FSock.ConvertLineEnd := True;
   FSock.SizeRecvBuffer := 65536;
   FSock.SizeSendBuffer := 65536;
-  FTimeout := 300000;
+  FTimeout := 90000;
   FTargetPort := cHttpProtocol;
   FProxyHost := '';
   FProxyPort := '8080';
@@ -142,6 +161,7 @@ begin
   FAlivePort := '';
   FProtocol := '1.0';
   FKeepAlive := True;
+  FStatus100 := False;
   FUserAgent := 'Mozilla/4.0 (compatible; Synapse)';
   FDownloadSize := 0;
   FUploadSize := 0;
@@ -198,10 +218,8 @@ begin
   FUploadSize := 0;
 
   URI := ParseURL(URL, Prot, User, Pass, Host, Port, Path, Para);
-
   if UpperCase(Prot) = 'HTTPS' then
   begin
-    FSock.SSLEnabled := True;
     HttpTunnel := FProxyHost <> '';
     FSock.HTTPTunnelIP := FProxyHost;
     FSock.HTTPTunnelPort := FProxyPort;
@@ -210,7 +228,6 @@ begin
   end
   else
   begin
-    FSock.SSLEnabled := False;
     HttpTunnel := False;
     FSock.HTTPTunnelIP := '';
     FSock.HTTPTunnelPort := '';
@@ -220,7 +237,7 @@ begin
 
   Sending := Document.Size > 0;
   {Headers for Sending data}
-  status100 := Sending and (FProtocol = '1.1');
+  status100 := FStatus100 and Sending and (FProtocol = '1.1');
   if status100 then
     FHeaders.Insert(0, 'Expect: 100-continue');
   if Sending then
@@ -247,12 +264,16 @@ begin
   if (FProxyHost <> '') and (FProxyUser <> '') and not(HttpTunnel) then
     FHeaders.Insert(0, 'Proxy-Authorization: Basic ' +
       EncodeBase64(FProxyUser + ':' + FProxyPass));
-  if Port<>'80' then
+  if isIP6(Host) then
-     FHeaders.Insert(0, 'Host: ' + Host + ':' + Port)
+    s := '[' + Host + ']'
   else
-     FHeaders.Insert(0, 'Host: ' + Host);
+    s := Host;
+  if Port<>'80' then
+     FHeaders.Insert(0, 'Host: ' + s + ':' + Port)
+  else
+     FHeaders.Insert(0, 'Host: ' + s);
   if (FProxyHost <> '') and not(HttpTunnel)then
-    URI := Prot + '://' + Host + ':' + Port + URI;
+    URI := Prot + '://' + s + ':' + Port + URI;
   if URI = '/*' then
     URI := '*';
   if FProtocol = '0.9' then
@@ -276,10 +297,21 @@ begin
   if (FAliveHost <> FTargetHost) or (FAlivePort <> FTargetPort) then
   begin
     FSock.CloseSocket;
-    FSock.CreateSocket;
     FSock.Bind(FIPInterface, cAnyPort);
     if FSock.LastError <> 0 then
       Exit;
+{$IFDEF STREAMSEC}
+    FSock.TLSServer := nil;
+    if UpperCase(Prot) = 'HTTPS' then
+      if assigned(FTLSServer) then
+        FSock.TLSServer := FTLSServer
+      else
+        exit;
+{$ELSE}
+    FSock.SSLEnabled := UpperCase(Prot) = 'HTTPS';
+{$ENDIF}
+    if FSock.LastError <> 0 then
+      Exit;
     FSock.Connect(FTargetHost, FTargetPort);
     if FSock.LastError <> 0 then
       Exit;
@@ -291,10 +323,21 @@ begin
     if FSock.CanRead(0) then
     begin
       FSock.CloseSocket;
-      FSock.CreateSocket;
       FSock.Bind(FIPInterface, cAnyPort);
       if FSock.LastError <> 0 then
         Exit;
+{$IFDEF STREAMSEC}
+      FSock.TLSServer := nil;
+      if UpperCase(Prot) = 'HTTPS' then
+        if assigned(FTLSServer) then
+          FSock.TLSServer := FTLSServer
+        else
+          exit;
+{$ELSE}
+      FSock.SSLEnabled := UpperCase(Prot) = 'HTTPS';
+{$ENDIF}
+      if FSock.LastError <> 0 then
+        Exit;
       FSock.Connect(FTargetHost, FTargetPort);
       if FSock.LastError <> 0 then
         Exit;

imapsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.002.002 |
+| Project : Delphree - Synapse                                   | 002.003.005 |
 |==============================================================================|
 | Content: IMAP4rev1 client                                                    |
 |==============================================================================|
@@ -42,8 +42,6 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
-{$WEAKPACKAGEUNIT ON}
-
 //RFC-2060
 //RFC-2595
 
@@ -53,6 +51,9 @@ interface
 
 uses
   SysUtils, Classes,
+  {$IFDEF STREAMSEC}
+  TlsInternalServer, TlsSynaSock,
+  {$ENDIF}
   blcksock, SynaUtil, SynaCode;
 
 const
@@ -61,7 +62,12 @@ const
 type
   TIMAPSend = class(TSynaClient)
   private
+    {$IFDEF STREAMSEC}
+    FSock: TSsTCPBlockSocket;
+    FTLSServer: TCustomTLSInternalServer;
+    {$ELSE}
     FSock: TTCPBlockSocket;
+    {$ENDIF}
     FTagCommand: integer;
     FResultString: string;
     FFullResult: TStringList;
@@ -83,6 +89,7 @@ type
     procedure ParseFolderList(Value:TStrings);
     procedure ParseSelect;
     procedure ParseSearch(Value:TStrings);
+    procedure ProcessLiterals;
   public
     constructor Create;
     destructor Destroy; override;
@@ -125,13 +132,18 @@ type
     property Password: string read FPassword Write FPassword;
     property AuthDone: Boolean read FAuthDone;
     property UID: Boolean read FUID Write FUID;
-    property Sock: TTCPBlockSocket read FSock;
     property SelectedFolder: string read FSelectedFolder;
     property SelectedCount: integer read FSelectedCount;
     property SelectedRecent: integer read FSelectedRecent;
     property SelectedUIDvalidity: integer read FSelectedUIDvalidity;
     property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
     property FullSSL: Boolean read FFullSSL Write FFullSSL;
+{$IFDEF STREAMSEC}                            
+    property Sock: TSsTCPBlockSocket read FSock;
+    property TLSServer: TCustomTLSInternalServer read FTLSServer write FTLSServer;
+{$ELSE}
+    property Sock: TTCPBlockSocket read FSock;
+{$ENDIF}
   end;
 
 implementation
@@ -141,12 +153,17 @@ begin
   inherited Create;
   FFullResult := TStringList.Create;
   FIMAPcap := TStringList.Create;
+{$IFDEF STREAMSEC}           
+  FTLSServer := GlobalTLSInternalServer;     
+  FSock := TSsTCPBlockSocket.Create;
+  FSock.BlockingRead := True;
+{$ELSE}
   FSock := TTCPBlockSocket.Create;
+{$ENDIF}
   FSock.ConvertLineEnd := True;
-  FSock.CreateSocket;
   FSock.SizeRecvBuffer := 32768;
   FSock.SizeSendBuffer := 32768;
-  FTimeout := 300000;
+  FTimeout := 60000;
   FTargetPort := cIMAPProtocol;
   FUsername := '';
   FPassword := '';
@@ -203,6 +220,47 @@ begin
   Result:=uppercase(separateleft(s, ' '));
 end;
 
+procedure TIMAPSend.ProcessLiterals;
+var
+  l: TStringList;
+  n, x: integer;
+  b: integer;
+  s: string;
+begin
+  l := TStringList.Create;
+  try
+    l.Assign(FFullResult);
+    FFullResult.Clear;
+    b := 0;
+    for n := 0 to l.Count - 1 do
+    begin
+      s := l[n];
+      if b > 0 then
+      begin
+        FFullResult[FFullresult.Count - 1] :=
+          FFullResult[FFullresult.Count - 1] + s;
+        inc(b);
+        if b > 2 then
+          b := 0;
+      end
+      else
+      begin
+        if (s <> '') and (s[Length(s)]='}') then
+        begin
+          x := RPos('{', s);
+          Delete(s, x, Length(s) - x + 1);
+          b := 1;
+        end
+        else
+          b := 0;
+        FFullResult.Add(s);
+      end;
+    end;
+  finally
+    l.Free;
+  end;
+end;
+
 function TIMAPSend.IMAPcommand(Value: string): string;
 begin
   Inc(FTagCommand);
@@ -240,6 +298,7 @@ var
   n, x: integer;
   s: string;
 begin
+  ProcessLiterals;
   Value.Clear;
   for n := 0 to FFullResult.Count - 1 do
   begin
@@ -264,6 +323,7 @@ var
   n: integer;
   s, t: string;
 begin
+  ProcessLiterals;
   FSelectedCount := 0;
   FSelectedRecent := 0;
   FSelectedUIDvalidity := 0;
@@ -296,6 +356,7 @@ var
   n: integer;
   s: string;
 begin
+  ProcessLiterals;
   Value.Clear;
   for n := 0 to FFullResult.Count - 1 do
   begin
@@ -326,17 +387,32 @@ end;
 
 function TIMAPSend.AuthLogin: Boolean;
 begin
-  Result := IMAPcommand('LOGIN ' + FUsername + ' ' + FPassword) = 'OK';
+  Result := IMAPcommand('LOGIN "' + FUsername + '" "' + FPassword + '"') = 'OK';
 end;
 
 function TIMAPSend.Connect: Boolean;
 begin
   FSock.CloseSocket;
-  FSock.CreateSocket;
+  FSock.Bind(FIPInterface, cAnyPort);
+{$IFDEF STREAMSEC}
+  if FFullSSL then
+  begin
+    if assigned(FTLSServer) then
+      FSock.TLSServer := FTLSServer
+    else
+    begin
+      Result := false;
+      exit;
+    end;
+  end
+  else
+    FSock.TLSServer := nil;
+{$ELSE}
   if FFullSSL then
     FSock.SSLEnabled := True;
-  FSock.Bind(FIPInterface, cAnyPort);
+{$ENDIF}
-  FSock.Connect(FTargetHost, FTargetPort);
+  if FSock.LastError = 0 then
+    FSock.Connect(FTargetHost, FTargetPort);
   Result := FSock.LastError = 0;
 end;
 
@@ -350,6 +426,7 @@ begin
   s := IMAPcommand('CAPABILITY');
   if s = 'OK' then
   begin
+    ProcessLiterals;
     for n := 0 to FFullResult.Count - 1 do
       if Pos('* CAPABILITY ', FFullResult[n]) = 1 then
       begin
@@ -475,10 +552,12 @@ begin
   Result := -1;
   Value := Uppercase(Value);
   if IMAPcommand('STATUS "' + FolderName + '" (' + Value + ')' ) = 'OK' then
+  begin
+    ProcessLiterals;
     for n := 0 to FFullResult.Count - 1 do
     begin
       s := UpperCase(FFullResult[n]);
-      if (Pos(FolderName, s) >= 1) and (Pos(Value, s) > 0 ) then
+      if (Pos('* ', s) = 1) and (Pos(FolderName, s) >= 1) and (Pos(Value, s) > 0 ) then
       begin
         t := SeparateRight(s, Value);
         t := SeparateLeft(t, ')');
@@ -487,6 +566,7 @@ begin
         Break;
       end;
     end;
+  end;
 end;
 
 function TIMAPSend.ExpungeFolder: Boolean;
@@ -546,6 +626,8 @@ begin
   if FUID then
     s := 'UID ' + s;
   if IMAPcommand(s) = 'OK' then
+  begin
+    ProcessLiterals;
     for n := 0 to FFullResult.Count - 1 do
     begin
       s := UpperCase(FFullResult[n]);
@@ -558,6 +640,7 @@ begin
         Break;
       end;
     end;
+  end;
 end;
 
 function TIMAPSend.CopyMess(MessID: integer; ToFolder: string): Boolean;
@@ -601,6 +684,7 @@ begin
   if FUID then
     s := 'UID ' + s;
   Result := IMAPcommand(s) = 'OK';
+  ProcessLiterals;
   for n := 0 to FFullResult.Count - 1 do
   begin
     s := uppercase(FFullResult[n]);
@@ -620,7 +704,14 @@ begin
   begin
     if IMAPcommand('STARTTLS') = 'OK' then
     begin
+{$IFDEF STREAMSEC}
+      if not assigned(FTLSServer) then
+        Exit;
+      Fsock.TLSServer := FTLSServer;
+      FSock.Connect('','');
+{$ELSE}
       Fsock.SSLDoConnect;
+{$ENDIF}
       Result := FSock.LastError = 0;
     end;
   end;
@@ -635,6 +726,7 @@ begin
   sUID := '';
   s := 'FETCH ' + IntToStr(MessID) + ' UID';
   Result := IMAPcommand(s) = 'OK';
+  ProcessLiterals;
   for n := 0 to FFullResult.Count - 1 do
   begin
     s := uppercase(FFullResult[n]);

mimeinln.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.000.005 |
+| Project : Delphree - Synapse                                   | 001.000.007 |
 |==============================================================================|
 | Content: Inline MIME support procedures and functions                        |
 |==============================================================================|
@@ -42,8 +42,6 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
-{$WEAKPACKAGEUNIT ON}
-
 unit MIMEinLn;
 
 interface
@@ -92,6 +90,9 @@ begin
   v := Value;
   x := Pos('=?', v);
   y := SearchEndInline(v, x);
+  //fix for broken coding with begin, but not with end.
+  if (x > 0) and (y <= 0) then
+    y := Length(Result);
   while (y > x) and (x > 0) do
   begin
     s := Copy(v, 1, x - 1);

mimemess.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.001.002 |
+| Project : Delphree - Synapse                                   | 002.001.003 |
 |==============================================================================|
 | Content: MIME message object                                                 |
 |==============================================================================|
@@ -42,8 +42,6 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
-{$WEAKPACKAGEUNIT ON}
-
 unit MIMEmess;
 
 interface

mimepart.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.003.002 |
+| Project : Delphree - Synapse                                   | 002.003.004 |
 |==============================================================================|
 | Content: MIME support procedures and functions                               |
 |==============================================================================|
@@ -695,7 +695,8 @@ begin
               s := CharsetConversion(s, FTargetCharset, FCharsetCode);
             if FEncodingCode = ME_QUOTED_PRINTABLE then
             begin
-              s := EncodeQuotedPrintable(s);
+              s := EncodeTriplet(s, '=', [Char(1)..Char(31), '=', Char(128)..Char(255)]);
+//              s := EncodeQuotedPrintable(s);
               repeat
                 if Length(s) < FMaxLineLength then
                 begin
@@ -813,7 +814,7 @@ begin
   if Primary = '' then
     Primary := 'application';
   if FSecondary = '' then
-    FSecondary := 'octet-string';
+    FSecondary := 'octet-stream';
 end;
 
 {==============================================================================}

nntpsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.002.003 |
+| Project : Delphree - Synapse                                   | 001.003.001 |
 |==============================================================================|
 | Content: NNTP client                                                         |
 |==============================================================================|
@@ -42,14 +42,15 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
-{$WEAKPACKAGEUNIT ON}
-
 unit NNTPsend;
 
 interface
 
 uses
   SysUtils, Classes,
+  {$IFDEF STREAMSEC}
+  TlsInternalServer, TlsSynaSock,
+  {$ENDIF}
   blcksock, SynaUtil, SynaCode;
 
 const
@@ -58,13 +59,21 @@ const
 type
   TNNTPSend = class(TSynaClient)
   private
+    {$IFDEF STREAMSEC}
+    FSock: TSsTCPBlockSocket;
+    FTLSServer: TCustomTLSInternalServer;
+    {$ELSE}
     FSock: TTCPBlockSocket;
+    {$ENDIF}
     FResultCode: Integer;
     FResultString: string;
     FData: TStringList;
     FDataToSend: TStringList;
     FUsername: string;
     FPassword: string;
+    FAutoTLS: Boolean;
+    FFullSSL: Boolean;
+    FNNTPcap: TStringList;
     function ReadResult: Integer;
     function ReadData: boolean;
     function SendData: boolean;
@@ -91,13 +100,23 @@ type
     function PostArticle: Boolean;
     function SwitchToSlave: Boolean;
     function Xover(xoStart, xoEnd: string): boolean;
+    function StartTLS: Boolean;
+    function FindCap(const Value: string): string;
+    function ListExtensions: Boolean;
   published
     property Username: string read FUsername write FUsername;
     property Password: string read FPassword write FPassword;
     property ResultCode: Integer read FResultCode;
     property ResultString: string read FResultString;
     property Data: TStringList read FData;
+    property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
+    property FullSSL: Boolean read FFullSSL Write FFullSSL;
+{$IFDEF STREAMSEC}
+    property Sock: TSsTCPBlockSocket read FSock;
+    property TLSServer: TCustomTLSInternalServer read FTLSServer write FTLSServer;
+{$ELSE}
     property Sock: TTCPBlockSocket read FSock;
+{$ENDIF}
   end;
 
 implementation
@@ -105,14 +124,23 @@ implementation
 constructor TNNTPSend.Create;
 begin
   inherited Create;
+{$IFDEF STREAMSEC}
+  FTLSServer := GlobalTLSInternalServer;
+  FSock := TSsTCPBlockSocket.Create;
+  FSock.BlockingRead := True;
+{$ELSE}
+  FSock := TTCPBlockSocket.Create;
+{$ENDIF}
   FData := TStringList.Create;
   FDataToSend := TStringList.Create;
-  FSock := TTCPBlockSocket.Create;
+  FNNTPcap := TStringList.Create;
   FSock.ConvertLineEnd := True;
-  FTimeout := 300000;
+  FTimeout := 60000;
   FTargetPort := cNNTPProtocol;
   FUsername := '';
   FPassword := '';
+  FAutoTLS := False;
+  FFullSSL := False;
 end;
 
 destructor TNNTPSend.Destroy;
@@ -120,6 +148,7 @@ begin
   FSock.Free;
   FDataToSend.Free;
   FData.Free;
+  FNNTPcap.Free;
   inherited Destroy;
 end;
 
@@ -179,16 +208,40 @@ function TNNTPSend.Connect: Boolean;
 begin
   FSock.CloseSocket;
   FSock.Bind(FIPInterface, cAnyPort);
-  FSock.Connect(FTargetHost, FTargetPort);
+{$IFDEF STREAMSEC}
+  if FFullSSL then
+  begin
+    if assigned(FTLSServer) then
+      FSock.TLSServer := FTLSServer;
+    else
+    begin
+      result := False;
+      Exit;
+    end;
+  end
+  else
+    FSock.TLSServer := nil;
+{$ELSE}
+  if FFullSSL then
+    FSock.SSLEnabled := True;
+{$ENDIF}
+  if FSock.LastError = 0 then
+    FSock.Connect(FTargetHost, FTargetPort);
   Result := FSock.LastError = 0;
 end;
 
 function TNNTPSend.Login: Boolean;
 begin
   Result := False;
+  FNNTPcap.Clear;
   if not Connect then
     Exit;
   Result := (ReadResult div 100) = 2;
+  ListExtensions;
+  FNNTPcap.Assign(Fdata);
+  if result then
+    if (not FullSSL) and FAutoTLS and (FindCap('STARTTLS') <> '') then
+      result := StartTLS;
   if (FUsername <> '') and Result then
   begin
     FSock.SendString('AUTHINFO USER ' + FUsername + CRLF);
@@ -335,6 +388,50 @@ begin
   Result := DoCommandRead(s);
 end;
 
+function TNNTPSend.StartTLS: Boolean;
+begin
+  Result := False;
+  if FindCap('STARTTLS') <> '' then
+  begin
+    if DoCommand('STARTTLS') then
+    begin
+{$IFDEF STREAMSEC}
+      if (Assigned(FTLSServer) then
+      begin
+        Fsock.TLSServer := FTLSServer;
+        Fsock.Connect('','');
+        Result := FSock.LastError = 0;
+      end
+      else
+        Result := False;
+{$ELSE}
+      Fsock.SSLDoConnect;
+      Result := FSock.LastError = 0;
+{$ENDIF}
+    end;
+  end;
+end;
+
+function TNNTPSend.ListExtensions: Boolean;
+begin
+  Result := DoCommandRead('LIST EXTENSIONS');
+end;
+
+function TNNTPSend.FindCap(const Value: string): string;
+var
+  n: Integer;
+  s: string;
+begin
+  s := UpperCase(Value);
+  Result := '';
+  for n := 0 to FNNTPcap.Count - 1 do
+    if Pos(s, UpperCase(FNNTPcap[n])) = 1 then
+    begin
+      Result := FNNTPcap[n];
+      Break;
+    end;
+end;
+
 {==============================================================================}
 
 end.

pingsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.003.001 |
+| Project : Delphree - Synapse                                   | 003.000.002 |
 |==============================================================================|
 | Content: PING sender                                                         |
 |==============================================================================|
@@ -42,14 +42,8 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
-{
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-See 'winsock2.txt' file in distribute package!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-}
-
 {$Q-}
-{$WEAKPACKAGEUNIT ON}
+{$R-}
 
 unit PINGsend;
 
@@ -67,6 +61,8 @@ uses
 const
   ICMP_ECHO = 8;
   ICMP_ECHOREPLY = 0;
+  ICMP6_ECHO = 128;
+  ICMP6_ECHOREPLY = 129;
 
 type
   TIcmpEchoHeader = record
@@ -75,7 +71,17 @@ type
     i_checkSum: Word;
     i_Id: Word;
     i_seq: Word;
-    TimeStamp: ULONG;
+    TimeStamp: ULong;
+  end;
+
+  TICMP6Packet = record
+    in_source: TInAddr6;
+    in_dest: TInAddr6;
+    Length: integer;
+    free0: Byte;
+    free1: Byte;
+    free2: Byte;
+    proto: Byte;
   end;
 
   TPINGSend = class(TSynaClient)
@@ -86,7 +92,10 @@ type
     FId: Integer;
     FPacketSize: Integer;
     FPingTime: Integer;
-    function Checksum: Integer;
+    FIcmpEcho: Byte;
+    FIcmpEchoReply: Byte;
+    function Checksum(Value: string): Word;
+    function Checksum6(Value: string): Word;
     function ReadPacket: Boolean;
   public
     function Ping(const Host: string): Boolean;
@@ -108,7 +117,6 @@ constructor TPINGSend.Create;
 begin
   inherited Create;
   FSock := TICMPBlockSocket.Create;
-  FSock.CreateSocket;
   FTimeout := 5000;
   FPacketSize := 32;
   FSeq := 0;
@@ -136,13 +144,27 @@ var
   t: Boolean;
 begin
   Result := False;
+  FPingTime := -1;
   FSock.Bind(FIPInterface, cAnyPort);
   FSock.Connect(Host, '0');
+  if FSock.LastError <> 0 then
+    Exit;
+  FSock.SizeRecvBuffer := 60 * 1024;
+  if FSock.IP6used then
+  begin
+    FIcmpEcho := ICMP6_ECHO;
+    FIcmpEchoReply := ICMP6_ECHOREPLY;
+  end
+  else
+  begin
+    FIcmpEcho := ICMP_ECHO;
+    FIcmpEchoReply := ICMP_ECHOREPLY;
+  end;
   FBuffer := StringOfChar(#0, SizeOf(TICMPEchoHeader) + FPacketSize);
   IcmpEchoHeaderPtr := Pointer(FBuffer);
   with IcmpEchoHeaderPtr^ do
   begin
-    i_type := ICMP_ECHO;
+    i_type := FIcmpEcho;
     i_code := 0;
     i_CheckSum := 0;
     FId := Random(32767);
@@ -152,28 +174,43 @@ begin
     i_Seq := FSeq;
     for n := Succ(SizeOf(TIcmpEchoHeader)) to Length(FBuffer) do
       FBuffer[n] := #$55;
-    i_CheckSum := CheckSum;
   end;
+  if fSock.IP6used then
+    IcmpEchoHeaderPtr^.i_CheckSum := CheckSum6(FBuffer)
+  else
+    IcmpEchoHeaderPtr^.i_CheckSum := CheckSum(FBuffer);
   FSock.SendString(FBuffer);
   repeat
     t := ReadPacket;
     if not t then
       break;
-    IPHeadPtr := Pointer(FBuffer);
+    if fSock.IP6used then
-    IpHdrLen := (IPHeadPtr^.VerLen and $0F) * 4;
+    begin
-    IcmpEchoHeaderPtr := @FBuffer[IpHdrLen + 1];
+{$IFDEF LINUX}
-  until (IcmpEchoHeaderPtr^.i_type <> ICMP_ECHO) and (IcmpEchoHeaderPtr^.i_id = FId);
+      IcmpEchoHeaderPtr := Pointer(FBuffer);
+{$ELSE}
+      FBuffer := StringOfChar(#0, 4) + FBuffer;
+      IcmpEchoHeaderPtr := Pointer(FBuffer);
+      IcmpEchoHeaderPtr^.i_type := FIcmpEchoReply;
+{$ENDIF}
+    end
+    else
+    begin
+      IPHeadPtr := Pointer(FBuffer);
+      IpHdrLen := (IPHeadPtr^.VerLen and $0F) * 4;
+      IcmpEchoHeaderPtr := @FBuffer[IpHdrLen + 1];
+    end;
+  until (IcmpEchoHeaderPtr^.i_type <> FIcmpEcho) and (IcmpEchoHeaderPtr^.i_id = FId);
   //it discard sometimes possible 'echoes' of previosly sended packet...
   if t then
-    if (IcmpEchoHeaderPtr^.i_type = ICMP_ECHOREPLY) then
+    if (IcmpEchoHeaderPtr^.i_type = FIcmpEchoReply) then
-      if (IcmpEchoHeaderPtr^.i_id = FId) then
+    begin
-      begin
+      FPingTime := TickDelta(IcmpEchoHeaderPtr^.TimeStamp, GetTick);
-        FPingTime := GetTick - IcmpEchoHeaderPtr^.TimeStamp;
+      Result := True;
-        Result := True;
+    end;
-      end;
 end;
 
-function TPINGSend.Checksum: Integer;
+function TPINGSend.Checksum(Value: string): Word;
 type
   TWordArray = array[0..0] of Word;
 var
@@ -182,29 +219,60 @@ var
   Num, Remain: Integer;
   n: Integer;
 begin
-  Num := Length(FBuffer) div 2;
+  Num := Length(Value) div 2;
-  Remain := Length(FBuffer) mod 2;
+  Remain := Length(Value) mod 2;
-  WordArr := Pointer(FBuffer);
+  WordArr := Pointer(Value);
   CkSum := 0;
   for n := 0 to Num - 1 do
     CkSum := CkSum + WordArr^[n];
   if Remain <> 0 then
-    CkSum := CkSum + Ord(FBuffer[Length(FBuffer)]);
+    CkSum := CkSum + Ord(Value[Length(Value)]);
   CkSum := (CkSum shr 16) + (CkSum and $FFFF);
   CkSum := CkSum + (CkSum shr 16);
   Result := Word(not CkSum);
 end;
 
+function TPINGSend.Checksum6(Value: string): Word;
+const
+  IOC_OUT = $40000000;
+  IOC_IN = $80000000;
+  IOC_INOUT = (IOC_IN or IOC_OUT);
+  IOC_WS2 = $08000000;
+  SIO_ROUTING_INTERFACE_QUERY = 20 or IOC_WS2 or IOC_INOUT;
+var
+  ICMP6Ptr: ^TICMP6Packet;
+  s: string;
+  b: integer;
+  ip6: TSockAddrIn6;
+  x: integer;
+begin
+{$IFDEF LINUX}
+  Result := 0;
+{$ELSE}
+  s := StringOfChar(#0, SizeOf(TICMP6Packet)) + Value;
+  ICMP6Ptr := Pointer(s);
+  x := synsock.WSAIoctl(FSock.Socket, SIO_ROUTING_INTERFACE_QUERY,
+    @FSock.RemoteSin.IP6, SizeOf(FSock.RemoteSin.IP6),
+    @ip6, SizeOf(ip6), @b, nil, nil);
+  if x <> -1 then
+    ICMP6Ptr^.in_dest := ip6.sin6_addr
+  else
+    ICMP6Ptr^.in_dest := FSock.LocalSin.IP6.sin6_addr;
+  ICMP6Ptr^.in_source := FSock.RemoteSin.IP6.sin6_addr;
+  ICMP6Ptr^.Length := synsock.htonl(Length(Value));
+  ICMP6Ptr^.proto := IPPROTO_ICMPV6;
+  Result := Checksum(s);
+{$ENDIF}
+end;
+
 {==============================================================================}
 
 function PingHost(const Host: string): Integer;
 begin
   with TPINGSend.Create do
   try
-    if Ping(Host) then
+    Ping(Host);
-      Result := PingTime
+    Result := PingTime;
-    else
-      Result := -1;
   finally
     Free;
   end;

pop3send.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.001.004 |
+| Project : Delphree - Synapse                                   | 002.001.008 |
 |==============================================================================|
 | Content: POP3 client                                                         |
 |==============================================================================|
@@ -42,8 +42,6 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
-{$WEAKPACKAGEUNIT ON}
-
 //RFC-1734
 //RFC-1939
 //RFC-2195
@@ -56,6 +54,9 @@ interface
 
 uses
   SysUtils, Classes,
+  {$IFDEF STREAMSEC}
+  TlsInternalServer, TlsSynaSock,
+  {$ENDIF}
   blcksock, SynaUtil, SynaCode;
 
 const
@@ -66,7 +67,12 @@ type
 
   TPOP3Send = class(TSynaClient)
   private
+    {$IFDEF STREAMSEC}
+    FSock: TSsTCPBlockSocket;
+    FTLSServer: TCustomTLSInternalServer;
+    {$ELSE}
     FSock: TTCPBlockSocket;
+    {$ENDIF}
     FResultCode: Integer;
     FResultString: string;
     FFullResult: TStringList;
@@ -109,9 +115,14 @@ type
     property StatSize: Integer read  FStatSize;
     property TimeStamp: string read FTimeStamp;
     property AuthType: TPOP3AuthType read FAuthType Write FAuthType;
-    property Sock: TTCPBlockSocket read FSock;
     property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
     property FullSSL: Boolean read FFullSSL Write FFullSSL;
+{$IFDEF STREAMSEC}
+    property Sock: TSsTCPBlockSocket read FSock;
+    property TLSServer: TCustomTLSInternalServer read FTLSServer write FTLSServer;
+{$ELSE}
+    property Sock: TTCPBlockSocket read FSock;
+{$ENDIF}
   end;
 
 implementation
@@ -121,10 +132,15 @@ begin
   inherited Create;
   FFullResult := TStringList.Create;
   FPOP3cap := TStringList.Create;
+{$IFDEF STREAMSEC}           
+  FTLSServer := GlobalTLSInternalServer;     
+  FSock := TSsTCPBlockSocket.Create;
+  FSock.BlockingRead := True;
+{$ELSE}
   FSock := TTCPBlockSocket.Create;
-  FSock.CreateSocket;
+{$ENDIF}
   FSock.ConvertLineEnd := true;
-  FTimeout := 300000;
+  FTimeout := 60000;
   FTargetPort := cPop3Protocol;
   FUsername := '';
   FPassword := '';
@@ -192,11 +208,26 @@ begin
   FStatSize := 0;
   FSock.CloseSocket;
   FSock.LineBuffer := '';
-  FSock.CreateSocket;
+  FSock.Bind(FIPInterface, cAnyPort);
+{$IFDEF STREAMSEC}
+  if FFullSSL then
+  begin
+    if Assigned(FTLSServer) then
+      FSock.TLSServer := FTLSServer
+    else
+    begin
+      Result := false;
+      Exit;
+    end;
+  end
+  else
+    FSock.TLSServer := nil;
+{$ELSE}
   if FFullSSL then
     FSock.SSLEnabled := True;
-  FSock.Bind(FIPInterface, cAnyPort);
+{$ENDIF}
-  FSock.Connect(FTargetHost, FTargetPort);
+  if FSock.LastError = 0 then
+    FSock.Connect(FTargetHost, FTargetPort);
   Result := FSock.LastError = 0;
 end;
 
@@ -321,8 +352,19 @@ begin
   FSock.SendString('STLS' + CRLF);
   if ReadResult(False) = 1 then
   begin
+{$IFDEF STREAMSEC}
+    if Assigned(FTLSServer) then
+    begin
+      Fsock.TLSServer := FTLSServer;
+      Fsock.Connect('','');
+      Result := FSock.LastError = 0;
+    end
+    else
+      Result := false;
+{$ELSE}
     Fsock.SSLDoConnect;
     Result := FSock.LastError = 0;
+{$ENDIF}
   end;
 end;
 

slogsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.001.001 |
+| Project : Delphree - Synapse                                   | 001.001.004 |
 |==============================================================================|
 | Content: SysLog client                                                       |
 |==============================================================================|
@@ -45,7 +45,6 @@
 // RFC-3164
 
 {$Q-}
-{$WEAKPACKAGEUNIT ON}
 
 unit SLogSend;
 
@@ -114,13 +113,11 @@ constructor TSyslogSend.Create;
 begin
   inherited Create;
   FSock := TUDPBlockSocket.Create;
-  FSock.CreateSocket;
   FTargetPort := cSysLogProtocol;
   FFacility := FCL_Local0;
   FSeverity := Debug;
   FTag := ExtractFileName(ParamStr(0));
   FMessage := '';
-  FIPInterface := cAnyHost;
 end;
 
 destructor TSyslogSend.Destroy;
@@ -152,9 +149,9 @@ begin
   Buf := Buf + Tag + ': ' + FMessage;
   if Length(Buf) <= 1024 then
   begin
-    if FSock.EnableReuse(True) then
+    FSock.EnableReuse(True);
-      Fsock.Bind(FIPInterface, FTargetPort)
+    Fsock.Bind(FIPInterface, FTargetPort);
-    else
+    if FSock.LastError <> 0 then
       FSock.Bind(FIPInterface, cAnyPort);
     FSock.Connect(FTargetHost, FTargetPort);
     FSock.SendString(Buf);

smtpsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 003.002.004 |
+| Project : Delphree - Synapse                                   | 003.002.008 |
 |==============================================================================|
 | Content: SMTP client                                                         |
 |==============================================================================|
@@ -42,14 +42,15 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
-{$WEAKPACKAGEUNIT ON}
-
 unit SMTPsend;
 
 interface
 
 uses
   SysUtils, Classes,
+  {$IFDEF STREAMSEC}
+  TlsInternalServer, TlsSynaSock,
+  {$ENDIF}
   blcksock, SynaUtil, SynaCode;
 
 const
@@ -58,7 +59,12 @@ const
 type
   TSMTPSend = class(TSynaClient)
   private
+    {$IFDEF STREAMSEC}
+    FSock: TSsTCPBlockSocket;
+    FTLSServer: TCustomTLSInternalServer;
+    {$ELSE}
     FSock: TTCPBlockSocket;
+    {$ENDIF}
     FResultCode: Integer;
     FResultString: string;
     FFullResult: TStringList;
@@ -112,9 +118,14 @@ type
     property EnhCode2: Integer read FEnhCode2;
     property EnhCode3: Integer read FEnhCode3;
     property SystemName: string read FSystemName Write FSystemName;
-    property Sock: TTCPBlockSocket read FSock;
     property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
     property FullSSL: Boolean read FFullSSL Write FFullSSL;
+{$IFDEF STREAMSEC}
+    property Sock: TSsTCPBlockSocket read FSock;
+    property TLSServer: TCustomTLSInternalServer read FTLSServer write FTLSServer;
+{$ELSE}
+    property Sock: TTCPBlockSocket read FSock;
+{$ENDIF}
   end;
 
 function SendToRaw(const MailFrom, MailTo, SMTPHost: string;
@@ -131,10 +142,15 @@ begin
   inherited Create;
   FFullResult := TStringList.Create;
   FESMTPcap := TStringList.Create;
+{$IFDEF STREAMSEC}           
+  FTLSServer := GlobalTLSInternalServer;     
+  FSock := TSsTCPBlockSocket.Create;
+  FSock.BlockingRead := True;
+{$ELSE}
   FSock := TTCPBlockSocket.Create;
-  FSock.CreateSocket;
+{$ENDIF}
   FSock.ConvertLineEnd := true;
-  FTimeout := 300000;
+  FTimeout := 60000;
   FTargetPort := cSmtpProtocol;
   FUsername := '';
   FPassword := '';
@@ -239,11 +255,26 @@ end;
 function TSMTPSend.Connect: Boolean;
 begin
   FSock.CloseSocket;
-  FSock.CreateSocket;
+  FSock.Bind(FIPInterface, cAnyPort);
+{$IFDEF STREAMSEC}
+  if FFullSSL then
+  begin
+    if assigned(FTLSServer) then
+      FSock.TLSServer := FTLSServer;
+    else
+    begin
+      result := False;
+      Exit;
+    end;
+  end
+  else
+    FSock.TLSServer := nil;
+{$ELSE}
   if FFullSSL then
     FSock.SSLEnabled := True;
-  FSock.Bind(FIPInterface, cAnyPort);
+{$ENDIF}
-  FSock.Connect(FTargetHost, FTargetPort);
+  if FSock.LastError = 0 then
+    FSock.Connect(FTargetHost, FTargetPort);
   Result := FSock.LastError = 0;
 end;
 
@@ -406,8 +437,19 @@ begin
     FSock.SendString('STARTTLS' + CRLF);
     if (ReadResult = 220) and (FSock.LastError = 0) then
     begin
+{$IFDEF STREAMSEC}
+      if (Assigned(FTLSServer) then
+      begin
+        Fsock.TLSServer := FTLSServer;
+        Fsock.Connect('','');
+        Result := FSock.LastError = 0;
+      end
+      else
+        Result := False;
+{$ELSE}
       Fsock.SSLDoConnect;
       Result := FSock.LastError = 0;
+{$ENDIF}
     end;
   end;
 end;

snmpsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.006.000 |
+| Project : Delphree - Synapse                                   | 002.006.002 |
 |==============================================================================|
 | Content: SNMP client                                                         |
 |==============================================================================|
@@ -44,7 +44,6 @@
 |==============================================================================}
 
 {$Q-}
-{$WEAKPACKAGEUNIT ON}
 
 unit SNMPSend;
 
@@ -308,7 +307,6 @@ begin
   FQuery.Clear;
   FReply.Clear;
   FSock := TUDPBlockSocket.Create;
-  FSock.CreateSocket;
   FTimeout := 5000;
   FTargetPort := cSnmpProtocol;
   FHostIP := '';

snmptrap.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.003.000 |
+| Project : Delphree - Synapse                                   | 002.003.002 |
 |==============================================================================|
 | Content: SNMP traps                                                          |
 |==============================================================================|
@@ -44,7 +44,6 @@
 |==============================================================================}
 
 {$Q-}
-{$WEAKPACKAGEUNIT ON}
 
 unit SNMPTrap;
 
@@ -272,7 +271,6 @@ constructor TTrapSNMP.Create;
 begin
   inherited Create;
   FSock := TUDPBlockSocket.Create;
-  FSock.CreateSocket;
   FTrap := TTrapPDU.Create;
   FTimeout := 5000;
   FTargetPort := cSnmpTrapProtocol;

sntpsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.002.001 |
+| Project : Delphree - Synapse                                   | 002.002.003 |
 |==============================================================================|
 | Content: SNTP client                                                         |
 |==============================================================================|
@@ -44,7 +44,6 @@
 |==============================================================================}
 
 {$Q-}
-{$WEAKPACKAGEUNIT ON}
 
 unit SNTPsend;
 
@@ -112,7 +111,6 @@ constructor TSNTPSend.Create;
 begin
   inherited Create;
   FSock := TUDPBlockSocket.Create;
-  FSock.CreateSocket;
   FTimeout := 5000;
   FTargetPort := cNtpProtocol;
   FMaxSyncDiff := 3600;

synachar.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 004.000.003 |
+| Project : Delphree - Synapse                                   | 004.000.005 |
 |==============================================================================|
 | Content: Charset conversion support                                          |
 |==============================================================================|
@@ -43,7 +43,6 @@
 |==============================================================================}
 
 {$Q-}
-{$WEAKPACKAGEUNIT ON}
 
 unit SynaChar;
 
@@ -797,51 +796,71 @@ end;
 {==============================================================================}
 procedure ReadMulti(const Value: string; var Index: Integer; mb: Byte;
   var b1, b2, b3, b4: Byte);
-var
+Begin
-  b: array[0..3] of Byte;
-  n: Integer;
-  s: string;
-begin
-  b[0] := 0;
-  b[1] := 0;
-  b[2] := 0;
-  b[3] := 0;
   b1 := 0;
   b2 := 0;
   b3 := 0;
   b4 := 0;
-  if length(Value) < (Index + mb - 1) then
+  if Index < 0 then
+    Index := 1;
+  if mb > 4 then
+    mb := 1;
+  if (Index + mb - 1) <= Length(Value) then
   begin
-    Inc(index, mb);
+    Case mb Of
-    Exit;
+      1:
-  end;
+        b1 := Ord(Value[Index]);
-  s := '';
+      2:
-  for n := 1 to mb do
+        Begin
-  begin
+          b1 := Ord(Value[Index]);
-    s := Value[Index] + s;
+          b2 := Ord(Value[Index + 1]);
-    Inc(Index);
+        End;
-  end;
+      3:
-  for n := 1 to mb do
+        Begin
-    b[n - 1] := Ord(s[n]);
+          b1 := Ord(Value[Index]);
-  b1 := b[0];
+          b2 := Ord(Value[Index + 1]);
-  b2 := b[1];
+          b3 := Ord(Value[Index + 2]);
-  b3 := b[2];
+        End;
-  b4 := b[3];
+      4:
-end;
+        Begin
+          b1 := Ord(Value[Index]);
+          b2 := Ord(Value[Index + 1]);
+          b3 := Ord(Value[Index + 2]);
+          b4 := Ord(Value[Index + 3]);
+        End;
+    end;
+    Inc(Index, mb);
+  End;
+End;
 
 {==============================================================================}
 function WriteMulti(b1, b2, b3, b4: Byte; mb: Byte): string;
-var
-  b: array[0..3] of Byte;
-  n: Integer;
 begin
-  Result := '';
+  if mb > 4 then
-  b[0] := b1;
+    mb := 1;
-  b[1] := b2;
+  SetLength(Result, mb);
-  b[2] := b3;
+  case mb Of
-  b[3] := b4;
+    1:
-  for n := 1 to mb do
+      Result[1] := Char(b1);
-    Result := Char(b[n - 1]) + Result;
+    2:
+      begin
+        Result[1] := Char(b1);
+        Result[2] := Char(b2);
+      end;
+    3:
+      begin
+        Result[1] := Char(b1);
+        Result[2] := Char(b2);
+        Result[3] := Char(b3);
+      end;
+    4:
+      begin
+        Result[1] := Char(b1);
+        Result[2] := Char(b2);
+        Result[3] := Char(b3);
+        Result[4] := Char(b4);
+      end;
+  end;
 end;
 
 {==============================================================================}

synacode.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.006.001 |
+| Project : Delphree - Synapse                                   | 001.007.001 |
 |==============================================================================|
 | Content: Coding and decoding support                                         |
 |==============================================================================|
@@ -43,7 +43,6 @@
 |==============================================================================}
 
 {$Q-}
-{$WEAKPACKAGEUNIT ON}
 
 unit SynaCode;
 
@@ -115,6 +114,7 @@ function EncodeBase64(const Value: string): string;
 function DecodeUU(const Value: string): string;
 function EncodeUU(const Value: string): string;
 function DecodeXX(const Value: string): string;
+function DecodeYEnc(const Value: string): string;
 function UpdateCrc32(Value: Byte; Crc32: Integer): Integer;
 function Crc32(const Value: string): Integer;
 function UpdateCrc16(Value: Byte; Crc16: Word): Word;
@@ -559,6 +559,30 @@ end;
 
 {==============================================================================}
 
+function DecodeYEnc(const Value: string): string;
+var
+  C : Byte;
+  i: integer;
+begin
+  Result := '';
+  i := 1;
+  while i <= Length(Value) do
+  begin
+    c := Ord(Value[i]);
+    Inc(i);
+    if c = Ord('=') then
+    begin
+      c := Ord(Value[i]);
+      Inc(i);
+      Dec(c, 64);
+    end;
+    Dec(C, 42);
+    Result := Result + Char(C);
+  end;
+end;
+
+{==============================================================================}
+
 function UpdateCrc32(Value: Byte; Crc32: Integer): Integer;
 begin
   Result := ((Crc32 shr 8) and Integer($00FFFFFF)) xor

synamisc.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.000.004 |
+| Project : Delphree - Synapse                                   | 001.000.006 |
 |==============================================================================|
 | Content: misc. procedures and functions                                      |
 |==============================================================================|
@@ -48,6 +48,14 @@ unit SynaMisc;
 
 interface
 
+{$IFDEF VER125}
+  {$DEFINE BCB}
+{$ENDIF}
+{$IFDEF BCB}
+  {$ObjExportAll On}
+  {$HPPEMIT '#pragma comment( lib , "wininet.lib" )'}
+{$ENDIF}
+
 uses
   SynaUtil, blcksock, SysUtils, Classes,
 {$IFDEF LINUX}

synassl.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.007.000 |
+| Project : Delphree - Synapse                                   | 001.007.001 |
 |==============================================================================|
 | Content: SSL support                                                         |
 |==============================================================================|
@@ -47,6 +47,14 @@ Special thanks to Gregor Ibic <gregor.ibic@intelicom.si>
  for good inspiration about SSL programming.
 }
 
+{$IFDEF VER125}
+  {$DEFINE BCB}
+{$ENDIF}
+{$IFDEF BCB}
+  {$ObjExportAll On}
+  (*$HPPEMIT 'namespace Synassl { using System::Shortint; }' *)
+{$ENDIF}
+
 unit SynaSSL;
 
 interface

synautil.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 003.003.000 |
+| Project : Delphree - Synapse                                   | 003.005.001 |
 |==============================================================================|
 | Content: support procedures and functions                                    |
 |==============================================================================|
@@ -45,6 +45,7 @@
 |==============================================================================}
 
 {$Q-}
+{$R-}
 
 unit SynaUtil;
 
@@ -70,11 +71,12 @@ function GetDateMDYFromStr(Value: string): TDateTime;
 function DecodeRfcDateTime(Value: string): TDateTime;
 function GetUTTime: TDateTime;
 function SetUTTime(Newdt: TDateTime): Boolean;
-function GetTick: Cardinal;
+function GetTick: ULong;
+function TickDelta(TickOld, TickNew: ULong): ULong;
 function CodeInt(Value: Word): string;
 function DecodeInt(const Value: string; Index: Integer): Word;
 function IsIP(const Value: string): Boolean;
-function ReverseIP(Value: string): string;
+function IsIP6(const Value: string): Boolean;
 function IPToID(Host: string): string;
 procedure Dump(const Buffer, DumpFile: string);
 procedure DumpEx(const Buffer, DumpFile: string);
@@ -479,7 +481,7 @@ end;
 {==============================================================================}
 
 {$IFDEF LINUX}
-function GetTick: Cardinal;
+function GetTick: ULong;
 var
   Stamp: TTimeStamp;
 begin
@@ -487,7 +489,7 @@ begin
   Result := Stamp.Time;
 end;
 {$ELSE}
-function GetTick: Cardinal;
+function GetTick: ULong;
 begin
   Result := Windows.GetTickCount;
 end;
@@ -495,6 +497,27 @@ end;
 
 {==============================================================================}
 
+function TickDelta(TickOld, TickNew: ULong): ULong;
+begin
+//if DWord is signed type (older Deplhi),
+// then it not work properly on differencies larger then maxint!
+  Result := 0;
+  if TickOld <> TickNew then
+  begin
+    if TickNew < TickOld then
+    begin
+      TickNew := TickNew + ULong(MaxInt) + 1;
+      TickOld := TickOld + ULong(MaxInt) + 1;
+    end;
+    Result := TickNew - TickOld;
+    if TickNew < TickOld then
+      if Result > 0 then
+        Result := 0 - Result;
+  end;
+end;
+
+{==============================================================================}
+
 function CodeInt(Value: Word): string;
 begin
   Result := Chr(Hi(Value)) + Chr(Lo(Value))
@@ -522,7 +545,6 @@ end;
 function IsIP(const Value: string): Boolean;
 var
   TempIP: string;
-
   function ByteIsOk(const Value: string): Boolean;
   var
     x, n: integer;
@@ -539,7 +561,6 @@ var
           Break;
         end;
   end;
-
 begin
   TempIP := Value;
   Result := False;
@@ -555,19 +576,47 @@ end;
 
 {==============================================================================}
 
-function ReverseIP(Value: string): string;
+function IsIP6(const Value: string): Boolean;
 var
-  x: Integer;
+  TempIP: string;
+  s,t: string;
+  x: integer;
+  partcount: integer;
+  zerocount: integer;
+  First: Boolean;
 begin
-  Result := '';
+  TempIP := Value;
-  repeat
+  Result := False;
-    x := LastDelimiter('.', Value);
+  partcount := 0;
-    Result := Result + '.' + Copy(Value, x + 1, Length(Value) - x);
+  zerocount := 0;
-    Delete(Value, x, Length(Value) - x + 1);
+  First := True;
-  until x < 1;
+  while tempIP <> '' do
-  if Length(Result) > 0 then
+  begin
-    if Result[1] = '.' then
+    s := fetch(TempIP, ':');
-      Delete(Result, 1, 1);
+    if not(First) and (s = '') then
+      Inc(zerocount);
+    First := False;
+    if zerocount > 1 then
+      break;
+    Inc(partCount);
+    if s = '' then
+      Continue;
+    if partCount > 8 then
+      break;
+    if tempIP = '' then
+    begin
+      t := SeparateRight(s, '%');
+      s := SeparateLeft(s, '%');
+      x := StrToIntDef('$' + t, -1);
+      if (x < 0) or (x > $ffff) then
+        break;
+    end;
+    x := StrToIntDef('$' + s, -1);
+    if (x < 0) or (x > $ffff) then
+      break;
+    if tempIP = '' then
+      Result := True;
+  end;
 end;
 
 {==============================================================================}
@@ -878,14 +927,25 @@ begin
     s1 := sURL;
     s2 := '';
   end;
-  x := Pos(':', s1);
+  if Pos('[', s1) = 1 then
-  if x > 0 then
   begin
-    Host := SeparateLeft(s1, ':');
+    Host := Separateleft(s1, ']');
-    Port := SeparateRight(s1, ':');
+    Delete(Host, 1, 1);
+    s1 := SeparateRight(s1, ']');
+    if Pos(':', s1) = 1 then
+      Port := SeparateRight(s1, ':');
   end
   else
-    Host := s1;
+  begin
+    x := Pos(':', s1);
+    if x > 0 then
+    begin
+      Host := SeparateLeft(s1, ':');
+      Port := SeparateRight(s1, ':');
+    end
+    else
+      Host := s1;
+  end;
   Result := '/' + s2;
   x := Pos('?', s2);
   if x > 0 then

tlntsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.000.002 |
+| Project : Delphree - Synapse                                   | 001.001.001 |
 |==============================================================================|
 | Content: TELNET client                                                       |
 |==============================================================================|
@@ -42,8 +42,6 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
-{$WEAKPACKAGEUNIT ON}
-
 //RFC-854
 
 unit TlntSend;
@@ -87,6 +85,7 @@ type
     FSessionLog: string;
     FSubNeg: string;
     FSubType: char;
+    FTermType: string;
     function Connect: Boolean;
     function Negotiate(const Buf: string): string;
     procedure FilterHook(Sender: TObject; var Value: string);
@@ -102,6 +101,7 @@ type
   published
     property Sock: TTCPBlockSocket read FSock;
     property SessionLog: string read FSessionLog write FSessionLog;
+    property TermType: string read FTermType write FTermType;
   end;
 
 implementation
@@ -111,10 +111,11 @@ begin
   inherited Create;
   FSock := TTCPBlockSocket.Create;
   FSock.OnReadFilter := FilterHook;
-  FTimeout := 300000;
+  FTimeout := 60000;
   FTargetPort := cTelnetProtocol;
   FSubNeg := '';
   FSubType := #0;
+  FTermType := 'SYNAPSE';
 end;
 
 destructor TTelnetSend.Destroy;
@@ -265,7 +266,7 @@ begin
                 #24:  //termtype
                   begin
                     if (FSubNeg <> '') and (FSubNeg[1] = #1) then
-                      SubReply := #0 + 'SYNAPSE';
+                      SubReply := #0 + FTermType;
                   end;
               end;
               Sock.SendString(TLNT_IAC + TLNT_SB + FSubType + SubReply + TLNT_IAC + TLNT_SE);