Release 25

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

asn1util.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.003.003 |
+| Project : Delphree - Synapse                                   | 001.003.004 |
 |==============================================================================|
 | Content: support for ASN.1 coding and decoding                               |
 |==============================================================================|
@@ -59,12 +59,10 @@ function ASNItem(var Start: Integer; const Buffer: string;
 function MibToId(Mib: string): string;
 function IdToMib(const Id: string): string;
 function IntMibToStr(const Value: string): string;
-function IPToID(Host: string): string;
 
 implementation
 
 {==============================================================================}
-
 function ASNEncOIDItem(Value: Integer): string;
 var
   x, xm: Integer;
@@ -85,7 +83,6 @@ begin
 end;
 
 {==============================================================================}
-
 function ASNDecOIDItem(var Start: Integer; const Buffer: string): Integer;
 var
   x: Integer;
@@ -103,7 +100,6 @@ begin
 end;
 
 {==============================================================================}
-
 function ASNEncLen(Len: Integer): string;
 var
   x, y: Integer;
@@ -126,7 +122,6 @@ begin
 end;
 
 {==============================================================================}
-
 function ASNDecLen(var Start: Integer; const Buffer: string): Integer;
 var
   x, n: Integer;
@@ -150,7 +145,6 @@ begin
 end;
 
 {==============================================================================}
-
 function ASNEncInt(Value: Integer): string;
 var
   x, y: Cardinal;
@@ -171,7 +165,6 @@ begin
 end;
 
 {==============================================================================}
-
 function ASNEncUInt(Value: Integer): string;
 var
   x, y: Integer;
@@ -192,14 +185,12 @@ begin
 end;
 
 {==============================================================================}
-
 function ASNObject(const Data: string; ASNType: Integer): string;
 begin
   Result := Char(ASNType) + ASNEncLen(Length(Data)) + Data;
 end;
 
 {==============================================================================}
-
 function ASNItem(var Start: Integer; const Buffer: string;
   var ValueType: Integer): string;
 var
@@ -298,7 +289,6 @@ begin
 end;
 
 {==============================================================================}
-
 function MibToId(Mib: string): string;
 var
   x: Integer;
@@ -335,7 +325,6 @@ begin
 end;
 
 {==============================================================================}
-
 function IdToMib(const Id: string): string;
 var
   x, y, n: Integer;
@@ -356,7 +345,6 @@ begin
 end;
 
 {==============================================================================}
-
 function IntMibToStr(const Value: string): string;
 var
   n, y: Integer;
@@ -368,25 +356,5 @@ begin
 end;
 
 {==============================================================================}
-//Hernan Sanchez
-
-function IPToID(Host: string): string;
-var
-  s, t: string;
-  i, x: Integer;
-begin
-  Result := '';
-  for x := 1 to 3 do
-  begin
-    t := '';
-    s := StrScan(PChar(Host), '.');
-    t := Copy(Host, 1, (Length(Host) - Length(s)));
-    Delete(Host, 1, (Length(Host) - Length(s) + 1));
-    i := StrToIntDef(t, 0);
-    Result := Result + Chr(i);
-  end;
-  i := StrToIntDef(Host, 0);
-  Result := Result + Chr(i);
-end;
 
 end.

blcksock.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 003.003.000 |
+| Project : Delphree - Synapse                                   | 004.000.000 |
 |==============================================================================|
 | Content: Library base                                                        |
 |==============================================================================|
@@ -36,7 +36,7 @@ uses
 {$ELSE}
   Windows, WinSock,
 {$ENDIF}
-  synsock;
+  synsock, SynaUtil;
 
 const
   cLocalhost = 'localhost';
@@ -94,7 +94,7 @@ type
     destructor Destroy; override;
     procedure CloseSocket; virtual;
     procedure Bind(IP, Port: string);
-    procedure Connect(IP, Port: string);
+    procedure Connect(IP, Port: string); virtual;
     function SendBuffer(Buffer: Pointer; Length: Integer): Integer; virtual;
     procedure SendByte(Data: Byte); virtual;
     procedure SendString(const Data: string); virtual;
@@ -103,6 +103,7 @@ type
       Timeout: Integer): Integer; virtual;
     function RecvByte(Timeout: Integer): Byte; virtual;
     function RecvString(Timeout: Integer): string; virtual;
+    function RecvPacket(Timeout: Integer): string; virtual;
     function PeekBuffer(Buffer: Pointer; Length: Integer): Integer; virtual;
     function PeekByte(Timeout: Integer): Byte; virtual;
     function WaitingData: Integer;
@@ -112,19 +113,24 @@ type
     procedure ExceptCheck;
     function LocalName: string;
     procedure ResolveNameToIP(Name: string; IPList: TStrings);
-    function GetLocalSinIP: string;
+    function ResolveName(Name: string): string;
-    function GetRemoteSinIP: string;
+    function ResolvePort(Port: string): Word;
-    function GetLocalSinPort: Integer;
+    procedure SetRemoteSin(IP, Port: string);
-    function GetRemoteSinPort: Integer;
+    function GetLocalSinIP: string; virtual;
+    function GetRemoteSinIP: string; virtual;
+    function GetLocalSinPort: Integer; virtual;
+    function GetRemoteSinPort: Integer; virtual;
     function CanRead(Timeout: Integer): Boolean;
     function CanWrite(Timeout: Integer): Boolean;
-    function SendBufferTo(Buffer: Pointer; Length: Integer): Integer;
+    function SendBufferTo(Buffer: Pointer; Length: Integer): Integer; virtual;
-    function RecvBufferFrom(Buffer: Pointer; Length: Integer): Integer;
+    function RecvBufferFrom(Buffer: Pointer; Length: Integer): Integer; virtual;
     function GroupCanRead(const SocketList: TList; Timeout: Integer;
       const CanReadList: TList): Boolean;
 
     //See 'winsock2.txt' file in distribute package!
     function SetTimeout(Timeout: Integer): Boolean;
+    function SetSendTimeout(Timeout: Integer): Boolean;
+    function SetRecvTimeout(Timeout: Integer): Boolean;
 
     property LocalSin: TSockAddrIn read FLocalSin;
     property RemoteSin: TSockAddrIn read FRemoteSin;
@@ -141,18 +147,65 @@ type
     property OnStatus: THookSocketStatus read FOnStatus write FOnStatus;
   end;
 
-  TUDPBlockSocket = class(TBlockSocket)
+  TSocksBlockSocket = class(TBlockSocket)
+  protected
+    FSocksIP: string;
+    FSocksPort: string;
+    FSocksTimeout: integer;
+    FSocksUsername: string;
+    FSocksPassword: string;
+    FUsingSocks: Boolean;
+    FSocksResolver: Boolean;
+    FSocksLastError: integer;
+    FSocksResponseIP: string;
+    FSocksResponsePort: string;
+    FSocksLocalIP: string;
+    FSocksLocalPort: string;
+    FSocksRemoteIP: string;
+    FSocksRemotePort: string;
+    function SocksCode(IP, Port: string): string;
+    function SocksDecode(Value: string): integer;
   public
-    procedure CreateSocket; override;
+    constructor Create;
-    function EnableBroadcast(Value: Boolean): Boolean;
+    function SocksOpen: Boolean;
+    function SocksRequest(Cmd: Byte; const IP, Port: string): Boolean;
+    function SocksResponse: Boolean;
+  published
+    property SocksIP: string read FSocksIP write FSocksIP;
+    property SocksPort: string read FSocksPort write FSocksPort;
+    property SocksUsername: string read FSocksUsername write FSocksUsername;
+    property SocksPassword: string read FSocksPassword write FSocksPassword;
+    property UsingSocks: Boolean read FUsingSocks;
+    property SocksResolver: Boolean read FSocksResolver write FSocksResolver;
+    property SocksLastError: integer read FSocksLastError;
   end;
 
-  TTCPBlockSocket = class(TBlockSocket)
+  TTCPBlockSocket = class(TSocksBlockSocket)
   public
     procedure CreateSocket; override;
     procedure CloseSocket; override;
     procedure Listen;
     function Accept: TSocket;
+    procedure Connect(IP, Port: string); override;
+    function GetLocalSinIP: string; override;
+    function GetRemoteSinIP: string; override;
+    function GetLocalSinPort: Integer; override;
+    function GetRemoteSinPort: Integer; override;
+  end;
+
+  TUDPBlockSocket = class(TSocksBlockSocket)
+  protected
+    FSocksControlSock: TTCPBlockSocket;
+    function UdpAssociation: Boolean;
+  public
+    destructor Destroy; override;
+    procedure CreateSocket; override;
+    function EnableBroadcast(Value: Boolean): Boolean;
+    procedure Connect(IP, Port: string); override;
+    function SendBuffer(Buffer: Pointer; Length: Integer): Integer; override;
+    function RecvBuffer(Buffer: Pointer; Length: Integer): Integer; override;
+    function SendBufferTo(Buffer: Pointer; Length: Integer): Integer; override;
+    function RecvBufferFrom(Buffer: Pointer; Length: Integer): Integer; override;
   end;
 
   //See 'winsock2.txt' file in distribute package!
@@ -342,23 +395,19 @@ end;
 
 procedure TBlockSocket.SendByte(Data: Byte);
 begin
-  sockcheck(synsock.Send(FSocket, Data, 1, 0));
+  SendBuffer(@Data, 1);
-  ExceptCheck;
-  DoStatus(HR_WriteCount, '1');
 end;
 
 procedure TBlockSocket.SendString(const Data: string);
 begin
-  SockCheck(synsock.Send(FSocket, PChar(Data)^, Length(Data), 0));
+  SendBuffer(PChar(Data), Length(Data));
-  ExceptCheck;
-  DoStatus(HR_WriteCount, IntToStr(Length(Data)));
 end;
 
 function TBlockSocket.RecvBuffer(Buffer: Pointer; Length: Integer): Integer;
 begin
   Result := synsock.Recv(FSocket, Buffer^, Length, 0);
   if Result = 0 then
-    FLastError := WSAENOTCONN
+    FLastError := WSAECONNRESET
   else
     SockCheck(Result);
   ExceptCheck;
@@ -407,7 +456,7 @@ begin
         SetLength(st, l);
         x := synsock.Recv(FSocket, Pointer(st)^, l, 0);
         if x = 0 then
-          FLastError := WSAENOTCONN
+          FLastError := WSAECONNRESET
         else
           SockCheck(x);
         if FLastError <> 0 then
@@ -432,6 +481,38 @@ begin
   ExceptCheck;
 end;
 
+function TBlockSocket.RecvPacket(Timeout: Integer): string;
+var
+  x: integer;
+  s: string;
+begin
+  Result := '';
+  FLastError := 0;
+  x := -1;
+  if FBuffer <> '' then
+  begin
+    Result := FBuffer;
+    FBuffer := '';
+  end
+  else
+    if CanRead(Timeout) then
+    begin
+      x := WaitingData;
+      if x > 0 then
+      begin
+        SetLength(s, x);
+        x := RecvBuffer(Pointer(s), x);
+        Result := Copy(s, 1, x);
+      end;
+    end
+    else
+      FLastError := WSAETIMEDOUT;
+  ExceptCheck;
+  if x = 0 then
+    FLastError := WSAECONNRESET;
+end;
+
+
 function TBlockSocket.RecvByte(Timeout: Integer): Byte;
 var
   y: Integer;
@@ -443,7 +524,7 @@ begin
   begin
     y := synsock.Recv(FSocket, Data, 1, 0);
     if y = 0 then
-      FLastError := WSAENOTCONN
+      FLastError := WSAECONNRESET
     else
       SockCheck(y);
     Result := Data;
@@ -487,7 +568,7 @@ begin
         r := synsock.Recv(FSocket, Pointer(FBuffer)^, x, 0);
         SockCheck(r);
         if r = 0 then
-          FLastError := WSAENOTCONN;
+          FLastError := WSAECONNRESET;
         if FLastError <> 0 then
           Break;
         DoStatus(HR_ReadCount, IntToStr(r));
@@ -538,7 +619,7 @@ begin
   begin
     y := synsock.Recv(FSocket, Data, 1, MSG_PEEK);
     if y = 0 then
-      FLastError := WSAENOTCONN;
+      FLastError := WSAECONNRESET;
     SockCheck(y);
     Result := Data;
   end
@@ -640,11 +721,46 @@ begin
         Inc(i);
       end;
     end;
+    if IPList.Count = 0 then
+      IPList.Add('0.0.0.0');
   end
   else
     IPList.Add(Name);
 end;
 
+function TBlockSocket.ResolveName(Name: string): string;
+var
+  l: TStringList;
+begin
+  l := TStringList.Create;
+  try
+    ResolveNameToIP(Name, l);
+    Result := l[0];
+  finally
+    l.Free;
+  end;
+end;
+
+function TBlockSocket.ResolvePort(Port: string): Word;
+var
+  ProtoEnt: PProtoEnt;
+  ServEnt: PServEnt;
+begin
+  ProtoEnt := synsock.GetProtoByNumber(FProtocol);
+  ServEnt := nil;
+  if ProtoEnt <> nil then
+    ServEnt := synsock.GetServByName(PChar(Port), ProtoEnt^.p_name);
+  if ServEnt = nil then
+    Result := synsock.htons(StrToIntDef(Port, 0))
+  else
+    Result := ServEnt^.s_port;
+end;
+
+procedure TBlockSocket.SetRemoteSin(IP, Port: string);
+begin
+  SetSin(FRemoteSin, IP, Port);
+end;
+
 function TBlockSocket.GetLocalSinIP: string;
 begin
   Result := GetSinIP(FLocalSin);
@@ -768,13 +884,23 @@ begin
 end;
 
 //See 'winsock2.txt' file in distribute package!
-
 function TBlockSocket.SetTimeout(Timeout: Integer): Boolean;
 begin
-  Result := synsock.SetSockOpt(FSocket, SOL_SOCKET,
+  Result := SetSendTimeout(Timeout) and SetRecvTimeout(Timeout);
-    SO_RCVTIMEO, @Timeout, SizeOf(Timeout)) <> SOCKET_ERROR;
+end;
-  Result := Result and (synsock.SetSockOpt(FSocket, SOL_SOCKET,
+
-    SO_SNDTIMEO, @Timeout, SizeOf(Timeout)) <> SOCKET_ERROR);
+//See 'winsock2.txt' file in distribute package!
+function TBlockSocket.SetSendTimeout(Timeout: Integer): Boolean;
+begin
+  Result := synsock.SetSockOpt(FSocket, SOL_SOCKET, SO_SNDTIMEO,
+    @Timeout, SizeOf(Timeout)) <> SOCKET_ERROR;
+end;
+
+//See 'winsock2.txt' file in distribute package!
+function TBlockSocket.SetRecvTimeout(Timeout: Integer): Boolean;
+begin
+  Result := synsock.SetSockOpt(FSocket, SOL_SOCKET, SO_RCVTIMEO,
+    @Timeout, SizeOf(Timeout)) <> SOCKET_ERROR;
 end;
 
 function TBlockSocket.GroupCanRead(const SocketList: TList; Timeout: Integer;
@@ -820,7 +946,6 @@ begin
     OnStatus(Self, Reason, Value);
 end;
 
-
 class function TBlockSocket.GetErrorDesc(ErrorCode: Integer): string;
 begin
   case ErrorCode of
@@ -935,6 +1060,156 @@ end;
 
 {======================================================================}
 
+constructor TSocksBlockSocket.Create;
+begin
+  inherited Create;
+  FSocksIP:= '';
+  FSocksPort:= '1080';
+  FSocksTimeout:= 300000;
+  FSocksUsername:= '';
+  FSocksPassword:= '';
+  FUsingSocks := False;
+  FSocksResolver := True;
+  FSocksLastError := 0;
+  FSocksResponseIP := '';
+  FSocksResponsePort := '';
+  FSocksLocalIP := '';
+  FSocksLocalPort := '';
+  FSocksRemoteIP := '';
+  FSocksRemotePort := '';
+end;
+
+function TSocksBlockSocket.SocksOpen: boolean;
+var
+  Buf: string;
+  n: integer;
+begin
+  Result := False;
+  FUsingSocks := False;
+  if FSocksUsername = '' then
+    Buf := #5 + #1 + #0
+  else
+    Buf := #5 + #2 + #2 +#0;
+  SendString(Buf);
+  Buf := RecvPacket(FSocksTimeout);
+  FBuffer := Copy(Buf, 3, Length(buf) - 2);
+  if Length(Buf) < 2 then
+    Exit;
+  if Buf[1] <> #5 then
+    Exit;
+  n := Ord(Buf[2]);
+  case n of
+    0: //not need authorisation
+      ;
+    2:
+      begin
+        Buf := #1 + char(Length(FSocksUsername)) + FSocksUsername
+          + char(Length(FSocksPassword)) + FSocksPassword;
+        SendString(Buf);
+        Buf := RecvPacket(FSocksTimeout);
+        FBuffer := Copy(Buf, 3, Length(buf) - 2);
+        if Length(Buf) < 2 then
+          Exit;
+        if Buf[2] <> #0 then
+          Exit;
+      end;
+  else
+    Exit;
+  end;
+  FUsingSocks := True;
+  Result := True;
+end;
+
+function TSocksBlockSocket.SocksRequest(Cmd: Byte;
+  const IP, Port: string): Boolean;
+var
+  Buf: string;
+begin
+  Result := False;
+  Buf := #5 + char(Cmd) + #0 + SocksCode(IP, Port);
+  SendString(Buf);
+  Result := FLastError = 0;
+end;
+
+function TSocksBlockSocket.SocksResponse: Boolean;
+var
+  Buf: string;
+  x: integer;
+begin
+  Result := False;
+  FSocksResponseIP := '';
+  FSocksResponsePort := '';
+  Buf := RecvPacket(FSocksTimeout);
+  if FLastError <> 0 then
+    Exit;
+  if Length(Buf) < 5 then
+    Exit;
+  if Buf[1] <> #5 then
+    Exit;
+  FSocksLastError := Ord(Buf[2]);
+  if FSocksLastError <> 0 then
+    Exit;
+  x := SocksDecode(Buf);
+  FBuffer := Copy(Buf, x, Length(buf) - x + 1);
+  Result := True;
+end;
+
+function TSocksBlockSocket.SocksCode(IP, Port: string): string;
+begin
+  if IsIP(IP) then
+    Result := #1 + IPToID(IP)
+  else
+    if FSocksResolver then
+      Result := #3 + char(Length(IP)) + IP
+    else
+      Result := #1 + IPToID(ResolveName(IP));
+  Result := Result + CodeInt(synsock.htons(ResolvePort(Port)));
+end;
+
+function TSocksBlockSocket.SocksDecode(Value: string): integer;
+var
+  Atyp: Byte;
+  y, n: integer;
+  w: Word;
+begin
+  FSocksResponsePort := '0';
+  Atyp := Ord(Value[4]);
+  Result := 5;
+  case Atyp of
+    1:
+      begin
+        if Length(Value) < 10 then
+          Exit;
+        FSocksResponseIP := Format('%d.%d.%d.%d',
+            [Ord(Value[5]), Ord(Value[6]), Ord(Value[7]), Ord(Value[8])]);
+        Result := 9;
+      end;
+    3:
+      begin
+        y := Ord(Value[5]);
+        if Length(Value) < (5 + y + 2) then
+          Exit;
+        for n := 6 to 6 + y do
+          FSocksResponseIP := FSocksResponseIP + Value[n];
+        Result := 5 + y +1;
+      end;
+  else
+    Exit;
+  end;
+  w := DecodeInt(Value, Result);
+  FSocksResponsePort := IntToStr(w);
+  Result := Result + 2;
+end;
+
+{======================================================================}
+
+destructor TUDPBlockSocket.Destroy;
+begin
+  if Assigned(FSocksControlSock) then
+    FSocksControlSock.Free;
+  inherited;
+end;
+
 procedure TUDPBlockSocket.CreateSocket;
 begin
   FSocket := synsock.Socket(PF_INET, Integer(SOCK_DGRAM), IPPROTO_UDP);
@@ -954,6 +1229,102 @@ begin
   ExceptCheck;
 end;
 
+procedure TUDPBlockSocket.Connect(IP, Port: string);
+begin
+  SetRemoteSin(IP, Port);
+  FBuffer := '';
+  DoStatus(HR_Connect, IP + ':' + Port);
+end;
+
+function TUDPBlockSocket.RecvBuffer(Buffer: Pointer; Length: Integer): Integer;
+begin
+  Result := RecvBufferFrom(Buffer, Length);
+end;
+
+function TUDPBlockSocket.SendBuffer(Buffer: Pointer; Length: Integer): Integer;
+begin
+  Result := SendBufferTo(Buffer, Length);
+end;
+
+function TUDPBlockSocket.UdpAssociation: Boolean;
+var
+  b: Boolean;
+begin
+  Result := True;
+  FUsingSocks := False;
+  if FSocksIP <> '' then
+  begin
+    Result := False;
+    if not Assigned(FSocksControlSock) then
+      FSocksControlSock := TTCPBlockSocket.Create;
+    FSocksControlSock.CloseSocket;
+    FSocksControlSock.CreateSocket;
+    FSocksControlSock.Connect(FSocksIP, FSocksPort);
+    if FSocksControlSock.LastError <> 0 then
+      Exit;
+    // if not assigned local port, assign it!
+    if GetLocalSinPort = 0 then
+      Bind(GetLocalSinIP, '0');
+    GetSins;
+    //open control TCP connection to SOCKS
+    b := FSocksControlSock.SocksOpen;
+    if b then
+      b := FSocksControlSock.SocksRequest(3, GetLocalSinIP,
+        IntToStr(GetLocalSinPort));
+    if b then
+      b := FSocksControlSock.SocksResponse;
+    if not b and (FLastError = 0) then
+      FLastError := WSANO_RECOVERY;
+    FUsingSocks :=FSocksControlSock.UsingSocks;
+    FSocksRemoteIP := FSocksControlSock.FSocksResponseIP;
+    FSocksRemotePort := FSocksControlSock.FSocksResponsePort;
+    Result := True;
+  end;
+end;
+
+function TUDPBlockSocket.SendBufferTo(Buffer: Pointer; Length: Integer): Integer;
+var
+  SIp: string;
+  SPort: integer;
+  Buf: string;
+begin
+  UdpAssociation;
+  if FUsingSocks then
+  begin
+    Sip := GetRemoteSinIp;
+    SPort := GetRemoteSinPort;
+    SetRemoteSin(FSocksRemoteIP, FSocksRemotePort);
+    SetLength(Buf,Length);
+    Move(Buffer^, PChar(Buf)^, Length);
+    Buf := #0 + #0 + #0 + SocksCode(Sip, IntToStr(SPort)) + Buf;
+    Result := inherited SendBufferTo(PChar(Buf), System.Length(buf));
+    SetRemoteSin(Sip, IntToStr(SPort));
+  end
+  else
+  begin
+    Result := inherited SendBufferTo(Buffer, Length);
+    GetSins;
+  end;
+end;
+
+function TUDPBlockSocket.RecvBufferFrom(Buffer: Pointer; Length: Integer): Integer;
+var
+  Buf: string;
+  x: integer;
+begin
+  Result := inherited RecvBufferFrom(Buffer, Length);
+  if FUsingSocks then
+  begin
+    SetLength(Buf, Result);
+    Move(Buffer^, PChar(Buf)^, Result);
+    x := SocksDecode(Buf);
+    Result := Result - x + 1;
+    Buf := Copy(Buf, x, Result);
+    Move(PChar(Buf)^, Buffer^, Result);
+    SetRemoteSin(FSocksResponseIP, FSocksResponsePort);
+  end;
+end;
+
 {======================================================================}
 
 procedure TTCPBlockSocket.CreateSocket;
@@ -970,9 +1341,36 @@ begin
 end;
 
 procedure TTCPBlockSocket.Listen;
+var
+  b: Boolean;
+  Sip,SPort: string;
 begin
-  SockCheck(synsock.Listen(FSocket, SOMAXCONN));
+  if FSocksIP = '' then
-  GetSins;
+  begin
+    SockCheck(synsock.Listen(FSocket, SOMAXCONN));
+    GetSins;
+  end
+  else
+  begin
+    Sip := GetLocalSinIP;
+    if Sip = '0.0.0.0' then
+      Sip := LocalName;
+    SPort := IntToStr(GetLocalSinPort);
+    Connect(FSocksIP, FSocksPort);
+    b := SocksOpen;
+    if b then
+      b := SocksRequest(2, Sip, SPort);
+    if b then
+      b := SocksResponse;
+    if not b and (FLastError = 0) then
+      FLastError := WSANO_RECOVERY;
+    FSocksLocalIP := FSocksResponseIP;
+    if FSocksLocalIP = '0.0.0.0' then
+      FSocksLocalIP := FSocksIP;
+    FSocksLocalPort := FSocksResponsePort;
+    FSocksRemoteIP := '';
+    FSocksRemotePort := '';
+  end;
   ExceptCheck;
   DoStatus(HR_Listen, '');
 end;
@@ -981,13 +1379,81 @@ function TTCPBlockSocket.Accept: TSocket;
 var
   Len: Integer;
 begin
-  Len := SizeOf(FRemoteSin);
+  if FUsingSocks then
-  Result := synsock.Accept(FSocket, @FRemoteSin, @Len);
+  begin
-  SockCheck(Result);
+    if not SocksResponse and (FLastError = 0) then
+      FLastError := WSANO_RECOVERY;
+    FSocksRemoteIP := FSocksResponseIP;
+    FSocksRemotePort := FSocksResponsePort;
+    Result := FSocket;
+  end
+  else
+  begin
+    Len := SizeOf(FRemoteSin);
+    Result := synsock.Accept(FSocket, @FRemoteSin, @Len);
+    SockCheck(Result);
+  end;
   ExceptCheck;
   DoStatus(HR_Accept, '');
 end;
 
+procedure TTCPBlockSocket.Connect(IP, Port: string);
+var
+  b: Boolean;
+begin
+  if FSocksIP = '' then
+    inherited Connect(IP, Port)
+  else
+  begin
+    inherited Connect(FSocksIP, FSocksPort);
+    b := SocksOpen;
+    if b then
+      b := SocksRequest(1, IP, Port);
+    if b then
+      b := SocksResponse;
+    if not b and (FLastError = 0) then
+      FLastError := WSANO_RECOVERY;
+    FSocksLocalIP := FSocksResponseIP;
+    FSocksLocalPort := FSocksResponsePort;
+    FSocksRemoteIP := IP;
+    FSocksRemotePort := Port;
+    ExceptCheck;
+    DoStatus(HR_Connect, IP + ':' + Port);
+  end;
+end;
+
+function TTCPBlockSocket.GetLocalSinIP: string;
+begin
+  if FUsingSocks then
+    Result := FSocksLocalIP
+  else
+    Result := inherited GetLocalSinIP;
+end;
+
+function TTCPBlockSocket.GetRemoteSinIP: string;
+begin
+  if FUsingSocks then
+    Result := FSocksRemoteIP
+  else
+    Result := inherited GetRemoteSinIP;
+end;
+
+function TTCPBlockSocket.GetLocalSinPort: Integer;
+begin
+  if FUsingSocks then
+    Result := StrToIntDef(FSocksLocalPort, 0)
+  else
+    Result := inherited GetLocalSinPort;
+end;
+
+function TTCPBlockSocket.GetRemoteSinPort: Integer;
+begin
+  if FUsingSocks then
+    Result := StrToIntDef(FSocksRemotePort, 0)
+  else
+    Result := inherited GetRemoteSinPort;
+end;
+
 {======================================================================}
 
 //See 'winsock2.txt' file in distribute package!

dnssend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.001.003 |
+| Project : Delphree - Synapse                                   | 001.001.004 |
 |==============================================================================|
 | Content: DNS client                                                          |
 |==============================================================================|
@@ -37,7 +37,7 @@ uses
   blcksock, SynaUtil;
 
 const
-  cDnsProtocol = 'Domain';
+  cDnsProtocol = 'domain';
 
   QTYPE_A = 1;
   QTYPE_NS = 2;
@@ -281,7 +281,7 @@ end;
 function TDNSSend.DNSQuery(Name: string; QType: Integer;
   const Reply: TStrings): Boolean;
 var
-  x, n, i: Integer;
+  n, i: Integer;
   flag, qdcount, ancount, nscount, arcount: Integer;
   s: string;
 begin
@@ -292,11 +292,9 @@ begin
   FBuffer := CodeHeader + CodeQuery(Name, QType);
   FSock.Connect(FDNSHost, cDnsProtocol);
   FSock.SendString(FBuffer);
-  if FSock.CanRead(FTimeout) then
+  FBuffer := FSock.RecvPacket(FTimeout);
+  if (FSock.LastError = 0) and (Length(FBuffer) > 13) then
   begin
-    x := FSock.WaitingData;
-    SetLength(FBuffer, x);
-    FSock.RecvBuffer(Pointer(FBuffer), x);
     flag := DecodeInt(FBuffer, 3);
     FRCode := Flag and $000F;
     if FRCode = 0 then

ftpsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.000.000 |
+| Project : Delphree - Synapse                                   | 001.002.000 |
 |==============================================================================|
 | Content: FTP client                                                          |
 |==============================================================================|
@@ -44,8 +44,12 @@ const
 type
   TLogonActions = array [0..17] of byte;
 
+  TFTPStatus = procedure(Sender: TObject; Response: Boolean;
+    const Value: string) of object;
+
   TFTPSend = class(TObject)
   private
+    FOnStatus: TFTPStatus;
     FSock: TTCPBlockSocket;
     FDSock: TTCPBlockSocket;
     FTimeout: Integer;
@@ -77,6 +81,8 @@ type
     function AcceptDataSocket: Boolean;
     function DataRead(const DestStream: TStream): Boolean;
     function DataWrite(const SourceStream: TStream): Boolean;
+  protected
+    procedure DoStatus(Response: Boolean; const Value: string);
   public
     CustomLogon: TLogonActions;
     constructor Create;
@@ -125,6 +131,7 @@ type
     property CanResume: Boolean read FCanResume;
     property PassiveMode: Boolean read FPassiveMode Write FPassiveMode;
     property ForceDefaultPort: Boolean read FForceDefaultPort Write FForceDefaultPort;
+    property OnStatus: TFTPStatus read FOnStatus write FOnStatus;
   end;
 
 function FtpGetFile(const IP, Port, FileName, LocalFile,
@@ -172,6 +179,12 @@ begin
   inherited Destroy;
 end;
 
+procedure TFTPSend.DoStatus(Response: Boolean; const Value: string);
+begin
+  if assigned(OnStatus) then
+    OnStatus(Self, Response, Value);
+end;
+
 function TFTPSend.ReadResult: Integer;
 var
   s,c: string;
@@ -197,7 +210,9 @@ end;
 function TFTPSend.FTPCommand(const Value: string): integer;
 begin
   FSock.SendString(Value + CRLF);
+  DoStatus(False, Value);
   Result := ReadResult;
+  DoStatus(True, FResultString);
 end;
 
 // based on idea by Petr Esner <petr.esner@atlas.cz>
@@ -401,6 +416,7 @@ begin
     FDSock.Listen;
     FDSock.GetSins;
     FDataIP := FDSock.GetLocalSinIP;
+    FDataIP := FDSock.ResolveName(FDataIP);
     FDataPort := IntToStr(FDSock.GetLocalSinPort);
     s := StringReplace(FDataIP, '.', ',');
     s := 'PORT ' + s + ',' + IntToStr(FDSock.GetLocalSinPort div 256)
@@ -421,7 +437,8 @@ begin
     if FDSock.CanRead(FTimeout) then
     begin
       x := FDSock.Accept;
-      FDSock.CloseSocket;
+      if not FDSock.UsingSocks then
+        FDSock.CloseSocket;
       FDSock.Socket := x;
       Result := True;
     end;
@@ -430,7 +447,7 @@ end;
 
 function TFTPSend.DataRead(const DestStream: TStream): Boolean;
 var
-  x, y: integer;
+  x: integer;
   buf: string;
 begin
   Result := False;
@@ -438,18 +455,9 @@ begin
     if not AcceptDataSocket then
       Exit;
     repeat
-      if FDSock.CanRead(1000) then
+      buf := FDSock.RecvPacket(FTimeout);
-      begin
+      if FDSock.LastError = 0 then
-        x := FDSock.WaitingData;
+        DestStream.Write(Pointer(buf)^, Length(buf));
-        if x = 0 then
-          break
-        else
-        begin
-          setlength(buf, x);
-          y := FDSock.RecvBuffer(Pchar(buf),x);
-          DestStream.Write(Pointer(buf)^, y);
-        end;
-      end;
     until FDSock.LastError <> 0;
     x := ReadResult;
     if (x = 226) or (x = 250) then
@@ -702,6 +710,8 @@ begin
       Username := User;
       Password := Pass;
     end;
+    FTPHost := IP;
+    FTPPort := Port;
     if not Login then
       Exit;
     DirectFileName := LocalFile;
@@ -724,6 +734,8 @@ begin
       Username := User;
       Password := Pass;
     end;
+    FTPHost := IP;
+    FTPPort := Port;
     if not Login then
       Exit;
     DirectFileName := LocalFile;
@@ -757,6 +769,10 @@ begin
       ToFTP.Username := ToUser;
       ToFTP.Password := ToPass;
     end;
+    FromFTP.FTPHost := FromIP;
+    FromFTP.FTPPort := FromPort;
+    ToFTP.FTPHost := ToIP;
+    ToFTP.FTPPort := ToPort;
     if not FromFTP.Login then
       Exit;
     if not ToFTP.Login then

httpsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.002.000 |
+| Project : Delphree - Synapse                                   | 002.003.000 |
 |==============================================================================|
 | Content: HTTP client                                                         |
 |==============================================================================|
@@ -184,7 +184,10 @@ begin
   if (FProxyHost <> '') and (FProxyUser <> '') then
     FHeaders.Insert(0, 'Proxy-Authorization: Basic ' +
       EncodeBase64(FProxyUser + ':' + FProxyPass));
-  FHeaders.Insert(0, 'Host: ' + Host + ':' + Port);
+  if Port<>'80' then
+     FHeaders.Insert(0, 'Host: ' + Host + ':' + Port)
+  else
+     FHeaders.Insert(0, 'Host: ' + Host);
   if FProxyHost <> '' then
     URI := Prot + '://' + Host + ':' + Port + URI;
   if URI = '/*' then
@@ -308,7 +311,8 @@ begin
       if Pos('CONTENT-LENGTH:', su) = 1 then
       begin
         Size := StrToIntDef(SeparateRight(s, ' '), -1);
-        FTransferEncoding := TE_IDENTITY;
+        if Size <> -1 then
+          FTransferEncoding := TE_IDENTITY;
       end;
       if Pos('CONTENT-TYPE:', su) = 1 then
         FMimeType := SeparateRight(s, ' ');
@@ -351,9 +355,9 @@ var
   s: string;
 begin
   repeat
-    s := FSock.RecvString(FTimeout);
+    s := FSock.RecvPacket(FTimeout);
-    s := s + CRLF;
+    if FSock.LastError = 0 then
-    FDocument.Write(Pointer(s)^, Length(s));
+      FDocument.Write(Pointer(s)^, Length(s));
   until FSock.LastError <> 0;
   Result := True;
 end;

mimepart.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.005.000 |
+| Project : Delphree - Synapse                                   | 001.005.002 |
 |==============================================================================|
 | Content: MIME support procedures and functions                               |
 |==============================================================================|
@@ -239,7 +239,10 @@ begin
           FSecondary := '';
         case FPrimaryCode of
           MP_TEXT:
-            Charset := UpperCase(GetParameter(s, 'charset='));
+            begin
+              Charset := UpperCase(GetParameter(s, 'charset='));
+              FFileName := GetParameter(s, 'name=');
+            end;
           MP_MULTIPART:
             FBoundary := GetParameter(s, 'Boundary=');
           MP_MESSAGE:
@@ -316,7 +319,7 @@ begin
     begin
       e := False;
       for n := x2 + 1 to Value.Count - 1 do
-        if Pos('--' + FBoundary, Value[n]) = 1 then
+        if Pos('--' + b, Value[n]) = 1 then
         begin
           e := True;
           Break;
@@ -428,8 +431,6 @@ begin
             if FPrimaryCode = MP_TEXT then
               s := CharsetConversion(s, FTargetCharset, FCharsetCode);
             s := EncodeBase64(s);
-            if x <> 54 then
-              s := s + '=';
             FLines.Add(s);
           end;
         end

pingsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.001.001 |
+| Project : Delphree - Synapse                                   | 002.001.002 |
 |==============================================================================|
 | Content: PING sender                                                         |
 |==============================================================================|
@@ -106,16 +106,9 @@ begin
 end;
 
 function TPINGSend.ReadPacket: Boolean;
-var
-  x: Integer;
 begin
-  Result := FSock.CanRead(FTimeout);
+  FBuffer := FSock.RecvPacket(Ftimeout);
-  if Result then
+  Result := FSock.LastError = 0;
-  begin
-    x := FSock.WaitingData;
-    SetLength(FBuffer, x);
-    FSock.RecvBuffer(Pointer(FBuffer), x);
-  end;
 end;
 
 function TPINGSend.Ping(const Host: string): Boolean;

slogsend.pas

@@ -0,0 +1,164 @@
+{==============================================================================|
+| Project : Delphree - Synapse                                   | 001.000.000 |
+|==============================================================================|
+| Content: SysLog client                                                       |
+|==============================================================================|
+| The contents of this file are subject to the Mozilla Public License Ver. 1.1 |
+| (the "License"); you may not use this file except in compliance with the     |
+| License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ |
+|                                                                              |
+| Software distributed under the License is distributed on an "AS IS" basis,   |
+| WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for |
+| the specific language governing rights and limitations under the License.    |
+|==============================================================================|
+| The Original Code is Synapse Delphi Library.                                 |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2001.                     |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+// RFC-3164
+
+{$Q-}
+{$WEAKPACKAGEUNIT ON}
+
+unit SLogSend;
+
+interface
+
+uses
+  SysUtils, Classes,
+  blcksock, SynaUtil;
+
+const
+  cSysLogProtocol = '514';
+
+  FCL_Kernel = 0;
+  FCL_UserLevel = 1;
+  FCL_MailSystem = 2;
+  FCL_System = 3;
+  FCL_Security = 4;
+  FCL_Syslogd = 5;
+  FCL_Printer = 6;
+  FCL_News = 7;
+  FCL_UUCP = 8;
+  FCL_Clock = 9;
+  FCL_Authorization = 10;
+  FCL_FTP = 11;
+  FCL_NTP = 12;
+  FCL_LogAudit = 13;
+  FCL_LogAlert = 14;
+  FCL_Time = 15;
+  FCL_Local0 = 16;
+  FCL_Local1 = 17;
+  FCL_Local2 = 18;
+  FCL_Local3 = 19;
+  FCL_Local4 = 20;
+  FCL_Local5 = 21;
+  FCL_Local6 = 22;
+  FCL_Local7 = 23;
+
+type
+  TSyslogSeverity = (Emergency, Alert, Critical, Error, Warning, Notice, Info,
+    Debug);
+
+  TSyslogSend = class(TObject)
+  private
+    FSyslogHost: string;
+    FSyslogPort: string;
+    FSock: TUDPBlockSocket;
+    FFacility: Byte;
+    FSeverity: TSyslogSeverity;
+    FTag: string;
+    FMessage: string;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    function DoIt: Boolean;
+  published
+    property SyslogHost: string read FSyslogHost Write FSyslogHost;
+    property SyslogPort: string read FSyslogPort Write FSyslogPort;
+    property Facility: Byte read FFacility Write FFacility;
+    property Severity: TSyslogSeverity read FSeverity Write FSeverity;
+    property Tag: string read FTag Write FTag;
+    property LogMessage: string read FMessage Write FMessage;
+  end;
+
+function ToSysLog(const SyslogServer: string; Facil: Byte;
+  Sever: TSyslogSeverity; const Content: string): Boolean;
+
+implementation
+
+constructor TSyslogSend.Create;
+begin
+  inherited Create;
+  FSock := TUDPBlockSocket.Create;
+  FSock.CreateSocket;
+  FSyslogHost := cLocalhost;
+  FSyslogPort := cSysLogProtocol;
+  FFacility := FCL_Local0;
+  FSeverity := Debug;
+  FTag := ExtractFileName(ParamStr(0));
+  FMessage := '';
+end;
+
+destructor TSyslogSend.Destroy;
+begin
+  FSock.Free;
+  inherited Destroy;
+end;
+
+function TSyslogSend.DoIt: Boolean;
+var
+  Buf: string;
+  S: string;
+  L: TStringList;
+begin
+  Result := False;
+  Buf := '<' + IntToStr((FFacility * 8) + Ord(FSeverity)) + '>';
+  Buf := Buf + CDateTime(now) + ' ';
+  L := TStringList.Create;
+  try
+    FSock.ResolveNameToIP(FSock.Localname, L);
+    if L.Count < 1 then
+      S := '0.0.0.0'
+    else
+      S := L[0];
+  finally
+    L.Free;
+  end;
+  Buf := Buf + S + ' ';
+  Buf := Buf + Tag + ': ' + FMessage;
+  if Length(Buf) <= 1024 then
+  begin
+    FSock.Connect(FSyslogHost, FSyslogPort);
+    FSock.SendString(Buf);
+    Result := FSock.LastError = 0;
+  end;
+end;
+
+{==============================================================================}
+
+function ToSysLog(const SyslogServer: string; Facil: Byte;
+  Sever: TSyslogSeverity; const Content: string): Boolean;
+begin
+  Result := False;
+  with TSyslogSend.Create do
+    try
+      SyslogHost :=SyslogServer;
+      Facility := Facil;
+      Severity := Sever;
+      LogMessage := Content;
+      Result := DoIt;
+    finally
+      Free;
+    end;
+end;
+
+end.

snmpsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.003.003 |
+| Project : Delphree - Synapse                                   | 002.003.005 |
 |==============================================================================|
 | Content: SNMP client                                                         |
 |==============================================================================|
@@ -299,17 +299,13 @@ begin
   FReply.Clear;
   FBuffer := Query.EncodeBuf;
   FSock.Connect(FHost, cSnmpProtocol);
-  FHostIP := FSock.GetRemoteSinIP;
+  FHostIP := '0.0.0.0';
-  FSock.SendBuffer(PChar(FBuffer), Length(FBuffer));
+  FSock.SendString(FBuffer);
-  if FSock.CanRead(FTimeout) then
+  FBuffer := FSock.RecvPacket(FTimeout);
+  if FSock.LastError = 0 then
   begin
-    x := FSock.WaitingData;
+    FHostIP := FSock.GetRemoteSinIP;
-    if x > 0 then
+    Result := True;
-    begin
-      SetLength(FBuffer, x);
-      FSock.RecvBuffer(PChar(FBuffer), x);
-      Result := True;
-    end;
   end;
   if Result then
     Result := FReply.DecodeBuf(FBuffer);

snmptrap.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.002.003 |
+| Project : Delphree - Synapse                                   | 002.002.004 |
 |==============================================================================|
 | Content: SNMP traps                                                          |
 |==============================================================================|
@@ -278,27 +278,18 @@ function TTrapSNMP.Send: Integer;
 begin
   FTrap.EncodeTrap;
   FSock.Connect(SNMPHost, FTrap.TrapPort);
-  FSock.SendBuffer(PChar(FTrap.FBuffer), Length(FTrap.FBuffer));
+  FSock.SendString(FTrap.FBuffer);
   Result := 1;
 end;
 
 function TTrapSNMP.Recv: Integer;
-var
-  x: Integer;
 begin
   Result := 0;
   FSock.Bind('0.0.0.0', FTrap.TrapPort);
-  if FSock.CanRead(FTimeout) then
+  FTrap.FBuffer := FSock.RecvPacket(FTimeout);
-  begin
+  if Fsock.Lasterror = 0 then
-    x := FSock.WaitingData;
+    if FTrap.DecodeTrap then
-    if x > 0 then
+      Result := 1;
-    begin
-      SetLength(FTrap.FBuffer, x);
-      FSock.RecvBuffer(PChar(FTrap.FBuffer), x);
-      if FTrap.DecodeTrap then
-        Result := 1;
-    end;
-  end;
 end;
 
 function SendTrap(const Dest, Source, Enterprise, Community: string;

synachar.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 003.002.000 |
+| Project : Delphree - Synapse                                   | 004.000.000 |
 |==============================================================================|
 | Content: Charset conversion support                                          |
 |==============================================================================|
@@ -621,6 +621,43 @@ const
     $00B0, $00A8, $02D9, $0171, $0158, $0159, $25A0, $00A0
     );
 
+  // nothing fr replace
+  Replace_None: array[0..0] of Word =
+    (0);
+
+  //remove diakritics from Czech
+  Replace_Czech: array[0..55] of Word =
+    (
+      $00E1, $0061,
+      $010D, $0063,
+      $010F, $0064,
+      $010E, $0044,
+      $00E9, $0065,
+      $011B, $0065,
+      $00ED, $0069,
+      $00F3, $006F,
+      $0159, $0072,
+      $0161, $0073,
+      $0165, $0074,
+      $00FA, $0075,
+      $016F, $0075,
+      $00FD, $0079,
+      $017E, $007A,
+      $00C1, $0041,
+      $010C, $0043,
+      $00C9, $0045,
+      $011A, $0045,
+      $00CD, $0049,
+      $00D3, $004F,
+      $0158, $0052,
+      $0160, $0053,
+      $0164, $0053,
+      $00DA, $0054,
+      $016E, $0055,
+      $00DD, $0059,
+      $017D, $005A
+    );
+
 {==============================================================================}
 function UTF8toUCS4(const Value: string): string;
 function UCS4toUTF8(const Value: string): string;
@@ -628,6 +665,8 @@ function UTF7toUCS2(const Value: string): string;
 function UCS2toUTF7(const Value: string): string;
 function CharsetConversion(Value: string; CharFrom: TMimeChar;
   CharTo: TMimeChar): string;
+function CharsetConversionEx(Value: string; CharFrom: TMimeChar;
+  CharTo: TMimeChar; const TransformTable: array of Word): string;
 function GetCurCP: TMimeChar;
 function GetCPFromID(Value: string): TMimeChar;
 function GetIDFromCP(Value: TMimeChar): string;
@@ -654,7 +693,22 @@ var
   SetFour: set of TMimeChar = [UCS_4, UTF_8];
 
 {==============================================================================}
+function ReplaceUnicode(Value: Word; const TransformTable: array of Word): Word;
+var
+  n: integer;
+begin
+  if High(TransformTable) <> 0 then
+    for n := 0 to High(TransformTable) do
+      if not odd(n) then
+        if TransformTable[n] = Value then
+          begin
+            Value := TransformTable[n+1];
+            break;
+          end;
+  Result := Value;
+end;
 
+{==============================================================================}
 procedure CopyArray(const SourceTable: array of Word;
   var TargetTable: array of Word);
 var
@@ -665,7 +719,6 @@ begin
 end;
 
 {==============================================================================}
-
 procedure GetArray(CharSet: TMimeChar; var Result: array of Word);
 begin
   case CharSet of
@@ -723,7 +776,6 @@ begin
 end;
 
 {==============================================================================}
-
 procedure ReadMulti(const Value: string; var Index: Integer; mb: Byte;
   var b1, b2, b3, b4: Byte);
 var
@@ -752,7 +804,6 @@ begin
 end;
 
 {==============================================================================}
-
 function WriteMulti(b1, b2, b3, b4: Byte; mb: Byte): string;
 var
   b: array[0..3] of Byte;
@@ -768,7 +819,6 @@ begin
 end;
 
 {==============================================================================}
-
 function UTF8toUCS4(const Value: string): string;
 var
   n, x, ul, m: Integer;
@@ -819,7 +869,6 @@ begin
 end;
 
 {==============================================================================}
-
 function UCS4toUTF8(const Value: string): string;
 var
   s, l, k: string;
@@ -867,7 +916,6 @@ begin
 end;
 
 {==============================================================================}
-
 function UTF7toUCS2(const Value: string): string;
 var
   n: Integer;
@@ -908,7 +956,6 @@ begin
 end;
 
 {==============================================================================}
-
 function UCS2toUTF7(const Value: string): string;
 var
   s: string;
@@ -948,9 +995,15 @@ begin
 end;
 
 {==============================================================================}
-
 function CharsetConversion(Value: string; CharFrom: TMimeChar;
   CharTo: TMimeChar): string;
+begin
+  Result := CharsetConversionEx(Value, CharFrom, CharTo, Replace_None);
+end;
+
+{==============================================================================}
+function CharsetConversionEx(Value: string; CharFrom: TMimeChar;
+  CharTo: TMimeChar; const TransformTable: array of Word): string;
 var
   uni: Word;
   n, m: Integer;
@@ -986,6 +1039,7 @@ begin
       if b1 > 127 then
       begin
         uni := SourceTable[b1];
+        uni := ReplaceUnicode(uni, TransformTable);
         b1 := Lo(uni);
         b2 := Hi(uni);
       end;
@@ -1025,7 +1079,6 @@ begin
 end;
 
 {==============================================================================}
-
 {$IFDEF LINUX}
 
 function GetCurCP: TMimeChar;
@@ -1062,7 +1115,6 @@ end;
 {$ENDIF}
 
 {==============================================================================}
-
 function GetCPFromID(Value: string): TMimeChar;
 begin
   Value := UpperCase(Value);
@@ -1156,7 +1208,6 @@ begin
 end;
 
 {==============================================================================}
-
 function GetIDFromCP(Value: TMimeChar): string;
 begin
   case Value of
@@ -1222,7 +1273,6 @@ begin
 end;
 
 {==============================================================================}
-
 function NeedCharsetConversion(const Value: string): Boolean;
 var
   n: Integer;
@@ -1237,7 +1287,6 @@ begin
 end;
 
 {==============================================================================}
-
 function IdealCharsetCoding(const Value: string; CharFrom: TMimeChar;
   CharTo: TMimeSetChar): TMimeChar;
 var

synautil.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.001.000 |
+| Project : Delphree - Synapse                                   | 002.003.000 |
 |==============================================================================|
 | Content: support procedures and functions                                    |
 |==============================================================================|
@@ -41,10 +41,12 @@ uses
 
 function Timezone: string;
 function Rfc822DateTime(t: TDateTime): string;
+function CDateTime(t: TDateTime): string;
 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 IPToID(Host: string): string;
 procedure Dump(const Buffer, DumpFile: string);
 function SeparateLeft(const Value, Delimiter: string): string;
 function SeparateRight(const Value, Delimiter: string): string;
@@ -61,7 +63,43 @@ function RPos(const Sub, Value: String): Integer;
 function Fetch(var Value: string; const Delimiter: string): string;
 
 implementation
+{==============================================================================}
+var
+  SaveDayNames: array[1..7] of string;
+  SaveMonthNames: array[1..12] of string;
+const
+  MyDayNames: array[1..7] of string =
+  ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
+  MyMonthNames: array[1..12] of string =
+  ('Jan', 'Feb', 'Mar', 'Apr',
+    'May', 'Jun', 'Jul', 'Aug',
+    'Sep', 'Oct', 'Nov', 'Dec');
 
+procedure SaveNames;
+var
+  I: integer;
+begin
+  for I := Low(ShortDayNames) to High(ShortDayNames) do
+  begin
+    SaveDayNames[I] := ShortDayNames[I];
+    ShortDayNames[I] := MyDayNames[I];
+  end;
+  for I := Low(ShortMonthNames) to High(ShortMonthNames) do
+  begin
+    SaveMonthNames[I] := ShortMonthNames[I];
+    ShortMonthNames[I] := MyMonthNames[I];
+  end;
+end;
+
+procedure RestoreNames;
+var
+  I: integer;
+begin
+  for I := Low(ShortDayNames) to High(ShortDayNames) do
+    ShortDayNames[I] := SaveDayNames[I];
+  for I := Low(ShortMonthNames) to High(ShortMonthNames) do
+    ShortMonthNames[I] := SaveMonthNames[I];
+end;
 {==============================================================================}
 
 function Timezone: string;
@@ -107,39 +145,28 @@ end;
 {==============================================================================}
 
 function Rfc822DateTime(t: TDateTime): string;
-var
-  I: Integer;
-  SaveDayNames: array[1..7] of string;
-  SaveMonthNames: array[1..12] of string;
-const
-  MyDayNames: array[1..7] of string =
-  ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
-  MyMonthNames: array[1..12] of string =
-  ('Jan', 'Feb', 'Mar', 'Apr',
-    'May', 'Jun', 'Jul', 'Aug',
-    'Sep', 'Oct', 'Nov', 'Dec');
 begin
-  if ShortDayNames[1] = MyDayNames[1] then
+  SaveNames;
-    Result := FormatDateTime('ddd, d mmm yyyy hh:mm:ss', t)
+  try
-  else
-  begin
-    for I := Low(ShortDayNames) to High(ShortDayNames) do
-    begin
-      SaveDayNames[I] := ShortDayNames[I];
-      ShortDayNames[I] := MyDayNames[I];
-    end;
-    for I := Low(ShortMonthNames) to High(ShortMonthNames) do
-    begin
-      SaveMonthNames[I] := ShortMonthNames[I];
-      ShortMonthNames[I] := MyMonthNames[I];
-    end;
     Result := FormatDateTime('ddd, d mmm yyyy hh:mm:ss', t);
-    for I := Low(ShortDayNames) to High(ShortDayNames) do
+    Result := Result + ' ' + Timezone;
-      ShortDayNames[I] := SaveDayNames[I];
+  finally
-    for I := Low(ShortMonthNames) to High(ShortMonthNames) do
+    RestoreNames;
-      ShortMonthNames[I] := SaveMonthNames[I];
+  end;
+end;
+
+{==============================================================================}
+
+function CDateTime(t: TDateTime): string;
+begin
+  SaveNames;
+  try
+    Result := FormatDateTime('mmm dd hh:mm:ss', t);
+    if Result[5] = '0' then
+      Result[5] := ' ';
+  finally
+    RestoreNames;
   end;
-  Result := Result + ' ' + Timezone;
 end;
 
 {==============================================================================}
@@ -159,7 +186,7 @@ begin
     x := Ord(Value[Index])
   else
     x := 0;
-  if Length(Value) > (Index + 1) then
+  if Length(Value) >= (Index + 1) then
     y := Ord(Value[Index + 1])
   else
     y := 0;
@@ -206,6 +233,27 @@ begin
       Delete(Result, 1, 1);
 end;
 
+{==============================================================================}
+//Hernan Sanchez
+function IPToID(Host: string): string;
+var
+  s, t: string;
+  i, x: Integer;
+begin
+  Result := '';
+  for x := 1 to 3 do
+  begin
+    t := '';
+    s := StrScan(PChar(Host), '.');
+    t := Copy(Host, 1, (Length(Host) - Length(s)));
+    Delete(Host, 1, (Length(Host) - Length(s) + 1));
+    i := StrToIntDef(t, 0);
+    Result := Result + Chr(i);
+  end;
+  i := StrToIntDef(Host, 0);
+  Result := Result + Chr(i);
+end;
+
 {==============================================================================}
 
 procedure Dump(const Buffer, DumpFile: string);