diff --git a/Tests/PS/plugintest.txt b/Tests/PS/plugintest.txt
index 0d82666..7e39942 100644
--- a/Tests/PS/plugintest.txt
+++ b/Tests/PS/plugintest.txt
@@ -1,64 +1,64 @@
-program new;
-{.LoadDLL libsmart}
-function IsKeyDown(C:Char): Boolean;
-begin
-  Result := SmartIsKeyDown(ord(c));
-end;
-
-procedure MoveMouse(x, y: Integer);
-begin
-  SmartMoveMouse(x, y);
-end;
-
-procedure HoldMouse(x, y: Integer; left: Boolean);
-begin
-  SmartHoldMouse(x, y, left);
-end;
-
-procedure ReleaseMouse(x, y: Integer; left: Boolean);
-begin
-  SmartReleaseMouse(x, y, left);
-end;
-
-procedure KeyUp(key: Byte);
-begin
-  If Key = 13 Then
-    Key := 10;
-  SmartReleaseKey(key);
-end;
-
-procedure KeyDown(key: Byte);
-begin
-  If Key = 13 Then
-    Key := 10;
-  SmartHoldKey(key);
-end;
-
-procedure SendKeys(S: String);
-begin
-  SmartSendKeys(S);
-end;
-
-procedure GetMousePos(var x, y: Integer);
-begin
-  SmartGetMousePos(x, y);
-end;
-
-function GetColor(x, y: Integer): Integer;
-begin
-  result:= SmartGetColor(x, y);
-end;
-
-
-var
-  w,h:integer;
-begin
-  SmartSetup('http://world19.runescape.com/', 'plugin.js?param=o0,a1,m0', 765, 503);
-  SetTargetArray(SmartImageArray, 765,503);
-  getclientdimensions(w,h);
-  writeln(inttostr(w) + ' , ' + inttostr(h));
-  if findcolortolerance(w,h,clwhite,0,0,764,502,300) then
-    smartmovemouse(w,h);
-  savescreenshot('/tmp/smart.bmp');
-  //Wait(5000);
-end.
+program new;
+{.LoadDLL libsmart}
+function IsKeyDown(C:Char): Boolean;
+begin
+  Result := SmartIsKeyDown(ord(c));
+end;
+
+procedure MoveMouse(x, y: Integer);
+begin
+  SmartMoveMouse(x, y);
+end;
+
+procedure HoldMouse(x, y: Integer; left: Boolean);
+begin
+  SmartHoldMouse(x, y, left);
+end;
+
+procedure ReleaseMouse(x, y: Integer; left: Boolean);
+begin
+  SmartReleaseMouse(x, y, left);
+end;
+
+procedure KeyUp(key: Byte);
+begin
+  If Key = 13 Then
+    Key := 10;
+  SmartReleaseKey(key);
+end;
+
+procedure KeyDown(key: Byte);
+begin
+  If Key = 13 Then
+    Key := 10;
+  SmartHoldKey(key);
+end;
+
+procedure SendKeys(S: String);
+begin
+  SmartSendKeys(S);
+end;
+
+procedure GetMousePos(var x, y: Integer);
+begin
+  SmartGetMousePos(x, y);
+end;
+
+function GetColor(x, y: Integer): Integer;
+begin
+  result:= SmartGetColor(x, y);
+end;
+
+
+var
+  w,h:integer;
+begin
+  SmartSetup('http://world19.runescape.com/', 'plugin.js?param=o0,a1,m0', 765, 503);
+  SetTargetArray(SmartImageArray, 765,503);
+  getclientdimensions(w,h);
+  writeln(inttostr(w) + ' , ' + inttostr(h));
+  if findcolortolerance(w,h,clwhite,0,0,764,502,300) then
+    smartmovemouse(w,h);
+  savescreenshot('/tmp/smart.bmp');
+  //Wait(5000);
+end.
diff --git a/Units/MMLAddon/PSInc/Wrappers/tpa.inc b/Units/MMLAddon/PSInc/Wrappers/tpa.inc
index ecbcee8..9def848 100644
--- a/Units/MMLAddon/PSInc/Wrappers/tpa.inc
+++ b/Units/MMLAddon/PSInc/Wrappers/tpa.inc
@@ -1,66 +1,66 @@
-procedure SplitTPAExWrap(arr: TPointArray; w, h: Integer; out res : T2DPointArray);
-begin
-  res := SplitTPAEx(arr,w,h);
-end;
-
-procedure SplitTPAWrap(arr: TPointArray; Dist: Integer; out res: T2DPointArray);
-begin
-  res := SplitTPA(arr,dist);
-end;
-
-procedure FindGapsTPAWrap(TPA: TPointArray; MinPixels: Integer; out Res : T2DPointArray); extdecl;
-begin
-  Res := FindGapsTPA(TPA,MinPixels);
-end;
-procedure RemoveDistTPointArrayWrap(x, y, dist: Integer; ThePoints: TPointArray; RemoveHigher: Boolean; out Res :  TPointArray);extdecl;
-begin
-  Res :=  RemoveDistTPointArray(x,y,dist,thepoints,removehigher);
-end;
-procedure CombineTPAWrap(Ar1, Ar2: TPointArray; out Res :  TPointArray);extdecl;
-begin
-  Res := CombineTPA(Ar1,Ar2);
-end;
-procedure ReArrangeandShortenArrayExWrap(a: TPointArray; w, h: Integer; out Res :  TPointArray);extdecl;
-begin
-  Res := ReArrangeandShortenArrayEx(a,w,h);
-end;
-procedure ReArrangeandShortenArrayWrap(a: TPointArray; Dist: Integer; out Res :  TPointArray);extdecl;
-begin
-  Res := ReArrangeandShortenArray(a,dist);
-end;
-procedure TPAtoATPAExWrap(TPA: TPointArray; w, h: Integer; out Res :  T2DPointArray);extdecl;
-begin
-  Res := TPAtoATPAEx(TPA,w,h);
-end;
-procedure TPAtoATPAWrap(TPA: TPointArray; Dist: Integer; out Res :  T2DPointArray);extdecl;
-begin
-  Res := TPAtoATPA(TPA,Dist);
-end;
-procedure CombineIntArrayWrap(Ar1, Ar2: TIntegerArray; out Res :  TIntegerArray);extdecl;
-begin
-  Res := CombineIntArray(Ar1,Ar2);
-end;
-procedure MergeATPAWrap(ATPA : T2DPointArray; out Res: TPointArray); extdecl;
-begin
-  Res := MergeATPA(ATPA);
-end;
-procedure TPAFromBoxWrap(const Box : TBox; out Res : TPointArray);extdecl;
-begin
-  Res := TPAFromBox(Box);
-end;
-procedure RotatePointsWrap(Const P: TPointArray; A, cx, cy: Extended; out Res :  TPointArray);extdecl;
-begin
-  Res := RotatePoints(P,a,cx,cy);
-end;
-procedure FindTPAEdgesWrap(p: TPointArray; out Res :  TPointArray);extdecl;
-begin
-  Res := FindTPAEdges(p);
-end;
-procedure ClearTPAFromTPAWrap(arP, ClearPoints: TPointArray; out Res :  TPointArray);extdecl;
-begin
-  Res := ClearTPAFromTPA(arP, clearpoints);
-end;
-procedure ReturnPointsNotInTPAWrap(Const TotalTPA: TPointArray; const Box: TBox; out Res :  TPointArray);extdecl;
-begin
-  Res := ReturnPointsNotInTPA(TotalTPA,box);
-end;
+procedure SplitTPAExWrap(arr: TPointArray; w, h: Integer; out res : T2DPointArray);
+begin
+  res := SplitTPAEx(arr,w,h);
+end;
+
+procedure SplitTPAWrap(arr: TPointArray; Dist: Integer; out res: T2DPointArray);
+begin
+  res := SplitTPA(arr,dist);
+end;
+
+procedure FindGapsTPAWrap(TPA: TPointArray; MinPixels: Integer; out Res : T2DPointArray); extdecl;
+begin
+  Res := FindGapsTPA(TPA,MinPixels);
+end;
+procedure RemoveDistTPointArrayWrap(x, y, dist: Integer; ThePoints: TPointArray; RemoveHigher: Boolean; out Res :  TPointArray);extdecl;
+begin
+  Res :=  RemoveDistTPointArray(x,y,dist,thepoints,removehigher);
+end;
+procedure CombineTPAWrap(Ar1, Ar2: TPointArray; out Res :  TPointArray);extdecl;
+begin
+  Res := CombineTPA(Ar1,Ar2);
+end;
+procedure ReArrangeandShortenArrayExWrap(a: TPointArray; w, h: Integer; out Res :  TPointArray);extdecl;
+begin
+  Res := ReArrangeandShortenArrayEx(a,w,h);
+end;
+procedure ReArrangeandShortenArrayWrap(a: TPointArray; Dist: Integer; out Res :  TPointArray);extdecl;
+begin
+  Res := ReArrangeandShortenArray(a,dist);
+end;
+procedure TPAtoATPAExWrap(TPA: TPointArray; w, h: Integer; out Res :  T2DPointArray);extdecl;
+begin
+  Res := TPAtoATPAEx(TPA,w,h);
+end;
+procedure TPAtoATPAWrap(TPA: TPointArray; Dist: Integer; out Res :  T2DPointArray);extdecl;
+begin
+  Res := TPAtoATPA(TPA,Dist);
+end;
+procedure CombineIntArrayWrap(Ar1, Ar2: TIntegerArray; out Res :  TIntegerArray);extdecl;
+begin
+  Res := CombineIntArray(Ar1,Ar2);
+end;
+procedure MergeATPAWrap(ATPA : T2DPointArray; out Res: TPointArray); extdecl;
+begin
+  Res := MergeATPA(ATPA);
+end;
+procedure TPAFromBoxWrap(const Box : TBox; out Res : TPointArray);extdecl;
+begin
+  Res := TPAFromBox(Box);
+end;
+procedure RotatePointsWrap(Const P: TPointArray; A, cx, cy: Extended; out Res :  TPointArray);extdecl;
+begin
+  Res := RotatePoints(P,a,cx,cy);
+end;
+procedure FindTPAEdgesWrap(p: TPointArray; out Res :  TPointArray);extdecl;
+begin
+  Res := FindTPAEdges(p);
+end;
+procedure ClearTPAFromTPAWrap(arP, ClearPoints: TPointArray; out Res :  TPointArray);extdecl;
+begin
+  Res := ClearTPAFromTPA(arP, clearpoints);
+end;
+procedure ReturnPointsNotInTPAWrap(Const TotalTPA: TPointArray; const Box: TBox; out Res :  TPointArray);extdecl;
+begin
+  Res := ReturnPointsNotInTPA(TotalTPA,box);
+end;
diff --git a/Units/MMLAddon/stringutil.pas b/Units/MMLAddon/stringutil.pas
index d378bab..9558571 100644
--- a/Units/MMLAddon/stringutil.pas
+++ b/Units/MMLAddon/stringutil.pas
@@ -1,114 +1,114 @@
-unit stringutil;
-
-{$mode objfpc}
-
-interface
-
-uses
-  Classes, SysUtils,mufasatypes;
-
-type
-  StrExtr =(Numbers, Letters, Others);
-function ExtractFromStr( Str : string; Extract : StrExtr) : string;
-function Capitalize(str : string) : string;
-function Implode(Glue : string; Pieces: TStringArray): string;
-function Explode(del, str: string): TStringArray;
-
-implementation
-
-function Implode(Glue: string;Pieces: TStringArray): string;
-var
-  I, Len : integer;
-begin
-  Len := high(Pieces);
-  if (Len < 0) then
-    exit;
-  Result := Pieces[0];
-  for i := 1 to len do
-    result := result + Glue + Pieces[i];
-end;
-
-function Explode(del, str: string): TStringArray;
-var
-  i,ii : integer;
-  lastpos : integer;
-  lenstr : integer;
-  lendel : integer;
-  lenres : integer;
-  matches : boolean;
-begin;
-  lastpos := 1;
-  lenres := 0;
-  setlength(result,lenres);
-  lendel := length(del);
-  lenstr := length(str);
-  //  for i := 1 to lenstr do
-  i := 1;
-  while i <= lenstr do
-  begin;
-    if not ((i + lendel - 1) > lenstr) then
-    begin
-      matches := true;
-      for ii := 1 to lendel do
-        if str[i + ii - 1] <> del[ii] then
-        begin
-          matches := false;
-          break;
-        end;
-      if matches then
-      begin;
-        inc(lenres);
-        setlength(result,lenres);
-        result[lenres-1] := Copy(str,lastpos,i-lastpos);
-        lastpos := i+lendel;
-        i := i + lendel-1;//Dirty
-        if i = lenstr then //This was the trailing delimiter
-          exit;
-      end;
-    end else //We cannot possibly find a delimiter anymore, thus copy the rest of the string and exit
-      Break;
-    inc(i);
-  end;
-  //Copy the rest of the string (if it's not a delimiter)
-  inc(lenres);
-  setlength(result,lenres);
-  result[lenres-1] := Copy(str,lastpos,lenstr - lastpos + 1);
-end;
-
-function Capitalize(str : string) : string;
-var
-  i , l : integer;
-  cap : boolean;
-  Range : set of char;
-begin;
-  result := str;
-  l := length(str);
-  cap := true;
-  Range :=  ['a'..'z','A'..'Z'];
-  for i := 1 to l do
-    if cap and (str[i] in Range) then
-    begin;
-      result[i] := UpperCase(str[i])[1];
-      cap := false;
-    end else if not (str[i] in Range) then
-      cap := true;
-end;
-
-function ExtractFromStr( Str : string; Extract : StrExtr) : string;
-var
-  Range : set of char;
-  i : integer;
-begin;
-  case Extract of
-    Numbers : Range := ['0'..'9'];
-    Letters : Range := ['A'..'Z','a'..'z'];
-    Others  : Range := [#0..#255] - ['0'..'9','A'..'Z','a'..'z'];
-  end;
-  Result := '';
-  for i := length(str) downto 1 do
-    if str[i] in Range then
-      result := str[i] + result;
-end;
-
-end.
-
+unit stringutil;
+
+{$mode objfpc}
+
+interface
+
+uses
+  Classes, SysUtils,mufasatypes;
+
+type
+  StrExtr =(Numbers, Letters, Others);
+function ExtractFromStr( Str : string; Extract : StrExtr) : string;
+function Capitalize(str : string) : string;
+function Implode(Glue : string; Pieces: TStringArray): string;
+function Explode(del, str: string): TStringArray;
+
+implementation
+
+function Implode(Glue: string;Pieces: TStringArray): string;
+var
+  I, Len : integer;
+begin
+  Len := high(Pieces);
+  if (Len < 0) then
+    exit;
+  Result := Pieces[0];
+  for i := 1 to len do
+    result := result + Glue + Pieces[i];
+end;
+
+function Explode(del, str: string): TStringArray;
+var
+  i,ii : integer;
+  lastpos : integer;
+  lenstr : integer;
+  lendel : integer;
+  lenres : integer;
+  matches : boolean;
+begin;
+  lastpos := 1;
+  lenres := 0;
+  setlength(result,lenres);
+  lendel := length(del);
+  lenstr := length(str);
+  //  for i := 1 to lenstr do
+  i := 1;
+  while i <= lenstr do
+  begin;
+    if not ((i + lendel - 1) > lenstr) then
+    begin
+      matches := true;
+      for ii := 1 to lendel do
+        if str[i + ii - 1] <> del[ii] then
+        begin
+          matches := false;
+          break;
+        end;
+      if matches then
+      begin;
+        inc(lenres);
+        setlength(result,lenres);
+        result[lenres-1] := Copy(str,lastpos,i-lastpos);
+        lastpos := i+lendel;
+        i := i + lendel-1;//Dirty
+        if i = lenstr then //This was the trailing delimiter
+          exit;
+      end;
+    end else //We cannot possibly find a delimiter anymore, thus copy the rest of the string and exit
+      Break;
+    inc(i);
+  end;
+  //Copy the rest of the string (if it's not a delimiter)
+  inc(lenres);
+  setlength(result,lenres);
+  result[lenres-1] := Copy(str,lastpos,lenstr - lastpos + 1);
+end;
+
+function Capitalize(str : string) : string;
+var
+  i , l : integer;
+  cap : boolean;
+  Range : set of char;
+begin;
+  result := str;
+  l := length(str);
+  cap := true;
+  Range :=  ['a'..'z','A'..'Z'];
+  for i := 1 to l do
+    if cap and (str[i] in Range) then
+    begin;
+      result[i] := UpperCase(str[i])[1];
+      cap := false;
+    end else if not (str[i] in Range) then
+      cap := true;
+end;
+
+function ExtractFromStr( Str : string; Extract : StrExtr) : string;
+var
+  Range : set of char;
+  i : integer;
+begin;
+  case Extract of
+    Numbers : Range := ['0'..'9'];
+    Letters : Range := ['A'..'Z','a'..'z'];
+    Others  : Range := [#0..#255] - ['0'..'9','A'..'Z','a'..'z'];
+  end;
+  Result := '';
+  for i := length(str) downto 1 do
+    if str[i] in Range then
+      result := str[i] + result;
+end;
+
+end.
+
diff --git a/Units/MMLCore/mufasabase.pas b/Units/MMLCore/mufasabase.pas
index 670ff85..c894860 100644
--- a/Units/MMLCore/mufasabase.pas
+++ b/Units/MMLCore/mufasabase.pas
@@ -1,50 +1,50 @@
-unit mufasabase;
-
-{$mode objfpc}
-
-interface
-
-uses
-  files, Classes, SysUtils{$ifdef MSWindows},windows{$endif};
-
-procedure mDebugLn( s : string);overload;
-procedure mDebugLn( s : string; f : array of const);overload;
-procedure InitmDebug;
-procedure FreemDebug;
-implementation
-
-uses
-  TestUnit;
-var
-  CanDebug : boolean = false;
-
-procedure mDebugLn(s: string);
-begin
-  if CanDebug then
-    Writeln(s);
-end;
-
-procedure mDebugLn(s: string; f: array of const); overload;
-begin
-  mDebugLn(format(s,f));
-end;
-
-procedure InitmDebug;
-begin
-  CanDebug := true;
-  {$ifdef MSWindows}
-  IsConsole:= True;
-  SysInitStdIO;
-  {$endif}
-end;
-
-procedure FreemDebug;
-begin
-  CanDebug := false;
-  {$ifdef MSWindows}
-  IsConsole := false;
-  {$endif}
-end;
-
-end.
-
+unit mufasabase;
+
+{$mode objfpc}
+
+interface
+
+uses
+  files, Classes, SysUtils{$ifdef MSWindows},windows{$endif};
+
+procedure mDebugLn( s : string);overload;
+procedure mDebugLn( s : string; f : array of const);overload;
+procedure InitmDebug;
+procedure FreemDebug;
+implementation
+
+uses
+  TestUnit;
+var
+  CanDebug : boolean = false;
+
+procedure mDebugLn(s: string);
+begin
+  if CanDebug then
+    Writeln(s);
+end;
+
+procedure mDebugLn(s: string; f: array of const); overload;
+begin
+  mDebugLn(format(s,f));
+end;
+
+procedure InitmDebug;
+begin
+  CanDebug := true;
+  {$ifdef MSWindows}
+  IsConsole:= True;
+  SysInitStdIO;
+  {$endif}
+end;
+
+procedure FreemDebug;
+begin
+  CanDebug := false;
+  {$ifdef MSWindows}
+  IsConsole := false;
+  {$endif}
+end;
+
+end.
+
diff --git a/Units/MMLCore/web.pas b/Units/MMLCore/web.pas
index b40936f..2533b91 100644
--- a/Units/MMLCore/web.pas
+++ b/Units/MMLCore/web.pas
@@ -1,42 +1,42 @@
-unit web;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes, SysUtils,LazHelpHTML,UTF8Process;
-
-procedure OpenWebPage(URL: string);
-
-implementation
-
-
-procedure OpenWebPage(URL: string);
-var
-  v: THTMLBrowserHelpViewer;
-  BrowserPath, BrowserParams: string;
-  p: LongInt;
-  BrowserProcess: TProcessUTF8;
-begin
-  v:=THTMLBrowserHelpViewer.Create(nil);
-  try
-    v.FindDefaultBrowser(BrowserPath,BrowserParams);
-    p:=System.Pos('%s', BrowserParams);
-    System.Delete(BrowserParams,p,2);
-    System.Insert(URL,BrowserParams,p);
-
-    // start browser
-    BrowserProcess:=TProcessUTF8.Create(nil);
-    try
-      BrowserProcess.CommandLine:=BrowserPath+' '+BrowserParams;
-      BrowserProcess.Execute;
-    finally
-      BrowserProcess.Free;
-    end;
-  finally
-    v.Free;
-  end;
-end;
-end.
-
+unit web;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils,LazHelpHTML,UTF8Process;
+
+procedure OpenWebPage(URL: string);
+
+implementation
+
+
+procedure OpenWebPage(URL: string);
+var
+  v: THTMLBrowserHelpViewer;
+  BrowserPath, BrowserParams: string;
+  p: LongInt;
+  BrowserProcess: TProcessUTF8;
+begin
+  v:=THTMLBrowserHelpViewer.Create(nil);
+  try
+    v.FindDefaultBrowser(BrowserPath,BrowserParams);
+    p:=System.Pos('%s', BrowserParams);
+    System.Delete(BrowserParams,p,2);
+    System.Insert(URL,BrowserParams,p);
+
+    // start browser
+    BrowserProcess:=TProcessUTF8.Create(nil);
+    try
+      BrowserProcess.CommandLine:=BrowserPath+' '+BrowserParams;
+      BrowserProcess.Execute;
+    finally
+      BrowserProcess.Free;
+    end;
+  finally
+    v.Free;
+  end;
+end;
+end.
+
diff --git a/Units/Misc/dcpbase64.pas b/Units/Misc/dcpbase64.pas
index 5a2472d..b82e2a2 100644
--- a/Units/Misc/dcpbase64.pas
+++ b/Units/Misc/dcpbase64.pas
@@ -1,140 +1,140 @@
-{******************************************************************************}
-{* DCPcrypt v2.0 written by David Barton (crypto@cityinthesky.co.uk) **********}
-{******************************************************************************}
-{* A Base64 encoding/decoding unit ********************************************}
-{******************************************************************************}
-{* Copyright (c) 1999-2002 David Barton                                       *}
-{* Permission is hereby granted, free of charge, to any person obtaining a    *}
-{* copy of this software and associated documentation files (the "Software"), *}
-{* to deal in the Software without restriction, including without limitation  *}
-{* the rights to use, copy, modify, merge, publish, distribute, sublicense,   *}
-{* and/or sell copies of the Software, and to permit persons to whom the      *}
-{* Software is furnished to do so, subject to the following conditions:       *}
-{*                                                                            *}
-{* The above copyright notice and this permission notice shall be included in *}
-{* all copies or substantial portions of the Software.                        *}
-{*                                                                            *}
-{* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR *}
-{* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,   *}
-{* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL    *}
-{* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER *}
-{* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING    *}
-{* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER        *}
-{* DEALINGS IN THE SOFTWARE.                                                  *}
-{******************************************************************************}
-unit DCPbase64;
-
-{$mode delphi}
-interface
-uses
-  Sysutils;
-
-function Base64EncodeStr(const Value: string): string;
-  { Encode a string into Base64 format }
-function Base64DecodeStr(const Value: string): string;
-  { Decode a Base64 format string }
-function Base64Encode(pInput: pointer; pOutput: pointer; Size: longint): longint;
-  { Encode a lump of raw data (output is (4/3) times bigger than input) }
-function Base64Decode(pInput: pointer; pOutput: pointer; Size: longint): longint;
-  { Decode a lump of raw data }
-
-
-{******************************************************************************}
-{******************************************************************************}
-implementation
-
-
-const
-  B64: array[0..63] of byte= (65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,
-    81,82,83,84,85,86,87,88,89,90,97,98,99,100,101,102,103,104,105,106,107,108,
-    109,110,111,112,113,114,115,116,117,118,119,120,121,122,48,49,50,51,52,53,
-    54,55,56,57,43,47);
-
-function Base64Encode(pInput: pointer; pOutput: pointer; Size: longint): longint;
-var
-  i, iptr, optr: integer;
-  Input, Output: PByteArray;
-begin
-  Input:= PByteArray(pInput); Output:= PByteArray(pOutput);
-  iptr:= 0; optr:= 0;
-  for i:= 1 to (Size div 3) do
-  begin
-    Output^[optr+0]:= B64[Input^[iptr] shr 2];
-    Output^[optr+1]:= B64[((Input^[iptr] and 3) shl 4) + (Input^[iptr+1] shr 4)];
-    Output^[optr+2]:= B64[((Input^[iptr+1] and 15) shl 2) + (Input^[iptr+2] shr 6)];
-    Output^[optr+3]:= B64[Input^[iptr+2] and 63];
-    Inc(optr,4); Inc(iptr,3);
-  end;
-  case (Size mod 3) of
-    1: begin
-         Output^[optr+0]:= B64[Input^[iptr] shr 2];
-         Output^[optr+1]:= B64[(Input^[iptr] and 3) shl 4];
-         Output^[optr+2]:= byte('=');
-         Output^[optr+3]:= byte('=');
-       end;
-    2: begin
-         Output^[optr+0]:= B64[Input^[iptr] shr 2];
-         Output^[optr+1]:= B64[((Input^[iptr] and 3) shl 4) + (Input^[iptr+1] shr 4)];
-         Output^[optr+2]:= B64[(Input^[iptr+1] and 15) shl 2];
-         Output^[optr+3]:= byte('=');
-       end;
-  end;
-  Result:= ((Size+2) div 3) * 4;
-end;
-
-function Base64EncodeStr(const Value: string): string;
-begin
-  SetLength(Result,((Length(Value)+2) div 3) * 4);
-  Base64Encode(@Value[1],@Result[1],Length(Value));
-end;
-
-function Base64Decode(pInput: pointer; pOutput: pointer; Size: longint): longint;
-var
-  i, j, iptr, optr: integer;
-  Temp: array[0..3] of byte;
-  Input, Output: PByteArray;
-begin
-  Input:= PByteArray(pInput); Output:= PByteArray(pOutput);
-  iptr:= 0; optr:= 0;
-  Result:= 0;
-  for i:= 1 to (Size div 4) do
-  begin
-    for j:= 0 to 3 do
-    begin
-      case Input^[iptr] of
-        65..90 : Temp[j]:= Input^[iptr] - Ord('A');
-        97..122: Temp[j]:= Input^[iptr] - Ord('a') + 26;
-        48..57 : Temp[j]:= Input^[iptr] - Ord('0') + 52;
-        43     : Temp[j]:= 62;
-        47     : Temp[j]:= 63;
-        61     : Temp[j]:= $FF;
-      end;
-      Inc(iptr);
-    end;
-    Output^[optr]:= (Temp[0] shl 2) or (Temp[1] shr 4);
-    Result:= optr+1;
-    if (Temp[2]<> $FF) and (Temp[3]= $FF) then
-    begin
-      Output^[optr+1]:= (Temp[1] shl 4) or (Temp[2] shr 2);
-      Result:= optr+2;
-      Inc(optr)
-    end
-    else if (Temp[2]<> $FF) then
-    begin
-      Output^[optr+1]:= (Temp[1] shl 4) or (Temp[2] shr 2);
-      Output^[optr+2]:= (Temp[2] shl 6) or  Temp[3];
-      Result:= optr+3;
-      Inc(optr,2);
-    end;
-    Inc(optr);
-  end;
-end;
-
-function Base64DecodeStr(const Value: string): string;
-begin
-  SetLength(Result,(Length(Value) div 4) * 3);
-  SetLength(Result,Base64Decode(@Value[1],@Result[1],Length(Value)));
-end;
-
-
-end.
+{******************************************************************************}
+{* DCPcrypt v2.0 written by David Barton (crypto@cityinthesky.co.uk) **********}
+{******************************************************************************}
+{* A Base64 encoding/decoding unit ********************************************}
+{******************************************************************************}
+{* Copyright (c) 1999-2002 David Barton                                       *}
+{* Permission is hereby granted, free of charge, to any person obtaining a    *}
+{* copy of this software and associated documentation files (the "Software"), *}
+{* to deal in the Software without restriction, including without limitation  *}
+{* the rights to use, copy, modify, merge, publish, distribute, sublicense,   *}
+{* and/or sell copies of the Software, and to permit persons to whom the      *}
+{* Software is furnished to do so, subject to the following conditions:       *}
+{*                                                                            *}
+{* The above copyright notice and this permission notice shall be included in *}
+{* all copies or substantial portions of the Software.                        *}
+{*                                                                            *}
+{* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR *}
+{* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,   *}
+{* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL    *}
+{* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER *}
+{* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING    *}
+{* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER        *}
+{* DEALINGS IN THE SOFTWARE.                                                  *}
+{******************************************************************************}
+unit DCPbase64;
+
+{$mode delphi}
+interface
+uses
+  Sysutils;
+
+function Base64EncodeStr(const Value: string): string;
+  { Encode a string into Base64 format }
+function Base64DecodeStr(const Value: string): string;
+  { Decode a Base64 format string }
+function Base64Encode(pInput: pointer; pOutput: pointer; Size: longint): longint;
+  { Encode a lump of raw data (output is (4/3) times bigger than input) }
+function Base64Decode(pInput: pointer; pOutput: pointer; Size: longint): longint;
+  { Decode a lump of raw data }
+
+
+{******************************************************************************}
+{******************************************************************************}
+implementation
+
+
+const
+  B64: array[0..63] of byte= (65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,
+    81,82,83,84,85,86,87,88,89,90,97,98,99,100,101,102,103,104,105,106,107,108,
+    109,110,111,112,113,114,115,116,117,118,119,120,121,122,48,49,50,51,52,53,
+    54,55,56,57,43,47);
+
+function Base64Encode(pInput: pointer; pOutput: pointer; Size: longint): longint;
+var
+  i, iptr, optr: integer;
+  Input, Output: PByteArray;
+begin
+  Input:= PByteArray(pInput); Output:= PByteArray(pOutput);
+  iptr:= 0; optr:= 0;
+  for i:= 1 to (Size div 3) do
+  begin
+    Output^[optr+0]:= B64[Input^[iptr] shr 2];
+    Output^[optr+1]:= B64[((Input^[iptr] and 3) shl 4) + (Input^[iptr+1] shr 4)];
+    Output^[optr+2]:= B64[((Input^[iptr+1] and 15) shl 2) + (Input^[iptr+2] shr 6)];
+    Output^[optr+3]:= B64[Input^[iptr+2] and 63];
+    Inc(optr,4); Inc(iptr,3);
+  end;
+  case (Size mod 3) of
+    1: begin
+         Output^[optr+0]:= B64[Input^[iptr] shr 2];
+         Output^[optr+1]:= B64[(Input^[iptr] and 3) shl 4];
+         Output^[optr+2]:= byte('=');
+         Output^[optr+3]:= byte('=');
+       end;
+    2: begin
+         Output^[optr+0]:= B64[Input^[iptr] shr 2];
+         Output^[optr+1]:= B64[((Input^[iptr] and 3) shl 4) + (Input^[iptr+1] shr 4)];
+         Output^[optr+2]:= B64[(Input^[iptr+1] and 15) shl 2];
+         Output^[optr+3]:= byte('=');
+       end;
+  end;
+  Result:= ((Size+2) div 3) * 4;
+end;
+
+function Base64EncodeStr(const Value: string): string;
+begin
+  SetLength(Result,((Length(Value)+2) div 3) * 4);
+  Base64Encode(@Value[1],@Result[1],Length(Value));
+end;
+
+function Base64Decode(pInput: pointer; pOutput: pointer; Size: longint): longint;
+var
+  i, j, iptr, optr: integer;
+  Temp: array[0..3] of byte;
+  Input, Output: PByteArray;
+begin
+  Input:= PByteArray(pInput); Output:= PByteArray(pOutput);
+  iptr:= 0; optr:= 0;
+  Result:= 0;
+  for i:= 1 to (Size div 4) do
+  begin
+    for j:= 0 to 3 do
+    begin
+      case Input^[iptr] of
+        65..90 : Temp[j]:= Input^[iptr] - Ord('A');
+        97..122: Temp[j]:= Input^[iptr] - Ord('a') + 26;
+        48..57 : Temp[j]:= Input^[iptr] - Ord('0') + 52;
+        43     : Temp[j]:= 62;
+        47     : Temp[j]:= 63;
+        61     : Temp[j]:= $FF;
+      end;
+      Inc(iptr);
+    end;
+    Output^[optr]:= (Temp[0] shl 2) or (Temp[1] shr 4);
+    Result:= optr+1;
+    if (Temp[2]<> $FF) and (Temp[3]= $FF) then
+    begin
+      Output^[optr+1]:= (Temp[1] shl 4) or (Temp[2] shr 2);
+      Result:= optr+2;
+      Inc(optr)
+    end
+    else if (Temp[2]<> $FF) then
+    begin
+      Output^[optr+1]:= (Temp[1] shl 4) or (Temp[2] shr 2);
+      Output^[optr+2]:= (Temp[2] shl 6) or  Temp[3];
+      Result:= optr+3;
+      Inc(optr,2);
+    end;
+    Inc(optr);
+  end;
+end;
+
+function Base64DecodeStr(const Value: string): string;
+begin
+  SetLength(Result,(Length(Value) div 4) * 3);
+  SetLength(Result,Base64Decode(@Value[1],@Result[1],Length(Value)));
+end;
+
+
+end.
diff --git a/Units/Misc/mPasLex.pas b/Units/Misc/mPasLex.pas
index e9977d9..29a77c6 100644
--- a/Units/Misc/mPasLex.pas
+++ b/Units/Misc/mPasLex.pas
@@ -1,1614 +1,1614 @@
-{+--------------------------------------------------------------------------+
- | Class:       TmwPasLex
- | Created:     07.98 - 10.98
- | Author:      Martin Waldenburg
- | Description: A very fast Pascal tokenizer.
- | Version:     1.32
- | Copyright (c) 1998, 1999 Martin Waldenburg
- | All rights reserved.
- |
- | LICENCE CONDITIONS
- |
- | USE OF THE ENCLOSED SOFTWARE
- | INDICATES YOUR ASSENT TO THE
- | FOLLOWING LICENCE CONDITIONS.
- |
- |
- |
- | These Licence Conditions are exlusively
- | governed by the Law and Rules of the
- | Federal Republic of Germany.
- |
- | Redistribution and use in source and binary form, with or without
- | modification, are permitted provided that the following conditions
- | are met:
- |
- | 1. Redistributions of source code must retain the above copyright
- |    notice, this list of conditions and the following disclaimer.
- |    If the source is modified, the complete original and unmodified
- |    source code has to distributed with the modified version.
- |
- | 2. Redistributions in binary form must reproduce the above
- |    copyright notice, these licence conditions and the disclaimer
- |    found at the end of this licence agreement in the documentation
- |    and/or other materials provided with the distribution.
- |
- | 3. Software using this code must contain a visible line of credit.
- |
- | 4. If my code is used in a "for profit" product, you have to donate
- |    to a registered charity in an amount that you feel is fair.
- |    You may use it in as many of your products as you like.
- |    Proof of this donation must be provided to the author of
- |    this software.
- |
- | 5. If you for some reasons don't want to give public credit to the
- |    author, you have to donate three times the price of your software
- |    product, or any other product including this component in any way,
- |    but no more than $500 US and not less than $200 US, or the
- |    equivalent thereof in other currency, to a registered charity.
- |    You have to do this for every of your products, which uses this
- |    code separately.
- |    Proof of this donations must be provided to the author of
- |    this software.
- |
- |
- | DISCLAIMER:
- |
- | THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS'.
- |
- | ALL EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
- | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
- | PARTICULAR PURPOSE ARE DISCLAIMED.
- |
- | IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
- | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
- | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
- | OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- | INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
- | WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
- | THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- |
- |  Martin.Waldenburg@T-Online.de
- +--------------------------------------------------------------------------+}
-
-{25/03/2003 Olivier GUILBAUD <golivier@free.fr> update for lazarus project}
-
-unit mPasLex;
-{$mode objfpc}{$H+}{$M+}
-interface
-
-uses
-  SysUtils;
-
-var
-  Identifiers: array[#0..#255]of ByteBool;
-  mHashTable: array[#0..#255]of Integer;
-
-type
-  TTokenKind=(tkAbsolute, tkAbstract, tkAddressOp, tkAnd, tkAnsiComment,
-    tkArray, tkAs, tkAt, tkAsciiChar, tkAsm, tkAssembler, tkAssign, tkAutomated,
-    tkBegin, tkBadString, tkBorComment, tkCase, tkCdecl, tkClass, tkColon,
-    tkComma, tkCompDirect, tkConst, tkConstructor, tkCRLF, tkCRLFCo, tkDefault,
-    tkDestructor, tkDispid, tkDispinterface, tkDiv, tkDo, tkDoubleAddressOp,
-    tkDotDot, tkDownto, tkDynamic, tkElse, tkEnd, tkEqual, tkError, tkExcept,
-    tkExport, tkExports, tkExternal, tkFar, tkFile, tkFinalization, tkFinally,
-    tkFloat, tkFor, tkForward, tkFunction, tkGoto, tkGreater, tkGreaterEqual,
-    tkIdentifier, tkIf, tkImplementation, tkImplements, tkIn, tkInclude, tkIndex,
-    tkInherited, tkInitialization, tkInline, tkInteger, tkInterface, tkIs,
-    tkKeyString, tkLabel, tkLibrary, tkLower, tkLowerEqual, tkMessage, tkMinus,
-    tkMod, tkName, tkNear, tkNil, tkNodefault, tkNone, tkNot, tkNotEqual, tkNull,
-    tkNumber, tkObject, tkOf, tkOn, tkOr, tkOut, tkOverload, tkOverride,
-    tkPacked, tkPascal, tkPlus, tkPoint, tkPointerSymbol, tkPrivate, tkProcedure,
-    tkProgram, tkProperty, tkProtected, tkPublic, tkPublished, tkRaise, tkRead,
-    tkReadonly, tkRecord, tkRegister, tkReintroduce, tkRepeat, tkResident,
-    tkResourcestring, tkRoundClose, tkRoundOpen, tkSafecall, tkSemiColon, tkSet,
-    tkShl, tkShr, tkSlash, tkSlashesComment, tkSquareClose, tkSquareOpen,
-    tkSpace, tkStar, tkStdcall, tkStored, tkString, tkStringresource, tkSymbol,
-    tkThen, tkThreadvar, tkTo, tkTry, tkType, tkUnit, tkUnknown, tkUntil, tkUses,
-    tkVar, tkVirtual, tkWhile, tkWith, tkWrite, tkWriteonly, tkXor);
-
-  TCommentState=(csAnsi, csBor, csNo);
-
-  TmwPasLex=class(TObject)
-  private
-    fComment: TCommentState;
-    fOrigin: PChar;
-    fProcTable: array[#0..#255]of procedure of Object;
-    Run: Longint;
-    Temp: PChar;
-    FRoundCount: Integer;
-    FSquareCount: Integer;
-    fStringLen: Integer;
-    fToIdent: PChar;
-    fIdentFuncTable: array[0..191]of function: TTokenKind of Object;
-    fTokenPos: Integer;
-    fLineNumber: Integer;
-    FTokenID: TTokenKind;
-    fLastIdentPos: Integer;
-    fLastNoSpace: TTokenKind;
-    fLastNoSpacePos: Integer;
-    fLinePos: Integer;
-    fIsInterface: Boolean;
-    fIsClass: Boolean;
-    function KeyHash(ToHash: PChar): Integer;
-    function KeyComp(const aKey: string): Boolean;
-    function Func15: TTokenKind;
-    function Func19: TTokenKind;
-    function Func20: TTokenKind;
-    function Func21: TTokenKind;
-    function Func23: TTokenKind;
-    function Func25: TTokenKind;
-    function Func27: TTokenKind;
-    function Func28: TTokenKind;
-    function Func29: TTokenKind;
-    function Func32: TTokenKind;
-    function Func33: TTokenKind;
-    function Func35: TTokenKind;
-    function Func37: TTokenKind;
-    function Func38: TTokenKind;
-    function Func39: TTokenKind;
-    function Func40: TTokenKind;
-    function Func41: TTokenKind;
-    function Func44: TTokenKind;
-    function Func45: TTokenKind;
-    function Func47: TTokenKind;
-    function Func49: TTokenKind;
-    function Func52: TTokenKind;
-    function Func54: TTokenKind;
-    function Func55: TTokenKind;
-    function Func56: TTokenKind;
-    function Func57: TTokenKind;
-    function Func59: TTokenKind;
-    function Func60: TTokenKind;
-    function Func61: TTokenKind;
-    function Func63: TTokenKind;
-    function Func64: TTokenKind;
-    function Func65: TTokenKind;
-    function Func66: TTokenKind;
-    function Func69: TTokenKind;
-    function Func71: TTokenKind;
-    function Func73: TTokenKind;
-    function Func75: TTokenKind;
-    function Func76: TTokenKind;
-    function Func79: TTokenKind;
-    function Func81: TTokenKind;
-    function Func84: TTokenKind;
-    function Func85: TTokenKind;
-    function Func87: TTokenKind;
-    function Func88: TTokenKind;
-    function Func91: TTokenKind;
-    function Func92: TTokenKind;
-    function Func94: TTokenKind;
-    function Func95: TTokenKind;
-    function Func96: TTokenKind;
-    function Func97: TTokenKind;
-    function Func98: TTokenKind;
-    function Func99: TTokenKind;
-    function Func100: TTokenKind;
-    function Func101: TTokenKind;
-    function Func102: TTokenKind;
-    function Func103: TTokenKind;
-    function Func105: TTokenKind;
-    function Func106: TTokenKind;
-    function Func117: TTokenKind;
-    function Func126: TTokenKind;
-    function Func129: TTokenKind;
-    function Func132: TTokenKind;
-    function Func133: TTokenKind;
-    function Func136: TTokenKind;
-    function Func141: TTokenKind;
-    function Func143: TTokenKind;
-    function Func166: TTokenKind;
-    function Func168: TTokenKind;
-    function Func191: TTokenKind;
-    function AltFunc: TTokenKind;
-    procedure InitIdent;
-    function IdentKind(MayBe: PChar): TTokenKind;
-    procedure SetOrigin(NewValue: PChar);
-    procedure SetRunPos(Value: Integer);
-    procedure MakeMethodTables;
-    procedure AddressOpProc;
-    procedure AsciiCharProc;
-    procedure AnsiProc;
-    procedure BorProc;
-    procedure BraceCloseProc;
-    procedure BraceOpenProc;
-    procedure ColonProc;
-    procedure CommaProc;
-    procedure CRProc;
-    procedure EqualProc;
-    procedure GreaterProc;
-    procedure IdentProc;
-    procedure IntegerProc;
-    procedure LFProc;
-    procedure LowerProc;
-    procedure MinusProc;
-    procedure NullProc;
-    procedure NumberProc;
-    procedure PlusProc;
-    procedure PointerSymbolProc;
-    procedure PointProc;
-    procedure RoundCloseProc;
-    procedure RoundOpenProc;
-    procedure SemiColonProc;
-    procedure SlashProc;
-    procedure SpaceProc;
-    procedure SquareCloseProc;
-    procedure SquareOpenProc;
-    procedure StarProc;
-    procedure StringProc;
-    procedure SymbolProc;
-    procedure UnknownProc;
-    function GetToken: string;
-    function InSymbols(aChar: Char): Boolean;
-  protected
-  public
-    constructor Create;
-    destructor Destroy; override;
-    function CharAhead(Count: Integer): Char;
-    procedure Next;
-    procedure NextID(ID: TTokenKind);
-    procedure NextNoJunk;
-    procedure NextClass;
-    property IsClass: Boolean read fIsClass;
-    property IsInterface: Boolean read fIsInterface;
-    property LastIdentPos: Integer read fLastIdentPos;
-    property LastNoSpace: TTokenKind read fLastNoSpace;
-    property LastNoSpacePos: Integer read fLastNoSpacePos;
-    property LineNumber: Integer read fLineNumber;
-    property LinePos: Integer read fLinePos;
-    property Origin: PChar read fOrigin write SetOrigin;
-    property RunPos: Integer read Run write SetRunPos;
-    property TokenPos: Integer read fTokenPos;
-    property Token: string read GetToken;
-    property TokenID: TTokenKind read FTokenID;
-  published
-  end;
-
-var
-  mwPasLex: TmwPasLex;
-
-implementation
-
-procedure MakeIdentTable;
-var
-  I, J: Char;
-begin
-  for I:=#0 to #255 do
-  begin
-    Case I of
-      '_', '0'..'9', 'a'..'z', 'A'..'Z': Identifiers[I]:=True;
-    else Identifiers[I]:=False;
-    end;
-    J:=UpperCase(I)[1];
-    Case I of
-      'a'..'z', 'A'..'Z', '_': mHashTable[I]:=Ord(J)-64;
-    else mHashTable[Char(I)]:=0;
-    end;
-  end;
-end;
-
-procedure TmwPasLex.InitIdent;
-var
-  I: Integer;
-begin
-  for I:=0 to 191 do
-    Case I of
-      15: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func15;
-      19: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func19;
-      20: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func20;
-      21: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func21;
-      23: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func23;
-      25: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func25;
-      27: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func27;
-      28: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func28;
-      29: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func29;
-      32: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func32;
-      33: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func33;
-      35: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func35;
-      37: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func37;
-      38: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func38;
-      39: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func39;
-      40: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func40;
-      41: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func41;
-      44: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func44;
-      45: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func45;
-      47: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func47;
-      49: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func49;
-      52: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func52;
-      54: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func54;
-      55: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func55;
-      56: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func56;
-      57: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func57;
-      59: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func59;
-      60: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func60;
-      61: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func61;
-      63: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func63;
-      64: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func64;
-      65: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func65;
-      66: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func66;
-      69: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func69;
-      71: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func71;
-      73: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func73;
-      75: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func75;
-      76: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func76;
-      79: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func79;
-      81: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func81;
-      84: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func84;
-      85: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func85;
-      87: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func87;
-      88: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func88;
-      91: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func91;
-      92: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func92;
-      94: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func94;
-      95: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func95;
-      96: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func96;
-      97: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func97;
-      98: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func98;
-      99: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func99;
-      100: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func100;
-      101: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func101;
-      102: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func102;
-      103: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func103;
-      105: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func105;
-      106: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func106;
-      117: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func117;
-      126: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func126;
-      129: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func129;
-      132: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func132;
-      133: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func133;
-      136: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func136;
-      141: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func141;
-      143: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func143;
-      166: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func166;
-      168: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func168;
-      191: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func191;
-    else fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}AltFunc;
-    end;
-end;
-
-function TmwPasLex.KeyHash(ToHash: PChar): Integer;
-begin
-  Result:=0;
-  while ToHash^in ['a'..'z', 'A'..'Z']do
-  begin
-    Inc(Result, mHashTable[ToHash^]);
-    Inc(ToHash);
-  end;
-  if ToHash^in ['_', '0'..'9']then Inc(ToHash);
-  fStringLen:=ToHash-fToIdent;
-end; { KeyHash }
-
-function TmwPasLex.KeyComp(const aKey: string): Boolean;
-var
-  I: Integer;
-begin
-  Temp:=fToIdent;
-  if Length(aKey)=fStringLen then
-  begin
-    Result:=True;
-    for i:=1 to fStringLen do
-    begin
-      if mHashTable[Temp^]<>mHashTable[aKey[i]]then
-      begin
-        Result:=False;
-        Break;
-      end;
-      Inc(Temp);
-    end;
-  end else Result:=False;
-end; { KeyComp }
-
-function TmwPasLex.Func15: TTokenKind;
-begin
-  if KeyComp('If')then Result:=tkIf else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func19: TTokenKind;
-begin
-  if KeyComp('Do')then Result:=tkDo else
-    if KeyComp('And')then Result:=tkAnd else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func20: TTokenKind;
-begin
-  if KeyComp('As')then Result:=tkAs else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func21: TTokenKind;
-begin
-  if KeyComp('Of')then Result:=tkOf else
-    if KeyComp('At')then Result:=tkAt else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func23: TTokenKind;
-begin
-  if KeyComp('End')then Result:=tkEnd else
-    if KeyComp('In')then Result:=tkIn else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func25: TTokenKind;
-begin
-  if KeyComp('Far')then Result:=tkFar else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func27: TTokenKind;
-begin
-  if KeyComp('Cdecl')then Result:=tkCdecl else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func28: TTokenKind;
-begin
-  if KeyComp('Read')then
-  begin
-    if inSymbols(CharAhead(fStringLen))then Result:=tkIdentifier else
-      Result:=tkRead
-  end else
-    if KeyComp('Case')then Result:=tkCase else
-      if KeyComp('Is')then Result:=tkIs else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func29: TTokenKind;
-begin
-  if KeyComp('On')then Result:=tkOn else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func32: TTokenKind;
-begin
-  if KeyComp('File')then Result:=tkFile else
-    if KeyComp('Label')then Result:=tkLabel else
-      if KeyComp('Mod')then Result:=tkMod else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func33: TTokenKind;
-begin
-  if KeyComp('Or')then Result:=tkOr else
-    if KeyComp('Name')then
-    begin
-      if inSymbols(CharAhead(fStringLen))then Result:=tkIdentifier else
-        Result:=tkName
-    end else
-      if KeyComp('Asm')then Result:=tkAsm else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func35: TTokenKind;
-begin
-  if KeyComp('To')then Result:=tkTo else
-    if KeyComp('Nil')then Result:=tkNil else
-      if KeyComp('Div')then Result:=tkDiv else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func37: TTokenKind;
-begin
-  if KeyComp('Begin')then Result:=tkBegin else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func38: TTokenKind;
-begin
-  if KeyComp('Near')then Result:=tkNear else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func39: TTokenKind;
-begin
-  if KeyComp('For')then Result:=tkFor else
-    if KeyComp('Shl')then Result:=tkShl else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func40: TTokenKind;
-begin
-  if KeyComp('Packed')then Result:=tkPacked else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func41: TTokenKind;
-begin
-  if KeyComp('Else')then Result:=tkElse else
-    if KeyComp('Var')then Result:=tkVar else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func44: TTokenKind;
-begin
-  if KeyComp('Set')then Result:=tkSet else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func45: TTokenKind;
-begin
-  if KeyComp('Shr')then Result:=tkShr else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func47: TTokenKind;
-begin
-  if KeyComp('Then')then Result:=tkThen else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func49: TTokenKind;
-begin
-  if KeyComp('Not')then Result:=tkNot else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func52: TTokenKind;
-begin
-  if KeyComp('Raise')then Result:=tkRaise else
-    if KeyComp('Pascal')then Result:=tkPascal else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func54: TTokenKind;
-begin
-  if KeyComp('Class')then
-  begin
-    Result:=tkClass;
-    if fLastNoSpace=tkEqual then
-    begin
-      fIsClass:=True;
-      if Identifiers[CharAhead(fStringLen)]then fIsClass:=False;
-    end else fIsClass:=False;
-  end else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func55: TTokenKind;
-begin
-  if KeyComp('Object')then Result:=tkObject else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func56: TTokenKind;
-begin
-  if KeyComp('Index')then
-  begin
-    if inSymbols(CharAhead(fStringLen))then Result:=tkIdentifier else
-      Result:=tkIndex
-  end else
-    if KeyComp('Out')then Result:=tkOut else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func57: TTokenKind;
-begin
-  if KeyComp('While')then Result:=tkWhile else
-    if KeyComp('Goto')then Result:=tkGoto else
-      if KeyComp('Xor')then Result:=tkXor else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func59: TTokenKind;
-begin
-  if KeyComp('Safecall')then Result:=tkSafecall else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func60: TTokenKind;
-begin
-  if KeyComp('With')then Result:=tkWith else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func61: TTokenKind;
-begin
-  if KeyComp('Dispid')then Result:=tkDispid else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func63: TTokenKind;
-begin
-  if KeyComp('Public')then
-  begin
-    if inSymbols(CharAhead(fStringLen))then Result:=tkIdentifier else
-      Result:=tkPublic
-  end else
-    if KeyComp('Record')then Result:=tkRecord else
-      if KeyComp('Try')then Result:=tkTry else
-        if KeyComp('Array')then Result:=tkArray else
-          if KeyComp('Inline')then Result:=tkInline else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func64: TTokenKind;
-begin
-  if KeyComp('Uses')then Result:=tkUses else
-    if KeyComp('Unit')then Result:=tkUnit else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func65: TTokenKind;
-begin
-  if KeyComp('Repeat')then Result:=tkRepeat else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func66: TTokenKind;
-begin
-  if KeyComp('Type')then Result:=tkType else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func69: TTokenKind;
-begin
-  if KeyComp('Dynamic')then Result:=tkDynamic else
-    if KeyComp('Default')then Result:=tkDefault else
-      if KeyComp('Message')then Result:=tkMessage else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func71: TTokenKind;
-begin
-  if KeyComp('Stdcall')then Result:=tkStdcall else
-    if KeyComp('Const')then Result:=tkConst else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func73: TTokenKind;
-begin
-  if KeyComp('Except')then Result:=tkExcept else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func75: TTokenKind;
-begin
-  if KeyComp('Write')then
-  begin
-    if inSymbols(CharAhead(fStringLen))then Result:=tkIdentifier else
-      Result:=tkWrite
-  end else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func76: TTokenKind;
-begin
-  if KeyComp('Until')then Result:=tkUntil else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func79: TTokenKind;
-begin
-  if KeyComp('Finally')then Result:=tkFinally else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func81: TTokenKind;
-begin
-  if KeyComp('Interface')then
-  begin
-    Result:=tkInterface;
-    if fLastNoSpace=tkEqual then
-      fIsInterface:=True else fIsInterface:=False;
-  end else
-    if KeyComp('Stored')then Result:=tkStored else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func84: TTokenKind;
-begin
-  if KeyComp('Abstract')then Result:=tkAbstract else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func85: TTokenKind;
-begin
-  if KeyComp('Library')then Result:=tkLibrary else
-    if KeyComp('Forward')then Result:=tkForward else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func87: TTokenKind;
-begin
-  if KeyComp('String')then Result:=tkString else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func88: TTokenKind;
-begin
-  if KeyComp('Program')then Result:=tkProgram else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func91: TTokenKind;
-begin
-  if KeyComp('Private')then
-  begin
-    if inSymbols(CharAhead(fStringLen))then Result:=tkIdentifier else
-      Result:=tkPrivate
-  end else
-    if KeyComp('Downto')then Result:=tkDownto else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func92: TTokenKind;
-begin
-  if KeyComp('overload') then
-    Result:=tkOverload
-  else
-    if KeyComp('Inherited') then
-      Result:=tkInherited
-    else
-      Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func94: TTokenKind;
-begin
-  if KeyComp('Resident')then Result:=tkResident else
-    if KeyComp('Readonly')then Result:=tkReadonly else
-      if KeyComp('Assembler')then Result:=tkAssembler else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func95: TTokenKind;
-begin
-  if KeyComp('Absolute')then Result:=tkAbsolute else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func96: TTokenKind;
-begin
-  if KeyComp('Published')then
-  begin
-    if inSymbols(CharAhead(fStringLen))then Result:=tkIdentifier else
-      Result:=tkPublished
-  end else
-    if KeyComp('Override')then Result:=tkOverride else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func97: TTokenKind;
-begin
-  if KeyComp('Threadvar')then Result:=tkThreadvar else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func98: TTokenKind;
-begin
-  if KeyComp('Export')then Result:=tkExport else
-    if KeyComp('Nodefault')then Result:=tkNodefault else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func99: TTokenKind;
-begin
-  if KeyComp('External')then Result:=tkExternal else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func100: TTokenKind;
-begin
-  if KeyComp('Automated')then
-  begin
-    if inSymbols(CharAhead(fStringLen))then Result:=tkIdentifier else
-      Result:=tkAutomated
-  end else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func101: TTokenKind;
-begin
-  if KeyComp('Register')then Result:=tkRegister else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func102: TTokenKind;
-begin
-  if KeyComp('Function')then Result:=tkFunction else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func103: TTokenKind;
-begin
-  if KeyComp('Virtual')then Result:=tkVirtual else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func105: TTokenKind;
-begin
-  if KeyComp('Procedure')then Result:=tkProcedure else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func106: TTokenKind;
-begin
-  if KeyComp('Protected')then
-  begin
-    if inSymbols(CharAhead(fStringLen))then Result:=tkIdentifier else
-      Result:=tkProtected
-  end else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func117: TTokenKind;
-begin
-  if KeyComp('Exports')then Result:=tkExports else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func126: TTokenKind;
-begin
-  if KeyComp('Implements') then
-    Result:=tkImplements
-  else
-  Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func129: TTokenKind;
-begin
-  if KeyComp('Dispinterface')then Result:=tkDispinterface else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func132: TTokenKind;
-begin
-  if KeyComp('Reintroduce') then
-    Result:=tkReintroduce
-  else
-  Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func133: TTokenKind;
-begin
-  if KeyComp('Property')then Result:=tkProperty else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func136: TTokenKind;
-begin
-  if KeyComp('Finalization')then Result:=tkFinalization else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func141: TTokenKind;
-begin
-  if KeyComp('Writeonly')then Result:=tkWriteonly else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func143: TTokenKind;
-begin
-  if KeyComp('Destructor')then Result:=tkDestructor else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func166: TTokenKind;
-begin
-  if KeyComp('Constructor')then Result:=tkConstructor else
-    if KeyComp('Implementation')then Result:=tkImplementation else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func168: TTokenKind;
-begin
-  if KeyComp('Initialization')then Result:=tkInitialization else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.Func191: TTokenKind;
-begin
-  if KeyComp('Resourcestring')then Result:=tkResourcestring else
-    if KeyComp('Stringresource')then Result:=tkStringresource else Result:=tkIdentifier;
-end;
-
-function TmwPasLex.AltFunc: TTokenKind;
-begin
-  Result:=tkIdentifier
-end;
-
-function TmwPasLex.IdentKind(MayBe: PChar): TTokenKind;
-var
-  HashKey: Integer;
-begin
-  fToIdent:=MayBe;
-  HashKey:=KeyHash(MayBe);
-  if HashKey<192 then
-    Result:=fIdentFuncTable[HashKey]()
-  else
-     Result:=tkIdentifier;
-end;
-
-procedure TmwPasLex.MakeMethodTables;
-var
-  I: Char;
-begin
-  for I:=#0 to #255 do
-    case I of
-      #0:  fProcTable[I]:={$IFDEF FPC}@{$ENDIF}NullProc;
-      #10: fProcTable[I]:={$IFDEF FPC}@{$ENDIF}LFProc;
-      #13: fProcTable[I]:={$IFDEF FPC}@{$ENDIF}CRProc;
-      #1..#9, #11, #12, #14..#32:
-        fProcTable[I]:={$IFDEF FPC}@{$ENDIF}SpaceProc;
-      '#': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}AsciiCharProc;
-      '$': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}IntegerProc;
-      #39: fProcTable[I]:={$IFDEF FPC}@{$ENDIF}StringProc;
-      '0'..'9': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}NumberProc;
-      'A'..'Z', 'a'..'z', '_':
-        fProcTable[I]:={$IFDEF FPC}@{$ENDIF}IdentProc;
-      '{': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}BraceOpenProc;
-      '}': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}BraceCloseProc;
-      '!', '"', '%', '&', '('..'/', ':'..'@', '['..'^', '`', '~':
-        begin
-          case I of
-            '(': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}RoundOpenProc;
-            ')': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}RoundCloseProc;
-            '*': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}StarProc;
-            '+': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}PlusProc;
-            ',': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}CommaProc;
-            '-': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}MinusProc;
-            '.': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}PointProc;
-            '/': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}SlashProc;
-            ':': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}ColonProc;
-            ';': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}SemiColonProc;
-            '<': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}LowerProc;
-            '=': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}EqualProc;
-            '>': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}GreaterProc;
-            '@': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}AddressOpProc;
-            '[': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}SquareOpenProc;
-            ']': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}SquareCloseProc;
-            '^': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}PointerSymbolProc;
-          else fProcTable[I]:={$IFDEF FPC}@{$ENDIF}SymbolProc;
-          end;
-        end;
-    else fProcTable[I]:={$IFDEF FPC}@{$ENDIF}UnknownProc;
-    end;
-end;
-
-constructor TmwPasLex.Create;
-begin
-  inherited Create;
-  InitIdent;
-  MakeMethodTables;
-end; { Create }
-
-destructor TmwPasLex.Destroy;
-begin
-  inherited Destroy;
-end; { Destroy }
-
-procedure TmwPasLex.SetOrigin(NewValue: PChar);
-begin
-  fOrigin:=NewValue;
-  fComment:=csNo;
-  fLineNumber:=0;
-  fLinePos:=0;
-  Run:=0;
-  Next;
-end; { SetOrigin }
-
-procedure TmwPasLex.SetRunPos(Value: Integer);
-begin
-  Run:=Value;
-  Next;
-end;
-
-procedure TmwPasLex.AddressOpProc;
-begin
-  Case FOrigin[Run+1]of
-    '@':
-      begin
-        fTokenID:=tkDoubleAddressOp;
-        Inc(Run, 2);
-      end;
-  else
-    begin
-      fTokenID:=tkAddressOp;
-      Inc(Run);
-    end;
-  end;
-end;
-
-procedure TmwPasLex.AsciiCharProc;
-begin
-  fTokenID:=tkAsciiChar;
-  Inc(Run);
-  while FOrigin[Run]in ['0'..'9']do Inc(Run);
-end;
-
-procedure TmwPasLex.BraceCloseProc;
-begin
-  Inc(Run);
-  fTokenId:=tkError;
-end;
-
-procedure TmwPasLex.BorProc;
-begin
-  fTokenID:=tkBorComment;
-  case FOrigin[Run]of
-    #0:
-      begin
-        NullProc;
-        Exit;
-      end;
-
-    #10:
-      begin
-        LFProc;
-        Exit;
-      end;
-
-    #13:
-      begin
-        CRProc;
-        Exit;
-      end;
-  end;
-
-  while FOrigin[Run]<>#0 do
-    case FOrigin[Run]of
-      '}':
-        begin
-          fComment:=csNo;
-          Inc(Run);
-          Break;
-        end;
-      #10: Break;
-
-      #13: Break;
-    else Inc(Run);
-    end;
-end;
-
-procedure TmwPasLex.BraceOpenProc;
-var
-  i: Integer;
-  s: string;
-begin
-  Case FOrigin[Run+1]of
-    '$': fTokenID:=tkCompDirect;
-    '.':
-      begin
-        fComment := csBor;
-        i := 1;
-        while (FOrigin[Run + 1 + i] <> #0) and (i <= 8) do
-        begin
-          s := s + FOrigin[Run + 1 + i];
-          Inc(i);
-        end;
-        if (AnsiCompareText(s, 'include ') = 0) then
-        begin
-          //Inc(Run, 8);
-          fTokenID := tkInclude;
-        end;
-      end
-  else
-    begin
-      fTokenID:=tkBorComment;
-      fComment:=csBor;
-    end;
-  end;
-  Inc(Run);
-  while FOrigin[Run]<>#0 do
-    case FOrigin[Run]of
-      '}':
-        begin
-          fComment:=csNo;
-          Inc(Run);
-          Break;
-        end;
-      #10: Break;
-
-      #13: Break;
-    else Inc(Run);
-    end;
-end;
-
-procedure TmwPasLex.ColonProc;
-begin
-  Case FOrigin[Run+1]of
-    '=':
-      begin
-        Inc(Run, 2);
-        fTokenID:=tkAssign;
-      end;
-  else
-    begin
-      Inc(Run);
-      fTokenID:=tkColon;
-    end;
-  end;
-end;
-
-procedure TmwPasLex.CommaProc;
-begin
-  Inc(Run);
-  fTokenID:=tkComma;
-end;
-
-procedure TmwPasLex.CRProc;
-begin
-  Case fComment of
-    csBor: fTokenID:=tkCRLFCo;
-    csAnsi: fTokenID:=tkCRLFCo;
-  else fTokenID:=tkCRLF;
-  end;
-
-  Case FOrigin[Run+1]of
-    #10: Inc(Run, 2);
-  else Inc(Run);
-  end;
-  Inc(fLineNumber);
-  fLinePos:=Run;
-end;
-
-procedure TmwPasLex.EqualProc;
-begin
-  Inc(Run);
-  fTokenID:=tkEqual;
-end;
-
-procedure TmwPasLex.GreaterProc;
-begin
-  Case FOrigin[Run+1]of
-    '=':
-      begin
-        Inc(Run, 2);
-        fTokenID:=tkGreaterEqual;
-      end;
-  else
-    begin
-      Inc(Run);
-      fTokenID:=tkGreater;
-    end;
-  end;
-end;
-
-function TmwPasLex.InSymbols(aChar: Char): Boolean;
-begin
-  if aChar in ['#', '$', '&', #39, '(', ')', '*', '+', ',', '–', '.', '/', ':',
-    ';', '<', '=', '>', '@', '[', ']', '^']then Result:=True else Result:=False;
-end;
-
-function TmwPasLex.CharAhead(Count: Integer): Char;
-begin
-  Temp:=fOrigin+Run+Count;
-  while Temp^in [#1..#9, #11, #12, #14..#32]do Inc(Temp);
-  Result:=Temp^;
-end;
-
-Function TokeToString(Toke : TTokenKind) : string;
-begin;
-  case toke of
-    tkAbsolute: result := 'tkAbsolute';
-    tkAbstract: result := 'tkAbstract';
-    tkAddressOp: result := 'tkAddressOp';
-    tkAnd: result := 'tkAnd';
-    tkAnsiComment: result := 'tkAnsiComment';
-    tkArray: result := 'tkArray';
-    tkAs: result := 'tkAs';
-    tkAt: result := 'tkAt';
-    tkAsciiChar: result := 'tkAsciiChar';
-    tkAsm: result := 'tkAsm';
-    tkAssembler: result := 'tkAssembler';
-    tkAssign: result := 'tkAssign';
-    tkAutomated: result := 'tkAutomated';
-    tkBegin: result := 'tkBegin';
-    tkBadString: result := 'tkBadString';
-    tkBorComment: result := 'tkBorComment';
-    tkCase: result := 'tkCase';
-    tkCdecl: result := 'tkCdecl';
-    tkClass: result := 'tkClass';
-    tkColon: result := 'tkColon';
-    tkComma: result := 'tkComma';
-    tkCompDirect: result := 'tkCompDirect';
-    tkConst: result := 'tkConst';
-    tkConstructor: result := 'tkConstructor';
-    tkCRLF: result := 'tkCRLF';
-    tkCRLFCo: result := 'tkCRLFCo';
-    tkDefault: result := 'tkDefault';
-    tkDestructor: result := 'tkDestructor';
-    tkDispid: result := 'tkDispid';
-    tkDispinterface: result := 'tkDispinterface';
-    tkDiv: result := 'tkDiv';
-    tkDo: result := 'tkDo';
-    tkDoubleAddressOp: result := 'tkDoubleAddressOp';
-    tkDotDot: result := 'tkDotDot';
-    tkDownto: result := 'tkDownto';
-    tkDynamic: result := 'tkDynamic';
-    tkElse: result := 'tkElse';
-    tkEnd: result := 'tkEnd';
-    tkEqual: result := 'tkEqual';
-    tkError: result := 'tkError';
-    tkExcept: result := 'tkExcept';
-    tkExport: result := 'tkExport';
-    tkExports: result := 'tkExports';
-    tkExternal: result := 'tkExternal';
-    tkFar: result := 'tkFar';
-    tkFile: result := 'tkFile';
-    tkFinalization: result := 'tkFinalization';
-    tkFinally: result := 'tkFinally';
-    tkFloat: result := 'tkFloat';
-    tkFor: result := 'tkFor';
-    tkForward: result := 'tkForward';
-    tkFunction: result := 'tkFunction';
-    tkGoto: result := 'tkGoto';
-    tkGreater: result := 'tkGreater';
-    tkGreaterEqual: result := 'tkGreaterEqual';
-    tkIdentifier: result := 'tkIdentifier';
-    tkIf: result := 'tkIf';
-    tkImplementation: result := 'tkImplementation';
-    tkImplements: result := 'tkImplements';
-    tkIn: result := 'tkIn';
-    tkINCLUDE: result := 'tkINCLUDE';
-    tkIndex: result := 'tkIndex';
-    tkInherited: result := 'tkInherited';
-    tkInitialization: result := 'tkInitialization';
-    tkInline: result := 'tkInline';
-    tkInteger: result := 'tkInteger';
-    tkInterface: result := 'tkInterface';
-    tkIs: result := 'tkIs';
-    tkKeyString: result := 'tkKeyString';
-    tkLabel: result := 'tkLabel';
-    tkLibrary: result := 'tkLibrary';
-    tkLower: result := 'tkLower';
-    tkLowerEqual: result := 'tkLowerEqual';
-    tkMessage: result := 'tkMessage';
-    tkMinus: result := 'tkMinus';
-    tkMod: result := 'tkMod';
-    tkName: result := 'tkName';
-    tkNear: result := 'tkNear';
-    tkNil: result := 'tkNil';
-    tkNodefault: result := 'tkNodefault';
-    tkNone: result := 'tkNone';
-    tkNot: result := 'tkNot';
-    tkNotEqual: result := 'tkNotEqual';
-    tkNull: result := 'tkNull';
-    tkNumber: result := 'tkNumber';
-    tkObject: result := 'tkObject';
-    tkOf: result := 'tkOf';
-    tkOn: result := 'tkOn';
-    tkOr: result := 'tkOr';
-    tkOut: result := 'tkOut';
-    tkOverload: result := 'tkOverload';
-    tkOverride: result := 'tkOverride';
-    tkPacked: result := 'tkPacked';
-    tkPascal: result := 'tkPascal';
-    tkPlus: result := 'tkPlus';
-    tkPoint: result := 'tkPoint';
-    tkPointerSymbol: result := 'tkPointerSymbol';
-    tkPrivate: result := 'tkPrivate';
-    tkProcedure: result := 'tkProcedure';
-    tkProgram: result := 'tkProgram';
-    tkProperty: result := 'tkProperty';
-    tkProtected: result := 'tkProtected';
-    tkPublic: result := 'tkPublic';
-    tkPublished: result := 'tkPublished';
-    tkRaise: result := 'tkRaise';
-    tkRead: result := 'tkRead';
-    tkReadonly: result := 'tkReadonly';
-    tkRecord: result := 'tkRecord';
-    tkRegister: result := 'tkRegister';
-    tkReintroduce: result := 'tkReintroduce';
-    tkRepeat: result := 'tkRepeat';
-    tkResident: result := 'tkResident';
-    tkResourcestring: result := 'tkResourcestring';
-    tkRoundClose: result := 'tkRoundClose';
-    tkRoundOpen: result := 'tkRoundOpen';
-    tkSafecall: result := 'tkSafecall';
-    tkSemiColon: result := 'tkSemiColon';
-    tkSet: result := 'tkSet';
-    tkShl: result := 'tkShl';
-    tkShr: result := 'tkShr';
-    tkSlash: result := 'tkSlash';
-    tkSlashesComment: result := 'tkSlashesComment';
-    tkSquareClose: result := 'tkSquareClose';
-    tkSquareOpen: result := 'tkSquareOpen';
-    tkSpace: result := 'tkSpace';
-    tkStar: result := 'tkStar';
-    tkStdcall: result := 'tkStdcall';
-    tkStored: result := 'tkStored';
-    tkString: result := 'tkString';
-    tkStringresource: result := 'tkStringresource';
-    tkSymbol: result := 'tkSymbol';
-    tkThen: result := 'tkThen';
-    tkThreadvar: result := 'tkThreadvar';
-    tkTo: result := 'tkTo';
-    tkTry: result := 'tkTry';
-    tkType: result := 'tkType';
-    tkUnit: result := 'tkUnit';
-    tkUnknown: result := 'tkUnknown';
-    tkUntil: result := 'tkUntil';
-    tkUses: result := 'tkUses';
-    tkVar: result := 'tkVar';
-    tkVirtual: result := 'tkVirtual';
-    tkWhile: result := 'tkWhile';
-    tkWith: result := 'tkWith';
-    tkWrite: result := 'tkWrite';
-    tkWriteonly: result := 'tkWriteonly';
-    tkXor: Result := 'tkXor';
-  end;
-end;
-
-procedure TmwPasLex.IdentProc;
-begin
-  fTokenID:=IdentKind((fOrigin+Run));
-  Inc(Run, fStringLen);
-  while Identifiers[fOrigin[Run]]do Inc(Run);
-end;
-
-procedure TmwPasLex.IntegerProc;
-begin
-  Inc(Run);
-  fTokenID:=tkInteger;
-  while FOrigin[Run]in ['0'..'9', 'A'..'F', 'a'..'f']do Inc(Run);
-end;
-
-procedure TmwPasLex.LFProc;
-begin
-  Case fComment of
-    csBor: fTokenID:=tkCRLFCo;
-    csAnsi: fTokenID:=tkCRLFCo;
-  else fTokenID:=tkCRLF;
-  end;
-  Inc(Run);
-  Inc(fLineNumber);
-  fLinePos:=Run;
-end;
-
-procedure TmwPasLex.LowerProc;
-begin
-  case FOrigin[Run+1]of
-    '=':
-      begin
-        Inc(Run, 2);
-        fTokenID:=tkLowerEqual;
-      end;
-    '>':
-      begin
-        Inc(Run, 2);
-        fTokenID:=tkNotEqual;
-      end
-  else
-    begin
-      Inc(Run);
-      fTokenID:=tkLower;
-    end;
-  end;
-end;
-
-procedure TmwPasLex.MinusProc;
-begin
-  Inc(Run);
-  fTokenID:=tkMinus;
-end;
-
-procedure TmwPasLex.NullProc;
-begin
-  fTokenID:=tkNull;
-end;
-
-procedure TmwPasLex.NumberProc;
-begin
-  Inc(Run);
-  fTokenID:=tkNumber;
-  while FOrigin[Run]in ['0'..'9', '.', 'e', 'E']do
-  begin
-    case FOrigin[Run]of
-      '.':
-        if FOrigin[Run+1]='.' then Break else fTokenID:=tkFloat
-    end;
-    Inc(Run);
-  end;
-end;
-
-procedure TmwPasLex.PlusProc;
-begin
-  Inc(Run);
-  fTokenID:=tkPlus;
-end;
-
-procedure TmwPasLex.PointerSymbolProc;
-begin
-  Inc(Run);
-  fTokenID:=tkPointerSymbol;
-end;
-
-procedure TmwPasLex.PointProc;
-begin
-  case FOrigin[Run+1]of
-    '.':
-      begin
-        Inc(Run, 2);
-        fTokenID:=tkDotDot;
-      end;
-    ')':
-      begin
-        Inc(Run, 2);
-        fTokenID:=tkSquareClose;
-        Dec(FSquareCount);
-      end;
-  else
-    begin
-      Inc(Run);
-      fTokenID:=tkPoint;
-    end;
-  end;
-end;
-
-procedure TmwPasLex.RoundCloseProc;
-begin
-  Inc(Run);
-  fTokenID:=tkRoundClose;
-  Dec(FRoundCount);
-end;
-
-procedure TmwPasLex.AnsiProc;
-begin
-  fTokenID:=tkAnsiComment;
-  case FOrigin[Run]of
-    #0:
-      begin
-        NullProc;
-        Exit;
-      end;
-
-    #10:
-      begin
-        LFProc;
-        Exit;
-      end;
-
-    #13:
-      begin
-        CRProc;
-        Exit;
-      end;
-  end;
-
-  while fOrigin[Run]<>#0 do
-    case fOrigin[Run]of
-      '*':
-        if fOrigin[Run+1]=')' then
-        begin
-          fComment:=csNo;
-          Inc(Run, 2);
-          Break;
-        end else Inc(Run);
-      #10: Break;
-
-      #13: Break;
-    else Inc(Run);
-    end;
-end;
-
-procedure TmwPasLex.RoundOpenProc;
-begin
-  Inc(Run);
-  case fOrigin[Run]of
-    '*':
-      begin
-        fTokenID:=tkAnsiComment;
-        if FOrigin[Run+1]='$' then fTokenID:=tkCompDirect else fComment:=csAnsi;
-        Inc(Run);
-        while fOrigin[Run]<>#0 do
-          case fOrigin[Run]of
-            '*':
-              if fOrigin[Run+1]=')' then
-              begin
-                fComment:=csNo;
-                Inc(Run, 2);
-                Break;
-              end else Inc(Run);
-            #10: Break;
-            #13: Break;
-          else Inc(Run);
-          end;
-      end;
-    '.':
-      begin
-        Inc(Run);
-        fTokenID:=tkSquareOpen;
-        Inc(FSquareCount);
-      end;
-  else
-    begin
-      FTokenID:=tkRoundOpen;
-      Inc(FRoundCount);
-    end;
-  end;
-end;
-
-procedure TmwPasLex.SemiColonProc;
-begin
-  Inc(Run);
-  fTokenID:=tkSemiColon;
-end;
-
-procedure TmwPasLex.SlashProc;
-begin
-  case FOrigin[Run+1]of
-    '/':
-      begin
-        Inc(Run, 2);
-        fTokenID:=tkSlashesComment;
-        while FOrigin[Run]<>#0 do
-        begin
-          case FOrigin[Run]of
-            #10, #13: Break;
-          end;
-          Inc(Run);
-        end;
-      end;
-  else
-    begin
-      Inc(Run);
-      fTokenID:=tkSlash;
-    end;
-  end;
-end;
-
-procedure TmwPasLex.SpaceProc;
-begin
-  Inc(Run);
-  fTokenID:=tkSpace;
-  while FOrigin[Run]in [#1..#9, #11, #12, #14..#32]do Inc(Run);
-end;
-
-procedure TmwPasLex.SquareCloseProc;
-begin
-  Inc(Run);
-  fTokenID:=tkSquareClose;
-  Dec(FSquareCount);
-end;
-
-procedure TmwPasLex.SquareOpenProc;
-begin
-  Inc(Run);
-  fTokenID:=tkSquareOpen;
-  Inc(FSquareCount);
-end;
-
-procedure TmwPasLex.StarProc;
-begin
-  Inc(Run);
-  fTokenID:=tkStar;
-end;
-
-procedure TmwPasLex.StringProc;
-begin
-  fTokenID:=tkString;
-  if(FOrigin[Run+1]=#39)and(FOrigin[Run+2]=#39)then Inc(Run, 2);
-  repeat
-    case FOrigin[Run]of
-      #0, #10, #13: Break;
-    end;
-    Inc(Run);
-  until FOrigin[Run]=#39;
-  if FOrigin[Run]<>#0 then Inc(Run);
-end;
-
-procedure TmwPasLex.SymbolProc;
-begin
-  Inc(Run);
-  fTokenID:=tkSymbol;
-end;
-
-procedure TmwPasLex.UnknownProc;
-begin
-  Inc(Run);
-  fTokenID:=tkUnknown;
-end;
-
-procedure TmwPasLex.Next;
-begin
-  Case fTokenID of
-    tkIdentifier:
-      begin
-        fLastIdentPos:=fTokenPos;
-        fLastNoSpace:=fTokenID;
-        fLastNoSpacePos:=fTokenPos;
-      end;
-    tkSpace: ;
-  else
-    begin
-      fLastNoSpace:=fTokenID;
-      fLastNoSpacePos:=fTokenPos;
-    end;
-  end;
-  fTokenPos:=Run;
-  Case fComment of
-    csNo: fProcTable[fOrigin[Run]];
-  else
-    Case fComment of
-      csBor: BorProc;
-      csAnsi: AnsiProc;
-    end;
-  end;
-end;
-
-function TmwPasLex.GetToken: string;
-var
-  Len: Longint;
-begin
-  Result := '';
-  Len:=Run-fTokenPos;
-  SetString(Result, (FOrigin+fTokenPos), Len);
-end;
-
-procedure TmwPasLex.NextID(ID: TTokenKind);
-begin
-  repeat
-    Case fTokenID of
-      tkNull: Break;
-    else Next;
-    end;
-  until fTokenID=ID;
-end;
-
-procedure TmwPasLex.NextNoJunk;
-begin
-  repeat
-    Next;
-  until not(fTokenID in [tkSlashesComment, tkAnsiComment, tkBorComment, tkCRLF, tkCRLFCo, tkSpace]);
-end;
-
-procedure TmwPasLex.NextClass;
-begin
-  if fTokenID<>tkNull then next;
-  repeat
-    Case fTokenID of
-      tkNull: Break;
-    else Next;
-    end;
-  until(fTokenID=tkClass)and(IsClass);
-end;
-
-initialization
-  MakeIdentTable;
-
-end.
-
-
-
-
-
-
+{+--------------------------------------------------------------------------+
+ | Class:       TmwPasLex
+ | Created:     07.98 - 10.98
+ | Author:      Martin Waldenburg
+ | Description: A very fast Pascal tokenizer.
+ | Version:     1.32
+ | Copyright (c) 1998, 1999 Martin Waldenburg
+ | All rights reserved.
+ |
+ | LICENCE CONDITIONS
+ |
+ | USE OF THE ENCLOSED SOFTWARE
+ | INDICATES YOUR ASSENT TO THE
+ | FOLLOWING LICENCE CONDITIONS.
+ |
+ |
+ |
+ | These Licence Conditions are exlusively
+ | governed by the Law and Rules of the
+ | Federal Republic of Germany.
+ |
+ | Redistribution and use in source and binary form, with or without
+ | modification, are permitted provided that the following conditions
+ | are met:
+ |
+ | 1. Redistributions of source code must retain the above copyright
+ |    notice, this list of conditions and the following disclaimer.
+ |    If the source is modified, the complete original and unmodified
+ |    source code has to distributed with the modified version.
+ |
+ | 2. Redistributions in binary form must reproduce the above
+ |    copyright notice, these licence conditions and the disclaimer
+ |    found at the end of this licence agreement in the documentation
+ |    and/or other materials provided with the distribution.
+ |
+ | 3. Software using this code must contain a visible line of credit.
+ |
+ | 4. If my code is used in a "for profit" product, you have to donate
+ |    to a registered charity in an amount that you feel is fair.
+ |    You may use it in as many of your products as you like.
+ |    Proof of this donation must be provided to the author of
+ |    this software.
+ |
+ | 5. If you for some reasons don't want to give public credit to the
+ |    author, you have to donate three times the price of your software
+ |    product, or any other product including this component in any way,
+ |    but no more than $500 US and not less than $200 US, or the
+ |    equivalent thereof in other currency, to a registered charity.
+ |    You have to do this for every of your products, which uses this
+ |    code separately.
+ |    Proof of this donations must be provided to the author of
+ |    this software.
+ |
+ |
+ | DISCLAIMER:
+ |
+ | THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS'.
+ |
+ | ALL EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
+ | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ | PARTICULAR PURPOSE ARE DISCLAIMED.
+ |
+ | IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+ | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+ | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ | OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ | INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ | WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+ | THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ |
+ |  Martin.Waldenburg@T-Online.de
+ +--------------------------------------------------------------------------+}
+
+{25/03/2003 Olivier GUILBAUD <golivier@free.fr> update for lazarus project}
+
+unit mPasLex;
+{$mode objfpc}{$H+}{$M+}
+interface
+
+uses
+  SysUtils;
+
+var
+  Identifiers: array[#0..#255]of ByteBool;
+  mHashTable: array[#0..#255]of Integer;
+
+type
+  TTokenKind=(tkAbsolute, tkAbstract, tkAddressOp, tkAnd, tkAnsiComment,
+    tkArray, tkAs, tkAt, tkAsciiChar, tkAsm, tkAssembler, tkAssign, tkAutomated,
+    tkBegin, tkBadString, tkBorComment, tkCase, tkCdecl, tkClass, tkColon,
+    tkComma, tkCompDirect, tkConst, tkConstructor, tkCRLF, tkCRLFCo, tkDefault,
+    tkDestructor, tkDispid, tkDispinterface, tkDiv, tkDo, tkDoubleAddressOp,
+    tkDotDot, tkDownto, tkDynamic, tkElse, tkEnd, tkEqual, tkError, tkExcept,
+    tkExport, tkExports, tkExternal, tkFar, tkFile, tkFinalization, tkFinally,
+    tkFloat, tkFor, tkForward, tkFunction, tkGoto, tkGreater, tkGreaterEqual,
+    tkIdentifier, tkIf, tkImplementation, tkImplements, tkIn, tkInclude, tkIndex,
+    tkInherited, tkInitialization, tkInline, tkInteger, tkInterface, tkIs,
+    tkKeyString, tkLabel, tkLibrary, tkLower, tkLowerEqual, tkMessage, tkMinus,
+    tkMod, tkName, tkNear, tkNil, tkNodefault, tkNone, tkNot, tkNotEqual, tkNull,
+    tkNumber, tkObject, tkOf, tkOn, tkOr, tkOut, tkOverload, tkOverride,
+    tkPacked, tkPascal, tkPlus, tkPoint, tkPointerSymbol, tkPrivate, tkProcedure,
+    tkProgram, tkProperty, tkProtected, tkPublic, tkPublished, tkRaise, tkRead,
+    tkReadonly, tkRecord, tkRegister, tkReintroduce, tkRepeat, tkResident,
+    tkResourcestring, tkRoundClose, tkRoundOpen, tkSafecall, tkSemiColon, tkSet,
+    tkShl, tkShr, tkSlash, tkSlashesComment, tkSquareClose, tkSquareOpen,
+    tkSpace, tkStar, tkStdcall, tkStored, tkString, tkStringresource, tkSymbol,
+    tkThen, tkThreadvar, tkTo, tkTry, tkType, tkUnit, tkUnknown, tkUntil, tkUses,
+    tkVar, tkVirtual, tkWhile, tkWith, tkWrite, tkWriteonly, tkXor);
+
+  TCommentState=(csAnsi, csBor, csNo);
+
+  TmwPasLex=class(TObject)
+  private
+    fComment: TCommentState;
+    fOrigin: PChar;
+    fProcTable: array[#0..#255]of procedure of Object;
+    Run: Longint;
+    Temp: PChar;
+    FRoundCount: Integer;
+    FSquareCount: Integer;
+    fStringLen: Integer;
+    fToIdent: PChar;
+    fIdentFuncTable: array[0..191]of function: TTokenKind of Object;
+    fTokenPos: Integer;
+    fLineNumber: Integer;
+    FTokenID: TTokenKind;
+    fLastIdentPos: Integer;
+    fLastNoSpace: TTokenKind;
+    fLastNoSpacePos: Integer;
+    fLinePos: Integer;
+    fIsInterface: Boolean;
+    fIsClass: Boolean;
+    function KeyHash(ToHash: PChar): Integer;
+    function KeyComp(const aKey: string): Boolean;
+    function Func15: TTokenKind;
+    function Func19: TTokenKind;
+    function Func20: TTokenKind;
+    function Func21: TTokenKind;
+    function Func23: TTokenKind;
+    function Func25: TTokenKind;
+    function Func27: TTokenKind;
+    function Func28: TTokenKind;
+    function Func29: TTokenKind;
+    function Func32: TTokenKind;
+    function Func33: TTokenKind;
+    function Func35: TTokenKind;
+    function Func37: TTokenKind;
+    function Func38: TTokenKind;
+    function Func39: TTokenKind;
+    function Func40: TTokenKind;
+    function Func41: TTokenKind;
+    function Func44: TTokenKind;
+    function Func45: TTokenKind;
+    function Func47: TTokenKind;
+    function Func49: TTokenKind;
+    function Func52: TTokenKind;
+    function Func54: TTokenKind;
+    function Func55: TTokenKind;
+    function Func56: TTokenKind;
+    function Func57: TTokenKind;
+    function Func59: TTokenKind;
+    function Func60: TTokenKind;
+    function Func61: TTokenKind;
+    function Func63: TTokenKind;
+    function Func64: TTokenKind;
+    function Func65: TTokenKind;
+    function Func66: TTokenKind;
+    function Func69: TTokenKind;
+    function Func71: TTokenKind;
+    function Func73: TTokenKind;
+    function Func75: TTokenKind;
+    function Func76: TTokenKind;
+    function Func79: TTokenKind;
+    function Func81: TTokenKind;
+    function Func84: TTokenKind;
+    function Func85: TTokenKind;
+    function Func87: TTokenKind;
+    function Func88: TTokenKind;
+    function Func91: TTokenKind;
+    function Func92: TTokenKind;
+    function Func94: TTokenKind;
+    function Func95: TTokenKind;
+    function Func96: TTokenKind;
+    function Func97: TTokenKind;
+    function Func98: TTokenKind;
+    function Func99: TTokenKind;
+    function Func100: TTokenKind;
+    function Func101: TTokenKind;
+    function Func102: TTokenKind;
+    function Func103: TTokenKind;
+    function Func105: TTokenKind;
+    function Func106: TTokenKind;
+    function Func117: TTokenKind;
+    function Func126: TTokenKind;
+    function Func129: TTokenKind;
+    function Func132: TTokenKind;
+    function Func133: TTokenKind;
+    function Func136: TTokenKind;
+    function Func141: TTokenKind;
+    function Func143: TTokenKind;
+    function Func166: TTokenKind;
+    function Func168: TTokenKind;
+    function Func191: TTokenKind;
+    function AltFunc: TTokenKind;
+    procedure InitIdent;
+    function IdentKind(MayBe: PChar): TTokenKind;
+    procedure SetOrigin(NewValue: PChar);
+    procedure SetRunPos(Value: Integer);
+    procedure MakeMethodTables;
+    procedure AddressOpProc;
+    procedure AsciiCharProc;
+    procedure AnsiProc;
+    procedure BorProc;
+    procedure BraceCloseProc;
+    procedure BraceOpenProc;
+    procedure ColonProc;
+    procedure CommaProc;
+    procedure CRProc;
+    procedure EqualProc;
+    procedure GreaterProc;
+    procedure IdentProc;
+    procedure IntegerProc;
+    procedure LFProc;
+    procedure LowerProc;
+    procedure MinusProc;
+    procedure NullProc;
+    procedure NumberProc;
+    procedure PlusProc;
+    procedure PointerSymbolProc;
+    procedure PointProc;
+    procedure RoundCloseProc;
+    procedure RoundOpenProc;
+    procedure SemiColonProc;
+    procedure SlashProc;
+    procedure SpaceProc;
+    procedure SquareCloseProc;
+    procedure SquareOpenProc;
+    procedure StarProc;
+    procedure StringProc;
+    procedure SymbolProc;
+    procedure UnknownProc;
+    function GetToken: string;
+    function InSymbols(aChar: Char): Boolean;
+  protected
+  public
+    constructor Create;
+    destructor Destroy; override;
+    function CharAhead(Count: Integer): Char;
+    procedure Next;
+    procedure NextID(ID: TTokenKind);
+    procedure NextNoJunk;
+    procedure NextClass;
+    property IsClass: Boolean read fIsClass;
+    property IsInterface: Boolean read fIsInterface;
+    property LastIdentPos: Integer read fLastIdentPos;
+    property LastNoSpace: TTokenKind read fLastNoSpace;
+    property LastNoSpacePos: Integer read fLastNoSpacePos;
+    property LineNumber: Integer read fLineNumber;
+    property LinePos: Integer read fLinePos;
+    property Origin: PChar read fOrigin write SetOrigin;
+    property RunPos: Integer read Run write SetRunPos;
+    property TokenPos: Integer read fTokenPos;
+    property Token: string read GetToken;
+    property TokenID: TTokenKind read FTokenID;
+  published
+  end;
+
+var
+  mwPasLex: TmwPasLex;
+
+implementation
+
+procedure MakeIdentTable;
+var
+  I, J: Char;
+begin
+  for I:=#0 to #255 do
+  begin
+    Case I of
+      '_', '0'..'9', 'a'..'z', 'A'..'Z': Identifiers[I]:=True;
+    else Identifiers[I]:=False;
+    end;
+    J:=UpperCase(I)[1];
+    Case I of
+      'a'..'z', 'A'..'Z', '_': mHashTable[I]:=Ord(J)-64;
+    else mHashTable[Char(I)]:=0;
+    end;
+  end;
+end;
+
+procedure TmwPasLex.InitIdent;
+var
+  I: Integer;
+begin
+  for I:=0 to 191 do
+    Case I of
+      15: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func15;
+      19: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func19;
+      20: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func20;
+      21: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func21;
+      23: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func23;
+      25: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func25;
+      27: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func27;
+      28: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func28;
+      29: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func29;
+      32: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func32;
+      33: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func33;
+      35: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func35;
+      37: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func37;
+      38: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func38;
+      39: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func39;
+      40: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func40;
+      41: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func41;
+      44: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func44;
+      45: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func45;
+      47: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func47;
+      49: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func49;
+      52: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func52;
+      54: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func54;
+      55: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func55;
+      56: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func56;
+      57: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func57;
+      59: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func59;
+      60: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func60;
+      61: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func61;
+      63: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func63;
+      64: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func64;
+      65: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func65;
+      66: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func66;
+      69: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func69;
+      71: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func71;
+      73: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func73;
+      75: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func75;
+      76: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func76;
+      79: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func79;
+      81: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func81;
+      84: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func84;
+      85: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func85;
+      87: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func87;
+      88: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func88;
+      91: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func91;
+      92: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func92;
+      94: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func94;
+      95: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func95;
+      96: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func96;
+      97: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func97;
+      98: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func98;
+      99: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func99;
+      100: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func100;
+      101: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func101;
+      102: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func102;
+      103: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func103;
+      105: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func105;
+      106: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func106;
+      117: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func117;
+      126: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func126;
+      129: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func129;
+      132: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func132;
+      133: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func133;
+      136: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func136;
+      141: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func141;
+      143: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func143;
+      166: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func166;
+      168: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func168;
+      191: fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}Func191;
+    else fIdentFuncTable[I]:={$IFDEF FPC}@{$ENDIF}AltFunc;
+    end;
+end;
+
+function TmwPasLex.KeyHash(ToHash: PChar): Integer;
+begin
+  Result:=0;
+  while ToHash^in ['a'..'z', 'A'..'Z']do
+  begin
+    Inc(Result, mHashTable[ToHash^]);
+    Inc(ToHash);
+  end;
+  if ToHash^in ['_', '0'..'9']then Inc(ToHash);
+  fStringLen:=ToHash-fToIdent;
+end; { KeyHash }
+
+function TmwPasLex.KeyComp(const aKey: string): Boolean;
+var
+  I: Integer;
+begin
+  Temp:=fToIdent;
+  if Length(aKey)=fStringLen then
+  begin
+    Result:=True;
+    for i:=1 to fStringLen do
+    begin
+      if mHashTable[Temp^]<>mHashTable[aKey[i]]then
+      begin
+        Result:=False;
+        Break;
+      end;
+      Inc(Temp);
+    end;
+  end else Result:=False;
+end; { KeyComp }
+
+function TmwPasLex.Func15: TTokenKind;
+begin
+  if KeyComp('If')then Result:=tkIf else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func19: TTokenKind;
+begin
+  if KeyComp('Do')then Result:=tkDo else
+    if KeyComp('And')then Result:=tkAnd else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func20: TTokenKind;
+begin
+  if KeyComp('As')then Result:=tkAs else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func21: TTokenKind;
+begin
+  if KeyComp('Of')then Result:=tkOf else
+    if KeyComp('At')then Result:=tkAt else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func23: TTokenKind;
+begin
+  if KeyComp('End')then Result:=tkEnd else
+    if KeyComp('In')then Result:=tkIn else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func25: TTokenKind;
+begin
+  if KeyComp('Far')then Result:=tkFar else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func27: TTokenKind;
+begin
+  if KeyComp('Cdecl')then Result:=tkCdecl else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func28: TTokenKind;
+begin
+  if KeyComp('Read')then
+  begin
+    if inSymbols(CharAhead(fStringLen))then Result:=tkIdentifier else
+      Result:=tkRead
+  end else
+    if KeyComp('Case')then Result:=tkCase else
+      if KeyComp('Is')then Result:=tkIs else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func29: TTokenKind;
+begin
+  if KeyComp('On')then Result:=tkOn else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func32: TTokenKind;
+begin
+  if KeyComp('File')then Result:=tkFile else
+    if KeyComp('Label')then Result:=tkLabel else
+      if KeyComp('Mod')then Result:=tkMod else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func33: TTokenKind;
+begin
+  if KeyComp('Or')then Result:=tkOr else
+    if KeyComp('Name')then
+    begin
+      if inSymbols(CharAhead(fStringLen))then Result:=tkIdentifier else
+        Result:=tkName
+    end else
+      if KeyComp('Asm')then Result:=tkAsm else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func35: TTokenKind;
+begin
+  if KeyComp('To')then Result:=tkTo else
+    if KeyComp('Nil')then Result:=tkNil else
+      if KeyComp('Div')then Result:=tkDiv else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func37: TTokenKind;
+begin
+  if KeyComp('Begin')then Result:=tkBegin else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func38: TTokenKind;
+begin
+  if KeyComp('Near')then Result:=tkNear else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func39: TTokenKind;
+begin
+  if KeyComp('For')then Result:=tkFor else
+    if KeyComp('Shl')then Result:=tkShl else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func40: TTokenKind;
+begin
+  if KeyComp('Packed')then Result:=tkPacked else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func41: TTokenKind;
+begin
+  if KeyComp('Else')then Result:=tkElse else
+    if KeyComp('Var')then Result:=tkVar else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func44: TTokenKind;
+begin
+  if KeyComp('Set')then Result:=tkSet else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func45: TTokenKind;
+begin
+  if KeyComp('Shr')then Result:=tkShr else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func47: TTokenKind;
+begin
+  if KeyComp('Then')then Result:=tkThen else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func49: TTokenKind;
+begin
+  if KeyComp('Not')then Result:=tkNot else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func52: TTokenKind;
+begin
+  if KeyComp('Raise')then Result:=tkRaise else
+    if KeyComp('Pascal')then Result:=tkPascal else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func54: TTokenKind;
+begin
+  if KeyComp('Class')then
+  begin
+    Result:=tkClass;
+    if fLastNoSpace=tkEqual then
+    begin
+      fIsClass:=True;
+      if Identifiers[CharAhead(fStringLen)]then fIsClass:=False;
+    end else fIsClass:=False;
+  end else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func55: TTokenKind;
+begin
+  if KeyComp('Object')then Result:=tkObject else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func56: TTokenKind;
+begin
+  if KeyComp('Index')then
+  begin
+    if inSymbols(CharAhead(fStringLen))then Result:=tkIdentifier else
+      Result:=tkIndex
+  end else
+    if KeyComp('Out')then Result:=tkOut else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func57: TTokenKind;
+begin
+  if KeyComp('While')then Result:=tkWhile else
+    if KeyComp('Goto')then Result:=tkGoto else
+      if KeyComp('Xor')then Result:=tkXor else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func59: TTokenKind;
+begin
+  if KeyComp('Safecall')then Result:=tkSafecall else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func60: TTokenKind;
+begin
+  if KeyComp('With')then Result:=tkWith else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func61: TTokenKind;
+begin
+  if KeyComp('Dispid')then Result:=tkDispid else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func63: TTokenKind;
+begin
+  if KeyComp('Public')then
+  begin
+    if inSymbols(CharAhead(fStringLen))then Result:=tkIdentifier else
+      Result:=tkPublic
+  end else
+    if KeyComp('Record')then Result:=tkRecord else
+      if KeyComp('Try')then Result:=tkTry else
+        if KeyComp('Array')then Result:=tkArray else
+          if KeyComp('Inline')then Result:=tkInline else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func64: TTokenKind;
+begin
+  if KeyComp('Uses')then Result:=tkUses else
+    if KeyComp('Unit')then Result:=tkUnit else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func65: TTokenKind;
+begin
+  if KeyComp('Repeat')then Result:=tkRepeat else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func66: TTokenKind;
+begin
+  if KeyComp('Type')then Result:=tkType else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func69: TTokenKind;
+begin
+  if KeyComp('Dynamic')then Result:=tkDynamic else
+    if KeyComp('Default')then Result:=tkDefault else
+      if KeyComp('Message')then Result:=tkMessage else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func71: TTokenKind;
+begin
+  if KeyComp('Stdcall')then Result:=tkStdcall else
+    if KeyComp('Const')then Result:=tkConst else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func73: TTokenKind;
+begin
+  if KeyComp('Except')then Result:=tkExcept else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func75: TTokenKind;
+begin
+  if KeyComp('Write')then
+  begin
+    if inSymbols(CharAhead(fStringLen))then Result:=tkIdentifier else
+      Result:=tkWrite
+  end else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func76: TTokenKind;
+begin
+  if KeyComp('Until')then Result:=tkUntil else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func79: TTokenKind;
+begin
+  if KeyComp('Finally')then Result:=tkFinally else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func81: TTokenKind;
+begin
+  if KeyComp('Interface')then
+  begin
+    Result:=tkInterface;
+    if fLastNoSpace=tkEqual then
+      fIsInterface:=True else fIsInterface:=False;
+  end else
+    if KeyComp('Stored')then Result:=tkStored else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func84: TTokenKind;
+begin
+  if KeyComp('Abstract')then Result:=tkAbstract else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func85: TTokenKind;
+begin
+  if KeyComp('Library')then Result:=tkLibrary else
+    if KeyComp('Forward')then Result:=tkForward else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func87: TTokenKind;
+begin
+  if KeyComp('String')then Result:=tkString else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func88: TTokenKind;
+begin
+  if KeyComp('Program')then Result:=tkProgram else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func91: TTokenKind;
+begin
+  if KeyComp('Private')then
+  begin
+    if inSymbols(CharAhead(fStringLen))then Result:=tkIdentifier else
+      Result:=tkPrivate
+  end else
+    if KeyComp('Downto')then Result:=tkDownto else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func92: TTokenKind;
+begin
+  if KeyComp('overload') then
+    Result:=tkOverload
+  else
+    if KeyComp('Inherited') then
+      Result:=tkInherited
+    else
+      Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func94: TTokenKind;
+begin
+  if KeyComp('Resident')then Result:=tkResident else
+    if KeyComp('Readonly')then Result:=tkReadonly else
+      if KeyComp('Assembler')then Result:=tkAssembler else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func95: TTokenKind;
+begin
+  if KeyComp('Absolute')then Result:=tkAbsolute else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func96: TTokenKind;
+begin
+  if KeyComp('Published')then
+  begin
+    if inSymbols(CharAhead(fStringLen))then Result:=tkIdentifier else
+      Result:=tkPublished
+  end else
+    if KeyComp('Override')then Result:=tkOverride else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func97: TTokenKind;
+begin
+  if KeyComp('Threadvar')then Result:=tkThreadvar else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func98: TTokenKind;
+begin
+  if KeyComp('Export')then Result:=tkExport else
+    if KeyComp('Nodefault')then Result:=tkNodefault else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func99: TTokenKind;
+begin
+  if KeyComp('External')then Result:=tkExternal else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func100: TTokenKind;
+begin
+  if KeyComp('Automated')then
+  begin
+    if inSymbols(CharAhead(fStringLen))then Result:=tkIdentifier else
+      Result:=tkAutomated
+  end else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func101: TTokenKind;
+begin
+  if KeyComp('Register')then Result:=tkRegister else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func102: TTokenKind;
+begin
+  if KeyComp('Function')then Result:=tkFunction else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func103: TTokenKind;
+begin
+  if KeyComp('Virtual')then Result:=tkVirtual else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func105: TTokenKind;
+begin
+  if KeyComp('Procedure')then Result:=tkProcedure else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func106: TTokenKind;
+begin
+  if KeyComp('Protected')then
+  begin
+    if inSymbols(CharAhead(fStringLen))then Result:=tkIdentifier else
+      Result:=tkProtected
+  end else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func117: TTokenKind;
+begin
+  if KeyComp('Exports')then Result:=tkExports else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func126: TTokenKind;
+begin
+  if KeyComp('Implements') then
+    Result:=tkImplements
+  else
+  Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func129: TTokenKind;
+begin
+  if KeyComp('Dispinterface')then Result:=tkDispinterface else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func132: TTokenKind;
+begin
+  if KeyComp('Reintroduce') then
+    Result:=tkReintroduce
+  else
+  Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func133: TTokenKind;
+begin
+  if KeyComp('Property')then Result:=tkProperty else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func136: TTokenKind;
+begin
+  if KeyComp('Finalization')then Result:=tkFinalization else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func141: TTokenKind;
+begin
+  if KeyComp('Writeonly')then Result:=tkWriteonly else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func143: TTokenKind;
+begin
+  if KeyComp('Destructor')then Result:=tkDestructor else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func166: TTokenKind;
+begin
+  if KeyComp('Constructor')then Result:=tkConstructor else
+    if KeyComp('Implementation')then Result:=tkImplementation else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func168: TTokenKind;
+begin
+  if KeyComp('Initialization')then Result:=tkInitialization else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.Func191: TTokenKind;
+begin
+  if KeyComp('Resourcestring')then Result:=tkResourcestring else
+    if KeyComp('Stringresource')then Result:=tkStringresource else Result:=tkIdentifier;
+end;
+
+function TmwPasLex.AltFunc: TTokenKind;
+begin
+  Result:=tkIdentifier
+end;
+
+function TmwPasLex.IdentKind(MayBe: PChar): TTokenKind;
+var
+  HashKey: Integer;
+begin
+  fToIdent:=MayBe;
+  HashKey:=KeyHash(MayBe);
+  if HashKey<192 then
+    Result:=fIdentFuncTable[HashKey]()
+  else
+     Result:=tkIdentifier;
+end;
+
+procedure TmwPasLex.MakeMethodTables;
+var
+  I: Char;
+begin
+  for I:=#0 to #255 do
+    case I of
+      #0:  fProcTable[I]:={$IFDEF FPC}@{$ENDIF}NullProc;
+      #10: fProcTable[I]:={$IFDEF FPC}@{$ENDIF}LFProc;
+      #13: fProcTable[I]:={$IFDEF FPC}@{$ENDIF}CRProc;
+      #1..#9, #11, #12, #14..#32:
+        fProcTable[I]:={$IFDEF FPC}@{$ENDIF}SpaceProc;
+      '#': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}AsciiCharProc;
+      '$': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}IntegerProc;
+      #39: fProcTable[I]:={$IFDEF FPC}@{$ENDIF}StringProc;
+      '0'..'9': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}NumberProc;
+      'A'..'Z', 'a'..'z', '_':
+        fProcTable[I]:={$IFDEF FPC}@{$ENDIF}IdentProc;
+      '{': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}BraceOpenProc;
+      '}': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}BraceCloseProc;
+      '!', '"', '%', '&', '('..'/', ':'..'@', '['..'^', '`', '~':
+        begin
+          case I of
+            '(': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}RoundOpenProc;
+            ')': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}RoundCloseProc;
+            '*': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}StarProc;
+            '+': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}PlusProc;
+            ',': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}CommaProc;
+            '-': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}MinusProc;
+            '.': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}PointProc;
+            '/': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}SlashProc;
+            ':': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}ColonProc;
+            ';': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}SemiColonProc;
+            '<': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}LowerProc;
+            '=': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}EqualProc;
+            '>': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}GreaterProc;
+            '@': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}AddressOpProc;
+            '[': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}SquareOpenProc;
+            ']': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}SquareCloseProc;
+            '^': fProcTable[I]:={$IFDEF FPC}@{$ENDIF}PointerSymbolProc;
+          else fProcTable[I]:={$IFDEF FPC}@{$ENDIF}SymbolProc;
+          end;
+        end;
+    else fProcTable[I]:={$IFDEF FPC}@{$ENDIF}UnknownProc;
+    end;
+end;
+
+constructor TmwPasLex.Create;
+begin
+  inherited Create;
+  InitIdent;
+  MakeMethodTables;
+end; { Create }
+
+destructor TmwPasLex.Destroy;
+begin
+  inherited Destroy;
+end; { Destroy }
+
+procedure TmwPasLex.SetOrigin(NewValue: PChar);
+begin
+  fOrigin:=NewValue;
+  fComment:=csNo;
+  fLineNumber:=0;
+  fLinePos:=0;
+  Run:=0;
+  Next;
+end; { SetOrigin }
+
+procedure TmwPasLex.SetRunPos(Value: Integer);
+begin
+  Run:=Value;
+  Next;
+end;
+
+procedure TmwPasLex.AddressOpProc;
+begin
+  Case FOrigin[Run+1]of
+    '@':
+      begin
+        fTokenID:=tkDoubleAddressOp;
+        Inc(Run, 2);
+      end;
+  else
+    begin
+      fTokenID:=tkAddressOp;
+      Inc(Run);
+    end;
+  end;
+end;
+
+procedure TmwPasLex.AsciiCharProc;
+begin
+  fTokenID:=tkAsciiChar;
+  Inc(Run);
+  while FOrigin[Run]in ['0'..'9']do Inc(Run);
+end;
+
+procedure TmwPasLex.BraceCloseProc;
+begin
+  Inc(Run);
+  fTokenId:=tkError;
+end;
+
+procedure TmwPasLex.BorProc;
+begin
+  fTokenID:=tkBorComment;
+  case FOrigin[Run]of
+    #0:
+      begin
+        NullProc;
+        Exit;
+      end;
+
+    #10:
+      begin
+        LFProc;
+        Exit;
+      end;
+
+    #13:
+      begin
+        CRProc;
+        Exit;
+      end;
+  end;
+
+  while FOrigin[Run]<>#0 do
+    case FOrigin[Run]of
+      '}':
+        begin
+          fComment:=csNo;
+          Inc(Run);
+          Break;
+        end;
+      #10: Break;
+
+      #13: Break;
+    else Inc(Run);
+    end;
+end;
+
+procedure TmwPasLex.BraceOpenProc;
+var
+  i: Integer;
+  s: string;
+begin
+  Case FOrigin[Run+1]of
+    '$': fTokenID:=tkCompDirect;
+    '.':
+      begin
+        fComment := csBor;
+        i := 1;
+        while (FOrigin[Run + 1 + i] <> #0) and (i <= 8) do
+        begin
+          s := s + FOrigin[Run + 1 + i];
+          Inc(i);
+        end;
+        if (AnsiCompareText(s, 'include ') = 0) then
+        begin
+          //Inc(Run, 8);
+          fTokenID := tkInclude;
+        end;
+      end
+  else
+    begin
+      fTokenID:=tkBorComment;
+      fComment:=csBor;
+    end;
+  end;
+  Inc(Run);
+  while FOrigin[Run]<>#0 do
+    case FOrigin[Run]of
+      '}':
+        begin
+          fComment:=csNo;
+          Inc(Run);
+          Break;
+        end;
+      #10: Break;
+
+      #13: Break;
+    else Inc(Run);
+    end;
+end;
+
+procedure TmwPasLex.ColonProc;
+begin
+  Case FOrigin[Run+1]of
+    '=':
+      begin
+        Inc(Run, 2);
+        fTokenID:=tkAssign;
+      end;
+  else
+    begin
+      Inc(Run);
+      fTokenID:=tkColon;
+    end;
+  end;
+end;
+
+procedure TmwPasLex.CommaProc;
+begin
+  Inc(Run);
+  fTokenID:=tkComma;
+end;
+
+procedure TmwPasLex.CRProc;
+begin
+  Case fComment of
+    csBor: fTokenID:=tkCRLFCo;
+    csAnsi: fTokenID:=tkCRLFCo;
+  else fTokenID:=tkCRLF;
+  end;
+
+  Case FOrigin[Run+1]of
+    #10: Inc(Run, 2);
+  else Inc(Run);
+  end;
+  Inc(fLineNumber);
+  fLinePos:=Run;
+end;
+
+procedure TmwPasLex.EqualProc;
+begin
+  Inc(Run);
+  fTokenID:=tkEqual;
+end;
+
+procedure TmwPasLex.GreaterProc;
+begin
+  Case FOrigin[Run+1]of
+    '=':
+      begin
+        Inc(Run, 2);
+        fTokenID:=tkGreaterEqual;
+      end;
+  else
+    begin
+      Inc(Run);
+      fTokenID:=tkGreater;
+    end;
+  end;
+end;
+
+function TmwPasLex.InSymbols(aChar: Char): Boolean;
+begin
+  if aChar in ['#', '$', '&', #39, '(', ')', '*', '+', ',', '–', '.', '/', ':',
+    ';', '<', '=', '>', '@', '[', ']', '^']then Result:=True else Result:=False;
+end;
+
+function TmwPasLex.CharAhead(Count: Integer): Char;
+begin
+  Temp:=fOrigin+Run+Count;
+  while Temp^in [#1..#9, #11, #12, #14..#32]do Inc(Temp);
+  Result:=Temp^;
+end;
+
+Function TokeToString(Toke : TTokenKind) : string;
+begin;
+  case toke of
+    tkAbsolute: result := 'tkAbsolute';
+    tkAbstract: result := 'tkAbstract';
+    tkAddressOp: result := 'tkAddressOp';
+    tkAnd: result := 'tkAnd';
+    tkAnsiComment: result := 'tkAnsiComment';
+    tkArray: result := 'tkArray';
+    tkAs: result := 'tkAs';
+    tkAt: result := 'tkAt';
+    tkAsciiChar: result := 'tkAsciiChar';
+    tkAsm: result := 'tkAsm';
+    tkAssembler: result := 'tkAssembler';
+    tkAssign: result := 'tkAssign';
+    tkAutomated: result := 'tkAutomated';
+    tkBegin: result := 'tkBegin';
+    tkBadString: result := 'tkBadString';
+    tkBorComment: result := 'tkBorComment';
+    tkCase: result := 'tkCase';
+    tkCdecl: result := 'tkCdecl';
+    tkClass: result := 'tkClass';
+    tkColon: result := 'tkColon';
+    tkComma: result := 'tkComma';
+    tkCompDirect: result := 'tkCompDirect';
+    tkConst: result := 'tkConst';
+    tkConstructor: result := 'tkConstructor';
+    tkCRLF: result := 'tkCRLF';
+    tkCRLFCo: result := 'tkCRLFCo';
+    tkDefault: result := 'tkDefault';
+    tkDestructor: result := 'tkDestructor';
+    tkDispid: result := 'tkDispid';
+    tkDispinterface: result := 'tkDispinterface';
+    tkDiv: result := 'tkDiv';
+    tkDo: result := 'tkDo';
+    tkDoubleAddressOp: result := 'tkDoubleAddressOp';
+    tkDotDot: result := 'tkDotDot';
+    tkDownto: result := 'tkDownto';
+    tkDynamic: result := 'tkDynamic';
+    tkElse: result := 'tkElse';
+    tkEnd: result := 'tkEnd';
+    tkEqual: result := 'tkEqual';
+    tkError: result := 'tkError';
+    tkExcept: result := 'tkExcept';
+    tkExport: result := 'tkExport';
+    tkExports: result := 'tkExports';
+    tkExternal: result := 'tkExternal';
+    tkFar: result := 'tkFar';
+    tkFile: result := 'tkFile';
+    tkFinalization: result := 'tkFinalization';
+    tkFinally: result := 'tkFinally';
+    tkFloat: result := 'tkFloat';
+    tkFor: result := 'tkFor';
+    tkForward: result := 'tkForward';
+    tkFunction: result := 'tkFunction';
+    tkGoto: result := 'tkGoto';
+    tkGreater: result := 'tkGreater';
+    tkGreaterEqual: result := 'tkGreaterEqual';
+    tkIdentifier: result := 'tkIdentifier';
+    tkIf: result := 'tkIf';
+    tkImplementation: result := 'tkImplementation';
+    tkImplements: result := 'tkImplements';
+    tkIn: result := 'tkIn';
+    tkINCLUDE: result := 'tkINCLUDE';
+    tkIndex: result := 'tkIndex';
+    tkInherited: result := 'tkInherited';
+    tkInitialization: result := 'tkInitialization';
+    tkInline: result := 'tkInline';
+    tkInteger: result := 'tkInteger';
+    tkInterface: result := 'tkInterface';
+    tkIs: result := 'tkIs';
+    tkKeyString: result := 'tkKeyString';
+    tkLabel: result := 'tkLabel';
+    tkLibrary: result := 'tkLibrary';
+    tkLower: result := 'tkLower';
+    tkLowerEqual: result := 'tkLowerEqual';
+    tkMessage: result := 'tkMessage';
+    tkMinus: result := 'tkMinus';
+    tkMod: result := 'tkMod';
+    tkName: result := 'tkName';
+    tkNear: result := 'tkNear';
+    tkNil: result := 'tkNil';
+    tkNodefault: result := 'tkNodefault';
+    tkNone: result := 'tkNone';
+    tkNot: result := 'tkNot';
+    tkNotEqual: result := 'tkNotEqual';
+    tkNull: result := 'tkNull';
+    tkNumber: result := 'tkNumber';
+    tkObject: result := 'tkObject';
+    tkOf: result := 'tkOf';
+    tkOn: result := 'tkOn';
+    tkOr: result := 'tkOr';
+    tkOut: result := 'tkOut';
+    tkOverload: result := 'tkOverload';
+    tkOverride: result := 'tkOverride';
+    tkPacked: result := 'tkPacked';
+    tkPascal: result := 'tkPascal';
+    tkPlus: result := 'tkPlus';
+    tkPoint: result := 'tkPoint';
+    tkPointerSymbol: result := 'tkPointerSymbol';
+    tkPrivate: result := 'tkPrivate';
+    tkProcedure: result := 'tkProcedure';
+    tkProgram: result := 'tkProgram';
+    tkProperty: result := 'tkProperty';
+    tkProtected: result := 'tkProtected';
+    tkPublic: result := 'tkPublic';
+    tkPublished: result := 'tkPublished';
+    tkRaise: result := 'tkRaise';
+    tkRead: result := 'tkRead';
+    tkReadonly: result := 'tkReadonly';
+    tkRecord: result := 'tkRecord';
+    tkRegister: result := 'tkRegister';
+    tkReintroduce: result := 'tkReintroduce';
+    tkRepeat: result := 'tkRepeat';
+    tkResident: result := 'tkResident';
+    tkResourcestring: result := 'tkResourcestring';
+    tkRoundClose: result := 'tkRoundClose';
+    tkRoundOpen: result := 'tkRoundOpen';
+    tkSafecall: result := 'tkSafecall';
+    tkSemiColon: result := 'tkSemiColon';
+    tkSet: result := 'tkSet';
+    tkShl: result := 'tkShl';
+    tkShr: result := 'tkShr';
+    tkSlash: result := 'tkSlash';
+    tkSlashesComment: result := 'tkSlashesComment';
+    tkSquareClose: result := 'tkSquareClose';
+    tkSquareOpen: result := 'tkSquareOpen';
+    tkSpace: result := 'tkSpace';
+    tkStar: result := 'tkStar';
+    tkStdcall: result := 'tkStdcall';
+    tkStored: result := 'tkStored';
+    tkString: result := 'tkString';
+    tkStringresource: result := 'tkStringresource';
+    tkSymbol: result := 'tkSymbol';
+    tkThen: result := 'tkThen';
+    tkThreadvar: result := 'tkThreadvar';
+    tkTo: result := 'tkTo';
+    tkTry: result := 'tkTry';
+    tkType: result := 'tkType';
+    tkUnit: result := 'tkUnit';
+    tkUnknown: result := 'tkUnknown';
+    tkUntil: result := 'tkUntil';
+    tkUses: result := 'tkUses';
+    tkVar: result := 'tkVar';
+    tkVirtual: result := 'tkVirtual';
+    tkWhile: result := 'tkWhile';
+    tkWith: result := 'tkWith';
+    tkWrite: result := 'tkWrite';
+    tkWriteonly: result := 'tkWriteonly';
+    tkXor: Result := 'tkXor';
+  end;
+end;
+
+procedure TmwPasLex.IdentProc;
+begin
+  fTokenID:=IdentKind((fOrigin+Run));
+  Inc(Run, fStringLen);
+  while Identifiers[fOrigin[Run]]do Inc(Run);
+end;
+
+procedure TmwPasLex.IntegerProc;
+begin
+  Inc(Run);
+  fTokenID:=tkInteger;
+  while FOrigin[Run]in ['0'..'9', 'A'..'F', 'a'..'f']do Inc(Run);
+end;
+
+procedure TmwPasLex.LFProc;
+begin
+  Case fComment of
+    csBor: fTokenID:=tkCRLFCo;
+    csAnsi: fTokenID:=tkCRLFCo;
+  else fTokenID:=tkCRLF;
+  end;
+  Inc(Run);
+  Inc(fLineNumber);
+  fLinePos:=Run;
+end;
+
+procedure TmwPasLex.LowerProc;
+begin
+  case FOrigin[Run+1]of
+    '=':
+      begin
+        Inc(Run, 2);
+        fTokenID:=tkLowerEqual;
+      end;
+    '>':
+      begin
+        Inc(Run, 2);
+        fTokenID:=tkNotEqual;
+      end
+  else
+    begin
+      Inc(Run);
+      fTokenID:=tkLower;
+    end;
+  end;
+end;
+
+procedure TmwPasLex.MinusProc;
+begin
+  Inc(Run);
+  fTokenID:=tkMinus;
+end;
+
+procedure TmwPasLex.NullProc;
+begin
+  fTokenID:=tkNull;
+end;
+
+procedure TmwPasLex.NumberProc;
+begin
+  Inc(Run);
+  fTokenID:=tkNumber;
+  while FOrigin[Run]in ['0'..'9', '.', 'e', 'E']do
+  begin
+    case FOrigin[Run]of
+      '.':
+        if FOrigin[Run+1]='.' then Break else fTokenID:=tkFloat
+    end;
+    Inc(Run);
+  end;
+end;
+
+procedure TmwPasLex.PlusProc;
+begin
+  Inc(Run);
+  fTokenID:=tkPlus;
+end;
+
+procedure TmwPasLex.PointerSymbolProc;
+begin
+  Inc(Run);
+  fTokenID:=tkPointerSymbol;
+end;
+
+procedure TmwPasLex.PointProc;
+begin
+  case FOrigin[Run+1]of
+    '.':
+      begin
+        Inc(Run, 2);
+        fTokenID:=tkDotDot;
+      end;
+    ')':
+      begin
+        Inc(Run, 2);
+        fTokenID:=tkSquareClose;
+        Dec(FSquareCount);
+      end;
+  else
+    begin
+      Inc(Run);
+      fTokenID:=tkPoint;
+    end;
+  end;
+end;
+
+procedure TmwPasLex.RoundCloseProc;
+begin
+  Inc(Run);
+  fTokenID:=tkRoundClose;
+  Dec(FRoundCount);
+end;
+
+procedure TmwPasLex.AnsiProc;
+begin
+  fTokenID:=tkAnsiComment;
+  case FOrigin[Run]of
+    #0:
+      begin
+        NullProc;
+        Exit;
+      end;
+
+    #10:
+      begin
+        LFProc;
+        Exit;
+      end;
+
+    #13:
+      begin
+        CRProc;
+        Exit;
+      end;
+  end;
+
+  while fOrigin[Run]<>#0 do
+    case fOrigin[Run]of
+      '*':
+        if fOrigin[Run+1]=')' then
+        begin
+          fComment:=csNo;
+          Inc(Run, 2);
+          Break;
+        end else Inc(Run);
+      #10: Break;
+
+      #13: Break;
+    else Inc(Run);
+    end;
+end;
+
+procedure TmwPasLex.RoundOpenProc;
+begin
+  Inc(Run);
+  case fOrigin[Run]of
+    '*':
+      begin
+        fTokenID:=tkAnsiComment;
+        if FOrigin[Run+1]='$' then fTokenID:=tkCompDirect else fComment:=csAnsi;
+        Inc(Run);
+        while fOrigin[Run]<>#0 do
+          case fOrigin[Run]of
+            '*':
+              if fOrigin[Run+1]=')' then
+              begin
+                fComment:=csNo;
+                Inc(Run, 2);
+                Break;
+              end else Inc(Run);
+            #10: Break;
+            #13: Break;
+          else Inc(Run);
+          end;
+      end;
+    '.':
+      begin
+        Inc(Run);
+        fTokenID:=tkSquareOpen;
+        Inc(FSquareCount);
+      end;
+  else
+    begin
+      FTokenID:=tkRoundOpen;
+      Inc(FRoundCount);
+    end;
+  end;
+end;
+
+procedure TmwPasLex.SemiColonProc;
+begin
+  Inc(Run);
+  fTokenID:=tkSemiColon;
+end;
+
+procedure TmwPasLex.SlashProc;
+begin
+  case FOrigin[Run+1]of
+    '/':
+      begin
+        Inc(Run, 2);
+        fTokenID:=tkSlashesComment;
+        while FOrigin[Run]<>#0 do
+        begin
+          case FOrigin[Run]of
+            #10, #13: Break;
+          end;
+          Inc(Run);
+        end;
+      end;
+  else
+    begin
+      Inc(Run);
+      fTokenID:=tkSlash;
+    end;
+  end;
+end;
+
+procedure TmwPasLex.SpaceProc;
+begin
+  Inc(Run);
+  fTokenID:=tkSpace;
+  while FOrigin[Run]in [#1..#9, #11, #12, #14..#32]do Inc(Run);
+end;
+
+procedure TmwPasLex.SquareCloseProc;
+begin
+  Inc(Run);
+  fTokenID:=tkSquareClose;
+  Dec(FSquareCount);
+end;
+
+procedure TmwPasLex.SquareOpenProc;
+begin
+  Inc(Run);
+  fTokenID:=tkSquareOpen;
+  Inc(FSquareCount);
+end;
+
+procedure TmwPasLex.StarProc;
+begin
+  Inc(Run);
+  fTokenID:=tkStar;
+end;
+
+procedure TmwPasLex.StringProc;
+begin
+  fTokenID:=tkString;
+  if(FOrigin[Run+1]=#39)and(FOrigin[Run+2]=#39)then Inc(Run, 2);
+  repeat
+    case FOrigin[Run]of
+      #0, #10, #13: Break;
+    end;
+    Inc(Run);
+  until FOrigin[Run]=#39;
+  if FOrigin[Run]<>#0 then Inc(Run);
+end;
+
+procedure TmwPasLex.SymbolProc;
+begin
+  Inc(Run);
+  fTokenID:=tkSymbol;
+end;
+
+procedure TmwPasLex.UnknownProc;
+begin
+  Inc(Run);
+  fTokenID:=tkUnknown;
+end;
+
+procedure TmwPasLex.Next;
+begin
+  Case fTokenID of
+    tkIdentifier:
+      begin
+        fLastIdentPos:=fTokenPos;
+        fLastNoSpace:=fTokenID;
+        fLastNoSpacePos:=fTokenPos;
+      end;
+    tkSpace: ;
+  else
+    begin
+      fLastNoSpace:=fTokenID;
+      fLastNoSpacePos:=fTokenPos;
+    end;
+  end;
+  fTokenPos:=Run;
+  Case fComment of
+    csNo: fProcTable[fOrigin[Run]];
+  else
+    Case fComment of
+      csBor: BorProc;
+      csAnsi: AnsiProc;
+    end;
+  end;
+end;
+
+function TmwPasLex.GetToken: string;
+var
+  Len: Longint;
+begin
+  Result := '';
+  Len:=Run-fTokenPos;
+  SetString(Result, (FOrigin+fTokenPos), Len);
+end;
+
+procedure TmwPasLex.NextID(ID: TTokenKind);
+begin
+  repeat
+    Case fTokenID of
+      tkNull: Break;
+    else Next;
+    end;
+  until fTokenID=ID;
+end;
+
+procedure TmwPasLex.NextNoJunk;
+begin
+  repeat
+    Next;
+  until not(fTokenID in [tkSlashesComment, tkAnsiComment, tkBorComment, tkCRLF, tkCRLFCo, tkSpace]);
+end;
+
+procedure TmwPasLex.NextClass;
+begin
+  if fTokenID<>tkNull then next;
+  repeat
+    Case fTokenID of
+      tkNull: Break;
+    else Next;
+    end;
+  until(fTokenID=tkClass)and(IsClass);
+end;
+
+initialization
+  MakeIdentTable;
+
+end.
+
+
+
+
+
+
diff --git a/Units/Synapse/asn1util.pas b/Units/Synapse/asn1util.pas
index e0419c7..dc711c7 100644
--- a/Units/Synapse/asn1util.pas
+++ b/Units/Synapse/asn1util.pas
@@ -1,510 +1,510 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 001.004.004 |
-|==============================================================================|
-| Content: support for ASN.1 BER coding and decoding                           |
-|==============================================================================|
-| Copyright (c)1999-2003, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c) 1999-2003                |
-| Portions created by Hernan Sanchez are Copyright (c) 2000.                   |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|   Hernan Sanchez (hernan.sanchez@iname.com)                                  |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{: @abstract(Utilities for handling ASN.1 BER encoding)
-By this unit you can parse ASN.1 BER encoded data to elements or build back any
- elements to ASN.1 BER encoded buffer. You can dump ASN.1 BER encoded data to
- human readable form for easy debugging, too.
-
-Supported element types are: ASN1_BOOL, ASN1_INT, ASN1_OCTSTR, ASN1_NULL,
- ASN1_OBJID, ASN1_ENUM, ASN1_SEQ, ASN1_SETOF, ASN1_IPADDR, ASN1_COUNTER,
- ASN1_GAUGE, ASN1_TIMETICKS, ASN1_OPAQUE
-
-For sample of using, look to @link(TSnmpSend) or @link(TLdapSend)class.
-}
-
-{$Q-}
-{$H+}
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-
-{$IFDEF UNICODE}
-  {$WARN IMPLICIT_STRING_CAST OFF}
-  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
-{$ENDIF}
-
-unit asn1util;
-
-interface
-
-uses
-  SysUtils, Classes, synautil;
-
-const
-  ASN1_BOOL = $01;
-  ASN1_INT = $02;
-  ASN1_OCTSTR = $04;
-  ASN1_NULL = $05;
-  ASN1_OBJID = $06;
-  ASN1_ENUM = $0a;
-  ASN1_SEQ = $30;
-  ASN1_SETOF = $31;
-  ASN1_IPADDR = $40;
-  ASN1_COUNTER = $41;
-  ASN1_GAUGE = $42;
-  ASN1_TIMETICKS = $43;
-  ASN1_OPAQUE = $44;
-
-{:Encodes OID item to binary form.}
-function ASNEncOIDItem(Value: Integer): AnsiString;
-
-{:Decodes an OID item of the next element in the "Buffer" from the "Start"
- position.}
-function ASNDecOIDItem(var Start: Integer; const Buffer: AnsiString): Integer;
-
-{:Encodes the length of ASN.1 element to binary.}
-function ASNEncLen(Len: Integer): AnsiString;
-
-{:Decodes length of next element in "Buffer" from the "Start" position.}
-function ASNDecLen(var Start: Integer; const Buffer: AnsiString): Integer;
-
-{:Encodes a signed integer to ASN.1 binary}
-function ASNEncInt(Value: Integer): AnsiString;
-
-{:Encodes unsigned integer into ASN.1 binary}
-function ASNEncUInt(Value: Integer): AnsiString;
-
-{:Encodes ASN.1 object to binary form.}
-function ASNObject(const Data: AnsiString; ASNType: Integer): AnsiString;
-
-{:Beginning with the "Start" position, decode the ASN.1 item of the next element
- in "Buffer". Type of item is stored in "ValueType."}
-function ASNItem(var Start: Integer; const Buffer: AnsiString;
-  var ValueType: Integer): AnsiString;
-
-{:Encodes an MIB OID string to binary form.}
-function MibToId(Mib: String): AnsiString;
-
-{:Decodes MIB OID from binary form to string form.}
-function IdToMib(const Id: AnsiString): String;
-
-{:Encodes an one number from MIB OID to binary form. (used internally from
-@link(MibToId))}
-function IntMibToStr(const Value: AnsiString): AnsiString;
-
-{:Convert ASN.1 BER encoded buffer to human readable form for debugging.}
-function ASNdump(const Value: AnsiString): AnsiString;
-
-implementation
-
-{==============================================================================}
-function ASNEncOIDItem(Value: Integer): AnsiString;
-var
-  x, xm: Integer;
-  b: Boolean;
-begin
-  x := Value;
-  b := False;
-  Result := '';
-  repeat
-    xm := x mod 128;
-    x := x div 128;
-    if b then
-      xm := xm or $80;
-    if x > 0 then
-      b := True;
-    Result := AnsiChar(xm) + Result;
-  until x = 0;
-end;
-
-{==============================================================================}
-function ASNDecOIDItem(var Start: Integer; const Buffer: AnsiString): Integer;
-var
-  x: Integer;
-  b: Boolean;
-begin
-  Result := 0;
-  repeat
-    Result := Result * 128;
-    x := Ord(Buffer[Start]);
-    Inc(Start);
-    b := x > $7F;
-    x := x and $7F;
-    Result := Result + x;
-  until not b;
-end;
-
-{==============================================================================}
-function ASNEncLen(Len: Integer): AnsiString;
-var
-  x, y: Integer;
-begin
-  if Len < $80 then
-    Result := AnsiChar(Len)
-  else
-  begin
-    x := Len;
-    Result := '';
-    repeat
-      y := x mod 256;
-      x := x div 256;
-      Result := AnsiChar(y) + Result;
-    until x = 0;
-    y := Length(Result);
-    y := y or $80;
-    Result := AnsiChar(y) + Result;
-  end;
-end;
-
-{==============================================================================}
-function ASNDecLen(var Start: Integer; const Buffer: AnsiString): Integer;
-var
-  x, n: Integer;
-begin
-  x := Ord(Buffer[Start]);
-  Inc(Start);
-  if x < $80 then
-    Result := x
-  else
-  begin
-    Result := 0;
-    x := x and $7F;
-    for n := 1 to x do
-    begin
-      Result := Result * 256;
-      x := Ord(Buffer[Start]);
-      Inc(Start);
-      Result := Result + x;
-    end;
-  end;
-end;
-
-{==============================================================================}
-function ASNEncInt(Value: Integer): AnsiString;
-var
-  x, y: Cardinal;
-  neg: Boolean;
-begin
-  neg := Value < 0;
-  x := Abs(Value);
-  if neg then
-    x := not (x - 1);
-  Result := '';
-  repeat
-    y := x mod 256;
-    x := x div 256;
-    Result := AnsiChar(y) + Result;
-  until x = 0;
-  if (not neg) and (Result[1] > #$7F) then
-    Result := #0 + Result;
-end;
-
-{==============================================================================}
-function ASNEncUInt(Value: Integer): AnsiString;
-var
-  x, y: Integer;
-  neg: Boolean;
-begin
-  neg := Value < 0;
-  x := Value;
-  if neg then
-    x := x and $7FFFFFFF;
-  Result := '';
-  repeat
-    y := x mod 256;
-    x := x div 256;
-    Result := AnsiChar(y) + Result;
-  until x = 0;
-  if neg then
-    Result[1] := AnsiChar(Ord(Result[1]) or $80);
-end;
-
-{==============================================================================}
-function ASNObject(const Data: AnsiString; ASNType: Integer): AnsiString;
-begin
-  Result := AnsiChar(ASNType) + ASNEncLen(Length(Data)) + Data;
-end;
-
-{==============================================================================}
-function ASNItem(var Start: Integer; const Buffer: AnsiString;
-  var ValueType: Integer): AnsiString;
-var
-  ASNType: Integer;
-  ASNSize: Integer;
-  y, n: Integer;
-  x: byte;
-  s: AnsiString;
-  c: AnsiChar;
-  neg: Boolean;
-  l: Integer;
-begin
-  Result := '';
-  ValueType := ASN1_NULL;
-  l := Length(Buffer);
-  if l < (Start + 1) then
-    Exit;
-  ASNType := Ord(Buffer[Start]);
-  ValueType := ASNType;
-  Inc(Start);
-  ASNSize := ASNDecLen(Start, Buffer);
-  if (Start + ASNSize - 1) > l then
-    Exit;
-  if (ASNType and $20) > 0 then
-//    Result := '$' + IntToHex(ASNType, 2)
-    Result := Copy(Buffer, Start, ASNSize)
-  else
-    case ASNType of
-      ASN1_INT, ASN1_ENUM, ASN1_BOOL:
-        begin
-          y := 0;
-          neg := False;
-          for n := 1 to ASNSize do
-          begin
-            x := Ord(Buffer[Start]);
-            if (n = 1) and (x > $7F) then
-              neg := True;
-            if neg then
-              x := not x;
-            y := y * 256 + x;
-            Inc(Start);
-          end;
-          if neg then
-            y := -(y + 1);
-          Result := IntToStr(y);
-        end;
-      ASN1_COUNTER, ASN1_GAUGE, ASN1_TIMETICKS:
-        begin
-          y := 0;
-          for n := 1 to ASNSize do
-          begin
-            y := y * 256 + Ord(Buffer[Start]);
-            Inc(Start);
-          end;
-          Result := IntToStr(y);
-        end;
-      ASN1_OCTSTR, ASN1_OPAQUE:
-        begin
-          for n := 1 to ASNSize do
-          begin
-            c := AnsiChar(Buffer[Start]);
-            Inc(Start);
-            s := s + c;
-          end;
-          Result := s;
-        end;
-      ASN1_OBJID:
-        begin
-          for n := 1 to ASNSize do
-          begin
-            c := AnsiChar(Buffer[Start]);
-            Inc(Start);
-            s := s + c;
-          end;
-          Result := IdToMib(s);
-        end;
-      ASN1_IPADDR:
-        begin
-          s := '';
-          for n := 1 to ASNSize do
-          begin
-            if (n <> 1) then
-              s := s + '.';
-            y := Ord(Buffer[Start]);
-            Inc(Start);
-            s := s + IntToStr(y);
-          end;
-          Result := s;
-        end;
-      ASN1_NULL:
-        begin
-          Result := '';
-          Start := Start + ASNSize;
-        end;
-    else // unknown
-      begin
-        for n := 1 to ASNSize do
-        begin
-          c := AnsiChar(Buffer[Start]);
-          Inc(Start);
-          s := s + c;
-        end;
-        Result := s;
-      end;
-    end;
-end;
-
-{==============================================================================}
-function MibToId(Mib: String): AnsiString;
-var
-  x: Integer;
-
-  function WalkInt(var s: String): Integer;
-  var
-    x: Integer;
-    t: AnsiString;
-  begin
-    x := Pos('.', s);
-    if x < 1 then
-    begin
-      t := s;
-      s := '';
-    end
-    else
-    begin
-      t := Copy(s, 1, x - 1);
-      s := Copy(s, x + 1, Length(s) - x);
-    end;
-    Result := StrToIntDef(t, 0);
-  end;
-
-begin
-  Result := '';
-  x := WalkInt(Mib);
-  x := x * 40 + WalkInt(Mib);
-  Result := ASNEncOIDItem(x);
-  while Mib <> '' do
-  begin
-    x := WalkInt(Mib);
-    Result := Result + ASNEncOIDItem(x);
-  end;
-end;
-
-{==============================================================================}
-function IdToMib(const Id: AnsiString): String;
-var
-  x, y, n: Integer;
-begin
-  Result := '';
-  n := 1;
-  while Length(Id) + 1 > n do
-  begin
-    x := ASNDecOIDItem(n, Id);
-    if (n - 1) = 1 then
-    begin
-      y := x div 40;
-      x := x mod 40;
-      Result := IntToStr(y);
-    end;
-    Result := Result + '.' + IntToStr(x);
-  end;
-end;
-
-{==============================================================================}
-function IntMibToStr(const Value: AnsiString): AnsiString;
-var
-  n, y: Integer;
-begin
-  y := 0;
-  for n := 1 to Length(Value) - 1 do
-    y := y * 256 + Ord(Value[n]);
-  Result := IntToStr(y);
-end;
-
-{==============================================================================}
-function ASNdump(const Value: AnsiString): AnsiString;
-var
-  i, at, x, n: integer;
-  s, indent: AnsiString;
-  il: TStringList;
-begin
-  il := TStringList.Create;
-  try
-    Result := '';
-    i := 1;
-    indent := '';
-    while i < Length(Value) do
-    begin
-      for n := il.Count - 1 downto 0 do
-      begin
-        x := StrToIntDef(il[n], 0);
-        if x <= i then
-        begin
-          il.Delete(n);
-          Delete(indent, 1, 2);
-        end;
-      end;
-      s := ASNItem(i, Value, at);
-      Result := Result + indent + '$' + IntToHex(at, 2);
-      if (at and $20) > 0 then
-      begin
-        x := Length(s);
-        Result := Result + ' constructed: length ' + IntToStr(x);
-        indent := indent + '  ';
-        il.Add(IntToStr(x + i - 1));
-      end
-      else
-      begin
-        case at of
-          ASN1_BOOL:
-            Result := Result + ' BOOL: ';
-          ASN1_INT:
-            Result := Result + ' INT: ';
-          ASN1_ENUM:
-            Result := Result + ' ENUM: ';
-          ASN1_COUNTER:
-            Result := Result + ' COUNTER: ';
-          ASN1_GAUGE:
-            Result := Result + ' GAUGE: ';
-          ASN1_TIMETICKS:
-            Result := Result + ' TIMETICKS: ';
-          ASN1_OCTSTR:
-            Result := Result + ' OCTSTR: ';
-          ASN1_OPAQUE:
-            Result := Result + ' OPAQUE: ';
-          ASN1_OBJID:
-            Result := Result + ' OBJID: ';
-          ASN1_IPADDR:
-            Result := Result + ' IPADDR: ';
-          ASN1_NULL:
-            Result := Result + ' NULL: ';
-        else // other
-          Result := Result + ' unknown: ';
-        end;
-        if IsBinaryString(s) then
-          s := DumpExStr(s);
-        Result := Result + s;
-      end;
-      Result := Result + #$0d + #$0a;
-    end;
-  finally
-    il.Free;
-  end;
-end;
-
-{==============================================================================}
-
-end.
+{==============================================================================|
+| Project : Ararat Synapse                                       | 001.004.004 |
+|==============================================================================|
+| Content: support for ASN.1 BER coding and decoding                           |
+|==============================================================================|
+| Copyright (c)1999-2003, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c) 1999-2003                |
+| Portions created by Hernan Sanchez are Copyright (c) 2000.                   |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|   Hernan Sanchez (hernan.sanchez@iname.com)                                  |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{: @abstract(Utilities for handling ASN.1 BER encoding)
+By this unit you can parse ASN.1 BER encoded data to elements or build back any
+ elements to ASN.1 BER encoded buffer. You can dump ASN.1 BER encoded data to
+ human readable form for easy debugging, too.
+
+Supported element types are: ASN1_BOOL, ASN1_INT, ASN1_OCTSTR, ASN1_NULL,
+ ASN1_OBJID, ASN1_ENUM, ASN1_SEQ, ASN1_SETOF, ASN1_IPADDR, ASN1_COUNTER,
+ ASN1_GAUGE, ASN1_TIMETICKS, ASN1_OPAQUE
+
+For sample of using, look to @link(TSnmpSend) or @link(TLdapSend)class.
+}
+
+{$Q-}
+{$H+}
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit asn1util;
+
+interface
+
+uses
+  SysUtils, Classes, synautil;
+
+const
+  ASN1_BOOL = $01;
+  ASN1_INT = $02;
+  ASN1_OCTSTR = $04;
+  ASN1_NULL = $05;
+  ASN1_OBJID = $06;
+  ASN1_ENUM = $0a;
+  ASN1_SEQ = $30;
+  ASN1_SETOF = $31;
+  ASN1_IPADDR = $40;
+  ASN1_COUNTER = $41;
+  ASN1_GAUGE = $42;
+  ASN1_TIMETICKS = $43;
+  ASN1_OPAQUE = $44;
+
+{:Encodes OID item to binary form.}
+function ASNEncOIDItem(Value: Integer): AnsiString;
+
+{:Decodes an OID item of the next element in the "Buffer" from the "Start"
+ position.}
+function ASNDecOIDItem(var Start: Integer; const Buffer: AnsiString): Integer;
+
+{:Encodes the length of ASN.1 element to binary.}
+function ASNEncLen(Len: Integer): AnsiString;
+
+{:Decodes length of next element in "Buffer" from the "Start" position.}
+function ASNDecLen(var Start: Integer; const Buffer: AnsiString): Integer;
+
+{:Encodes a signed integer to ASN.1 binary}
+function ASNEncInt(Value: Integer): AnsiString;
+
+{:Encodes unsigned integer into ASN.1 binary}
+function ASNEncUInt(Value: Integer): AnsiString;
+
+{:Encodes ASN.1 object to binary form.}
+function ASNObject(const Data: AnsiString; ASNType: Integer): AnsiString;
+
+{:Beginning with the "Start" position, decode the ASN.1 item of the next element
+ in "Buffer". Type of item is stored in "ValueType."}
+function ASNItem(var Start: Integer; const Buffer: AnsiString;
+  var ValueType: Integer): AnsiString;
+
+{:Encodes an MIB OID string to binary form.}
+function MibToId(Mib: String): AnsiString;
+
+{:Decodes MIB OID from binary form to string form.}
+function IdToMib(const Id: AnsiString): String;
+
+{:Encodes an one number from MIB OID to binary form. (used internally from
+@link(MibToId))}
+function IntMibToStr(const Value: AnsiString): AnsiString;
+
+{:Convert ASN.1 BER encoded buffer to human readable form for debugging.}
+function ASNdump(const Value: AnsiString): AnsiString;
+
+implementation
+
+{==============================================================================}
+function ASNEncOIDItem(Value: Integer): AnsiString;
+var
+  x, xm: Integer;
+  b: Boolean;
+begin
+  x := Value;
+  b := False;
+  Result := '';
+  repeat
+    xm := x mod 128;
+    x := x div 128;
+    if b then
+      xm := xm or $80;
+    if x > 0 then
+      b := True;
+    Result := AnsiChar(xm) + Result;
+  until x = 0;
+end;
+
+{==============================================================================}
+function ASNDecOIDItem(var Start: Integer; const Buffer: AnsiString): Integer;
+var
+  x: Integer;
+  b: Boolean;
+begin
+  Result := 0;
+  repeat
+    Result := Result * 128;
+    x := Ord(Buffer[Start]);
+    Inc(Start);
+    b := x > $7F;
+    x := x and $7F;
+    Result := Result + x;
+  until not b;
+end;
+
+{==============================================================================}
+function ASNEncLen(Len: Integer): AnsiString;
+var
+  x, y: Integer;
+begin
+  if Len < $80 then
+    Result := AnsiChar(Len)
+  else
+  begin
+    x := Len;
+    Result := '';
+    repeat
+      y := x mod 256;
+      x := x div 256;
+      Result := AnsiChar(y) + Result;
+    until x = 0;
+    y := Length(Result);
+    y := y or $80;
+    Result := AnsiChar(y) + Result;
+  end;
+end;
+
+{==============================================================================}
+function ASNDecLen(var Start: Integer; const Buffer: AnsiString): Integer;
+var
+  x, n: Integer;
+begin
+  x := Ord(Buffer[Start]);
+  Inc(Start);
+  if x < $80 then
+    Result := x
+  else
+  begin
+    Result := 0;
+    x := x and $7F;
+    for n := 1 to x do
+    begin
+      Result := Result * 256;
+      x := Ord(Buffer[Start]);
+      Inc(Start);
+      Result := Result + x;
+    end;
+  end;
+end;
+
+{==============================================================================}
+function ASNEncInt(Value: Integer): AnsiString;
+var
+  x, y: Cardinal;
+  neg: Boolean;
+begin
+  neg := Value < 0;
+  x := Abs(Value);
+  if neg then
+    x := not (x - 1);
+  Result := '';
+  repeat
+    y := x mod 256;
+    x := x div 256;
+    Result := AnsiChar(y) + Result;
+  until x = 0;
+  if (not neg) and (Result[1] > #$7F) then
+    Result := #0 + Result;
+end;
+
+{==============================================================================}
+function ASNEncUInt(Value: Integer): AnsiString;
+var
+  x, y: Integer;
+  neg: Boolean;
+begin
+  neg := Value < 0;
+  x := Value;
+  if neg then
+    x := x and $7FFFFFFF;
+  Result := '';
+  repeat
+    y := x mod 256;
+    x := x div 256;
+    Result := AnsiChar(y) + Result;
+  until x = 0;
+  if neg then
+    Result[1] := AnsiChar(Ord(Result[1]) or $80);
+end;
+
+{==============================================================================}
+function ASNObject(const Data: AnsiString; ASNType: Integer): AnsiString;
+begin
+  Result := AnsiChar(ASNType) + ASNEncLen(Length(Data)) + Data;
+end;
+
+{==============================================================================}
+function ASNItem(var Start: Integer; const Buffer: AnsiString;
+  var ValueType: Integer): AnsiString;
+var
+  ASNType: Integer;
+  ASNSize: Integer;
+  y, n: Integer;
+  x: byte;
+  s: AnsiString;
+  c: AnsiChar;
+  neg: Boolean;
+  l: Integer;
+begin
+  Result := '';
+  ValueType := ASN1_NULL;
+  l := Length(Buffer);
+  if l < (Start + 1) then
+    Exit;
+  ASNType := Ord(Buffer[Start]);
+  ValueType := ASNType;
+  Inc(Start);
+  ASNSize := ASNDecLen(Start, Buffer);
+  if (Start + ASNSize - 1) > l then
+    Exit;
+  if (ASNType and $20) > 0 then
+//    Result := '$' + IntToHex(ASNType, 2)
+    Result := Copy(Buffer, Start, ASNSize)
+  else
+    case ASNType of
+      ASN1_INT, ASN1_ENUM, ASN1_BOOL:
+        begin
+          y := 0;
+          neg := False;
+          for n := 1 to ASNSize do
+          begin
+            x := Ord(Buffer[Start]);
+            if (n = 1) and (x > $7F) then
+              neg := True;
+            if neg then
+              x := not x;
+            y := y * 256 + x;
+            Inc(Start);
+          end;
+          if neg then
+            y := -(y + 1);
+          Result := IntToStr(y);
+        end;
+      ASN1_COUNTER, ASN1_GAUGE, ASN1_TIMETICKS:
+        begin
+          y := 0;
+          for n := 1 to ASNSize do
+          begin
+            y := y * 256 + Ord(Buffer[Start]);
+            Inc(Start);
+          end;
+          Result := IntToStr(y);
+        end;
+      ASN1_OCTSTR, ASN1_OPAQUE:
+        begin
+          for n := 1 to ASNSize do
+          begin
+            c := AnsiChar(Buffer[Start]);
+            Inc(Start);
+            s := s + c;
+          end;
+          Result := s;
+        end;
+      ASN1_OBJID:
+        begin
+          for n := 1 to ASNSize do
+          begin
+            c := AnsiChar(Buffer[Start]);
+            Inc(Start);
+            s := s + c;
+          end;
+          Result := IdToMib(s);
+        end;
+      ASN1_IPADDR:
+        begin
+          s := '';
+          for n := 1 to ASNSize do
+          begin
+            if (n <> 1) then
+              s := s + '.';
+            y := Ord(Buffer[Start]);
+            Inc(Start);
+            s := s + IntToStr(y);
+          end;
+          Result := s;
+        end;
+      ASN1_NULL:
+        begin
+          Result := '';
+          Start := Start + ASNSize;
+        end;
+    else // unknown
+      begin
+        for n := 1 to ASNSize do
+        begin
+          c := AnsiChar(Buffer[Start]);
+          Inc(Start);
+          s := s + c;
+        end;
+        Result := s;
+      end;
+    end;
+end;
+
+{==============================================================================}
+function MibToId(Mib: String): AnsiString;
+var
+  x: Integer;
+
+  function WalkInt(var s: String): Integer;
+  var
+    x: Integer;
+    t: AnsiString;
+  begin
+    x := Pos('.', s);
+    if x < 1 then
+    begin
+      t := s;
+      s := '';
+    end
+    else
+    begin
+      t := Copy(s, 1, x - 1);
+      s := Copy(s, x + 1, Length(s) - x);
+    end;
+    Result := StrToIntDef(t, 0);
+  end;
+
+begin
+  Result := '';
+  x := WalkInt(Mib);
+  x := x * 40 + WalkInt(Mib);
+  Result := ASNEncOIDItem(x);
+  while Mib <> '' do
+  begin
+    x := WalkInt(Mib);
+    Result := Result + ASNEncOIDItem(x);
+  end;
+end;
+
+{==============================================================================}
+function IdToMib(const Id: AnsiString): String;
+var
+  x, y, n: Integer;
+begin
+  Result := '';
+  n := 1;
+  while Length(Id) + 1 > n do
+  begin
+    x := ASNDecOIDItem(n, Id);
+    if (n - 1) = 1 then
+    begin
+      y := x div 40;
+      x := x mod 40;
+      Result := IntToStr(y);
+    end;
+    Result := Result + '.' + IntToStr(x);
+  end;
+end;
+
+{==============================================================================}
+function IntMibToStr(const Value: AnsiString): AnsiString;
+var
+  n, y: Integer;
+begin
+  y := 0;
+  for n := 1 to Length(Value) - 1 do
+    y := y * 256 + Ord(Value[n]);
+  Result := IntToStr(y);
+end;
+
+{==============================================================================}
+function ASNdump(const Value: AnsiString): AnsiString;
+var
+  i, at, x, n: integer;
+  s, indent: AnsiString;
+  il: TStringList;
+begin
+  il := TStringList.Create;
+  try
+    Result := '';
+    i := 1;
+    indent := '';
+    while i < Length(Value) do
+    begin
+      for n := il.Count - 1 downto 0 do
+      begin
+        x := StrToIntDef(il[n], 0);
+        if x <= i then
+        begin
+          il.Delete(n);
+          Delete(indent, 1, 2);
+        end;
+      end;
+      s := ASNItem(i, Value, at);
+      Result := Result + indent + '$' + IntToHex(at, 2);
+      if (at and $20) > 0 then
+      begin
+        x := Length(s);
+        Result := Result + ' constructed: length ' + IntToStr(x);
+        indent := indent + '  ';
+        il.Add(IntToStr(x + i - 1));
+      end
+      else
+      begin
+        case at of
+          ASN1_BOOL:
+            Result := Result + ' BOOL: ';
+          ASN1_INT:
+            Result := Result + ' INT: ';
+          ASN1_ENUM:
+            Result := Result + ' ENUM: ';
+          ASN1_COUNTER:
+            Result := Result + ' COUNTER: ';
+          ASN1_GAUGE:
+            Result := Result + ' GAUGE: ';
+          ASN1_TIMETICKS:
+            Result := Result + ' TIMETICKS: ';
+          ASN1_OCTSTR:
+            Result := Result + ' OCTSTR: ';
+          ASN1_OPAQUE:
+            Result := Result + ' OPAQUE: ';
+          ASN1_OBJID:
+            Result := Result + ' OBJID: ';
+          ASN1_IPADDR:
+            Result := Result + ' IPADDR: ';
+          ASN1_NULL:
+            Result := Result + ' NULL: ';
+        else // other
+          Result := Result + ' unknown: ';
+        end;
+        if IsBinaryString(s) then
+          s := DumpExStr(s);
+        Result := Result + s;
+      end;
+      Result := Result + #$0d + #$0a;
+    end;
+  finally
+    il.Free;
+  end;
+end;
+
+{==============================================================================}
+
+end.
diff --git a/Units/Synapse/blcksock.pas b/Units/Synapse/blcksock.pas
index 5f41f02..c475a56 100644
--- a/Units/Synapse/blcksock.pas
+++ b/Units/Synapse/blcksock.pas
@@ -1,4261 +1,4261 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 009.008.002 |
-|==============================================================================|
-| Content: Library base                                                        |
-|==============================================================================|
-| Copyright (c)1999-2010, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)1999-2010.                |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{
-Special thanks to Gregor Ibic <gregor.ibic@intelicom.si>
- (Intelicom d.o.o., http://www.intelicom.si)
- for good inspiration about SSL programming.
-}
-
-{$DEFINE ONCEWINSOCK}
-{Note about define ONCEWINSOCK:
-If you remove this compiler directive, then socket interface is loaded and
-initialized on constructor of TBlockSocket class for each socket separately.
-Socket interface is used only if your need it.
-
-If you leave this directive here, then socket interface is loaded and
-initialized only once at start of your program! It boost performace on high
-count of created and destroyed sockets. It eliminate possible small resource
-leak on Windows systems too.
-}
-
-//{$DEFINE RAISEEXCEPT}
-{When you enable this define, then is Raiseexcept property is on by default
-}
-
-{:@abstract(Synapse's library core)
-
-Core with implementation basic socket classes.
-}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$IFDEF VER125}
-  {$DEFINE BCB}
-{$ENDIF}
-{$IFDEF BCB}
-  {$ObjExportAll On}
-{$ENDIF}
-{$Q-}
-{$H+}
-{$M+}
-
-//old Delphi does not have MSWINDOWS define.
-{$IFDEF WIN32}
-  {$IFNDEF MSWINDOWS}
-    {$DEFINE MSWINDOWS}
-  {$ENDIF}
-{$ENDIF}
-
-{$IFDEF UNICODE}
-  {$WARN IMPLICIT_STRING_CAST OFF}
-  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
-{$ENDIF}
-
-unit blcksock;
-
-interface
-
-uses
-  SysUtils, Classes,
-  synafpc,
-  synsock, synautil, synacode, synaip
-{$IFDEF CIL}
-  ,System.Net
-  ,System.Net.Sockets
-  ,System.Text
-{$ENDIF}
-  ;
-
-const
-
-  SynapseRelease = '38';
-
-  cLocalhost = '127.0.0.1';
-  cAnyHost = '0.0.0.0';
-  cBroadcast = '255.255.255.255';
-  c6Localhost = '::1';
-  c6AnyHost = '::0';
-  c6Broadcast = 'ffff::1';
-  cAnyPort = '0';
-  CR = #$0d;
-  LF = #$0a;
-  CRLF = CR + LF;
-  c64k = 65536;
-
-type
-
-  {:@abstract(Exception clas used by Synapse)
-   When you enable generating of exceptions, this exception is raised by
-   Synapse's units.}
-  ESynapseError = class(Exception)
-  private
-    FErrorCode: Integer;
-    FErrorMessage: string;
-  published
-    {:Code of error. Value depending on used operating system}
-    property ErrorCode: Integer read FErrorCode Write FErrorCode;
-    {:Human readable description of error.}
-    property ErrorMessage: string read FErrorMessage Write FErrorMessage;
-  end;
-
-  {:Types of OnStatus events}
-  THookSocketReason = (
-    {:Resolving is begin. Resolved IP and port is in parameter in format like:
-     'localhost.somewhere.com:25'.}
-    HR_ResolvingBegin,
-    {:Resolving is done. Resolved IP and port is in parameter in format like:
-     'localhost.somewhere.com:25'. It is always same as in HR_ResolvingBegin!}
-    HR_ResolvingEnd,
-    {:Socket created by CreateSocket method. It reporting Family of created
-     socket too!}
-    HR_SocketCreate,
-    {:Socket closed by CloseSocket method.}
-    HR_SocketClose,
-    {:Socket binded to IP and Port. Binded IP and Port is in parameter in format
-     like: 'localhost.somewhere.com:25'.}
-    HR_Bind,
-    {:Socket connected to IP and Port. Connected IP and Port is in parameter in
-     format like: 'localhost.somewhere.com:25'.}
-    HR_Connect,
-    {:Called when CanRead method is used with @True result.}
-    HR_CanRead,
-    {:Called when CanWrite method is used with @True result.}
-    HR_CanWrite,
-    {:Socket is swithed to Listen mode. (TCP socket only)}
-    HR_Listen,
-    {:Socket Accepting client connection. (TCP socket only)}
-    HR_Accept,
-    {:report count of bytes readed from socket. Number is in parameter string.
-     If you need is in integer, you must use StrToInt function!}
-    HR_ReadCount,
-    {:report count of bytes writed to socket. Number is in parameter string. If
-     you need is in integer, you must use StrToInt function!}
-    HR_WriteCount,
-    {:If is limiting of bandwidth on, then this reason is called when sending or
-     receiving is stopped for satisfy bandwidth limit. Parameter is count of
-     waiting milliseconds.}
-    HR_Wait,
-    {:report situation where communication error occured. When raiseexcept is
-     @true, then exception is called after this Hook reason.}
-    HR_Error
-    );
-
-  {:Procedural type for OnStatus event. Sender is calling TBlockSocket object,
-   Reason is one of set Status events and value is optional data.}
-  THookSocketStatus = procedure(Sender: TObject; Reason: THookSocketReason;
-    const Value: String) of object;
-
-  {:This procedural type is used for DataFilter hooks.}
-  THookDataFilter = procedure(Sender: TObject; var Value: AnsiString) of object;
-
-  {:This procedural type is used for hook OnCreateSocket. By this hook you can
-   insert your code after initialisation of socket. (you can set special socket
-   options, etc.)}
-  THookCreateSocket = procedure(Sender: TObject) of object;
-
-  {:This procedural type is used for monitoring of communication.}
-  THookMonitor = procedure(Sender: TObject; Writing: Boolean;
-    const Buffer: TMemory; Len: Integer) of object;
-
-  {:This procedural type is used for hook OnAfterConnect. By this hook you can
-   insert your code after TCP socket has been sucessfully connected.}
-  THookAfterConnect = procedure(Sender: TObject) of object;
-
-  {:This procedural type is used for hook OnHeartbeat. By this hook you can
-   call your code repeately during long socket operations.
-   You must enable heartbeats by @Link(HeartbeatRate) property!}
-  THookHeartbeat = procedure(Sender: TObject) of object;
-
-  {:Specify family of socket.}
-  TSocketFamily = (
-    {:Default mode. Socket family is defined by target address for connection.
-     It allows instant access to IPv4 and IPv6 nodes. When you need IPv6 address
-     as destination, then is used IPv6 mode. othervise is used IPv4 mode.
-     However this mode not working properly with preliminary IPv6 supports!}
-    SF_Any,
-    {:Turn this class to pure IPv4 mode. This mode is totally compatible with
-     previous Synapse releases.}
-    SF_IP4,
-    {:Turn to only IPv6 mode.}
-    SF_IP6
-    );
-
-  {:specify possible values of SOCKS modes.}
-  TSocksType = (
-    ST_Socks5,
-    ST_Socks4
-    );
-
-  {:Specify requested SSL/TLS version for secure connection.}
-  TSSLType = (
-    LT_all,
-    LT_SSLv2,
-    LT_SSLv3,
-    LT_TLSv1,
-    LT_TLSv1_1,
-    LT_SSHv2
-    );
-
-  {:Specify type of socket delayed option.}
-  TSynaOptionType = (
-    SOT_Linger,
-    SOT_RecvBuff,
-    SOT_SendBuff,
-    SOT_NonBlock,
-    SOT_RecvTimeout,
-    SOT_SendTimeout,
-    SOT_Reuse,
-    SOT_TTL,
-    SOT_Broadcast,
-    SOT_MulticastTTL,
-    SOT_MulticastLoop
-    );
-
-  {:@abstract(this object is used for remember delayed socket option set.)}
-  TSynaOption = class(TObject)
-  public
-    Option: TSynaOptionType;
-    Enabled: Boolean;
-    Value: Integer;
-  end;
-
-  TCustomSSL = class;
-  TSSLClass = class of TCustomSSL;
-
-  {:@abstract(Basic IP object.)
-   This is parent class for other class with protocol implementations. Do not
-   use this class directly! Use @link(TICMPBlockSocket), @link(TRAWBlockSocket),
-   @link(TTCPBlockSocket) or @link(TUDPBlockSocket) instead.}
-  TBlockSocket = class(TObject)
-  private
-    FOnStatus: THookSocketStatus;
-    FOnReadFilter: THookDataFilter;
-    FOnCreateSocket: THookCreateSocket;
-    FOnMonitor: THookMonitor;
-    FOnHeartbeat: THookHeartbeat;
-    FLocalSin: TVarSin;
-    FRemoteSin: TVarSin;
-    FTag: integer;
-    FBuffer: AnsiString;
-    FRaiseExcept: Boolean;
-    FNonBlockMode: Boolean;
-    FMaxLineLength: Integer;
-    FMaxSendBandwidth: Integer;
-    FNextSend: LongWord;
-    FMaxRecvBandwidth: Integer;
-    FNextRecv: LongWord;
-    FConvertLineEnd: Boolean;
-    FLastCR: Boolean;
-    FLastLF: Boolean;
-    FBinded: Boolean;
-    FFamily: TSocketFamily;
-    FFamilySave: TSocketFamily;
-    FIP6used: Boolean;
-    FPreferIP4: Boolean;
-    FDelayedOptions: TList;
-    FInterPacketTimeout: Boolean;
-    {$IFNDEF CIL}
-    FFDSet: TFDSet;
-    {$ENDIF}
-    FRecvCounter: Integer;
-    FSendCounter: Integer;
-    FSendMaxChunk: Integer;
-    FStopFlag: Boolean;
-    FNonblockSendTimeout: Integer;
-    FHeartbeatRate: integer;
-    function GetSizeRecvBuffer: Integer;
-    procedure SetSizeRecvBuffer(Size: Integer);
-    function GetSizeSendBuffer: Integer;
-    procedure SetSizeSendBuffer(Size: Integer);
-    procedure SetNonBlockMode(Value: Boolean);
-    procedure SetTTL(TTL: integer);
-    function GetTTL:integer;
-    procedure SetFamily(Value: TSocketFamily); virtual;
-    procedure SetSocket(Value: TSocket); virtual;
-    function GetWsaData: TWSAData;
-    function FamilyToAF(f: TSocketFamily): TAddrFamily;
-  protected
-    FSocket: TSocket;
-    FLastError: Integer;
-    FLastErrorDesc: string;
-    FOwner: TObject;
-    procedure SetDelayedOption(const Value: TSynaOption);
-    procedure DelayedOption(const Value: TSynaOption);
-    procedure ProcessDelayedOptions;
-    procedure InternalCreateSocket(Sin: TVarSin);
-    procedure SetSin(var Sin: TVarSin; IP, Port: string);
-    function GetSinIP(Sin: TVarSin): string;
-    function GetSinPort(Sin: TVarSin): Integer;
-    procedure DoStatus(Reason: THookSocketReason; const Value: string);
-    procedure DoReadFilter(Buffer: TMemory; var Len: Integer);
-    procedure DoMonitor(Writing: Boolean; const Buffer: TMemory; Len: Integer);
-    procedure DoCreateSocket;
-    procedure DoHeartbeat;
-    procedure LimitBandwidth(Length: Integer; MaxB: integer; var Next: LongWord);
-    procedure SetBandwidth(Value: Integer);
-    function TestStopFlag: Boolean;
-    procedure InternalSendStream(const Stream: TStream; WithSize, Indy: boolean); virtual;
-    function InternalCanRead(Timeout: Integer): Boolean; virtual;
-  public
-    constructor Create;
-
-    {:Create object and load all necessary socket library. What library is
-     loaded is described by STUB parameter. If STUB is empty string, then is
-     loaded default libraries.}
-    constructor CreateAlternate(Stub: string);
-    destructor Destroy; override;
-
-    {:If @link(family) is not SF_Any, then create socket with type defined in
-     @link(Family) property. If family is SF_Any, then do nothing! (socket is
-     created automaticly when you know what type of socket you need to create.
-     (i.e. inside @link(Connect) or @link(Bind) call.) When socket is created,
-     then is aplyed all stored delayed socket options.}
-    procedure CreateSocket;
-
-    {:It create socket. Address resolving of Value tells what type of socket is
-     created. If Value is resolved as IPv4 IP, then is created IPv4 socket. If
-     value is resolved as IPv6 address, then is created IPv6 socket.}
-    procedure CreateSocketByName(const Value: String);
-
-    {:Destroy socket in use. This method is also automatically called from
-     object destructor.}
-    procedure CloseSocket; virtual;
-
-    {:Abort any work on Socket and destroy them.}
-    procedure AbortSocket; virtual;
-
-    {:Connects socket to local IP address and PORT. IP address may be numeric or
-     symbolic ('192.168.74.50', 'cosi.nekde.cz', 'ff08::1'). The same for PORT
-     - it may be number or mnemonic port ('23', 'telnet').
-
-     If port value is '0', system chooses itself and conects unused port in the
-     range 1024 to 4096 (this depending by operating system!). Structure
-     LocalSin is filled after calling this method.
-
-     Note: If you call this on non-created socket, then socket is created
-     automaticly.
-
-     Warning: when you call : Bind('0.0.0.0','0'); then is nothing done! In this
-     case is used implicit system bind instead.}
-    procedure Bind(IP, Port: string);
-
-    {:Connects socket to remote IP address and PORT. The same rules as with
-     @link(BIND) method are valid. The only exception is that PORT with 0 value
-     will not be connected!
-
-     Structures LocalSin and RemoteSin will be filled with valid values.
-
-     When you call this on non-created socket, then socket is created
-     automaticly. Type of created socket is by @link(Family) property. If is
-     used SF_IP4, then is created socket for IPv4. If is used SF_IP6, then is
-     created socket for IPv6. When you have family on SF_Any (default!), then
-     type of created socket is determined by address resolving of destination
-     address. (Not work properly on prilimitary winsock IPv6 support!)}
-    procedure Connect(IP, Port: string); virtual;
-
-    {:Sets socket to receive mode for new incoming connections. It is necessary
-     to use @link(TBlockSocket.BIND) function call before this method to select
-     receiving port!}
-    procedure Listen; virtual;
-
-    {:Waits until new incoming connection comes. After it comes a new socket is
-     automatically created (socket handler is returned by this function as
-     result).}
-    function Accept: TSocket; virtual;
-
-    {:Sends data of LENGTH from BUFFER address via connected socket. System
-     automatically splits data to packets.}
-    function SendBuffer(Buffer: Tmemory; Length: Integer): Integer; virtual;
-
-    {:One data BYTE is sent via connected socket.}
-    procedure SendByte(Data: Byte); virtual;
-
-    {:Send data string via connected socket. Any terminator is not added! If you
-     need send true string with CR-LF termination, you must add CR-LF characters
-     to sended string! Because any termination is not added automaticly, you can
-     use this function for sending any binary data in binary string.}
-    procedure SendString(Data: AnsiString); virtual;
-
-    {:Send integer as four bytes to socket.}
-    procedure SendInteger(Data: integer); virtual;
-
-    {:Send data as one block to socket. Each block begin with 4 bytes with
-     length of data in block. This 4 bytes is added automaticly by this
-     function.}
-    procedure SendBlock(const Data: AnsiString); virtual;
-
-    {:Send data from stream to socket.}
-    procedure SendStreamRaw(const Stream: TStream); virtual;
-
-    {:Send content of stream to socket. It using @link(SendBlock) method}
-    procedure SendStream(const Stream: TStream); virtual;
-
-    {:Send content of stream to socket. It using @link(SendBlock) method and
-    this is compatible with streams in Indy library.}
-    procedure SendStreamIndy(const Stream: TStream); virtual;
-
-    {:Note: This is low-level receive function. You must be sure if data is
-     waiting for read before call this function for avoid deadlock!
-
-     Waits until allocated buffer is filled by received data. Returns number of
-     data received, which equals to LENGTH value under normal operation. If it
-     is not equal the communication channel is possibly broken.
-
-     On stream oriented sockets if is received 0 bytes, it mean 'socket is
-     closed!"
-
-     On datagram socket is readed first waiting datagram.}
-    function RecvBuffer(Buffer: TMemory; Length: Integer): Integer; virtual;
-
-    {:Note: This is high-level receive function. It using internal
-     @link(LineBuffer) and you can combine this function freely with other
-     high-level functions!
-
-     Method waits until data is received. If no data is received within TIMEOUT
-     (in milliseconds) period, @link(LastError) is set to WSAETIMEDOUT. Methods
-     serves for reading any size of data (i.e. one megabyte...). This method is
-     preffered for reading from stream sockets (like TCP).}
-    function RecvBufferEx(Buffer: Tmemory; Len: Integer;
-      Timeout: Integer): Integer; virtual;
-
-    {:Similar to @link(RecvBufferEx), but readed data is stored in binary
-     string, not in memory buffer.}
-    function RecvBufferStr(Len: Integer; Timeout: Integer): AnsiString; virtual;
-
-    {:Note: This is high-level receive function. It using internal
-     @link(LineBuffer) and you can combine this function freely with other
-     high-level functions.
-
-     Waits until one data byte is received which is also returned as function
-     result. If no data is received within TIMEOUT (in milliseconds)period,
-     @link(LastError) is set to WSAETIMEDOUT and result have value 0.}
-    function RecvByte(Timeout: Integer): Byte; virtual;
-
-    {:Note: This is high-level receive function. It using internal
-     @link(LineBuffer) and you can combine this function freely with other
-     high-level functions.
-
-     Waits until one four bytes are received and return it as one Ineger Value.
-     If no data is received within TIMEOUT (in milliseconds)period,
-     @link(LastError) is set to WSAETIMEDOUT and result have value 0.}
-    function RecvInteger(Timeout: Integer): Integer; virtual;
-
-    {:Note: This is high-level receive function. It using internal
-     @link(LineBuffer) and you can combine this function freely with other
-     high-level functions.
-
-     Method waits until data string is received. This string is terminated by
-     CR-LF characters. The resulting string is returned without this termination
-     (CR-LF)! If @link(ConvertLineEnd) is used, then CR-LF sequence may not be
-     exactly CR-LF. See @link(ConvertLineEnd) description. If no data is
-     received within TIMEOUT (in milliseconds) period, @link(LastError) is set
-     to WSAETIMEDOUT. You may also specify maximum length of reading data by
-     @link(MaxLineLength) property.}
-    function RecvString(Timeout: Integer): AnsiString; virtual;
-
-    {:Note: This is high-level receive function. It using internal
-     @link(LineBuffer) and you can combine this function freely with other
-     high-level functions.
-
-     Method waits until data string is received. This string is terminated by
-     Terminator string. The resulting string is returned without this
-     termination. If no data is received within TIMEOUT (in milliseconds)
-     period, @link(LastError) is set to WSAETIMEDOUT. You may also specify
-     maximum length of reading data by @link(MaxLineLength) property.}
-    function RecvTerminated(Timeout: Integer; const Terminator: AnsiString): AnsiString; virtual;
-
-    {:Note: This is high-level receive function. It using internal
-     @link(LineBuffer) and you can combine this function freely with other
-     high-level functions.
-
-     Method reads all data waiting for read. If no data is received within
-     TIMEOUT (in milliseconds) period, @link(LastError) is set to WSAETIMEDOUT.
-     Methods serves for reading unknown size of data. Because before call this
-     function you don't know size of received data, returned data is stored in
-     dynamic size binary string. This method is preffered for reading from
-     stream sockets (like TCP). It is very goot for receiving datagrams too!
-     (UDP protocol)}
-    function RecvPacket(Timeout: Integer): AnsiString; virtual;
-
-    {:Read one block of data from socket. Each block begin with 4 bytes with
-     length of data in block. This function read first 4 bytes for get lenght,
-     then it wait for reported count of bytes.}
-    function RecvBlock(Timeout: Integer): AnsiString; virtual;
-
-    {:Read all data from socket to stream until socket is closed (or any error
-     occured.)}
-    procedure RecvStreamRaw(const Stream: TStream; Timeout: Integer); virtual;
-    {:Read requested count of bytes from socket to stream.}
-    procedure RecvStreamSize(const Stream: TStream; Timeout: Integer; Size: Integer);
-
-    {:Receive data to stream. It using @link(RecvBlock) method.}
-    procedure RecvStream(const Stream: TStream; Timeout: Integer); virtual;
-
-    {:Receive data to stream. This function is compatible with similar function
-    in Indy library. It using @link(RecvBlock) method.}
-    procedure RecvStreamIndy(const Stream: TStream; Timeout: Integer); virtual;
-
-    {:Same as @link(RecvBuffer), but readed data stays in system input buffer.
-    Warning: this function not respect data in @link(LineBuffer)! Is not
-    recommended to use this function!}
-    function PeekBuffer(Buffer: TMemory; Length: Integer): Integer; virtual;
-
-    {:Same as @link(RecvByte), but readed data stays in input system buffer.
-     Warning: this function not respect data in @link(LineBuffer)! Is not
-    recommended to use this function!}
-    function PeekByte(Timeout: Integer): Byte; virtual;
-
-    {:On stream sockets it returns number of received bytes waiting for picking.
-     0 is returned when there is no such data. On datagram socket it returns
-     length of the first waiting datagram. Returns 0 if no datagram is waiting.}
-    function WaitingData: Integer; virtual;
-
-    {:Same as @link(WaitingData), but if exists some of data in @link(Linebuffer),
-     return their length instead.}
-    function WaitingDataEx: Integer;
-
-    {:Clear all waiting data for read from buffers.}
-    procedure Purge;
-
-    {:Sets linger. Enabled linger means that the system waits another LINGER
-     (in milliseconds) time for delivery of sent data. This function is only for
-     stream type of socket! (TCP)}
-    procedure SetLinger(Enable: Boolean; Linger: Integer);
-
-    {:Actualize values in @link(LocalSin).}
-    procedure GetSinLocal;
-
-    {:Actualize values in @link(RemoteSin).}
-    procedure GetSinRemote;
-
-    {:Actualize values in @link(LocalSin) and @link(RemoteSin).}
-    procedure GetSins;
-
-    {:Reset @link(LastError) and @link(LastErrorDesc) to non-error state.}
-    procedure ResetLastError;
-
-    {:If you "manually" call Socket API functions, forward their return code as
-     parameter to this function, which evaluates it, eventually calls
-     GetLastError and found error code returns and stores to @link(LastError).}
-    function SockCheck(SockResult: Integer): Integer; virtual;
-
-    {:If @link(LastError) contains some error code and @link(RaiseExcept)
-     property is @true, raise adequate exception.}
-    procedure ExceptCheck;
-
-    {:Returns local computer name as numerical or symbolic value. It try get
-     fully qualified domain name. Name is returned in the format acceptable by
-     functions demanding IP as input parameter.}
-    function LocalName: string;
-
-    {:Try resolve name to all possible IP address. i.e. If you pass as name
-     result of @link(LocalName) method, you get all IP addresses used by local
-     system.}
-    procedure ResolveNameToIP(Name: string; const IPList: TStrings);
-
-    {:Try resolve name to primary IP address. i.e. If you pass as name result of
-     @link(LocalName) method, you get primary IP addresses used by local system.}
-    function ResolveName(Name: string): string;
-
-    {:Try resolve IP to their primary domain name. If IP not have domain name,
-     then is returned original IP.}
-    function ResolveIPToName(IP: string): string;
-
-    {:Try resolve symbolic port name to port number. (i.e. 'Echo' to 8)}
-    function ResolvePort(Port: string): Word;
-
-    {:Set information about remote side socket. It is good for seting remote
-     side for sending UDP packet, etc.}
-    procedure SetRemoteSin(IP, Port: string);
-
-    {:Picks IP socket address from @link(LocalSin).}
-    function GetLocalSinIP: string; virtual;
-
-    {:Picks IP socket address from @link(RemoteSin).}
-    function GetRemoteSinIP: string; virtual;
-
-    {:Picks socket PORT number from @link(LocalSin).}
-    function GetLocalSinPort: Integer; virtual;
-
-    {:Picks socket PORT number from @link(RemoteSin).}
-    function GetRemoteSinPort: Integer; virtual;
-
-    {:Return @TRUE, if you can read any data from socket or is incoming
-     connection on TCP based socket. Status is tested for time Timeout (in
-     milliseconds). If value in Timeout is 0, status is only tested and
-     continue. If value in Timeout is -1, run is breaked and waiting for read
-     data maybe forever.
-
-     This function is need only on special cases, when you need use
-     @link(RecvBuffer) function directly! read functioms what have timeout as
-     calling parameter, calling this function internally.}
-    function CanRead(Timeout: Integer): Boolean; virtual;
-
-    {:Same as @link(CanRead), but additionally return @TRUE if is some data in
-     @link(LineBuffer).}
-    function CanReadEx(Timeout: Integer): Boolean; virtual;
-
-    {:Return @TRUE, if you can to socket write any data (not full sending
-     buffer). Status is tested for time Timeout (in milliseconds). If value in
-     Timeout is 0, status is only tested and continue. If value in Timeout is
-     -1, run is breaked and waiting for write data maybe forever.
-
-     This function is need only on special cases!}
-    function CanWrite(Timeout: Integer): Boolean; virtual;
-
-    {:Same as @link(SendBuffer), but send datagram to address from
-     @link(RemoteSin). Usefull for sending reply to datagram received by
-     function @link(RecvBufferFrom).}
-    function SendBufferTo(Buffer: TMemory; Length: Integer): Integer; virtual;
-
-    {:Note: This is low-lever receive function. You must be sure if data is
-     waiting for read before call this function for avoid deadlock!
-
-     Receives first waiting datagram to allocated buffer. If there is no waiting
-     one, then waits until one comes. Returns length of datagram stored in
-     BUFFER. If length exceeds buffer datagram is truncated. After this
-     @link(RemoteSin) structure contains information about sender of UDP packet.}
-    function RecvBufferFrom(Buffer: TMemory; Length: Integer): Integer; virtual;
-{$IFNDEF CIL}
-    {:This function is for check for incoming data on set of sockets. Whitch
-    sockets is checked is decribed by SocketList Tlist with TBlockSocket
-    objects. TList may have maximal number of objects defined by FD_SETSIZE
-    constant. Return @TRUE, if you can from some socket read any data or is
-    incoming connection on TCP based socket. Status is tested for time Timeout
-    (in milliseconds). If value in Timeout is 0, status is only tested and
-    continue. If value in Timeout is -1, run is breaked and waiting for read
-    data maybe forever. If is returned @TRUE, CanReadList TList is filled by all
-    TBlockSocket objects what waiting for read.}
-    function GroupCanRead(const SocketList: TList; Timeout: Integer;
-      const CanReadList: TList): Boolean;
-{$ENDIF}
-    {:By this method you may turn address reuse mode for local @link(bind). It
-     is good specially for UDP protocol. Using this with TCP protocol is
-     hazardous!}
-    procedure EnableReuse(Value: Boolean);
-
-    {:Try set timeout for all sending and receiving operations, if socket
-     provider can do it. (It not supported by all socket providers!)}
-    procedure SetTimeout(Timeout: Integer);
-
-    {:Try set timeout for all sending operations, if socket provider can do it.
-     (It not supported by all socket providers!)}
-    procedure SetSendTimeout(Timeout: Integer);
-
-    {:Try set timeout for all receiving operations, if socket provider can do
-     it. (It not supported by all socket providers!)}
-    procedure SetRecvTimeout(Timeout: Integer);
-
-    {:Return value of socket type.}
-    function GetSocketType: integer; Virtual;
-
-    {:Return value of protocol type for socket creation.}
-    function GetSocketProtocol: integer; Virtual;
-
-    {:WSA structure with information about socket provider. On non-windows 
-     platforms this structure is simulated!}
-    property WSAData: TWSADATA read GetWsaData;
-
-    {:FDset structure prepared for usage with this socket.}
-    property FDset: TFDSet read FFDset;
-
-    {:Structure describing local socket side.}
-    property LocalSin: TVarSin read FLocalSin write FLocalSin;
-
-    {:Structure describing remote socket side.}
-    property RemoteSin: TVarSin read FRemoteSin write FRemoteSin;
-
-    {:Socket handler. Suitable for "manual" calls to socket API or manual
-     connection of socket to a previously created socket (i.e by Accept method
-     on TCP socket)}
-    property Socket: TSocket read FSocket write SetSocket;
-
-    {:Last socket operation error code. Error codes are described in socket
-     documentation. Human readable error description is stored in
-     @link(LastErrorDesc) property.}
-    property LastError: Integer read FLastError;
-
-    {:Human readable error description of @link(LastError) code.}
-    property LastErrorDesc: string read FLastErrorDesc;
-
-    {:Buffer used by all high-level receiving functions. This buffer is used for
-     optimized reading of data from socket. In normal cases you not need access
-     to this buffer directly!}
-    property LineBuffer: AnsiString read FBuffer write FBuffer;
-
-    {:Size of Winsock receive buffer. If it is not supported by socket provider,
-     it return as size one kilobyte.}
-    property SizeRecvBuffer: Integer read GetSizeRecvBuffer write SetSizeRecvBuffer;
-
-    {:Size of Winsock send buffer. If it is not supported by socket provider, it
-     return as size one kilobyte.}
-    property SizeSendBuffer: Integer read GetSizeSendBuffer write SetSizeSendBuffer;
-
-    {:If @True, turn class to non-blocking mode. Not all functions are working
-     properly in this mode, you must know exactly what you are doing! However
-     when you have big experience with non-blocking programming, then you can
-     optimise your program by non-block mode!}
-    property NonBlockMode: Boolean read FNonBlockMode Write SetNonBlockMode;
-
-    {:Set Time-to-live value. (if system supporting it!)}
-    property TTL: Integer read GetTTL Write SetTTL;
-
-    {:If is @true, then class in in IPv6 mode.}
-    property IP6used: Boolean read FIP6used;
-
-    {:Return count of received bytes on this socket from begin of current
-     connection.}
-    property RecvCounter: Integer read FRecvCounter;
-
-    {:Return count of sended bytes on this socket from begin of current
-     connection.}
-    property SendCounter: Integer read FSendCounter;
-  published
-    {:Return descriptive string for given error code. This is class function.
-     You may call it without created object!}
-    class function GetErrorDesc(ErrorCode: Integer): string;
-
-    {:Return descriptive string for @link(LastError).}
-    function GetErrorDescEx: string; virtual;
-
-    {:this value is for free use.}
-    property Tag: Integer read FTag write FTag;
-
-    {:If @true, winsock errors raises exception. Otherwise is setted
-    @link(LastError) value only and you must check it from your program! Default
-    value is @false.}
-    property RaiseExcept: Boolean read FRaiseExcept write FRaiseExcept;
-
-    {:Define maximum length in bytes of @link(LineBuffer) for high-level
-     receiving functions. If this functions try to read more data then this
-     limit, error is returned! If value is 0 (default), no limitation is used.
-     This is very good protection for stupid attacks to your server by sending
-     lot of data without proper terminator... until all your memory is allocated
-     by LineBuffer!
-
-     Note: This maximum length is checked only in functions, what read unknown
-     number of bytes! (like @link(RecvString) or @link(RecvTerminated))}
-    property MaxLineLength: Integer read FMaxLineLength Write FMaxLineLength;
-
-    {:Define maximal bandwidth for all sending operations in bytes per second.
-     If value is 0 (default), bandwidth limitation is not used.}
-    property MaxSendBandwidth: Integer read FMaxSendBandwidth Write FMaxSendBandwidth;
-
-    {:Define maximal bandwidth for all receiving operations in bytes per second.
-     If value is 0 (default), bandwidth limitation is not used.}
-    property MaxRecvBandwidth: Integer read FMaxRecvBandwidth Write FMaxRecvBandwidth;
-
-    {:Define maximal bandwidth for all sending and receiving operations in bytes
-     per second. If value is 0 (default), bandwidth limitation is not used.}
-    property MaxBandwidth: Integer Write SetBandwidth;
-
-    {:Do a conversion of non-standard line terminators to CRLF. (Off by default)
-     If @True, then terminators like sigle CR, single LF or LFCR are converted
-     to CRLF internally. This have effect only in @link(RecvString) method!}
-    property ConvertLineEnd: Boolean read FConvertLineEnd Write FConvertLineEnd;
-
-    {:Specified Family of this socket. When you are using Windows preliminary
-     support for IPv6, then I recommend to set this property!}
-    property Family: TSocketFamily read FFamily Write SetFamily;
-
-    {:When resolving of domain name return both IPv4 and IPv6 addresses, then
-     specify if is used IPv4 (dafault - @true) or IPv6.}
-    property PreferIP4: Boolean read FPreferIP4 Write FPreferIP4;
-
-    {:By default (@true) is all timeouts used as timeout between two packets in
-     reading operations. If you set this to @false, then Timeouts is for overall
-     reading operation!}
-    property InterPacketTimeout: Boolean read FInterPacketTimeout Write FInterPacketTimeout;
-
-    {:All sended datas was splitted by this value.}
-    property SendMaxChunk: Integer read FSendMaxChunk Write FSendMaxChunk;
-
-    {:By setting this property to @true you can stop any communication. You can
-     use this property for soft abort of communication.}
-    property StopFlag: Boolean read FStopFlag Write FStopFlag;
-
-    {:Timeout for data sending by non-blocking socket mode.}
-    property NonblockSendTimeout: Integer read FNonblockSendTimeout Write FNonblockSendTimeout;
-
-    {:This event is called by various reasons. It is good for monitoring socket,
-     create gauges for data transfers, etc.}
-    property OnStatus: THookSocketStatus read FOnStatus write FOnStatus;
-
-    {:this event is good for some internal thinks about filtering readed datas.
-     It is used by telnet client by example.}
-    property OnReadFilter: THookDataFilter read FOnReadFilter write FOnReadFilter;
-
-    {:This event is called after real socket creation for setting special socket
-     options, because you not know when socket is created. (it is depended on
-     Ipv4, IPv6 or automatic mode)}
-    property OnCreateSocket: THookCreateSocket read FOnCreateSocket write FOnCreateSocket;
-
-    {:This event is good for monitoring content of readed or writed datas.}
-    property OnMonitor: THookMonitor read FOnMonitor write FOnMonitor;
-
-    {:This event is good for calling your code during long socket operations.
-      (Example, for refresing UI if class in not called within the thread.)
-      Rate of heartbeats can be modified by @link(HeartbeatRate) property.}
-    property OnHeartbeat: THookHeartbeat read FOnHeartbeat write FOnHeartbeat;
-
-    {:Specify typical rate of @link(OnHeartbeat) event and @link(StopFlag) testing.
-      Default value 0 disabling heartbeats! Value is in milliseconds.
-      Real rate can be higher or smaller then this value, because it depending
-      on real socket operations too!
-      Note: Each heartbeat slowing socket processing.}
-    property HeartbeatRate: integer read FHeartbeatRate Write FHeartbeatRate;
-    {:What class own this socket? Used by protocol implementation classes.}
-    property Owner: TObject read FOwner Write FOwner;
-  end;
-
-  {:@abstract(Support for SOCKS4 and SOCKS5 proxy)
-   Layer with definition all necessary properties and functions for
-   implementation SOCKS proxy client. Do not use this class directly.}
-  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;
-    FBypassFlag: Boolean;
-    FSocksType: TSocksType;
-    function SocksCode(IP, Port: string): Ansistring;
-    function SocksDecode(Value: Ansistring): integer;
-  public
-    constructor Create;
-
-    {:Open connection to SOCKS proxy and if @link(SocksUsername) is set, do
-     authorisation to proxy. This is needed only in special cases! (it is called
-     internally!)}
-    function SocksOpen: Boolean;
-
-    {:Send specified request to SOCKS proxy. This is needed only in special
-     cases! (it is called internally!)}
-    function SocksRequest(Cmd: Byte; const IP, Port: string): Boolean;
-
-    {:Receive response to previosly sended request. This is needed only in
-     special cases! (it is called internally!)}
-    function SocksResponse: Boolean;
-
-    {:Is @True when class is using SOCKS proxy.}
-    property UsingSocks: Boolean read FUsingSocks;
-
-    {:If SOCKS proxy failed, here is error code returned from SOCKS proxy.}
-    property SocksLastError: integer read FSocksLastError;
-  published
-    {:Address of SOCKS server. If value is empty string, SOCKS support is
-     disabled. Assingning any value to this property enable SOCKS mode.
-     Warning: You cannot combine this mode with HTTP-tunneling mode!}
-    property SocksIP: string read FSocksIP write FSocksIP;
-
-    {:Port of SOCKS server. Default value is '1080'.}
-    property SocksPort: string read FSocksPort write FSocksPort;
-
-    {:If you need authorisation on SOCKS server, set username here.}
-    property SocksUsername: string read FSocksUsername write FSocksUsername;
-
-    {:If you need authorisation on SOCKS server, set password here.}
-    property SocksPassword: string read FSocksPassword write FSocksPassword;
-
-    {:Specify timeout for communicatin with SOCKS server. Default is one minute.}
-    property SocksTimeout: integer read FSocksTimeout write FSocksTimeout;
-
-    {:If @True, all symbolic names of target hosts is not translated to IP's
-     locally, but resolving is by SOCKS proxy. Default is @True.}
-    property SocksResolver: Boolean read FSocksResolver write FSocksResolver;
-
-    {:Specify SOCKS type. By default is used SOCKS5, but you can use SOCKS4 too.
-     When you select SOCKS4, then if @link(SOCKSResolver) is enabled, then is
-     used SOCKS4a. Othervise is used pure SOCKS4.}
-    property SocksType: TSocksType read FSocksType write FSocksType;
-  end;
-
-  {:@abstract(Implementation of TCP socket.)
-   Supported features: IPv4, IPv6, SSL/TLS or SSH (depending on used plugin),
-   SOCKS5 proxy (outgoing connections and limited incomming), SOCKS4/4a proxy
-   (outgoing connections and limited incomming), TCP through HTTP proxy tunnel.}
-  TTCPBlockSocket = class(TSocksBlockSocket)
-  protected
-    FOnAfterConnect: THookAfterConnect;
-    FSSL: TCustomSSL;
-    FHTTPTunnelIP: string;
-    FHTTPTunnelPort: string;
-    FHTTPTunnel: Boolean;
-    FHTTPTunnelRemoteIP: string;
-    FHTTPTunnelRemotePort: string;
-    FHTTPTunnelUser: string;
-    FHTTPTunnelPass: string;
-    FHTTPTunnelTimeout: integer;
-    procedure SocksDoConnect(IP, Port: string);
-    procedure HTTPTunnelDoConnect(IP, Port: string);
-    procedure DoAfterConnect;
-  public
-    {:Create TCP socket class with default plugin for SSL/TSL/SSH implementation
-    (see @link(SSLImplementation))}
-    constructor Create;
-
-    {:Create TCP socket class with desired plugin for SSL/TSL/SSH implementation}
-    constructor CreateWithSSL(SSLPlugin: TSSLClass);
-    destructor Destroy; override;
-
-    {:See @link(TBlockSocket.CloseSocket)}
-    procedure CloseSocket; override;
-
-    {:See @link(TBlockSocket.WaitingData)}
-    function WaitingData: Integer; override;
-
-    {:Sets socket to receive mode for new incoming connections. It is necessary
-     to use @link(TBlockSocket.BIND) function call before this method to select
-     receiving port!
-
-     If you use SOCKS, activate incoming TCP connection by this proxy. (By BIND
-     method of SOCKS.)}
-    procedure Listen; override;
-
-    {:Waits until new incoming connection comes. After it comes a new socket is
-     automatically created (socket handler is returned by this function as
-     result).
-
-     If you use SOCKS, new socket is not created! In this case is used same
-     socket as socket for listening! So, you can accept only one connection in
-     SOCKS mode.}
-    function Accept: TSocket; override;
-
-    {:Connects socket to remote IP address and PORT. The same rules as with
-     @link(TBlockSocket.BIND) method are valid. The only exception is that PORT
-     with 0 value will not be connected. After call to this method
-     a communication channel between local and remote socket is created. Local
-     socket is assigned automatically if not controlled by previous call to
-     @link(TBlockSocket.BIND) method. Structures @link(TBlockSocket.LocalSin)
-     and @link(TBlockSocket.RemoteSin) will be filled with valid values.
-
-     If you use SOCKS, activate outgoing TCP connection by SOCKS proxy specified
-     in @link(TSocksBlockSocket.SocksIP). (By CONNECT method of SOCKS.)
-
-     If you use HTTP-tunnel mode, activate outgoing TCP connection by HTTP
-     tunnel specified in @link(HTTPTunnelIP). (By CONNECT method of HTTP
-     protocol.)
-
-     Note: If you call this on non-created socket, then socket is created
-     automaticly.}
-    procedure Connect(IP, Port: string); override;
-
-    {:If you need upgrade existing TCP connection to SSL/TLS (or SSH2, if plugin
-     allows it) mode, then call this method. This method switch this class to
-     SSL mode and do SSL/TSL handshake.}
-    procedure SSLDoConnect;
-
-    {:By this method you can downgrade existing SSL/TLS connection to normal TCP
-     connection.}
-    procedure SSLDoShutdown;
-
-    {:If you need use this component as SSL/TLS TCP server, then after accepting
-     of inbound connection you need start SSL/TLS session by this method. Before
-     call this function, you must have assigned all neeeded certificates and
-     keys!}
-    function SSLAcceptConnection: Boolean;
-
-    {:See @link(TBlockSocket.GetLocalSinIP)}
-    function GetLocalSinIP: string; override;
-
-    {:See @link(TBlockSocket.GetRemoteSinIP)}
-    function GetRemoteSinIP: string; override;
-
-    {:See @link(TBlockSocket.GetLocalSinPort)}
-    function GetLocalSinPort: Integer; override;
-
-    {:See @link(TBlockSocket.GetRemoteSinPort)}
-    function GetRemoteSinPort: Integer; override;
-
-    {:See @link(TBlockSocket.SendBuffer)}
-    function SendBuffer(Buffer: TMemory; Length: Integer): Integer; override;
-
-    {:See @link(TBlockSocket.RecvBuffer)}
-    function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; override;
-
-    {:Return value of socket type. For TCP return SOCK_STREAM.}
-    function GetSocketType: integer; override;
-
-    {:Return value of protocol type for socket creation. For TCP return
-     IPPROTO_TCP.}
-    function GetSocketProtocol: integer; override;
-
-    {:Class implementing SSL/TLS support. It is allways some descendant
-     of @link(TCustomSSL) class. When programmer not select some SSL plugin
-     class, then is used @link(TSSLNone)}
-    property SSL: TCustomSSL read FSSL;
-
-    {:@True if is used HTTP tunnel mode.}
-    property HTTPTunnel: Boolean read FHTTPTunnel;
-  published
-    {:Return descriptive string for @link(LastError). On case of error
-     in SSL/TLS subsystem, it returns right error description.}
-    function GetErrorDescEx: string; override;
-
-    {:Specify IP address of HTTP proxy. Assingning non-empty value to this
-     property enable HTTP-tunnel mode. This mode is for tunnelling any outgoing
-     TCP connection through HTTP proxy server. (If policy on HTTP proxy server
-     allow this!) Warning: You cannot combine this mode with SOCK5 mode!}
-    property HTTPTunnelIP: string read FHTTPTunnelIP Write FHTTPTunnelIP;
-
-    {:Specify port of HTTP proxy for HTTP-tunneling.}
-    property HTTPTunnelPort: string read FHTTPTunnelPort Write FHTTPTunnelPort;
-
-    {:Specify authorisation username for access to HTTP proxy in HTTP-tunnel
-     mode. If you not need authorisation, then let this property empty.}
-    property HTTPTunnelUser: string read FHTTPTunnelUser Write FHTTPTunnelUser;
-
-    {:Specify authorisation password for access to HTTP proxy in HTTP-tunnel
-     mode.}
-    property HTTPTunnelPass: string read FHTTPTunnelPass Write FHTTPTunnelPass;
-
-    {:Specify timeout for communication with HTTP proxy in HTTPtunnel mode.}
-    property HTTPTunnelTimeout: integer read FHTTPTunnelTimeout Write FHTTPTunnelTimeout;
-
-    {:This event is called after sucessful TCP socket connection.}
-    property OnAfterConnect: THookAfterConnect read FOnAfterConnect write FOnAfterConnect;
-  end;
-
-  {:@abstract(Datagram based communication)
-   This class implementing datagram based communication instead default stream
-   based communication style.}
-  TDgramBlockSocket = class(TSocksBlockSocket)
-  public
-    {:Fill @link(TBlockSocket.RemoteSin) structure. This address is used for
-     sending data.}
-    procedure Connect(IP, Port: string); override;
-
-    {:Silently redirected to @link(TBlockSocket.SendBufferTo).}
-    function SendBuffer(Buffer: TMemory; Length: Integer): Integer; override;
-
-    {:Silently redirected to @link(TBlockSocket.RecvBufferFrom).}
-    function RecvBuffer(Buffer: TMemory; Length: Integer): Integer; override;
-  end;
-
-  {:@abstract(Implementation of UDP socket.)
-   NOTE: in this class is all receiving redirected to RecvBufferFrom. You can
-   use for reading any receive function. Preffered is RecvPacket! Similary all
-   sending is redirected to SendbufferTo. You can use for sending UDP packet any
-   sending function, like SendString.
-
-   Supported features: IPv4, IPv6, unicasts, broadcasts, multicasts, SOCKS5
-   proxy (only unicasts! Outgoing and incomming.)}
-  TUDPBlockSocket = class(TDgramBlockSocket)
-  protected
-    FSocksControlSock: TTCPBlockSocket;
-    function UdpAssociation: Boolean;
-    procedure SetMulticastTTL(TTL: integer);
-    function GetMulticastTTL:integer;
-  public
-    destructor Destroy; override;
-
-    {:Enable or disable sending of broadcasts. If seting OK, result is @true.
-     This method is not supported in SOCKS5 mode! IPv6 does not support
-     broadcasts! In this case you must use Multicasts instead.}
-    procedure EnableBroadcast(Value: Boolean);
-
-    {:See @link(TBlockSocket.SendBufferTo)}
-    function SendBufferTo(Buffer: TMemory; Length: Integer): Integer; override;
-
-    {:See @link(TBlockSocket.RecvBufferFrom)}
-    function RecvBufferFrom(Buffer: TMemory; Length: Integer): Integer; override;
-{$IFNDEF CIL}
-    {:Add this socket to given multicast group. You cannot use Multicasts in
-     SOCKS mode!}
-    procedure AddMulticast(MCastIP:string);
-
-    {:Remove this socket from given multicast group.}
-    procedure DropMulticast(MCastIP:string);
-{$ENDIF}
-    {:All sended multicast datagrams is loopbacked to your interface too. (you
-     can read your sended datas.) You can disable this feature by this function.
-     This function not working on some Windows systems!}
-    procedure EnableMulticastLoop(Value: Boolean);
-
-    {:Return value of socket type. For UDP return SOCK_DGRAM.}
-    function GetSocketType: integer; override;
-
-    {:Return value of protocol type for socket creation. For UDP return
-     IPPROTO_UDP.}
-    function GetSocketProtocol: integer; override;
-
-    {:Set Time-to-live value for multicasts packets. It define number of routers
-     for transfer of datas. If you set this to 1 (dafault system value), then
-     multicasts packet goes only to you local network. If you need transport
-     multicast packet to worldwide, then increase this value, but be carefull,
-     lot of routers on internet does not transport multicasts packets!}
-    property MulticastTTL: Integer read GetMulticastTTL Write SetMulticastTTL;
-  end;
-
-  {:@abstract(Implementation of RAW ICMP socket.)
-   For this object you must have rights for creating RAW sockets!}
-  TICMPBlockSocket = class(TDgramBlockSocket)
-  public
-    {:Return value of socket type. For RAW and ICMP return SOCK_RAW.}
-    function GetSocketType: integer; override;
-
-    {:Return value of protocol type for socket creation. For ICMP returns
-     IPPROTO_ICMP or IPPROTO_ICMPV6}
-    function GetSocketProtocol: integer; override;
-  end;
-
-  {:@abstract(Implementation of RAW socket.)
-   For this object you must have rights for creating RAW sockets!}
-  TRAWBlockSocket = class(TBlockSocket)
-  public
-    {:Return value of socket type. For RAW and ICMP return SOCK_RAW.}
-    function GetSocketType: integer; override;
-
-    {:Return value of protocol type for socket creation. For RAW returns
-     IPPROTO_RAW.}
-    function GetSocketProtocol: integer; override;
-  end;
-
-  {:@abstract(Implementation of PGM-message socket.)
-   Not all systems supports this protocol!}
-  TPGMMessageBlockSocket = class(TBlockSocket)
-  public
-    {:Return value of socket type. For PGM-message return SOCK_RDM.}
-    function GetSocketType: integer; override;
-
-    {:Return value of protocol type for socket creation. For PGM-message returns
-     IPPROTO_RM.}
-    function GetSocketProtocol: integer; override;
-  end;
-
-  {:@abstract(Implementation of PGM-stream socket.)
-   Not all systems supports this protocol!}
-  TPGMStreamBlockSocket = class(TBlockSocket)
-  public
-    {:Return value of socket type. For PGM-stream return SOCK_STREAM.}
-    function GetSocketType: integer; override;
-
-    {:Return value of protocol type for socket creation. For PGM-stream returns
-     IPPROTO_RM.}
-    function GetSocketProtocol: integer; override;
-  end;
-
-  {:@abstract(Parent class for all SSL plugins.)
-   This is abstract class defining interface for other SSL plugins.
-
-   Instance of this class will be created for each @link(TTCPBlockSocket).
-
-   Warning: not all methods and propertis can work in all existing SSL plugins!
-   Please, read documentation of used SSL plugin.}
-  TCustomSSL = class(TObject)
-  protected
-    FSocket: TTCPBlockSocket;
-    FSSLEnabled: Boolean;
-    FLastError: integer;
-    FLastErrorDesc: string;
-    FSSLType: TSSLType;
-    FKeyPassword: string;
-    FCiphers: string;
-    FCertificateFile: string;
-    FPrivateKeyFile: string;
-    FCertificate: Ansistring;
-    FPrivateKey: Ansistring;
-    FPFX: Ansistring;
-    FPFXfile: string;
-    FCertCA: Ansistring;
-    FCertCAFile: string;
-    FTrustCertificate: Ansistring;
-    FTrustCertificateFile: string;
-    FVerifyCert: Boolean;
-    FUsername: string;
-    FPassword: string;
-    FSSHChannelType: string;
-    FSSHChannelArg1: string;
-    FSSHChannelArg2: string;
-    procedure ReturnError;
-    function CreateSelfSignedCert(Host: string): Boolean; virtual;
-  public
-    {: Create plugin class. it is called internally from @link(TTCPBlockSocket)}
-    constructor Create(const Value: TTCPBlockSocket); virtual;
-
-    {: Assign settings (certificates and configuration) from another SSL plugin
-     class.}
-    procedure Assign(const Value: TCustomSSL); virtual;
-
-    {: return description of used plugin. It usually return name and version
-     of used SSL library.}
-    function LibVersion: String; virtual;
-
-    {: return name of used plugin.}
-    function LibName: String; virtual;
-
-    {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)!
-
-     Here is needed code for start SSL connection.}
-    function Connect: boolean; virtual;
-
-    {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)!
-
-     Here is needed code for acept new SSL connection.}
-    function Accept: boolean; virtual;
-
-    {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)!
-
-     Here is needed code for hard shutdown of SSL connection. (for example,
-     before socket is closed)}
-    function Shutdown: boolean; virtual;
-
-    {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)!
-
-     Here is needed code for soft shutdown of SSL connection. (for example,
-     when you need to continue with unprotected connection.)}
-    function BiShutdown: boolean; virtual;
-
-    {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)!
-
-     Here is needed code for sending some datas by SSL connection.}
-    function SendBuffer(Buffer: TMemory; Len: Integer): Integer; virtual;
-
-    {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)!
-
-     Here is needed code for receiving some datas by SSL connection.}
-    function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; virtual;
-
-    {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)!
-
-     Here is needed code for getting count of datas what waiting for read.
-     If SSL plugin not allows this, then it should return 0.}
-    function WaitingData: Integer; virtual;
-
-    {:Return string with identificator of SSL/TLS version of existing
-     connection.}
-    function GetSSLVersion: string; virtual;
-
-    {:Return subject of remote SSL peer.}
-    function GetPeerSubject: string; virtual;
-
-    {:Return issuer certificate of remote SSL peer.}
-    function GetPeerIssuer: string; virtual;
-
-    {:Return peer name from remote side certificate. This is good for verify,
-     if certificate is generated for remote side IP name.}
-    function GetPeerName: string; virtual;
-
-    {:Return fingerprint of remote SSL peer.}
-    function GetPeerFingerprint: string; virtual;
-
-    {:Return all detailed information about certificate from remote side of
-     SSL/TLS connection. Result string can be multilined! Each plugin can return
-     this informations in different format!}
-    function GetCertInfo: string; virtual;
-
-    {:Return currently used Cipher.}
-    function GetCipherName: string; virtual;
-
-    {:Return currently used number of bits in current Cipher algorythm.}
-    function GetCipherBits: integer; virtual;
-
-    {:Return number of bits in current Cipher algorythm.}
-    function GetCipherAlgBits: integer; virtual;
-
-    {:Return result value of verify remote side certificate. Look to OpenSSL
-     documentation for possible values. For example 0 is successfuly verified
-     certificate, or 18 is self-signed certificate.}
-    function GetVerifyCert: integer; virtual;
-
-    {: Resurn @true if SSL mode is enabled on existing cvonnection.}
-    property SSLEnabled: Boolean read FSSLEnabled;
-
-    {:Return error code of last SSL operation. 0 is OK.}
-    property LastError: integer read FLastError;
-
-    {:Return error description of last SSL operation.}
-    property LastErrorDesc: string read FLastErrorDesc;
-  published
-    {:Here you can specify requested SSL/TLS mode. Default is autodetection, but
-     on some servers autodetection not working properly. In this case you must
-     specify requested SSL/TLS mode by your hand!}
-    property SSLType: TSSLType read FSSLType write FSSLType;
-
-    {:Password for decrypting of encoded certificate or key.}
-    property KeyPassword: string read FKeyPassword write FKeyPassword;
-
-    {:Username for possible credentials.}
-    property Username: string read FUsername write FUsername;
-
-    {:password for possible credentials.}
-    property Password: string read FPassword write FPassword;
-
-    {:By this property you can modify default set of SSL/TLS ciphers.}
-    property Ciphers: string read FCiphers write FCiphers;
-
-    {:Used for loading certificate from disk file. See to plugin documentation
-     if this method is supported and how!}
-    property CertificateFile: string read FCertificateFile write FCertificateFile;
-
-    {:Used for loading private key from disk file. See to plugin documentation
-     if this method is supported and how!}
-    property PrivateKeyFile: string read FPrivateKeyFile write FPrivateKeyFile;
-
-    {:Used for loading certificate from binary string. See to plugin documentation
-     if this method is supported and how!}
-    property Certificate: Ansistring read FCertificate write FCertificate;
-
-    {:Used for loading private key from binary string. See to plugin documentation
-     if this method is supported and how!}
-    property PrivateKey: Ansistring read FPrivateKey write FPrivateKey;
-
-    {:Used for loading PFX from binary string. See to plugin documentation
-     if this method is supported and how!}
-    property PFX: Ansistring read FPFX write FPFX;
-
-    {:Used for loading PFX from disk file. See to plugin documentation
-     if this method is supported and how!}
-    property PFXfile: string read FPFXfile write FPFXfile;
-
-    {:Used for loading trusted certificates from disk file. See to plugin documentation
-     if this method is supported and how!}
-    property TrustCertificateFile: string read FTrustCertificateFile write FTrustCertificateFile;
-
-    {:Used for loading trusted certificates from binary string. See to plugin documentation
-     if this method is supported and how!}
-    property TrustCertificate: Ansistring read FTrustCertificate write FTrustCertificate;
-
-    {:Used for loading CA certificates from binary string. See to plugin documentation
-     if this method is supported and how!}
-    property CertCA: Ansistring read FCertCA write FCertCA;
-
-    {:Used for loading CA certificates from disk file. See to plugin documentation
-     if this method is supported and how!}
-    property CertCAFile: string read FCertCAFile write FCertCAFile;
-
-    {:If @true, then is verified client certificate. (it is good for writing
-     SSL/TLS servers.) When you are not server, but you are client, then if this
-     property is @true, verify servers certificate.}
-    property VerifyCert: Boolean read FVerifyCert write FVerifyCert;
-
-    {:channel type for possible SSH connections}
-    property SSHChannelType: string read FSSHChannelType write FSSHChannelType;
-
-    {:First argument of channel type for possible SSH connections}
-    property SSHChannelArg1: string read FSSHChannelArg1 write FSSHChannelArg1;
-
-    {:Second argument of channel type for possible SSH connections}
-    property SSHChannelArg2: string read FSSHChannelArg2 write FSSHChannelArg2;
-  end;
-
-  {:@abstract(Default SSL plugin with no SSL support.)
-   Dummy SSL plugin implementation for applications without SSL/TLS support.}
-  TSSLNone = class (TCustomSSL)
-  public
-    {:See @inherited}
-    function LibVersion: String; override;
-    {:See @inherited}
-    function LibName: String; override;
-  end;
-
-  {:@abstract(Record with definition of IP packet header.)
-   For reading data from ICMP or RAW sockets.}
-  TIPHeader = record
-    VerLen: Byte;
-    TOS: Byte;
-    TotalLen: Word;
-    Identifer: Word;
-    FragOffsets: Word;
-    TTL: Byte;
-    Protocol: Byte;
-    CheckSum: Word;
-    SourceIp: LongWord;
-    DestIp: LongWord;
-    Options: LongWord;
-  end;
-
-  {:@abstract(Parent class of application protocol implementations.)
-   By this class is defined common properties.}
-  TSynaClient = Class(TObject)
-  protected
-    FTargetHost: string;
-    FTargetPort: string;
-    FIPInterface: string;
-    FTimeout: integer;
-    FUserName: string;
-    FPassword: string;
-  public
-    constructor Create;
-  published
-    {:Specify terget server IP (or symbolic name). Default is 'localhost'.}
-    property TargetHost: string read FTargetHost Write FTargetHost;
-
-    {:Specify terget server port (or symbolic name).}
-    property TargetPort: string read FTargetPort Write FTargetPort;
-
-    {:Defined local socket address. (outgoing IP address). By default is used
-     '0.0.0.0' as wildcard for default IP.}
-    property IPInterface: string read FIPInterface Write FIPInterface;
-
-    {:Specify default timeout for socket operations.}
-    property Timeout: integer read FTimeout Write FTimeout;
-
-    {:If protocol need user authorization, then fill here username.}
-    property UserName: string read FUserName Write FUserName;
-
-    {:If protocol need user authorization, then fill here password.}
-    property Password: string read FPassword Write FPassword;
-  end;
-
-var
-  {:Selected SSL plugin. Default is @link(TSSLNone).
-
-   Do not change this value directly!!!
-
-   Just add your plugin unit to your project uses instead. Each plugin unit have
-   initialization code what modify this variable.}
-  SSLImplementation: TSSLClass = TSSLNone;
-
-implementation
-
-{$IFDEF ONCEWINSOCK}
-var
-  WsaDataOnce: TWSADATA;
-  e: ESynapseError;
-{$ENDIF}
-
-
-constructor TBlockSocket.Create;
-begin
-  CreateAlternate('');
-end;
-
-constructor TBlockSocket.CreateAlternate(Stub: string);
-{$IFNDEF ONCEWINSOCK}
-var
-  e: ESynapseError;
-{$ENDIF}
-begin
-  inherited Create;
-  FDelayedOptions := TList.Create;
-  FRaiseExcept := False;
-{$IFDEF RAISEEXCEPT}
-  FRaiseExcept := True;
-{$ENDIF}
-  FSocket := INVALID_SOCKET;
-  FBuffer := '';
-  FLastCR := False;
-  FLastLF := False;
-  FBinded := False;
-  FNonBlockMode := False;
-  FMaxLineLength := 0;
-  FMaxSendBandwidth := 0;
-  FNextSend := 0;
-  FMaxRecvBandwidth := 0;
-  FNextRecv := 0;
-  FConvertLineEnd := False;
-  FFamily := SF_Any;
-  FFamilySave := SF_Any;
-  FIP6used := False;
-  FPreferIP4 := True;
-  FInterPacketTimeout := True;
-  FRecvCounter := 0;
-  FSendCounter := 0;
-  FSendMaxChunk := c64k;
-  FStopFlag := False;
-  FNonblockSendTimeout := 15000;
-  FHeartbeatRate := 0;
-  FOwner := nil;
-{$IFNDEF ONCEWINSOCK}
-  if Stub = '' then
-    Stub := DLLStackName;
-  if not InitSocketInterface(Stub) then
-  begin
-    e := ESynapseError.Create('Error loading Socket interface (' + Stub + ')!');
-    e.ErrorCode := 0;
-    e.ErrorMessage := 'Error loading Socket interface (' + Stub + ')!';
-    raise e;
-  end;
-  SockCheck(synsock.WSAStartup(WinsockLevel, FWsaDataOnce));
-  ExceptCheck;
-{$ENDIF}
-end;
-
-destructor TBlockSocket.Destroy;
-var
-  n: integer;
-  p: TSynaOption;
-begin
-  CloseSocket;
-{$IFNDEF ONCEWINSOCK}
-  synsock.WSACleanup;
-  DestroySocketInterface;
-{$ENDIF}
-  for n := FDelayedOptions.Count - 1 downto 0 do
-    begin
-      p := TSynaOption(FDelayedOptions[n]);
-      p.Free;
-    end;
-  FDelayedOptions.Free;
-  inherited Destroy;
-end;
-
-function TBlockSocket.FamilyToAF(f: TSocketFamily): TAddrFamily;
-begin
-  case f of
-    SF_ip4:
-      Result := AF_INET;
-    SF_ip6:
-      Result := AF_INET6;
-  else
-    Result := AF_UNSPEC;
-  end;
-end;
-
-procedure TBlockSocket.SetDelayedOption(const Value: TSynaOption);
-var
-  li: TLinger;
-  x: integer;
-  buf: TMemory;
-{$IFNDEF MSWINDOWS}
-  timeval: TTimeval;
-{$ENDIF}
-begin
-  case value.Option of
-    SOT_Linger:
-      begin
-        {$IFDEF CIL}
-        li := TLinger.Create(Value.Enabled, Value.Value div 1000);
-        synsock.SetSockOptObj(FSocket, integer(SOL_SOCKET), integer(SO_LINGER), li);
-        {$ELSE}
-        li.l_onoff := Ord(Value.Enabled);
-        li.l_linger := Value.Value div 1000;
-        buf := @li;
-        synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_LINGER), buf, SizeOf(li));
-        {$ENDIF}
-      end;
-    SOT_RecvBuff:
-      begin
-        {$IFDEF CIL}
-        buf := System.BitConverter.GetBytes(value.Value);
-        {$ELSE}
-        buf := @Value.Value;
-        {$ENDIF}
-        synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_RCVBUF),
-          buf, SizeOf(Value.Value));
-      end;
-    SOT_SendBuff:
-      begin
-        {$IFDEF CIL}
-        buf := System.BitConverter.GetBytes(value.Value);
-        {$ELSE}
-        buf := @Value.Value;
-        {$ENDIF}
-        synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_SNDBUF),
-          buf, SizeOf(Value.Value));
-      end;
-    SOT_NonBlock:
-      begin
-        FNonBlockMode := Value.Enabled;
-        x := Ord(FNonBlockMode);
-        synsock.IoctlSocket(FSocket, FIONBIO, x);
-      end;
-    SOT_RecvTimeout:
-      begin
-        {$IFDEF CIL}
-        buf := System.BitConverter.GetBytes(value.Value);
-        synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_RCVTIMEO),
-          buf, SizeOf(Value.Value));
-        {$ELSE}
-          {$IFDEF MSWINDOWS}
-        buf := @Value.Value;
-        synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_RCVTIMEO),
-          buf, SizeOf(Value.Value));
-          {$ELSE}
-        timeval.tv_sec:=Value.Value div 1000;
-        timeval.tv_usec:=(Value.Value mod 1000) * 1000;
-        synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_RCVTIMEO),
-          @timeval, SizeOf(timeval));
-          {$ENDIF}
-        {$ENDIF}
-      end;
-    SOT_SendTimeout:
-      begin
-        {$IFDEF CIL}
-        buf := System.BitConverter.GetBytes(value.Value);
-        {$ELSE}
-          {$IFDEF MSWINDOWS}
-        buf := @Value.Value;
-        synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_SNDTIMEO),
-          buf, SizeOf(Value.Value));
-          {$ELSE}
-        timeval.tv_sec:=Value.Value div 1000;
-        timeval.tv_usec:=(Value.Value mod 1000) * 1000;
-        synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_SNDTIMEO),
-          @timeval, SizeOf(timeval));
-          {$ENDIF}
-        {$ENDIF}
-      end;
-    SOT_Reuse:
-      begin
-        x := Ord(Value.Enabled);
-        {$IFDEF CIL}
-        buf := System.BitConverter.GetBytes(x);
-        {$ELSE}
-        buf := @x;
-        {$ENDIF}
-        synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_REUSEADDR), buf, SizeOf(x));
-      end;
-    SOT_TTL:
-      begin
-        {$IFDEF CIL}
-        buf := System.BitConverter.GetBytes(value.Value);
-        {$ELSE}
-        buf := @Value.Value;
-        {$ENDIF}
-        if FIP6Used then
-          synsock.SetSockOpt(FSocket, integer(IPPROTO_IPV6), integer(IPV6_UNICAST_HOPS),
-            buf, SizeOf(Value.Value))
-        else
-          synsock.SetSockOpt(FSocket, integer(IPPROTO_IP), integer(IP_TTL),
-            buf, SizeOf(Value.Value));
-      end;
-    SOT_Broadcast:
-      begin
-//#todo1 broadcasty na IP6
-        x := Ord(Value.Enabled);
-        {$IFDEF CIL}
-        buf := System.BitConverter.GetBytes(x);
-        {$ELSE}
-        buf := @x;
-        {$ENDIF}
-        synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_BROADCAST), buf, SizeOf(x));
-      end;
-    SOT_MulticastTTL:
-      begin
-        {$IFDEF CIL}
-        buf := System.BitConverter.GetBytes(value.Value);
-        {$ELSE}
-        buf := @Value.Value;
-        {$ENDIF}
-        if FIP6Used then
-          synsock.SetSockOpt(FSocket, integer(IPPROTO_IPV6), integer(IPV6_MULTICAST_HOPS),
-            buf, SizeOf(Value.Value))
-        else
-          synsock.SetSockOpt(FSocket, integer(IPPROTO_IP), integer(IP_MULTICAST_TTL),
-            buf, SizeOf(Value.Value));
-      end;
-   SOT_MulticastLoop:
-      begin
-        x := Ord(Value.Enabled);
-        {$IFDEF CIL}
-        buf := System.BitConverter.GetBytes(x);
-        {$ELSE}
-        buf := @x;
-        {$ENDIF}
-        if FIP6Used then
-          synsock.SetSockOpt(FSocket, integer(IPPROTO_IPV6), integer(IPV6_MULTICAST_LOOP), buf, SizeOf(x))
-        else
-          synsock.SetSockOpt(FSocket, integer(IPPROTO_IP), integer(IP_MULTICAST_LOOP), buf, SizeOf(x));
-      end;
-  end;
-  Value.free;
-end;
-
-procedure TBlockSocket.DelayedOption(const Value: TSynaOption);
-begin
-  if FSocket = INVALID_SOCKET then
-  begin
-    FDelayedOptions.Insert(0, Value);
-  end
-  else
-    SetDelayedOption(Value);
-end;
-
-procedure TBlockSocket.ProcessDelayedOptions;
-var
-  n: integer;
-  d: TSynaOption;
-begin
-  for n := FDelayedOptions.Count - 1 downto 0 do
-  begin
-    d := TSynaOption(FDelayedOptions[n]);
-    SetDelayedOption(d);
-  end;
-  FDelayedOptions.Clear;
-end;
-
-procedure TBlockSocket.SetSin(var Sin: TVarSin; IP, Port: string);
-var
-  f: TSocketFamily;
-begin
-  DoStatus(HR_ResolvingBegin, IP + ':' + Port);
-  ResetLastError;
-  //if socket exists, then use their type, else use users selection
-  f := SF_Any;
-  if (FSocket = INVALID_SOCKET) and (FFamily = SF_any) then
-  begin
-    if IsIP(IP) then
-      f := SF_IP4
-    else
-      if IsIP6(IP) then
-        f := SF_IP6;
-  end
-  else
-    f := FFamily;
-  FLastError := synsock.SetVarSin(sin, ip, port, FamilyToAF(f),
-    GetSocketprotocol, GetSocketType, FPreferIP4);
-  DoStatus(HR_ResolvingEnd, GetSinIP(sin) + ':' + IntTostr(GetSinPort(sin)));
-end;
-
-function TBlockSocket.GetSinIP(Sin: TVarSin): string;
-begin
-  Result := synsock.GetSinIP(sin);
-end;
-
-function TBlockSocket.GetSinPort(Sin: TVarSin): Integer;
-begin
-  Result := synsock.GetSinPort(sin);
-end;
-
-procedure TBlockSocket.CreateSocket;
-var
-  sin: TVarSin;
-begin
-  //dummy for SF_Any Family mode
-  ResetLastError;
-  if (FFamily <> SF_Any) and (FSocket = INVALID_SOCKET) then
-  begin
-    {$IFDEF CIL}
-    if FFamily = SF_IP6 then
-      sin := TVarSin.Create(IPAddress.Parse('::0'), 0)
-    else
-      sin := TVarSin.Create(IPAddress.Parse('0.0.0.0'), 0);
-    {$ELSE}
-    FillChar(Sin, Sizeof(Sin), 0);
-    if FFamily = SF_IP6 then
-      sin.sin_family := AF_INET6
-    else
-      sin.sin_family := AF_INET;
-    {$ENDIF}
-    InternalCreateSocket(Sin);
-  end;
-end;
-
-procedure TBlockSocket.CreateSocketByName(const Value: String);
-var
-  sin: TVarSin;
-begin
-  ResetLastError;
-  if FSocket = INVALID_SOCKET then
-  begin
-    SetSin(sin, value, '0');
-    if FLastError = 0 then
-      InternalCreateSocket(Sin);
-  end;
-end;
-
-procedure TBlockSocket.InternalCreateSocket(Sin: TVarSin);
-begin
-  FStopFlag := False;
-  FRecvCounter := 0;
-  FSendCounter := 0;
-  ResetLastError;
-  if FSocket = INVALID_SOCKET then
-  begin
-    FBuffer := '';
-    FBinded := False;
-    FIP6Used := Sin.AddressFamily = AF_INET6;
-    FSocket := synsock.Socket(integer(Sin.AddressFamily), GetSocketType, GetSocketProtocol);
-    if FSocket = INVALID_SOCKET then
-      FLastError := synsock.WSAGetLastError;
-    {$IFNDEF CIL}
-    FD_ZERO(FFDSet);
-    FD_SET(FSocket, FFDSet);
-    {$ENDIF}
-    ExceptCheck;
-    if FIP6used then
-      DoStatus(HR_SocketCreate, 'IPv6')
-    else
-      DoStatus(HR_SocketCreate, 'IPv4');
-    ProcessDelayedOptions;
-    DoCreateSocket;
-  end;
-end;
-
-procedure TBlockSocket.CloseSocket;
-begin
-  AbortSocket;
-end;
-
-procedure TBlockSocket.AbortSocket;
-var
-  n: integer;
-  p: TSynaOption;
-begin
-  if FSocket <> INVALID_SOCKET then
-    synsock.CloseSocket(FSocket);
-  FSocket := INVALID_SOCKET;
-  for n := FDelayedOptions.Count - 1 downto 0 do
-    begin
-      p := TSynaOption(FDelayedOptions[n]);
-      p.Free;
-    end;
-  FDelayedOptions.Clear;
-  FFamily := FFamilySave;
-  DoStatus(HR_SocketClose, '');
-end;
-
-procedure TBlockSocket.Bind(IP, Port: string);
-var
-  Sin: TVarSin;
-begin
-  ResetLastError;
-  if (FSocket <> INVALID_SOCKET)
-    or not((FFamily = SF_ANY) and (IP = cAnyHost) and (Port = cAnyPort)) then
-  begin
-    SetSin(Sin, IP, Port);
-    if FLastError = 0 then
-    begin
-      if FSocket = INVALID_SOCKET then
-        InternalCreateSocket(Sin);
-      SockCheck(synsock.Bind(FSocket, Sin));
-      GetSinLocal;
-      FBuffer := '';
-      FBinded := True;
-    end;
-    ExceptCheck;
-    DoStatus(HR_Bind, IP + ':' + Port);
-  end;
-end;
-
-procedure TBlockSocket.Connect(IP, Port: string);
-var
-  Sin: TVarSin;
-begin
-  SetSin(Sin, IP, Port);
-  if FLastError = 0 then
-  begin
-    if FSocket = INVALID_SOCKET then
-      InternalCreateSocket(Sin);
-    SockCheck(synsock.Connect(FSocket, Sin));
-    if FLastError = 0 then
-      GetSins;
-    FBuffer := '';
-    FLastCR := False;
-    FLastLF := False;
-  end;
-  ExceptCheck;
-  DoStatus(HR_Connect, IP + ':' + Port);
-end;
-
-procedure TBlockSocket.Listen;
-begin
-  SockCheck(synsock.Listen(FSocket, SOMAXCONN));
-  GetSins;
-  ExceptCheck;
-  DoStatus(HR_Listen, '');
-end;
-
-function TBlockSocket.Accept: TSocket;
-begin
-  Result := synsock.Accept(FSocket, FRemoteSin);
-///    SockCheck(Result);
-  ExceptCheck;
-  DoStatus(HR_Accept, '');
-end;
-
-procedure TBlockSocket.GetSinLocal;
-begin
-  synsock.GetSockName(FSocket, FLocalSin);
-end;
-
-procedure TBlockSocket.GetSinRemote;
-begin
-  synsock.GetPeerName(FSocket, FRemoteSin);
-end;
-
-procedure TBlockSocket.GetSins;
-begin
-  GetSinLocal;
-  GetSinRemote;
-end;
-
-procedure TBlockSocket.SetBandwidth(Value: Integer);
-begin
-  MaxSendBandwidth := Value;
-  MaxRecvBandwidth := Value;
-end;
-
-procedure TBlockSocket.LimitBandwidth(Length: Integer; MaxB: integer; var Next: LongWord);
-var
-  x: LongWord;
-  y: LongWord;
-  n: integer;
-begin
-  if FStopFlag then
-    exit;
-  if MaxB > 0 then
-  begin
-    y := GetTick;
-    if Next > y then
-    begin
-      x := Next - y;
-      if x > 0 then
-      begin
-        DoStatus(HR_Wait, IntToStr(x));
-        sleep(x mod 250);
-        for n := 1 to x div 250 do
-          if FStopFlag then
-            Break
-          else
-            sleep(250);
-      end;
-    end;
-    Next := GetTick + Trunc((Length / MaxB) * 1000);
-  end;
-end;
-
-function TBlockSocket.TestStopFlag: Boolean;
-begin
-  DoHeartbeat;
-  Result := FStopFlag;
-  if Result then
-  begin
-    FStopFlag := False;
-    FLastError := WSAECONNABORTED;
-    ExceptCheck;
-  end;
-end;
-
-
-function TBlockSocket.SendBuffer(Buffer: TMemory; Length: Integer): Integer;
-{$IFNDEF CIL}
-var
-  x, y: integer;
-  l, r: integer;
-  p: Pointer;
-{$ENDIF}
-begin
-  Result := 0;
-  if TestStopFlag then
-    Exit;
-  DoMonitor(True, Buffer, Length);
-{$IFDEF CIL}
-  Result := synsock.Send(FSocket, Buffer, Length, 0);
-{$ELSE}
-  l := Length;
-  x := 0;
-  while x < l do
-  begin
-    y := l - x;
-    if y > FSendMaxChunk then
-      y := FSendMaxChunk;
-    if y > 0 then
-    begin
-      LimitBandwidth(y, FMaxSendBandwidth, FNextsend);
-      p := IncPoint(Buffer, x);
-      r := synsock.Send(FSocket, p, y, MSG_NOSIGNAL);
-      SockCheck(r);
-      if FLastError = WSAEWOULDBLOCK then
-      begin
-        if CanWrite(FNonblockSendTimeout) then
-        begin
-          r := synsock.Send(FSocket, p, y, MSG_NOSIGNAL);
-          SockCheck(r);
-        end
-        else
-          FLastError := WSAETIMEDOUT;
-      end;
-      if FLastError <> 0 then
-        Break;
-      Inc(x, r);
-      Inc(Result, r);
-      Inc(FSendCounter, r);
-      DoStatus(HR_WriteCount, IntToStr(r));
-    end
-    else
-      break;
-  end;
-{$ENDIF}
-  ExceptCheck;
-end;
-
-procedure TBlockSocket.SendByte(Data: Byte);
-{$IFDEF CIL}
-var
-  buf: TMemory;
-{$ENDIF}
-begin
-{$IFDEF CIL}
-  setlength(buf, 1);
-  buf[0] := Data;
-  SendBuffer(buf, 1);
-{$ELSE}
-  SendBuffer(@Data, 1);
-{$ENDIF}
-end;
-
-procedure TBlockSocket.SendString(Data: AnsiString);
-var
-  buf: TMemory;
-begin
-  {$IFDEF CIL}
-  buf := BytesOf(Data);
-  {$ELSE}
-  buf := Pointer(data);
-  {$ENDIF}
-  SendBuffer(buf, Length(Data));
-end;
-
-procedure TBlockSocket.SendInteger(Data: integer);
-var
-  buf: TMemory;
-begin
-  {$IFDEF CIL}
-  buf := System.BitConverter.GetBytes(Data);
-  {$ELSE}
-  buf := @Data;
-  {$ENDIF}
-  SendBuffer(buf, SizeOf(Data));
-end;
-
-procedure TBlockSocket.SendBlock(const Data: AnsiString);
-var
-  i: integer;
-begin
-  i := SwapBytes(Length(data));
-  SendString(Codelongint(i) + Data);
-end;
-
-procedure TBlockSocket.InternalSendStream(const Stream: TStream; WithSize, Indy: boolean);
-var
-  l: integer;
-  yr: integer;
-  s: AnsiString;
-  b: boolean;
-{$IFDEF CIL}
-  buf: TMemory;
-{$ENDIF}
-begin
-  b := true;
-  l := 0;
-  if WithSize then
-  begin
-    l := Stream.Size - Stream.Position;;
-    if Indy then
-      l := SwapBytes(l);
-  end;
-  repeat
-    {$IFDEF CIL}
-    Setlength(buf, FSendMaxChunk);
-    yr := Stream.read(buf, FSendMaxChunk);
-    if yr > 0 then
-    begin
-      if WithSize and b then
-      begin
-        b := false;
-        SendString(CodeLongInt(l));
-      end;
-      SendBuffer(buf, yr);
-      if FLastError <> 0 then
-        break;
-    end
-    {$ELSE}
-    Setlength(s, FSendMaxChunk);
-    yr := Stream.read(Pointer(s)^, FSendMaxChunk);
-    if yr > 0 then
-    begin
-      SetLength(s, yr);
-      if WithSize and b then
-      begin
-        b := false;
-        SendString(CodeLongInt(l) + s);
-      end
-      else
-        SendString(s);
-      if FLastError <> 0 then
-        break;
-    end
-    {$ENDIF}
-  until yr <= 0;
-end;
-
-procedure TBlockSocket.SendStreamRaw(const Stream: TStream);
-begin
-  InternalSendStream(Stream, false, false);
-end;
-
-procedure TBlockSocket.SendStreamIndy(const Stream: TStream);
-begin
-  InternalSendStream(Stream, true, true);
-end;
-
-procedure TBlockSocket.SendStream(const Stream: TStream);
-begin
-  InternalSendStream(Stream, true, false);
-end;
-
-function TBlockSocket.RecvBuffer(Buffer: TMemory; Length: Integer): Integer;
-begin
-  Result := 0;
-  if TestStopFlag then
-    Exit;
-  LimitBandwidth(Length, FMaxRecvBandwidth, FNextRecv);
-//  Result := synsock.Recv(FSocket, Buffer^, Length, MSG_NOSIGNAL);
-  Result := synsock.Recv(FSocket, Buffer, Length, MSG_NOSIGNAL);
-  if Result = 0 then
-    FLastError := WSAECONNRESET
-  else
-    SockCheck(Result);
-  ExceptCheck;
-  if Result > 0 then
-  begin
-    Inc(FRecvCounter, Result);
-    DoStatus(HR_ReadCount, IntToStr(Result));
-    DoMonitor(False, Buffer, Result);
-    DoReadFilter(Buffer, Result);
-  end;
-end;
-
-function TBlockSocket.RecvBufferEx(Buffer: TMemory; Len: Integer;
-  Timeout: Integer): Integer;
-var
-  s: AnsiString;
-  rl, l: integer;
-  ti: LongWord;
-{$IFDEF CIL}
-  n: integer;
-  b: TMemory;
-{$ENDIF}
-begin
-  ResetLastError;
-  Result := 0;
-  if Len > 0 then
-  begin
-    rl := 0;
-    repeat
-      ti := GetTick;
-      s := RecvPacket(Timeout);
-      l := Length(s);
-      if (rl + l) > Len then
-        l := Len - rl;
-      {$IFDEF CIL}
-      b := BytesOf(s);
-      for n := 0 to l do
-        Buffer[rl + n] := b[n];
-      {$ELSE}
-      Move(Pointer(s)^, IncPoint(Buffer, rl)^, l);
-      {$ENDIF}
-      rl := rl + l;
-      if FLastError <> 0 then
-        Break;
-      if rl >= Len then
-        Break;
-      if not FInterPacketTimeout then
-      begin
-        Timeout := Timeout - integer(TickDelta(ti, GetTick));
-        if Timeout <= 0 then
-        begin
-          FLastError := WSAETIMEDOUT;
-          Break;
-        end;
-      end;
-    until False;
-    delete(s, 1, l);
-    FBuffer := s;
-    Result := rl;
-  end;
-end;
-
-function TBlockSocket.RecvBufferStr(Len: Integer; Timeout: Integer): AnsiString;
-var
-  x: integer;
-{$IFDEF CIL}
-  buf: Tmemory;
-{$ENDIF}
-begin
-  Result := '';
-  if Len > 0 then
-  begin
-    {$IFDEF CIL}
-    Setlength(Buf, Len);
-    x := RecvBufferEx(buf, Len , Timeout);
-    if FLastError = 0 then
-    begin
-      SetLength(Buf, x);
-      Result := StringOf(buf);
-    end
-    else
-      Result := '';
-    {$ELSE}
-    Setlength(Result, Len);
-    x := RecvBufferEx(Pointer(Result), Len , Timeout);
-    if FLastError = 0 then
-      SetLength(Result, x)
-    else
-      Result := '';
-    {$ENDIF}
-  end;
-end;
-
-function TBlockSocket.RecvPacket(Timeout: Integer): AnsiString;
-var
-  x: integer;
-{$IFDEF CIL}
-  buf: TMemory;
-{$ENDIF}
-begin
-  Result := '';
-  ResetLastError;
-  if FBuffer <> '' then
-  begin
-    Result := FBuffer;
-    FBuffer := '';
-  end
-  else
-  begin
-    {$IFDEF MSWINDOWS}
-    //not drain CPU on large downloads...
-    Sleep(0);
-    {$ENDIF}
-    x := WaitingData;
-    if x > 0 then
-    begin
-      {$IFDEF CIL}
-      SetLength(Buf, x);
-      x := RecvBuffer(Buf, x);
-      if x >= 0 then
-      begin
-        SetLength(Buf, x);
-        Result := StringOf(Buf);
-      end;
-      {$ELSE}
-      SetLength(Result, x);
-      x := RecvBuffer(Pointer(Result), x);
-      if x >= 0 then
-        SetLength(Result, x);
-      {$ENDIF}
-    end
-    else
-    begin
-      if CanRead(Timeout) then
-      begin
-        x := WaitingData;
-        if x = 0 then
-          FLastError := WSAECONNRESET;
-        if x > 0 then
-        begin
-          {$IFDEF CIL}
-          SetLength(Buf, x);
-          x := RecvBuffer(Buf, x);
-          if x >= 0 then
-          begin
-            SetLength(Buf, x);
-            result := StringOf(Buf);
-          end;
-          {$ELSE}
-          SetLength(Result, x);
-          x := RecvBuffer(Pointer(Result), x);
-          if x >= 0 then
-            SetLength(Result, x);
-          {$ENDIF}
-        end;
-      end
-      else
-        FLastError := WSAETIMEDOUT;
-    end;
-  end;
-  if FConvertLineEnd and (Result <> '') then
-  begin
-    if FLastCR and (Result[1] = LF) then
-      Delete(Result, 1, 1);
-    if FLastLF and (Result[1] = CR) then
-      Delete(Result, 1, 1);
-    FLastCR := False;
-    FLastLF := False;
-  end;
-  ExceptCheck;
-end;
-
-
-function TBlockSocket.RecvByte(Timeout: Integer): Byte;
-begin
-  Result := 0;
-  ResetLastError;
-  if FBuffer = '' then
-    FBuffer := RecvPacket(Timeout);
-  if (FLastError = 0) and (FBuffer <> '') then
-  begin
-    Result := Ord(FBuffer[1]);
-    Delete(FBuffer, 1, 1);
-  end;
-  ExceptCheck;
-end;
-
-function TBlockSocket.RecvInteger(Timeout: Integer): Integer;
-var
-  s: AnsiString;
-begin
-  Result := 0;
-  s := RecvBufferStr(4, Timeout);
-  if FLastError = 0 then
-    Result := (ord(s[1]) + ord(s[2]) * 256) + (ord(s[3]) + ord(s[4]) * 256) * 65536;
-end;
-
-function TBlockSocket.RecvTerminated(Timeout: Integer; const Terminator: AnsiString): AnsiString;
-var
-  x: Integer;
-  s: AnsiString;
-  l: Integer;
-  CorCRLF: Boolean;
-  t: AnsiString;
-  tl: integer;
-  ti: LongWord;
-begin
-  ResetLastError;
-  Result := '';
-  l := Length(Terminator);
-  if l = 0 then
-    Exit;
-  tl := l;
-  CorCRLF := FConvertLineEnd and (Terminator = CRLF);
-  s := '';
-  x := 0;
-  repeat
-    //get rest of FBuffer or incomming new data...
-    ti := GetTick;
-    s := s + RecvPacket(Timeout);
-    if FLastError <> 0 then
-      Break;
-    x := 0;
-    if Length(s) > 0 then
-      if CorCRLF then
-      begin
-        t := '';
-        x := PosCRLF(s, t);
-        tl := Length(t);
-        if t = CR then
-          FLastCR := True;
-        if t = LF then
-          FLastLF := True;
-      end
-      else
-      begin
-        x := pos(Terminator, s);
-        tl := l;
-      end;
-    if (FMaxLineLength <> 0) and (Length(s) > FMaxLineLength) then
-    begin
-      FLastError := WSAENOBUFS;
-      Break;
-    end;
-    if x > 0 then
-      Break;
-    if not FInterPacketTimeout then
-    begin
-      Timeout := Timeout - integer(TickDelta(ti, GetTick));
-      if Timeout <= 0 then
-      begin
-        FLastError := WSAETIMEDOUT;
-        Break;
-      end;
-    end;
-  until False;
-  if x > 0 then
-  begin
-    Result := Copy(s, 1, x - 1);
-    Delete(s, 1, x + tl - 1);
-  end;
-  FBuffer := s;
-  ExceptCheck;
-end;
-
-function TBlockSocket.RecvString(Timeout: Integer): AnsiString;
-var
-  s: AnsiString;
-begin
-  Result := '';
-  s := RecvTerminated(Timeout, CRLF);
-  if FLastError = 0 then
-    Result := s;
-end;
-
-function TBlockSocket.RecvBlock(Timeout: Integer): AnsiString;
-var
-  x: integer;
-begin
-  Result := '';
-  x := RecvInteger(Timeout);
-  if FLastError = 0 then
-    Result := RecvBufferStr(x, Timeout);
-end;
-
-procedure TBlockSocket.RecvStreamRaw(const Stream: TStream; Timeout: Integer);
-var
-  s: AnsiString;
-begin
-  repeat
-    s := RecvPacket(Timeout);
-    if FLastError = 0 then
-      WriteStrToStream(Stream, s);
-  until FLastError <> 0;
-end;
-
-procedure TBlockSocket.RecvStreamSize(const Stream: TStream; Timeout: Integer; Size: Integer);
-var
-  s: AnsiString;
-  n: integer;
-{$IFDEF CIL}
-  buf: TMemory;
-{$ENDIF}
-begin
-  for n := 1 to (Size div FSendMaxChunk) do
-  begin
-    {$IFDEF CIL}
-    SetLength(buf, FSendMaxChunk);
-    RecvBufferEx(buf, FSendMaxChunk, Timeout);
-    if FLastError <> 0 then
-      Exit;
-    Stream.Write(buf, FSendMaxChunk);
-    {$ELSE}
-    s := RecvBufferStr(FSendMaxChunk, Timeout);
-    if FLastError <> 0 then
-      Exit;
-    WriteStrToStream(Stream, s);
-    {$ENDIF}
-  end;
-  n := Size mod FSendMaxChunk;
-  if n > 0 then
-  begin
-    {$IFDEF CIL}
-    SetLength(buf, n);
-    RecvBufferEx(buf, n, Timeout);
-    if FLastError <> 0 then
-      Exit;
-    Stream.Write(buf, n);
-    {$ELSE}
-    s := RecvBufferStr(n, Timeout);
-    if FLastError <> 0 then
-      Exit;
-    WriteStrToStream(Stream, s);
-    {$ENDIF}
-  end;
-end;
-
-procedure TBlockSocket.RecvStreamIndy(const Stream: TStream; Timeout: Integer);
-var
-  x: integer;
-begin
-  x := RecvInteger(Timeout);
-  x := synsock.NToHL(x);
-  if FLastError = 0 then
-    RecvStreamSize(Stream, Timeout, x);
-end;
-
-procedure TBlockSocket.RecvStream(const Stream: TStream; Timeout: Integer);
-var
-  x: integer;
-begin
-  x := RecvInteger(Timeout);
-  if FLastError = 0 then
-    RecvStreamSize(Stream, Timeout, x);
-end;
-
-function TBlockSocket.PeekBuffer(Buffer: TMemory; Length: Integer): Integer;
-begin
- {$IFNDEF CIL}
-//  Result := synsock.Recv(FSocket, Buffer^, Length, MSG_PEEK + MSG_NOSIGNAL);
-  Result := synsock.Recv(FSocket, Buffer, Length, MSG_PEEK + MSG_NOSIGNAL);
-  SockCheck(Result);
-  ExceptCheck;
-  {$ENDIF}
-end;
-
-function TBlockSocket.PeekByte(Timeout: Integer): Byte;
-var
-  s: string;
-begin
- {$IFNDEF CIL}
-  Result := 0;
-  if CanRead(Timeout) then
-  begin
-    SetLength(s, 1);
-    PeekBuffer(Pointer(s), 1);
-    if s <> '' then
-      Result := Ord(s[1]);
-  end
-  else
-    FLastError := WSAETIMEDOUT;
-  ExceptCheck;
-  {$ENDIF}
-end;
-
-procedure TBlockSocket.ResetLastError;
-begin
-  FLastError := 0;
-  FLastErrorDesc := '';
-end;
-
-function TBlockSocket.SockCheck(SockResult: Integer): Integer;
-begin
-  ResetLastError;
-  if SockResult = integer(SOCKET_ERROR) then
-  begin
-    FLastError := synsock.WSAGetLastError;
-    FLastErrorDesc := GetErrorDescEx;
-  end;
-  Result := FLastError;
-end;
-
-procedure TBlockSocket.ExceptCheck;
-var
-  e: ESynapseError;
-begin
-  FLastErrorDesc := GetErrorDescEx;
-  if (LastError <> 0) and (LastError <> WSAEINPROGRESS)
-    and (LastError <> WSAEWOULDBLOCK) then
-  begin
-    DoStatus(HR_Error, IntToStr(FLastError) + ',' + FLastErrorDesc);
-    if FRaiseExcept then
-    begin
-      e := ESynapseError.Create(Format('Synapse TCP/IP Socket error %d: %s',
-        [FLastError, FLastErrorDesc]));
-      e.ErrorCode := FLastError;
-      e.ErrorMessage := FLastErrorDesc;
-      raise e;
-    end;
-  end;
-end;
-
-function TBlockSocket.WaitingData: Integer;
-var
-  x: Integer;
-begin
-  Result := 0;
-  if synsock.IoctlSocket(FSocket, FIONREAD, x) = 0 then
-    Result := x;
-  if Result > c64k then
-    Result := c64k;
-end;
-
-function TBlockSocket.WaitingDataEx: Integer;
-begin
-  if FBuffer <> '' then
-    Result := Length(FBuffer)
-  else
-    Result := WaitingData;
-end;
-
-procedure TBlockSocket.Purge;
-begin
-  Sleep(1);
-  try
-    while (Length(FBuffer) > 0) or (WaitingData > 0) do
-    begin
-      RecvPacket(0);
-      if FLastError <> 0 then
-        break;
-    end;
-  except
-    on exception do;
-  end;
-  ResetLastError;
-end;
-
-procedure TBlockSocket.SetLinger(Enable: Boolean; Linger: Integer);
-var
-  d: TSynaOption;
-begin
-  d := TSynaOption.Create;
-  d.Option := SOT_Linger;
-  d.Enabled := Enable;
-  d.Value := Linger;
-  DelayedOption(d);
-end;
-
-function TBlockSocket.LocalName: string;
-begin
-  Result := synsock.GetHostName;
-  if Result = '' then
-    Result := '127.0.0.1';
-end;
-
-procedure TBlockSocket.ResolveNameToIP(Name: string; const IPList: TStrings);
-begin
-  IPList.Clear;
-  synsock.ResolveNameToIP(Name, FamilyToAF(FFamily), GetSocketprotocol, GetSocketType, IPList);
-  if IPList.Count = 0 then
-    IPList.Add(cAnyHost);
-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;
-begin
-  Result := synsock.ResolvePort(Port, FamilyToAF(FFamily), GetSocketProtocol, GetSocketType);
-end;
-
-function TBlockSocket.ResolveIPToName(IP: string): string;
-begin
-  if not IsIP(IP) or not IsIp6(IP) then
-    IP := ResolveName(IP);
-  Result := synsock.ResolveIPToName(IP, FamilyToAF(FFamily), GetSocketProtocol, GetSocketType);
-end;
-
-procedure TBlockSocket.SetRemoteSin(IP, Port: string);
-begin
-  SetSin(FRemoteSin, IP, Port);
-end;
-
-function TBlockSocket.GetLocalSinIP: string;
-begin
-  Result := GetSinIP(FLocalSin);
-end;
-
-function TBlockSocket.GetRemoteSinIP: string;
-begin
-  Result := GetSinIP(FRemoteSin);
-end;
-
-function TBlockSocket.GetLocalSinPort: Integer;
-begin
-  Result := GetSinPort(FLocalSin);
-end;
-
-function TBlockSocket.GetRemoteSinPort: Integer;
-begin
-  Result := GetSinPort(FRemoteSin);
-end;
-
-function TBlockSocket.InternalCanRead(Timeout: Integer): Boolean;
-{$IFDEF CIL}
-begin
-  Result := FSocket.Poll(Timeout * 1000, SelectMode.SelectRead);
-{$ELSE}
-var
-  TimeVal: PTimeVal;
-  TimeV: TTimeVal;
-  x: Integer;
-  FDSet: TFDSet;
-begin
-  TimeV.tv_usec := (Timeout mod 1000) * 1000;
-  TimeV.tv_sec := Timeout div 1000;
-  TimeVal := @TimeV;
-  if Timeout = -1 then
-    TimeVal := nil;
-  FDSet := FFdSet;
-  x := synsock.Select(FSocket + 1, @FDSet, nil, nil, TimeVal);
-  SockCheck(x);
-  if FLastError <> 0 then
-    x := 0;
-  Result := x > 0;
-{$ENDIF}
-end;
-
-function TBlockSocket.CanRead(Timeout: Integer): Boolean;
-var
-  ti, tr: Integer;
-  n: integer;
-begin
-  if (FHeartbeatRate <> 0) and (Timeout <> -1) then
-  begin
-    ti := Timeout div FHeartbeatRate;
-    tr := Timeout mod FHeartbeatRate;
-  end
-  else
-  begin
-    ti := 0;
-    tr := Timeout;
-  end;
-  Result := InternalCanRead(tr);
-  if not Result then
-    for n := 0 to ti do
-    begin
-      DoHeartbeat;
-      if FStopFlag then
-      begin
-        Result := False;
-        FStopFlag := False;
-        Break;
-      end;
-      Result := InternalCanRead(FHeartbeatRate);
-      if Result then
-        break;
-    end;
-  ExceptCheck;
-  if Result then
-    DoStatus(HR_CanRead, '');
-end;
-
-function TBlockSocket.CanWrite(Timeout: Integer): Boolean;
-{$IFDEF CIL}
-begin
-  Result := FSocket.Poll(Timeout * 1000, SelectMode.SelectWrite);
-{$ELSE}
-var
-  TimeVal: PTimeVal;
-  TimeV: TTimeVal;
-  x: Integer;
-  FDSet: TFDSet;
-begin
-  TimeV.tv_usec := (Timeout mod 1000) * 1000;
-  TimeV.tv_sec := Timeout div 1000;
-  TimeVal := @TimeV;
-  if Timeout = -1 then
-    TimeVal := nil;
-  FDSet := FFdSet;
-  x := synsock.Select(FSocket + 1, nil, @FDSet, nil, TimeVal);
-  SockCheck(x);
-  if FLastError <> 0 then
-    x := 0;
-  Result := x > 0;
-{$ENDIF}
-  ExceptCheck;
-  if Result then
-    DoStatus(HR_CanWrite, '');
-end;
-
-function TBlockSocket.CanReadEx(Timeout: Integer): Boolean;
-begin
-  if FBuffer <> '' then
-    Result := True
-  else
-    Result := CanRead(Timeout);
-end;
-
-function TBlockSocket.SendBufferTo(Buffer: TMemory; Length: Integer): Integer;
-begin
-  Result := 0;
-  if TestStopFlag then
-    Exit;
-  DoMonitor(True, Buffer, Length);
-  LimitBandwidth(Length, FMaxSendBandwidth, FNextsend);
-  Result := synsock.SendTo(FSocket, Buffer, Length, MSG_NOSIGNAL, FRemoteSin);
-  SockCheck(Result);
-  ExceptCheck;
-  Inc(FSendCounter, Result);
-  DoStatus(HR_WriteCount, IntToStr(Result));
-end;
-
-function TBlockSocket.RecvBufferFrom(Buffer: TMemory; Length: Integer): Integer;
-begin
-  Result := 0;
-  if TestStopFlag then
-    Exit;
-  LimitBandwidth(Length, FMaxRecvBandwidth, FNextRecv);
-  Result := synsock.RecvFrom(FSocket, Buffer, Length, MSG_NOSIGNAL, FRemoteSin);
-  SockCheck(Result);
-  ExceptCheck;
-  Inc(FRecvCounter, Result);
-  DoStatus(HR_ReadCount, IntToStr(Result));
-  DoMonitor(False, Buffer, Result);
-end;
-
-function TBlockSocket.GetSizeRecvBuffer: Integer;
-var
-  l: Integer;
-{$IFDEF CIL}
-  buf: TMemory;
-{$ENDIF}
-begin
-{$IFDEF CIL}
-  setlength(buf, 4);
-  SockCheck(synsock.GetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_RCVBUF), buf, l));
-  Result := System.BitConverter.ToInt32(buf,0);
-{$ELSE}
-  l := SizeOf(Result);
-  SockCheck(synsock.GetSockOpt(FSocket, SOL_SOCKET, SO_RCVBUF, @Result, l));
-  if FLastError <> 0 then
-    Result := 1024;
-  ExceptCheck;
-{$ENDIF}
-end;
-
-procedure TBlockSocket.SetSizeRecvBuffer(Size: Integer);
-var
-  d: TSynaOption;
-begin
-  d := TSynaOption.Create;
-  d.Option := SOT_RecvBuff;
-  d.Value := Size;
-  DelayedOption(d);
-end;
-
-function TBlockSocket.GetSizeSendBuffer: Integer;
-var
-  l: Integer;
-{$IFDEF CIL}
-  buf: TMemory;
-{$ENDIF}
-begin
-{$IFDEF CIL}
-  setlength(buf, 4);
-  SockCheck(synsock.GetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_SNDBUF), buf, l));
-  Result := System.BitConverter.ToInt32(buf,0);
-{$ELSE}
-  l := SizeOf(Result);
-  SockCheck(synsock.GetSockOpt(FSocket, SOL_SOCKET, SO_SNDBUF, @Result, l));
-  if FLastError <> 0 then
-    Result := 1024;
-  ExceptCheck;
-{$ENDIF}
-end;
-
-procedure TBlockSocket.SetSizeSendBuffer(Size: Integer);
-var
-  d: TSynaOption;
-begin
-  d := TSynaOption.Create;
-  d.Option := SOT_SendBuff;
-  d.Value := Size;
-  DelayedOption(d);
-end;
-
-procedure TBlockSocket.SetNonBlockMode(Value: Boolean);
-var
-  d: TSynaOption;
-begin
-  d := TSynaOption.Create;
-  d.Option := SOT_nonblock;
-  d.Enabled := Value;
-  DelayedOption(d);
-end;
-
-procedure TBlockSocket.SetTimeout(Timeout: Integer);
-begin
-  SetSendTimeout(Timeout);
-  SetRecvTimeout(Timeout);
-end;
-
-procedure TBlockSocket.SetSendTimeout(Timeout: Integer);
-var
-  d: TSynaOption;
-begin
-  d := TSynaOption.Create;
-  d.Option := SOT_sendtimeout;
-  d.Value := Timeout;
-  DelayedOption(d);
-end;
-
-procedure TBlockSocket.SetRecvTimeout(Timeout: Integer);
-var
-  d: TSynaOption;
-begin
-  d := TSynaOption.Create;
-  d.Option := SOT_recvtimeout;
-  d.Value := Timeout;
-  DelayedOption(d);
-end;
-
-{$IFNDEF CIL}
-function TBlockSocket.GroupCanRead(const SocketList: TList; Timeout: Integer;
-  const CanReadList: TList): boolean;
-var
-  FDSet: TFDSet;
-  TimeVal: PTimeVal;
-  TimeV: TTimeVal;
-  x, n: Integer;
-  Max: Integer;
-begin
-  TimeV.tv_usec := (Timeout mod 1000) * 1000;
-  TimeV.tv_sec := Timeout div 1000;
-  TimeVal := @TimeV;
-  if Timeout = -1 then
-    TimeVal := nil;
-  FD_ZERO(FDSet);
-  Max := 0;
-  for n := 0 to SocketList.Count - 1 do
-    if TObject(SocketList.Items[n]) is TBlockSocket then
-    begin
-      if TBlockSocket(SocketList.Items[n]).Socket > Max then
-        Max := TBlockSocket(SocketList.Items[n]).Socket;
-      FD_SET(TBlockSocket(SocketList.Items[n]).Socket, FDSet);
-    end;
-  x := synsock.Select(Max + 1, @FDSet, nil, nil, TimeVal);
-  SockCheck(x);
-  ExceptCheck;
-  if FLastError <> 0 then
-    x := 0;
-  Result := x > 0;
-  CanReadList.Clear;
-  if Result then
-    for n := 0 to SocketList.Count - 1 do
-      if TObject(SocketList.Items[n]) is TBlockSocket then
-        if FD_ISSET(TBlockSocket(SocketList.Items[n]).Socket, FDSet) then
-          CanReadList.Add(TBlockSocket(SocketList.Items[n]));
-end;
-{$ENDIF}
-
-procedure TBlockSocket.EnableReuse(Value: Boolean);
-var
-  d: TSynaOption;
-begin
-  d := TSynaOption.Create;
-  d.Option := SOT_reuse;
-  d.Enabled := Value;
-  DelayedOption(d);
-end;
-
-procedure TBlockSocket.SetTTL(TTL: integer);
-var
-  d: TSynaOption;
-begin
-  d := TSynaOption.Create;
-  d.Option := SOT_TTL;
-  d.Value := TTL;
-  DelayedOption(d);
-end;
-
-function TBlockSocket.GetTTL:integer;
-var
-  l: Integer;
-begin
-{$IFNDEF CIL}
-  l := SizeOf(Result);
-  if FIP6Used then
-    synsock.GetSockOpt(FSocket, IPPROTO_IPV6, IPV6_UNICAST_HOPS, @Result, l)
-  else
-    synsock.GetSockOpt(FSocket, IPPROTO_IP, IP_TTL, @Result, l);
-{$ENDIF}
-end;
-
-procedure TBlockSocket.SetFamily(Value: TSocketFamily);
-begin
-  FFamily := Value;
-  FFamilySave := Value;
-end;
-
-procedure TBlockSocket.SetSocket(Value: TSocket);
-begin
-  FRecvCounter := 0;
-  FSendCounter := 0;
-  FSocket := Value;
-{$IFNDEF CIL}
-  FD_ZERO(FFDSet);
-  FD_SET(FSocket, FFDSet);
-{$ENDIF}
-  GetSins;
-  FIP6Used := FRemoteSin.AddressFamily = AF_INET6;
-end;
-
-function TBlockSocket.GetWsaData: TWSAData;
-begin
-  Result := WsaDataOnce;
-end;
-
-function TBlockSocket.GetSocketType: integer;
-begin
-  Result := 0;
-end;
-
-function TBlockSocket.GetSocketProtocol: integer;
-begin
-  Result := integer(IPPROTO_IP);
-end;
-
-procedure TBlockSocket.DoStatus(Reason: THookSocketReason; const Value: string);
-begin
-  if assigned(OnStatus) then
-    OnStatus(Self, Reason, Value);
-end;
-
-procedure TBlockSocket.DoReadFilter(Buffer: TMemory; var Len: Integer);
-var
-  s: AnsiString;
-begin
-  if assigned(OnReadFilter) then
-    if Len > 0 then
-      begin
-        {$IFDEF CIL}
-        s := StringOf(Buffer);
-        {$ELSE}
-        SetLength(s, Len);
-        Move(Buffer^, Pointer(s)^, Len);
-        {$ENDIF}
-        OnReadFilter(Self, s);
-        if Length(s) > Len then
-          SetLength(s, Len);
-        Len := Length(s);
-        {$IFDEF CIL}
-        Buffer := BytesOf(s);
-        {$ELSE}
-        Move(Pointer(s)^, Buffer^, Len);
-        {$ENDIF}
-      end;
-end;
-
-procedure TBlockSocket.DoCreateSocket;
-begin
-  if assigned(OnCreateSocket) then
-    OnCreateSocket(Self);
-end;
-
-procedure TBlockSocket.DoMonitor(Writing: Boolean; const Buffer: TMemory; Len: Integer);
-begin
-  if assigned(OnMonitor) then
-  begin
-    OnMonitor(Self, Writing, Buffer, Len);
-  end;
-end;
-
-procedure TBlockSocket.DoHeartbeat;
-begin
-  if assigned(OnHeartbeat) and (FHeartbeatRate <> 0) then
-  begin
-    OnHeartbeat(Self);
-  end;
-end;
-
-function TBlockSocket.GetErrorDescEx: string;
-begin
-  Result := GetErrorDesc(FLastError);
-end;
-
-class function TBlockSocket.GetErrorDesc(ErrorCode: Integer): string;
-begin
-{$IFDEF CIL}
-  if ErrorCode = 0 then
-    Result := ''
-  else
-  begin
-    Result := WSAGetLastErrorDesc;
-    if Result = '' then
-      Result := 'Other Winsock error (' + IntToStr(ErrorCode) + ')';
-  end;
-{$ELSE}
-  case ErrorCode of
-    0:
-      Result := '';
-    WSAEINTR: {10004}
-      Result := 'Interrupted system call';
-    WSAEBADF: {10009}
-      Result := 'Bad file number';
-    WSAEACCES: {10013}
-      Result := 'Permission denied';
-    WSAEFAULT: {10014}
-      Result := 'Bad address';
-    WSAEINVAL: {10022}
-      Result := 'Invalid argument';
-    WSAEMFILE: {10024}
-      Result := 'Too many open files';
-    WSAEWOULDBLOCK: {10035}
-      Result := 'Operation would block';
-    WSAEINPROGRESS: {10036}
-      Result := 'Operation now in progress';
-    WSAEALREADY: {10037}
-      Result := 'Operation already in progress';
-    WSAENOTSOCK: {10038}
-      Result := 'Socket operation on nonsocket';
-    WSAEDESTADDRREQ: {10039}
-      Result := 'Destination address required';
-    WSAEMSGSIZE: {10040}
-      Result := 'Message too long';
-    WSAEPROTOTYPE: {10041}
-      Result := 'Protocol wrong type for Socket';
-    WSAENOPROTOOPT: {10042}
-      Result := 'Protocol not available';
-    WSAEPROTONOSUPPORT: {10043}
-      Result := 'Protocol not supported';
-    WSAESOCKTNOSUPPORT: {10044}
-      Result := 'Socket not supported';
-    WSAEOPNOTSUPP: {10045}
-      Result := 'Operation not supported on Socket';
-    WSAEPFNOSUPPORT: {10046}
-      Result := 'Protocol family not supported';
-    WSAEAFNOSUPPORT: {10047}
-      Result := 'Address family not supported';
-    WSAEADDRINUSE: {10048}
-      Result := 'Address already in use';
-    WSAEADDRNOTAVAIL: {10049}
-      Result := 'Can''t assign requested address';
-    WSAENETDOWN: {10050}
-      Result := 'Network is down';
-    WSAENETUNREACH: {10051}
-      Result := 'Network is unreachable';
-    WSAENETRESET: {10052}
-      Result := 'Network dropped connection on reset';
-    WSAECONNABORTED: {10053}
-      Result := 'Software caused connection abort';
-    WSAECONNRESET: {10054}
-      Result := 'Connection reset by peer';
-    WSAENOBUFS: {10055}
-      Result := 'No Buffer space available';
-    WSAEISCONN: {10056}
-      Result := 'Socket is already connected';
-    WSAENOTCONN: {10057}
-      Result := 'Socket is not connected';
-    WSAESHUTDOWN: {10058}
-      Result := 'Can''t send after Socket shutdown';
-    WSAETOOMANYREFS: {10059}
-      Result := 'Too many references:can''t splice';
-    WSAETIMEDOUT: {10060}
-      Result := 'Connection timed out';
-    WSAECONNREFUSED: {10061}
-      Result := 'Connection refused';
-    WSAELOOP: {10062}
-      Result := 'Too many levels of symbolic links';
-    WSAENAMETOOLONG: {10063}
-      Result := 'File name is too long';
-    WSAEHOSTDOWN: {10064}
-      Result := 'Host is down';
-    WSAEHOSTUNREACH: {10065}
-      Result := 'No route to host';
-    WSAENOTEMPTY: {10066}
-      Result := 'Directory is not empty';
-    WSAEPROCLIM: {10067}
-      Result := 'Too many processes';
-    WSAEUSERS: {10068}
-      Result := 'Too many users';
-    WSAEDQUOT: {10069}
-      Result := 'Disk quota exceeded';
-    WSAESTALE: {10070}
-      Result := 'Stale NFS file handle';
-    WSAEREMOTE: {10071}
-      Result := 'Too many levels of remote in path';
-    WSASYSNOTREADY: {10091}
-      Result := 'Network subsystem is unusable';
-    WSAVERNOTSUPPORTED: {10092}
-      Result := 'Winsock DLL cannot support this application';
-    WSANOTINITIALISED: {10093}
-      Result := 'Winsock not initialized';
-    WSAEDISCON: {10101}
-      Result := 'Disconnect';
-    WSAHOST_NOT_FOUND: {11001}
-      Result := 'Host not found';
-    WSATRY_AGAIN: {11002}
-      Result := 'Non authoritative - host not found';
-    WSANO_RECOVERY: {11003}
-      Result := 'Non recoverable error';
-    WSANO_DATA: {11004}
-      Result := 'Valid name, no data record of requested type'
-  else
-    Result := 'Other Winsock error (' + IntToStr(ErrorCode) + ')';
-  end;
-{$ENDIF}
-end;
-
-{======================================================================}
-
-constructor TSocksBlockSocket.Create;
-begin
-  inherited Create;
-  FSocksIP:= '';
-  FSocksPort:= '1080';
-  FSocksTimeout:= 60000;
-  FSocksUsername:= '';
-  FSocksPassword:= '';
-  FUsingSocks := False;
-  FSocksResolver := True;
-  FSocksLastError := 0;
-  FSocksResponseIP := '';
-  FSocksResponsePort := '';
-  FSocksLocalIP := '';
-  FSocksLocalPort := '';
-  FSocksRemoteIP := '';
-  FSocksRemotePort := '';
-  FBypassFlag := False;
-  FSocksType := ST_Socks5;
-end;
-
-function TSocksBlockSocket.SocksOpen: boolean;
-var
-  Buf: AnsiString;
-  n: integer;
-begin
-  Result := False;
-  FUsingSocks := False;
-  if FSocksType <> ST_Socks5 then
-  begin
-    FUsingSocks := True;
-    Result := True;
-  end
-  else
-  begin
-    FBypassFlag := True;
-    try
-      if FSocksUsername = '' then
-        Buf := #5 + #1 + #0
-      else
-        Buf := #5 + #2 + #2 +#0;
-      SendString(Buf);
-      Buf := RecvBufferStr(2, FSocksTimeout);
-      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 + AnsiChar(Length(FSocksUsername)) + FSocksUsername
-              + AnsiChar(Length(FSocksPassword)) + FSocksPassword;
-            SendString(Buf);
-            Buf := RecvBufferStr(2, FSocksTimeout);
-            if Length(Buf) < 2 then
-              Exit;
-            if Buf[2] <> #0 then
-              Exit;
-          end;
-      else
-        //other authorisation is not supported!
-        Exit;
-      end;
-      FUsingSocks := True;
-      Result := True;
-    finally
-      FBypassFlag := False;
-    end;
-  end;
-end;
-
-function TSocksBlockSocket.SocksRequest(Cmd: Byte;
-  const IP, Port: string): Boolean;
-var
-  Buf: AnsiString;
-begin
-  FBypassFlag := True;
-  try
-    if FSocksType <> ST_Socks5 then
-      Buf := #4 + AnsiChar(Cmd) + SocksCode(IP, Port)
-    else
-      Buf := #5 + AnsiChar(Cmd) + #0 + SocksCode(IP, Port);
-    SendString(Buf);
-    Result := FLastError = 0;
-  finally
-    FBypassFlag := False;
-  end;
-end;
-
-function TSocksBlockSocket.SocksResponse: Boolean;
-var
-  Buf, s: AnsiString;
-  x: integer;
-begin
-  Result := False;
-  FBypassFlag := True;
-  try
-    FSocksResponseIP := '';
-    FSocksResponsePort := '';
-    FSocksLastError := -1;
-    if FSocksType <> ST_Socks5 then
-    begin
-      Buf := RecvBufferStr(8, FSocksTimeout);
-      if FLastError <> 0 then
-        Exit;
-      if Buf[1] <> #0 then
-        Exit;
-      FSocksLastError := Ord(Buf[2]);
-    end
-    else
-    begin
-      Buf := RecvBufferStr(4, FSocksTimeout);
-      if FLastError <> 0 then
-        Exit;
-      if Buf[1] <> #5 then
-        Exit;
-      case Ord(Buf[4]) of
-        1:
-          s := RecvBufferStr(4, FSocksTimeout);
-        3:
-          begin
-            x := RecvByte(FSocksTimeout);
-            if FLastError <> 0 then
-              Exit;
-            s := AnsiChar(x) + RecvBufferStr(x, FSocksTimeout);
-          end;
-        4:
-          s := RecvBufferStr(16, FSocksTimeout);
-      else
-        Exit;
-      end;
-      Buf := Buf + s + RecvBufferStr(2, FSocksTimeout);
-      if FLastError <> 0 then
-        Exit;
-      FSocksLastError := Ord(Buf[2]);
-    end;
-    if ((FSocksLastError <> 0) and (FSocksLastError <> 90)) then
-      Exit;
-    SocksDecode(Buf);
-    Result := True;
-  finally
-    FBypassFlag := False;
-  end;
-end;
-
-function TSocksBlockSocket.SocksCode(IP, Port: string): Ansistring;
-var
-  ip6: TIp6Bytes;
-  n: integer;
-begin
-  if FSocksType <> ST_Socks5 then
-  begin
-    Result := CodeInt(ResolvePort(Port));
-    if not FSocksResolver then
-      IP := ResolveName(IP);
-    if IsIP(IP) then
-    begin
-      Result := Result + IPToID(IP);
-      Result := Result + FSocksUsername + #0;
-    end
-    else
-    begin
-      Result := Result + IPToID('0.0.0.1');
-      Result := Result + FSocksUsername + #0;
-      Result := Result + IP + #0;
-    end;
-  end
-  else
-  begin
-    if not FSocksResolver then
-      IP := ResolveName(IP);
-    if IsIP(IP) then
-      Result := #1 + IPToID(IP)
-    else
-      if IsIP6(IP) then
-      begin
-        ip6 := StrToIP6(IP);
-        Result := #4;
-        for n := 0 to 15 do
-          Result := Result + AnsiChar(ip6[n]);
-      end
-      else
-        Result := #3 + AnsiChar(Length(IP)) + IP;
-    Result := Result + CodeInt(ResolvePort(Port));
-  end;
-end;
-
-function TSocksBlockSocket.SocksDecode(Value: Ansistring): integer;
-var
-  Atyp: Byte;
-  y, n: integer;
-  w: Word;
-  ip6: TIp6Bytes;
-begin
-  FSocksResponsePort := '0';
-  Result := 0;
-  if FSocksType <> ST_Socks5 then
-  begin
-    if Length(Value) < 8 then
-      Exit;
-    Result := 3;
-    w := DecodeInt(Value, Result);
-    FSocksResponsePort := IntToStr(w);
-    FSocksResponseIP := Format('%d.%d.%d.%d',
-      [Ord(Value[5]), Ord(Value[6]), Ord(Value[7]), Ord(Value[8])]);
-    Result := 9;
-  end
-  else
-  begin
-    if Length(Value) < 4 then
-      Exit;
-    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 - 1 do
-            FSocksResponseIP := FSocksResponseIP + Value[n];
-          Result := 5 + y + 1;
-        end;
-      4:
-        begin
-          if Length(Value) < 22 then
-            Exit;
-          for n := 0 to 15 do
-            ip6[n] := ord(Value[n + 5]);
-          FSocksResponseIP := IP6ToStr(ip6);
-          Result := 21;
-        end;
-    else
-      Exit;
-    end;
-    w := DecodeInt(Value, Result);
-    FSocksResponsePort := IntToStr(w);
-    Result := Result + 2;
-  end;
-end;
-
-{======================================================================}
-
-procedure TDgramBlockSocket.Connect(IP, Port: string);
-begin
-  SetRemoteSin(IP, Port);
-  InternalCreateSocket(FRemoteSin);
-  FBuffer := '';
-  DoStatus(HR_Connect, IP + ':' + Port);
-end;
-
-function TDgramBlockSocket.RecvBuffer(Buffer: TMemory; Length: Integer): Integer;
-begin
-  Result := RecvBufferFrom(Buffer, Length);
-end;
-
-function TDgramBlockSocket.SendBuffer(Buffer: TMemory; Length: Integer): Integer;
-begin
-  Result := SendBufferTo(Buffer, Length);
-end;
-
-{======================================================================}
-
-destructor TUDPBlockSocket.Destroy;
-begin
-  if Assigned(FSocksControlSock) then
-    FSocksControlSock.Free;
-  inherited;
-end;
-
-procedure TUDPBlockSocket.EnableBroadcast(Value: Boolean);
-var
-  d: TSynaOption;
-begin
-  d := TSynaOption.Create;
-  d.Option := SOT_Broadcast;
-  d.Enabled := Value;
-  DelayedOption(d);
-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.CreateSocketByName(FSocksIP);
-    FSocksControlSock.Connect(FSocksIP, FSocksPort);
-    if FSocksControlSock.LastError <> 0 then
-      Exit;
-    // if not assigned local port, assign it!
-    if not FBinded then
-      Bind(cAnyHost, cAnyPort);
-    //open control TCP connection to SOCKS
-    FSocksControlSock.FSocksUsername := FSocksUsername;
-    FSocksControlSock.FSocksPassword := FSocksPassword;
-    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 := b and (FLastError = 0);
-  end;
-end;
-
-function TUDPBlockSocket.SendBufferTo(Buffer: TMemory; Length: Integer): Integer;
-var
-  SIp: string;
-  SPort: integer;
-  Buf: Ansistring;
-begin
-  Result := 0;
-  FUsingSocks := False;
-  if (FSocksIP <> '') and (not UdpAssociation) then
-    FLastError := WSANO_RECOVERY
-  else
-  begin
-    if FUsingSocks then
-    begin
-{$IFNDEF CIL}
-      Sip := GetRemoteSinIp;
-      SPort := GetRemoteSinPort;
-      SetRemoteSin(FSocksRemoteIP, FSocksRemotePort);
-      SetLength(Buf,Length);
-      Move(Buffer^, Pointer(Buf)^, Length);
-      Buf := #0 + #0 + #0 + SocksCode(Sip, IntToStr(SPort)) + Buf;
-      Result := inherited SendBufferTo(Pointer(Buf), System.Length(buf));
-      SetRemoteSin(Sip, IntToStr(SPort));
-{$ENDIF}
-    end
-    else
-      Result := inherited SendBufferTo(Buffer, Length);
-  end;
-end;
-
-function TUDPBlockSocket.RecvBufferFrom(Buffer: TMemory; Length: Integer): Integer;
-var
-  Buf: Ansistring;
-  x: integer;
-begin
-  Result := inherited RecvBufferFrom(Buffer, Length);
-  if FUsingSocks then
-  begin
-{$IFNDEF CIL}
-    SetLength(Buf, Result);
-    Move(Buffer^, Pointer(Buf)^, Result);
-    x := SocksDecode(Buf);
-    Result := Result - x + 1;
-    Buf := Copy(Buf, x, Result);
-    Move(Pointer(Buf)^, Buffer^, Result);
-    SetRemoteSin(FSocksResponseIP, FSocksResponsePort);
-{$ENDIF}
-  end;
-end;
-
-{$IFNDEF CIL}
-procedure TUDPBlockSocket.AddMulticast(MCastIP: string);
-var
-  Multicast: TIP_mreq;
-  Multicast6: TIPv6_mreq;
-  n: integer;
-  ip6: Tip6bytes;
-begin
-  if FIP6Used then
-  begin
-    ip6 := StrToIp6(MCastIP);
-    for n := 0 to 15 do
-      Multicast6.ipv6mr_multiaddr.u6_addr8[n] := Ip6[n];
-    Multicast6.ipv6mr_interface := 0;
-    SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IPV6, IPV6_JOIN_GROUP,
-      PAnsiChar(@Multicast6), SizeOf(Multicast6)));
-  end
-  else
-  begin
-    Multicast.imr_multiaddr.S_addr := swapbytes(strtoip(MCastIP));
-    Multicast.imr_interface.S_addr := INADDR_ANY;
-    SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IP, IP_ADD_MEMBERSHIP,
-      PAnsiChar(@Multicast), SizeOf(Multicast)));
-  end;
-  ExceptCheck;
-end;
-
-procedure TUDPBlockSocket.DropMulticast(MCastIP: string);
-var
-  Multicast: TIP_mreq;
-  Multicast6: TIPv6_mreq;
-  n: integer;
-  ip6: Tip6bytes;
-begin
-  if FIP6Used then
-  begin
-    ip6 := StrToIp6(MCastIP);
-    for n := 0 to 15 do
-      Multicast6.ipv6mr_multiaddr.u6_addr8[n] := Ip6[n];
-    Multicast6.ipv6mr_interface := 0;
-    SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IPV6, IPV6_LEAVE_GROUP,
-      PAnsiChar(@Multicast6), SizeOf(Multicast6)));
-  end
-  else
-  begin
-    Multicast.imr_multiaddr.S_addr := swapbytes(strtoip(MCastIP));
-    Multicast.imr_interface.S_addr := INADDR_ANY;
-    SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IP, IP_DROP_MEMBERSHIP,
-      PAnsiChar(@Multicast), SizeOf(Multicast)));
-  end;
-  ExceptCheck;
-end;
-{$ENDIF}
-
-procedure TUDPBlockSocket.SetMulticastTTL(TTL: integer);
-var
-  d: TSynaOption;
-begin
-  d := TSynaOption.Create;
-  d.Option := SOT_MulticastTTL;
-  d.Value := TTL;
-  DelayedOption(d);
-end;
-
-function TUDPBlockSocket.GetMulticastTTL:integer;
-var
-  l: Integer;
-begin
-{$IFNDEF CIL}
-  l := SizeOf(Result);
-  if FIP6Used then
-    synsock.GetSockOpt(FSocket, IPPROTO_IPV6, IPV6_MULTICAST_HOPS, @Result, l)
-  else
-    synsock.GetSockOpt(FSocket, IPPROTO_IP, IP_MULTICAST_TTL, @Result, l);
-{$ENDIF}
-end;
-
-procedure TUDPBlockSocket.EnableMulticastLoop(Value: Boolean);
-var
-  d: TSynaOption;
-begin
-  d := TSynaOption.Create;
-  d.Option := SOT_MulticastLoop;
-  d.Enabled := Value;
-  DelayedOption(d);
-end;
-
-function TUDPBlockSocket.GetSocketType: integer;
-begin
-  Result := integer(SOCK_DGRAM);
-end;
-
-function TUDPBlockSocket.GetSocketProtocol: integer;
-begin
- Result := integer(IPPROTO_UDP);
-end;
-
-{======================================================================}
-constructor TTCPBlockSocket.CreateWithSSL(SSLPlugin: TSSLClass);
-begin
-  inherited Create;
-  FSSL := SSLPlugin.Create(self);
-  FHTTPTunnelIP := '';
-  FHTTPTunnelPort := '';
-  FHTTPTunnel := False;
-  FHTTPTunnelRemoteIP := '';
-  FHTTPTunnelRemotePort := '';
-  FHTTPTunnelUser := '';
-  FHTTPTunnelPass := '';
-  FHTTPTunnelTimeout := 30000;
-end;
-
-constructor TTCPBlockSocket.Create;
-begin
-  CreateWithSSL(SSLImplementation);
-end;
-
-destructor TTCPBlockSocket.Destroy;
-begin
-  inherited Destroy;
-  FSSL.Free;
-end;
-
-function TTCPBlockSocket.GetErrorDescEx: string;
-begin
-  Result := inherited GetErrorDescEx;
-  if (FLastError = WSASYSNOTREADY) and (self.SSL.LastError <> 0) then
-  begin
-    Result := self.SSL.LastErrorDesc;
-  end;
-end;
-
-procedure TTCPBlockSocket.CloseSocket;
-begin
-  if FSSL.SSLEnabled then
-    FSSL.Shutdown;
-  if (FSocket <> INVALID_SOCKET) and (FLastError = 0) then
-  begin
-    Synsock.Shutdown(FSocket, 1);
-    Purge;
-  end;
-  inherited CloseSocket;
-end;
-
-procedure TTCPBlockSocket.DoAfterConnect;
-begin
-  if assigned(OnAfterConnect) then
-  begin
-    OnAfterConnect(Self);
-  end;
-end;
-
-function TTCPBlockSocket.WaitingData: Integer;
-begin
-  Result := 0;
-  if FSSL.SSLEnabled and (FSocket <> INVALID_SOCKET) then
-    Result := FSSL.WaitingData;
-  if Result = 0 then
-    Result := inherited WaitingData;
-end;
-
-procedure TTCPBlockSocket.Listen;
-var
-  b: Boolean;
-  Sip,SPort: string;
-begin
-  if FSocksIP = '' then
-  begin
-    inherited Listen;
-  end
-  else
-  begin
-    Sip := GetLocalSinIP;
-    if Sip = cAnyHost then
-      Sip := LocalName;
-    SPort := IntToStr(GetLocalSinPort);
-    inherited 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 = cAnyHost then
-      FSocksLocalIP := FSocksIP;
-    FSocksLocalPort := FSocksResponsePort;
-    FSocksRemoteIP := '';
-    FSocksRemotePort := '';
-    ExceptCheck;
-    DoStatus(HR_Listen, '');
-  end;
-end;
-
-function TTCPBlockSocket.Accept: TSocket;
-begin
-  if FUsingSocks then
-  begin
-    if not SocksResponse and (FLastError = 0) then
-      FLastError := WSANO_RECOVERY;
-    FSocksRemoteIP := FSocksResponseIP;
-    FSocksRemotePort := FSocksResponsePort;
-    Result := FSocket;
-    ExceptCheck;
-    DoStatus(HR_Accept, '');
-  end
-  else
-  begin
-    result := inherited Accept;
-  end;
-end;
-
-procedure TTCPBlockSocket.Connect(IP, Port: string);
-begin
-  if FSocksIP <> '' then
-    SocksDoConnect(IP, Port)
-  else
-    if FHTTPTunnelIP <> '' then
-      HTTPTunnelDoConnect(IP, Port)
-    else
-      inherited Connect(IP, Port);
-  if FLasterror = 0 then
-    DoAfterConnect;
-end;
-
-procedure TTCPBlockSocket.SocksDoConnect(IP, Port: string);
-var
-  b: Boolean;
-begin
-  inherited Connect(FSocksIP, FSocksPort);
-  if FLastError = 0 then
-  begin
-    b := SocksOpen;
-    if b then
-      b := SocksRequest(1, IP, Port);
-    if b then
-      b := SocksResponse;
-    if not b and (FLastError = 0) then
-      FLastError := WSASYSNOTREADY;
-    FSocksLocalIP := FSocksResponseIP;
-    FSocksLocalPort := FSocksResponsePort;
-    FSocksRemoteIP := IP;
-    FSocksRemotePort := Port;
-  end;
-  ExceptCheck;
-  DoStatus(HR_Connect, IP + ':' + Port);
-end;
-
-procedure TTCPBlockSocket.HTTPTunnelDoConnect(IP, Port: string);
-//bugfixed by Mike Green (mgreen@emixode.com)
-var
-  s: string;
-begin
-  Port := IntToStr(ResolvePort(Port));
-  inherited Connect(FHTTPTunnelIP, FHTTPTunnelPort);
-  if FLastError <> 0 then
-    Exit;
-  FHTTPTunnel := False;
-  if IsIP6(IP) then
-    IP := '[' + IP + ']';
-  SendString('CONNECT ' + IP + ':' + Port + ' HTTP/1.0' + CRLF);
-  if FHTTPTunnelUser <> '' then
-  Sendstring('Proxy-Authorization: Basic ' +
-    EncodeBase64(FHTTPTunnelUser + ':' + FHTTPTunnelPass) + CRLF);
-  SendString(CRLF);
-  repeat
-    s := RecvTerminated(FHTTPTunnelTimeout, #$0a);
-    if FLastError <> 0 then
-      Break;
-    if (Pos('HTTP/', s) = 1) and (Length(s) > 11) then
-      FHTTPTunnel := s[10] = '2';
-  until (s = '') or (s = #$0d);
-  if (FLasterror = 0) and not FHTTPTunnel then
-    FLastError := WSASYSNOTREADY;
-  FHTTPTunnelRemoteIP := IP;
-  FHTTPTunnelRemotePort := Port;
-  ExceptCheck;
-end;
-
-procedure TTCPBlockSocket.SSLDoConnect;
-begin
-  ResetLastError;
-  if not FSSL.Connect then
-    FLastError := WSASYSNOTREADY;
-  ExceptCheck;
-end;
-
-procedure TTCPBlockSocket.SSLDoShutdown;
-begin
-  ResetLastError;
-  FSSL.BiShutdown;
-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
-    if FHTTPTunnel then
-      Result := FHTTPTunnelRemoteIP
-    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 := ResolvePort(FSocksRemotePort)
-  else
-    if FHTTPTunnel then
-      Result := StrToIntDef(FHTTPTunnelRemotePort, 0)
-    else
-      Result := inherited GetRemoteSinPort;
-end;
-
-function TTCPBlockSocket.RecvBuffer(Buffer: TMemory; Len: Integer): Integer;
-begin
-  if FSSL.SSLEnabled then
-  begin
-    Result := 0;
-    if TestStopFlag then
-      Exit;
-    ResetLastError;
-    LimitBandwidth(Len, FMaxRecvBandwidth, FNextRecv);
-    Result := FSSL.RecvBuffer(Buffer, Len);
-    if FSSL.LastError <> 0 then
-      FLastError := WSASYSNOTREADY;
-    ExceptCheck;
-    Inc(FRecvCounter, Result);
-    DoStatus(HR_ReadCount, IntToStr(Result));
-    DoMonitor(False, Buffer, Result);
-    DoReadFilter(Buffer, Result);
-  end
-  else
-    Result := inherited RecvBuffer(Buffer, Len);
-end;
-
-function TTCPBlockSocket.SendBuffer(Buffer: TMemory; Length: Integer): Integer;
-var
-  x, y: integer;
-  l, r: integer;
-{$IFNDEF CIL}
-  p: Pointer;
-{$ENDIF}
-begin
-  if FSSL.SSLEnabled then
-  begin
-    Result := 0;
-    if TestStopFlag then
-      Exit;
-    ResetLastError;
-    DoMonitor(True, Buffer, Length);
-{$IFDEF CIL}
-    Result := FSSL.SendBuffer(Buffer, Length);
-    if FSSL.LastError <> 0 then
-      FLastError := WSASYSNOTREADY;
-    Inc(FSendCounter, Result);
-    DoStatus(HR_WriteCount, IntToStr(Result));
-{$ELSE}
-    l := Length;
-    x := 0;
-    while x < l do
-    begin
-      y := l - x;
-      if y > FSendMaxChunk then
-        y := FSendMaxChunk;
-      if y > 0 then
-      begin
-        LimitBandwidth(y, FMaxSendBandwidth, FNextsend);
-        p := IncPoint(Buffer, x);
-        r := FSSL.SendBuffer(p, y);
-        if FSSL.LastError <> 0 then
-          FLastError := WSASYSNOTREADY;
-        if Flasterror <> 0 then
-          Break;
-        Inc(x, r);
-        Inc(Result, r);
-        Inc(FSendCounter, r);
-        DoStatus(HR_WriteCount, IntToStr(r));
-      end
-      else
-        break;
-    end;
-{$ENDIF}
-    ExceptCheck;
-  end
-  else
-    Result := inherited SendBuffer(Buffer, Length);
-end;
-
-function TTCPBlockSocket.SSLAcceptConnection: Boolean;
-begin
-  ResetLastError;
-  if not FSSL.Accept then
-    FLastError := WSASYSNOTREADY;
-  ExceptCheck;
-  Result := FLastError = 0;
-end;
-
-function TTCPBlockSocket.GetSocketType: integer;
-begin
-  Result := integer(SOCK_STREAM);
-end;
-
-function TTCPBlockSocket.GetSocketProtocol: integer;
-begin
-  Result := integer(IPPROTO_TCP);
-end;
-
-{======================================================================}
-
-function TICMPBlockSocket.GetSocketType: integer;
-begin
-  Result := integer(SOCK_RAW);
-end;
-
-function TICMPBlockSocket.GetSocketProtocol: integer;
-begin
-  if FIP6Used then
-    Result := integer(IPPROTO_ICMPV6)
-  else
-    Result := integer(IPPROTO_ICMP);
-end;
-
-{======================================================================}
-
-function TRAWBlockSocket.GetSocketType: integer;
-begin
-  Result := integer(SOCK_RAW);
-end;
-
-function TRAWBlockSocket.GetSocketProtocol: integer;
-begin
-  Result := integer(IPPROTO_RAW);
-end;
-
-{======================================================================}
-
-function TPGMmessageBlockSocket.GetSocketType: integer;
-begin
-  Result := integer(SOCK_RDM);
-end;
-
-function TPGMmessageBlockSocket.GetSocketProtocol: integer;
-begin
-  Result := integer(IPPROTO_RM);
-end;
-
-{======================================================================}
-
-function TPGMstreamBlockSocket.GetSocketType: integer;
-begin
-  Result := integer(SOCK_STREAM);
-end;
-
-function TPGMstreamBlockSocket.GetSocketProtocol: integer;
-begin
-  Result := integer(IPPROTO_RM);
-end;
-
-{======================================================================}
-
-constructor TSynaClient.Create;
-begin
-  inherited Create;
-  FIPInterface := cAnyHost;
-  FTargetHost := cLocalhost;
-  FTargetPort := cAnyPort;
-  FTimeout := 5000;
-  FUsername := '';
-  FPassword := '';
-end;
-
-{======================================================================}
-
-constructor TCustomSSL.Create(const Value: TTCPBlockSocket);
-begin
-  inherited Create;
-  FSocket := Value;
-  FSSLEnabled := False;
-  FUsername := '';
-  FPassword := '';
-  FLastError := 0;
-  FLastErrorDesc := '';
-  FVerifyCert := False;
-  FSSLType := LT_all;
-  FKeyPassword := '';
-  FCiphers := '';
-  FCertificateFile := '';
-  FPrivateKeyFile := '';
-  FCertCAFile := '';
-  FCertCA := '';
-  FTrustCertificate := '';
-  FTrustCertificateFile := '';
-  FCertificate := '';
-  FPrivateKey := '';
-  FPFX := '';
-  FPFXfile := '';
-  FSSHChannelType := '';
-  FSSHChannelArg1 := '';
-  FSSHChannelArg2 := '';
-end;
-
-procedure TCustomSSL.Assign(const Value: TCustomSSL);
-begin
-  FUsername := Value.Username;
-  FPassword := Value.Password;
-  FVerifyCert := Value.VerifyCert;
-  FSSLType := Value.SSLType;
-  FKeyPassword := Value.KeyPassword;
-  FCiphers := Value.Ciphers;
-  FCertificateFile := Value.CertificateFile;
-  FPrivateKeyFile := Value.PrivateKeyFile;
-  FCertCAFile := Value.CertCAFile;
-  FCertCA := Value.CertCA;
-  FTrustCertificate := Value.TrustCertificate;
-  FTrustCertificateFile := Value.TrustCertificateFile;
-  FCertificate := Value.Certificate;
-  FPrivateKey := Value.PrivateKey;
-  FPFX := Value.PFX;
-  FPFXfile := Value.PFXfile;
-end;
-
-procedure TCustomSSL.ReturnError;
-begin
-  FLastError := -1;
-  FLastErrorDesc := 'SSL/TLS support is not compiled!';
-end;
-
-function TCustomSSL.LibVersion: String;
-begin
-  Result := '';
-end;
-
-function TCustomSSL.LibName: String;
-begin
-  Result := '';
-end;
-
-function TCustomSSL.CreateSelfSignedCert(Host: string): Boolean;
-begin
-  Result := False;
-end;
-
-function TCustomSSL.Connect: boolean;
-begin
-  ReturnError;
-  Result := False;
-end;
-
-function TCustomSSL.Accept: boolean;
-begin
-  ReturnError;
-  Result := False;
-end;
-
-function TCustomSSL.Shutdown: boolean;
-begin
-  ReturnError;
-  Result := False;
-end;
-
-function TCustomSSL.BiShutdown: boolean;
-begin
-  ReturnError;
-  Result := False;
-end;
-
-function TCustomSSL.SendBuffer(Buffer: TMemory; Len: Integer): Integer;
-begin
-  ReturnError;
-  Result := integer(SOCKET_ERROR);
-end;
-
-function TCustomSSL.RecvBuffer(Buffer: TMemory; Len: Integer): Integer;
-begin
-  ReturnError;
-  Result := integer(SOCKET_ERROR);
-end;
-
-function TCustomSSL.WaitingData: Integer;
-begin
-  ReturnError;
-  Result := 0;
-end;
-
-function TCustomSSL.GetSSLVersion: string;
-begin
-  Result := '';
-end;
-
-function TCustomSSL.GetPeerSubject: string;
-begin
-  Result := '';
-end;
-
-function TCustomSSL.GetPeerName: string;
-begin
-  Result := '';
-end;
-
-function TCustomSSL.GetPeerIssuer: string;
-begin
-  Result := '';
-end;
-
-function TCustomSSL.GetPeerFingerprint: string;
-begin
-  Result := '';
-end;
-
-function TCustomSSL.GetCertInfo: string;
-begin
-  Result := '';
-end;
-
-function TCustomSSL.GetCipherName: string;
-begin
-  Result := '';
-end;
-
-function TCustomSSL.GetCipherBits: integer;
-begin
-  Result := 0;
-end;
-
-function TCustomSSL.GetCipherAlgBits: integer;
-begin
-  Result := 0;
-end;
-
-function TCustomSSL.GetVerifyCert: integer;
-begin
-  Result := 1;
-end;
-
-{======================================================================}
-
-function TSSLNone.LibVersion: String;
-begin
-  Result := 'Without SSL support';
-end;
-
-function TSSLNone.LibName: String;
-begin
-  Result := 'ssl_none';
-end;
-
-{======================================================================}
-
-{$IFDEF ONCEWINSOCK}
-initialization
-begin
-  if not InitSocketInterface(DLLStackName) then
-  begin
-    e := ESynapseError.Create('Error loading Socket interface (' + DLLStackName + ')!');
-    e.ErrorCode := 0;
-    e.ErrorMessage := 'Error loading Socket interface (' + DLLStackName + ')!';
-    raise e;
-  end;
-  synsock.WSAStartup(WinsockLevel, WsaDataOnce);
-end;
-{$ENDIF}
-
-finalization
-begin
-{$IFDEF ONCEWINSOCK}
-  synsock.WSACleanup;
-  DestroySocketInterface;
-{$ENDIF}
-end;
-
-end.
+{==============================================================================|
+| Project : Ararat Synapse                                       | 009.008.002 |
+|==============================================================================|
+| Content: Library base                                                        |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)1999-2010.                |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{
+Special thanks to Gregor Ibic <gregor.ibic@intelicom.si>
+ (Intelicom d.o.o., http://www.intelicom.si)
+ for good inspiration about SSL programming.
+}
+
+{$DEFINE ONCEWINSOCK}
+{Note about define ONCEWINSOCK:
+If you remove this compiler directive, then socket interface is loaded and
+initialized on constructor of TBlockSocket class for each socket separately.
+Socket interface is used only if your need it.
+
+If you leave this directive here, then socket interface is loaded and
+initialized only once at start of your program! It boost performace on high
+count of created and destroyed sockets. It eliminate possible small resource
+leak on Windows systems too.
+}
+
+//{$DEFINE RAISEEXCEPT}
+{When you enable this define, then is Raiseexcept property is on by default
+}
+
+{:@abstract(Synapse's library core)
+
+Core with implementation basic socket classes.
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$IFDEF VER125}
+  {$DEFINE BCB}
+{$ENDIF}
+{$IFDEF BCB}
+  {$ObjExportAll On}
+{$ENDIF}
+{$Q-}
+{$H+}
+{$M+}
+
+//old Delphi does not have MSWINDOWS define.
+{$IFDEF WIN32}
+  {$IFNDEF MSWINDOWS}
+    {$DEFINE MSWINDOWS}
+  {$ENDIF}
+{$ENDIF}
+
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit blcksock;
+
+interface
+
+uses
+  SysUtils, Classes,
+  synafpc,
+  synsock, synautil, synacode, synaip
+{$IFDEF CIL}
+  ,System.Net
+  ,System.Net.Sockets
+  ,System.Text
+{$ENDIF}
+  ;
+
+const
+
+  SynapseRelease = '38';
+
+  cLocalhost = '127.0.0.1';
+  cAnyHost = '0.0.0.0';
+  cBroadcast = '255.255.255.255';
+  c6Localhost = '::1';
+  c6AnyHost = '::0';
+  c6Broadcast = 'ffff::1';
+  cAnyPort = '0';
+  CR = #$0d;
+  LF = #$0a;
+  CRLF = CR + LF;
+  c64k = 65536;
+
+type
+
+  {:@abstract(Exception clas used by Synapse)
+   When you enable generating of exceptions, this exception is raised by
+   Synapse's units.}
+  ESynapseError = class(Exception)
+  private
+    FErrorCode: Integer;
+    FErrorMessage: string;
+  published
+    {:Code of error. Value depending on used operating system}
+    property ErrorCode: Integer read FErrorCode Write FErrorCode;
+    {:Human readable description of error.}
+    property ErrorMessage: string read FErrorMessage Write FErrorMessage;
+  end;
+
+  {:Types of OnStatus events}
+  THookSocketReason = (
+    {:Resolving is begin. Resolved IP and port is in parameter in format like:
+     'localhost.somewhere.com:25'.}
+    HR_ResolvingBegin,
+    {:Resolving is done. Resolved IP and port is in parameter in format like:
+     'localhost.somewhere.com:25'. It is always same as in HR_ResolvingBegin!}
+    HR_ResolvingEnd,
+    {:Socket created by CreateSocket method. It reporting Family of created
+     socket too!}
+    HR_SocketCreate,
+    {:Socket closed by CloseSocket method.}
+    HR_SocketClose,
+    {:Socket binded to IP and Port. Binded IP and Port is in parameter in format
+     like: 'localhost.somewhere.com:25'.}
+    HR_Bind,
+    {:Socket connected to IP and Port. Connected IP and Port is in parameter in
+     format like: 'localhost.somewhere.com:25'.}
+    HR_Connect,
+    {:Called when CanRead method is used with @True result.}
+    HR_CanRead,
+    {:Called when CanWrite method is used with @True result.}
+    HR_CanWrite,
+    {:Socket is swithed to Listen mode. (TCP socket only)}
+    HR_Listen,
+    {:Socket Accepting client connection. (TCP socket only)}
+    HR_Accept,
+    {:report count of bytes readed from socket. Number is in parameter string.
+     If you need is in integer, you must use StrToInt function!}
+    HR_ReadCount,
+    {:report count of bytes writed to socket. Number is in parameter string. If
+     you need is in integer, you must use StrToInt function!}
+    HR_WriteCount,
+    {:If is limiting of bandwidth on, then this reason is called when sending or
+     receiving is stopped for satisfy bandwidth limit. Parameter is count of
+     waiting milliseconds.}
+    HR_Wait,
+    {:report situation where communication error occured. When raiseexcept is
+     @true, then exception is called after this Hook reason.}
+    HR_Error
+    );
+
+  {:Procedural type for OnStatus event. Sender is calling TBlockSocket object,
+   Reason is one of set Status events and value is optional data.}
+  THookSocketStatus = procedure(Sender: TObject; Reason: THookSocketReason;
+    const Value: String) of object;
+
+  {:This procedural type is used for DataFilter hooks.}
+  THookDataFilter = procedure(Sender: TObject; var Value: AnsiString) of object;
+
+  {:This procedural type is used for hook OnCreateSocket. By this hook you can
+   insert your code after initialisation of socket. (you can set special socket
+   options, etc.)}
+  THookCreateSocket = procedure(Sender: TObject) of object;
+
+  {:This procedural type is used for monitoring of communication.}
+  THookMonitor = procedure(Sender: TObject; Writing: Boolean;
+    const Buffer: TMemory; Len: Integer) of object;
+
+  {:This procedural type is used for hook OnAfterConnect. By this hook you can
+   insert your code after TCP socket has been sucessfully connected.}
+  THookAfterConnect = procedure(Sender: TObject) of object;
+
+  {:This procedural type is used for hook OnHeartbeat. By this hook you can
+   call your code repeately during long socket operations.
+   You must enable heartbeats by @Link(HeartbeatRate) property!}
+  THookHeartbeat = procedure(Sender: TObject) of object;
+
+  {:Specify family of socket.}
+  TSocketFamily = (
+    {:Default mode. Socket family is defined by target address for connection.
+     It allows instant access to IPv4 and IPv6 nodes. When you need IPv6 address
+     as destination, then is used IPv6 mode. othervise is used IPv4 mode.
+     However this mode not working properly with preliminary IPv6 supports!}
+    SF_Any,
+    {:Turn this class to pure IPv4 mode. This mode is totally compatible with
+     previous Synapse releases.}
+    SF_IP4,
+    {:Turn to only IPv6 mode.}
+    SF_IP6
+    );
+
+  {:specify possible values of SOCKS modes.}
+  TSocksType = (
+    ST_Socks5,
+    ST_Socks4
+    );
+
+  {:Specify requested SSL/TLS version for secure connection.}
+  TSSLType = (
+    LT_all,
+    LT_SSLv2,
+    LT_SSLv3,
+    LT_TLSv1,
+    LT_TLSv1_1,
+    LT_SSHv2
+    );
+
+  {:Specify type of socket delayed option.}
+  TSynaOptionType = (
+    SOT_Linger,
+    SOT_RecvBuff,
+    SOT_SendBuff,
+    SOT_NonBlock,
+    SOT_RecvTimeout,
+    SOT_SendTimeout,
+    SOT_Reuse,
+    SOT_TTL,
+    SOT_Broadcast,
+    SOT_MulticastTTL,
+    SOT_MulticastLoop
+    );
+
+  {:@abstract(this object is used for remember delayed socket option set.)}
+  TSynaOption = class(TObject)
+  public
+    Option: TSynaOptionType;
+    Enabled: Boolean;
+    Value: Integer;
+  end;
+
+  TCustomSSL = class;
+  TSSLClass = class of TCustomSSL;
+
+  {:@abstract(Basic IP object.)
+   This is parent class for other class with protocol implementations. Do not
+   use this class directly! Use @link(TICMPBlockSocket), @link(TRAWBlockSocket),
+   @link(TTCPBlockSocket) or @link(TUDPBlockSocket) instead.}
+  TBlockSocket = class(TObject)
+  private
+    FOnStatus: THookSocketStatus;
+    FOnReadFilter: THookDataFilter;
+    FOnCreateSocket: THookCreateSocket;
+    FOnMonitor: THookMonitor;
+    FOnHeartbeat: THookHeartbeat;
+    FLocalSin: TVarSin;
+    FRemoteSin: TVarSin;
+    FTag: integer;
+    FBuffer: AnsiString;
+    FRaiseExcept: Boolean;
+    FNonBlockMode: Boolean;
+    FMaxLineLength: Integer;
+    FMaxSendBandwidth: Integer;
+    FNextSend: LongWord;
+    FMaxRecvBandwidth: Integer;
+    FNextRecv: LongWord;
+    FConvertLineEnd: Boolean;
+    FLastCR: Boolean;
+    FLastLF: Boolean;
+    FBinded: Boolean;
+    FFamily: TSocketFamily;
+    FFamilySave: TSocketFamily;
+    FIP6used: Boolean;
+    FPreferIP4: Boolean;
+    FDelayedOptions: TList;
+    FInterPacketTimeout: Boolean;
+    {$IFNDEF CIL}
+    FFDSet: TFDSet;
+    {$ENDIF}
+    FRecvCounter: Integer;
+    FSendCounter: Integer;
+    FSendMaxChunk: Integer;
+    FStopFlag: Boolean;
+    FNonblockSendTimeout: Integer;
+    FHeartbeatRate: integer;
+    function GetSizeRecvBuffer: Integer;
+    procedure SetSizeRecvBuffer(Size: Integer);
+    function GetSizeSendBuffer: Integer;
+    procedure SetSizeSendBuffer(Size: Integer);
+    procedure SetNonBlockMode(Value: Boolean);
+    procedure SetTTL(TTL: integer);
+    function GetTTL:integer;
+    procedure SetFamily(Value: TSocketFamily); virtual;
+    procedure SetSocket(Value: TSocket); virtual;
+    function GetWsaData: TWSAData;
+    function FamilyToAF(f: TSocketFamily): TAddrFamily;
+  protected
+    FSocket: TSocket;
+    FLastError: Integer;
+    FLastErrorDesc: string;
+    FOwner: TObject;
+    procedure SetDelayedOption(const Value: TSynaOption);
+    procedure DelayedOption(const Value: TSynaOption);
+    procedure ProcessDelayedOptions;
+    procedure InternalCreateSocket(Sin: TVarSin);
+    procedure SetSin(var Sin: TVarSin; IP, Port: string);
+    function GetSinIP(Sin: TVarSin): string;
+    function GetSinPort(Sin: TVarSin): Integer;
+    procedure DoStatus(Reason: THookSocketReason; const Value: string);
+    procedure DoReadFilter(Buffer: TMemory; var Len: Integer);
+    procedure DoMonitor(Writing: Boolean; const Buffer: TMemory; Len: Integer);
+    procedure DoCreateSocket;
+    procedure DoHeartbeat;
+    procedure LimitBandwidth(Length: Integer; MaxB: integer; var Next: LongWord);
+    procedure SetBandwidth(Value: Integer);
+    function TestStopFlag: Boolean;
+    procedure InternalSendStream(const Stream: TStream; WithSize, Indy: boolean); virtual;
+    function InternalCanRead(Timeout: Integer): Boolean; virtual;
+  public
+    constructor Create;
+
+    {:Create object and load all necessary socket library. What library is
+     loaded is described by STUB parameter. If STUB is empty string, then is
+     loaded default libraries.}
+    constructor CreateAlternate(Stub: string);
+    destructor Destroy; override;
+
+    {:If @link(family) is not SF_Any, then create socket with type defined in
+     @link(Family) property. If family is SF_Any, then do nothing! (socket is
+     created automaticly when you know what type of socket you need to create.
+     (i.e. inside @link(Connect) or @link(Bind) call.) When socket is created,
+     then is aplyed all stored delayed socket options.}
+    procedure CreateSocket;
+
+    {:It create socket. Address resolving of Value tells what type of socket is
+     created. If Value is resolved as IPv4 IP, then is created IPv4 socket. If
+     value is resolved as IPv6 address, then is created IPv6 socket.}
+    procedure CreateSocketByName(const Value: String);
+
+    {:Destroy socket in use. This method is also automatically called from
+     object destructor.}
+    procedure CloseSocket; virtual;
+
+    {:Abort any work on Socket and destroy them.}
+    procedure AbortSocket; virtual;
+
+    {:Connects socket to local IP address and PORT. IP address may be numeric or
+     symbolic ('192.168.74.50', 'cosi.nekde.cz', 'ff08::1'). The same for PORT
+     - it may be number or mnemonic port ('23', 'telnet').
+
+     If port value is '0', system chooses itself and conects unused port in the
+     range 1024 to 4096 (this depending by operating system!). Structure
+     LocalSin is filled after calling this method.
+
+     Note: If you call this on non-created socket, then socket is created
+     automaticly.
+
+     Warning: when you call : Bind('0.0.0.0','0'); then is nothing done! In this
+     case is used implicit system bind instead.}
+    procedure Bind(IP, Port: string);
+
+    {:Connects socket to remote IP address and PORT. The same rules as with
+     @link(BIND) method are valid. The only exception is that PORT with 0 value
+     will not be connected!
+
+     Structures LocalSin and RemoteSin will be filled with valid values.
+
+     When you call this on non-created socket, then socket is created
+     automaticly. Type of created socket is by @link(Family) property. If is
+     used SF_IP4, then is created socket for IPv4. If is used SF_IP6, then is
+     created socket for IPv6. When you have family on SF_Any (default!), then
+     type of created socket is determined by address resolving of destination
+     address. (Not work properly on prilimitary winsock IPv6 support!)}
+    procedure Connect(IP, Port: string); virtual;
+
+    {:Sets socket to receive mode for new incoming connections. It is necessary
+     to use @link(TBlockSocket.BIND) function call before this method to select
+     receiving port!}
+    procedure Listen; virtual;
+
+    {:Waits until new incoming connection comes. After it comes a new socket is
+     automatically created (socket handler is returned by this function as
+     result).}
+    function Accept: TSocket; virtual;
+
+    {:Sends data of LENGTH from BUFFER address via connected socket. System
+     automatically splits data to packets.}
+    function SendBuffer(Buffer: Tmemory; Length: Integer): Integer; virtual;
+
+    {:One data BYTE is sent via connected socket.}
+    procedure SendByte(Data: Byte); virtual;
+
+    {:Send data string via connected socket. Any terminator is not added! If you
+     need send true string with CR-LF termination, you must add CR-LF characters
+     to sended string! Because any termination is not added automaticly, you can
+     use this function for sending any binary data in binary string.}
+    procedure SendString(Data: AnsiString); virtual;
+
+    {:Send integer as four bytes to socket.}
+    procedure SendInteger(Data: integer); virtual;
+
+    {:Send data as one block to socket. Each block begin with 4 bytes with
+     length of data in block. This 4 bytes is added automaticly by this
+     function.}
+    procedure SendBlock(const Data: AnsiString); virtual;
+
+    {:Send data from stream to socket.}
+    procedure SendStreamRaw(const Stream: TStream); virtual;
+
+    {:Send content of stream to socket. It using @link(SendBlock) method}
+    procedure SendStream(const Stream: TStream); virtual;
+
+    {:Send content of stream to socket. It using @link(SendBlock) method and
+    this is compatible with streams in Indy library.}
+    procedure SendStreamIndy(const Stream: TStream); virtual;
+
+    {:Note: This is low-level receive function. You must be sure if data is
+     waiting for read before call this function for avoid deadlock!
+
+     Waits until allocated buffer is filled by received data. Returns number of
+     data received, which equals to LENGTH value under normal operation. If it
+     is not equal the communication channel is possibly broken.
+
+     On stream oriented sockets if is received 0 bytes, it mean 'socket is
+     closed!"
+
+     On datagram socket is readed first waiting datagram.}
+    function RecvBuffer(Buffer: TMemory; Length: Integer): Integer; virtual;
+
+    {:Note: This is high-level receive function. It using internal
+     @link(LineBuffer) and you can combine this function freely with other
+     high-level functions!
+
+     Method waits until data is received. If no data is received within TIMEOUT
+     (in milliseconds) period, @link(LastError) is set to WSAETIMEDOUT. Methods
+     serves for reading any size of data (i.e. one megabyte...). This method is
+     preffered for reading from stream sockets (like TCP).}
+    function RecvBufferEx(Buffer: Tmemory; Len: Integer;
+      Timeout: Integer): Integer; virtual;
+
+    {:Similar to @link(RecvBufferEx), but readed data is stored in binary
+     string, not in memory buffer.}
+    function RecvBufferStr(Len: Integer; Timeout: Integer): AnsiString; virtual;
+
+    {:Note: This is high-level receive function. It using internal
+     @link(LineBuffer) and you can combine this function freely with other
+     high-level functions.
+
+     Waits until one data byte is received which is also returned as function
+     result. If no data is received within TIMEOUT (in milliseconds)period,
+     @link(LastError) is set to WSAETIMEDOUT and result have value 0.}
+    function RecvByte(Timeout: Integer): Byte; virtual;
+
+    {:Note: This is high-level receive function. It using internal
+     @link(LineBuffer) and you can combine this function freely with other
+     high-level functions.
+
+     Waits until one four bytes are received and return it as one Ineger Value.
+     If no data is received within TIMEOUT (in milliseconds)period,
+     @link(LastError) is set to WSAETIMEDOUT and result have value 0.}
+    function RecvInteger(Timeout: Integer): Integer; virtual;
+
+    {:Note: This is high-level receive function. It using internal
+     @link(LineBuffer) and you can combine this function freely with other
+     high-level functions.
+
+     Method waits until data string is received. This string is terminated by
+     CR-LF characters. The resulting string is returned without this termination
+     (CR-LF)! If @link(ConvertLineEnd) is used, then CR-LF sequence may not be
+     exactly CR-LF. See @link(ConvertLineEnd) description. If no data is
+     received within TIMEOUT (in milliseconds) period, @link(LastError) is set
+     to WSAETIMEDOUT. You may also specify maximum length of reading data by
+     @link(MaxLineLength) property.}
+    function RecvString(Timeout: Integer): AnsiString; virtual;
+
+    {:Note: This is high-level receive function. It using internal
+     @link(LineBuffer) and you can combine this function freely with other
+     high-level functions.
+
+     Method waits until data string is received. This string is terminated by
+     Terminator string. The resulting string is returned without this
+     termination. If no data is received within TIMEOUT (in milliseconds)
+     period, @link(LastError) is set to WSAETIMEDOUT. You may also specify
+     maximum length of reading data by @link(MaxLineLength) property.}
+    function RecvTerminated(Timeout: Integer; const Terminator: AnsiString): AnsiString; virtual;
+
+    {:Note: This is high-level receive function. It using internal
+     @link(LineBuffer) and you can combine this function freely with other
+     high-level functions.
+
+     Method reads all data waiting for read. If no data is received within
+     TIMEOUT (in milliseconds) period, @link(LastError) is set to WSAETIMEDOUT.
+     Methods serves for reading unknown size of data. Because before call this
+     function you don't know size of received data, returned data is stored in
+     dynamic size binary string. This method is preffered for reading from
+     stream sockets (like TCP). It is very goot for receiving datagrams too!
+     (UDP protocol)}
+    function RecvPacket(Timeout: Integer): AnsiString; virtual;
+
+    {:Read one block of data from socket. Each block begin with 4 bytes with
+     length of data in block. This function read first 4 bytes for get lenght,
+     then it wait for reported count of bytes.}
+    function RecvBlock(Timeout: Integer): AnsiString; virtual;
+
+    {:Read all data from socket to stream until socket is closed (or any error
+     occured.)}
+    procedure RecvStreamRaw(const Stream: TStream; Timeout: Integer); virtual;
+    {:Read requested count of bytes from socket to stream.}
+    procedure RecvStreamSize(const Stream: TStream; Timeout: Integer; Size: Integer);
+
+    {:Receive data to stream. It using @link(RecvBlock) method.}
+    procedure RecvStream(const Stream: TStream; Timeout: Integer); virtual;
+
+    {:Receive data to stream. This function is compatible with similar function
+    in Indy library. It using @link(RecvBlock) method.}
+    procedure RecvStreamIndy(const Stream: TStream; Timeout: Integer); virtual;
+
+    {:Same as @link(RecvBuffer), but readed data stays in system input buffer.
+    Warning: this function not respect data in @link(LineBuffer)! Is not
+    recommended to use this function!}
+    function PeekBuffer(Buffer: TMemory; Length: Integer): Integer; virtual;
+
+    {:Same as @link(RecvByte), but readed data stays in input system buffer.
+     Warning: this function not respect data in @link(LineBuffer)! Is not
+    recommended to use this function!}
+    function PeekByte(Timeout: Integer): Byte; virtual;
+
+    {:On stream sockets it returns number of received bytes waiting for picking.
+     0 is returned when there is no such data. On datagram socket it returns
+     length of the first waiting datagram. Returns 0 if no datagram is waiting.}
+    function WaitingData: Integer; virtual;
+
+    {:Same as @link(WaitingData), but if exists some of data in @link(Linebuffer),
+     return their length instead.}
+    function WaitingDataEx: Integer;
+
+    {:Clear all waiting data for read from buffers.}
+    procedure Purge;
+
+    {:Sets linger. Enabled linger means that the system waits another LINGER
+     (in milliseconds) time for delivery of sent data. This function is only for
+     stream type of socket! (TCP)}
+    procedure SetLinger(Enable: Boolean; Linger: Integer);
+
+    {:Actualize values in @link(LocalSin).}
+    procedure GetSinLocal;
+
+    {:Actualize values in @link(RemoteSin).}
+    procedure GetSinRemote;
+
+    {:Actualize values in @link(LocalSin) and @link(RemoteSin).}
+    procedure GetSins;
+
+    {:Reset @link(LastError) and @link(LastErrorDesc) to non-error state.}
+    procedure ResetLastError;
+
+    {:If you "manually" call Socket API functions, forward their return code as
+     parameter to this function, which evaluates it, eventually calls
+     GetLastError and found error code returns and stores to @link(LastError).}
+    function SockCheck(SockResult: Integer): Integer; virtual;
+
+    {:If @link(LastError) contains some error code and @link(RaiseExcept)
+     property is @true, raise adequate exception.}
+    procedure ExceptCheck;
+
+    {:Returns local computer name as numerical or symbolic value. It try get
+     fully qualified domain name. Name is returned in the format acceptable by
+     functions demanding IP as input parameter.}
+    function LocalName: string;
+
+    {:Try resolve name to all possible IP address. i.e. If you pass as name
+     result of @link(LocalName) method, you get all IP addresses used by local
+     system.}
+    procedure ResolveNameToIP(Name: string; const IPList: TStrings);
+
+    {:Try resolve name to primary IP address. i.e. If you pass as name result of
+     @link(LocalName) method, you get primary IP addresses used by local system.}
+    function ResolveName(Name: string): string;
+
+    {:Try resolve IP to their primary domain name. If IP not have domain name,
+     then is returned original IP.}
+    function ResolveIPToName(IP: string): string;
+
+    {:Try resolve symbolic port name to port number. (i.e. 'Echo' to 8)}
+    function ResolvePort(Port: string): Word;
+
+    {:Set information about remote side socket. It is good for seting remote
+     side for sending UDP packet, etc.}
+    procedure SetRemoteSin(IP, Port: string);
+
+    {:Picks IP socket address from @link(LocalSin).}
+    function GetLocalSinIP: string; virtual;
+
+    {:Picks IP socket address from @link(RemoteSin).}
+    function GetRemoteSinIP: string; virtual;
+
+    {:Picks socket PORT number from @link(LocalSin).}
+    function GetLocalSinPort: Integer; virtual;
+
+    {:Picks socket PORT number from @link(RemoteSin).}
+    function GetRemoteSinPort: Integer; virtual;
+
+    {:Return @TRUE, if you can read any data from socket or is incoming
+     connection on TCP based socket. Status is tested for time Timeout (in
+     milliseconds). If value in Timeout is 0, status is only tested and
+     continue. If value in Timeout is -1, run is breaked and waiting for read
+     data maybe forever.
+
+     This function is need only on special cases, when you need use
+     @link(RecvBuffer) function directly! read functioms what have timeout as
+     calling parameter, calling this function internally.}
+    function CanRead(Timeout: Integer): Boolean; virtual;
+
+    {:Same as @link(CanRead), but additionally return @TRUE if is some data in
+     @link(LineBuffer).}
+    function CanReadEx(Timeout: Integer): Boolean; virtual;
+
+    {:Return @TRUE, if you can to socket write any data (not full sending
+     buffer). Status is tested for time Timeout (in milliseconds). If value in
+     Timeout is 0, status is only tested and continue. If value in Timeout is
+     -1, run is breaked and waiting for write data maybe forever.
+
+     This function is need only on special cases!}
+    function CanWrite(Timeout: Integer): Boolean; virtual;
+
+    {:Same as @link(SendBuffer), but send datagram to address from
+     @link(RemoteSin). Usefull for sending reply to datagram received by
+     function @link(RecvBufferFrom).}
+    function SendBufferTo(Buffer: TMemory; Length: Integer): Integer; virtual;
+
+    {:Note: This is low-lever receive function. You must be sure if data is
+     waiting for read before call this function for avoid deadlock!
+
+     Receives first waiting datagram to allocated buffer. If there is no waiting
+     one, then waits until one comes. Returns length of datagram stored in
+     BUFFER. If length exceeds buffer datagram is truncated. After this
+     @link(RemoteSin) structure contains information about sender of UDP packet.}
+    function RecvBufferFrom(Buffer: TMemory; Length: Integer): Integer; virtual;
+{$IFNDEF CIL}
+    {:This function is for check for incoming data on set of sockets. Whitch
+    sockets is checked is decribed by SocketList Tlist with TBlockSocket
+    objects. TList may have maximal number of objects defined by FD_SETSIZE
+    constant. Return @TRUE, if you can from some socket read any data or is
+    incoming connection on TCP based socket. Status is tested for time Timeout
+    (in milliseconds). If value in Timeout is 0, status is only tested and
+    continue. If value in Timeout is -1, run is breaked and waiting for read
+    data maybe forever. If is returned @TRUE, CanReadList TList is filled by all
+    TBlockSocket objects what waiting for read.}
+    function GroupCanRead(const SocketList: TList; Timeout: Integer;
+      const CanReadList: TList): Boolean;
+{$ENDIF}
+    {:By this method you may turn address reuse mode for local @link(bind). It
+     is good specially for UDP protocol. Using this with TCP protocol is
+     hazardous!}
+    procedure EnableReuse(Value: Boolean);
+
+    {:Try set timeout for all sending and receiving operations, if socket
+     provider can do it. (It not supported by all socket providers!)}
+    procedure SetTimeout(Timeout: Integer);
+
+    {:Try set timeout for all sending operations, if socket provider can do it.
+     (It not supported by all socket providers!)}
+    procedure SetSendTimeout(Timeout: Integer);
+
+    {:Try set timeout for all receiving operations, if socket provider can do
+     it. (It not supported by all socket providers!)}
+    procedure SetRecvTimeout(Timeout: Integer);
+
+    {:Return value of socket type.}
+    function GetSocketType: integer; Virtual;
+
+    {:Return value of protocol type for socket creation.}
+    function GetSocketProtocol: integer; Virtual;
+
+    {:WSA structure with information about socket provider. On non-windows 
+     platforms this structure is simulated!}
+    property WSAData: TWSADATA read GetWsaData;
+
+    {:FDset structure prepared for usage with this socket.}
+    property FDset: TFDSet read FFDset;
+
+    {:Structure describing local socket side.}
+    property LocalSin: TVarSin read FLocalSin write FLocalSin;
+
+    {:Structure describing remote socket side.}
+    property RemoteSin: TVarSin read FRemoteSin write FRemoteSin;
+
+    {:Socket handler. Suitable for "manual" calls to socket API or manual
+     connection of socket to a previously created socket (i.e by Accept method
+     on TCP socket)}
+    property Socket: TSocket read FSocket write SetSocket;
+
+    {:Last socket operation error code. Error codes are described in socket
+     documentation. Human readable error description is stored in
+     @link(LastErrorDesc) property.}
+    property LastError: Integer read FLastError;
+
+    {:Human readable error description of @link(LastError) code.}
+    property LastErrorDesc: string read FLastErrorDesc;
+
+    {:Buffer used by all high-level receiving functions. This buffer is used for
+     optimized reading of data from socket. In normal cases you not need access
+     to this buffer directly!}
+    property LineBuffer: AnsiString read FBuffer write FBuffer;
+
+    {:Size of Winsock receive buffer. If it is not supported by socket provider,
+     it return as size one kilobyte.}
+    property SizeRecvBuffer: Integer read GetSizeRecvBuffer write SetSizeRecvBuffer;
+
+    {:Size of Winsock send buffer. If it is not supported by socket provider, it
+     return as size one kilobyte.}
+    property SizeSendBuffer: Integer read GetSizeSendBuffer write SetSizeSendBuffer;
+
+    {:If @True, turn class to non-blocking mode. Not all functions are working
+     properly in this mode, you must know exactly what you are doing! However
+     when you have big experience with non-blocking programming, then you can
+     optimise your program by non-block mode!}
+    property NonBlockMode: Boolean read FNonBlockMode Write SetNonBlockMode;
+
+    {:Set Time-to-live value. (if system supporting it!)}
+    property TTL: Integer read GetTTL Write SetTTL;
+
+    {:If is @true, then class in in IPv6 mode.}
+    property IP6used: Boolean read FIP6used;
+
+    {:Return count of received bytes on this socket from begin of current
+     connection.}
+    property RecvCounter: Integer read FRecvCounter;
+
+    {:Return count of sended bytes on this socket from begin of current
+     connection.}
+    property SendCounter: Integer read FSendCounter;
+  published
+    {:Return descriptive string for given error code. This is class function.
+     You may call it without created object!}
+    class function GetErrorDesc(ErrorCode: Integer): string;
+
+    {:Return descriptive string for @link(LastError).}
+    function GetErrorDescEx: string; virtual;
+
+    {:this value is for free use.}
+    property Tag: Integer read FTag write FTag;
+
+    {:If @true, winsock errors raises exception. Otherwise is setted
+    @link(LastError) value only and you must check it from your program! Default
+    value is @false.}
+    property RaiseExcept: Boolean read FRaiseExcept write FRaiseExcept;
+
+    {:Define maximum length in bytes of @link(LineBuffer) for high-level
+     receiving functions. If this functions try to read more data then this
+     limit, error is returned! If value is 0 (default), no limitation is used.
+     This is very good protection for stupid attacks to your server by sending
+     lot of data without proper terminator... until all your memory is allocated
+     by LineBuffer!
+
+     Note: This maximum length is checked only in functions, what read unknown
+     number of bytes! (like @link(RecvString) or @link(RecvTerminated))}
+    property MaxLineLength: Integer read FMaxLineLength Write FMaxLineLength;
+
+    {:Define maximal bandwidth for all sending operations in bytes per second.
+     If value is 0 (default), bandwidth limitation is not used.}
+    property MaxSendBandwidth: Integer read FMaxSendBandwidth Write FMaxSendBandwidth;
+
+    {:Define maximal bandwidth for all receiving operations in bytes per second.
+     If value is 0 (default), bandwidth limitation is not used.}
+    property MaxRecvBandwidth: Integer read FMaxRecvBandwidth Write FMaxRecvBandwidth;
+
+    {:Define maximal bandwidth for all sending and receiving operations in bytes
+     per second. If value is 0 (default), bandwidth limitation is not used.}
+    property MaxBandwidth: Integer Write SetBandwidth;
+
+    {:Do a conversion of non-standard line terminators to CRLF. (Off by default)
+     If @True, then terminators like sigle CR, single LF or LFCR are converted
+     to CRLF internally. This have effect only in @link(RecvString) method!}
+    property ConvertLineEnd: Boolean read FConvertLineEnd Write FConvertLineEnd;
+
+    {:Specified Family of this socket. When you are using Windows preliminary
+     support for IPv6, then I recommend to set this property!}
+    property Family: TSocketFamily read FFamily Write SetFamily;
+
+    {:When resolving of domain name return both IPv4 and IPv6 addresses, then
+     specify if is used IPv4 (dafault - @true) or IPv6.}
+    property PreferIP4: Boolean read FPreferIP4 Write FPreferIP4;
+
+    {:By default (@true) is all timeouts used as timeout between two packets in
+     reading operations. If you set this to @false, then Timeouts is for overall
+     reading operation!}
+    property InterPacketTimeout: Boolean read FInterPacketTimeout Write FInterPacketTimeout;
+
+    {:All sended datas was splitted by this value.}
+    property SendMaxChunk: Integer read FSendMaxChunk Write FSendMaxChunk;
+
+    {:By setting this property to @true you can stop any communication. You can
+     use this property for soft abort of communication.}
+    property StopFlag: Boolean read FStopFlag Write FStopFlag;
+
+    {:Timeout for data sending by non-blocking socket mode.}
+    property NonblockSendTimeout: Integer read FNonblockSendTimeout Write FNonblockSendTimeout;
+
+    {:This event is called by various reasons. It is good for monitoring socket,
+     create gauges for data transfers, etc.}
+    property OnStatus: THookSocketStatus read FOnStatus write FOnStatus;
+
+    {:this event is good for some internal thinks about filtering readed datas.
+     It is used by telnet client by example.}
+    property OnReadFilter: THookDataFilter read FOnReadFilter write FOnReadFilter;
+
+    {:This event is called after real socket creation for setting special socket
+     options, because you not know when socket is created. (it is depended on
+     Ipv4, IPv6 or automatic mode)}
+    property OnCreateSocket: THookCreateSocket read FOnCreateSocket write FOnCreateSocket;
+
+    {:This event is good for monitoring content of readed or writed datas.}
+    property OnMonitor: THookMonitor read FOnMonitor write FOnMonitor;
+
+    {:This event is good for calling your code during long socket operations.
+      (Example, for refresing UI if class in not called within the thread.)
+      Rate of heartbeats can be modified by @link(HeartbeatRate) property.}
+    property OnHeartbeat: THookHeartbeat read FOnHeartbeat write FOnHeartbeat;
+
+    {:Specify typical rate of @link(OnHeartbeat) event and @link(StopFlag) testing.
+      Default value 0 disabling heartbeats! Value is in milliseconds.
+      Real rate can be higher or smaller then this value, because it depending
+      on real socket operations too!
+      Note: Each heartbeat slowing socket processing.}
+    property HeartbeatRate: integer read FHeartbeatRate Write FHeartbeatRate;
+    {:What class own this socket? Used by protocol implementation classes.}
+    property Owner: TObject read FOwner Write FOwner;
+  end;
+
+  {:@abstract(Support for SOCKS4 and SOCKS5 proxy)
+   Layer with definition all necessary properties and functions for
+   implementation SOCKS proxy client. Do not use this class directly.}
+  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;
+    FBypassFlag: Boolean;
+    FSocksType: TSocksType;
+    function SocksCode(IP, Port: string): Ansistring;
+    function SocksDecode(Value: Ansistring): integer;
+  public
+    constructor Create;
+
+    {:Open connection to SOCKS proxy and if @link(SocksUsername) is set, do
+     authorisation to proxy. This is needed only in special cases! (it is called
+     internally!)}
+    function SocksOpen: Boolean;
+
+    {:Send specified request to SOCKS proxy. This is needed only in special
+     cases! (it is called internally!)}
+    function SocksRequest(Cmd: Byte; const IP, Port: string): Boolean;
+
+    {:Receive response to previosly sended request. This is needed only in
+     special cases! (it is called internally!)}
+    function SocksResponse: Boolean;
+
+    {:Is @True when class is using SOCKS proxy.}
+    property UsingSocks: Boolean read FUsingSocks;
+
+    {:If SOCKS proxy failed, here is error code returned from SOCKS proxy.}
+    property SocksLastError: integer read FSocksLastError;
+  published
+    {:Address of SOCKS server. If value is empty string, SOCKS support is
+     disabled. Assingning any value to this property enable SOCKS mode.
+     Warning: You cannot combine this mode with HTTP-tunneling mode!}
+    property SocksIP: string read FSocksIP write FSocksIP;
+
+    {:Port of SOCKS server. Default value is '1080'.}
+    property SocksPort: string read FSocksPort write FSocksPort;
+
+    {:If you need authorisation on SOCKS server, set username here.}
+    property SocksUsername: string read FSocksUsername write FSocksUsername;
+
+    {:If you need authorisation on SOCKS server, set password here.}
+    property SocksPassword: string read FSocksPassword write FSocksPassword;
+
+    {:Specify timeout for communicatin with SOCKS server. Default is one minute.}
+    property SocksTimeout: integer read FSocksTimeout write FSocksTimeout;
+
+    {:If @True, all symbolic names of target hosts is not translated to IP's
+     locally, but resolving is by SOCKS proxy. Default is @True.}
+    property SocksResolver: Boolean read FSocksResolver write FSocksResolver;
+
+    {:Specify SOCKS type. By default is used SOCKS5, but you can use SOCKS4 too.
+     When you select SOCKS4, then if @link(SOCKSResolver) is enabled, then is
+     used SOCKS4a. Othervise is used pure SOCKS4.}
+    property SocksType: TSocksType read FSocksType write FSocksType;
+  end;
+
+  {:@abstract(Implementation of TCP socket.)
+   Supported features: IPv4, IPv6, SSL/TLS or SSH (depending on used plugin),
+   SOCKS5 proxy (outgoing connections and limited incomming), SOCKS4/4a proxy
+   (outgoing connections and limited incomming), TCP through HTTP proxy tunnel.}
+  TTCPBlockSocket = class(TSocksBlockSocket)
+  protected
+    FOnAfterConnect: THookAfterConnect;
+    FSSL: TCustomSSL;
+    FHTTPTunnelIP: string;
+    FHTTPTunnelPort: string;
+    FHTTPTunnel: Boolean;
+    FHTTPTunnelRemoteIP: string;
+    FHTTPTunnelRemotePort: string;
+    FHTTPTunnelUser: string;
+    FHTTPTunnelPass: string;
+    FHTTPTunnelTimeout: integer;
+    procedure SocksDoConnect(IP, Port: string);
+    procedure HTTPTunnelDoConnect(IP, Port: string);
+    procedure DoAfterConnect;
+  public
+    {:Create TCP socket class with default plugin for SSL/TSL/SSH implementation
+    (see @link(SSLImplementation))}
+    constructor Create;
+
+    {:Create TCP socket class with desired plugin for SSL/TSL/SSH implementation}
+    constructor CreateWithSSL(SSLPlugin: TSSLClass);
+    destructor Destroy; override;
+
+    {:See @link(TBlockSocket.CloseSocket)}
+    procedure CloseSocket; override;
+
+    {:See @link(TBlockSocket.WaitingData)}
+    function WaitingData: Integer; override;
+
+    {:Sets socket to receive mode for new incoming connections. It is necessary
+     to use @link(TBlockSocket.BIND) function call before this method to select
+     receiving port!
+
+     If you use SOCKS, activate incoming TCP connection by this proxy. (By BIND
+     method of SOCKS.)}
+    procedure Listen; override;
+
+    {:Waits until new incoming connection comes. After it comes a new socket is
+     automatically created (socket handler is returned by this function as
+     result).
+
+     If you use SOCKS, new socket is not created! In this case is used same
+     socket as socket for listening! So, you can accept only one connection in
+     SOCKS mode.}
+    function Accept: TSocket; override;
+
+    {:Connects socket to remote IP address and PORT. The same rules as with
+     @link(TBlockSocket.BIND) method are valid. The only exception is that PORT
+     with 0 value will not be connected. After call to this method
+     a communication channel between local and remote socket is created. Local
+     socket is assigned automatically if not controlled by previous call to
+     @link(TBlockSocket.BIND) method. Structures @link(TBlockSocket.LocalSin)
+     and @link(TBlockSocket.RemoteSin) will be filled with valid values.
+
+     If you use SOCKS, activate outgoing TCP connection by SOCKS proxy specified
+     in @link(TSocksBlockSocket.SocksIP). (By CONNECT method of SOCKS.)
+
+     If you use HTTP-tunnel mode, activate outgoing TCP connection by HTTP
+     tunnel specified in @link(HTTPTunnelIP). (By CONNECT method of HTTP
+     protocol.)
+
+     Note: If you call this on non-created socket, then socket is created
+     automaticly.}
+    procedure Connect(IP, Port: string); override;
+
+    {:If you need upgrade existing TCP connection to SSL/TLS (or SSH2, if plugin
+     allows it) mode, then call this method. This method switch this class to
+     SSL mode and do SSL/TSL handshake.}
+    procedure SSLDoConnect;
+
+    {:By this method you can downgrade existing SSL/TLS connection to normal TCP
+     connection.}
+    procedure SSLDoShutdown;
+
+    {:If you need use this component as SSL/TLS TCP server, then after accepting
+     of inbound connection you need start SSL/TLS session by this method. Before
+     call this function, you must have assigned all neeeded certificates and
+     keys!}
+    function SSLAcceptConnection: Boolean;
+
+    {:See @link(TBlockSocket.GetLocalSinIP)}
+    function GetLocalSinIP: string; override;
+
+    {:See @link(TBlockSocket.GetRemoteSinIP)}
+    function GetRemoteSinIP: string; override;
+
+    {:See @link(TBlockSocket.GetLocalSinPort)}
+    function GetLocalSinPort: Integer; override;
+
+    {:See @link(TBlockSocket.GetRemoteSinPort)}
+    function GetRemoteSinPort: Integer; override;
+
+    {:See @link(TBlockSocket.SendBuffer)}
+    function SendBuffer(Buffer: TMemory; Length: Integer): Integer; override;
+
+    {:See @link(TBlockSocket.RecvBuffer)}
+    function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; override;
+
+    {:Return value of socket type. For TCP return SOCK_STREAM.}
+    function GetSocketType: integer; override;
+
+    {:Return value of protocol type for socket creation. For TCP return
+     IPPROTO_TCP.}
+    function GetSocketProtocol: integer; override;
+
+    {:Class implementing SSL/TLS support. It is allways some descendant
+     of @link(TCustomSSL) class. When programmer not select some SSL plugin
+     class, then is used @link(TSSLNone)}
+    property SSL: TCustomSSL read FSSL;
+
+    {:@True if is used HTTP tunnel mode.}
+    property HTTPTunnel: Boolean read FHTTPTunnel;
+  published
+    {:Return descriptive string for @link(LastError). On case of error
+     in SSL/TLS subsystem, it returns right error description.}
+    function GetErrorDescEx: string; override;
+
+    {:Specify IP address of HTTP proxy. Assingning non-empty value to this
+     property enable HTTP-tunnel mode. This mode is for tunnelling any outgoing
+     TCP connection through HTTP proxy server. (If policy on HTTP proxy server
+     allow this!) Warning: You cannot combine this mode with SOCK5 mode!}
+    property HTTPTunnelIP: string read FHTTPTunnelIP Write FHTTPTunnelIP;
+
+    {:Specify port of HTTP proxy for HTTP-tunneling.}
+    property HTTPTunnelPort: string read FHTTPTunnelPort Write FHTTPTunnelPort;
+
+    {:Specify authorisation username for access to HTTP proxy in HTTP-tunnel
+     mode. If you not need authorisation, then let this property empty.}
+    property HTTPTunnelUser: string read FHTTPTunnelUser Write FHTTPTunnelUser;
+
+    {:Specify authorisation password for access to HTTP proxy in HTTP-tunnel
+     mode.}
+    property HTTPTunnelPass: string read FHTTPTunnelPass Write FHTTPTunnelPass;
+
+    {:Specify timeout for communication with HTTP proxy in HTTPtunnel mode.}
+    property HTTPTunnelTimeout: integer read FHTTPTunnelTimeout Write FHTTPTunnelTimeout;
+
+    {:This event is called after sucessful TCP socket connection.}
+    property OnAfterConnect: THookAfterConnect read FOnAfterConnect write FOnAfterConnect;
+  end;
+
+  {:@abstract(Datagram based communication)
+   This class implementing datagram based communication instead default stream
+   based communication style.}
+  TDgramBlockSocket = class(TSocksBlockSocket)
+  public
+    {:Fill @link(TBlockSocket.RemoteSin) structure. This address is used for
+     sending data.}
+    procedure Connect(IP, Port: string); override;
+
+    {:Silently redirected to @link(TBlockSocket.SendBufferTo).}
+    function SendBuffer(Buffer: TMemory; Length: Integer): Integer; override;
+
+    {:Silently redirected to @link(TBlockSocket.RecvBufferFrom).}
+    function RecvBuffer(Buffer: TMemory; Length: Integer): Integer; override;
+  end;
+
+  {:@abstract(Implementation of UDP socket.)
+   NOTE: in this class is all receiving redirected to RecvBufferFrom. You can
+   use for reading any receive function. Preffered is RecvPacket! Similary all
+   sending is redirected to SendbufferTo. You can use for sending UDP packet any
+   sending function, like SendString.
+
+   Supported features: IPv4, IPv6, unicasts, broadcasts, multicasts, SOCKS5
+   proxy (only unicasts! Outgoing and incomming.)}
+  TUDPBlockSocket = class(TDgramBlockSocket)
+  protected
+    FSocksControlSock: TTCPBlockSocket;
+    function UdpAssociation: Boolean;
+    procedure SetMulticastTTL(TTL: integer);
+    function GetMulticastTTL:integer;
+  public
+    destructor Destroy; override;
+
+    {:Enable or disable sending of broadcasts. If seting OK, result is @true.
+     This method is not supported in SOCKS5 mode! IPv6 does not support
+     broadcasts! In this case you must use Multicasts instead.}
+    procedure EnableBroadcast(Value: Boolean);
+
+    {:See @link(TBlockSocket.SendBufferTo)}
+    function SendBufferTo(Buffer: TMemory; Length: Integer): Integer; override;
+
+    {:See @link(TBlockSocket.RecvBufferFrom)}
+    function RecvBufferFrom(Buffer: TMemory; Length: Integer): Integer; override;
+{$IFNDEF CIL}
+    {:Add this socket to given multicast group. You cannot use Multicasts in
+     SOCKS mode!}
+    procedure AddMulticast(MCastIP:string);
+
+    {:Remove this socket from given multicast group.}
+    procedure DropMulticast(MCastIP:string);
+{$ENDIF}
+    {:All sended multicast datagrams is loopbacked to your interface too. (you
+     can read your sended datas.) You can disable this feature by this function.
+     This function not working on some Windows systems!}
+    procedure EnableMulticastLoop(Value: Boolean);
+
+    {:Return value of socket type. For UDP return SOCK_DGRAM.}
+    function GetSocketType: integer; override;
+
+    {:Return value of protocol type for socket creation. For UDP return
+     IPPROTO_UDP.}
+    function GetSocketProtocol: integer; override;
+
+    {:Set Time-to-live value for multicasts packets. It define number of routers
+     for transfer of datas. If you set this to 1 (dafault system value), then
+     multicasts packet goes only to you local network. If you need transport
+     multicast packet to worldwide, then increase this value, but be carefull,
+     lot of routers on internet does not transport multicasts packets!}
+    property MulticastTTL: Integer read GetMulticastTTL Write SetMulticastTTL;
+  end;
+
+  {:@abstract(Implementation of RAW ICMP socket.)
+   For this object you must have rights for creating RAW sockets!}
+  TICMPBlockSocket = class(TDgramBlockSocket)
+  public
+    {:Return value of socket type. For RAW and ICMP return SOCK_RAW.}
+    function GetSocketType: integer; override;
+
+    {:Return value of protocol type for socket creation. For ICMP returns
+     IPPROTO_ICMP or IPPROTO_ICMPV6}
+    function GetSocketProtocol: integer; override;
+  end;
+
+  {:@abstract(Implementation of RAW socket.)
+   For this object you must have rights for creating RAW sockets!}
+  TRAWBlockSocket = class(TBlockSocket)
+  public
+    {:Return value of socket type. For RAW and ICMP return SOCK_RAW.}
+    function GetSocketType: integer; override;
+
+    {:Return value of protocol type for socket creation. For RAW returns
+     IPPROTO_RAW.}
+    function GetSocketProtocol: integer; override;
+  end;
+
+  {:@abstract(Implementation of PGM-message socket.)
+   Not all systems supports this protocol!}
+  TPGMMessageBlockSocket = class(TBlockSocket)
+  public
+    {:Return value of socket type. For PGM-message return SOCK_RDM.}
+    function GetSocketType: integer; override;
+
+    {:Return value of protocol type for socket creation. For PGM-message returns
+     IPPROTO_RM.}
+    function GetSocketProtocol: integer; override;
+  end;
+
+  {:@abstract(Implementation of PGM-stream socket.)
+   Not all systems supports this protocol!}
+  TPGMStreamBlockSocket = class(TBlockSocket)
+  public
+    {:Return value of socket type. For PGM-stream return SOCK_STREAM.}
+    function GetSocketType: integer; override;
+
+    {:Return value of protocol type for socket creation. For PGM-stream returns
+     IPPROTO_RM.}
+    function GetSocketProtocol: integer; override;
+  end;
+
+  {:@abstract(Parent class for all SSL plugins.)
+   This is abstract class defining interface for other SSL plugins.
+
+   Instance of this class will be created for each @link(TTCPBlockSocket).
+
+   Warning: not all methods and propertis can work in all existing SSL plugins!
+   Please, read documentation of used SSL plugin.}
+  TCustomSSL = class(TObject)
+  protected
+    FSocket: TTCPBlockSocket;
+    FSSLEnabled: Boolean;
+    FLastError: integer;
+    FLastErrorDesc: string;
+    FSSLType: TSSLType;
+    FKeyPassword: string;
+    FCiphers: string;
+    FCertificateFile: string;
+    FPrivateKeyFile: string;
+    FCertificate: Ansistring;
+    FPrivateKey: Ansistring;
+    FPFX: Ansistring;
+    FPFXfile: string;
+    FCertCA: Ansistring;
+    FCertCAFile: string;
+    FTrustCertificate: Ansistring;
+    FTrustCertificateFile: string;
+    FVerifyCert: Boolean;
+    FUsername: string;
+    FPassword: string;
+    FSSHChannelType: string;
+    FSSHChannelArg1: string;
+    FSSHChannelArg2: string;
+    procedure ReturnError;
+    function CreateSelfSignedCert(Host: string): Boolean; virtual;
+  public
+    {: Create plugin class. it is called internally from @link(TTCPBlockSocket)}
+    constructor Create(const Value: TTCPBlockSocket); virtual;
+
+    {: Assign settings (certificates and configuration) from another SSL plugin
+     class.}
+    procedure Assign(const Value: TCustomSSL); virtual;
+
+    {: return description of used plugin. It usually return name and version
+     of used SSL library.}
+    function LibVersion: String; virtual;
+
+    {: return name of used plugin.}
+    function LibName: String; virtual;
+
+    {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)!
+
+     Here is needed code for start SSL connection.}
+    function Connect: boolean; virtual;
+
+    {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)!
+
+     Here is needed code for acept new SSL connection.}
+    function Accept: boolean; virtual;
+
+    {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)!
+
+     Here is needed code for hard shutdown of SSL connection. (for example,
+     before socket is closed)}
+    function Shutdown: boolean; virtual;
+
+    {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)!
+
+     Here is needed code for soft shutdown of SSL connection. (for example,
+     when you need to continue with unprotected connection.)}
+    function BiShutdown: boolean; virtual;
+
+    {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)!
+
+     Here is needed code for sending some datas by SSL connection.}
+    function SendBuffer(Buffer: TMemory; Len: Integer): Integer; virtual;
+
+    {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)!
+
+     Here is needed code for receiving some datas by SSL connection.}
+    function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; virtual;
+
+    {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)!
+
+     Here is needed code for getting count of datas what waiting for read.
+     If SSL plugin not allows this, then it should return 0.}
+    function WaitingData: Integer; virtual;
+
+    {:Return string with identificator of SSL/TLS version of existing
+     connection.}
+    function GetSSLVersion: string; virtual;
+
+    {:Return subject of remote SSL peer.}
+    function GetPeerSubject: string; virtual;
+
+    {:Return issuer certificate of remote SSL peer.}
+    function GetPeerIssuer: string; virtual;
+
+    {:Return peer name from remote side certificate. This is good for verify,
+     if certificate is generated for remote side IP name.}
+    function GetPeerName: string; virtual;
+
+    {:Return fingerprint of remote SSL peer.}
+    function GetPeerFingerprint: string; virtual;
+
+    {:Return all detailed information about certificate from remote side of
+     SSL/TLS connection. Result string can be multilined! Each plugin can return
+     this informations in different format!}
+    function GetCertInfo: string; virtual;
+
+    {:Return currently used Cipher.}
+    function GetCipherName: string; virtual;
+
+    {:Return currently used number of bits in current Cipher algorythm.}
+    function GetCipherBits: integer; virtual;
+
+    {:Return number of bits in current Cipher algorythm.}
+    function GetCipherAlgBits: integer; virtual;
+
+    {:Return result value of verify remote side certificate. Look to OpenSSL
+     documentation for possible values. For example 0 is successfuly verified
+     certificate, or 18 is self-signed certificate.}
+    function GetVerifyCert: integer; virtual;
+
+    {: Resurn @true if SSL mode is enabled on existing cvonnection.}
+    property SSLEnabled: Boolean read FSSLEnabled;
+
+    {:Return error code of last SSL operation. 0 is OK.}
+    property LastError: integer read FLastError;
+
+    {:Return error description of last SSL operation.}
+    property LastErrorDesc: string read FLastErrorDesc;
+  published
+    {:Here you can specify requested SSL/TLS mode. Default is autodetection, but
+     on some servers autodetection not working properly. In this case you must
+     specify requested SSL/TLS mode by your hand!}
+    property SSLType: TSSLType read FSSLType write FSSLType;
+
+    {:Password for decrypting of encoded certificate or key.}
+    property KeyPassword: string read FKeyPassword write FKeyPassword;
+
+    {:Username for possible credentials.}
+    property Username: string read FUsername write FUsername;
+
+    {:password for possible credentials.}
+    property Password: string read FPassword write FPassword;
+
+    {:By this property you can modify default set of SSL/TLS ciphers.}
+    property Ciphers: string read FCiphers write FCiphers;
+
+    {:Used for loading certificate from disk file. See to plugin documentation
+     if this method is supported and how!}
+    property CertificateFile: string read FCertificateFile write FCertificateFile;
+
+    {:Used for loading private key from disk file. See to plugin documentation
+     if this method is supported and how!}
+    property PrivateKeyFile: string read FPrivateKeyFile write FPrivateKeyFile;
+
+    {:Used for loading certificate from binary string. See to plugin documentation
+     if this method is supported and how!}
+    property Certificate: Ansistring read FCertificate write FCertificate;
+
+    {:Used for loading private key from binary string. See to plugin documentation
+     if this method is supported and how!}
+    property PrivateKey: Ansistring read FPrivateKey write FPrivateKey;
+
+    {:Used for loading PFX from binary string. See to plugin documentation
+     if this method is supported and how!}
+    property PFX: Ansistring read FPFX write FPFX;
+
+    {:Used for loading PFX from disk file. See to plugin documentation
+     if this method is supported and how!}
+    property PFXfile: string read FPFXfile write FPFXfile;
+
+    {:Used for loading trusted certificates from disk file. See to plugin documentation
+     if this method is supported and how!}
+    property TrustCertificateFile: string read FTrustCertificateFile write FTrustCertificateFile;
+
+    {:Used for loading trusted certificates from binary string. See to plugin documentation
+     if this method is supported and how!}
+    property TrustCertificate: Ansistring read FTrustCertificate write FTrustCertificate;
+
+    {:Used for loading CA certificates from binary string. See to plugin documentation
+     if this method is supported and how!}
+    property CertCA: Ansistring read FCertCA write FCertCA;
+
+    {:Used for loading CA certificates from disk file. See to plugin documentation
+     if this method is supported and how!}
+    property CertCAFile: string read FCertCAFile write FCertCAFile;
+
+    {:If @true, then is verified client certificate. (it is good for writing
+     SSL/TLS servers.) When you are not server, but you are client, then if this
+     property is @true, verify servers certificate.}
+    property VerifyCert: Boolean read FVerifyCert write FVerifyCert;
+
+    {:channel type for possible SSH connections}
+    property SSHChannelType: string read FSSHChannelType write FSSHChannelType;
+
+    {:First argument of channel type for possible SSH connections}
+    property SSHChannelArg1: string read FSSHChannelArg1 write FSSHChannelArg1;
+
+    {:Second argument of channel type for possible SSH connections}
+    property SSHChannelArg2: string read FSSHChannelArg2 write FSSHChannelArg2;
+  end;
+
+  {:@abstract(Default SSL plugin with no SSL support.)
+   Dummy SSL plugin implementation for applications without SSL/TLS support.}
+  TSSLNone = class (TCustomSSL)
+  public
+    {:See @inherited}
+    function LibVersion: String; override;
+    {:See @inherited}
+    function LibName: String; override;
+  end;
+
+  {:@abstract(Record with definition of IP packet header.)
+   For reading data from ICMP or RAW sockets.}
+  TIPHeader = record
+    VerLen: Byte;
+    TOS: Byte;
+    TotalLen: Word;
+    Identifer: Word;
+    FragOffsets: Word;
+    TTL: Byte;
+    Protocol: Byte;
+    CheckSum: Word;
+    SourceIp: LongWord;
+    DestIp: LongWord;
+    Options: LongWord;
+  end;
+
+  {:@abstract(Parent class of application protocol implementations.)
+   By this class is defined common properties.}
+  TSynaClient = Class(TObject)
+  protected
+    FTargetHost: string;
+    FTargetPort: string;
+    FIPInterface: string;
+    FTimeout: integer;
+    FUserName: string;
+    FPassword: string;
+  public
+    constructor Create;
+  published
+    {:Specify terget server IP (or symbolic name). Default is 'localhost'.}
+    property TargetHost: string read FTargetHost Write FTargetHost;
+
+    {:Specify terget server port (or symbolic name).}
+    property TargetPort: string read FTargetPort Write FTargetPort;
+
+    {:Defined local socket address. (outgoing IP address). By default is used
+     '0.0.0.0' as wildcard for default IP.}
+    property IPInterface: string read FIPInterface Write FIPInterface;
+
+    {:Specify default timeout for socket operations.}
+    property Timeout: integer read FTimeout Write FTimeout;
+
+    {:If protocol need user authorization, then fill here username.}
+    property UserName: string read FUserName Write FUserName;
+
+    {:If protocol need user authorization, then fill here password.}
+    property Password: string read FPassword Write FPassword;
+  end;
+
+var
+  {:Selected SSL plugin. Default is @link(TSSLNone).
+
+   Do not change this value directly!!!
+
+   Just add your plugin unit to your project uses instead. Each plugin unit have
+   initialization code what modify this variable.}
+  SSLImplementation: TSSLClass = TSSLNone;
+
+implementation
+
+{$IFDEF ONCEWINSOCK}
+var
+  WsaDataOnce: TWSADATA;
+  e: ESynapseError;
+{$ENDIF}
+
+
+constructor TBlockSocket.Create;
+begin
+  CreateAlternate('');
+end;
+
+constructor TBlockSocket.CreateAlternate(Stub: string);
+{$IFNDEF ONCEWINSOCK}
+var
+  e: ESynapseError;
+{$ENDIF}
+begin
+  inherited Create;
+  FDelayedOptions := TList.Create;
+  FRaiseExcept := False;
+{$IFDEF RAISEEXCEPT}
+  FRaiseExcept := True;
+{$ENDIF}
+  FSocket := INVALID_SOCKET;
+  FBuffer := '';
+  FLastCR := False;
+  FLastLF := False;
+  FBinded := False;
+  FNonBlockMode := False;
+  FMaxLineLength := 0;
+  FMaxSendBandwidth := 0;
+  FNextSend := 0;
+  FMaxRecvBandwidth := 0;
+  FNextRecv := 0;
+  FConvertLineEnd := False;
+  FFamily := SF_Any;
+  FFamilySave := SF_Any;
+  FIP6used := False;
+  FPreferIP4 := True;
+  FInterPacketTimeout := True;
+  FRecvCounter := 0;
+  FSendCounter := 0;
+  FSendMaxChunk := c64k;
+  FStopFlag := False;
+  FNonblockSendTimeout := 15000;
+  FHeartbeatRate := 0;
+  FOwner := nil;
+{$IFNDEF ONCEWINSOCK}
+  if Stub = '' then
+    Stub := DLLStackName;
+  if not InitSocketInterface(Stub) then
+  begin
+    e := ESynapseError.Create('Error loading Socket interface (' + Stub + ')!');
+    e.ErrorCode := 0;
+    e.ErrorMessage := 'Error loading Socket interface (' + Stub + ')!';
+    raise e;
+  end;
+  SockCheck(synsock.WSAStartup(WinsockLevel, FWsaDataOnce));
+  ExceptCheck;
+{$ENDIF}
+end;
+
+destructor TBlockSocket.Destroy;
+var
+  n: integer;
+  p: TSynaOption;
+begin
+  CloseSocket;
+{$IFNDEF ONCEWINSOCK}
+  synsock.WSACleanup;
+  DestroySocketInterface;
+{$ENDIF}
+  for n := FDelayedOptions.Count - 1 downto 0 do
+    begin
+      p := TSynaOption(FDelayedOptions[n]);
+      p.Free;
+    end;
+  FDelayedOptions.Free;
+  inherited Destroy;
+end;
+
+function TBlockSocket.FamilyToAF(f: TSocketFamily): TAddrFamily;
+begin
+  case f of
+    SF_ip4:
+      Result := AF_INET;
+    SF_ip6:
+      Result := AF_INET6;
+  else
+    Result := AF_UNSPEC;
+  end;
+end;
+
+procedure TBlockSocket.SetDelayedOption(const Value: TSynaOption);
+var
+  li: TLinger;
+  x: integer;
+  buf: TMemory;
+{$IFNDEF MSWINDOWS}
+  timeval: TTimeval;
+{$ENDIF}
+begin
+  case value.Option of
+    SOT_Linger:
+      begin
+        {$IFDEF CIL}
+        li := TLinger.Create(Value.Enabled, Value.Value div 1000);
+        synsock.SetSockOptObj(FSocket, integer(SOL_SOCKET), integer(SO_LINGER), li);
+        {$ELSE}
+        li.l_onoff := Ord(Value.Enabled);
+        li.l_linger := Value.Value div 1000;
+        buf := @li;
+        synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_LINGER), buf, SizeOf(li));
+        {$ENDIF}
+      end;
+    SOT_RecvBuff:
+      begin
+        {$IFDEF CIL}
+        buf := System.BitConverter.GetBytes(value.Value);
+        {$ELSE}
+        buf := @Value.Value;
+        {$ENDIF}
+        synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_RCVBUF),
+          buf, SizeOf(Value.Value));
+      end;
+    SOT_SendBuff:
+      begin
+        {$IFDEF CIL}
+        buf := System.BitConverter.GetBytes(value.Value);
+        {$ELSE}
+        buf := @Value.Value;
+        {$ENDIF}
+        synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_SNDBUF),
+          buf, SizeOf(Value.Value));
+      end;
+    SOT_NonBlock:
+      begin
+        FNonBlockMode := Value.Enabled;
+        x := Ord(FNonBlockMode);
+        synsock.IoctlSocket(FSocket, FIONBIO, x);
+      end;
+    SOT_RecvTimeout:
+      begin
+        {$IFDEF CIL}
+        buf := System.BitConverter.GetBytes(value.Value);
+        synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_RCVTIMEO),
+          buf, SizeOf(Value.Value));
+        {$ELSE}
+          {$IFDEF MSWINDOWS}
+        buf := @Value.Value;
+        synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_RCVTIMEO),
+          buf, SizeOf(Value.Value));
+          {$ELSE}
+        timeval.tv_sec:=Value.Value div 1000;
+        timeval.tv_usec:=(Value.Value mod 1000) * 1000;
+        synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_RCVTIMEO),
+          @timeval, SizeOf(timeval));
+          {$ENDIF}
+        {$ENDIF}
+      end;
+    SOT_SendTimeout:
+      begin
+        {$IFDEF CIL}
+        buf := System.BitConverter.GetBytes(value.Value);
+        {$ELSE}
+          {$IFDEF MSWINDOWS}
+        buf := @Value.Value;
+        synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_SNDTIMEO),
+          buf, SizeOf(Value.Value));
+          {$ELSE}
+        timeval.tv_sec:=Value.Value div 1000;
+        timeval.tv_usec:=(Value.Value mod 1000) * 1000;
+        synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_SNDTIMEO),
+          @timeval, SizeOf(timeval));
+          {$ENDIF}
+        {$ENDIF}
+      end;
+    SOT_Reuse:
+      begin
+        x := Ord(Value.Enabled);
+        {$IFDEF CIL}
+        buf := System.BitConverter.GetBytes(x);
+        {$ELSE}
+        buf := @x;
+        {$ENDIF}
+        synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_REUSEADDR), buf, SizeOf(x));
+      end;
+    SOT_TTL:
+      begin
+        {$IFDEF CIL}
+        buf := System.BitConverter.GetBytes(value.Value);
+        {$ELSE}
+        buf := @Value.Value;
+        {$ENDIF}
+        if FIP6Used then
+          synsock.SetSockOpt(FSocket, integer(IPPROTO_IPV6), integer(IPV6_UNICAST_HOPS),
+            buf, SizeOf(Value.Value))
+        else
+          synsock.SetSockOpt(FSocket, integer(IPPROTO_IP), integer(IP_TTL),
+            buf, SizeOf(Value.Value));
+      end;
+    SOT_Broadcast:
+      begin
+//#todo1 broadcasty na IP6
+        x := Ord(Value.Enabled);
+        {$IFDEF CIL}
+        buf := System.BitConverter.GetBytes(x);
+        {$ELSE}
+        buf := @x;
+        {$ENDIF}
+        synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_BROADCAST), buf, SizeOf(x));
+      end;
+    SOT_MulticastTTL:
+      begin
+        {$IFDEF CIL}
+        buf := System.BitConverter.GetBytes(value.Value);
+        {$ELSE}
+        buf := @Value.Value;
+        {$ENDIF}
+        if FIP6Used then
+          synsock.SetSockOpt(FSocket, integer(IPPROTO_IPV6), integer(IPV6_MULTICAST_HOPS),
+            buf, SizeOf(Value.Value))
+        else
+          synsock.SetSockOpt(FSocket, integer(IPPROTO_IP), integer(IP_MULTICAST_TTL),
+            buf, SizeOf(Value.Value));
+      end;
+   SOT_MulticastLoop:
+      begin
+        x := Ord(Value.Enabled);
+        {$IFDEF CIL}
+        buf := System.BitConverter.GetBytes(x);
+        {$ELSE}
+        buf := @x;
+        {$ENDIF}
+        if FIP6Used then
+          synsock.SetSockOpt(FSocket, integer(IPPROTO_IPV6), integer(IPV6_MULTICAST_LOOP), buf, SizeOf(x))
+        else
+          synsock.SetSockOpt(FSocket, integer(IPPROTO_IP), integer(IP_MULTICAST_LOOP), buf, SizeOf(x));
+      end;
+  end;
+  Value.free;
+end;
+
+procedure TBlockSocket.DelayedOption(const Value: TSynaOption);
+begin
+  if FSocket = INVALID_SOCKET then
+  begin
+    FDelayedOptions.Insert(0, Value);
+  end
+  else
+    SetDelayedOption(Value);
+end;
+
+procedure TBlockSocket.ProcessDelayedOptions;
+var
+  n: integer;
+  d: TSynaOption;
+begin
+  for n := FDelayedOptions.Count - 1 downto 0 do
+  begin
+    d := TSynaOption(FDelayedOptions[n]);
+    SetDelayedOption(d);
+  end;
+  FDelayedOptions.Clear;
+end;
+
+procedure TBlockSocket.SetSin(var Sin: TVarSin; IP, Port: string);
+var
+  f: TSocketFamily;
+begin
+  DoStatus(HR_ResolvingBegin, IP + ':' + Port);
+  ResetLastError;
+  //if socket exists, then use their type, else use users selection
+  f := SF_Any;
+  if (FSocket = INVALID_SOCKET) and (FFamily = SF_any) then
+  begin
+    if IsIP(IP) then
+      f := SF_IP4
+    else
+      if IsIP6(IP) then
+        f := SF_IP6;
+  end
+  else
+    f := FFamily;
+  FLastError := synsock.SetVarSin(sin, ip, port, FamilyToAF(f),
+    GetSocketprotocol, GetSocketType, FPreferIP4);
+  DoStatus(HR_ResolvingEnd, GetSinIP(sin) + ':' + IntTostr(GetSinPort(sin)));
+end;
+
+function TBlockSocket.GetSinIP(Sin: TVarSin): string;
+begin
+  Result := synsock.GetSinIP(sin);
+end;
+
+function TBlockSocket.GetSinPort(Sin: TVarSin): Integer;
+begin
+  Result := synsock.GetSinPort(sin);
+end;
+
+procedure TBlockSocket.CreateSocket;
+var
+  sin: TVarSin;
+begin
+  //dummy for SF_Any Family mode
+  ResetLastError;
+  if (FFamily <> SF_Any) and (FSocket = INVALID_SOCKET) then
+  begin
+    {$IFDEF CIL}
+    if FFamily = SF_IP6 then
+      sin := TVarSin.Create(IPAddress.Parse('::0'), 0)
+    else
+      sin := TVarSin.Create(IPAddress.Parse('0.0.0.0'), 0);
+    {$ELSE}
+    FillChar(Sin, Sizeof(Sin), 0);
+    if FFamily = SF_IP6 then
+      sin.sin_family := AF_INET6
+    else
+      sin.sin_family := AF_INET;
+    {$ENDIF}
+    InternalCreateSocket(Sin);
+  end;
+end;
+
+procedure TBlockSocket.CreateSocketByName(const Value: String);
+var
+  sin: TVarSin;
+begin
+  ResetLastError;
+  if FSocket = INVALID_SOCKET then
+  begin
+    SetSin(sin, value, '0');
+    if FLastError = 0 then
+      InternalCreateSocket(Sin);
+  end;
+end;
+
+procedure TBlockSocket.InternalCreateSocket(Sin: TVarSin);
+begin
+  FStopFlag := False;
+  FRecvCounter := 0;
+  FSendCounter := 0;
+  ResetLastError;
+  if FSocket = INVALID_SOCKET then
+  begin
+    FBuffer := '';
+    FBinded := False;
+    FIP6Used := Sin.AddressFamily = AF_INET6;
+    FSocket := synsock.Socket(integer(Sin.AddressFamily), GetSocketType, GetSocketProtocol);
+    if FSocket = INVALID_SOCKET then
+      FLastError := synsock.WSAGetLastError;
+    {$IFNDEF CIL}
+    FD_ZERO(FFDSet);
+    FD_SET(FSocket, FFDSet);
+    {$ENDIF}
+    ExceptCheck;
+    if FIP6used then
+      DoStatus(HR_SocketCreate, 'IPv6')
+    else
+      DoStatus(HR_SocketCreate, 'IPv4');
+    ProcessDelayedOptions;
+    DoCreateSocket;
+  end;
+end;
+
+procedure TBlockSocket.CloseSocket;
+begin
+  AbortSocket;
+end;
+
+procedure TBlockSocket.AbortSocket;
+var
+  n: integer;
+  p: TSynaOption;
+begin
+  if FSocket <> INVALID_SOCKET then
+    synsock.CloseSocket(FSocket);
+  FSocket := INVALID_SOCKET;
+  for n := FDelayedOptions.Count - 1 downto 0 do
+    begin
+      p := TSynaOption(FDelayedOptions[n]);
+      p.Free;
+    end;
+  FDelayedOptions.Clear;
+  FFamily := FFamilySave;
+  DoStatus(HR_SocketClose, '');
+end;
+
+procedure TBlockSocket.Bind(IP, Port: string);
+var
+  Sin: TVarSin;
+begin
+  ResetLastError;
+  if (FSocket <> INVALID_SOCKET)
+    or not((FFamily = SF_ANY) and (IP = cAnyHost) and (Port = cAnyPort)) then
+  begin
+    SetSin(Sin, IP, Port);
+    if FLastError = 0 then
+    begin
+      if FSocket = INVALID_SOCKET then
+        InternalCreateSocket(Sin);
+      SockCheck(synsock.Bind(FSocket, Sin));
+      GetSinLocal;
+      FBuffer := '';
+      FBinded := True;
+    end;
+    ExceptCheck;
+    DoStatus(HR_Bind, IP + ':' + Port);
+  end;
+end;
+
+procedure TBlockSocket.Connect(IP, Port: string);
+var
+  Sin: TVarSin;
+begin
+  SetSin(Sin, IP, Port);
+  if FLastError = 0 then
+  begin
+    if FSocket = INVALID_SOCKET then
+      InternalCreateSocket(Sin);
+    SockCheck(synsock.Connect(FSocket, Sin));
+    if FLastError = 0 then
+      GetSins;
+    FBuffer := '';
+    FLastCR := False;
+    FLastLF := False;
+  end;
+  ExceptCheck;
+  DoStatus(HR_Connect, IP + ':' + Port);
+end;
+
+procedure TBlockSocket.Listen;
+begin
+  SockCheck(synsock.Listen(FSocket, SOMAXCONN));
+  GetSins;
+  ExceptCheck;
+  DoStatus(HR_Listen, '');
+end;
+
+function TBlockSocket.Accept: TSocket;
+begin
+  Result := synsock.Accept(FSocket, FRemoteSin);
+///    SockCheck(Result);
+  ExceptCheck;
+  DoStatus(HR_Accept, '');
+end;
+
+procedure TBlockSocket.GetSinLocal;
+begin
+  synsock.GetSockName(FSocket, FLocalSin);
+end;
+
+procedure TBlockSocket.GetSinRemote;
+begin
+  synsock.GetPeerName(FSocket, FRemoteSin);
+end;
+
+procedure TBlockSocket.GetSins;
+begin
+  GetSinLocal;
+  GetSinRemote;
+end;
+
+procedure TBlockSocket.SetBandwidth(Value: Integer);
+begin
+  MaxSendBandwidth := Value;
+  MaxRecvBandwidth := Value;
+end;
+
+procedure TBlockSocket.LimitBandwidth(Length: Integer; MaxB: integer; var Next: LongWord);
+var
+  x: LongWord;
+  y: LongWord;
+  n: integer;
+begin
+  if FStopFlag then
+    exit;
+  if MaxB > 0 then
+  begin
+    y := GetTick;
+    if Next > y then
+    begin
+      x := Next - y;
+      if x > 0 then
+      begin
+        DoStatus(HR_Wait, IntToStr(x));
+        sleep(x mod 250);
+        for n := 1 to x div 250 do
+          if FStopFlag then
+            Break
+          else
+            sleep(250);
+      end;
+    end;
+    Next := GetTick + Trunc((Length / MaxB) * 1000);
+  end;
+end;
+
+function TBlockSocket.TestStopFlag: Boolean;
+begin
+  DoHeartbeat;
+  Result := FStopFlag;
+  if Result then
+  begin
+    FStopFlag := False;
+    FLastError := WSAECONNABORTED;
+    ExceptCheck;
+  end;
+end;
+
+
+function TBlockSocket.SendBuffer(Buffer: TMemory; Length: Integer): Integer;
+{$IFNDEF CIL}
+var
+  x, y: integer;
+  l, r: integer;
+  p: Pointer;
+{$ENDIF}
+begin
+  Result := 0;
+  if TestStopFlag then
+    Exit;
+  DoMonitor(True, Buffer, Length);
+{$IFDEF CIL}
+  Result := synsock.Send(FSocket, Buffer, Length, 0);
+{$ELSE}
+  l := Length;
+  x := 0;
+  while x < l do
+  begin
+    y := l - x;
+    if y > FSendMaxChunk then
+      y := FSendMaxChunk;
+    if y > 0 then
+    begin
+      LimitBandwidth(y, FMaxSendBandwidth, FNextsend);
+      p := IncPoint(Buffer, x);
+      r := synsock.Send(FSocket, p, y, MSG_NOSIGNAL);
+      SockCheck(r);
+      if FLastError = WSAEWOULDBLOCK then
+      begin
+        if CanWrite(FNonblockSendTimeout) then
+        begin
+          r := synsock.Send(FSocket, p, y, MSG_NOSIGNAL);
+          SockCheck(r);
+        end
+        else
+          FLastError := WSAETIMEDOUT;
+      end;
+      if FLastError <> 0 then
+        Break;
+      Inc(x, r);
+      Inc(Result, r);
+      Inc(FSendCounter, r);
+      DoStatus(HR_WriteCount, IntToStr(r));
+    end
+    else
+      break;
+  end;
+{$ENDIF}
+  ExceptCheck;
+end;
+
+procedure TBlockSocket.SendByte(Data: Byte);
+{$IFDEF CIL}
+var
+  buf: TMemory;
+{$ENDIF}
+begin
+{$IFDEF CIL}
+  setlength(buf, 1);
+  buf[0] := Data;
+  SendBuffer(buf, 1);
+{$ELSE}
+  SendBuffer(@Data, 1);
+{$ENDIF}
+end;
+
+procedure TBlockSocket.SendString(Data: AnsiString);
+var
+  buf: TMemory;
+begin
+  {$IFDEF CIL}
+  buf := BytesOf(Data);
+  {$ELSE}
+  buf := Pointer(data);
+  {$ENDIF}
+  SendBuffer(buf, Length(Data));
+end;
+
+procedure TBlockSocket.SendInteger(Data: integer);
+var
+  buf: TMemory;
+begin
+  {$IFDEF CIL}
+  buf := System.BitConverter.GetBytes(Data);
+  {$ELSE}
+  buf := @Data;
+  {$ENDIF}
+  SendBuffer(buf, SizeOf(Data));
+end;
+
+procedure TBlockSocket.SendBlock(const Data: AnsiString);
+var
+  i: integer;
+begin
+  i := SwapBytes(Length(data));
+  SendString(Codelongint(i) + Data);
+end;
+
+procedure TBlockSocket.InternalSendStream(const Stream: TStream; WithSize, Indy: boolean);
+var
+  l: integer;
+  yr: integer;
+  s: AnsiString;
+  b: boolean;
+{$IFDEF CIL}
+  buf: TMemory;
+{$ENDIF}
+begin
+  b := true;
+  l := 0;
+  if WithSize then
+  begin
+    l := Stream.Size - Stream.Position;;
+    if Indy then
+      l := SwapBytes(l);
+  end;
+  repeat
+    {$IFDEF CIL}
+    Setlength(buf, FSendMaxChunk);
+    yr := Stream.read(buf, FSendMaxChunk);
+    if yr > 0 then
+    begin
+      if WithSize and b then
+      begin
+        b := false;
+        SendString(CodeLongInt(l));
+      end;
+      SendBuffer(buf, yr);
+      if FLastError <> 0 then
+        break;
+    end
+    {$ELSE}
+    Setlength(s, FSendMaxChunk);
+    yr := Stream.read(Pointer(s)^, FSendMaxChunk);
+    if yr > 0 then
+    begin
+      SetLength(s, yr);
+      if WithSize and b then
+      begin
+        b := false;
+        SendString(CodeLongInt(l) + s);
+      end
+      else
+        SendString(s);
+      if FLastError <> 0 then
+        break;
+    end
+    {$ENDIF}
+  until yr <= 0;
+end;
+
+procedure TBlockSocket.SendStreamRaw(const Stream: TStream);
+begin
+  InternalSendStream(Stream, false, false);
+end;
+
+procedure TBlockSocket.SendStreamIndy(const Stream: TStream);
+begin
+  InternalSendStream(Stream, true, true);
+end;
+
+procedure TBlockSocket.SendStream(const Stream: TStream);
+begin
+  InternalSendStream(Stream, true, false);
+end;
+
+function TBlockSocket.RecvBuffer(Buffer: TMemory; Length: Integer): Integer;
+begin
+  Result := 0;
+  if TestStopFlag then
+    Exit;
+  LimitBandwidth(Length, FMaxRecvBandwidth, FNextRecv);
+//  Result := synsock.Recv(FSocket, Buffer^, Length, MSG_NOSIGNAL);
+  Result := synsock.Recv(FSocket, Buffer, Length, MSG_NOSIGNAL);
+  if Result = 0 then
+    FLastError := WSAECONNRESET
+  else
+    SockCheck(Result);
+  ExceptCheck;
+  if Result > 0 then
+  begin
+    Inc(FRecvCounter, Result);
+    DoStatus(HR_ReadCount, IntToStr(Result));
+    DoMonitor(False, Buffer, Result);
+    DoReadFilter(Buffer, Result);
+  end;
+end;
+
+function TBlockSocket.RecvBufferEx(Buffer: TMemory; Len: Integer;
+  Timeout: Integer): Integer;
+var
+  s: AnsiString;
+  rl, l: integer;
+  ti: LongWord;
+{$IFDEF CIL}
+  n: integer;
+  b: TMemory;
+{$ENDIF}
+begin
+  ResetLastError;
+  Result := 0;
+  if Len > 0 then
+  begin
+    rl := 0;
+    repeat
+      ti := GetTick;
+      s := RecvPacket(Timeout);
+      l := Length(s);
+      if (rl + l) > Len then
+        l := Len - rl;
+      {$IFDEF CIL}
+      b := BytesOf(s);
+      for n := 0 to l do
+        Buffer[rl + n] := b[n];
+      {$ELSE}
+      Move(Pointer(s)^, IncPoint(Buffer, rl)^, l);
+      {$ENDIF}
+      rl := rl + l;
+      if FLastError <> 0 then
+        Break;
+      if rl >= Len then
+        Break;
+      if not FInterPacketTimeout then
+      begin
+        Timeout := Timeout - integer(TickDelta(ti, GetTick));
+        if Timeout <= 0 then
+        begin
+          FLastError := WSAETIMEDOUT;
+          Break;
+        end;
+      end;
+    until False;
+    delete(s, 1, l);
+    FBuffer := s;
+    Result := rl;
+  end;
+end;
+
+function TBlockSocket.RecvBufferStr(Len: Integer; Timeout: Integer): AnsiString;
+var
+  x: integer;
+{$IFDEF CIL}
+  buf: Tmemory;
+{$ENDIF}
+begin
+  Result := '';
+  if Len > 0 then
+  begin
+    {$IFDEF CIL}
+    Setlength(Buf, Len);
+    x := RecvBufferEx(buf, Len , Timeout);
+    if FLastError = 0 then
+    begin
+      SetLength(Buf, x);
+      Result := StringOf(buf);
+    end
+    else
+      Result := '';
+    {$ELSE}
+    Setlength(Result, Len);
+    x := RecvBufferEx(Pointer(Result), Len , Timeout);
+    if FLastError = 0 then
+      SetLength(Result, x)
+    else
+      Result := '';
+    {$ENDIF}
+  end;
+end;
+
+function TBlockSocket.RecvPacket(Timeout: Integer): AnsiString;
+var
+  x: integer;
+{$IFDEF CIL}
+  buf: TMemory;
+{$ENDIF}
+begin
+  Result := '';
+  ResetLastError;
+  if FBuffer <> '' then
+  begin
+    Result := FBuffer;
+    FBuffer := '';
+  end
+  else
+  begin
+    {$IFDEF MSWINDOWS}
+    //not drain CPU on large downloads...
+    Sleep(0);
+    {$ENDIF}
+    x := WaitingData;
+    if x > 0 then
+    begin
+      {$IFDEF CIL}
+      SetLength(Buf, x);
+      x := RecvBuffer(Buf, x);
+      if x >= 0 then
+      begin
+        SetLength(Buf, x);
+        Result := StringOf(Buf);
+      end;
+      {$ELSE}
+      SetLength(Result, x);
+      x := RecvBuffer(Pointer(Result), x);
+      if x >= 0 then
+        SetLength(Result, x);
+      {$ENDIF}
+    end
+    else
+    begin
+      if CanRead(Timeout) then
+      begin
+        x := WaitingData;
+        if x = 0 then
+          FLastError := WSAECONNRESET;
+        if x > 0 then
+        begin
+          {$IFDEF CIL}
+          SetLength(Buf, x);
+          x := RecvBuffer(Buf, x);
+          if x >= 0 then
+          begin
+            SetLength(Buf, x);
+            result := StringOf(Buf);
+          end;
+          {$ELSE}
+          SetLength(Result, x);
+          x := RecvBuffer(Pointer(Result), x);
+          if x >= 0 then
+            SetLength(Result, x);
+          {$ENDIF}
+        end;
+      end
+      else
+        FLastError := WSAETIMEDOUT;
+    end;
+  end;
+  if FConvertLineEnd and (Result <> '') then
+  begin
+    if FLastCR and (Result[1] = LF) then
+      Delete(Result, 1, 1);
+    if FLastLF and (Result[1] = CR) then
+      Delete(Result, 1, 1);
+    FLastCR := False;
+    FLastLF := False;
+  end;
+  ExceptCheck;
+end;
+
+
+function TBlockSocket.RecvByte(Timeout: Integer): Byte;
+begin
+  Result := 0;
+  ResetLastError;
+  if FBuffer = '' then
+    FBuffer := RecvPacket(Timeout);
+  if (FLastError = 0) and (FBuffer <> '') then
+  begin
+    Result := Ord(FBuffer[1]);
+    Delete(FBuffer, 1, 1);
+  end;
+  ExceptCheck;
+end;
+
+function TBlockSocket.RecvInteger(Timeout: Integer): Integer;
+var
+  s: AnsiString;
+begin
+  Result := 0;
+  s := RecvBufferStr(4, Timeout);
+  if FLastError = 0 then
+    Result := (ord(s[1]) + ord(s[2]) * 256) + (ord(s[3]) + ord(s[4]) * 256) * 65536;
+end;
+
+function TBlockSocket.RecvTerminated(Timeout: Integer; const Terminator: AnsiString): AnsiString;
+var
+  x: Integer;
+  s: AnsiString;
+  l: Integer;
+  CorCRLF: Boolean;
+  t: AnsiString;
+  tl: integer;
+  ti: LongWord;
+begin
+  ResetLastError;
+  Result := '';
+  l := Length(Terminator);
+  if l = 0 then
+    Exit;
+  tl := l;
+  CorCRLF := FConvertLineEnd and (Terminator = CRLF);
+  s := '';
+  x := 0;
+  repeat
+    //get rest of FBuffer or incomming new data...
+    ti := GetTick;
+    s := s + RecvPacket(Timeout);
+    if FLastError <> 0 then
+      Break;
+    x := 0;
+    if Length(s) > 0 then
+      if CorCRLF then
+      begin
+        t := '';
+        x := PosCRLF(s, t);
+        tl := Length(t);
+        if t = CR then
+          FLastCR := True;
+        if t = LF then
+          FLastLF := True;
+      end
+      else
+      begin
+        x := pos(Terminator, s);
+        tl := l;
+      end;
+    if (FMaxLineLength <> 0) and (Length(s) > FMaxLineLength) then
+    begin
+      FLastError := WSAENOBUFS;
+      Break;
+    end;
+    if x > 0 then
+      Break;
+    if not FInterPacketTimeout then
+    begin
+      Timeout := Timeout - integer(TickDelta(ti, GetTick));
+      if Timeout <= 0 then
+      begin
+        FLastError := WSAETIMEDOUT;
+        Break;
+      end;
+    end;
+  until False;
+  if x > 0 then
+  begin
+    Result := Copy(s, 1, x - 1);
+    Delete(s, 1, x + tl - 1);
+  end;
+  FBuffer := s;
+  ExceptCheck;
+end;
+
+function TBlockSocket.RecvString(Timeout: Integer): AnsiString;
+var
+  s: AnsiString;
+begin
+  Result := '';
+  s := RecvTerminated(Timeout, CRLF);
+  if FLastError = 0 then
+    Result := s;
+end;
+
+function TBlockSocket.RecvBlock(Timeout: Integer): AnsiString;
+var
+  x: integer;
+begin
+  Result := '';
+  x := RecvInteger(Timeout);
+  if FLastError = 0 then
+    Result := RecvBufferStr(x, Timeout);
+end;
+
+procedure TBlockSocket.RecvStreamRaw(const Stream: TStream; Timeout: Integer);
+var
+  s: AnsiString;
+begin
+  repeat
+    s := RecvPacket(Timeout);
+    if FLastError = 0 then
+      WriteStrToStream(Stream, s);
+  until FLastError <> 0;
+end;
+
+procedure TBlockSocket.RecvStreamSize(const Stream: TStream; Timeout: Integer; Size: Integer);
+var
+  s: AnsiString;
+  n: integer;
+{$IFDEF CIL}
+  buf: TMemory;
+{$ENDIF}
+begin
+  for n := 1 to (Size div FSendMaxChunk) do
+  begin
+    {$IFDEF CIL}
+    SetLength(buf, FSendMaxChunk);
+    RecvBufferEx(buf, FSendMaxChunk, Timeout);
+    if FLastError <> 0 then
+      Exit;
+    Stream.Write(buf, FSendMaxChunk);
+    {$ELSE}
+    s := RecvBufferStr(FSendMaxChunk, Timeout);
+    if FLastError <> 0 then
+      Exit;
+    WriteStrToStream(Stream, s);
+    {$ENDIF}
+  end;
+  n := Size mod FSendMaxChunk;
+  if n > 0 then
+  begin
+    {$IFDEF CIL}
+    SetLength(buf, n);
+    RecvBufferEx(buf, n, Timeout);
+    if FLastError <> 0 then
+      Exit;
+    Stream.Write(buf, n);
+    {$ELSE}
+    s := RecvBufferStr(n, Timeout);
+    if FLastError <> 0 then
+      Exit;
+    WriteStrToStream(Stream, s);
+    {$ENDIF}
+  end;
+end;
+
+procedure TBlockSocket.RecvStreamIndy(const Stream: TStream; Timeout: Integer);
+var
+  x: integer;
+begin
+  x := RecvInteger(Timeout);
+  x := synsock.NToHL(x);
+  if FLastError = 0 then
+    RecvStreamSize(Stream, Timeout, x);
+end;
+
+procedure TBlockSocket.RecvStream(const Stream: TStream; Timeout: Integer);
+var
+  x: integer;
+begin
+  x := RecvInteger(Timeout);
+  if FLastError = 0 then
+    RecvStreamSize(Stream, Timeout, x);
+end;
+
+function TBlockSocket.PeekBuffer(Buffer: TMemory; Length: Integer): Integer;
+begin
+ {$IFNDEF CIL}
+//  Result := synsock.Recv(FSocket, Buffer^, Length, MSG_PEEK + MSG_NOSIGNAL);
+  Result := synsock.Recv(FSocket, Buffer, Length, MSG_PEEK + MSG_NOSIGNAL);
+  SockCheck(Result);
+  ExceptCheck;
+  {$ENDIF}
+end;
+
+function TBlockSocket.PeekByte(Timeout: Integer): Byte;
+var
+  s: string;
+begin
+ {$IFNDEF CIL}
+  Result := 0;
+  if CanRead(Timeout) then
+  begin
+    SetLength(s, 1);
+    PeekBuffer(Pointer(s), 1);
+    if s <> '' then
+      Result := Ord(s[1]);
+  end
+  else
+    FLastError := WSAETIMEDOUT;
+  ExceptCheck;
+  {$ENDIF}
+end;
+
+procedure TBlockSocket.ResetLastError;
+begin
+  FLastError := 0;
+  FLastErrorDesc := '';
+end;
+
+function TBlockSocket.SockCheck(SockResult: Integer): Integer;
+begin
+  ResetLastError;
+  if SockResult = integer(SOCKET_ERROR) then
+  begin
+    FLastError := synsock.WSAGetLastError;
+    FLastErrorDesc := GetErrorDescEx;
+  end;
+  Result := FLastError;
+end;
+
+procedure TBlockSocket.ExceptCheck;
+var
+  e: ESynapseError;
+begin
+  FLastErrorDesc := GetErrorDescEx;
+  if (LastError <> 0) and (LastError <> WSAEINPROGRESS)
+    and (LastError <> WSAEWOULDBLOCK) then
+  begin
+    DoStatus(HR_Error, IntToStr(FLastError) + ',' + FLastErrorDesc);
+    if FRaiseExcept then
+    begin
+      e := ESynapseError.Create(Format('Synapse TCP/IP Socket error %d: %s',
+        [FLastError, FLastErrorDesc]));
+      e.ErrorCode := FLastError;
+      e.ErrorMessage := FLastErrorDesc;
+      raise e;
+    end;
+  end;
+end;
+
+function TBlockSocket.WaitingData: Integer;
+var
+  x: Integer;
+begin
+  Result := 0;
+  if synsock.IoctlSocket(FSocket, FIONREAD, x) = 0 then
+    Result := x;
+  if Result > c64k then
+    Result := c64k;
+end;
+
+function TBlockSocket.WaitingDataEx: Integer;
+begin
+  if FBuffer <> '' then
+    Result := Length(FBuffer)
+  else
+    Result := WaitingData;
+end;
+
+procedure TBlockSocket.Purge;
+begin
+  Sleep(1);
+  try
+    while (Length(FBuffer) > 0) or (WaitingData > 0) do
+    begin
+      RecvPacket(0);
+      if FLastError <> 0 then
+        break;
+    end;
+  except
+    on exception do;
+  end;
+  ResetLastError;
+end;
+
+procedure TBlockSocket.SetLinger(Enable: Boolean; Linger: Integer);
+var
+  d: TSynaOption;
+begin
+  d := TSynaOption.Create;
+  d.Option := SOT_Linger;
+  d.Enabled := Enable;
+  d.Value := Linger;
+  DelayedOption(d);
+end;
+
+function TBlockSocket.LocalName: string;
+begin
+  Result := synsock.GetHostName;
+  if Result = '' then
+    Result := '127.0.0.1';
+end;
+
+procedure TBlockSocket.ResolveNameToIP(Name: string; const IPList: TStrings);
+begin
+  IPList.Clear;
+  synsock.ResolveNameToIP(Name, FamilyToAF(FFamily), GetSocketprotocol, GetSocketType, IPList);
+  if IPList.Count = 0 then
+    IPList.Add(cAnyHost);
+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;
+begin
+  Result := synsock.ResolvePort(Port, FamilyToAF(FFamily), GetSocketProtocol, GetSocketType);
+end;
+
+function TBlockSocket.ResolveIPToName(IP: string): string;
+begin
+  if not IsIP(IP) or not IsIp6(IP) then
+    IP := ResolveName(IP);
+  Result := synsock.ResolveIPToName(IP, FamilyToAF(FFamily), GetSocketProtocol, GetSocketType);
+end;
+
+procedure TBlockSocket.SetRemoteSin(IP, Port: string);
+begin
+  SetSin(FRemoteSin, IP, Port);
+end;
+
+function TBlockSocket.GetLocalSinIP: string;
+begin
+  Result := GetSinIP(FLocalSin);
+end;
+
+function TBlockSocket.GetRemoteSinIP: string;
+begin
+  Result := GetSinIP(FRemoteSin);
+end;
+
+function TBlockSocket.GetLocalSinPort: Integer;
+begin
+  Result := GetSinPort(FLocalSin);
+end;
+
+function TBlockSocket.GetRemoteSinPort: Integer;
+begin
+  Result := GetSinPort(FRemoteSin);
+end;
+
+function TBlockSocket.InternalCanRead(Timeout: Integer): Boolean;
+{$IFDEF CIL}
+begin
+  Result := FSocket.Poll(Timeout * 1000, SelectMode.SelectRead);
+{$ELSE}
+var
+  TimeVal: PTimeVal;
+  TimeV: TTimeVal;
+  x: Integer;
+  FDSet: TFDSet;
+begin
+  TimeV.tv_usec := (Timeout mod 1000) * 1000;
+  TimeV.tv_sec := Timeout div 1000;
+  TimeVal := @TimeV;
+  if Timeout = -1 then
+    TimeVal := nil;
+  FDSet := FFdSet;
+  x := synsock.Select(FSocket + 1, @FDSet, nil, nil, TimeVal);
+  SockCheck(x);
+  if FLastError <> 0 then
+    x := 0;
+  Result := x > 0;
+{$ENDIF}
+end;
+
+function TBlockSocket.CanRead(Timeout: Integer): Boolean;
+var
+  ti, tr: Integer;
+  n: integer;
+begin
+  if (FHeartbeatRate <> 0) and (Timeout <> -1) then
+  begin
+    ti := Timeout div FHeartbeatRate;
+    tr := Timeout mod FHeartbeatRate;
+  end
+  else
+  begin
+    ti := 0;
+    tr := Timeout;
+  end;
+  Result := InternalCanRead(tr);
+  if not Result then
+    for n := 0 to ti do
+    begin
+      DoHeartbeat;
+      if FStopFlag then
+      begin
+        Result := False;
+        FStopFlag := False;
+        Break;
+      end;
+      Result := InternalCanRead(FHeartbeatRate);
+      if Result then
+        break;
+    end;
+  ExceptCheck;
+  if Result then
+    DoStatus(HR_CanRead, '');
+end;
+
+function TBlockSocket.CanWrite(Timeout: Integer): Boolean;
+{$IFDEF CIL}
+begin
+  Result := FSocket.Poll(Timeout * 1000, SelectMode.SelectWrite);
+{$ELSE}
+var
+  TimeVal: PTimeVal;
+  TimeV: TTimeVal;
+  x: Integer;
+  FDSet: TFDSet;
+begin
+  TimeV.tv_usec := (Timeout mod 1000) * 1000;
+  TimeV.tv_sec := Timeout div 1000;
+  TimeVal := @TimeV;
+  if Timeout = -1 then
+    TimeVal := nil;
+  FDSet := FFdSet;
+  x := synsock.Select(FSocket + 1, nil, @FDSet, nil, TimeVal);
+  SockCheck(x);
+  if FLastError <> 0 then
+    x := 0;
+  Result := x > 0;
+{$ENDIF}
+  ExceptCheck;
+  if Result then
+    DoStatus(HR_CanWrite, '');
+end;
+
+function TBlockSocket.CanReadEx(Timeout: Integer): Boolean;
+begin
+  if FBuffer <> '' then
+    Result := True
+  else
+    Result := CanRead(Timeout);
+end;
+
+function TBlockSocket.SendBufferTo(Buffer: TMemory; Length: Integer): Integer;
+begin
+  Result := 0;
+  if TestStopFlag then
+    Exit;
+  DoMonitor(True, Buffer, Length);
+  LimitBandwidth(Length, FMaxSendBandwidth, FNextsend);
+  Result := synsock.SendTo(FSocket, Buffer, Length, MSG_NOSIGNAL, FRemoteSin);
+  SockCheck(Result);
+  ExceptCheck;
+  Inc(FSendCounter, Result);
+  DoStatus(HR_WriteCount, IntToStr(Result));
+end;
+
+function TBlockSocket.RecvBufferFrom(Buffer: TMemory; Length: Integer): Integer;
+begin
+  Result := 0;
+  if TestStopFlag then
+    Exit;
+  LimitBandwidth(Length, FMaxRecvBandwidth, FNextRecv);
+  Result := synsock.RecvFrom(FSocket, Buffer, Length, MSG_NOSIGNAL, FRemoteSin);
+  SockCheck(Result);
+  ExceptCheck;
+  Inc(FRecvCounter, Result);
+  DoStatus(HR_ReadCount, IntToStr(Result));
+  DoMonitor(False, Buffer, Result);
+end;
+
+function TBlockSocket.GetSizeRecvBuffer: Integer;
+var
+  l: Integer;
+{$IFDEF CIL}
+  buf: TMemory;
+{$ENDIF}
+begin
+{$IFDEF CIL}
+  setlength(buf, 4);
+  SockCheck(synsock.GetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_RCVBUF), buf, l));
+  Result := System.BitConverter.ToInt32(buf,0);
+{$ELSE}
+  l := SizeOf(Result);
+  SockCheck(synsock.GetSockOpt(FSocket, SOL_SOCKET, SO_RCVBUF, @Result, l));
+  if FLastError <> 0 then
+    Result := 1024;
+  ExceptCheck;
+{$ENDIF}
+end;
+
+procedure TBlockSocket.SetSizeRecvBuffer(Size: Integer);
+var
+  d: TSynaOption;
+begin
+  d := TSynaOption.Create;
+  d.Option := SOT_RecvBuff;
+  d.Value := Size;
+  DelayedOption(d);
+end;
+
+function TBlockSocket.GetSizeSendBuffer: Integer;
+var
+  l: Integer;
+{$IFDEF CIL}
+  buf: TMemory;
+{$ENDIF}
+begin
+{$IFDEF CIL}
+  setlength(buf, 4);
+  SockCheck(synsock.GetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_SNDBUF), buf, l));
+  Result := System.BitConverter.ToInt32(buf,0);
+{$ELSE}
+  l := SizeOf(Result);
+  SockCheck(synsock.GetSockOpt(FSocket, SOL_SOCKET, SO_SNDBUF, @Result, l));
+  if FLastError <> 0 then
+    Result := 1024;
+  ExceptCheck;
+{$ENDIF}
+end;
+
+procedure TBlockSocket.SetSizeSendBuffer(Size: Integer);
+var
+  d: TSynaOption;
+begin
+  d := TSynaOption.Create;
+  d.Option := SOT_SendBuff;
+  d.Value := Size;
+  DelayedOption(d);
+end;
+
+procedure TBlockSocket.SetNonBlockMode(Value: Boolean);
+var
+  d: TSynaOption;
+begin
+  d := TSynaOption.Create;
+  d.Option := SOT_nonblock;
+  d.Enabled := Value;
+  DelayedOption(d);
+end;
+
+procedure TBlockSocket.SetTimeout(Timeout: Integer);
+begin
+  SetSendTimeout(Timeout);
+  SetRecvTimeout(Timeout);
+end;
+
+procedure TBlockSocket.SetSendTimeout(Timeout: Integer);
+var
+  d: TSynaOption;
+begin
+  d := TSynaOption.Create;
+  d.Option := SOT_sendtimeout;
+  d.Value := Timeout;
+  DelayedOption(d);
+end;
+
+procedure TBlockSocket.SetRecvTimeout(Timeout: Integer);
+var
+  d: TSynaOption;
+begin
+  d := TSynaOption.Create;
+  d.Option := SOT_recvtimeout;
+  d.Value := Timeout;
+  DelayedOption(d);
+end;
+
+{$IFNDEF CIL}
+function TBlockSocket.GroupCanRead(const SocketList: TList; Timeout: Integer;
+  const CanReadList: TList): boolean;
+var
+  FDSet: TFDSet;
+  TimeVal: PTimeVal;
+  TimeV: TTimeVal;
+  x, n: Integer;
+  Max: Integer;
+begin
+  TimeV.tv_usec := (Timeout mod 1000) * 1000;
+  TimeV.tv_sec := Timeout div 1000;
+  TimeVal := @TimeV;
+  if Timeout = -1 then
+    TimeVal := nil;
+  FD_ZERO(FDSet);
+  Max := 0;
+  for n := 0 to SocketList.Count - 1 do
+    if TObject(SocketList.Items[n]) is TBlockSocket then
+    begin
+      if TBlockSocket(SocketList.Items[n]).Socket > Max then
+        Max := TBlockSocket(SocketList.Items[n]).Socket;
+      FD_SET(TBlockSocket(SocketList.Items[n]).Socket, FDSet);
+    end;
+  x := synsock.Select(Max + 1, @FDSet, nil, nil, TimeVal);
+  SockCheck(x);
+  ExceptCheck;
+  if FLastError <> 0 then
+    x := 0;
+  Result := x > 0;
+  CanReadList.Clear;
+  if Result then
+    for n := 0 to SocketList.Count - 1 do
+      if TObject(SocketList.Items[n]) is TBlockSocket then
+        if FD_ISSET(TBlockSocket(SocketList.Items[n]).Socket, FDSet) then
+          CanReadList.Add(TBlockSocket(SocketList.Items[n]));
+end;
+{$ENDIF}
+
+procedure TBlockSocket.EnableReuse(Value: Boolean);
+var
+  d: TSynaOption;
+begin
+  d := TSynaOption.Create;
+  d.Option := SOT_reuse;
+  d.Enabled := Value;
+  DelayedOption(d);
+end;
+
+procedure TBlockSocket.SetTTL(TTL: integer);
+var
+  d: TSynaOption;
+begin
+  d := TSynaOption.Create;
+  d.Option := SOT_TTL;
+  d.Value := TTL;
+  DelayedOption(d);
+end;
+
+function TBlockSocket.GetTTL:integer;
+var
+  l: Integer;
+begin
+{$IFNDEF CIL}
+  l := SizeOf(Result);
+  if FIP6Used then
+    synsock.GetSockOpt(FSocket, IPPROTO_IPV6, IPV6_UNICAST_HOPS, @Result, l)
+  else
+    synsock.GetSockOpt(FSocket, IPPROTO_IP, IP_TTL, @Result, l);
+{$ENDIF}
+end;
+
+procedure TBlockSocket.SetFamily(Value: TSocketFamily);
+begin
+  FFamily := Value;
+  FFamilySave := Value;
+end;
+
+procedure TBlockSocket.SetSocket(Value: TSocket);
+begin
+  FRecvCounter := 0;
+  FSendCounter := 0;
+  FSocket := Value;
+{$IFNDEF CIL}
+  FD_ZERO(FFDSet);
+  FD_SET(FSocket, FFDSet);
+{$ENDIF}
+  GetSins;
+  FIP6Used := FRemoteSin.AddressFamily = AF_INET6;
+end;
+
+function TBlockSocket.GetWsaData: TWSAData;
+begin
+  Result := WsaDataOnce;
+end;
+
+function TBlockSocket.GetSocketType: integer;
+begin
+  Result := 0;
+end;
+
+function TBlockSocket.GetSocketProtocol: integer;
+begin
+  Result := integer(IPPROTO_IP);
+end;
+
+procedure TBlockSocket.DoStatus(Reason: THookSocketReason; const Value: string);
+begin
+  if assigned(OnStatus) then
+    OnStatus(Self, Reason, Value);
+end;
+
+procedure TBlockSocket.DoReadFilter(Buffer: TMemory; var Len: Integer);
+var
+  s: AnsiString;
+begin
+  if assigned(OnReadFilter) then
+    if Len > 0 then
+      begin
+        {$IFDEF CIL}
+        s := StringOf(Buffer);
+        {$ELSE}
+        SetLength(s, Len);
+        Move(Buffer^, Pointer(s)^, Len);
+        {$ENDIF}
+        OnReadFilter(Self, s);
+        if Length(s) > Len then
+          SetLength(s, Len);
+        Len := Length(s);
+        {$IFDEF CIL}
+        Buffer := BytesOf(s);
+        {$ELSE}
+        Move(Pointer(s)^, Buffer^, Len);
+        {$ENDIF}
+      end;
+end;
+
+procedure TBlockSocket.DoCreateSocket;
+begin
+  if assigned(OnCreateSocket) then
+    OnCreateSocket(Self);
+end;
+
+procedure TBlockSocket.DoMonitor(Writing: Boolean; const Buffer: TMemory; Len: Integer);
+begin
+  if assigned(OnMonitor) then
+  begin
+    OnMonitor(Self, Writing, Buffer, Len);
+  end;
+end;
+
+procedure TBlockSocket.DoHeartbeat;
+begin
+  if assigned(OnHeartbeat) and (FHeartbeatRate <> 0) then
+  begin
+    OnHeartbeat(Self);
+  end;
+end;
+
+function TBlockSocket.GetErrorDescEx: string;
+begin
+  Result := GetErrorDesc(FLastError);
+end;
+
+class function TBlockSocket.GetErrorDesc(ErrorCode: Integer): string;
+begin
+{$IFDEF CIL}
+  if ErrorCode = 0 then
+    Result := ''
+  else
+  begin
+    Result := WSAGetLastErrorDesc;
+    if Result = '' then
+      Result := 'Other Winsock error (' + IntToStr(ErrorCode) + ')';
+  end;
+{$ELSE}
+  case ErrorCode of
+    0:
+      Result := '';
+    WSAEINTR: {10004}
+      Result := 'Interrupted system call';
+    WSAEBADF: {10009}
+      Result := 'Bad file number';
+    WSAEACCES: {10013}
+      Result := 'Permission denied';
+    WSAEFAULT: {10014}
+      Result := 'Bad address';
+    WSAEINVAL: {10022}
+      Result := 'Invalid argument';
+    WSAEMFILE: {10024}
+      Result := 'Too many open files';
+    WSAEWOULDBLOCK: {10035}
+      Result := 'Operation would block';
+    WSAEINPROGRESS: {10036}
+      Result := 'Operation now in progress';
+    WSAEALREADY: {10037}
+      Result := 'Operation already in progress';
+    WSAENOTSOCK: {10038}
+      Result := 'Socket operation on nonsocket';
+    WSAEDESTADDRREQ: {10039}
+      Result := 'Destination address required';
+    WSAEMSGSIZE: {10040}
+      Result := 'Message too long';
+    WSAEPROTOTYPE: {10041}
+      Result := 'Protocol wrong type for Socket';
+    WSAENOPROTOOPT: {10042}
+      Result := 'Protocol not available';
+    WSAEPROTONOSUPPORT: {10043}
+      Result := 'Protocol not supported';
+    WSAESOCKTNOSUPPORT: {10044}
+      Result := 'Socket not supported';
+    WSAEOPNOTSUPP: {10045}
+      Result := 'Operation not supported on Socket';
+    WSAEPFNOSUPPORT: {10046}
+      Result := 'Protocol family not supported';
+    WSAEAFNOSUPPORT: {10047}
+      Result := 'Address family not supported';
+    WSAEADDRINUSE: {10048}
+      Result := 'Address already in use';
+    WSAEADDRNOTAVAIL: {10049}
+      Result := 'Can''t assign requested address';
+    WSAENETDOWN: {10050}
+      Result := 'Network is down';
+    WSAENETUNREACH: {10051}
+      Result := 'Network is unreachable';
+    WSAENETRESET: {10052}
+      Result := 'Network dropped connection on reset';
+    WSAECONNABORTED: {10053}
+      Result := 'Software caused connection abort';
+    WSAECONNRESET: {10054}
+      Result := 'Connection reset by peer';
+    WSAENOBUFS: {10055}
+      Result := 'No Buffer space available';
+    WSAEISCONN: {10056}
+      Result := 'Socket is already connected';
+    WSAENOTCONN: {10057}
+      Result := 'Socket is not connected';
+    WSAESHUTDOWN: {10058}
+      Result := 'Can''t send after Socket shutdown';
+    WSAETOOMANYREFS: {10059}
+      Result := 'Too many references:can''t splice';
+    WSAETIMEDOUT: {10060}
+      Result := 'Connection timed out';
+    WSAECONNREFUSED: {10061}
+      Result := 'Connection refused';
+    WSAELOOP: {10062}
+      Result := 'Too many levels of symbolic links';
+    WSAENAMETOOLONG: {10063}
+      Result := 'File name is too long';
+    WSAEHOSTDOWN: {10064}
+      Result := 'Host is down';
+    WSAEHOSTUNREACH: {10065}
+      Result := 'No route to host';
+    WSAENOTEMPTY: {10066}
+      Result := 'Directory is not empty';
+    WSAEPROCLIM: {10067}
+      Result := 'Too many processes';
+    WSAEUSERS: {10068}
+      Result := 'Too many users';
+    WSAEDQUOT: {10069}
+      Result := 'Disk quota exceeded';
+    WSAESTALE: {10070}
+      Result := 'Stale NFS file handle';
+    WSAEREMOTE: {10071}
+      Result := 'Too many levels of remote in path';
+    WSASYSNOTREADY: {10091}
+      Result := 'Network subsystem is unusable';
+    WSAVERNOTSUPPORTED: {10092}
+      Result := 'Winsock DLL cannot support this application';
+    WSANOTINITIALISED: {10093}
+      Result := 'Winsock not initialized';
+    WSAEDISCON: {10101}
+      Result := 'Disconnect';
+    WSAHOST_NOT_FOUND: {11001}
+      Result := 'Host not found';
+    WSATRY_AGAIN: {11002}
+      Result := 'Non authoritative - host not found';
+    WSANO_RECOVERY: {11003}
+      Result := 'Non recoverable error';
+    WSANO_DATA: {11004}
+      Result := 'Valid name, no data record of requested type'
+  else
+    Result := 'Other Winsock error (' + IntToStr(ErrorCode) + ')';
+  end;
+{$ENDIF}
+end;
+
+{======================================================================}
+
+constructor TSocksBlockSocket.Create;
+begin
+  inherited Create;
+  FSocksIP:= '';
+  FSocksPort:= '1080';
+  FSocksTimeout:= 60000;
+  FSocksUsername:= '';
+  FSocksPassword:= '';
+  FUsingSocks := False;
+  FSocksResolver := True;
+  FSocksLastError := 0;
+  FSocksResponseIP := '';
+  FSocksResponsePort := '';
+  FSocksLocalIP := '';
+  FSocksLocalPort := '';
+  FSocksRemoteIP := '';
+  FSocksRemotePort := '';
+  FBypassFlag := False;
+  FSocksType := ST_Socks5;
+end;
+
+function TSocksBlockSocket.SocksOpen: boolean;
+var
+  Buf: AnsiString;
+  n: integer;
+begin
+  Result := False;
+  FUsingSocks := False;
+  if FSocksType <> ST_Socks5 then
+  begin
+    FUsingSocks := True;
+    Result := True;
+  end
+  else
+  begin
+    FBypassFlag := True;
+    try
+      if FSocksUsername = '' then
+        Buf := #5 + #1 + #0
+      else
+        Buf := #5 + #2 + #2 +#0;
+      SendString(Buf);
+      Buf := RecvBufferStr(2, FSocksTimeout);
+      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 + AnsiChar(Length(FSocksUsername)) + FSocksUsername
+              + AnsiChar(Length(FSocksPassword)) + FSocksPassword;
+            SendString(Buf);
+            Buf := RecvBufferStr(2, FSocksTimeout);
+            if Length(Buf) < 2 then
+              Exit;
+            if Buf[2] <> #0 then
+              Exit;
+          end;
+      else
+        //other authorisation is not supported!
+        Exit;
+      end;
+      FUsingSocks := True;
+      Result := True;
+    finally
+      FBypassFlag := False;
+    end;
+  end;
+end;
+
+function TSocksBlockSocket.SocksRequest(Cmd: Byte;
+  const IP, Port: string): Boolean;
+var
+  Buf: AnsiString;
+begin
+  FBypassFlag := True;
+  try
+    if FSocksType <> ST_Socks5 then
+      Buf := #4 + AnsiChar(Cmd) + SocksCode(IP, Port)
+    else
+      Buf := #5 + AnsiChar(Cmd) + #0 + SocksCode(IP, Port);
+    SendString(Buf);
+    Result := FLastError = 0;
+  finally
+    FBypassFlag := False;
+  end;
+end;
+
+function TSocksBlockSocket.SocksResponse: Boolean;
+var
+  Buf, s: AnsiString;
+  x: integer;
+begin
+  Result := False;
+  FBypassFlag := True;
+  try
+    FSocksResponseIP := '';
+    FSocksResponsePort := '';
+    FSocksLastError := -1;
+    if FSocksType <> ST_Socks5 then
+    begin
+      Buf := RecvBufferStr(8, FSocksTimeout);
+      if FLastError <> 0 then
+        Exit;
+      if Buf[1] <> #0 then
+        Exit;
+      FSocksLastError := Ord(Buf[2]);
+    end
+    else
+    begin
+      Buf := RecvBufferStr(4, FSocksTimeout);
+      if FLastError <> 0 then
+        Exit;
+      if Buf[1] <> #5 then
+        Exit;
+      case Ord(Buf[4]) of
+        1:
+          s := RecvBufferStr(4, FSocksTimeout);
+        3:
+          begin
+            x := RecvByte(FSocksTimeout);
+            if FLastError <> 0 then
+              Exit;
+            s := AnsiChar(x) + RecvBufferStr(x, FSocksTimeout);
+          end;
+        4:
+          s := RecvBufferStr(16, FSocksTimeout);
+      else
+        Exit;
+      end;
+      Buf := Buf + s + RecvBufferStr(2, FSocksTimeout);
+      if FLastError <> 0 then
+        Exit;
+      FSocksLastError := Ord(Buf[2]);
+    end;
+    if ((FSocksLastError <> 0) and (FSocksLastError <> 90)) then
+      Exit;
+    SocksDecode(Buf);
+    Result := True;
+  finally
+    FBypassFlag := False;
+  end;
+end;
+
+function TSocksBlockSocket.SocksCode(IP, Port: string): Ansistring;
+var
+  ip6: TIp6Bytes;
+  n: integer;
+begin
+  if FSocksType <> ST_Socks5 then
+  begin
+    Result := CodeInt(ResolvePort(Port));
+    if not FSocksResolver then
+      IP := ResolveName(IP);
+    if IsIP(IP) then
+    begin
+      Result := Result + IPToID(IP);
+      Result := Result + FSocksUsername + #0;
+    end
+    else
+    begin
+      Result := Result + IPToID('0.0.0.1');
+      Result := Result + FSocksUsername + #0;
+      Result := Result + IP + #0;
+    end;
+  end
+  else
+  begin
+    if not FSocksResolver then
+      IP := ResolveName(IP);
+    if IsIP(IP) then
+      Result := #1 + IPToID(IP)
+    else
+      if IsIP6(IP) then
+      begin
+        ip6 := StrToIP6(IP);
+        Result := #4;
+        for n := 0 to 15 do
+          Result := Result + AnsiChar(ip6[n]);
+      end
+      else
+        Result := #3 + AnsiChar(Length(IP)) + IP;
+    Result := Result + CodeInt(ResolvePort(Port));
+  end;
+end;
+
+function TSocksBlockSocket.SocksDecode(Value: Ansistring): integer;
+var
+  Atyp: Byte;
+  y, n: integer;
+  w: Word;
+  ip6: TIp6Bytes;
+begin
+  FSocksResponsePort := '0';
+  Result := 0;
+  if FSocksType <> ST_Socks5 then
+  begin
+    if Length(Value) < 8 then
+      Exit;
+    Result := 3;
+    w := DecodeInt(Value, Result);
+    FSocksResponsePort := IntToStr(w);
+    FSocksResponseIP := Format('%d.%d.%d.%d',
+      [Ord(Value[5]), Ord(Value[6]), Ord(Value[7]), Ord(Value[8])]);
+    Result := 9;
+  end
+  else
+  begin
+    if Length(Value) < 4 then
+      Exit;
+    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 - 1 do
+            FSocksResponseIP := FSocksResponseIP + Value[n];
+          Result := 5 + y + 1;
+        end;
+      4:
+        begin
+          if Length(Value) < 22 then
+            Exit;
+          for n := 0 to 15 do
+            ip6[n] := ord(Value[n + 5]);
+          FSocksResponseIP := IP6ToStr(ip6);
+          Result := 21;
+        end;
+    else
+      Exit;
+    end;
+    w := DecodeInt(Value, Result);
+    FSocksResponsePort := IntToStr(w);
+    Result := Result + 2;
+  end;
+end;
+
+{======================================================================}
+
+procedure TDgramBlockSocket.Connect(IP, Port: string);
+begin
+  SetRemoteSin(IP, Port);
+  InternalCreateSocket(FRemoteSin);
+  FBuffer := '';
+  DoStatus(HR_Connect, IP + ':' + Port);
+end;
+
+function TDgramBlockSocket.RecvBuffer(Buffer: TMemory; Length: Integer): Integer;
+begin
+  Result := RecvBufferFrom(Buffer, Length);
+end;
+
+function TDgramBlockSocket.SendBuffer(Buffer: TMemory; Length: Integer): Integer;
+begin
+  Result := SendBufferTo(Buffer, Length);
+end;
+
+{======================================================================}
+
+destructor TUDPBlockSocket.Destroy;
+begin
+  if Assigned(FSocksControlSock) then
+    FSocksControlSock.Free;
+  inherited;
+end;
+
+procedure TUDPBlockSocket.EnableBroadcast(Value: Boolean);
+var
+  d: TSynaOption;
+begin
+  d := TSynaOption.Create;
+  d.Option := SOT_Broadcast;
+  d.Enabled := Value;
+  DelayedOption(d);
+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.CreateSocketByName(FSocksIP);
+    FSocksControlSock.Connect(FSocksIP, FSocksPort);
+    if FSocksControlSock.LastError <> 0 then
+      Exit;
+    // if not assigned local port, assign it!
+    if not FBinded then
+      Bind(cAnyHost, cAnyPort);
+    //open control TCP connection to SOCKS
+    FSocksControlSock.FSocksUsername := FSocksUsername;
+    FSocksControlSock.FSocksPassword := FSocksPassword;
+    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 := b and (FLastError = 0);
+  end;
+end;
+
+function TUDPBlockSocket.SendBufferTo(Buffer: TMemory; Length: Integer): Integer;
+var
+  SIp: string;
+  SPort: integer;
+  Buf: Ansistring;
+begin
+  Result := 0;
+  FUsingSocks := False;
+  if (FSocksIP <> '') and (not UdpAssociation) then
+    FLastError := WSANO_RECOVERY
+  else
+  begin
+    if FUsingSocks then
+    begin
+{$IFNDEF CIL}
+      Sip := GetRemoteSinIp;
+      SPort := GetRemoteSinPort;
+      SetRemoteSin(FSocksRemoteIP, FSocksRemotePort);
+      SetLength(Buf,Length);
+      Move(Buffer^, Pointer(Buf)^, Length);
+      Buf := #0 + #0 + #0 + SocksCode(Sip, IntToStr(SPort)) + Buf;
+      Result := inherited SendBufferTo(Pointer(Buf), System.Length(buf));
+      SetRemoteSin(Sip, IntToStr(SPort));
+{$ENDIF}
+    end
+    else
+      Result := inherited SendBufferTo(Buffer, Length);
+  end;
+end;
+
+function TUDPBlockSocket.RecvBufferFrom(Buffer: TMemory; Length: Integer): Integer;
+var
+  Buf: Ansistring;
+  x: integer;
+begin
+  Result := inherited RecvBufferFrom(Buffer, Length);
+  if FUsingSocks then
+  begin
+{$IFNDEF CIL}
+    SetLength(Buf, Result);
+    Move(Buffer^, Pointer(Buf)^, Result);
+    x := SocksDecode(Buf);
+    Result := Result - x + 1;
+    Buf := Copy(Buf, x, Result);
+    Move(Pointer(Buf)^, Buffer^, Result);
+    SetRemoteSin(FSocksResponseIP, FSocksResponsePort);
+{$ENDIF}
+  end;
+end;
+
+{$IFNDEF CIL}
+procedure TUDPBlockSocket.AddMulticast(MCastIP: string);
+var
+  Multicast: TIP_mreq;
+  Multicast6: TIPv6_mreq;
+  n: integer;
+  ip6: Tip6bytes;
+begin
+  if FIP6Used then
+  begin
+    ip6 := StrToIp6(MCastIP);
+    for n := 0 to 15 do
+      Multicast6.ipv6mr_multiaddr.u6_addr8[n] := Ip6[n];
+    Multicast6.ipv6mr_interface := 0;
+    SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IPV6, IPV6_JOIN_GROUP,
+      PAnsiChar(@Multicast6), SizeOf(Multicast6)));
+  end
+  else
+  begin
+    Multicast.imr_multiaddr.S_addr := swapbytes(strtoip(MCastIP));
+    Multicast.imr_interface.S_addr := INADDR_ANY;
+    SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IP, IP_ADD_MEMBERSHIP,
+      PAnsiChar(@Multicast), SizeOf(Multicast)));
+  end;
+  ExceptCheck;
+end;
+
+procedure TUDPBlockSocket.DropMulticast(MCastIP: string);
+var
+  Multicast: TIP_mreq;
+  Multicast6: TIPv6_mreq;
+  n: integer;
+  ip6: Tip6bytes;
+begin
+  if FIP6Used then
+  begin
+    ip6 := StrToIp6(MCastIP);
+    for n := 0 to 15 do
+      Multicast6.ipv6mr_multiaddr.u6_addr8[n] := Ip6[n];
+    Multicast6.ipv6mr_interface := 0;
+    SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IPV6, IPV6_LEAVE_GROUP,
+      PAnsiChar(@Multicast6), SizeOf(Multicast6)));
+  end
+  else
+  begin
+    Multicast.imr_multiaddr.S_addr := swapbytes(strtoip(MCastIP));
+    Multicast.imr_interface.S_addr := INADDR_ANY;
+    SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IP, IP_DROP_MEMBERSHIP,
+      PAnsiChar(@Multicast), SizeOf(Multicast)));
+  end;
+  ExceptCheck;
+end;
+{$ENDIF}
+
+procedure TUDPBlockSocket.SetMulticastTTL(TTL: integer);
+var
+  d: TSynaOption;
+begin
+  d := TSynaOption.Create;
+  d.Option := SOT_MulticastTTL;
+  d.Value := TTL;
+  DelayedOption(d);
+end;
+
+function TUDPBlockSocket.GetMulticastTTL:integer;
+var
+  l: Integer;
+begin
+{$IFNDEF CIL}
+  l := SizeOf(Result);
+  if FIP6Used then
+    synsock.GetSockOpt(FSocket, IPPROTO_IPV6, IPV6_MULTICAST_HOPS, @Result, l)
+  else
+    synsock.GetSockOpt(FSocket, IPPROTO_IP, IP_MULTICAST_TTL, @Result, l);
+{$ENDIF}
+end;
+
+procedure TUDPBlockSocket.EnableMulticastLoop(Value: Boolean);
+var
+  d: TSynaOption;
+begin
+  d := TSynaOption.Create;
+  d.Option := SOT_MulticastLoop;
+  d.Enabled := Value;
+  DelayedOption(d);
+end;
+
+function TUDPBlockSocket.GetSocketType: integer;
+begin
+  Result := integer(SOCK_DGRAM);
+end;
+
+function TUDPBlockSocket.GetSocketProtocol: integer;
+begin
+ Result := integer(IPPROTO_UDP);
+end;
+
+{======================================================================}
+constructor TTCPBlockSocket.CreateWithSSL(SSLPlugin: TSSLClass);
+begin
+  inherited Create;
+  FSSL := SSLPlugin.Create(self);
+  FHTTPTunnelIP := '';
+  FHTTPTunnelPort := '';
+  FHTTPTunnel := False;
+  FHTTPTunnelRemoteIP := '';
+  FHTTPTunnelRemotePort := '';
+  FHTTPTunnelUser := '';
+  FHTTPTunnelPass := '';
+  FHTTPTunnelTimeout := 30000;
+end;
+
+constructor TTCPBlockSocket.Create;
+begin
+  CreateWithSSL(SSLImplementation);
+end;
+
+destructor TTCPBlockSocket.Destroy;
+begin
+  inherited Destroy;
+  FSSL.Free;
+end;
+
+function TTCPBlockSocket.GetErrorDescEx: string;
+begin
+  Result := inherited GetErrorDescEx;
+  if (FLastError = WSASYSNOTREADY) and (self.SSL.LastError <> 0) then
+  begin
+    Result := self.SSL.LastErrorDesc;
+  end;
+end;
+
+procedure TTCPBlockSocket.CloseSocket;
+begin
+  if FSSL.SSLEnabled then
+    FSSL.Shutdown;
+  if (FSocket <> INVALID_SOCKET) and (FLastError = 0) then
+  begin
+    Synsock.Shutdown(FSocket, 1);
+    Purge;
+  end;
+  inherited CloseSocket;
+end;
+
+procedure TTCPBlockSocket.DoAfterConnect;
+begin
+  if assigned(OnAfterConnect) then
+  begin
+    OnAfterConnect(Self);
+  end;
+end;
+
+function TTCPBlockSocket.WaitingData: Integer;
+begin
+  Result := 0;
+  if FSSL.SSLEnabled and (FSocket <> INVALID_SOCKET) then
+    Result := FSSL.WaitingData;
+  if Result = 0 then
+    Result := inherited WaitingData;
+end;
+
+procedure TTCPBlockSocket.Listen;
+var
+  b: Boolean;
+  Sip,SPort: string;
+begin
+  if FSocksIP = '' then
+  begin
+    inherited Listen;
+  end
+  else
+  begin
+    Sip := GetLocalSinIP;
+    if Sip = cAnyHost then
+      Sip := LocalName;
+    SPort := IntToStr(GetLocalSinPort);
+    inherited 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 = cAnyHost then
+      FSocksLocalIP := FSocksIP;
+    FSocksLocalPort := FSocksResponsePort;
+    FSocksRemoteIP := '';
+    FSocksRemotePort := '';
+    ExceptCheck;
+    DoStatus(HR_Listen, '');
+  end;
+end;
+
+function TTCPBlockSocket.Accept: TSocket;
+begin
+  if FUsingSocks then
+  begin
+    if not SocksResponse and (FLastError = 0) then
+      FLastError := WSANO_RECOVERY;
+    FSocksRemoteIP := FSocksResponseIP;
+    FSocksRemotePort := FSocksResponsePort;
+    Result := FSocket;
+    ExceptCheck;
+    DoStatus(HR_Accept, '');
+  end
+  else
+  begin
+    result := inherited Accept;
+  end;
+end;
+
+procedure TTCPBlockSocket.Connect(IP, Port: string);
+begin
+  if FSocksIP <> '' then
+    SocksDoConnect(IP, Port)
+  else
+    if FHTTPTunnelIP <> '' then
+      HTTPTunnelDoConnect(IP, Port)
+    else
+      inherited Connect(IP, Port);
+  if FLasterror = 0 then
+    DoAfterConnect;
+end;
+
+procedure TTCPBlockSocket.SocksDoConnect(IP, Port: string);
+var
+  b: Boolean;
+begin
+  inherited Connect(FSocksIP, FSocksPort);
+  if FLastError = 0 then
+  begin
+    b := SocksOpen;
+    if b then
+      b := SocksRequest(1, IP, Port);
+    if b then
+      b := SocksResponse;
+    if not b and (FLastError = 0) then
+      FLastError := WSASYSNOTREADY;
+    FSocksLocalIP := FSocksResponseIP;
+    FSocksLocalPort := FSocksResponsePort;
+    FSocksRemoteIP := IP;
+    FSocksRemotePort := Port;
+  end;
+  ExceptCheck;
+  DoStatus(HR_Connect, IP + ':' + Port);
+end;
+
+procedure TTCPBlockSocket.HTTPTunnelDoConnect(IP, Port: string);
+//bugfixed by Mike Green (mgreen@emixode.com)
+var
+  s: string;
+begin
+  Port := IntToStr(ResolvePort(Port));
+  inherited Connect(FHTTPTunnelIP, FHTTPTunnelPort);
+  if FLastError <> 0 then
+    Exit;
+  FHTTPTunnel := False;
+  if IsIP6(IP) then
+    IP := '[' + IP + ']';
+  SendString('CONNECT ' + IP + ':' + Port + ' HTTP/1.0' + CRLF);
+  if FHTTPTunnelUser <> '' then
+  Sendstring('Proxy-Authorization: Basic ' +
+    EncodeBase64(FHTTPTunnelUser + ':' + FHTTPTunnelPass) + CRLF);
+  SendString(CRLF);
+  repeat
+    s := RecvTerminated(FHTTPTunnelTimeout, #$0a);
+    if FLastError <> 0 then
+      Break;
+    if (Pos('HTTP/', s) = 1) and (Length(s) > 11) then
+      FHTTPTunnel := s[10] = '2';
+  until (s = '') or (s = #$0d);
+  if (FLasterror = 0) and not FHTTPTunnel then
+    FLastError := WSASYSNOTREADY;
+  FHTTPTunnelRemoteIP := IP;
+  FHTTPTunnelRemotePort := Port;
+  ExceptCheck;
+end;
+
+procedure TTCPBlockSocket.SSLDoConnect;
+begin
+  ResetLastError;
+  if not FSSL.Connect then
+    FLastError := WSASYSNOTREADY;
+  ExceptCheck;
+end;
+
+procedure TTCPBlockSocket.SSLDoShutdown;
+begin
+  ResetLastError;
+  FSSL.BiShutdown;
+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
+    if FHTTPTunnel then
+      Result := FHTTPTunnelRemoteIP
+    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 := ResolvePort(FSocksRemotePort)
+  else
+    if FHTTPTunnel then
+      Result := StrToIntDef(FHTTPTunnelRemotePort, 0)
+    else
+      Result := inherited GetRemoteSinPort;
+end;
+
+function TTCPBlockSocket.RecvBuffer(Buffer: TMemory; Len: Integer): Integer;
+begin
+  if FSSL.SSLEnabled then
+  begin
+    Result := 0;
+    if TestStopFlag then
+      Exit;
+    ResetLastError;
+    LimitBandwidth(Len, FMaxRecvBandwidth, FNextRecv);
+    Result := FSSL.RecvBuffer(Buffer, Len);
+    if FSSL.LastError <> 0 then
+      FLastError := WSASYSNOTREADY;
+    ExceptCheck;
+    Inc(FRecvCounter, Result);
+    DoStatus(HR_ReadCount, IntToStr(Result));
+    DoMonitor(False, Buffer, Result);
+    DoReadFilter(Buffer, Result);
+  end
+  else
+    Result := inherited RecvBuffer(Buffer, Len);
+end;
+
+function TTCPBlockSocket.SendBuffer(Buffer: TMemory; Length: Integer): Integer;
+var
+  x, y: integer;
+  l, r: integer;
+{$IFNDEF CIL}
+  p: Pointer;
+{$ENDIF}
+begin
+  if FSSL.SSLEnabled then
+  begin
+    Result := 0;
+    if TestStopFlag then
+      Exit;
+    ResetLastError;
+    DoMonitor(True, Buffer, Length);
+{$IFDEF CIL}
+    Result := FSSL.SendBuffer(Buffer, Length);
+    if FSSL.LastError <> 0 then
+      FLastError := WSASYSNOTREADY;
+    Inc(FSendCounter, Result);
+    DoStatus(HR_WriteCount, IntToStr(Result));
+{$ELSE}
+    l := Length;
+    x := 0;
+    while x < l do
+    begin
+      y := l - x;
+      if y > FSendMaxChunk then
+        y := FSendMaxChunk;
+      if y > 0 then
+      begin
+        LimitBandwidth(y, FMaxSendBandwidth, FNextsend);
+        p := IncPoint(Buffer, x);
+        r := FSSL.SendBuffer(p, y);
+        if FSSL.LastError <> 0 then
+          FLastError := WSASYSNOTREADY;
+        if Flasterror <> 0 then
+          Break;
+        Inc(x, r);
+        Inc(Result, r);
+        Inc(FSendCounter, r);
+        DoStatus(HR_WriteCount, IntToStr(r));
+      end
+      else
+        break;
+    end;
+{$ENDIF}
+    ExceptCheck;
+  end
+  else
+    Result := inherited SendBuffer(Buffer, Length);
+end;
+
+function TTCPBlockSocket.SSLAcceptConnection: Boolean;
+begin
+  ResetLastError;
+  if not FSSL.Accept then
+    FLastError := WSASYSNOTREADY;
+  ExceptCheck;
+  Result := FLastError = 0;
+end;
+
+function TTCPBlockSocket.GetSocketType: integer;
+begin
+  Result := integer(SOCK_STREAM);
+end;
+
+function TTCPBlockSocket.GetSocketProtocol: integer;
+begin
+  Result := integer(IPPROTO_TCP);
+end;
+
+{======================================================================}
+
+function TICMPBlockSocket.GetSocketType: integer;
+begin
+  Result := integer(SOCK_RAW);
+end;
+
+function TICMPBlockSocket.GetSocketProtocol: integer;
+begin
+  if FIP6Used then
+    Result := integer(IPPROTO_ICMPV6)
+  else
+    Result := integer(IPPROTO_ICMP);
+end;
+
+{======================================================================}
+
+function TRAWBlockSocket.GetSocketType: integer;
+begin
+  Result := integer(SOCK_RAW);
+end;
+
+function TRAWBlockSocket.GetSocketProtocol: integer;
+begin
+  Result := integer(IPPROTO_RAW);
+end;
+
+{======================================================================}
+
+function TPGMmessageBlockSocket.GetSocketType: integer;
+begin
+  Result := integer(SOCK_RDM);
+end;
+
+function TPGMmessageBlockSocket.GetSocketProtocol: integer;
+begin
+  Result := integer(IPPROTO_RM);
+end;
+
+{======================================================================}
+
+function TPGMstreamBlockSocket.GetSocketType: integer;
+begin
+  Result := integer(SOCK_STREAM);
+end;
+
+function TPGMstreamBlockSocket.GetSocketProtocol: integer;
+begin
+  Result := integer(IPPROTO_RM);
+end;
+
+{======================================================================}
+
+constructor TSynaClient.Create;
+begin
+  inherited Create;
+  FIPInterface := cAnyHost;
+  FTargetHost := cLocalhost;
+  FTargetPort := cAnyPort;
+  FTimeout := 5000;
+  FUsername := '';
+  FPassword := '';
+end;
+
+{======================================================================}
+
+constructor TCustomSSL.Create(const Value: TTCPBlockSocket);
+begin
+  inherited Create;
+  FSocket := Value;
+  FSSLEnabled := False;
+  FUsername := '';
+  FPassword := '';
+  FLastError := 0;
+  FLastErrorDesc := '';
+  FVerifyCert := False;
+  FSSLType := LT_all;
+  FKeyPassword := '';
+  FCiphers := '';
+  FCertificateFile := '';
+  FPrivateKeyFile := '';
+  FCertCAFile := '';
+  FCertCA := '';
+  FTrustCertificate := '';
+  FTrustCertificateFile := '';
+  FCertificate := '';
+  FPrivateKey := '';
+  FPFX := '';
+  FPFXfile := '';
+  FSSHChannelType := '';
+  FSSHChannelArg1 := '';
+  FSSHChannelArg2 := '';
+end;
+
+procedure TCustomSSL.Assign(const Value: TCustomSSL);
+begin
+  FUsername := Value.Username;
+  FPassword := Value.Password;
+  FVerifyCert := Value.VerifyCert;
+  FSSLType := Value.SSLType;
+  FKeyPassword := Value.KeyPassword;
+  FCiphers := Value.Ciphers;
+  FCertificateFile := Value.CertificateFile;
+  FPrivateKeyFile := Value.PrivateKeyFile;
+  FCertCAFile := Value.CertCAFile;
+  FCertCA := Value.CertCA;
+  FTrustCertificate := Value.TrustCertificate;
+  FTrustCertificateFile := Value.TrustCertificateFile;
+  FCertificate := Value.Certificate;
+  FPrivateKey := Value.PrivateKey;
+  FPFX := Value.PFX;
+  FPFXfile := Value.PFXfile;
+end;
+
+procedure TCustomSSL.ReturnError;
+begin
+  FLastError := -1;
+  FLastErrorDesc := 'SSL/TLS support is not compiled!';
+end;
+
+function TCustomSSL.LibVersion: String;
+begin
+  Result := '';
+end;
+
+function TCustomSSL.LibName: String;
+begin
+  Result := '';
+end;
+
+function TCustomSSL.CreateSelfSignedCert(Host: string): Boolean;
+begin
+  Result := False;
+end;
+
+function TCustomSSL.Connect: boolean;
+begin
+  ReturnError;
+  Result := False;
+end;
+
+function TCustomSSL.Accept: boolean;
+begin
+  ReturnError;
+  Result := False;
+end;
+
+function TCustomSSL.Shutdown: boolean;
+begin
+  ReturnError;
+  Result := False;
+end;
+
+function TCustomSSL.BiShutdown: boolean;
+begin
+  ReturnError;
+  Result := False;
+end;
+
+function TCustomSSL.SendBuffer(Buffer: TMemory; Len: Integer): Integer;
+begin
+  ReturnError;
+  Result := integer(SOCKET_ERROR);
+end;
+
+function TCustomSSL.RecvBuffer(Buffer: TMemory; Len: Integer): Integer;
+begin
+  ReturnError;
+  Result := integer(SOCKET_ERROR);
+end;
+
+function TCustomSSL.WaitingData: Integer;
+begin
+  ReturnError;
+  Result := 0;
+end;
+
+function TCustomSSL.GetSSLVersion: string;
+begin
+  Result := '';
+end;
+
+function TCustomSSL.GetPeerSubject: string;
+begin
+  Result := '';
+end;
+
+function TCustomSSL.GetPeerName: string;
+begin
+  Result := '';
+end;
+
+function TCustomSSL.GetPeerIssuer: string;
+begin
+  Result := '';
+end;
+
+function TCustomSSL.GetPeerFingerprint: string;
+begin
+  Result := '';
+end;
+
+function TCustomSSL.GetCertInfo: string;
+begin
+  Result := '';
+end;
+
+function TCustomSSL.GetCipherName: string;
+begin
+  Result := '';
+end;
+
+function TCustomSSL.GetCipherBits: integer;
+begin
+  Result := 0;
+end;
+
+function TCustomSSL.GetCipherAlgBits: integer;
+begin
+  Result := 0;
+end;
+
+function TCustomSSL.GetVerifyCert: integer;
+begin
+  Result := 1;
+end;
+
+{======================================================================}
+
+function TSSLNone.LibVersion: String;
+begin
+  Result := 'Without SSL support';
+end;
+
+function TSSLNone.LibName: String;
+begin
+  Result := 'ssl_none';
+end;
+
+{======================================================================}
+
+{$IFDEF ONCEWINSOCK}
+initialization
+begin
+  if not InitSocketInterface(DLLStackName) then
+  begin
+    e := ESynapseError.Create('Error loading Socket interface (' + DLLStackName + ')!');
+    e.ErrorCode := 0;
+    e.ErrorMessage := 'Error loading Socket interface (' + DLLStackName + ')!';
+    raise e;
+  end;
+  synsock.WSAStartup(WinsockLevel, WsaDataOnce);
+end;
+{$ENDIF}
+
+finalization
+begin
+{$IFDEF ONCEWINSOCK}
+  synsock.WSACleanup;
+  DestroySocketInterface;
+{$ENDIF}
+end;
+
+end.
diff --git a/Units/Synapse/clamsend.pas b/Units/Synapse/clamsend.pas
index 8d3c2d6..08a8864 100644
--- a/Units/Synapse/clamsend.pas
+++ b/Units/Synapse/clamsend.pas
@@ -1,277 +1,277 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 001.001.001 |
-|==============================================================================|
-| Content: ClamAV-daemon client                                                |
-|==============================================================================|
-| Copyright (c)2005-2010, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2005-2010.                |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{:@abstract( ClamAV-daemon client)
-
-This unit is capable to do antivirus scan of your data by TCP channel to ClamD
-daemon from ClamAV. See more about ClamAV on @LINK(http://www.clamav.net)
-}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$Q-}
-{$H+}
-
-{$IFDEF UNICODE}
-  {$WARN IMPLICIT_STRING_CAST OFF}
-  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
-{$ENDIF}
-
-unit clamsend;
-
-interface
-
-uses
-  SysUtils, Classes,
-  synsock, blcksock, synautil;
-
-const
-  cClamProtocol = '3310';
-
-type
-
-  {:@abstract(Implementation of ClamAV-daemon client protocol)
-   By this class you can scan any your data by ClamAV opensource antivirus.
-
-   This class can connect to ClamD by TCP channel, send your data to ClamD
-   and read result.}
-  TClamSend = class(TSynaClient)
-  private
-    FSock: TTCPBlockSocket;
-    FDSock: TTCPBlockSocket;
-    FSession: boolean;
-    function Login: boolean; virtual;
-    function Logout: Boolean; virtual;
-    function OpenStream: Boolean; virtual;
-  public
-    constructor Create;
-    destructor Destroy; override;
-
-    {:Call any command to ClamD. Used internally by other methods.}
-    function DoCommand(const Value: AnsiString): AnsiString; virtual;
-
-    {:Return ClamAV version and version of loaded databases.}
-    function GetVersion: AnsiString; virtual;
-
-    {:Scan content of TStrings.}
-    function ScanStrings(const Value: TStrings): AnsiString; virtual;
-
-    {:Scan content of TStream.}
-    function ScanStream(const Value: TStream): AnsiString; virtual;
-
-    {:Scan content of TStrings by new 0.95 API.}
-    function ScanStrings2(const Value: TStrings): AnsiString; virtual;
-
-    {:Scan content of TStream by new 0.95 API.}
-    function ScanStream2(const Value: TStream): AnsiString; virtual;
-  published
-    {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
-    property Sock: TTCPBlockSocket read FSock;
-
-    {:Socket object used for TCP data transfer operation. Good for seting OnStatus hook, etc.}
-    property DSock: TTCPBlockSocket read FDSock;
-
-    {:Can turn-on session mode of communication with ClamD. Default is @false,
-     because ClamAV developers design their TCP code very badly and session mode
-     is broken now (CVS-20051031). Maybe ClamAV developers fix their bugs
-     and this mode will be possible in future.}
-    property Session: boolean read FSession write FSession;
-  end;
-
-implementation
-
-constructor TClamSend.Create;
-begin
-  inherited Create;
-  FSock := TTCPBlockSocket.Create;
-  FSock.Owner := self;
-  FDSock := TTCPBlockSocket.Create;
-  FDSock.Owner := self;
-  FTimeout := 60000;
-  FTargetPort := cClamProtocol;
-  FSession := false;
-end;
-
-destructor TClamSend.Destroy;
-begin
-  Logout;
-  FDSock.Free;
-  FSock.Free;
-  inherited Destroy;
-end;
-
-function TClamSend.DoCommand(const Value: AnsiString): AnsiString;
-begin
-  Result := '';
-  if not FSession then
-    FSock.CloseSocket
-  else
-    FSock.SendString(Value + LF);
-  if not FSession or (FSock.LastError <> 0) then
-  begin
-    if Login then
-      FSock.SendString(Value + LF)
-    else
-      Exit;
-  end;
-  Result := FSock.RecvTerminated(FTimeout, LF);
-end;
-
-function TClamSend.Login: boolean;
-begin
-  Result := False;
-  Sock.CloseSocket;
-  FSock.Bind(FIPInterface, cAnyPort);
-  if FSock.LastError <> 0 then
-    Exit;
-  FSock.Connect(FTargetHost, FTargetPort);
-  if FSock.LastError <> 0 then
-    Exit;
-  if FSession then
-    FSock.SendString('SESSION' + LF);
-  Result := FSock.LastError = 0;
-end;
-
-function TClamSend.Logout: Boolean;
-begin
-  FSock.SendString('END' + LF);
-  Result := FSock.LastError = 0;
-  FSock.CloseSocket;
-end;
-
-function TClamSend.GetVersion: AnsiString;
-begin
-  Result := DoCommand('nVERSION');
-end;
-
-function TClamSend.OpenStream: Boolean;
-var
-  S: AnsiString;
-begin
-  Result := False;
-  s := DoCommand('nSTREAM');
-  if (s <> '') and (Copy(s, 1, 4) = 'PORT') then
-  begin
-    s := SeparateRight(s, ' ');
-    FDSock.CloseSocket;
-    FDSock.Bind(FIPInterface, cAnyPort);
-    if FDSock.LastError <> 0 then
-      Exit;
-    FDSock.Connect(FTargetHost, s);
-    if FDSock.LastError <> 0 then
-      Exit;
-    Result := True;
-  end;
-end;
-
-function TClamSend.ScanStrings(const Value: TStrings): AnsiString;
-begin
-  Result := '';
-  if OpenStream then
-  begin
-    DSock.SendString(Value.Text);
-    DSock.CloseSocket;
-    Result := FSock.RecvTerminated(FTimeout, LF);
-  end;
-end;
-
-function TClamSend.ScanStream(const Value: TStream): AnsiString;
-begin
-  Result := '';
-  if OpenStream then
-  begin
-    DSock.SendStreamRaw(Value);
-    DSock.CloseSocket;
-    Result := FSock.RecvTerminated(FTimeout, LF);
-  end;
-end;
-
-function TClamSend.ScanStrings2(const Value: TStrings): AnsiString;
-var
-  i: integer;
-  s: AnsiString;
-begin
-  Result := '';
-  if not FSession then
-    FSock.CloseSocket
-  else
-    FSock.sendstring('nINSTREAM' + LF);
-  if not FSession or (FSock.LastError <> 0) then
-  begin
-    if Login then
-      FSock.sendstring('nINSTREAM' + LF)
-    else
-      Exit;
-  end;
-  s := Value.text;
-  i := length(s);
-  FSock.SendString(CodeLongint(i) + s + #0#0#0#0);
-  Result := FSock.RecvTerminated(FTimeout, LF);
-end;
-
-function TClamSend.ScanStream2(const Value: TStream): AnsiString;
-var
-  i: integer;
-begin
-  Result := '';
-  if not FSession then
-    FSock.CloseSocket
-  else
-    FSock.sendstring('nINSTREAM' + LF);
-  if not FSession or (FSock.LastError <> 0) then
-  begin
-    if Login then
-      FSock.sendstring('nINSTREAM' + LF)
-    else
-      Exit;
-  end;
-  i := value.Size;
-  FSock.SendString(CodeLongint(i));
-  FSock.SendStreamRaw(Value);
-  FSock.SendString(#0#0#0#0);
-  Result := FSock.RecvTerminated(FTimeout, LF);
-end;
-
-end.
+{==============================================================================|
+| Project : Ararat Synapse                                       | 001.001.001 |
+|==============================================================================|
+| Content: ClamAV-daemon client                                                |
+|==============================================================================|
+| Copyright (c)2005-2010, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2005-2010.                |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@abstract( ClamAV-daemon client)
+
+This unit is capable to do antivirus scan of your data by TCP channel to ClamD
+daemon from ClamAV. See more about ClamAV on @LINK(http://www.clamav.net)
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$Q-}
+{$H+}
+
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit clamsend;
+
+interface
+
+uses
+  SysUtils, Classes,
+  synsock, blcksock, synautil;
+
+const
+  cClamProtocol = '3310';
+
+type
+
+  {:@abstract(Implementation of ClamAV-daemon client protocol)
+   By this class you can scan any your data by ClamAV opensource antivirus.
+
+   This class can connect to ClamD by TCP channel, send your data to ClamD
+   and read result.}
+  TClamSend = class(TSynaClient)
+  private
+    FSock: TTCPBlockSocket;
+    FDSock: TTCPBlockSocket;
+    FSession: boolean;
+    function Login: boolean; virtual;
+    function Logout: Boolean; virtual;
+    function OpenStream: Boolean; virtual;
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    {:Call any command to ClamD. Used internally by other methods.}
+    function DoCommand(const Value: AnsiString): AnsiString; virtual;
+
+    {:Return ClamAV version and version of loaded databases.}
+    function GetVersion: AnsiString; virtual;
+
+    {:Scan content of TStrings.}
+    function ScanStrings(const Value: TStrings): AnsiString; virtual;
+
+    {:Scan content of TStream.}
+    function ScanStream(const Value: TStream): AnsiString; virtual;
+
+    {:Scan content of TStrings by new 0.95 API.}
+    function ScanStrings2(const Value: TStrings): AnsiString; virtual;
+
+    {:Scan content of TStream by new 0.95 API.}
+    function ScanStream2(const Value: TStream): AnsiString; virtual;
+  published
+    {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
+    property Sock: TTCPBlockSocket read FSock;
+
+    {:Socket object used for TCP data transfer operation. Good for seting OnStatus hook, etc.}
+    property DSock: TTCPBlockSocket read FDSock;
+
+    {:Can turn-on session mode of communication with ClamD. Default is @false,
+     because ClamAV developers design their TCP code very badly and session mode
+     is broken now (CVS-20051031). Maybe ClamAV developers fix their bugs
+     and this mode will be possible in future.}
+    property Session: boolean read FSession write FSession;
+  end;
+
+implementation
+
+constructor TClamSend.Create;
+begin
+  inherited Create;
+  FSock := TTCPBlockSocket.Create;
+  FSock.Owner := self;
+  FDSock := TTCPBlockSocket.Create;
+  FDSock.Owner := self;
+  FTimeout := 60000;
+  FTargetPort := cClamProtocol;
+  FSession := false;
+end;
+
+destructor TClamSend.Destroy;
+begin
+  Logout;
+  FDSock.Free;
+  FSock.Free;
+  inherited Destroy;
+end;
+
+function TClamSend.DoCommand(const Value: AnsiString): AnsiString;
+begin
+  Result := '';
+  if not FSession then
+    FSock.CloseSocket
+  else
+    FSock.SendString(Value + LF);
+  if not FSession or (FSock.LastError <> 0) then
+  begin
+    if Login then
+      FSock.SendString(Value + LF)
+    else
+      Exit;
+  end;
+  Result := FSock.RecvTerminated(FTimeout, LF);
+end;
+
+function TClamSend.Login: boolean;
+begin
+  Result := False;
+  Sock.CloseSocket;
+  FSock.Bind(FIPInterface, cAnyPort);
+  if FSock.LastError <> 0 then
+    Exit;
+  FSock.Connect(FTargetHost, FTargetPort);
+  if FSock.LastError <> 0 then
+    Exit;
+  if FSession then
+    FSock.SendString('SESSION' + LF);
+  Result := FSock.LastError = 0;
+end;
+
+function TClamSend.Logout: Boolean;
+begin
+  FSock.SendString('END' + LF);
+  Result := FSock.LastError = 0;
+  FSock.CloseSocket;
+end;
+
+function TClamSend.GetVersion: AnsiString;
+begin
+  Result := DoCommand('nVERSION');
+end;
+
+function TClamSend.OpenStream: Boolean;
+var
+  S: AnsiString;
+begin
+  Result := False;
+  s := DoCommand('nSTREAM');
+  if (s <> '') and (Copy(s, 1, 4) = 'PORT') then
+  begin
+    s := SeparateRight(s, ' ');
+    FDSock.CloseSocket;
+    FDSock.Bind(FIPInterface, cAnyPort);
+    if FDSock.LastError <> 0 then
+      Exit;
+    FDSock.Connect(FTargetHost, s);
+    if FDSock.LastError <> 0 then
+      Exit;
+    Result := True;
+  end;
+end;
+
+function TClamSend.ScanStrings(const Value: TStrings): AnsiString;
+begin
+  Result := '';
+  if OpenStream then
+  begin
+    DSock.SendString(Value.Text);
+    DSock.CloseSocket;
+    Result := FSock.RecvTerminated(FTimeout, LF);
+  end;
+end;
+
+function TClamSend.ScanStream(const Value: TStream): AnsiString;
+begin
+  Result := '';
+  if OpenStream then
+  begin
+    DSock.SendStreamRaw(Value);
+    DSock.CloseSocket;
+    Result := FSock.RecvTerminated(FTimeout, LF);
+  end;
+end;
+
+function TClamSend.ScanStrings2(const Value: TStrings): AnsiString;
+var
+  i: integer;
+  s: AnsiString;
+begin
+  Result := '';
+  if not FSession then
+    FSock.CloseSocket
+  else
+    FSock.sendstring('nINSTREAM' + LF);
+  if not FSession or (FSock.LastError <> 0) then
+  begin
+    if Login then
+      FSock.sendstring('nINSTREAM' + LF)
+    else
+      Exit;
+  end;
+  s := Value.text;
+  i := length(s);
+  FSock.SendString(CodeLongint(i) + s + #0#0#0#0);
+  Result := FSock.RecvTerminated(FTimeout, LF);
+end;
+
+function TClamSend.ScanStream2(const Value: TStream): AnsiString;
+var
+  i: integer;
+begin
+  Result := '';
+  if not FSession then
+    FSock.CloseSocket
+  else
+    FSock.sendstring('nINSTREAM' + LF);
+  if not FSession or (FSock.LastError <> 0) then
+  begin
+    if Login then
+      FSock.sendstring('nINSTREAM' + LF)
+    else
+      Exit;
+  end;
+  i := value.Size;
+  FSock.SendString(CodeLongint(i));
+  FSock.SendStreamRaw(Value);
+  FSock.SendString(#0#0#0#0);
+  Result := FSock.RecvTerminated(FTimeout, LF);
+end;
+
+end.
diff --git a/Units/Synapse/dnssend.pas b/Units/Synapse/dnssend.pas
index 84c14cc..cbf7d3b 100644
--- a/Units/Synapse/dnssend.pas
+++ b/Units/Synapse/dnssend.pas
@@ -1,603 +1,603 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 002.007.006 |
-|==============================================================================|
-| Content: DNS client                                                          |
-|==============================================================================|
-| Copyright (c)1999-2010, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2000-2010.                |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-{: @abstract(DNS client by UDP or TCP)
-Support for sending DNS queries by UDP or TCP protocol. It can retrieve zone
- transfers too!
-
-Used RFC: RFC-1035, RFC-1183, RFC1706, RFC1712, RFC2163, RFC2230
-}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$Q-}
-{$H+}
-
-{$IFDEF UNICODE}
-  {$WARN IMPLICIT_STRING_CAST OFF}
-  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
-{$ENDIF}
-
-unit dnssend;
-
-interface
-
-uses
-  SysUtils, Classes,
-  blcksock, synautil, synaip, synsock;
-
-const
-  cDnsProtocol = '53';
-
-  QTYPE_A = 1;
-  QTYPE_NS = 2;
-  QTYPE_MD = 3;
-  QTYPE_MF = 4;
-  QTYPE_CNAME = 5;
-  QTYPE_SOA = 6;
-  QTYPE_MB = 7;
-  QTYPE_MG = 8;
-  QTYPE_MR = 9;
-  QTYPE_NULL = 10;
-  QTYPE_WKS = 11; //
-  QTYPE_PTR = 12;
-  QTYPE_HINFO = 13;
-  QTYPE_MINFO = 14;
-  QTYPE_MX = 15;
-  QTYPE_TXT = 16;
-
-  QTYPE_RP = 17;
-  QTYPE_AFSDB = 18;
-  QTYPE_X25 = 19;
-  QTYPE_ISDN = 20;
-  QTYPE_RT = 21;
-  QTYPE_NSAP = 22;
-  QTYPE_NSAPPTR = 23;
-  QTYPE_SIG = 24; // RFC-2065
-  QTYPE_KEY = 25; // RFC-2065
-  QTYPE_PX = 26;
-  QTYPE_GPOS = 27;
-  QTYPE_AAAA = 28;
-  QTYPE_LOC = 29; // RFC-1876
-  QTYPE_NXT = 30; // RFC-2065
-
-  QTYPE_SRV = 33;
-  QTYPE_NAPTR = 35; // RFC-2168
-  QTYPE_KX = 36;
-  QTYPE_SPF = 99;
-
-  QTYPE_AXFR = 252;
-  QTYPE_MAILB = 253; //
-  QTYPE_MAILA = 254; //
-  QTYPE_ALL = 255;
-
-type
-  {:@abstract(Implementation of DNS protocol by UDP or TCP protocol.)
-
-   Note: Are you missing properties for specify server address and port? Look to
-   parent @link(TSynaClient) too!}
-  TDNSSend = class(TSynaClient)
-  private
-    FID: Word;
-    FRCode: Integer;
-    FBuffer: AnsiString;
-    FSock: TUDPBlockSocket;
-    FTCPSock: TTCPBlockSocket;
-    FUseTCP: Boolean;
-    FAnswerInfo: TStringList;
-    FNameserverInfo: TStringList;
-    FAdditionalInfo: TStringList;
-    FAuthoritative: Boolean;
-    FTruncated: Boolean;
-    function CompressName(const Value: AnsiString): AnsiString;
-    function CodeHeader: AnsiString;
-    function CodeQuery(const Name: AnsiString; QType: Integer): AnsiString;
-    function DecodeLabels(var From: Integer): AnsiString;
-    function DecodeString(var From: Integer): AnsiString;
-    function DecodeResource(var i: Integer; const Info: TStringList;
-      QType: Integer): AnsiString;
-    function RecvTCPResponse(const WorkSock: TBlockSocket): AnsiString;
-    function DecodeResponse(const Buf: AnsiString; const Reply: TStrings;
-      QType: Integer):boolean;
-  public
-    constructor Create;
-    destructor Destroy; override;
-
-    {:Query a DNSHost for QType resources correspond to a name. Supported QType
-     values are: Qtype_A, Qtype_NS, Qtype_MD, Qtype_MF, Qtype_CNAME, Qtype_SOA,
-     Qtype_MB, Qtype_MG, Qtype_MR, Qtype_NULL, Qtype_PTR, Qtype_HINFO,
-     Qtype_MINFO, Qtype_MX, Qtype_TXT, Qtype_RP, Qtype_AFSDB, Qtype_X25,
-     Qtype_ISDN, Qtype_RT, Qtype_NSAP, Qtype_NSAPPTR, Qtype_PX, Qtype_GPOS,
-     Qtype_KX.
-
-     Type for zone transfers QTYPE_AXFR is supported too, but only in TCP mode!
-
-     "Name" is domain name or host name for queried resource. If "name" is
-     IP address, automatically convert to reverse domain form (.in-addr.arpa).
-
-     If result is @true, Reply contains resource records. One record on one line.
-     If Resource record have multiple fields, they are stored on line divided by
-     comma. (example: MX record contains value 'rs.cesnet.cz' with preference
-     number 10, string in Reply is: '10,rs.cesnet.cz'). All numbers or IP address
-     in resource are converted to string form.}
-    function DNSQuery(Name: AnsiString; QType: Integer;
-      const Reply: TStrings): Boolean;
-  published
-
-    {:Socket object used for UDP operation. Good for seting OnStatus hook, etc.}
-    property Sock: TUDPBlockSocket read FSock;
-
-    {:Socket object used for TCP operation. Good for seting OnStatus hook, etc.}
-    property TCPSock: TTCPBlockSocket read FTCPSock;
-
-    {:if @true, then is used TCP protocol instead UDP. It is needed for zone
-     transfers, etc.}
-    property UseTCP: Boolean read FUseTCP Write FUseTCP;
-
-    {:After DNS operation contains ResultCode of DNS operation.
-      Values are: 0-no error, 1-format error, 2-server failure, 3-name error,
-      4-not implemented, 5-refused.}
-    property RCode: Integer read FRCode;
-
-    {:@True, if answer is authoritative.}
-    property Authoritative: Boolean read FAuthoritative;
-
-    {:@True, if answer is truncated to 512 bytes.}
-    property Truncated: Boolean read FTRuncated;
-
-    {:Detailed informations from name server reply. One record per line. Record
-     have comma delimited entries with type number, TTL and data filelds.
-     This information contains detailed information about query reply.}
-    property AnswerInfo: TStringList read FAnswerInfo;
-
-    {:Detailed informations from name server reply. One record per line. Record
-     have comma delimited entries with type number, TTL and data filelds.
-     This information contains detailed information about nameserver.}
-    property NameserverInfo: TStringList read FNameserverInfo;
-
-    {:Detailed informations from name server reply. One record per line. Record
-     have comma delimited entries with type number, TTL and data filelds.
-     This information contains detailed additional information.}
-    property AdditionalInfo: TStringList read FAdditionalInfo;
-  end;
-
-{:A very useful function, and example of it's use is found in the TDNSSend object.
- This function is used to get mail servers for a domain and sort them by
- preference numbers. "Servers" contains only the domain names of the mail
- servers in the right order (without preference number!). The first domain name
- will always be the highest preferenced mail server. Returns boolean @TRUE if
- all went well.}
-function GetMailServers(const DNSHost, Domain: AnsiString;
-  const Servers: TStrings): Boolean;
-
-implementation
-
-constructor TDNSSend.Create;
-begin
-  inherited Create;
-  FSock := TUDPBlockSocket.Create;
-  FSock.Owner := self;
-  FTCPSock := TTCPBlockSocket.Create;
-  FTCPSock.Owner := self;
-  FUseTCP := False;
-  FTimeout := 10000;
-  FTargetPort := cDnsProtocol;
-  FAnswerInfo := TStringList.Create;
-  FNameserverInfo := TStringList.Create;
-  FAdditionalInfo := TStringList.Create;
-  Randomize;
-end;
-
-destructor TDNSSend.Destroy;
-begin
-  FAnswerInfo.Free;
-  FNameserverInfo.Free;
-  FAdditionalInfo.Free;
-  FTCPSock.Free;
-  FSock.Free;
-  inherited Destroy;
-end;
-
-function TDNSSend.CompressName(const Value: AnsiString): AnsiString;
-var
-  n: Integer;
-  s: AnsiString;
-begin
-  Result := '';
-  if Value = '' then
-    Result := #0
-  else
-  begin
-    s := '';
-    for n := 1 to Length(Value) do
-      if Value[n] = '.' then
-      begin
-        Result := Result + AnsiChar(Length(s)) + s;
-        s := '';
-      end
-      else
-        s := s + Value[n];
-    if s <> '' then
-      Result := Result + AnsiChar(Length(s)) + s;
-    Result := Result + #0;
-  end;
-end;
-
-function TDNSSend.CodeHeader: AnsiString;
-begin
-  FID := Random(32767);
-  Result := CodeInt(FID); // ID
-  Result := Result + CodeInt($0100); // flags
-  Result := Result + CodeInt(1); // QDCount
-  Result := Result + CodeInt(0); // ANCount
-  Result := Result + CodeInt(0); // NSCount
-  Result := Result + CodeInt(0); // ARCount
-end;
-
-function TDNSSend.CodeQuery(const Name: AnsiString; QType: Integer): AnsiString;
-begin
-  Result := CompressName(Name);
-  Result := Result + CodeInt(QType);
-  Result := Result + CodeInt(1); // Type INTERNET
-end;
-
-function TDNSSend.DecodeString(var From: Integer): AnsiString;
-var
-  Len: integer;
-begin
-  Len := Ord(FBuffer[From]);
-  Inc(From);
-  Result := Copy(FBuffer, From, Len);
-  Inc(From, Len);
-end;
-
-function TDNSSend.DecodeLabels(var From: Integer): AnsiString;
-var
-  l, f: Integer;
-begin
-  Result := '';
-  while True do
-  begin
-    if From >= Length(FBuffer) then
-      Break;
-    l := Ord(FBuffer[From]);
-    Inc(From);
-    if l = 0 then
-      Break;
-    if Result <> '' then
-      Result := Result + '.';
-    if (l and $C0) = $C0 then
-    begin
-      f := l and $3F;
-      f := f * 256 + Ord(FBuffer[From]) + 1;
-      Inc(From);
-      Result := Result + DecodeLabels(f);
-      Break;
-    end
-    else
-    begin
-      Result := Result + Copy(FBuffer, From, l);
-      Inc(From, l);
-    end;
-  end;
-end;
-
-function TDNSSend.DecodeResource(var i: Integer; const Info: TStringList;
-  QType: Integer): AnsiString;
-var
-  Rname: AnsiString;
-  RType, Len, j, x, y, z, n: Integer;
-  R: AnsiString;
-  t1, t2, ttl: integer;
-  ip6: TIp6bytes;
-begin
-  Result := '';
-  R := '';
-  Rname := DecodeLabels(i);
-  RType := DecodeInt(FBuffer, i);
-  Inc(i, 4);
-  t1 := DecodeInt(FBuffer, i);
-  Inc(i, 2);
-  t2 := DecodeInt(FBuffer, i);
-  Inc(i, 2);
-  ttl := t1 * 65536 + t2;
-  Len := DecodeInt(FBuffer, i);
-  Inc(i, 2); // i point to begin of data
-  j := i;
-  i := i + len; // i point to next record
-  if Length(FBuffer) >= (i - 1) then
-    case RType of
-      QTYPE_A:
-        begin
-          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_AAAA:
-        begin
-          for n := 0 to 15 do
-            ip6[n] := ord(FBuffer[j + n]);
-          R := 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, QTYPE_SPF:
-        begin
-          R := '';
-          while j < i do
-            R := R + DecodeString(j);
-        end;
-      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;
-      QTYPE_SRV:
-      // Author: Dan <ml@mutox.org>
-        begin
-          x := DecodeInt(FBuffer, j);
-          Inc(j, 2);
-          y := DecodeInt(FBuffer, j);
-          Inc(j, 2);
-          z := DecodeInt(FBuffer, j);
-          Inc(j, 2);
-          R := IntToStr(x);                     // Priority
-          R := R + ',' + IntToStr(y);           // Weight
-          R := R + ',' + IntToStr(z);           // Port
-          R := R + ',' + DecodeLabels(j);       // Server DNS Name
-        end;
-    end;
-  if R <> '' then
-    Info.Add(RName + ',' + IntToStr(RType) + ',' + IntToStr(ttl) + ',' + R);
-  if QType = RType then
-    Result := R;
-end;
-
-function TDNSSend.RecvTCPResponse(const WorkSock: TBlockSocket): AnsiString;
-var
-  l: integer;
-begin
-  Result := '';
-  l := WorkSock.recvbyte(FTimeout) * 256 + WorkSock.recvbyte(FTimeout);
-  if l > 0 then
-    Result := WorkSock.RecvBufferStr(l, FTimeout);
-end;
-
-function TDNSSend.DecodeResponse(const Buf: AnsiString; const Reply: TStrings;
-  QType: Integer):boolean;
-var
-  n, i: Integer;
-  flag, qdcount, ancount, nscount, arcount: Integer;
-  s: AnsiString;
-begin
-  Result := False;
-  Reply.Clear;
-  FAnswerInfo.Clear;
-  FNameserverInfo.Clear;
-  FAdditionalInfo.Clear;
-  FAuthoritative := False;
-  if (Length(Buf) > 13) and (FID = DecodeInt(Buf, 1)) then
-  begin
-    Result := True;
-    flag := DecodeInt(Buf, 3);
-    FRCode := Flag and $000F;
-    FAuthoritative := (Flag and $0400) > 0;
-    FTruncated := (Flag and $0200) > 0;
-    if FRCode = 0 then
-    begin
-      qdcount := DecodeInt(Buf, 5);
-      ancount := DecodeInt(Buf, 7);
-      nscount := DecodeInt(Buf, 9);
-      arcount := DecodeInt(Buf, 11);
-      i := 13; //begin of body
-      if (qdcount > 0) and (Length(Buf) > i) then //skip questions
-        for n := 1 to qdcount do
-        begin
-          while (Buf[i] <> #0) and ((Ord(Buf[i]) and $C0) <> $C0) do
-            Inc(i);
-          Inc(i, 5);
-        end;
-      if (ancount > 0) and (Length(Buf) > i) then // decode reply
-        for n := 1 to ancount do
-        begin
-          s := DecodeResource(i, FAnswerInfo, QType);
-          if s <> '' then
-            Reply.Add(s);
-        end;
-      if (nscount > 0) and (Length(Buf) > i) then // decode nameserver info
-        for n := 1 to nscount do
-          DecodeResource(i, FNameserverInfo, QType);
-      if (arcount > 0) and (Length(Buf) > i) then // decode additional info
-        for n := 1 to arcount do
-          DecodeResource(i, FAdditionalInfo, QType);
-    end;
-  end;
-end;
-
-function TDNSSend.DNSQuery(Name: AnsiString; QType: Integer;
-  const Reply: TStrings): Boolean;
-var
-  WorkSock: TBlockSocket;
-  t: TStringList;
-  b: boolean;
-begin
-  Result := False;
-  if IsIP(Name) then
-    Name := ReverseIP(Name) + '.in-addr.arpa';
-  if IsIP6(Name) then
-    Name := ReverseIP6(Name) + '.ip6.arpa';
-  FBuffer := CodeHeader + CodeQuery(Name, QType);
-  if FUseTCP then
-    WorkSock := FTCPSock
-  else
-    WorkSock := FSock;
-  WorkSock.Bind(FIPInterface, cAnyPort);
-  WorkSock.Connect(FTargetHost, FTargetPort);
-  if FUseTCP then
-    FBuffer := Codeint(length(FBuffer)) + FBuffer;
-  WorkSock.SendString(FBuffer);
-  if FUseTCP then
-    FBuffer := RecvTCPResponse(WorkSock)
-  else
-    FBuffer := WorkSock.RecvPacket(FTimeout);
-  if FUseTCP and (QType = QTYPE_AXFR) then //zone transfer
-  begin
-    t := TStringList.Create;
-    try
-      repeat
-        b := DecodeResponse(FBuffer, Reply, QType);
-        if (t.Count > 1) and (AnswerInfo.Count > 0) then  //find end of transfer
-          b := b and (t[0] <> AnswerInfo[AnswerInfo.count - 1]);
-        if b then
-        begin
-          t.AddStrings(AnswerInfo);
-          FBuffer := RecvTCPResponse(WorkSock);
-          if FBuffer = '' then
-            Break;
-          if WorkSock.LastError <> 0 then
-            Break;
-        end;
-      until not b;
-      Reply.Assign(t);
-      Result := True;
-    finally
-      t.free;
-    end;
-  end
-  else //normal query
-    if WorkSock.LastError = 0 then
-      Result := DecodeResponse(FBuffer, Reply, QType);
-end;
-
-{==============================================================================}
-
-function GetMailServers(const DNSHost, Domain: AnsiString;
-  const Servers: TStrings): Boolean;
-var
-  DNS: TDNSSend;
-  t: TStringList;
-  n, m, x: Integer;
-begin
-  Result := False;
-  Servers.Clear;
-  t := TStringList.Create;
-  DNS := TDNSSend.Create;
-  try
-    DNS.TargetHost := DNSHost;
-    if DNS.DNSQuery(Domain, QType_MX, t) then
-    begin
-      { normalize preference number to 5 digits }
-      for n := 0 to t.Count - 1 do
-      begin
-        x := Pos(',', t[n]);
-        if x > 0 then
-          for m := 1 to 6 - x do
-            t[n] := '0' + t[n];
-      end;
-      { sort server list }
-      t.Sorted := True;
-      { result is sorted list without preference numbers }
-      for n := 0 to t.Count - 1 do
-      begin
-        x := Pos(',', t[n]);
-        Servers.Add(Copy(t[n], x + 1, Length(t[n]) - x));
-      end;
-      Result := True;
-    end;
-  finally
-    DNS.Free;
-    t.Free;
-  end;
-end;
-
-end.
+{==============================================================================|
+| Project : Ararat Synapse                                       | 002.007.006 |
+|==============================================================================|
+| Content: DNS client                                                          |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2000-2010.                |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+{: @abstract(DNS client by UDP or TCP)
+Support for sending DNS queries by UDP or TCP protocol. It can retrieve zone
+ transfers too!
+
+Used RFC: RFC-1035, RFC-1183, RFC1706, RFC1712, RFC2163, RFC2230
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$Q-}
+{$H+}
+
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit dnssend;
+
+interface
+
+uses
+  SysUtils, Classes,
+  blcksock, synautil, synaip, synsock;
+
+const
+  cDnsProtocol = '53';
+
+  QTYPE_A = 1;
+  QTYPE_NS = 2;
+  QTYPE_MD = 3;
+  QTYPE_MF = 4;
+  QTYPE_CNAME = 5;
+  QTYPE_SOA = 6;
+  QTYPE_MB = 7;
+  QTYPE_MG = 8;
+  QTYPE_MR = 9;
+  QTYPE_NULL = 10;
+  QTYPE_WKS = 11; //
+  QTYPE_PTR = 12;
+  QTYPE_HINFO = 13;
+  QTYPE_MINFO = 14;
+  QTYPE_MX = 15;
+  QTYPE_TXT = 16;
+
+  QTYPE_RP = 17;
+  QTYPE_AFSDB = 18;
+  QTYPE_X25 = 19;
+  QTYPE_ISDN = 20;
+  QTYPE_RT = 21;
+  QTYPE_NSAP = 22;
+  QTYPE_NSAPPTR = 23;
+  QTYPE_SIG = 24; // RFC-2065
+  QTYPE_KEY = 25; // RFC-2065
+  QTYPE_PX = 26;
+  QTYPE_GPOS = 27;
+  QTYPE_AAAA = 28;
+  QTYPE_LOC = 29; // RFC-1876
+  QTYPE_NXT = 30; // RFC-2065
+
+  QTYPE_SRV = 33;
+  QTYPE_NAPTR = 35; // RFC-2168
+  QTYPE_KX = 36;
+  QTYPE_SPF = 99;
+
+  QTYPE_AXFR = 252;
+  QTYPE_MAILB = 253; //
+  QTYPE_MAILA = 254; //
+  QTYPE_ALL = 255;
+
+type
+  {:@abstract(Implementation of DNS protocol by UDP or TCP protocol.)
+
+   Note: Are you missing properties for specify server address and port? Look to
+   parent @link(TSynaClient) too!}
+  TDNSSend = class(TSynaClient)
+  private
+    FID: Word;
+    FRCode: Integer;
+    FBuffer: AnsiString;
+    FSock: TUDPBlockSocket;
+    FTCPSock: TTCPBlockSocket;
+    FUseTCP: Boolean;
+    FAnswerInfo: TStringList;
+    FNameserverInfo: TStringList;
+    FAdditionalInfo: TStringList;
+    FAuthoritative: Boolean;
+    FTruncated: Boolean;
+    function CompressName(const Value: AnsiString): AnsiString;
+    function CodeHeader: AnsiString;
+    function CodeQuery(const Name: AnsiString; QType: Integer): AnsiString;
+    function DecodeLabels(var From: Integer): AnsiString;
+    function DecodeString(var From: Integer): AnsiString;
+    function DecodeResource(var i: Integer; const Info: TStringList;
+      QType: Integer): AnsiString;
+    function RecvTCPResponse(const WorkSock: TBlockSocket): AnsiString;
+    function DecodeResponse(const Buf: AnsiString; const Reply: TStrings;
+      QType: Integer):boolean;
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    {:Query a DNSHost for QType resources correspond to a name. Supported QType
+     values are: Qtype_A, Qtype_NS, Qtype_MD, Qtype_MF, Qtype_CNAME, Qtype_SOA,
+     Qtype_MB, Qtype_MG, Qtype_MR, Qtype_NULL, Qtype_PTR, Qtype_HINFO,
+     Qtype_MINFO, Qtype_MX, Qtype_TXT, Qtype_RP, Qtype_AFSDB, Qtype_X25,
+     Qtype_ISDN, Qtype_RT, Qtype_NSAP, Qtype_NSAPPTR, Qtype_PX, Qtype_GPOS,
+     Qtype_KX.
+
+     Type for zone transfers QTYPE_AXFR is supported too, but only in TCP mode!
+
+     "Name" is domain name or host name for queried resource. If "name" is
+     IP address, automatically convert to reverse domain form (.in-addr.arpa).
+
+     If result is @true, Reply contains resource records. One record on one line.
+     If Resource record have multiple fields, they are stored on line divided by
+     comma. (example: MX record contains value 'rs.cesnet.cz' with preference
+     number 10, string in Reply is: '10,rs.cesnet.cz'). All numbers or IP address
+     in resource are converted to string form.}
+    function DNSQuery(Name: AnsiString; QType: Integer;
+      const Reply: TStrings): Boolean;
+  published
+
+    {:Socket object used for UDP operation. Good for seting OnStatus hook, etc.}
+    property Sock: TUDPBlockSocket read FSock;
+
+    {:Socket object used for TCP operation. Good for seting OnStatus hook, etc.}
+    property TCPSock: TTCPBlockSocket read FTCPSock;
+
+    {:if @true, then is used TCP protocol instead UDP. It is needed for zone
+     transfers, etc.}
+    property UseTCP: Boolean read FUseTCP Write FUseTCP;
+
+    {:After DNS operation contains ResultCode of DNS operation.
+      Values are: 0-no error, 1-format error, 2-server failure, 3-name error,
+      4-not implemented, 5-refused.}
+    property RCode: Integer read FRCode;
+
+    {:@True, if answer is authoritative.}
+    property Authoritative: Boolean read FAuthoritative;
+
+    {:@True, if answer is truncated to 512 bytes.}
+    property Truncated: Boolean read FTRuncated;
+
+    {:Detailed informations from name server reply. One record per line. Record
+     have comma delimited entries with type number, TTL and data filelds.
+     This information contains detailed information about query reply.}
+    property AnswerInfo: TStringList read FAnswerInfo;
+
+    {:Detailed informations from name server reply. One record per line. Record
+     have comma delimited entries with type number, TTL and data filelds.
+     This information contains detailed information about nameserver.}
+    property NameserverInfo: TStringList read FNameserverInfo;
+
+    {:Detailed informations from name server reply. One record per line. Record
+     have comma delimited entries with type number, TTL and data filelds.
+     This information contains detailed additional information.}
+    property AdditionalInfo: TStringList read FAdditionalInfo;
+  end;
+
+{:A very useful function, and example of it's use is found in the TDNSSend object.
+ This function is used to get mail servers for a domain and sort them by
+ preference numbers. "Servers" contains only the domain names of the mail
+ servers in the right order (without preference number!). The first domain name
+ will always be the highest preferenced mail server. Returns boolean @TRUE if
+ all went well.}
+function GetMailServers(const DNSHost, Domain: AnsiString;
+  const Servers: TStrings): Boolean;
+
+implementation
+
+constructor TDNSSend.Create;
+begin
+  inherited Create;
+  FSock := TUDPBlockSocket.Create;
+  FSock.Owner := self;
+  FTCPSock := TTCPBlockSocket.Create;
+  FTCPSock.Owner := self;
+  FUseTCP := False;
+  FTimeout := 10000;
+  FTargetPort := cDnsProtocol;
+  FAnswerInfo := TStringList.Create;
+  FNameserverInfo := TStringList.Create;
+  FAdditionalInfo := TStringList.Create;
+  Randomize;
+end;
+
+destructor TDNSSend.Destroy;
+begin
+  FAnswerInfo.Free;
+  FNameserverInfo.Free;
+  FAdditionalInfo.Free;
+  FTCPSock.Free;
+  FSock.Free;
+  inherited Destroy;
+end;
+
+function TDNSSend.CompressName(const Value: AnsiString): AnsiString;
+var
+  n: Integer;
+  s: AnsiString;
+begin
+  Result := '';
+  if Value = '' then
+    Result := #0
+  else
+  begin
+    s := '';
+    for n := 1 to Length(Value) do
+      if Value[n] = '.' then
+      begin
+        Result := Result + AnsiChar(Length(s)) + s;
+        s := '';
+      end
+      else
+        s := s + Value[n];
+    if s <> '' then
+      Result := Result + AnsiChar(Length(s)) + s;
+    Result := Result + #0;
+  end;
+end;
+
+function TDNSSend.CodeHeader: AnsiString;
+begin
+  FID := Random(32767);
+  Result := CodeInt(FID); // ID
+  Result := Result + CodeInt($0100); // flags
+  Result := Result + CodeInt(1); // QDCount
+  Result := Result + CodeInt(0); // ANCount
+  Result := Result + CodeInt(0); // NSCount
+  Result := Result + CodeInt(0); // ARCount
+end;
+
+function TDNSSend.CodeQuery(const Name: AnsiString; QType: Integer): AnsiString;
+begin
+  Result := CompressName(Name);
+  Result := Result + CodeInt(QType);
+  Result := Result + CodeInt(1); // Type INTERNET
+end;
+
+function TDNSSend.DecodeString(var From: Integer): AnsiString;
+var
+  Len: integer;
+begin
+  Len := Ord(FBuffer[From]);
+  Inc(From);
+  Result := Copy(FBuffer, From, Len);
+  Inc(From, Len);
+end;
+
+function TDNSSend.DecodeLabels(var From: Integer): AnsiString;
+var
+  l, f: Integer;
+begin
+  Result := '';
+  while True do
+  begin
+    if From >= Length(FBuffer) then
+      Break;
+    l := Ord(FBuffer[From]);
+    Inc(From);
+    if l = 0 then
+      Break;
+    if Result <> '' then
+      Result := Result + '.';
+    if (l and $C0) = $C0 then
+    begin
+      f := l and $3F;
+      f := f * 256 + Ord(FBuffer[From]) + 1;
+      Inc(From);
+      Result := Result + DecodeLabels(f);
+      Break;
+    end
+    else
+    begin
+      Result := Result + Copy(FBuffer, From, l);
+      Inc(From, l);
+    end;
+  end;
+end;
+
+function TDNSSend.DecodeResource(var i: Integer; const Info: TStringList;
+  QType: Integer): AnsiString;
+var
+  Rname: AnsiString;
+  RType, Len, j, x, y, z, n: Integer;
+  R: AnsiString;
+  t1, t2, ttl: integer;
+  ip6: TIp6bytes;
+begin
+  Result := '';
+  R := '';
+  Rname := DecodeLabels(i);
+  RType := DecodeInt(FBuffer, i);
+  Inc(i, 4);
+  t1 := DecodeInt(FBuffer, i);
+  Inc(i, 2);
+  t2 := DecodeInt(FBuffer, i);
+  Inc(i, 2);
+  ttl := t1 * 65536 + t2;
+  Len := DecodeInt(FBuffer, i);
+  Inc(i, 2); // i point to begin of data
+  j := i;
+  i := i + len; // i point to next record
+  if Length(FBuffer) >= (i - 1) then
+    case RType of
+      QTYPE_A:
+        begin
+          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_AAAA:
+        begin
+          for n := 0 to 15 do
+            ip6[n] := ord(FBuffer[j + n]);
+          R := 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, QTYPE_SPF:
+        begin
+          R := '';
+          while j < i do
+            R := R + DecodeString(j);
+        end;
+      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;
+      QTYPE_SRV:
+      // Author: Dan <ml@mutox.org>
+        begin
+          x := DecodeInt(FBuffer, j);
+          Inc(j, 2);
+          y := DecodeInt(FBuffer, j);
+          Inc(j, 2);
+          z := DecodeInt(FBuffer, j);
+          Inc(j, 2);
+          R := IntToStr(x);                     // Priority
+          R := R + ',' + IntToStr(y);           // Weight
+          R := R + ',' + IntToStr(z);           // Port
+          R := R + ',' + DecodeLabels(j);       // Server DNS Name
+        end;
+    end;
+  if R <> '' then
+    Info.Add(RName + ',' + IntToStr(RType) + ',' + IntToStr(ttl) + ',' + R);
+  if QType = RType then
+    Result := R;
+end;
+
+function TDNSSend.RecvTCPResponse(const WorkSock: TBlockSocket): AnsiString;
+var
+  l: integer;
+begin
+  Result := '';
+  l := WorkSock.recvbyte(FTimeout) * 256 + WorkSock.recvbyte(FTimeout);
+  if l > 0 then
+    Result := WorkSock.RecvBufferStr(l, FTimeout);
+end;
+
+function TDNSSend.DecodeResponse(const Buf: AnsiString; const Reply: TStrings;
+  QType: Integer):boolean;
+var
+  n, i: Integer;
+  flag, qdcount, ancount, nscount, arcount: Integer;
+  s: AnsiString;
+begin
+  Result := False;
+  Reply.Clear;
+  FAnswerInfo.Clear;
+  FNameserverInfo.Clear;
+  FAdditionalInfo.Clear;
+  FAuthoritative := False;
+  if (Length(Buf) > 13) and (FID = DecodeInt(Buf, 1)) then
+  begin
+    Result := True;
+    flag := DecodeInt(Buf, 3);
+    FRCode := Flag and $000F;
+    FAuthoritative := (Flag and $0400) > 0;
+    FTruncated := (Flag and $0200) > 0;
+    if FRCode = 0 then
+    begin
+      qdcount := DecodeInt(Buf, 5);
+      ancount := DecodeInt(Buf, 7);
+      nscount := DecodeInt(Buf, 9);
+      arcount := DecodeInt(Buf, 11);
+      i := 13; //begin of body
+      if (qdcount > 0) and (Length(Buf) > i) then //skip questions
+        for n := 1 to qdcount do
+        begin
+          while (Buf[i] <> #0) and ((Ord(Buf[i]) and $C0) <> $C0) do
+            Inc(i);
+          Inc(i, 5);
+        end;
+      if (ancount > 0) and (Length(Buf) > i) then // decode reply
+        for n := 1 to ancount do
+        begin
+          s := DecodeResource(i, FAnswerInfo, QType);
+          if s <> '' then
+            Reply.Add(s);
+        end;
+      if (nscount > 0) and (Length(Buf) > i) then // decode nameserver info
+        for n := 1 to nscount do
+          DecodeResource(i, FNameserverInfo, QType);
+      if (arcount > 0) and (Length(Buf) > i) then // decode additional info
+        for n := 1 to arcount do
+          DecodeResource(i, FAdditionalInfo, QType);
+    end;
+  end;
+end;
+
+function TDNSSend.DNSQuery(Name: AnsiString; QType: Integer;
+  const Reply: TStrings): Boolean;
+var
+  WorkSock: TBlockSocket;
+  t: TStringList;
+  b: boolean;
+begin
+  Result := False;
+  if IsIP(Name) then
+    Name := ReverseIP(Name) + '.in-addr.arpa';
+  if IsIP6(Name) then
+    Name := ReverseIP6(Name) + '.ip6.arpa';
+  FBuffer := CodeHeader + CodeQuery(Name, QType);
+  if FUseTCP then
+    WorkSock := FTCPSock
+  else
+    WorkSock := FSock;
+  WorkSock.Bind(FIPInterface, cAnyPort);
+  WorkSock.Connect(FTargetHost, FTargetPort);
+  if FUseTCP then
+    FBuffer := Codeint(length(FBuffer)) + FBuffer;
+  WorkSock.SendString(FBuffer);
+  if FUseTCP then
+    FBuffer := RecvTCPResponse(WorkSock)
+  else
+    FBuffer := WorkSock.RecvPacket(FTimeout);
+  if FUseTCP and (QType = QTYPE_AXFR) then //zone transfer
+  begin
+    t := TStringList.Create;
+    try
+      repeat
+        b := DecodeResponse(FBuffer, Reply, QType);
+        if (t.Count > 1) and (AnswerInfo.Count > 0) then  //find end of transfer
+          b := b and (t[0] <> AnswerInfo[AnswerInfo.count - 1]);
+        if b then
+        begin
+          t.AddStrings(AnswerInfo);
+          FBuffer := RecvTCPResponse(WorkSock);
+          if FBuffer = '' then
+            Break;
+          if WorkSock.LastError <> 0 then
+            Break;
+        end;
+      until not b;
+      Reply.Assign(t);
+      Result := True;
+    finally
+      t.free;
+    end;
+  end
+  else //normal query
+    if WorkSock.LastError = 0 then
+      Result := DecodeResponse(FBuffer, Reply, QType);
+end;
+
+{==============================================================================}
+
+function GetMailServers(const DNSHost, Domain: AnsiString;
+  const Servers: TStrings): Boolean;
+var
+  DNS: TDNSSend;
+  t: TStringList;
+  n, m, x: Integer;
+begin
+  Result := False;
+  Servers.Clear;
+  t := TStringList.Create;
+  DNS := TDNSSend.Create;
+  try
+    DNS.TargetHost := DNSHost;
+    if DNS.DNSQuery(Domain, QType_MX, t) then
+    begin
+      { normalize preference number to 5 digits }
+      for n := 0 to t.Count - 1 do
+      begin
+        x := Pos(',', t[n]);
+        if x > 0 then
+          for m := 1 to 6 - x do
+            t[n] := '0' + t[n];
+      end;
+      { sort server list }
+      t.Sorted := True;
+      { result is sorted list without preference numbers }
+      for n := 0 to t.Count - 1 do
+      begin
+        x := Pos(',', t[n]);
+        Servers.Add(Copy(t[n], x + 1, Length(t[n]) - x));
+      end;
+      Result := True;
+    end;
+  finally
+    DNS.Free;
+    t.Free;
+  end;
+end;
+
+end.
diff --git a/Units/Synapse/ftpsend.pas b/Units/Synapse/ftpsend.pas
index cbbfb35..9ed1261 100644
--- a/Units/Synapse/ftpsend.pas
+++ b/Units/Synapse/ftpsend.pas
@@ -1,1949 +1,1949 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 003.005.003 |
-|==============================================================================|
-| Content: FTP client                                                          |
-|==============================================================================|
-| Copyright (c)1999-2010, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c) 1999-2010.               |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|   Petr Esner <petr.esner@atlas.cz>                                           |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{: @abstract(FTP client protocol)
-
-Used RFC: RFC-959, RFC-2228, RFC-2428
-}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$H+}
-
-{$IFDEF UNICODE}
-  {$WARN IMPLICIT_STRING_CAST OFF}
-  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
-{$ENDIF}
-
-unit ftpsend;
-
-interface
-
-uses
-  SysUtils, Classes,
-  blcksock, synautil, synaip, synsock;
-
-const
-  cFtpProtocol = '21';
-  cFtpDataProtocol = '20';
-
-  {:Terminating value for TLogonActions}
-  FTP_OK = 255;
-  {:Terminating value for TLogonActions}
-  FTP_ERR = 254;
-
-type
-  {:Array for holding definition of logon sequence.}
-  TLogonActions = array [0..17] of byte;
-
-  {:Procedural type for OnStatus event. Sender is calling @link(TFTPSend) object.
-   Value is FTP command or reply to this comand. (if it is reply, Response
-   is @True).}
-  TFTPStatus = procedure(Sender: TObject; Response: Boolean;
-    const Value: string) of object;
-
-  {: @abstract(Object for holding file information) parsed from directory
-   listing of FTP server.}
-  TFTPListRec = class(TObject)
-  private
-    FFileName: String;
-    FDirectory: Boolean;
-    FReadable: Boolean;
-    FFileSize: Longint;
-    FFileTime: TDateTime;
-    FOriginalLine: string;
-    FMask: string;
-    FPermission: String;
-  public
-    {: You can assign another TFTPListRec to this object.}
-    procedure Assign(Value: TFTPListRec); virtual;
-    {:name of file}
-    property FileName: string read FFileName write FFileName;
-    {:if name is subdirectory not file.}
-    property Directory: Boolean read FDirectory write FDirectory;
-    {:if you have rights to read}
-    property Readable: Boolean read FReadable write FReadable;
-    {:size of file in bytes}
-    property FileSize: Longint read FFileSize write FFileSize;
-    {:date and time of file. Local server timezone is used. Any timezone
-     conversions was not done!}
-    property FileTime: TDateTime read FFileTime write FFileTime;
-    {:original unparsed line}
-    property OriginalLine: string read FOriginalLine write FOriginalLine;
-    {:mask what was used for parsing}
-    property Mask: string read FMask write FMask;
-    {:permission string (depending on used mask!)}
-    property Permission: string read FPermission write FPermission;
-  end;
-
-  {:@abstract(This is TList of TFTPListRec objects.)
-   This object is used for holding lististing of all files information in listed
-   directory on FTP server.}
-  TFTPList = class(TObject)
-  protected
-    FList: TList;
-    FLines: TStringList;
-    FMasks: TStringList;
-    FUnparsedLines: TStringList;
-    Monthnames: string;
-    BlockSize: string;
-    DirFlagValue: string;
-    FileName: string;
-    VMSFileName: string;
-    Day: string;
-    Month: string;
-    ThreeMonth: string;
-    YearTime: string;
-    Year: string;
-    Hours: string;
-    HoursModif: Ansistring;
-    Minutes: string;
-    Seconds: string;
-    Size: Ansistring;
-    Permissions: Ansistring;
-    DirFlag: string;
-    function GetListItem(Index: integer): TFTPListRec; virtual;
-    function ParseEPLF(Value: string): Boolean; virtual;
-    procedure ClearStore; virtual;
-    function ParseByMask(Value, NextValue, Mask: ansistring): Integer; virtual;
-    function CheckValues: Boolean; virtual;
-    procedure FillRecord(const Value: TFTPListRec); virtual;
-  public
-    {:Constructor. You not need create this object, it is created by TFTPSend
-     class as their property.}
-    constructor Create;
-    destructor Destroy; override;
-
-    {:Clear list.}
-    procedure Clear; virtual;
-
-    {:count of holded @link(TFTPListRec) objects}
-    function Count: integer; virtual;
-
-    {:Assigns one list to another}
-    procedure Assign(Value: TFTPList); virtual;
-
-    {:try to parse raw directory listing in @link(lines) to list of
-     @link(TFTPListRec).}
-    procedure ParseLines; virtual;
-
-    {:By this property you have access to list of @link(TFTPListRec).
-     This is for compatibility only. Please, use @link(Items) instead.}
-    property List: TList read FList;
-
-    {:By this property you have access to list of @link(TFTPListRec).}
-    property Items[Index: Integer]: TFTPListRec read GetListItem; default;
-
-    {:Set of lines with RAW directory listing for @link(parseLines)}
-    property Lines: TStringList read FLines;
-
-    {:Set of masks for directory listing parser. It is predefined by default,
-    however you can modify it as you need. (for example, you can add your own
-    definition mask.) Mask is same as mask used in TotalCommander.}
-    property Masks: TStringList read FMasks;
-
-    {:After @link(ParseLines) it holding lines what was not sucessfully parsed.}
-    property UnparsedLines: TStringList read FUnparsedLines;
-  end;
-
-  {:@abstract(Implementation of FTP protocol.)
-   Note: Are you missing properties for setting Username and Password? Look to
-   parent @link(TSynaClient) object! (Username and Password have default values
-   for "anonymous" FTP login)
-
-   Are you missing properties for specify server address and port? Look to
-   parent @link(TSynaClient) too!}
-  TFTPSend = class(TSynaClient)
-  protected
-    FOnStatus: TFTPStatus;
-    FSock: TTCPBlockSocket;
-    FDSock: TTCPBlockSocket;
-    FResultCode: Integer;
-    FResultString: string;
-    FFullResult: TStringList;
-    FAccount: string;
-    FFWHost: string;
-    FFWPort: string;
-    FFWUsername: string;
-    FFWPassword: string;
-    FFWMode: integer;
-    FDataStream: TMemoryStream;
-    FDataIP: string;
-    FDataPort: string;
-    FDirectFile: Boolean;
-    FDirectFileName: string;
-    FCanResume: Boolean;
-    FPassiveMode: Boolean;
-    FForceDefaultPort: Boolean;
-    FForceOldPort: Boolean;
-    FFtpList: TFTPList;
-    FBinaryMode: Boolean;
-    FAutoTLS: Boolean;
-    FIsTLS: Boolean;
-    FIsDataTLS: Boolean;
-    FTLSonData: Boolean;
-    FFullSSL: Boolean;
-    function Auth(Mode: integer): Boolean; virtual;
-    function Connect: Boolean; virtual;
-    function InternalStor(const Command: string; RestoreAt: integer): Boolean; virtual;
-    function DataSocket: Boolean; virtual;
-    function AcceptDataSocket: Boolean; virtual;
-    procedure DoStatus(Response: Boolean; const Value: string); virtual;
-  public
-    {:Custom definition of login sequence. You can use this when you set
-     @link(FWMode) to value -1.}
-    CustomLogon: TLogonActions;
-
-    constructor Create;
-    destructor Destroy; override;
-
-    {:Waits and read FTP server response. You need this only in special cases!}
-    function ReadResult: Integer; virtual;
-
-    {:Parse remote side information of data channel from value string (returned
-     by PASV command). This function you need only in special cases!}
-    procedure ParseRemote(Value: string); virtual;
-
-    {:Parse remote side information of data channel from value string (returned
-     by EPSV command). This function you need only in special cases!}
-    procedure ParseRemoteEPSV(Value: string); virtual;
-
-    {:Send Value as FTP command to FTP server. Returned result code is result of
-     this function.
-     This command is good for sending site specific command, or non-standard
-     commands.}
-    function FTPCommand(const Value: string): integer; virtual;
-
-    {:Connect and logon to FTP server. If you specify any FireWall, connect to
-     firewall and throw them connect to FTP server. Login sequence depending on
-     @link(FWMode).}
-    function Login: Boolean; virtual;
-
-    {:Logoff and disconnect from FTP server.}
-    function Logout: Boolean; virtual;
-
-    {:Break current transmission of data. (You can call this method from
-     Sock.OnStatus event, or from another thread.)}
-    procedure Abort; virtual;
-
-    {:Break current transmission of data. It is same as Abort, but it send abort
-     telnet commands prior ABOR FTP command. Some servers need it. (You can call
-     this method from Sock.OnStatus event, or from another thread.)}
-    procedure TelnetAbort; virtual;
-
-    {:Download directory listing of Directory on FTP server. If Directory is
-     empty string, download listing of current working directory.
-     If NameList is @true, download only names of files in directory.
-     (internally use NLST command instead LIST command)
-     If NameList is @false, returned list is also parsed to @link(FTPList)
-     property.}
-    function List(Directory: string; NameList: Boolean): Boolean; virtual;
-
-    {:Read data from FileName on FTP server. If Restore is @true and server
-     supports resume dowloads, download is resumed. (received is only rest
-     of file)}
-    function RetrieveFile(const FileName: string; Restore: Boolean): Boolean; virtual;
-
-    {:Send data to FileName on FTP server. If Restore is @true and server
-     supports resume upload, upload is resumed. (send only rest of file)
-     In this case if remote file is same length as local file, nothing will be
-     done. If remote file is larger then local, resume is disabled and file is
-     transfered from begin!}
-    function StoreFile(const FileName: string; Restore: Boolean): Boolean; virtual;
-
-    {:Send data to FTP server and assing unique name for this file.}
-    function StoreUniqueFile: Boolean; virtual;
-
-    {:Append data to FileName on FTP server.}
-    function AppendFile(const FileName: string): Boolean; virtual;
-
-    {:Rename on FTP server file with OldName to NewName.}
-    function RenameFile(const OldName, NewName: string): Boolean; virtual;
-
-    {:Delete file FileName on FTP server.}
-    function DeleteFile(const FileName: string): Boolean; virtual;
-
-    {:Return size of Filename file on FTP server. If command failed (i.e. not
-     implemented), return -1.}
-    function FileSize(const FileName: string): integer; virtual;
-
-    {:Send NOOP command to FTP server for preserve of disconnect by inactivity
-     timeout.}
-    function NoOp: Boolean; virtual;
-
-    {:Change currect working directory to Directory on FTP server.}
-    function ChangeWorkingDir(const Directory: string): Boolean; virtual;
-
-    {:walk to upper directory on FTP server.}
-    function ChangeToParentDir: Boolean; virtual;
-
-    {:walk to root directory on FTP server. (May not work with all servers properly!)}
-    function ChangeToRootDir: Boolean; virtual;
-
-    {:Delete Directory on FTP server.}
-    function DeleteDir(const Directory: string): Boolean; virtual;
-
-    {:Create Directory on FTP server.}
-    function CreateDir(const Directory: string): Boolean; virtual;
-
-    {:Return current working directory on FTP server.}
-    function GetCurrentDir: String; virtual;
-
-    {:Establish data channel to FTP server and retrieve data.
-     This function you need only in special cases, i.e. when you need to implement
-     some special unsupported FTP command!}
-    function DataRead(const DestStream: TStream): Boolean; virtual;
-
-    {:Establish data channel to FTP server and send data.
-     This function you need only in special cases, i.e. when you need to implement
-     some special unsupported FTP command.}
-    function DataWrite(const SourceStream: TStream): Boolean; virtual;
-  published
-    {:After FTP command contains result number of this operation.}
-    property ResultCode: Integer read FResultCode;
-
-    {:After FTP command contains main line of result.}
-    property ResultString: string read FResultString;
-
-    {:After any FTP command it contains all lines of FTP server reply.}
-    property FullResult: TStringList read FFullResult;
-
-    {:Account information used in some cases inside login sequence.}
-    property Account: string read FAccount Write FAccount;
-
-    {:Address of firewall. If empty string (default), firewall not used.}
-    property FWHost: string read FFWHost Write FFWHost;
-
-    {:port of firewall. standard value is same port as ftp server used. (21)}
-    property FWPort: string read FFWPort Write FFWPort;
-
-    {:Username for login to firewall. (if needed)}
-    property FWUsername: string read FFWUsername Write FFWUsername;
-
-    {:password for login to firewall. (if needed)}
-    property FWPassword: string read FFWPassword Write FFWPassword;
-
-    {:Type of Firewall. Used only if you set some firewall address. Supported
-     predefined firewall login sequences are described by comments in source
-     file where you can see pseudocode decribing each sequence.}
-    property FWMode: integer read FFWMode Write FFWMode;
-
-    {:Socket object used for TCP/IP operation on control channel. Good for
-     seting OnStatus hook, etc.}
-    property Sock: TTCPBlockSocket read FSock;
-
-    {:Socket object used for TCP/IP operation on data channel. Good for seting
-     OnStatus hook, etc.}
-    property DSock: TTCPBlockSocket read FDSock;
-
-    {:If you not use @link(DirectFile) mode, all data transfers is made to or
-     from this stream.}
-    property DataStream: TMemoryStream read FDataStream;
-
-    {:After data connection is established, contains remote side IP of this
-     connection.}
-    property DataIP: string read FDataIP;
-
-    {:After data connection is established, contains remote side port of this
-     connection.}
-    property DataPort: string read FDataPort;
-
-    {:Mode of data handling by data connection. If @False, all data operations
-     are made to or from @link(DataStream) TMemoryStream.
-     If @true, data operations is made directly to file in your disk. (filename
-     is specified by @link(DirectFileName) property.) Dafault is @False!}
-    property DirectFile: Boolean read FDirectFile Write FDirectFile;
-
-    {:Filename for direct disk data operations.}
-    property DirectFileName: string read FDirectFileName Write FDirectFileName;
-
-    {:Indicate after @link(Login) if remote server support resume downloads and
-     uploads.}
-    property CanResume: Boolean read FCanResume;
-
-    {:If true (default value), all transfers is made by passive method.
-     It is safer method for various firewalls.}
-    property PassiveMode: Boolean read FPassiveMode Write FPassiveMode;
-
-    {:Force to listen for dataconnection on standard port (20). Default is @false,
-     dataconnections will be made to any non-standard port reported by PORT FTP
-     command. This setting is not used, if you use passive mode.}
-    property ForceDefaultPort: Boolean read FForceDefaultPort Write FForceDefaultPort;
-
-    {:When is @true, then is disabled EPSV and EPRT support. However without this
-     commands you cannot use IPv6! (Disabling of this commands is needed only
-     when you are behind some crap firewall/NAT.}
-    property ForceOldPort: Boolean read FForceOldPort Write FForceOldPort;
-
-    {:You may set this hook for monitoring FTP commands and replies.}
-    property OnStatus: TFTPStatus read FOnStatus write FOnStatus;
-
-    {:After LIST command is here parsed list of files in given directory.}
-    property FtpList: TFTPList read FFtpList;
-
-    {:if @true (default), then data transfers is in binary mode. If this is set
-     to @false, then ASCII mode is used.}
-    property BinaryMode: Boolean read FBinaryMode Write FBinaryMode;
-
-    {:if is true, then if server support upgrade to SSL/TLS mode, then use them.}
-    property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
-
-    {:if server listen on SSL/TLS port, then you set this to true.}
-    property FullSSL: Boolean read FFullSSL Write FFullSSL;
-
-    {:Signalise, if control channel is in SSL/TLS mode.}
-    property IsTLS: Boolean read FIsTLS;
-
-    {:Signalise, if data transfers is in SSL/TLS mode.}
-    property IsDataTLS: Boolean read FIsDataTLS;
-
-    {:If @true (default), then try to use SSL/TLS on data transfers too.
-     If @false, then SSL/TLS is used only for control connection.}
-    property TLSonData: Boolean read FTLSonData write FTLSonData;
-  end;
-
-{:A very useful function, and example of use can be found in the TFtpSend object.
- Dowload specified file from FTP server to LocalFile.}
-function FtpGetFile(const IP, Port, FileName, LocalFile,
-  User, Pass: string): Boolean;
-
-{:A very useful function, and example of use can be found in the TFtpSend object.
- Upload specified LocalFile to FTP server.}
-function FtpPutFile(const IP, Port, FileName, LocalFile,
-  User, Pass: string): Boolean;
-
-{:A very useful function, and example of use can be found in the TFtpSend object.
- Initiate transfer of file between two FTP servers.}
-function FtpInterServerTransfer(
-  const FromIP, FromPort, FromFile, FromUser, FromPass: string;
-  const ToIP, ToPort, ToFile, ToUser, ToPass: string): Boolean;
-
-implementation
-
-constructor TFTPSend.Create;
-begin
-  inherited Create;
-  FFullResult := TStringList.Create;
-  FDataStream := TMemoryStream.Create;
-  FSock := TTCPBlockSocket.Create;
-  FSock.Owner := self;
-  FSock.ConvertLineEnd := True;
-  FDSock := TTCPBlockSocket.Create;
-  FDSock.Owner := self;
-  FFtpList := TFTPList.Create;
-  FTimeout := 300000;
-  FTargetPort := cFtpProtocol;
-  FUsername := 'anonymous';
-  FPassword := 'anonymous@' + FSock.LocalName;
-  FDirectFile := False;
-  FPassiveMode := True;
-  FForceDefaultPort := False;
-  FForceOldPort := false;
-  FAccount := '';
-  FFWHost := '';
-  FFWPort := cFtpProtocol;
-  FFWUsername := '';
-  FFWPassword := '';
-  FFWMode := 0;
-  FBinaryMode := True;
-  FAutoTLS := False;
-  FFullSSL := False;
-  FIsTLS := False;
-  FIsDataTLS := False;
-  FTLSonData := True;
-end;
-
-destructor TFTPSend.Destroy;
-begin
-  FDSock.Free;
-  FSock.Free;
-  FFTPList.Free;
-  FDataStream.Free;
-  FFullResult.Free;
-  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: AnsiString;
-begin
-  FFullResult.Clear;
-  c := '';
-  repeat
-    s := FSock.RecvString(FTimeout);
-    if c = '' then
-      if length(s) > 3 then
-        if s[4] in [' ', '-'] then
-          c :=Copy(s, 1, 3);
-    FResultString := s;
-    FFullResult.Add(s);
-    DoStatus(True, s);
-    if FSock.LastError <> 0 then
-      Break;
-  until (c <> '') and (Pos(c + ' ', s) = 1);
-  Result := StrToIntDef(c, 0);
-  FResultCode := Result;
-end;
-
-function TFTPSend.FTPCommand(const Value: string): integer;
-begin
-  FSock.Purge;
-  FSock.SendString(Value + CRLF);
-  DoStatus(False, Value);
-  Result := ReadResult;
-end;
-
-// based on idea by Petr Esner <petr.esner@atlas.cz>
-function TFTPSend.Auth(Mode: integer): Boolean;
-const
-  //if not USER <username> then
-  //  if not PASS <password> then
-  //    if not ACCT <account> then ERROR!
-  //OK!
-  Action0: TLogonActions =
-    (0, FTP_OK, 3,
-     1, FTP_OK, 6,
-     2, FTP_OK, FTP_ERR,
-     0, 0, 0, 0, 0, 0, 0, 0, 0);
-
-  //if not USER <FWusername> then
-  //  if not PASS <FWPassword> then ERROR!
-  //if SITE <FTPServer> then ERROR!
-  //if not USER <username> then
-  //  if not PASS <password> then
-  //    if not ACCT <account> then ERROR!
-  //OK!
-  Action1: TLogonActions =
-    (3, 6, 3,
-     4, 6, FTP_ERR,
-     5, FTP_ERR, 9,
-     0, FTP_OK, 12,
-     1, FTP_OK, 15,
-     2, FTP_OK, FTP_ERR);
-
-  //if not USER <FWusername> then
-  //  if not PASS <FWPassword> then ERROR!
-  //if USER <UserName>'@'<FTPServer> then OK!
-  //if not PASS <password> then
-  //  if not ACCT <account> then ERROR!
-  //OK!
-  Action2: TLogonActions =
-    (3, 6, 3,
-     4, 6, FTP_ERR,
-     6, FTP_OK, 9,
-     1, FTP_OK, 12,
-     2, FTP_OK, FTP_ERR,
-     0, 0, 0);
-
-  //if not USER <FWusername> then
-  //  if not PASS <FWPassword> then ERROR!
-  //if not USER <username> then
-  //  if not PASS <password> then
-  //    if not ACCT <account> then ERROR!
-  //OK!
-  Action3: TLogonActions =
-    (3, 6, 3,
-     4, 6, FTP_ERR,
-     0, FTP_OK, 9,
-     1, FTP_OK, 12,
-     2, FTP_OK, FTP_ERR,
-     0, 0, 0);
-
-  //OPEN <FTPserver>
-  //if not USER <username> then
-  //  if not PASS <password> then
-  //    if not ACCT <account> then ERROR!
-  //OK!
-  Action4: TLogonActions =
-    (7, 3, 3,
-     0, FTP_OK, 6,
-     1, FTP_OK, 9,
-     2, FTP_OK, FTP_ERR,
-     0, 0, 0, 0, 0, 0);
-
-  //if USER <UserName>'@'<FTPServer> then OK!
-  //if not PASS <password> then
-  //  if not ACCT <account> then ERROR!
-  //OK!
-  Action5: TLogonActions =
-    (6, FTP_OK, 3,
-     1, FTP_OK, 6,
-     2, FTP_OK, FTP_ERR,
-     0, 0, 0, 0, 0, 0, 0, 0, 0);
-
-  //if not USER <FWUserName>@<FTPServer> then
-  //  if not PASS <FWPassword> then ERROR!
-  //if not USER <username> then
-  //  if not PASS <password> then
-  //    if not ACCT <account> then ERROR!
-  //OK!
-  Action6: TLogonActions =
-    (8, 6, 3,
-     4, 6, FTP_ERR,
-     0, FTP_OK, 9,
-     1, FTP_OK, 12,
-     2, FTP_OK, FTP_ERR,
-     0, 0, 0);
-
-  //if USER <UserName>@<FTPServer> <FWUserName> then ERROR!
-  //if not PASS <password> then
-  //  if not ACCT <account> then ERROR!
-  //OK!
-  Action7: TLogonActions =
-    (9, FTP_ERR, 3,
-     1, FTP_OK, 6,
-     2, FTP_OK, FTP_ERR,
-     0, 0, 0, 0, 0, 0, 0, 0, 0);
-
-  //if not USER <UserName>@<FWUserName>@<FTPServer> then
-  //  if not PASS <Password>@<FWPassword> then
-  //    if not ACCT <account> then ERROR!
-  //OK!
-  Action8: TLogonActions =
-    (10, FTP_OK, 3,
-     11, FTP_OK, 6,
-     2, FTP_OK, FTP_ERR,
-     0, 0, 0, 0, 0, 0, 0, 0, 0);
-var
-  FTPServer: string;
-  LogonActions: TLogonActions;
-  i: integer;
-  s: string;
-  x: integer;
-begin
-  Result := False;
-  if FFWHost = '' then
-    Mode := 0;
-  if (FTargetPort = cFtpProtocol) or (FTargetPort = '21') then
-    FTPServer := FTargetHost
-  else
-    FTPServer := FTargetHost + ':' + FTargetPort;
-  case Mode of
-    -1:
-      LogonActions := CustomLogon;
-    1:
-      LogonActions := Action1;
-    2:
-      LogonActions := Action2;
-    3:
-      LogonActions := Action3;
-    4:
-      LogonActions := Action4;
-    5:
-      LogonActions := Action5;
-    6:
-      LogonActions := Action6;
-    7:
-      LogonActions := Action7;
-    8:
-      LogonActions := Action8;
-  else
-    LogonActions := Action0;
-  end;
-  i := 0;
-  repeat
-    case LogonActions[i] of
-      0:  s := 'USER ' + FUserName;
-      1:  s := 'PASS ' + FPassword;
-      2:  s := 'ACCT ' + FAccount;
-      3:  s := 'USER ' + FFWUserName;
-      4:  s := 'PASS ' + FFWPassword;
-      5:  s := 'SITE ' + FTPServer;
-      6:  s := 'USER ' + FUserName + '@' + FTPServer;
-      7:  s := 'OPEN ' + FTPServer;
-      8:  s := 'USER ' + FFWUserName + '@' + FTPServer;
-      9:  s := 'USER ' + FUserName + '@' + FTPServer + ' ' + FFWUserName;
-      10: s := 'USER ' + FUserName + '@' + FFWUserName + '@' + FTPServer;
-      11: s := 'PASS ' + FPassword + '@' + FFWPassword;
-    end;
-    x := FTPCommand(s);
-    x := x div 100;
-    if (x <> 2) and (x <> 3) then
-      Exit;
-    i := LogonActions[i + x - 1];
-    case i of
-      FTP_ERR:
-        Exit;
-      FTP_OK:
-        begin
-          Result := True;
-          Exit;
-        end;
-    end;
-  until False;
-end;
-
-
-function TFTPSend.Connect: Boolean;
-begin
-  FSock.CloseSocket;
-  FSock.Bind(FIPInterface, cAnyPort);
-  if FSock.LastError = 0 then
-    if FFWHost = '' then
-      FSock.Connect(FTargetHost, FTargetPort)
-    else
-      FSock.Connect(FFWHost, FFWPort);
-  if FSock.LastError = 0 then
-    if FFullSSL then
-      FSock.SSLDoConnect;
-  Result := FSock.LastError = 0;
-end;
-
-function TFTPSend.Login: Boolean;
-var
-  x: integer;
-begin
-  Result := False;
-  FCanResume := False;
-  if not Connect then
-    Exit;
-  FIsTLS := FFullSSL;
-  FIsDataTLS := False;
-  repeat
-    x := ReadResult div 100;
-  until x <> 1;
-  if x <> 2 then
-    Exit;
-  if FAutoTLS and not(FIsTLS) then
-    if (FTPCommand('AUTH TLS') div 100) = 2 then
-    begin
-      FSock.SSLDoConnect;
-      FIsTLS := FSock.LastError = 0;
-      if not FIsTLS then
-      begin
-        Result := False;
-        Exit;
-      end;
-    end;
-  if not Auth(FFWMode) then
-    Exit;
-  if FIsTLS then
-  begin
-    FTPCommand('PBSZ 0');
-    if FTLSonData then
-      FIsDataTLS := (FTPCommand('PROT P') div 100) = 2;
-    if not FIsDataTLS then
-      FTPCommand('PROT C');
-  end;
-  FTPCommand('TYPE I');
-  FTPCommand('STRU F');
-  FTPCommand('MODE S');
-  if FTPCommand('REST 0') = 350 then
-    if FTPCommand('REST 1') = 350 then
-    begin
-      FTPCommand('REST 0');
-      FCanResume := True;
-    end;
-  Result := True;
-end;
-
-function TFTPSend.Logout: Boolean;
-begin
-  Result := (FTPCommand('QUIT') div 100) = 2;
-  FSock.CloseSocket;
-end;
-
-procedure TFTPSend.ParseRemote(Value: string);
-var
-  n: integer;
-  nb, ne: integer;
-  s: string;
-  x: integer;
-begin
-  Value := trim(Value);
-  nb := Pos('(',Value);
-  ne := Pos(')',Value);
-  if (nb = 0) or (ne = 0) then
-  begin
-    nb:=RPos(' ',Value);
-    s:=Copy(Value, nb + 1, Length(Value) - nb);
-  end
-  else
-  begin
-    s:=Copy(Value,nb+1,ne-nb-1);
-  end;
-  for n := 1 to 4 do
-    if n = 1 then
-      FDataIP := Fetch(s, ',')
-    else
-      FDataIP := FDataIP + '.' + Fetch(s, ',');
-  x := StrToIntDef(Fetch(s, ','), 0) * 256;
-  x := x + StrToIntDef(Fetch(s, ','), 0);
-  FDataPort := IntToStr(x);
-end;
-
-procedure TFTPSend.ParseRemoteEPSV(Value: string);
-var
-  n: integer;
-  s, v: AnsiString;
-begin
-  s := SeparateRight(Value, '(');
-  s := Trim(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;
-begin
-  Result := False;
-  if FIsDataTLS then
-    FPassiveMode := True;
-  if FPassiveMode then
-  begin
-    if FSock.IP6used then
-      s := '2'
-    else
-      s := '1';
-    if not(FForceOldPort) and ((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.Bind(FIPInterface, cAnyPort);
-    FDSock.Connect(FDataIP, FDataPort);
-    Result := FDSock.LastError = 0;
-  end
-  else
-  begin
-    FDSock.CloseSocket;
-    if FForceDefaultPort then
-      s := cFtpDataProtocol
-    else
-      s := '0';
-    //data conection from same interface as command connection
-    FDSock.Bind(FSock.GetLocalSinIP, s);
-    if FDSock.LastError <> 0 then
-      Exit;
-    FDSock.SetLinger(True, 10000);
-    FDSock.Listen;
-    FDSock.GetSins;
-    FDataIP := FDSock.GetLocalSinIP;
-    FDataIP := FDSock.ResolveName(FDataIP);
-    FDataPort := IntToStr(FDSock.GetLocalSinPort);
-    if not FForceOldPort then
-    begin
-      if IsIp6(FDataIP) then
-        s := '2'
-      else
-        s := '1';
-      s := 'EPRT |' + s +'|' + FDataIP + '|' + FDataPort + '|';
-      Result := (FTPCommand(s) div 100) = 2;
-    end;
-    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;
-
-function TFTPSend.AcceptDataSocket: Boolean;
-var
-  x: TSocket;
-begin
-  if FPassiveMode then
-    Result := True
-  else
-  begin
-    Result := False;
-    if FDSock.CanRead(FTimeout) then
-    begin
-      x := FDSock.Accept;
-      if not FDSock.UsingSocks then
-        FDSock.CloseSocket;
-      FDSock.Socket := x;
-      Result := True;
-    end;
-  end;
-  if Result and FIsDataTLS then
-  begin
-    FDSock.SSL.Assign(FSock.SSL);
-    FDSock.SSLDoConnect;
-    Result := FDSock.LastError = 0;
-  end;
-end;
-
-function TFTPSend.DataRead(const DestStream: TStream): Boolean;
-var
-  x: integer;
-begin
-  Result := False;
-  try
-    if not AcceptDataSocket then
-      Exit;
-    FDSock.RecvStreamRaw(DestStream, FTimeout);
-    FDSock.CloseSocket;
-    x := ReadResult;
-    Result := (x div 100) = 2;
-  finally
-    FDSock.CloseSocket;
-  end;
-end;
-
-function TFTPSend.DataWrite(const SourceStream: TStream): Boolean;
-var
-  x: integer;
-  b: Boolean;
-begin
-  Result := False;
-  try
-    if not AcceptDataSocket then
-      Exit;
-    FDSock.SendStreamRaw(SourceStream);
-    b := FDSock.LastError = 0;
-    FDSock.CloseSocket;
-    x := ReadResult;
-    Result := b and ((x div 100) = 2);
-  finally
-    FDSock.CloseSocket;
-  end;
-end;
-
-function TFTPSend.List(Directory: string; NameList: Boolean): Boolean;
-var
-  x: integer;
-begin
-  Result := False;
-  FDataStream.Clear;
-  FFTPList.Clear;
-  if Directory <> '' then
-    Directory := ' ' + Directory;
-  FTPCommand('TYPE A');
-  if not DataSocket then
-    Exit;
-  if NameList then
-    x := FTPCommand('NLST' + Directory)
-  else
-    x := FTPCommand('LIST' + Directory);
-  if (x div 100) <> 1 then
-    Exit;
-  Result := DataRead(FDataStream);
-  if (not NameList) and Result then
-  begin
-    FDataStream.Position := 0;
-    FFTPList.Lines.LoadFromStream(FDataStream);
-    FFTPList.ParseLines;
-  end;
-  FDataStream.Position := 0;
-end;
-
-function TFTPSend.RetrieveFile(const FileName: string; Restore: Boolean): Boolean;
-var
-  RetrStream: TStream;
-begin
-  Result := False;
-  if FileName = '' then
-    Exit;
-  if not DataSocket then
-    Exit;
-  Restore := Restore and FCanResume;
-  if FDirectFile then
-    if Restore and FileExists(FDirectFileName) then
-      RetrStream := TFileStream.Create(FDirectFileName,
-        fmOpenReadWrite  or fmShareExclusive)
-    else
-      RetrStream := TFileStream.Create(FDirectFileName,
-        fmCreate or fmShareDenyWrite)
-  else
-    RetrStream := FDataStream;
-  try
-    if FBinaryMode then
-      FTPCommand('TYPE I')
-    else
-      FTPCommand('TYPE A');
-    if Restore then
-    begin
-      RetrStream.Position := RetrStream.Size;
-      if (FTPCommand('REST ' + IntToStr(RetrStream.Size)) div 100) <> 3 then
-        Exit;
-    end
-    else
-      if RetrStream is TMemoryStream then
-        TMemoryStream(RetrStream).Clear;
-    if (FTPCommand('RETR ' + FileName) div 100) <> 1 then
-      Exit;
-    Result := DataRead(RetrStream);
-    if not FDirectFile then
-      RetrStream.Position := 0;
-  finally
-    if FDirectFile then
-      RetrStream.Free;
-  end;
-end;
-
-function TFTPSend.InternalStor(const Command: string; RestoreAt: integer): Boolean;
-var
-  SendStream: TStream;
-  StorSize: integer;
-begin
-  Result := False;
-  if FDirectFile then
-    if not FileExists(FDirectFileName) then
-      Exit
-    else
-      SendStream := TFileStream.Create(FDirectFileName,
-        fmOpenRead or fmShareDenyWrite)
-  else
-    SendStream := FDataStream;
-  try
-    if not DataSocket then
-      Exit;
-    if FBinaryMode then
-      FTPCommand('TYPE I')
-    else
-      FTPCommand('TYPE A');
-    StorSize := SendStream.Size;
-    if not FCanResume then
-      RestoreAt := 0;
-    if (StorSize > 0) and (RestoreAt = StorSize) then
-    begin
-      Result := True;
-      Exit;
-    end;
-    if RestoreAt > StorSize then
-      RestoreAt := 0;
-    FTPCommand('ALLO ' + IntToStr(StorSize - RestoreAt));
-    if FCanResume then
-      if (FTPCommand('REST ' + IntToStr(RestoreAt)) div 100) <> 3 then
-        Exit;
-    SendStream.Position := RestoreAt;
-    if (FTPCommand(Command) div 100) <> 1 then
-      Exit;
-    Result := DataWrite(SendStream);
-  finally
-    if FDirectFile then
-      SendStream.Free;
-  end;
-end;
-
-function TFTPSend.StoreFile(const FileName: string; Restore: Boolean): Boolean;
-var
-  RestoreAt: integer;
-begin
-  Result := False;
-  if FileName = '' then
-    Exit;
-  RestoreAt := 0;
-  Restore := Restore and FCanResume;
-  if Restore then
-  begin
-    RestoreAt := Self.FileSize(FileName);
-    if RestoreAt < 0 then
-      RestoreAt := 0;
-  end;
-  Result := InternalStor('STOR ' + FileName, RestoreAt);
-end;
-
-function TFTPSend.StoreUniqueFile: Boolean;
-begin
-  Result := InternalStor('STOU', 0);
-end;
-
-function TFTPSend.AppendFile(const FileName: string): Boolean;
-begin
-  Result := False;
-  if FileName = '' then
-    Exit;
-  Result := InternalStor('APPE '+FileName, 0);
-end;
-
-function TFTPSend.NoOp: Boolean;
-begin
-  Result := (FTPCommand('NOOP') div 100) = 2;
-end;
-
-function TFTPSend.RenameFile(const OldName, NewName: string): Boolean;
-begin
-  Result := False;
-  if (FTPCommand('RNFR ' + OldName) div 100) <> 3  then
-    Exit;
-  Result := (FTPCommand('RNTO ' + NewName) div 100) = 2;
-end;
-
-function TFTPSend.DeleteFile(const FileName: string): Boolean;
-begin
-  Result := (FTPCommand('DELE ' + FileName) div 100) = 2;
-end;
-
-function TFTPSend.FileSize(const FileName: string): integer;
-var
-  s: string;
-begin
-  Result := -1;
-  if (FTPCommand('SIZE ' + FileName) div 100) = 2 then
-  begin
-    s := Trim(SeparateRight(ResultString, ' '));
-    s := Trim(SeparateLeft(s, ' '));
-    Result := StrToIntDef(s, -1);
-  end;
-end;
-
-function TFTPSend.ChangeWorkingDir(const Directory: string): Boolean;
-begin
-  Result := (FTPCommand('CWD ' + Directory) div 100) = 2;
-end;
-
-function TFTPSend.ChangeToParentDir: Boolean;
-begin
-  Result := (FTPCommand('CDUP') div 100) = 2;
-end;
-
-function TFTPSend.ChangeToRootDir: Boolean;
-begin
-  Result := ChangeWorkingDir('/');
-end;
-
-function TFTPSend.DeleteDir(const Directory: string): Boolean;
-begin
-  Result := (FTPCommand('RMD ' + Directory) div 100) = 2;
-end;
-
-function TFTPSend.CreateDir(const Directory: string): Boolean;
-begin
-  Result := (FTPCommand('MKD ' + Directory) div 100) = 2;
-end;
-
-function TFTPSend.GetCurrentDir: String;
-begin
-  Result := '';
-  if (FTPCommand('PWD') div 100) = 2 then
-  begin
-    Result := SeparateRight(FResultString, '"');
-    Result := Trim(Separateleft(Result, '"'));
-  end;
-end;
-
-procedure TFTPSend.Abort;
-begin
-  FSock.SendString('ABOR' + CRLF);
-  FDSock.StopFlag := True;
-end;
-
-procedure TFTPSend.TelnetAbort;
-begin
-  FSock.SendString(#$FF + #$F4 + #$FF + #$F2);
-  Abort;
-end;
-
-{==============================================================================}
-
-procedure TFTPListRec.Assign(Value: TFTPListRec);
-begin
-  FFileName := Value.FileName;
-  FDirectory := Value.Directory;
-  FReadable := Value.Readable;
-  FFileSize := Value.FileSize;
-  FFileTime := Value.FileTime;
-  FOriginalLine := Value.OriginalLine;
-  FMask := Value.Mask;
-end;
-
-constructor TFTPList.Create;
-begin
-  inherited Create;
-  FList := TList.Create;
-  FLines := TStringList.Create;
-  FMasks := TStringList.Create;
-  FUnparsedLines := TStringList.Create;
-  //various UNIX
-  FMasks.add('pppppppppp $!!!S*$TTT$DD$hh mm ss$YYYY$n*');
-  FMasks.add('pppppppppp $!!!S*$DD$TTT$hh mm ss$YYYY$n*');
-  FMasks.add('pppppppppp $!!!S*$TTT$DD$UUUUU$n*');  //mostly used UNIX format
-  FMasks.add('pppppppppp $!!!S*$DD$TTT$UUUUU$n*');
-  //MacOS
-  FMasks.add('pppppppppp $!!S*$TTT$DD$UUUUU$n*');
-  FMasks.add('pppppppppp $!S*$TTT$DD$UUUUU$n*');
-  //Novell
-  FMasks.add('d            $!S*$TTT$DD$UUUUU$n*');
-  //Windows
-  FMasks.add('MM DD YY  hh mmH !S* n*');
-  FMasks.add('MM DD YY  hh mmH $ d!n*');
-  FMasks.add('MM DD YYYY  hh mmH !S* n*');
-  FMasks.add('MM DD YYYY  hh mmH $ d!n*');
-  FMasks.add('DD MM YYYY  hh mmH !S* n*');
-  FMasks.add('DD MM YYYY  hh mmH $ d!n*');
-  //VMS
-  FMasks.add('v*$  DD TTT YYYY hh mm');
-  FMasks.add('v*$!DD TTT YYYY hh mm');
-  FMasks.add('n*$                 YYYY MM DD hh mm$S*');
-  //AS400
-  FMasks.add('!S*$MM DD YY hh mm ss !n*');
-  FMasks.add('!S*$DD MM YY hh mm ss !n*');
-  FMasks.add('n*!S*$MM DD YY hh mm ss d');
-  FMasks.add('n*!S*$DD MM YY hh mm ss d');
-  //VxWorks
-  FMasks.add('$S*    TTT DD YYYY  hh mm ss $n* $ d');
-  FMasks.add('$S*    TTT DD YYYY  hh mm ss $n*');
-  //Distinct
-  FMasks.add('d    $S*$TTT DD YYYY  hh mm$n*');
-  FMasks.add('d    $S*$TTT DD$hh mm$n*');
-  //PC-NFSD
-  FMasks.add('nnnnnnnn.nnn  dSSSSSSSSSSS MM DD YY  hh mmH');
-  //VOS
-  FMasks.add('-   SSSSS            YY MM DD hh mm ss  n*');
-  FMasks.add('- d=  SSSSS  YY MM DD hh mm ss  n*');
-  //Unissys ClearPath
-  FMasks.add('nnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn               SSSSSSSSS MM DD YYYY hh mm');
-  FMasks.add('n*\x                                               SSSSSSSSS MM DD YYYY hh mm');
-  //IBM
-  FMasks.add('-     SSSSSSSSSSSS           d   MM DD YYYY   hh mm  n*');
-  //OS9
-  FMasks.add('-         YY MM DD hhmm d                        SSSSSSSSS n*');
-  //tandem
-  FMasks.add('nnnnnnnn                   SSSSSSS DD TTT YY hh mm ss');
-  //MVS
-  FMasks.add('-             YYYY MM DD                     SSSSS   d=O n*');
-  //BullGCOS8
-  FMasks.add('             $S* MM DD YY hh mm ss  !n*');
-  FMasks.add('d            $S* MM DD YY           !n*');
-  //BullGCOS7
-  FMasks.add('                                         TTT DD  YYYY n*');
-  FMasks.add('  d                                                   n*');
-end;
-
-destructor TFTPList.Destroy;
-begin
-  Clear;
-  FList.Free;
-  FLines.Free;
-  FMasks.Free;
-  FUnparsedLines.Free;
-  inherited Destroy;
-end;
-
-procedure TFTPList.Clear;
-var
-  n:integer;
-begin
-  for n := 0 to FList.Count - 1 do
-    if Assigned(FList[n]) then
-      TFTPListRec(FList[n]).Free;
-  FList.Clear;
-  FLines.Clear;
-  FUnparsedLines.Clear;
-end;
-
-function TFTPList.Count: integer;
-begin
-  Result := FList.Count;
-end;
-
-function TFTPList.GetListItem(Index: integer): TFTPListRec;
-begin
-  Result := nil;
-  if Index < Count then
-    Result := TFTPListRec(FList[Index]);
-end;
-
-procedure TFTPList.Assign(Value: TFTPList);
-var
-  flr: TFTPListRec;
-  n: integer;
-begin
-  Clear;
-  for n := 0 to Value.Count - 1 do
-  begin
-    flr := TFTPListRec.Create;
-    flr.Assign(Value[n]);
-    Flist.Add(flr);
-  end;
-  Lines.Assign(Value.Lines);
-  Masks.Assign(Value.Masks);
-  UnparsedLines.Assign(Value.UnparsedLines);
-end;
-
-procedure TFTPList.ClearStore;
-begin
-  Monthnames := '';
-  BlockSize := '';
-  DirFlagValue := '';
-  FileName := '';
-  VMSFileName := '';
-  Day := '';
-  Month := '';
-  ThreeMonth := '';
-  YearTime := '';
-  Year := '';
-  Hours := '';
-  HoursModif := '';
-  Minutes := '';
-  Seconds := '';
-  Size := '';
-  Permissions := '';
-  DirFlag := '';
-end;
-
-function TFTPList.ParseByMask(Value, NextValue, Mask: AnsiString): Integer;
-var
-  Ivalue, IMask: integer;
-  MaskC, LastMaskC: AnsiChar;
-  c: AnsiChar;
-  s: string;
-begin
-  ClearStore;
-  Result := 0;
-  if Value = '' then
-    Exit;
-  if Mask = '' then
-    Exit;
-  Ivalue := 1;
-  IMask := 1;
-  Result := 1;
-  LastMaskC := ' ';
-  while Imask <= Length(mask) do
-  begin
-    if (Mask[Imask] <> '*') and (Ivalue > Length(Value)) then
-    begin
-      Result := 0;
-      Exit;
-    end;
-    MaskC := Mask[Imask];
-    if Ivalue > Length(Value) then
-      Exit;
-    c := Value[Ivalue];
-    case MaskC of
-      'n':
-        FileName := FileName + c;
-      'v':
-        VMSFileName := VMSFileName + c;
-      '.':
-        begin
-          if c in ['.', ' '] then
-            FileName := TrimSP(FileName) + '.'
-          else
-          begin
-            Result := 0;
-            Exit;
-          end;
-        end;
-      'D':
-        Day := Day + c;
-      'M':
-        Month := Month + c;
-      'T':
-        ThreeMonth := ThreeMonth + c;
-      'U':
-        YearTime := YearTime + c;
-      'Y':
-        Year := Year + c;
-      'h':
-        Hours := Hours + c;
-      'H':
-        HoursModif := HoursModif + c;
-      'm':
-        Minutes := Minutes + c;
-      's':
-        Seconds := Seconds + c;
-      'S':
-        Size := Size + c;
-      'p':
-        Permissions := Permissions + c;
-      'd':
-        DirFlag := DirFlag + c;
-      'x':
-        if c <> ' ' then
-          begin
-            Result := 0;
-            Exit;
-          end;
-      '*':
-        begin
-          s := '';
-          if LastMaskC in ['n', 'v'] then
-          begin
-            if Imask = Length(Mask) then
-              s := Copy(Value, IValue, Maxint)
-            else
-              while IValue <= Length(Value) do
-              begin
-                if Value[Ivalue] = ' ' then
-                  break;
-                s := s + Value[Ivalue];
-                Inc(Ivalue);
-              end;
-            if LastMaskC = 'n' then
-              FileName := FileName + s
-            else
-              VMSFileName := VMSFileName + s;
-          end
-          else
-          begin
-            while IValue <= Length(Value) do
-            begin
-              if not(Value[Ivalue] in ['0'..'9']) then
-                break;
-              s := s + Value[Ivalue];
-              Inc(Ivalue);
-            end;
-            case LastMaskC of
-              'S':
-                Size := Size + s;
-            end;
-          end;
-          Dec(IValue);
-        end;
-      '!':
-        begin
-          while IValue <= Length(Value) do
-          begin
-            if Value[Ivalue] = ' ' then
-              break;
-            Inc(Ivalue);
-          end;
-          while IValue <= Length(Value) do
-          begin
-            if Value[Ivalue] <> ' ' then
-              break;
-            Inc(Ivalue);
-          end;
-          Dec(IValue);
-        end;
-      '$':
-        begin
-          while IValue <= Length(Value) do
-          begin
-            if not(Value[Ivalue] in [' ', #9]) then
-              break;
-            Inc(Ivalue);
-          end;
-          Dec(IValue);
-        end;
-      '=':
-        begin
-          s := '';
-          case LastmaskC of
-            'S':
-              begin
-                while Imask <= Length(Mask) do
-                begin
-                  if not(Mask[Imask] in ['0'..'9']) then
-                    break;
-                  s := s + Mask[Imask];
-                  Inc(Imask);
-                end;
-                Dec(Imask);
-                BlockSize := s;
-              end;
-            'T':
-              begin
-                Monthnames := Copy(Mask, IMask, 12 * 3);
-                Inc(IMask, 12 * 3);
-              end;
-            'd':
-              begin
-                Inc(Imask);
-                DirFlagValue := Mask[Imask];
-              end;
-          end;
-        end;
-      '\':
-        begin
-          Value := NextValue;
-          IValue := 0;
-          Result := 2;
-        end;
-    end;
-    Inc(Ivalue);
-    Inc(Imask);
-    LastMaskC := MaskC;
-  end;
-end;
-
-function TFTPList.CheckValues: Boolean;
-var
-  x, n: integer;
-begin
-  Result := false;
-  if FileName <> '' then
-  begin
-    if pos('?', VMSFilename) > 0 then
-      Exit;
-    if pos('*', VMSFilename) > 0 then
-      Exit;
-  end;
-  if VMSFileName <> '' then
-    if pos(';', VMSFilename) <= 0 then
-      Exit;
-  if (FileName = '') and (VMSFileName = '') then
-    Exit;
-  if Permissions <> '' then
-  begin
-    if length(Permissions) <> 10 then
-      Exit;
-    for n := 1 to 10 do
-      if not(Permissions[n] in
-        ['a', 'b', 'c', 'd', 'h', 'l', 'p', 'r', 's', 't', 'w', 'x', 'y', '-']) then
-        Exit;
-  end;
-  if Day <> '' then
-  begin
-    Day := TrimSP(Day);
-    x := StrToIntDef(day, -1);
-    if (x < 1) or (x > 31) then
-      Exit;
-  end;
-  if Month <> '' then
-  begin
-    Month := TrimSP(Month);
-    x := StrToIntDef(Month, -1);
-    if (x < 1) or (x > 12) then
-      Exit;
-  end;
-  if Hours <> '' then
-  begin
-    Hours := TrimSP(Hours);
-    x := StrToIntDef(Hours, -1);
-    if (x < 0) or (x > 24) then
-      Exit;
-  end;
-  if HoursModif <> '' then
-  begin
-    if not (HoursModif[1] in ['a', 'A', 'p', 'P']) then
-      Exit;
-  end;
-  if Minutes <> '' then
-  begin
-    Minutes := TrimSP(Minutes);
-    x := StrToIntDef(Minutes, -1);
-    if (x < 0) or (x > 59) then
-      Exit;
-  end;
-  if Seconds <> '' then
-  begin
-    Seconds := TrimSP(Seconds);
-    x := StrToIntDef(Seconds, -1);
-    if (x < 0) or (x > 59) then
-      Exit;
-  end;
-  if Size <> '' then
-  begin
-    Size := TrimSP(Size);
-    for n := 1 to Length(Size) do
-      if not (Size[n] in ['0'..'9']) then
-        Exit;
-  end;
-
-  if length(Monthnames) = (12 * 3) then
-    for n := 1 to 12 do
-      CustomMonthNames[n] := Copy(Monthnames, ((n - 1) * 3) + 1, 3);
-  if ThreeMonth <> '' then
-  begin
-    x := GetMonthNumber(ThreeMonth);
-    if (x = 0) then
-      Exit;
-  end;
-  if YearTime <> '' then
-  begin
-    YearTime := ReplaceString(YearTime, '-', ':');
-    if pos(':', YearTime) > 0 then
-    begin
-      if (GetTimeFromstr(YearTime) = -1) then
-        Exit;
-    end
-    else
-    begin
-      YearTime := TrimSP(YearTime);
-      x := StrToIntDef(YearTime, -1);
-      if (x = -1) then
-        Exit;
-      if (x < 1900) or (x > 2100) then
-        Exit;
-    end;
-  end;
-  if Year <> '' then
-  begin
-    Year := TrimSP(Year);
-    x := StrToIntDef(Year, -1);
-    if (x = -1) then
-      Exit;
-    if Length(Year) = 4 then
-    begin
-      if not((x > 1900) and (x < 2100)) then
-        Exit;
-    end
-    else
-      if Length(Year) = 2 then
-      begin
-        if not((x >= 0) and (x <= 99)) then
-          Exit;
-      end
-      else
-        if Length(Year) = 3 then
-        begin
-          if not((x >= 100) and (x <= 110)) then
-            Exit;
-        end
-        else
-          Exit;
-  end;
-  Result := True;
-end;
-
-procedure TFTPList.FillRecord(const Value: TFTPListRec);
-var
-  s: string;
-  x: integer;
-  myear: Word;
-  mmonth: Word;
-  mday: Word;
-  mhours, mminutes, mseconds: word;
-  n: integer;
-begin
-  s := DirFlagValue;
-  if s = '' then
-    s := 'D';
-  s := Uppercase(s);
-  Value.Directory :=  s = Uppercase(DirFlag);
-  if FileName <> '' then
-    Value.FileName := SeparateLeft(Filename, ' -> ');
-  if VMSFileName <> '' then
-  begin
-    Value.FileName := VMSFilename;
-    Value.Directory := Pos('.DIR;',VMSFilename) > 0;
-  end;
-  Value.FileName := TrimSPRight(Value.FileName);
-  Value.Readable := not Value.Directory;
-  if BlockSize <> '' then
-    x := StrToIntDef(BlockSize, 1)
-  else
-    x := 1;
-  Value.FileSize := x * StrToIntDef(Size, 0);
-
-  DecodeDate(Date,myear,mmonth,mday);
-  mhours := 0;
-  mminutes := 0;
-  mseconds := 0;
-
-  if Day <> '' then
-    mday := StrToIntDef(day, 1);
-  if Month <> '' then
-    mmonth := StrToIntDef(Month, 1);
-  if length(Monthnames) = (12 * 3) then
-    for n := 1 to 12 do
-      CustomMonthNames[n] := Copy(Monthnames, ((n - 1) * 3) + 1, 3);
-  if ThreeMonth <> '' then
-    mmonth := GetMonthNumber(ThreeMonth);
-  if Year <> '' then
-  begin
-    myear := StrToIntDef(Year, 0);
-    if (myear <= 99) and (myear > 50) then
-      myear := myear + 1900;
-    if myear <= 50 then
-      myear := myear + 2000;
-  end;
-  if YearTime <> '' then
-  begin
-    if pos(':', YearTime) > 0 then
-    begin
-      YearTime := TrimSP(YearTime);
-      mhours := StrToIntDef(Separateleft(YearTime, ':'), 0);
-      mminutes := StrToIntDef(SeparateRight(YearTime, ':'), 0);
-      if (Encodedate(myear, mmonth, mday)
-        + EncodeTime(mHours, mminutes, 0, 0)) > now then
-        Dec(mYear);
-    end
-    else
-      myear := StrToIntDef(YearTime, 0);
-  end;
-  if Minutes <> '' then
-    mminutes := StrToIntDef(Minutes, 0);
-  if Seconds <> '' then
-    mseconds := StrToIntDef(Seconds, 0);
-  if Hours <> '' then
-  begin
-    mHours := StrToIntDef(Hours, 0);
-    if HoursModif <> '' then
-      if Uppercase(HoursModif[1]) = 'P' then
-        if mHours <> 12 then
-          mHours := MHours + 12;
-  end;
-  Value.FileTime := Encodedate(myear, mmonth, mday)
-    + EncodeTime(mHours, mminutes, mseconds, 0);
-  if Permissions <> '' then
-  begin
-    Value.Permission := Permissions;
-    Value.Readable := Uppercase(permissions)[2] = 'R';
-    if Uppercase(permissions)[1] = 'D' then
-    begin
-      Value.Directory := True;
-      Value.Readable := false;
-    end
-    else
-      if Uppercase(permissions)[1] = 'L' then
-        Value.Directory := True;
-  end;
-end;
-
-function TFTPList.ParseEPLF(Value: string): Boolean;
-var
-  s, os: string;
-  flr: TFTPListRec;
-begin
-  Result := False;
-  if Value <> '' then
-    if Value[1] = '+' then
-    begin
-      os := Value;
-      Delete(Value, 1, 1);
-      flr := TFTPListRec.create;
-      flr.FileName := SeparateRight(Value, #9);
-      s := Fetch(Value, ',');
-      while s <> '' do
-      begin
-        if s[1] = #9 then
-          Break;
-        case s[1] of
-          '/':
-            flr.Directory := true;
-          'r':
-            flr.Readable := true;
-          's':
-            flr.FileSize := StrToIntDef(Copy(s, 2, Length(s) - 1), 0);
-          'm':
-            flr.FileTime := (StrToIntDef(Copy(s, 2, Length(s) - 1), 0) / 86400)
-              + 25569;
-        end;
-        s := Fetch(Value, ',');
-      end;
-      if flr.FileName <> '' then
-      if (flr.Directory and ((flr.FileName = '.') or (flr.FileName = '..')))
-        or (flr.FileName = '') then
-        flr.free
-      else
-      begin
-        flr.OriginalLine := os;
-        flr.Mask := 'EPLF';
-        Flist.Add(flr);
-        Result := True;
-      end;
-    end;
-end;
-
-procedure TFTPList.ParseLines;
-var
-  flr: TFTPListRec;
-  n, m: Integer;
-  S: string;
-  x: integer;
-  b: Boolean;
-begin
-  n := 0;
-  while n < Lines.Count do
-  begin
-    if n = Lines.Count - 1 then
-      s := ''
-    else
-      s := Lines[n + 1];
-    b := False;
-    x := 0;
-    if ParseEPLF(Lines[n]) then
-    begin
-      b := True;
-      x := 1;
-    end
-    else
-      for m := 0 to Masks.Count - 1 do
-      begin
-        x := ParseByMask(Lines[n], s, Masks[m]);
-        if x > 0 then
-          if CheckValues then
-          begin
-            flr := TFTPListRec.create;
-            FillRecord(flr);
-            flr.OriginalLine := Lines[n];
-            flr.Mask := Masks[m];
-            if flr.Directory and ((flr.FileName = '.') or (flr.FileName = '..')) then
-              flr.free
-            else
-              Flist.Add(flr);
-            b := True;
-            Break;
-          end;
-      end;
-    if not b then
-      FUnparsedLines.Add(Lines[n]);
-    Inc(n);
-    if x > 1 then
-      Inc(n, x - 1);
-  end;
-end;
-
-{==============================================================================}
-
-function FtpGetFile(const IP, Port, FileName, LocalFile,
-  User, Pass: string): Boolean;
-begin
-  Result := False;
-  with TFTPSend.Create do
-  try
-    if User <> '' then
-    begin
-      Username := User;
-      Password := Pass;
-    end;
-    TargetHost := IP;
-    TargetPort := Port;
-    if not Login then
-      Exit;
-    DirectFileName := LocalFile;
-    DirectFile:=True;
-    Result := RetrieveFile(FileName, False);
-    Logout;
-  finally
-    Free;
-  end;
-end;
-
-function FtpPutFile(const IP, Port, FileName, LocalFile,
-  User, Pass: string): Boolean;
-begin
-  Result := False;
-  with TFTPSend.Create do
-  try
-    if User <> '' then
-    begin
-      Username := User;
-      Password := Pass;
-    end;
-    TargetHost := IP;
-    TargetPort := Port;
-    if not Login then
-      Exit;
-    DirectFileName := LocalFile;
-    DirectFile:=True;
-    Result := StoreFile(FileName, False);
-    Logout;
-  finally
-    Free;
-  end;
-end;
-
-function FtpInterServerTransfer(
-  const FromIP, FromPort, FromFile, FromUser, FromPass: string;
-  const ToIP, ToPort, ToFile, ToUser, ToPass: string): Boolean;
-var
-  FromFTP, ToFTP: TFTPSend;
-  s: string;
-  x: integer;
-begin
-  Result := False;
-  FromFTP := TFTPSend.Create;
-  toFTP := TFTPSend.Create;
-  try
-    if FromUser <> '' then
-    begin
-      FromFTP.Username := FromUser;
-      FromFTP.Password := FromPass;
-    end;
-    if ToUser <> '' then
-    begin
-      ToFTP.Username := ToUser;
-      ToFTP.Password := ToPass;
-    end;
-    FromFTP.TargetHost := FromIP;
-    FromFTP.TargetPort := FromPort;
-    ToFTP.TargetHost := ToIP;
-    ToFTP.TargetPort := ToPort;
-    if not FromFTP.Login then
-      Exit;
-    if not ToFTP.Login then
-      Exit;
-    if (FromFTP.FTPCommand('PASV') div 100) <> 2 then
-      Exit;
-    FromFTP.ParseRemote(FromFTP.ResultString);
-    s := ReplaceString(FromFTP.DataIP, '.', ',');
-    s := 'PORT ' + s + ',' + IntToStr(StrToIntDef(FromFTP.DataPort, 0) div 256)
-      + ',' + IntToStr(StrToIntDef(FromFTP.DataPort, 0) mod 256);
-    if (ToFTP.FTPCommand(s) div 100) <> 2 then
-      Exit;
-    x := ToFTP.FTPCommand('RETR ' + FromFile);
-    if (x div 100) <> 1 then
-      Exit;
-    x := FromFTP.FTPCommand('STOR ' + ToFile);
-    if (x div 100) <> 1 then
-      Exit;
-    FromFTP.Timeout := 21600000;
-    x := FromFTP.ReadResult;
-    if (x  div 100) <> 2 then
-      Exit;
-    ToFTP.Timeout := 21600000;
-    x := ToFTP.ReadResult;
-    if (x div 100) <> 2 then
-      Exit;
-    Result := True;
-  finally
-    ToFTP.Free;
-    FromFTP.Free;
-  end;
-end;
-
-end.
+{==============================================================================|
+| Project : Ararat Synapse                                       | 003.005.003 |
+|==============================================================================|
+| Content: FTP client                                                          |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c) 1999-2010.               |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|   Petr Esner <petr.esner@atlas.cz>                                           |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{: @abstract(FTP client protocol)
+
+Used RFC: RFC-959, RFC-2228, RFC-2428
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit ftpsend;
+
+interface
+
+uses
+  SysUtils, Classes,
+  blcksock, synautil, synaip, synsock;
+
+const
+  cFtpProtocol = '21';
+  cFtpDataProtocol = '20';
+
+  {:Terminating value for TLogonActions}
+  FTP_OK = 255;
+  {:Terminating value for TLogonActions}
+  FTP_ERR = 254;
+
+type
+  {:Array for holding definition of logon sequence.}
+  TLogonActions = array [0..17] of byte;
+
+  {:Procedural type for OnStatus event. Sender is calling @link(TFTPSend) object.
+   Value is FTP command or reply to this comand. (if it is reply, Response
+   is @True).}
+  TFTPStatus = procedure(Sender: TObject; Response: Boolean;
+    const Value: string) of object;
+
+  {: @abstract(Object for holding file information) parsed from directory
+   listing of FTP server.}
+  TFTPListRec = class(TObject)
+  private
+    FFileName: String;
+    FDirectory: Boolean;
+    FReadable: Boolean;
+    FFileSize: Longint;
+    FFileTime: TDateTime;
+    FOriginalLine: string;
+    FMask: string;
+    FPermission: String;
+  public
+    {: You can assign another TFTPListRec to this object.}
+    procedure Assign(Value: TFTPListRec); virtual;
+    {:name of file}
+    property FileName: string read FFileName write FFileName;
+    {:if name is subdirectory not file.}
+    property Directory: Boolean read FDirectory write FDirectory;
+    {:if you have rights to read}
+    property Readable: Boolean read FReadable write FReadable;
+    {:size of file in bytes}
+    property FileSize: Longint read FFileSize write FFileSize;
+    {:date and time of file. Local server timezone is used. Any timezone
+     conversions was not done!}
+    property FileTime: TDateTime read FFileTime write FFileTime;
+    {:original unparsed line}
+    property OriginalLine: string read FOriginalLine write FOriginalLine;
+    {:mask what was used for parsing}
+    property Mask: string read FMask write FMask;
+    {:permission string (depending on used mask!)}
+    property Permission: string read FPermission write FPermission;
+  end;
+
+  {:@abstract(This is TList of TFTPListRec objects.)
+   This object is used for holding lististing of all files information in listed
+   directory on FTP server.}
+  TFTPList = class(TObject)
+  protected
+    FList: TList;
+    FLines: TStringList;
+    FMasks: TStringList;
+    FUnparsedLines: TStringList;
+    Monthnames: string;
+    BlockSize: string;
+    DirFlagValue: string;
+    FileName: string;
+    VMSFileName: string;
+    Day: string;
+    Month: string;
+    ThreeMonth: string;
+    YearTime: string;
+    Year: string;
+    Hours: string;
+    HoursModif: Ansistring;
+    Minutes: string;
+    Seconds: string;
+    Size: Ansistring;
+    Permissions: Ansistring;
+    DirFlag: string;
+    function GetListItem(Index: integer): TFTPListRec; virtual;
+    function ParseEPLF(Value: string): Boolean; virtual;
+    procedure ClearStore; virtual;
+    function ParseByMask(Value, NextValue, Mask: ansistring): Integer; virtual;
+    function CheckValues: Boolean; virtual;
+    procedure FillRecord(const Value: TFTPListRec); virtual;
+  public
+    {:Constructor. You not need create this object, it is created by TFTPSend
+     class as their property.}
+    constructor Create;
+    destructor Destroy; override;
+
+    {:Clear list.}
+    procedure Clear; virtual;
+
+    {:count of holded @link(TFTPListRec) objects}
+    function Count: integer; virtual;
+
+    {:Assigns one list to another}
+    procedure Assign(Value: TFTPList); virtual;
+
+    {:try to parse raw directory listing in @link(lines) to list of
+     @link(TFTPListRec).}
+    procedure ParseLines; virtual;
+
+    {:By this property you have access to list of @link(TFTPListRec).
+     This is for compatibility only. Please, use @link(Items) instead.}
+    property List: TList read FList;
+
+    {:By this property you have access to list of @link(TFTPListRec).}
+    property Items[Index: Integer]: TFTPListRec read GetListItem; default;
+
+    {:Set of lines with RAW directory listing for @link(parseLines)}
+    property Lines: TStringList read FLines;
+
+    {:Set of masks for directory listing parser. It is predefined by default,
+    however you can modify it as you need. (for example, you can add your own
+    definition mask.) Mask is same as mask used in TotalCommander.}
+    property Masks: TStringList read FMasks;
+
+    {:After @link(ParseLines) it holding lines what was not sucessfully parsed.}
+    property UnparsedLines: TStringList read FUnparsedLines;
+  end;
+
+  {:@abstract(Implementation of FTP protocol.)
+   Note: Are you missing properties for setting Username and Password? Look to
+   parent @link(TSynaClient) object! (Username and Password have default values
+   for "anonymous" FTP login)
+
+   Are you missing properties for specify server address and port? Look to
+   parent @link(TSynaClient) too!}
+  TFTPSend = class(TSynaClient)
+  protected
+    FOnStatus: TFTPStatus;
+    FSock: TTCPBlockSocket;
+    FDSock: TTCPBlockSocket;
+    FResultCode: Integer;
+    FResultString: string;
+    FFullResult: TStringList;
+    FAccount: string;
+    FFWHost: string;
+    FFWPort: string;
+    FFWUsername: string;
+    FFWPassword: string;
+    FFWMode: integer;
+    FDataStream: TMemoryStream;
+    FDataIP: string;
+    FDataPort: string;
+    FDirectFile: Boolean;
+    FDirectFileName: string;
+    FCanResume: Boolean;
+    FPassiveMode: Boolean;
+    FForceDefaultPort: Boolean;
+    FForceOldPort: Boolean;
+    FFtpList: TFTPList;
+    FBinaryMode: Boolean;
+    FAutoTLS: Boolean;
+    FIsTLS: Boolean;
+    FIsDataTLS: Boolean;
+    FTLSonData: Boolean;
+    FFullSSL: Boolean;
+    function Auth(Mode: integer): Boolean; virtual;
+    function Connect: Boolean; virtual;
+    function InternalStor(const Command: string; RestoreAt: integer): Boolean; virtual;
+    function DataSocket: Boolean; virtual;
+    function AcceptDataSocket: Boolean; virtual;
+    procedure DoStatus(Response: Boolean; const Value: string); virtual;
+  public
+    {:Custom definition of login sequence. You can use this when you set
+     @link(FWMode) to value -1.}
+    CustomLogon: TLogonActions;
+
+    constructor Create;
+    destructor Destroy; override;
+
+    {:Waits and read FTP server response. You need this only in special cases!}
+    function ReadResult: Integer; virtual;
+
+    {:Parse remote side information of data channel from value string (returned
+     by PASV command). This function you need only in special cases!}
+    procedure ParseRemote(Value: string); virtual;
+
+    {:Parse remote side information of data channel from value string (returned
+     by EPSV command). This function you need only in special cases!}
+    procedure ParseRemoteEPSV(Value: string); virtual;
+
+    {:Send Value as FTP command to FTP server. Returned result code is result of
+     this function.
+     This command is good for sending site specific command, or non-standard
+     commands.}
+    function FTPCommand(const Value: string): integer; virtual;
+
+    {:Connect and logon to FTP server. If you specify any FireWall, connect to
+     firewall and throw them connect to FTP server. Login sequence depending on
+     @link(FWMode).}
+    function Login: Boolean; virtual;
+
+    {:Logoff and disconnect from FTP server.}
+    function Logout: Boolean; virtual;
+
+    {:Break current transmission of data. (You can call this method from
+     Sock.OnStatus event, or from another thread.)}
+    procedure Abort; virtual;
+
+    {:Break current transmission of data. It is same as Abort, but it send abort
+     telnet commands prior ABOR FTP command. Some servers need it. (You can call
+     this method from Sock.OnStatus event, or from another thread.)}
+    procedure TelnetAbort; virtual;
+
+    {:Download directory listing of Directory on FTP server. If Directory is
+     empty string, download listing of current working directory.
+     If NameList is @true, download only names of files in directory.
+     (internally use NLST command instead LIST command)
+     If NameList is @false, returned list is also parsed to @link(FTPList)
+     property.}
+    function List(Directory: string; NameList: Boolean): Boolean; virtual;
+
+    {:Read data from FileName on FTP server. If Restore is @true and server
+     supports resume dowloads, download is resumed. (received is only rest
+     of file)}
+    function RetrieveFile(const FileName: string; Restore: Boolean): Boolean; virtual;
+
+    {:Send data to FileName on FTP server. If Restore is @true and server
+     supports resume upload, upload is resumed. (send only rest of file)
+     In this case if remote file is same length as local file, nothing will be
+     done. If remote file is larger then local, resume is disabled and file is
+     transfered from begin!}
+    function StoreFile(const FileName: string; Restore: Boolean): Boolean; virtual;
+
+    {:Send data to FTP server and assing unique name for this file.}
+    function StoreUniqueFile: Boolean; virtual;
+
+    {:Append data to FileName on FTP server.}
+    function AppendFile(const FileName: string): Boolean; virtual;
+
+    {:Rename on FTP server file with OldName to NewName.}
+    function RenameFile(const OldName, NewName: string): Boolean; virtual;
+
+    {:Delete file FileName on FTP server.}
+    function DeleteFile(const FileName: string): Boolean; virtual;
+
+    {:Return size of Filename file on FTP server. If command failed (i.e. not
+     implemented), return -1.}
+    function FileSize(const FileName: string): integer; virtual;
+
+    {:Send NOOP command to FTP server for preserve of disconnect by inactivity
+     timeout.}
+    function NoOp: Boolean; virtual;
+
+    {:Change currect working directory to Directory on FTP server.}
+    function ChangeWorkingDir(const Directory: string): Boolean; virtual;
+
+    {:walk to upper directory on FTP server.}
+    function ChangeToParentDir: Boolean; virtual;
+
+    {:walk to root directory on FTP server. (May not work with all servers properly!)}
+    function ChangeToRootDir: Boolean; virtual;
+
+    {:Delete Directory on FTP server.}
+    function DeleteDir(const Directory: string): Boolean; virtual;
+
+    {:Create Directory on FTP server.}
+    function CreateDir(const Directory: string): Boolean; virtual;
+
+    {:Return current working directory on FTP server.}
+    function GetCurrentDir: String; virtual;
+
+    {:Establish data channel to FTP server and retrieve data.
+     This function you need only in special cases, i.e. when you need to implement
+     some special unsupported FTP command!}
+    function DataRead(const DestStream: TStream): Boolean; virtual;
+
+    {:Establish data channel to FTP server and send data.
+     This function you need only in special cases, i.e. when you need to implement
+     some special unsupported FTP command.}
+    function DataWrite(const SourceStream: TStream): Boolean; virtual;
+  published
+    {:After FTP command contains result number of this operation.}
+    property ResultCode: Integer read FResultCode;
+
+    {:After FTP command contains main line of result.}
+    property ResultString: string read FResultString;
+
+    {:After any FTP command it contains all lines of FTP server reply.}
+    property FullResult: TStringList read FFullResult;
+
+    {:Account information used in some cases inside login sequence.}
+    property Account: string read FAccount Write FAccount;
+
+    {:Address of firewall. If empty string (default), firewall not used.}
+    property FWHost: string read FFWHost Write FFWHost;
+
+    {:port of firewall. standard value is same port as ftp server used. (21)}
+    property FWPort: string read FFWPort Write FFWPort;
+
+    {:Username for login to firewall. (if needed)}
+    property FWUsername: string read FFWUsername Write FFWUsername;
+
+    {:password for login to firewall. (if needed)}
+    property FWPassword: string read FFWPassword Write FFWPassword;
+
+    {:Type of Firewall. Used only if you set some firewall address. Supported
+     predefined firewall login sequences are described by comments in source
+     file where you can see pseudocode decribing each sequence.}
+    property FWMode: integer read FFWMode Write FFWMode;
+
+    {:Socket object used for TCP/IP operation on control channel. Good for
+     seting OnStatus hook, etc.}
+    property Sock: TTCPBlockSocket read FSock;
+
+    {:Socket object used for TCP/IP operation on data channel. Good for seting
+     OnStatus hook, etc.}
+    property DSock: TTCPBlockSocket read FDSock;
+
+    {:If you not use @link(DirectFile) mode, all data transfers is made to or
+     from this stream.}
+    property DataStream: TMemoryStream read FDataStream;
+
+    {:After data connection is established, contains remote side IP of this
+     connection.}
+    property DataIP: string read FDataIP;
+
+    {:After data connection is established, contains remote side port of this
+     connection.}
+    property DataPort: string read FDataPort;
+
+    {:Mode of data handling by data connection. If @False, all data operations
+     are made to or from @link(DataStream) TMemoryStream.
+     If @true, data operations is made directly to file in your disk. (filename
+     is specified by @link(DirectFileName) property.) Dafault is @False!}
+    property DirectFile: Boolean read FDirectFile Write FDirectFile;
+
+    {:Filename for direct disk data operations.}
+    property DirectFileName: string read FDirectFileName Write FDirectFileName;
+
+    {:Indicate after @link(Login) if remote server support resume downloads and
+     uploads.}
+    property CanResume: Boolean read FCanResume;
+
+    {:If true (default value), all transfers is made by passive method.
+     It is safer method for various firewalls.}
+    property PassiveMode: Boolean read FPassiveMode Write FPassiveMode;
+
+    {:Force to listen for dataconnection on standard port (20). Default is @false,
+     dataconnections will be made to any non-standard port reported by PORT FTP
+     command. This setting is not used, if you use passive mode.}
+    property ForceDefaultPort: Boolean read FForceDefaultPort Write FForceDefaultPort;
+
+    {:When is @true, then is disabled EPSV and EPRT support. However without this
+     commands you cannot use IPv6! (Disabling of this commands is needed only
+     when you are behind some crap firewall/NAT.}
+    property ForceOldPort: Boolean read FForceOldPort Write FForceOldPort;
+
+    {:You may set this hook for monitoring FTP commands and replies.}
+    property OnStatus: TFTPStatus read FOnStatus write FOnStatus;
+
+    {:After LIST command is here parsed list of files in given directory.}
+    property FtpList: TFTPList read FFtpList;
+
+    {:if @true (default), then data transfers is in binary mode. If this is set
+     to @false, then ASCII mode is used.}
+    property BinaryMode: Boolean read FBinaryMode Write FBinaryMode;
+
+    {:if is true, then if server support upgrade to SSL/TLS mode, then use them.}
+    property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
+
+    {:if server listen on SSL/TLS port, then you set this to true.}
+    property FullSSL: Boolean read FFullSSL Write FFullSSL;
+
+    {:Signalise, if control channel is in SSL/TLS mode.}
+    property IsTLS: Boolean read FIsTLS;
+
+    {:Signalise, if data transfers is in SSL/TLS mode.}
+    property IsDataTLS: Boolean read FIsDataTLS;
+
+    {:If @true (default), then try to use SSL/TLS on data transfers too.
+     If @false, then SSL/TLS is used only for control connection.}
+    property TLSonData: Boolean read FTLSonData write FTLSonData;
+  end;
+
+{:A very useful function, and example of use can be found in the TFtpSend object.
+ Dowload specified file from FTP server to LocalFile.}
+function FtpGetFile(const IP, Port, FileName, LocalFile,
+  User, Pass: string): Boolean;
+
+{:A very useful function, and example of use can be found in the TFtpSend object.
+ Upload specified LocalFile to FTP server.}
+function FtpPutFile(const IP, Port, FileName, LocalFile,
+  User, Pass: string): Boolean;
+
+{:A very useful function, and example of use can be found in the TFtpSend object.
+ Initiate transfer of file between two FTP servers.}
+function FtpInterServerTransfer(
+  const FromIP, FromPort, FromFile, FromUser, FromPass: string;
+  const ToIP, ToPort, ToFile, ToUser, ToPass: string): Boolean;
+
+implementation
+
+constructor TFTPSend.Create;
+begin
+  inherited Create;
+  FFullResult := TStringList.Create;
+  FDataStream := TMemoryStream.Create;
+  FSock := TTCPBlockSocket.Create;
+  FSock.Owner := self;
+  FSock.ConvertLineEnd := True;
+  FDSock := TTCPBlockSocket.Create;
+  FDSock.Owner := self;
+  FFtpList := TFTPList.Create;
+  FTimeout := 300000;
+  FTargetPort := cFtpProtocol;
+  FUsername := 'anonymous';
+  FPassword := 'anonymous@' + FSock.LocalName;
+  FDirectFile := False;
+  FPassiveMode := True;
+  FForceDefaultPort := False;
+  FForceOldPort := false;
+  FAccount := '';
+  FFWHost := '';
+  FFWPort := cFtpProtocol;
+  FFWUsername := '';
+  FFWPassword := '';
+  FFWMode := 0;
+  FBinaryMode := True;
+  FAutoTLS := False;
+  FFullSSL := False;
+  FIsTLS := False;
+  FIsDataTLS := False;
+  FTLSonData := True;
+end;
+
+destructor TFTPSend.Destroy;
+begin
+  FDSock.Free;
+  FSock.Free;
+  FFTPList.Free;
+  FDataStream.Free;
+  FFullResult.Free;
+  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: AnsiString;
+begin
+  FFullResult.Clear;
+  c := '';
+  repeat
+    s := FSock.RecvString(FTimeout);
+    if c = '' then
+      if length(s) > 3 then
+        if s[4] in [' ', '-'] then
+          c :=Copy(s, 1, 3);
+    FResultString := s;
+    FFullResult.Add(s);
+    DoStatus(True, s);
+    if FSock.LastError <> 0 then
+      Break;
+  until (c <> '') and (Pos(c + ' ', s) = 1);
+  Result := StrToIntDef(c, 0);
+  FResultCode := Result;
+end;
+
+function TFTPSend.FTPCommand(const Value: string): integer;
+begin
+  FSock.Purge;
+  FSock.SendString(Value + CRLF);
+  DoStatus(False, Value);
+  Result := ReadResult;
+end;
+
+// based on idea by Petr Esner <petr.esner@atlas.cz>
+function TFTPSend.Auth(Mode: integer): Boolean;
+const
+  //if not USER <username> then
+  //  if not PASS <password> then
+  //    if not ACCT <account> then ERROR!
+  //OK!
+  Action0: TLogonActions =
+    (0, FTP_OK, 3,
+     1, FTP_OK, 6,
+     2, FTP_OK, FTP_ERR,
+     0, 0, 0, 0, 0, 0, 0, 0, 0);
+
+  //if not USER <FWusername> then
+  //  if not PASS <FWPassword> then ERROR!
+  //if SITE <FTPServer> then ERROR!
+  //if not USER <username> then
+  //  if not PASS <password> then
+  //    if not ACCT <account> then ERROR!
+  //OK!
+  Action1: TLogonActions =
+    (3, 6, 3,
+     4, 6, FTP_ERR,
+     5, FTP_ERR, 9,
+     0, FTP_OK, 12,
+     1, FTP_OK, 15,
+     2, FTP_OK, FTP_ERR);
+
+  //if not USER <FWusername> then
+  //  if not PASS <FWPassword> then ERROR!
+  //if USER <UserName>'@'<FTPServer> then OK!
+  //if not PASS <password> then
+  //  if not ACCT <account> then ERROR!
+  //OK!
+  Action2: TLogonActions =
+    (3, 6, 3,
+     4, 6, FTP_ERR,
+     6, FTP_OK, 9,
+     1, FTP_OK, 12,
+     2, FTP_OK, FTP_ERR,
+     0, 0, 0);
+
+  //if not USER <FWusername> then
+  //  if not PASS <FWPassword> then ERROR!
+  //if not USER <username> then
+  //  if not PASS <password> then
+  //    if not ACCT <account> then ERROR!
+  //OK!
+  Action3: TLogonActions =
+    (3, 6, 3,
+     4, 6, FTP_ERR,
+     0, FTP_OK, 9,
+     1, FTP_OK, 12,
+     2, FTP_OK, FTP_ERR,
+     0, 0, 0);
+
+  //OPEN <FTPserver>
+  //if not USER <username> then
+  //  if not PASS <password> then
+  //    if not ACCT <account> then ERROR!
+  //OK!
+  Action4: TLogonActions =
+    (7, 3, 3,
+     0, FTP_OK, 6,
+     1, FTP_OK, 9,
+     2, FTP_OK, FTP_ERR,
+     0, 0, 0, 0, 0, 0);
+
+  //if USER <UserName>'@'<FTPServer> then OK!
+  //if not PASS <password> then
+  //  if not ACCT <account> then ERROR!
+  //OK!
+  Action5: TLogonActions =
+    (6, FTP_OK, 3,
+     1, FTP_OK, 6,
+     2, FTP_OK, FTP_ERR,
+     0, 0, 0, 0, 0, 0, 0, 0, 0);
+
+  //if not USER <FWUserName>@<FTPServer> then
+  //  if not PASS <FWPassword> then ERROR!
+  //if not USER <username> then
+  //  if not PASS <password> then
+  //    if not ACCT <account> then ERROR!
+  //OK!
+  Action6: TLogonActions =
+    (8, 6, 3,
+     4, 6, FTP_ERR,
+     0, FTP_OK, 9,
+     1, FTP_OK, 12,
+     2, FTP_OK, FTP_ERR,
+     0, 0, 0);
+
+  //if USER <UserName>@<FTPServer> <FWUserName> then ERROR!
+  //if not PASS <password> then
+  //  if not ACCT <account> then ERROR!
+  //OK!
+  Action7: TLogonActions =
+    (9, FTP_ERR, 3,
+     1, FTP_OK, 6,
+     2, FTP_OK, FTP_ERR,
+     0, 0, 0, 0, 0, 0, 0, 0, 0);
+
+  //if not USER <UserName>@<FWUserName>@<FTPServer> then
+  //  if not PASS <Password>@<FWPassword> then
+  //    if not ACCT <account> then ERROR!
+  //OK!
+  Action8: TLogonActions =
+    (10, FTP_OK, 3,
+     11, FTP_OK, 6,
+     2, FTP_OK, FTP_ERR,
+     0, 0, 0, 0, 0, 0, 0, 0, 0);
+var
+  FTPServer: string;
+  LogonActions: TLogonActions;
+  i: integer;
+  s: string;
+  x: integer;
+begin
+  Result := False;
+  if FFWHost = '' then
+    Mode := 0;
+  if (FTargetPort = cFtpProtocol) or (FTargetPort = '21') then
+    FTPServer := FTargetHost
+  else
+    FTPServer := FTargetHost + ':' + FTargetPort;
+  case Mode of
+    -1:
+      LogonActions := CustomLogon;
+    1:
+      LogonActions := Action1;
+    2:
+      LogonActions := Action2;
+    3:
+      LogonActions := Action3;
+    4:
+      LogonActions := Action4;
+    5:
+      LogonActions := Action5;
+    6:
+      LogonActions := Action6;
+    7:
+      LogonActions := Action7;
+    8:
+      LogonActions := Action8;
+  else
+    LogonActions := Action0;
+  end;
+  i := 0;
+  repeat
+    case LogonActions[i] of
+      0:  s := 'USER ' + FUserName;
+      1:  s := 'PASS ' + FPassword;
+      2:  s := 'ACCT ' + FAccount;
+      3:  s := 'USER ' + FFWUserName;
+      4:  s := 'PASS ' + FFWPassword;
+      5:  s := 'SITE ' + FTPServer;
+      6:  s := 'USER ' + FUserName + '@' + FTPServer;
+      7:  s := 'OPEN ' + FTPServer;
+      8:  s := 'USER ' + FFWUserName + '@' + FTPServer;
+      9:  s := 'USER ' + FUserName + '@' + FTPServer + ' ' + FFWUserName;
+      10: s := 'USER ' + FUserName + '@' + FFWUserName + '@' + FTPServer;
+      11: s := 'PASS ' + FPassword + '@' + FFWPassword;
+    end;
+    x := FTPCommand(s);
+    x := x div 100;
+    if (x <> 2) and (x <> 3) then
+      Exit;
+    i := LogonActions[i + x - 1];
+    case i of
+      FTP_ERR:
+        Exit;
+      FTP_OK:
+        begin
+          Result := True;
+          Exit;
+        end;
+    end;
+  until False;
+end;
+
+
+function TFTPSend.Connect: Boolean;
+begin
+  FSock.CloseSocket;
+  FSock.Bind(FIPInterface, cAnyPort);
+  if FSock.LastError = 0 then
+    if FFWHost = '' then
+      FSock.Connect(FTargetHost, FTargetPort)
+    else
+      FSock.Connect(FFWHost, FFWPort);
+  if FSock.LastError = 0 then
+    if FFullSSL then
+      FSock.SSLDoConnect;
+  Result := FSock.LastError = 0;
+end;
+
+function TFTPSend.Login: Boolean;
+var
+  x: integer;
+begin
+  Result := False;
+  FCanResume := False;
+  if not Connect then
+    Exit;
+  FIsTLS := FFullSSL;
+  FIsDataTLS := False;
+  repeat
+    x := ReadResult div 100;
+  until x <> 1;
+  if x <> 2 then
+    Exit;
+  if FAutoTLS and not(FIsTLS) then
+    if (FTPCommand('AUTH TLS') div 100) = 2 then
+    begin
+      FSock.SSLDoConnect;
+      FIsTLS := FSock.LastError = 0;
+      if not FIsTLS then
+      begin
+        Result := False;
+        Exit;
+      end;
+    end;
+  if not Auth(FFWMode) then
+    Exit;
+  if FIsTLS then
+  begin
+    FTPCommand('PBSZ 0');
+    if FTLSonData then
+      FIsDataTLS := (FTPCommand('PROT P') div 100) = 2;
+    if not FIsDataTLS then
+      FTPCommand('PROT C');
+  end;
+  FTPCommand('TYPE I');
+  FTPCommand('STRU F');
+  FTPCommand('MODE S');
+  if FTPCommand('REST 0') = 350 then
+    if FTPCommand('REST 1') = 350 then
+    begin
+      FTPCommand('REST 0');
+      FCanResume := True;
+    end;
+  Result := True;
+end;
+
+function TFTPSend.Logout: Boolean;
+begin
+  Result := (FTPCommand('QUIT') div 100) = 2;
+  FSock.CloseSocket;
+end;
+
+procedure TFTPSend.ParseRemote(Value: string);
+var
+  n: integer;
+  nb, ne: integer;
+  s: string;
+  x: integer;
+begin
+  Value := trim(Value);
+  nb := Pos('(',Value);
+  ne := Pos(')',Value);
+  if (nb = 0) or (ne = 0) then
+  begin
+    nb:=RPos(' ',Value);
+    s:=Copy(Value, nb + 1, Length(Value) - nb);
+  end
+  else
+  begin
+    s:=Copy(Value,nb+1,ne-nb-1);
+  end;
+  for n := 1 to 4 do
+    if n = 1 then
+      FDataIP := Fetch(s, ',')
+    else
+      FDataIP := FDataIP + '.' + Fetch(s, ',');
+  x := StrToIntDef(Fetch(s, ','), 0) * 256;
+  x := x + StrToIntDef(Fetch(s, ','), 0);
+  FDataPort := IntToStr(x);
+end;
+
+procedure TFTPSend.ParseRemoteEPSV(Value: string);
+var
+  n: integer;
+  s, v: AnsiString;
+begin
+  s := SeparateRight(Value, '(');
+  s := Trim(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;
+begin
+  Result := False;
+  if FIsDataTLS then
+    FPassiveMode := True;
+  if FPassiveMode then
+  begin
+    if FSock.IP6used then
+      s := '2'
+    else
+      s := '1';
+    if not(FForceOldPort) and ((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.Bind(FIPInterface, cAnyPort);
+    FDSock.Connect(FDataIP, FDataPort);
+    Result := FDSock.LastError = 0;
+  end
+  else
+  begin
+    FDSock.CloseSocket;
+    if FForceDefaultPort then
+      s := cFtpDataProtocol
+    else
+      s := '0';
+    //data conection from same interface as command connection
+    FDSock.Bind(FSock.GetLocalSinIP, s);
+    if FDSock.LastError <> 0 then
+      Exit;
+    FDSock.SetLinger(True, 10000);
+    FDSock.Listen;
+    FDSock.GetSins;
+    FDataIP := FDSock.GetLocalSinIP;
+    FDataIP := FDSock.ResolveName(FDataIP);
+    FDataPort := IntToStr(FDSock.GetLocalSinPort);
+    if not FForceOldPort then
+    begin
+      if IsIp6(FDataIP) then
+        s := '2'
+      else
+        s := '1';
+      s := 'EPRT |' + s +'|' + FDataIP + '|' + FDataPort + '|';
+      Result := (FTPCommand(s) div 100) = 2;
+    end;
+    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;
+
+function TFTPSend.AcceptDataSocket: Boolean;
+var
+  x: TSocket;
+begin
+  if FPassiveMode then
+    Result := True
+  else
+  begin
+    Result := False;
+    if FDSock.CanRead(FTimeout) then
+    begin
+      x := FDSock.Accept;
+      if not FDSock.UsingSocks then
+        FDSock.CloseSocket;
+      FDSock.Socket := x;
+      Result := True;
+    end;
+  end;
+  if Result and FIsDataTLS then
+  begin
+    FDSock.SSL.Assign(FSock.SSL);
+    FDSock.SSLDoConnect;
+    Result := FDSock.LastError = 0;
+  end;
+end;
+
+function TFTPSend.DataRead(const DestStream: TStream): Boolean;
+var
+  x: integer;
+begin
+  Result := False;
+  try
+    if not AcceptDataSocket then
+      Exit;
+    FDSock.RecvStreamRaw(DestStream, FTimeout);
+    FDSock.CloseSocket;
+    x := ReadResult;
+    Result := (x div 100) = 2;
+  finally
+    FDSock.CloseSocket;
+  end;
+end;
+
+function TFTPSend.DataWrite(const SourceStream: TStream): Boolean;
+var
+  x: integer;
+  b: Boolean;
+begin
+  Result := False;
+  try
+    if not AcceptDataSocket then
+      Exit;
+    FDSock.SendStreamRaw(SourceStream);
+    b := FDSock.LastError = 0;
+    FDSock.CloseSocket;
+    x := ReadResult;
+    Result := b and ((x div 100) = 2);
+  finally
+    FDSock.CloseSocket;
+  end;
+end;
+
+function TFTPSend.List(Directory: string; NameList: Boolean): Boolean;
+var
+  x: integer;
+begin
+  Result := False;
+  FDataStream.Clear;
+  FFTPList.Clear;
+  if Directory <> '' then
+    Directory := ' ' + Directory;
+  FTPCommand('TYPE A');
+  if not DataSocket then
+    Exit;
+  if NameList then
+    x := FTPCommand('NLST' + Directory)
+  else
+    x := FTPCommand('LIST' + Directory);
+  if (x div 100) <> 1 then
+    Exit;
+  Result := DataRead(FDataStream);
+  if (not NameList) and Result then
+  begin
+    FDataStream.Position := 0;
+    FFTPList.Lines.LoadFromStream(FDataStream);
+    FFTPList.ParseLines;
+  end;
+  FDataStream.Position := 0;
+end;
+
+function TFTPSend.RetrieveFile(const FileName: string; Restore: Boolean): Boolean;
+var
+  RetrStream: TStream;
+begin
+  Result := False;
+  if FileName = '' then
+    Exit;
+  if not DataSocket then
+    Exit;
+  Restore := Restore and FCanResume;
+  if FDirectFile then
+    if Restore and FileExists(FDirectFileName) then
+      RetrStream := TFileStream.Create(FDirectFileName,
+        fmOpenReadWrite  or fmShareExclusive)
+    else
+      RetrStream := TFileStream.Create(FDirectFileName,
+        fmCreate or fmShareDenyWrite)
+  else
+    RetrStream := FDataStream;
+  try
+    if FBinaryMode then
+      FTPCommand('TYPE I')
+    else
+      FTPCommand('TYPE A');
+    if Restore then
+    begin
+      RetrStream.Position := RetrStream.Size;
+      if (FTPCommand('REST ' + IntToStr(RetrStream.Size)) div 100) <> 3 then
+        Exit;
+    end
+    else
+      if RetrStream is TMemoryStream then
+        TMemoryStream(RetrStream).Clear;
+    if (FTPCommand('RETR ' + FileName) div 100) <> 1 then
+      Exit;
+    Result := DataRead(RetrStream);
+    if not FDirectFile then
+      RetrStream.Position := 0;
+  finally
+    if FDirectFile then
+      RetrStream.Free;
+  end;
+end;
+
+function TFTPSend.InternalStor(const Command: string; RestoreAt: integer): Boolean;
+var
+  SendStream: TStream;
+  StorSize: integer;
+begin
+  Result := False;
+  if FDirectFile then
+    if not FileExists(FDirectFileName) then
+      Exit
+    else
+      SendStream := TFileStream.Create(FDirectFileName,
+        fmOpenRead or fmShareDenyWrite)
+  else
+    SendStream := FDataStream;
+  try
+    if not DataSocket then
+      Exit;
+    if FBinaryMode then
+      FTPCommand('TYPE I')
+    else
+      FTPCommand('TYPE A');
+    StorSize := SendStream.Size;
+    if not FCanResume then
+      RestoreAt := 0;
+    if (StorSize > 0) and (RestoreAt = StorSize) then
+    begin
+      Result := True;
+      Exit;
+    end;
+    if RestoreAt > StorSize then
+      RestoreAt := 0;
+    FTPCommand('ALLO ' + IntToStr(StorSize - RestoreAt));
+    if FCanResume then
+      if (FTPCommand('REST ' + IntToStr(RestoreAt)) div 100) <> 3 then
+        Exit;
+    SendStream.Position := RestoreAt;
+    if (FTPCommand(Command) div 100) <> 1 then
+      Exit;
+    Result := DataWrite(SendStream);
+  finally
+    if FDirectFile then
+      SendStream.Free;
+  end;
+end;
+
+function TFTPSend.StoreFile(const FileName: string; Restore: Boolean): Boolean;
+var
+  RestoreAt: integer;
+begin
+  Result := False;
+  if FileName = '' then
+    Exit;
+  RestoreAt := 0;
+  Restore := Restore and FCanResume;
+  if Restore then
+  begin
+    RestoreAt := Self.FileSize(FileName);
+    if RestoreAt < 0 then
+      RestoreAt := 0;
+  end;
+  Result := InternalStor('STOR ' + FileName, RestoreAt);
+end;
+
+function TFTPSend.StoreUniqueFile: Boolean;
+begin
+  Result := InternalStor('STOU', 0);
+end;
+
+function TFTPSend.AppendFile(const FileName: string): Boolean;
+begin
+  Result := False;
+  if FileName = '' then
+    Exit;
+  Result := InternalStor('APPE '+FileName, 0);
+end;
+
+function TFTPSend.NoOp: Boolean;
+begin
+  Result := (FTPCommand('NOOP') div 100) = 2;
+end;
+
+function TFTPSend.RenameFile(const OldName, NewName: string): Boolean;
+begin
+  Result := False;
+  if (FTPCommand('RNFR ' + OldName) div 100) <> 3  then
+    Exit;
+  Result := (FTPCommand('RNTO ' + NewName) div 100) = 2;
+end;
+
+function TFTPSend.DeleteFile(const FileName: string): Boolean;
+begin
+  Result := (FTPCommand('DELE ' + FileName) div 100) = 2;
+end;
+
+function TFTPSend.FileSize(const FileName: string): integer;
+var
+  s: string;
+begin
+  Result := -1;
+  if (FTPCommand('SIZE ' + FileName) div 100) = 2 then
+  begin
+    s := Trim(SeparateRight(ResultString, ' '));
+    s := Trim(SeparateLeft(s, ' '));
+    Result := StrToIntDef(s, -1);
+  end;
+end;
+
+function TFTPSend.ChangeWorkingDir(const Directory: string): Boolean;
+begin
+  Result := (FTPCommand('CWD ' + Directory) div 100) = 2;
+end;
+
+function TFTPSend.ChangeToParentDir: Boolean;
+begin
+  Result := (FTPCommand('CDUP') div 100) = 2;
+end;
+
+function TFTPSend.ChangeToRootDir: Boolean;
+begin
+  Result := ChangeWorkingDir('/');
+end;
+
+function TFTPSend.DeleteDir(const Directory: string): Boolean;
+begin
+  Result := (FTPCommand('RMD ' + Directory) div 100) = 2;
+end;
+
+function TFTPSend.CreateDir(const Directory: string): Boolean;
+begin
+  Result := (FTPCommand('MKD ' + Directory) div 100) = 2;
+end;
+
+function TFTPSend.GetCurrentDir: String;
+begin
+  Result := '';
+  if (FTPCommand('PWD') div 100) = 2 then
+  begin
+    Result := SeparateRight(FResultString, '"');
+    Result := Trim(Separateleft(Result, '"'));
+  end;
+end;
+
+procedure TFTPSend.Abort;
+begin
+  FSock.SendString('ABOR' + CRLF);
+  FDSock.StopFlag := True;
+end;
+
+procedure TFTPSend.TelnetAbort;
+begin
+  FSock.SendString(#$FF + #$F4 + #$FF + #$F2);
+  Abort;
+end;
+
+{==============================================================================}
+
+procedure TFTPListRec.Assign(Value: TFTPListRec);
+begin
+  FFileName := Value.FileName;
+  FDirectory := Value.Directory;
+  FReadable := Value.Readable;
+  FFileSize := Value.FileSize;
+  FFileTime := Value.FileTime;
+  FOriginalLine := Value.OriginalLine;
+  FMask := Value.Mask;
+end;
+
+constructor TFTPList.Create;
+begin
+  inherited Create;
+  FList := TList.Create;
+  FLines := TStringList.Create;
+  FMasks := TStringList.Create;
+  FUnparsedLines := TStringList.Create;
+  //various UNIX
+  FMasks.add('pppppppppp $!!!S*$TTT$DD$hh mm ss$YYYY$n*');
+  FMasks.add('pppppppppp $!!!S*$DD$TTT$hh mm ss$YYYY$n*');
+  FMasks.add('pppppppppp $!!!S*$TTT$DD$UUUUU$n*');  //mostly used UNIX format
+  FMasks.add('pppppppppp $!!!S*$DD$TTT$UUUUU$n*');
+  //MacOS
+  FMasks.add('pppppppppp $!!S*$TTT$DD$UUUUU$n*');
+  FMasks.add('pppppppppp $!S*$TTT$DD$UUUUU$n*');
+  //Novell
+  FMasks.add('d            $!S*$TTT$DD$UUUUU$n*');
+  //Windows
+  FMasks.add('MM DD YY  hh mmH !S* n*');
+  FMasks.add('MM DD YY  hh mmH $ d!n*');
+  FMasks.add('MM DD YYYY  hh mmH !S* n*');
+  FMasks.add('MM DD YYYY  hh mmH $ d!n*');
+  FMasks.add('DD MM YYYY  hh mmH !S* n*');
+  FMasks.add('DD MM YYYY  hh mmH $ d!n*');
+  //VMS
+  FMasks.add('v*$  DD TTT YYYY hh mm');
+  FMasks.add('v*$!DD TTT YYYY hh mm');
+  FMasks.add('n*$                 YYYY MM DD hh mm$S*');
+  //AS400
+  FMasks.add('!S*$MM DD YY hh mm ss !n*');
+  FMasks.add('!S*$DD MM YY hh mm ss !n*');
+  FMasks.add('n*!S*$MM DD YY hh mm ss d');
+  FMasks.add('n*!S*$DD MM YY hh mm ss d');
+  //VxWorks
+  FMasks.add('$S*    TTT DD YYYY  hh mm ss $n* $ d');
+  FMasks.add('$S*    TTT DD YYYY  hh mm ss $n*');
+  //Distinct
+  FMasks.add('d    $S*$TTT DD YYYY  hh mm$n*');
+  FMasks.add('d    $S*$TTT DD$hh mm$n*');
+  //PC-NFSD
+  FMasks.add('nnnnnnnn.nnn  dSSSSSSSSSSS MM DD YY  hh mmH');
+  //VOS
+  FMasks.add('-   SSSSS            YY MM DD hh mm ss  n*');
+  FMasks.add('- d=  SSSSS  YY MM DD hh mm ss  n*');
+  //Unissys ClearPath
+  FMasks.add('nnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn               SSSSSSSSS MM DD YYYY hh mm');
+  FMasks.add('n*\x                                               SSSSSSSSS MM DD YYYY hh mm');
+  //IBM
+  FMasks.add('-     SSSSSSSSSSSS           d   MM DD YYYY   hh mm  n*');
+  //OS9
+  FMasks.add('-         YY MM DD hhmm d                        SSSSSSSSS n*');
+  //tandem
+  FMasks.add('nnnnnnnn                   SSSSSSS DD TTT YY hh mm ss');
+  //MVS
+  FMasks.add('-             YYYY MM DD                     SSSSS   d=O n*');
+  //BullGCOS8
+  FMasks.add('             $S* MM DD YY hh mm ss  !n*');
+  FMasks.add('d            $S* MM DD YY           !n*');
+  //BullGCOS7
+  FMasks.add('                                         TTT DD  YYYY n*');
+  FMasks.add('  d                                                   n*');
+end;
+
+destructor TFTPList.Destroy;
+begin
+  Clear;
+  FList.Free;
+  FLines.Free;
+  FMasks.Free;
+  FUnparsedLines.Free;
+  inherited Destroy;
+end;
+
+procedure TFTPList.Clear;
+var
+  n:integer;
+begin
+  for n := 0 to FList.Count - 1 do
+    if Assigned(FList[n]) then
+      TFTPListRec(FList[n]).Free;
+  FList.Clear;
+  FLines.Clear;
+  FUnparsedLines.Clear;
+end;
+
+function TFTPList.Count: integer;
+begin
+  Result := FList.Count;
+end;
+
+function TFTPList.GetListItem(Index: integer): TFTPListRec;
+begin
+  Result := nil;
+  if Index < Count then
+    Result := TFTPListRec(FList[Index]);
+end;
+
+procedure TFTPList.Assign(Value: TFTPList);
+var
+  flr: TFTPListRec;
+  n: integer;
+begin
+  Clear;
+  for n := 0 to Value.Count - 1 do
+  begin
+    flr := TFTPListRec.Create;
+    flr.Assign(Value[n]);
+    Flist.Add(flr);
+  end;
+  Lines.Assign(Value.Lines);
+  Masks.Assign(Value.Masks);
+  UnparsedLines.Assign(Value.UnparsedLines);
+end;
+
+procedure TFTPList.ClearStore;
+begin
+  Monthnames := '';
+  BlockSize := '';
+  DirFlagValue := '';
+  FileName := '';
+  VMSFileName := '';
+  Day := '';
+  Month := '';
+  ThreeMonth := '';
+  YearTime := '';
+  Year := '';
+  Hours := '';
+  HoursModif := '';
+  Minutes := '';
+  Seconds := '';
+  Size := '';
+  Permissions := '';
+  DirFlag := '';
+end;
+
+function TFTPList.ParseByMask(Value, NextValue, Mask: AnsiString): Integer;
+var
+  Ivalue, IMask: integer;
+  MaskC, LastMaskC: AnsiChar;
+  c: AnsiChar;
+  s: string;
+begin
+  ClearStore;
+  Result := 0;
+  if Value = '' then
+    Exit;
+  if Mask = '' then
+    Exit;
+  Ivalue := 1;
+  IMask := 1;
+  Result := 1;
+  LastMaskC := ' ';
+  while Imask <= Length(mask) do
+  begin
+    if (Mask[Imask] <> '*') and (Ivalue > Length(Value)) then
+    begin
+      Result := 0;
+      Exit;
+    end;
+    MaskC := Mask[Imask];
+    if Ivalue > Length(Value) then
+      Exit;
+    c := Value[Ivalue];
+    case MaskC of
+      'n':
+        FileName := FileName + c;
+      'v':
+        VMSFileName := VMSFileName + c;
+      '.':
+        begin
+          if c in ['.', ' '] then
+            FileName := TrimSP(FileName) + '.'
+          else
+          begin
+            Result := 0;
+            Exit;
+          end;
+        end;
+      'D':
+        Day := Day + c;
+      'M':
+        Month := Month + c;
+      'T':
+        ThreeMonth := ThreeMonth + c;
+      'U':
+        YearTime := YearTime + c;
+      'Y':
+        Year := Year + c;
+      'h':
+        Hours := Hours + c;
+      'H':
+        HoursModif := HoursModif + c;
+      'm':
+        Minutes := Minutes + c;
+      's':
+        Seconds := Seconds + c;
+      'S':
+        Size := Size + c;
+      'p':
+        Permissions := Permissions + c;
+      'd':
+        DirFlag := DirFlag + c;
+      'x':
+        if c <> ' ' then
+          begin
+            Result := 0;
+            Exit;
+          end;
+      '*':
+        begin
+          s := '';
+          if LastMaskC in ['n', 'v'] then
+          begin
+            if Imask = Length(Mask) then
+              s := Copy(Value, IValue, Maxint)
+            else
+              while IValue <= Length(Value) do
+              begin
+                if Value[Ivalue] = ' ' then
+                  break;
+                s := s + Value[Ivalue];
+                Inc(Ivalue);
+              end;
+            if LastMaskC = 'n' then
+              FileName := FileName + s
+            else
+              VMSFileName := VMSFileName + s;
+          end
+          else
+          begin
+            while IValue <= Length(Value) do
+            begin
+              if not(Value[Ivalue] in ['0'..'9']) then
+                break;
+              s := s + Value[Ivalue];
+              Inc(Ivalue);
+            end;
+            case LastMaskC of
+              'S':
+                Size := Size + s;
+            end;
+          end;
+          Dec(IValue);
+        end;
+      '!':
+        begin
+          while IValue <= Length(Value) do
+          begin
+            if Value[Ivalue] = ' ' then
+              break;
+            Inc(Ivalue);
+          end;
+          while IValue <= Length(Value) do
+          begin
+            if Value[Ivalue] <> ' ' then
+              break;
+            Inc(Ivalue);
+          end;
+          Dec(IValue);
+        end;
+      '$':
+        begin
+          while IValue <= Length(Value) do
+          begin
+            if not(Value[Ivalue] in [' ', #9]) then
+              break;
+            Inc(Ivalue);
+          end;
+          Dec(IValue);
+        end;
+      '=':
+        begin
+          s := '';
+          case LastmaskC of
+            'S':
+              begin
+                while Imask <= Length(Mask) do
+                begin
+                  if not(Mask[Imask] in ['0'..'9']) then
+                    break;
+                  s := s + Mask[Imask];
+                  Inc(Imask);
+                end;
+                Dec(Imask);
+                BlockSize := s;
+              end;
+            'T':
+              begin
+                Monthnames := Copy(Mask, IMask, 12 * 3);
+                Inc(IMask, 12 * 3);
+              end;
+            'd':
+              begin
+                Inc(Imask);
+                DirFlagValue := Mask[Imask];
+              end;
+          end;
+        end;
+      '\':
+        begin
+          Value := NextValue;
+          IValue := 0;
+          Result := 2;
+        end;
+    end;
+    Inc(Ivalue);
+    Inc(Imask);
+    LastMaskC := MaskC;
+  end;
+end;
+
+function TFTPList.CheckValues: Boolean;
+var
+  x, n: integer;
+begin
+  Result := false;
+  if FileName <> '' then
+  begin
+    if pos('?', VMSFilename) > 0 then
+      Exit;
+    if pos('*', VMSFilename) > 0 then
+      Exit;
+  end;
+  if VMSFileName <> '' then
+    if pos(';', VMSFilename) <= 0 then
+      Exit;
+  if (FileName = '') and (VMSFileName = '') then
+    Exit;
+  if Permissions <> '' then
+  begin
+    if length(Permissions) <> 10 then
+      Exit;
+    for n := 1 to 10 do
+      if not(Permissions[n] in
+        ['a', 'b', 'c', 'd', 'h', 'l', 'p', 'r', 's', 't', 'w', 'x', 'y', '-']) then
+        Exit;
+  end;
+  if Day <> '' then
+  begin
+    Day := TrimSP(Day);
+    x := StrToIntDef(day, -1);
+    if (x < 1) or (x > 31) then
+      Exit;
+  end;
+  if Month <> '' then
+  begin
+    Month := TrimSP(Month);
+    x := StrToIntDef(Month, -1);
+    if (x < 1) or (x > 12) then
+      Exit;
+  end;
+  if Hours <> '' then
+  begin
+    Hours := TrimSP(Hours);
+    x := StrToIntDef(Hours, -1);
+    if (x < 0) or (x > 24) then
+      Exit;
+  end;
+  if HoursModif <> '' then
+  begin
+    if not (HoursModif[1] in ['a', 'A', 'p', 'P']) then
+      Exit;
+  end;
+  if Minutes <> '' then
+  begin
+    Minutes := TrimSP(Minutes);
+    x := StrToIntDef(Minutes, -1);
+    if (x < 0) or (x > 59) then
+      Exit;
+  end;
+  if Seconds <> '' then
+  begin
+    Seconds := TrimSP(Seconds);
+    x := StrToIntDef(Seconds, -1);
+    if (x < 0) or (x > 59) then
+      Exit;
+  end;
+  if Size <> '' then
+  begin
+    Size := TrimSP(Size);
+    for n := 1 to Length(Size) do
+      if not (Size[n] in ['0'..'9']) then
+        Exit;
+  end;
+
+  if length(Monthnames) = (12 * 3) then
+    for n := 1 to 12 do
+      CustomMonthNames[n] := Copy(Monthnames, ((n - 1) * 3) + 1, 3);
+  if ThreeMonth <> '' then
+  begin
+    x := GetMonthNumber(ThreeMonth);
+    if (x = 0) then
+      Exit;
+  end;
+  if YearTime <> '' then
+  begin
+    YearTime := ReplaceString(YearTime, '-', ':');
+    if pos(':', YearTime) > 0 then
+    begin
+      if (GetTimeFromstr(YearTime) = -1) then
+        Exit;
+    end
+    else
+    begin
+      YearTime := TrimSP(YearTime);
+      x := StrToIntDef(YearTime, -1);
+      if (x = -1) then
+        Exit;
+      if (x < 1900) or (x > 2100) then
+        Exit;
+    end;
+  end;
+  if Year <> '' then
+  begin
+    Year := TrimSP(Year);
+    x := StrToIntDef(Year, -1);
+    if (x = -1) then
+      Exit;
+    if Length(Year) = 4 then
+    begin
+      if not((x > 1900) and (x < 2100)) then
+        Exit;
+    end
+    else
+      if Length(Year) = 2 then
+      begin
+        if not((x >= 0) and (x <= 99)) then
+          Exit;
+      end
+      else
+        if Length(Year) = 3 then
+        begin
+          if not((x >= 100) and (x <= 110)) then
+            Exit;
+        end
+        else
+          Exit;
+  end;
+  Result := True;
+end;
+
+procedure TFTPList.FillRecord(const Value: TFTPListRec);
+var
+  s: string;
+  x: integer;
+  myear: Word;
+  mmonth: Word;
+  mday: Word;
+  mhours, mminutes, mseconds: word;
+  n: integer;
+begin
+  s := DirFlagValue;
+  if s = '' then
+    s := 'D';
+  s := Uppercase(s);
+  Value.Directory :=  s = Uppercase(DirFlag);
+  if FileName <> '' then
+    Value.FileName := SeparateLeft(Filename, ' -> ');
+  if VMSFileName <> '' then
+  begin
+    Value.FileName := VMSFilename;
+    Value.Directory := Pos('.DIR;',VMSFilename) > 0;
+  end;
+  Value.FileName := TrimSPRight(Value.FileName);
+  Value.Readable := not Value.Directory;
+  if BlockSize <> '' then
+    x := StrToIntDef(BlockSize, 1)
+  else
+    x := 1;
+  Value.FileSize := x * StrToIntDef(Size, 0);
+
+  DecodeDate(Date,myear,mmonth,mday);
+  mhours := 0;
+  mminutes := 0;
+  mseconds := 0;
+
+  if Day <> '' then
+    mday := StrToIntDef(day, 1);
+  if Month <> '' then
+    mmonth := StrToIntDef(Month, 1);
+  if length(Monthnames) = (12 * 3) then
+    for n := 1 to 12 do
+      CustomMonthNames[n] := Copy(Monthnames, ((n - 1) * 3) + 1, 3);
+  if ThreeMonth <> '' then
+    mmonth := GetMonthNumber(ThreeMonth);
+  if Year <> '' then
+  begin
+    myear := StrToIntDef(Year, 0);
+    if (myear <= 99) and (myear > 50) then
+      myear := myear + 1900;
+    if myear <= 50 then
+      myear := myear + 2000;
+  end;
+  if YearTime <> '' then
+  begin
+    if pos(':', YearTime) > 0 then
+    begin
+      YearTime := TrimSP(YearTime);
+      mhours := StrToIntDef(Separateleft(YearTime, ':'), 0);
+      mminutes := StrToIntDef(SeparateRight(YearTime, ':'), 0);
+      if (Encodedate(myear, mmonth, mday)
+        + EncodeTime(mHours, mminutes, 0, 0)) > now then
+        Dec(mYear);
+    end
+    else
+      myear := StrToIntDef(YearTime, 0);
+  end;
+  if Minutes <> '' then
+    mminutes := StrToIntDef(Minutes, 0);
+  if Seconds <> '' then
+    mseconds := StrToIntDef(Seconds, 0);
+  if Hours <> '' then
+  begin
+    mHours := StrToIntDef(Hours, 0);
+    if HoursModif <> '' then
+      if Uppercase(HoursModif[1]) = 'P' then
+        if mHours <> 12 then
+          mHours := MHours + 12;
+  end;
+  Value.FileTime := Encodedate(myear, mmonth, mday)
+    + EncodeTime(mHours, mminutes, mseconds, 0);
+  if Permissions <> '' then
+  begin
+    Value.Permission := Permissions;
+    Value.Readable := Uppercase(permissions)[2] = 'R';
+    if Uppercase(permissions)[1] = 'D' then
+    begin
+      Value.Directory := True;
+      Value.Readable := false;
+    end
+    else
+      if Uppercase(permissions)[1] = 'L' then
+        Value.Directory := True;
+  end;
+end;
+
+function TFTPList.ParseEPLF(Value: string): Boolean;
+var
+  s, os: string;
+  flr: TFTPListRec;
+begin
+  Result := False;
+  if Value <> '' then
+    if Value[1] = '+' then
+    begin
+      os := Value;
+      Delete(Value, 1, 1);
+      flr := TFTPListRec.create;
+      flr.FileName := SeparateRight(Value, #9);
+      s := Fetch(Value, ',');
+      while s <> '' do
+      begin
+        if s[1] = #9 then
+          Break;
+        case s[1] of
+          '/':
+            flr.Directory := true;
+          'r':
+            flr.Readable := true;
+          's':
+            flr.FileSize := StrToIntDef(Copy(s, 2, Length(s) - 1), 0);
+          'm':
+            flr.FileTime := (StrToIntDef(Copy(s, 2, Length(s) - 1), 0) / 86400)
+              + 25569;
+        end;
+        s := Fetch(Value, ',');
+      end;
+      if flr.FileName <> '' then
+      if (flr.Directory and ((flr.FileName = '.') or (flr.FileName = '..')))
+        or (flr.FileName = '') then
+        flr.free
+      else
+      begin
+        flr.OriginalLine := os;
+        flr.Mask := 'EPLF';
+        Flist.Add(flr);
+        Result := True;
+      end;
+    end;
+end;
+
+procedure TFTPList.ParseLines;
+var
+  flr: TFTPListRec;
+  n, m: Integer;
+  S: string;
+  x: integer;
+  b: Boolean;
+begin
+  n := 0;
+  while n < Lines.Count do
+  begin
+    if n = Lines.Count - 1 then
+      s := ''
+    else
+      s := Lines[n + 1];
+    b := False;
+    x := 0;
+    if ParseEPLF(Lines[n]) then
+    begin
+      b := True;
+      x := 1;
+    end
+    else
+      for m := 0 to Masks.Count - 1 do
+      begin
+        x := ParseByMask(Lines[n], s, Masks[m]);
+        if x > 0 then
+          if CheckValues then
+          begin
+            flr := TFTPListRec.create;
+            FillRecord(flr);
+            flr.OriginalLine := Lines[n];
+            flr.Mask := Masks[m];
+            if flr.Directory and ((flr.FileName = '.') or (flr.FileName = '..')) then
+              flr.free
+            else
+              Flist.Add(flr);
+            b := True;
+            Break;
+          end;
+      end;
+    if not b then
+      FUnparsedLines.Add(Lines[n]);
+    Inc(n);
+    if x > 1 then
+      Inc(n, x - 1);
+  end;
+end;
+
+{==============================================================================}
+
+function FtpGetFile(const IP, Port, FileName, LocalFile,
+  User, Pass: string): Boolean;
+begin
+  Result := False;
+  with TFTPSend.Create do
+  try
+    if User <> '' then
+    begin
+      Username := User;
+      Password := Pass;
+    end;
+    TargetHost := IP;
+    TargetPort := Port;
+    if not Login then
+      Exit;
+    DirectFileName := LocalFile;
+    DirectFile:=True;
+    Result := RetrieveFile(FileName, False);
+    Logout;
+  finally
+    Free;
+  end;
+end;
+
+function FtpPutFile(const IP, Port, FileName, LocalFile,
+  User, Pass: string): Boolean;
+begin
+  Result := False;
+  with TFTPSend.Create do
+  try
+    if User <> '' then
+    begin
+      Username := User;
+      Password := Pass;
+    end;
+    TargetHost := IP;
+    TargetPort := Port;
+    if not Login then
+      Exit;
+    DirectFileName := LocalFile;
+    DirectFile:=True;
+    Result := StoreFile(FileName, False);
+    Logout;
+  finally
+    Free;
+  end;
+end;
+
+function FtpInterServerTransfer(
+  const FromIP, FromPort, FromFile, FromUser, FromPass: string;
+  const ToIP, ToPort, ToFile, ToUser, ToPass: string): Boolean;
+var
+  FromFTP, ToFTP: TFTPSend;
+  s: string;
+  x: integer;
+begin
+  Result := False;
+  FromFTP := TFTPSend.Create;
+  toFTP := TFTPSend.Create;
+  try
+    if FromUser <> '' then
+    begin
+      FromFTP.Username := FromUser;
+      FromFTP.Password := FromPass;
+    end;
+    if ToUser <> '' then
+    begin
+      ToFTP.Username := ToUser;
+      ToFTP.Password := ToPass;
+    end;
+    FromFTP.TargetHost := FromIP;
+    FromFTP.TargetPort := FromPort;
+    ToFTP.TargetHost := ToIP;
+    ToFTP.TargetPort := ToPort;
+    if not FromFTP.Login then
+      Exit;
+    if not ToFTP.Login then
+      Exit;
+    if (FromFTP.FTPCommand('PASV') div 100) <> 2 then
+      Exit;
+    FromFTP.ParseRemote(FromFTP.ResultString);
+    s := ReplaceString(FromFTP.DataIP, '.', ',');
+    s := 'PORT ' + s + ',' + IntToStr(StrToIntDef(FromFTP.DataPort, 0) div 256)
+      + ',' + IntToStr(StrToIntDef(FromFTP.DataPort, 0) mod 256);
+    if (ToFTP.FTPCommand(s) div 100) <> 2 then
+      Exit;
+    x := ToFTP.FTPCommand('RETR ' + FromFile);
+    if (x div 100) <> 1 then
+      Exit;
+    x := FromFTP.FTPCommand('STOR ' + ToFile);
+    if (x div 100) <> 1 then
+      Exit;
+    FromFTP.Timeout := 21600000;
+    x := FromFTP.ReadResult;
+    if (x  div 100) <> 2 then
+      Exit;
+    ToFTP.Timeout := 21600000;
+    x := ToFTP.ReadResult;
+    if (x div 100) <> 2 then
+      Exit;
+    Result := True;
+  finally
+    ToFTP.Free;
+    FromFTP.Free;
+  end;
+end;
+
+end.
diff --git a/Units/Synapse/ftptsend.pas b/Units/Synapse/ftptsend.pas
index 6ab4173..d80f3b6 100644
--- a/Units/Synapse/ftptsend.pas
+++ b/Units/Synapse/ftptsend.pas
@@ -1,403 +1,403 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 001.001.001 |
-|==============================================================================|
-| Content: Trivial FTP (TFTP) client and server                                |
-|==============================================================================|
-| Copyright (c)1999-2010, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2003-2010.                |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{: @abstract(TFTP client and server protocol)
-
-Used RFC: RFC-1350
-}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$Q-}
-{$H+}
-
-{$IFDEF UNICODE}
-  {$WARN IMPLICIT_STRING_CAST OFF}
-  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
-{$ENDIF}
-
-unit ftptsend;
-
-interface
-
-uses
-  SysUtils, Classes,
-  blcksock, synautil;
-
-const
-  cTFTPProtocol = '69';
-
-  cTFTP_RRQ = word(1);
-  cTFTP_WRQ = word(2);
-  cTFTP_DTA = word(3);
-  cTFTP_ACK = word(4);
-  cTFTP_ERR = word(5);
-
-type
-  {:@abstract(Implementation of TFTP client and server)
-   Note: Are you missing properties for specify server address and port? Look to
-   parent @link(TSynaClient) too!}
-  TTFTPSend = class(TSynaClient)
-  private
-    FSock: TUDPBlockSocket;
-    FErrorCode: integer;
-    FErrorString: string;
-    FData: TMemoryStream;
-    FRequestIP: string;
-    FRequestPort: string;
-    function SendPacket(Cmd: word; Serial: word; const Value: string): Boolean;
-    function RecvPacket(Serial: word; var Value: string): Boolean;
-  public
-    constructor Create;
-    destructor Destroy; override;
-
-    {:Upload @link(data) as file to TFTP server.}
-    function SendFile(const Filename: string): Boolean;
-
-    {:Download file from TFTP server to @link(data).}
-    function RecvFile(const Filename: string): Boolean;
-
-    {:Acts as TFTP server and wait for client request. When some request
-     incoming within Timeout, result is @true and parametres is filled with
-     information from request. You must handle this request, validate it, and
-     call @link(ReplyError), @link(ReplyRecv) or @link(ReplySend) for send reply
-     to TFTP Client.}
-    function WaitForRequest(var Req: word; var filename: string): Boolean;
-
-    {:send error to TFTP client, when you acts as TFTP server.}
-    procedure ReplyError(Error: word; Description: string);
-
-    {:Accept uploaded file from TFTP client to @link(data), when you acts as
-     TFTP server.}
-    function ReplyRecv: Boolean;
-
-    {:Accept download request file from TFTP client and send content of
-     @link(data), when you acts as TFTP server.}
-    function ReplySend: Boolean;
-  published
-    {:Code of TFTP error.}
-    property ErrorCode: integer read FErrorCode;
-
-    {:Human readable decription of TFTP error. (if is sended by remote side)}
-    property ErrorString: string read FErrorString;
-
-    {:MemoryStream with datas for sending or receiving}
-    property Data: TMemoryStream read FData;
-
-    {:Address of TFTP remote side.}
-    property RequestIP: string read FRequestIP write FRequestIP;
-
-    {:Port of TFTP remote side.}
-    property RequestPort: string read FRequestPort write FRequestPort;
-  end;
-
-implementation
-
-constructor TTFTPSend.Create;
-begin
-  inherited Create;
-  FSock := TUDPBlockSocket.Create;
-  FSock.Owner := self;
-  FTargetPort := cTFTPProtocol;
-  FData := TMemoryStream.Create;
-  FErrorCode := 0;
-  FErrorString := '';
-end;
-
-destructor TTFTPSend.Destroy;
-begin
-  FSock.Free;
-  FData.Free;
-  inherited Destroy;
-end;
-
-function TTFTPSend.SendPacket(Cmd: word; Serial: word; const Value: string): Boolean;
-var
-  s, sh: string;
-begin
-  FErrorCode := 0;
-  FErrorString := '';
-  Result := false;
-  if Cmd <> 2 then
-    s := CodeInt(Cmd) + CodeInt(Serial) + Value
-  else
-    s := CodeInt(Cmd) + Value;
-  FSock.SendString(s);
-  s := FSock.RecvPacket(FTimeout);
-  if FSock.LastError = 0 then
-    if length(s) >= 4 then
-    begin
-      sh := CodeInt(4) + CodeInt(Serial);
-      if Pos(sh, s) = 1 then
-        Result := True
-      else
-        if s[1] = #5 then
-        begin
-          FErrorCode := DecodeInt(s, 3);
-          Delete(s, 1, 4);
-          FErrorString := SeparateLeft(s, #0);
-        end;
-    end;
-end;
-
-function TTFTPSend.RecvPacket(Serial: word; var Value: string): Boolean;
-var
-  s: string;
-  ser: word;
-begin
-  FErrorCode := 0;
-  FErrorString := '';
-  Result := False;
-  Value := '';
-  s := FSock.RecvPacket(FTimeout);
-  if FSock.LastError = 0 then
-    if length(s) >= 4 then
-      if DecodeInt(s, 1) = 3 then
-      begin
-        ser := DecodeInt(s, 3);
-        if ser = Serial then
-        begin
-          Delete(s, 1, 4);
-          Value := s;
-          S := CodeInt(4) + CodeInt(ser);
-          FSock.SendString(s);
-          Result := FSock.LastError = 0;
-        end
-        else
-        begin
-          S := CodeInt(5) + CodeInt(5) + 'Unexcepted serial#' + #0;
-          FSock.SendString(s);
-        end;
-      end;
-      if DecodeInt(s, 1) = 5 then
-      begin
-        FErrorCode := DecodeInt(s, 3);
-        Delete(s, 1, 4);
-        FErrorString := SeparateLeft(s, #0);
-      end;
-end;
-
-function TTFTPSend.SendFile(const Filename: string): Boolean;
-var
-  s: string;
-  ser: word;
-  n, n1, n2: integer;
-begin
-  Result := False;
-  FErrorCode := 0;
-  FErrorString := '';
-  FSock.CloseSocket;
-  FSock.Connect(FTargetHost, FTargetPort);
-  try
-    if FSock.LastError = 0 then
-    begin
-      s := Filename + #0 + 'octet' + #0;
-      if not Sendpacket(2, 0, s) then
-        Exit;
-      ser := 1;
-      FData.Position := 0;
-      n1 := FData.Size div 512;
-      n2 := FData.Size mod 512;
-      for n := 1 to n1 do
-      begin
-        s := ReadStrFromStream(FData, 512);
-//        SetLength(s, 512);
-//        FData.Read(pointer(s)^, 512);
-        if not Sendpacket(3, ser, s) then
-          Exit;
-        inc(ser);
-      end;
-      s := ReadStrFromStream(FData, n2);
-//      SetLength(s, n2);
-//      FData.Read(pointer(s)^, n2);
-      if not Sendpacket(3, ser, s) then
-        Exit;
-      Result := True;
-    end;
-  finally
-    FSock.CloseSocket;
-  end;
-end;
-
-function TTFTPSend.RecvFile(const Filename: string): Boolean;
-var
-  s: string;
-  ser: word;
-begin
-  Result := False;
-  FErrorCode := 0;
-  FErrorString := '';
-  FSock.CloseSocket;
-  FSock.Connect(FTargetHost, FTargetPort);
-  try
-    if FSock.LastError = 0 then
-    begin
-      s := CodeInt(1) + Filename + #0 + 'octet' + #0;
-      FSock.SendString(s);
-      if FSock.LastError <> 0 then
-        Exit;
-      FData.Clear;
-      ser := 1;
-      repeat
-        if not RecvPacket(ser, s) then
-          Exit;
-        inc(ser);
-        WriteStrToStream(FData, s);
-//        FData.Write(pointer(s)^, length(s));
-      until length(s) <> 512;
-      FData.Position := 0;
-      Result := true;
-    end;
-  finally
-    FSock.CloseSocket;
-  end;
-end;
-
-function TTFTPSend.WaitForRequest(var Req: word; var filename: string): Boolean;
-var
-  s: string;
-begin
-  Result := False;
-  FErrorCode := 0;
-  FErrorString := '';
-  FSock.CloseSocket;
-  FSock.Bind('0.0.0.0', FTargetPort);
-  if FSock.LastError = 0 then
-  begin
-    s := FSock.RecvPacket(FTimeout);
-    if FSock.LastError = 0 then
-      if Length(s) >= 4 then
-      begin
-        FRequestIP := FSock.GetRemoteSinIP;
-        FRequestPort := IntToStr(FSock.GetRemoteSinPort);
-        Req := DecodeInt(s, 1);
-        delete(s, 1, 2);
-        filename := Trim(SeparateLeft(s, #0));
-        s := SeparateRight(s, #0);
-        s := SeparateLeft(s, #0);
-        Result := lowercase(trim(s)) = 'octet';
-      end;
-  end;
-end;
-
-procedure TTFTPSend.ReplyError(Error: word; Description: string);
-var
-  s: string;
-begin
-  FSock.CloseSocket;
-  FSock.Connect(FRequestIP, FRequestPort);
-  s := CodeInt(5) + CodeInt(Error) + Description + #0;
-  FSock.SendString(s);
-  FSock.CloseSocket;
-end;
-
-function TTFTPSend.ReplyRecv: Boolean;
-var
-  s: string;
-  ser: integer;
-begin
-  Result := False;
-  FErrorCode := 0;
-  FErrorString := '';
-  FSock.CloseSocket;
-  FSock.Connect(FRequestIP, FRequestPort);
-  try
-    s := CodeInt(4) + CodeInt(0);
-    FSock.SendString(s);
-    FData.Clear;
-    ser := 1;
-    repeat
-      if not RecvPacket(ser, s) then
-        Exit;
-      inc(ser);
-      WriteStrToStream(FData, s);
-//      FData.Write(pointer(s)^, length(s));
-    until length(s) <> 512;
-    FData.Position := 0;
-    Result := true;
-  finally
-    FSock.CloseSocket;
-  end;
-end;
-
-function TTFTPSend.ReplySend: Boolean;
-var
-  s: string;
-  ser: word;
-  n, n1, n2: integer;
-begin
-  Result := False;
-  FErrorCode := 0;
-  FErrorString := '';
-  FSock.CloseSocket;
-  FSock.Connect(FRequestIP, FRequestPort);
-  try
-    ser := 1;
-    FData.Position := 0;
-    n1 := FData.Size div 512;
-    n2 := FData.Size mod 512;
-    for n := 1 to n1 do
-    begin
-      s := ReadStrFromStream(FData, 512);
-//      SetLength(s, 512);
-//      FData.Read(pointer(s)^, 512);
-      if not Sendpacket(3, ser, s) then
-        Exit;
-      inc(ser);
-    end;
-    s := ReadStrFromStream(FData, n2);
-//    SetLength(s, n2);
-//    FData.Read(pointer(s)^, n2);
-    if not Sendpacket(3, ser, s) then
-      Exit;
-    Result := True;
-  finally
-    FSock.CloseSocket;
-  end;
-end;
-
-{==============================================================================}
-
-end.
+{==============================================================================|
+| Project : Ararat Synapse                                       | 001.001.001 |
+|==============================================================================|
+| Content: Trivial FTP (TFTP) client and server                                |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2003-2010.                |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{: @abstract(TFTP client and server protocol)
+
+Used RFC: RFC-1350
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$Q-}
+{$H+}
+
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit ftptsend;
+
+interface
+
+uses
+  SysUtils, Classes,
+  blcksock, synautil;
+
+const
+  cTFTPProtocol = '69';
+
+  cTFTP_RRQ = word(1);
+  cTFTP_WRQ = word(2);
+  cTFTP_DTA = word(3);
+  cTFTP_ACK = word(4);
+  cTFTP_ERR = word(5);
+
+type
+  {:@abstract(Implementation of TFTP client and server)
+   Note: Are you missing properties for specify server address and port? Look to
+   parent @link(TSynaClient) too!}
+  TTFTPSend = class(TSynaClient)
+  private
+    FSock: TUDPBlockSocket;
+    FErrorCode: integer;
+    FErrorString: string;
+    FData: TMemoryStream;
+    FRequestIP: string;
+    FRequestPort: string;
+    function SendPacket(Cmd: word; Serial: word; const Value: string): Boolean;
+    function RecvPacket(Serial: word; var Value: string): Boolean;
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    {:Upload @link(data) as file to TFTP server.}
+    function SendFile(const Filename: string): Boolean;
+
+    {:Download file from TFTP server to @link(data).}
+    function RecvFile(const Filename: string): Boolean;
+
+    {:Acts as TFTP server and wait for client request. When some request
+     incoming within Timeout, result is @true and parametres is filled with
+     information from request. You must handle this request, validate it, and
+     call @link(ReplyError), @link(ReplyRecv) or @link(ReplySend) for send reply
+     to TFTP Client.}
+    function WaitForRequest(var Req: word; var filename: string): Boolean;
+
+    {:send error to TFTP client, when you acts as TFTP server.}
+    procedure ReplyError(Error: word; Description: string);
+
+    {:Accept uploaded file from TFTP client to @link(data), when you acts as
+     TFTP server.}
+    function ReplyRecv: Boolean;
+
+    {:Accept download request file from TFTP client and send content of
+     @link(data), when you acts as TFTP server.}
+    function ReplySend: Boolean;
+  published
+    {:Code of TFTP error.}
+    property ErrorCode: integer read FErrorCode;
+
+    {:Human readable decription of TFTP error. (if is sended by remote side)}
+    property ErrorString: string read FErrorString;
+
+    {:MemoryStream with datas for sending or receiving}
+    property Data: TMemoryStream read FData;
+
+    {:Address of TFTP remote side.}
+    property RequestIP: string read FRequestIP write FRequestIP;
+
+    {:Port of TFTP remote side.}
+    property RequestPort: string read FRequestPort write FRequestPort;
+  end;
+
+implementation
+
+constructor TTFTPSend.Create;
+begin
+  inherited Create;
+  FSock := TUDPBlockSocket.Create;
+  FSock.Owner := self;
+  FTargetPort := cTFTPProtocol;
+  FData := TMemoryStream.Create;
+  FErrorCode := 0;
+  FErrorString := '';
+end;
+
+destructor TTFTPSend.Destroy;
+begin
+  FSock.Free;
+  FData.Free;
+  inherited Destroy;
+end;
+
+function TTFTPSend.SendPacket(Cmd: word; Serial: word; const Value: string): Boolean;
+var
+  s, sh: string;
+begin
+  FErrorCode := 0;
+  FErrorString := '';
+  Result := false;
+  if Cmd <> 2 then
+    s := CodeInt(Cmd) + CodeInt(Serial) + Value
+  else
+    s := CodeInt(Cmd) + Value;
+  FSock.SendString(s);
+  s := FSock.RecvPacket(FTimeout);
+  if FSock.LastError = 0 then
+    if length(s) >= 4 then
+    begin
+      sh := CodeInt(4) + CodeInt(Serial);
+      if Pos(sh, s) = 1 then
+        Result := True
+      else
+        if s[1] = #5 then
+        begin
+          FErrorCode := DecodeInt(s, 3);
+          Delete(s, 1, 4);
+          FErrorString := SeparateLeft(s, #0);
+        end;
+    end;
+end;
+
+function TTFTPSend.RecvPacket(Serial: word; var Value: string): Boolean;
+var
+  s: string;
+  ser: word;
+begin
+  FErrorCode := 0;
+  FErrorString := '';
+  Result := False;
+  Value := '';
+  s := FSock.RecvPacket(FTimeout);
+  if FSock.LastError = 0 then
+    if length(s) >= 4 then
+      if DecodeInt(s, 1) = 3 then
+      begin
+        ser := DecodeInt(s, 3);
+        if ser = Serial then
+        begin
+          Delete(s, 1, 4);
+          Value := s;
+          S := CodeInt(4) + CodeInt(ser);
+          FSock.SendString(s);
+          Result := FSock.LastError = 0;
+        end
+        else
+        begin
+          S := CodeInt(5) + CodeInt(5) + 'Unexcepted serial#' + #0;
+          FSock.SendString(s);
+        end;
+      end;
+      if DecodeInt(s, 1) = 5 then
+      begin
+        FErrorCode := DecodeInt(s, 3);
+        Delete(s, 1, 4);
+        FErrorString := SeparateLeft(s, #0);
+      end;
+end;
+
+function TTFTPSend.SendFile(const Filename: string): Boolean;
+var
+  s: string;
+  ser: word;
+  n, n1, n2: integer;
+begin
+  Result := False;
+  FErrorCode := 0;
+  FErrorString := '';
+  FSock.CloseSocket;
+  FSock.Connect(FTargetHost, FTargetPort);
+  try
+    if FSock.LastError = 0 then
+    begin
+      s := Filename + #0 + 'octet' + #0;
+      if not Sendpacket(2, 0, s) then
+        Exit;
+      ser := 1;
+      FData.Position := 0;
+      n1 := FData.Size div 512;
+      n2 := FData.Size mod 512;
+      for n := 1 to n1 do
+      begin
+        s := ReadStrFromStream(FData, 512);
+//        SetLength(s, 512);
+//        FData.Read(pointer(s)^, 512);
+        if not Sendpacket(3, ser, s) then
+          Exit;
+        inc(ser);
+      end;
+      s := ReadStrFromStream(FData, n2);
+//      SetLength(s, n2);
+//      FData.Read(pointer(s)^, n2);
+      if not Sendpacket(3, ser, s) then
+        Exit;
+      Result := True;
+    end;
+  finally
+    FSock.CloseSocket;
+  end;
+end;
+
+function TTFTPSend.RecvFile(const Filename: string): Boolean;
+var
+  s: string;
+  ser: word;
+begin
+  Result := False;
+  FErrorCode := 0;
+  FErrorString := '';
+  FSock.CloseSocket;
+  FSock.Connect(FTargetHost, FTargetPort);
+  try
+    if FSock.LastError = 0 then
+    begin
+      s := CodeInt(1) + Filename + #0 + 'octet' + #0;
+      FSock.SendString(s);
+      if FSock.LastError <> 0 then
+        Exit;
+      FData.Clear;
+      ser := 1;
+      repeat
+        if not RecvPacket(ser, s) then
+          Exit;
+        inc(ser);
+        WriteStrToStream(FData, s);
+//        FData.Write(pointer(s)^, length(s));
+      until length(s) <> 512;
+      FData.Position := 0;
+      Result := true;
+    end;
+  finally
+    FSock.CloseSocket;
+  end;
+end;
+
+function TTFTPSend.WaitForRequest(var Req: word; var filename: string): Boolean;
+var
+  s: string;
+begin
+  Result := False;
+  FErrorCode := 0;
+  FErrorString := '';
+  FSock.CloseSocket;
+  FSock.Bind('0.0.0.0', FTargetPort);
+  if FSock.LastError = 0 then
+  begin
+    s := FSock.RecvPacket(FTimeout);
+    if FSock.LastError = 0 then
+      if Length(s) >= 4 then
+      begin
+        FRequestIP := FSock.GetRemoteSinIP;
+        FRequestPort := IntToStr(FSock.GetRemoteSinPort);
+        Req := DecodeInt(s, 1);
+        delete(s, 1, 2);
+        filename := Trim(SeparateLeft(s, #0));
+        s := SeparateRight(s, #0);
+        s := SeparateLeft(s, #0);
+        Result := lowercase(trim(s)) = 'octet';
+      end;
+  end;
+end;
+
+procedure TTFTPSend.ReplyError(Error: word; Description: string);
+var
+  s: string;
+begin
+  FSock.CloseSocket;
+  FSock.Connect(FRequestIP, FRequestPort);
+  s := CodeInt(5) + CodeInt(Error) + Description + #0;
+  FSock.SendString(s);
+  FSock.CloseSocket;
+end;
+
+function TTFTPSend.ReplyRecv: Boolean;
+var
+  s: string;
+  ser: integer;
+begin
+  Result := False;
+  FErrorCode := 0;
+  FErrorString := '';
+  FSock.CloseSocket;
+  FSock.Connect(FRequestIP, FRequestPort);
+  try
+    s := CodeInt(4) + CodeInt(0);
+    FSock.SendString(s);
+    FData.Clear;
+    ser := 1;
+    repeat
+      if not RecvPacket(ser, s) then
+        Exit;
+      inc(ser);
+      WriteStrToStream(FData, s);
+//      FData.Write(pointer(s)^, length(s));
+    until length(s) <> 512;
+    FData.Position := 0;
+    Result := true;
+  finally
+    FSock.CloseSocket;
+  end;
+end;
+
+function TTFTPSend.ReplySend: Boolean;
+var
+  s: string;
+  ser: word;
+  n, n1, n2: integer;
+begin
+  Result := False;
+  FErrorCode := 0;
+  FErrorString := '';
+  FSock.CloseSocket;
+  FSock.Connect(FRequestIP, FRequestPort);
+  try
+    ser := 1;
+    FData.Position := 0;
+    n1 := FData.Size div 512;
+    n2 := FData.Size mod 512;
+    for n := 1 to n1 do
+    begin
+      s := ReadStrFromStream(FData, 512);
+//      SetLength(s, 512);
+//      FData.Read(pointer(s)^, 512);
+      if not Sendpacket(3, ser, s) then
+        Exit;
+      inc(ser);
+    end;
+    s := ReadStrFromStream(FData, n2);
+//    SetLength(s, n2);
+//    FData.Read(pointer(s)^, n2);
+    if not Sendpacket(3, ser, s) then
+      Exit;
+    Result := True;
+  finally
+    FSock.CloseSocket;
+  end;
+end;
+
+{==============================================================================}
+
+end.
diff --git a/Units/Synapse/httpsend.pas b/Units/Synapse/httpsend.pas
index 21d1240..0c58455 100644
--- a/Units/Synapse/httpsend.pas
+++ b/Units/Synapse/httpsend.pas
@@ -1,840 +1,840 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 003.012.004 |
-|==============================================================================|
-| Content: HTTP client                                                         |
-|==============================================================================|
-| Copyright (c)1999-2010, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c) 1999-2010.               |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{:@abstract(HTTP protocol client)
-
-Used RFC: RFC-1867, RFC-1947, RFC-2388, RFC-2616
-}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$H+}
-//old Delphi does not have MSWINDOWS define.
-{$IFDEF WIN32}
-  {$IFNDEF MSWINDOWS}
-    {$DEFINE MSWINDOWS}
-  {$ENDIF}
-{$ENDIF}
-
-{$IFDEF UNICODE}
-  {$WARN IMPLICIT_STRING_CAST OFF}
-  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
-{$ENDIF}
-
-unit httpsend;
-
-interface
-
-uses
-  SysUtils, Classes,
-  blcksock, synautil, synaip, synacode, synsock;
-
-const
-  cHttpProtocol = '80';
-
-type
-  {:These encoding types are used internally by the THTTPSend object to identify
-   the transfer data types.}
-  TTransferEncoding = (TE_UNKNOWN, TE_IDENTITY, TE_CHUNKED);
-
-  {:abstract(Implementation of HTTP protocol.)}
-  THTTPSend = class(TSynaClient)
-  protected
-    FSock: TTCPBlockSocket;
-    FTransferEncoding: TTransferEncoding;
-    FAliveHost: string;
-    FAlivePort: string;
-    FHeaders: TStringList;
-    FDocument: TMemoryStream;
-    FMimeType: string;
-    FProtocol: string;
-    FKeepAlive: Boolean;
-    FKeepAliveTimeout: integer;
-    FStatus100: Boolean;
-    FProxyHost: string;
-    FProxyPort: string;
-    FProxyUser: string;
-    FProxyPass: string;
-    FResultCode: Integer;
-    FResultString: string;
-    FUserAgent: string;
-    FCookies: TStringList;
-    FDownloadSize: integer;
-    FUploadSize: integer;
-    FRangeStart: integer;
-    FRangeEnd: integer;
-    FAddPortNumberToHost: Boolean;
-    function ReadUnknown: Boolean;
-    function ReadIdentity(Size: Integer): Boolean;
-    function ReadChunked: Boolean;
-    procedure ParseCookies;
-    function PrepareHeaders: string;
-    function InternalDoConnect(needssl: Boolean): Boolean;
-    function InternalConnect(needssl: Boolean): Boolean;
-  public
-    constructor Create;
-    destructor Destroy; override;
-
-    {:Reset headers and document and Mimetype.}
-    procedure Clear;
-
-    {:Decode ResultCode and ResultString from Value.}
-    procedure DecodeStatus(const Value: string);
-
-    {:Connects to host define in URL and access to resource defined in URL by
-     method. If Document is not empty, send it to server as part of HTTP request.
-     Server response is in Document and headers. Connection may be authorised
-     by username and password in URL. If you define proxy properties, connection
-     is made by this proxy. If all OK, result is @true, else result is @false.
-
-     If you use in URL 'https:' instead only 'http:', then your request is made
-     by SSL/TLS connection (if you not specify port, then port 443 is used
-     instead standard port 80). If you use SSL/TLS request and you have defined
-     HTTP proxy, then HTTP-tunnel mode is automaticly used .}
-    function HTTPMethod(const Method, URL: string): Boolean;
-
-    {:You can call this method from OnStatus event for break current data
-     transfer. (or from another thread.)}
-    procedure Abort;
-  published
-    {:Before HTTP operation you may define any non-standard headers for HTTP
-     request, except of: 'Expect: 100-continue', 'Content-Length', 'Content-Type',
-     'Connection', 'Authorization', 'Proxy-Authorization' and 'Host' headers.
-     After HTTP operation contains full headers of returned document.}
-    property Headers: TStringList read FHeaders;
-
-    {:This is stringlist with name-value stringlist pairs. Each this pair is one
-     cookie. After HTTP request is returned cookies parsed to this stringlist.
-     You can leave this cookies untouched for next HTTP request. You can also
-     save this stringlist for later use.}
-    property Cookies: TStringList read FCookies;
-
-    {:Stream with document to send (before request, or with document received
-     from HTTP server (after request).}
-    property Document: TMemoryStream read FDocument;
-
-    {:If you need download only part of requested document, here specify
-     possition of subpart begin. If here 0, then is requested full document.}
-    property RangeStart: integer read FRangeStart Write FRangeStart;
-
-    {:If you need download only part of requested document, here specify
-     possition of subpart end. If here 0, then is requested document from
-     rangeStart to end of document. (for broken download restoration,
-     for example.)}
-    property RangeEnd: integer read FRangeEnd Write FRangeEnd;
-
-    {:Mime type of sending data. Default is: 'text/html'.}
-    property MimeType: string read FMimeType Write FMimeType;
-
-    {:Define protocol version. Possible values are: '1.1', '1.0' (default)
-     and '0.9'.}
-    property Protocol: string read FProtocol Write FProtocol;
-
-    {:If @true (default value), keepalives in HTTP protocol 1.1 is enabled.}
-    property KeepAlive: Boolean read FKeepAlive Write FKeepAlive;
-
-    {:Define timeout for keepalives in seconds!}
-    property KeepAliveTimeout: integer read FKeepAliveTimeout Write FKeepAliveTimeout;
-
-    {:if @true, then server is requested for 100status capability when uploading
-     data. Default is @false (off).}
-    property Status100: Boolean read FStatus100 Write FStatus100;
-
-    {:Address of proxy server (IP address or domain name) where you want to
-     connect in @link(HTTPMethod) method.}
-    property ProxyHost: string read FProxyHost Write FProxyHost;
-
-    {:Port number for proxy connection. Default value is 8080.}
-    property ProxyPort: string read FProxyPort Write FProxyPort;
-
-    {:Username for connect to proxy server where you want to connect in
-     HTTPMethod method.}
-    property ProxyUser: string read FProxyUser Write FProxyUser;
-
-    {:Password for connect to proxy server where you want to connect in
-     HTTPMethod method.}
-    property ProxyPass: string read FProxyPass Write FProxyPass;
-
-    {:Here you can specify custom User-Agent indentification. By default is
-     used: 'Mozilla/4.0 (compatible; Synapse)'}
-    property UserAgent: string read FUserAgent Write FUserAgent;
-
-    {:After successful @link(HTTPMethod) method contains result code of
-     operation.}
-    property ResultCode: Integer read FResultCode;
-
-    {:After successful @link(HTTPMethod) method contains string after result code.}
-    property ResultString: string read FResultString;
-
-    {:if this value is not 0, then data download pending. In this case you have
-     here total sice of downloaded data. It is good for draw download
-     progressbar from OnStatus event.}
-    property DownloadSize: integer read FDownloadSize;
-
-    {:if this value is not 0, then data upload pending. In this case you have
-     here total sice of uploaded data. It is good for draw upload progressbar
-     from OnStatus event.}
-    property UploadSize: integer read FUploadSize;
-    {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
-    property Sock: TTCPBlockSocket read FSock;
-
-    {:To have possibility to switch off port number in 'Host:' HTTP header, by
-    default @TRUE. Some buggy servers not like port informations in this header.}
-    property AddPortNumberToHost: Boolean read FAddPortNumberToHost write FAddPortNumberToHost;
-  end;
-
-{:A very usefull function, and example of use can be found in the THTTPSend
- object. It implements the GET method of the HTTP protocol. This function sends
- the GET method for URL document to an HTTP server. Returned document is in the
- "Response" stringlist (without any headers). Returns boolean TRUE if all went
- well.}
-function HttpGetText(const URL: string; const Response: TStrings): Boolean;
-
-{:A very usefull function, and example of use can be found in the THTTPSend
- object. It implements the GET method of the HTTP protocol. This function sends
- the GET method for URL document to an HTTP server. Returned document is in the
- "Response" stream. Returns boolean TRUE if all went well.}
-function HttpGetBinary(const URL: string; const Response: TStream): Boolean;
-
-{:A very useful function, and example of use can be found in the THTTPSend
- object. It implements the POST method of the HTTP protocol. This function sends
- the SEND method for a URL document to an HTTP server. The document to be sent
- is located in "Data" stream. The returned document is in the "Data" stream.
- Returns boolean TRUE if all went well.}
-function HttpPostBinary(const URL: string; const Data: TStream): Boolean;
-
-{:A very useful function, and example of use can be found in the THTTPSend
- object. It implements the POST method of the HTTP protocol. This function is
- good for POSTing form data. It sends the POST method for a URL document to
- an HTTP server. You must prepare the form data in the same manner as you would
- the URL data, and pass this prepared data to "URLdata". The following is
- a sample of how the data would appear: 'name=Lukas&field1=some%20data'.
- The information in the field must be encoded by EncodeURLElement function.
- The returned document is in the "Data" stream. Returns boolean TRUE if all
- went well.}
-function HttpPostURL(const URL, URLData: string; const Data: TStream): Boolean;
-
-{:A very useful function, and example of use can be found in the THTTPSend
- object. It implements the POST method of the HTTP protocol. This function sends
- the POST method for a URL document to an HTTP server. This function simulate
- posting of file by HTML form used method 'multipart/form-data'. Posting file
- is in DATA stream. Its name is Filename string. Fieldname is for name of
- formular field with file. (simulate HTML INPUT FILE) The returned document is
- in the ResultData Stringlist. Returns boolean TRUE if all went well.}
-function HttpPostFile(const URL, FieldName, FileName: string;
-  const Data: TStream; const ResultData: TStrings): Boolean;
-
-implementation
-
-constructor THTTPSend.Create;
-begin
-  inherited Create;
-  FHeaders := TStringList.Create;
-  FCookies := TStringList.Create;
-  FDocument := TMemoryStream.Create;
-  FSock := TTCPBlockSocket.Create;
-  FSock.Owner := self;
-  FSock.ConvertLineEnd := True;
-  FSock.SizeRecvBuffer := c64k;
-  FSock.SizeSendBuffer := c64k;
-  FTimeout := 90000;
-  FTargetPort := cHttpProtocol;
-  FProxyHost := '';
-  FProxyPort := '8080';
-  FProxyUser := '';
-  FProxyPass := '';
-  FAliveHost := '';
-  FAlivePort := '';
-  FProtocol := '1.0';
-  FKeepAlive := True;
-  FStatus100 := False;
-  FUserAgent := 'Mozilla/4.0 (compatible; Synapse)';
-  FDownloadSize := 0;
-  FUploadSize := 0;
-  FAddPortNumberToHost := true;
-  FKeepAliveTimeout := 300;
-  Clear;
-end;
-
-destructor THTTPSend.Destroy;
-begin
-  FSock.Free;
-  FDocument.Free;
-  FCookies.Free;
-  FHeaders.Free;
-  inherited Destroy;
-end;
-
-procedure THTTPSend.Clear;
-begin
-  FRangeStart := 0;
-  FRangeEnd := 0;
-  FDocument.Clear;
-  FHeaders.Clear;
-  FMimeType := 'text/html';
-end;
-
-procedure THTTPSend.DecodeStatus(const Value: string);
-var
-  s, su: string;
-begin
-  s := Trim(SeparateRight(Value, ' '));
-  su := Trim(SeparateLeft(s, ' '));
-  FResultCode := StrToIntDef(su, 0);
-  FResultString := Trim(SeparateRight(s, ' '));
-  if FResultString = s then
-    FResultString := '';
-end;
-
-function THTTPSend.PrepareHeaders: string;
-begin
-  if FProtocol = '0.9' then
-    Result := FHeaders[0] + CRLF
-  else
-{$IFNDEF MSWINDOWS}
-    Result := AdjustLineBreaks(FHeaders.Text, tlbsCRLF);
-{$ELSE}
-    Result := FHeaders.Text;
-{$ENDIF}
-end;
-
-function THTTPSend.InternalDoConnect(needssl: Boolean): Boolean;
-begin
-  Result := False;
-  FSock.CloseSocket;
-  FSock.Bind(FIPInterface, cAnyPort);
-  if FSock.LastError <> 0 then
-    Exit;
-  FSock.Connect(FTargetHost, FTargetPort);
-  if FSock.LastError <> 0 then
-    Exit;
-  if needssl then
-  begin
-    FSock.SSLDoConnect;
-    if FSock.LastError <> 0 then
-      Exit;
-  end;
-  FAliveHost := FTargetHost;
-  FAlivePort := FTargetPort;
-  Result := True;
-end;
-
-function THTTPSend.InternalConnect(needssl: Boolean): Boolean;
-begin
-  if FSock.Socket = INVALID_SOCKET then
-    Result := InternalDoConnect(needssl)
-  else
-    if (FAliveHost <> FTargetHost) or (FAlivePort <> FTargetPort)
-      or FSock.CanRead(0) then
-      Result := InternalDoConnect(needssl)
-    else
-      Result := True;
-end;
-
-function THTTPSend.HTTPMethod(const Method, URL: string): Boolean;
-var
-  Sending, Receiving: Boolean;
-  status100: Boolean;
-  status100error: string;
-  ToClose: Boolean;
-  Size: Integer;
-  Prot, User, Pass, Host, Port, Path, Para, URI: string;
-  s, su: string;
-  HttpTunnel: Boolean;
-  n: integer;
-  pp: string;
-  UsingProxy: boolean;
-  l: TStringList;
-  x: integer;
-begin
-  {initial values}
-  Result := False;
-  FResultCode := 500;
-  FResultString := '';
-  FDownloadSize := 0;
-  FUploadSize := 0;
-
-  URI := ParseURL(URL, Prot, User, Pass, Host, Port, Path, Para);
-  if User = '' then
-  begin
-    User := FUsername;
-    Pass := FPassword;
-  end;
-  if UpperCase(Prot) = 'HTTPS' then
-  begin
-    HttpTunnel := FProxyHost <> '';
-    FSock.HTTPTunnelIP := FProxyHost;
-    FSock.HTTPTunnelPort := FProxyPort;
-    FSock.HTTPTunnelUser := FProxyUser;
-    FSock.HTTPTunnelPass := FProxyPass;
-  end
-  else
-  begin
-    HttpTunnel := False;
-    FSock.HTTPTunnelIP := '';
-    FSock.HTTPTunnelPort := '';
-    FSock.HTTPTunnelUser := '';
-    FSock.HTTPTunnelPass := '';
-  end;
-  UsingProxy := (FProxyHost <> '') and not(HttpTunnel);
-  Sending := FDocument.Size > 0;
-  {Headers for Sending data}
-  status100 := FStatus100 and Sending and (FProtocol = '1.1');
-  if status100 then
-    FHeaders.Insert(0, 'Expect: 100-continue');
-  if Sending then
-  begin
-    FHeaders.Insert(0, 'Content-Length: ' + IntToStr(FDocument.Size));
-    if FMimeType <> '' then
-      FHeaders.Insert(0, 'Content-Type: ' + FMimeType);
-  end;
-  { setting User-agent }
-  if FUserAgent <> '' then
-    FHeaders.Insert(0, 'User-Agent: ' + FUserAgent);
-  { setting Ranges }
-  if (FRangeStart > 0) or (FRangeEnd > 0) then
-  begin
-    if FRangeEnd >= FRangeStart then
-      FHeaders.Insert(0, 'Range: bytes=' + IntToStr(FRangeStart) + '-' + IntToStr(FRangeEnd))
-    else
-      FHeaders.Insert(0, 'Range: bytes=' + IntToStr(FRangeStart) + '-');
-  end;
-  { setting Cookies }
-  s := '';
-  for n := 0 to FCookies.Count - 1 do
-  begin
-    if s <> '' then
-      s := s + '; ';
-    s := s + FCookies[n];
-  end;
-  if s <> '' then
-    FHeaders.Insert(0, 'Cookie: ' + s);
-  { setting KeepAlives }
-  pp := '';
-  if UsingProxy then
-    pp := 'Proxy-';
-  if FKeepAlive then
-  begin
-    FHeaders.Insert(0, pp + 'Connection: keep-alive');
-    FHeaders.Insert(0, 'Keep-Alive: ' + IntToStr(FKeepAliveTimeout));
-  end
-  else
-    FHeaders.Insert(0, pp + 'Connection: close');
-  { set target servers/proxy, authorizations, etc... }
-  if User <> '' then
-    FHeaders.Insert(0, 'Authorization: Basic ' + EncodeBase64(User + ':' + Pass));
-  if UsingProxy and (FProxyUser <> '') then
-    FHeaders.Insert(0, 'Proxy-Authorization: Basic ' +
-      EncodeBase64(FProxyUser + ':' + FProxyPass));
-  if isIP6(Host) then
-    s := '[' + Host + ']'
-  else
-    s := Host;
-  if FAddPortNumberToHost and (Port <> '80') then
-     FHeaders.Insert(0, 'Host: ' + s + ':' + Port)
-  else
-     FHeaders.Insert(0, 'Host: ' + s);
-  if UsingProxy then
-    URI := Prot + '://' + s + ':' + Port + URI;
-  if URI = '/*' then
-    URI := '*';
-  if FProtocol = '0.9' then
-    FHeaders.Insert(0, UpperCase(Method) + ' ' + URI)
-  else
-    FHeaders.Insert(0, UpperCase(Method) + ' ' + URI + ' HTTP/' + FProtocol);
-  if UsingProxy then
-  begin
-    FTargetHost := FProxyHost;
-    FTargetPort := FProxyPort;
-  end
-  else
-  begin
-    FTargetHost := Host;
-    FTargetPort := Port;
-  end;
-  if FHeaders[FHeaders.Count - 1] <> '' then
-    FHeaders.Add('');
-
-  { connect }
-  if not InternalConnect(UpperCase(Prot) = 'HTTPS') then
-  begin
-    FAliveHost := '';
-    FAlivePort := '';
-    Exit;
-  end;
-
-  { reading Status }
-  FDocument.Position := 0;
-  Status100Error := '';
-  if status100 then
-  begin
-    { send Headers }
-    FSock.SendString(PrepareHeaders);
-    if FSock.LastError <> 0 then
-      Exit;
-    repeat
-      s := FSock.RecvString(FTimeout);
-      if s <> '' then
-        Break;
-    until FSock.LastError <> 0;
-    DecodeStatus(s);
-    Status100Error := s;
-    repeat
-      s := FSock.recvstring(FTimeout);
-      if s = '' then
-        Break;
-    until FSock.LastError <> 0;
-    if (FResultCode >= 100) and (FResultCode < 200) then
-    begin
-      { we can upload content }
-      Status100Error := '';
-      FUploadSize := FDocument.Size;
-      FSock.SendBuffer(FDocument.Memory, FDocument.Size);
-    end;
-  end
-  else
-    { upload content }
-    if sending then
-    begin
-      if FDocument.Size >= c64k then
-      begin
-        FSock.SendString(PrepareHeaders);
-        FUploadSize := FDocument.Size;
-        FSock.SendBuffer(FDocument.Memory, FDocument.Size);
-      end
-      else
-      begin
-        s := PrepareHeaders + ReadStrFromStream(FDocument, FDocument.Size);
-        FUploadSize := Length(s);
-        FSock.SendString(s);
-      end;
-    end
-    else
-    begin
-      { we not need to upload document, send headers only }
-      FSock.SendString(PrepareHeaders);
-    end;
-
-  if FSock.LastError <> 0 then
-    Exit;
-
-  Clear;
-  Size := -1;
-  FTransferEncoding := TE_UNKNOWN;
-
-  { read status }
-  if Status100Error = '' then
-  begin
-    repeat
-      repeat
-        s := FSock.RecvString(FTimeout);
-        if s <> '' then
-          Break;
-      until FSock.LastError <> 0;
-      if Pos('HTTP/', UpperCase(s)) = 1 then
-      begin
-        FHeaders.Add(s);
-        DecodeStatus(s);
-      end
-      else
-      begin
-        { old HTTP 0.9 and some buggy servers not send result }
-        s := s + CRLF;
-        WriteStrToStream(FDocument, s);
-        FResultCode := 0;
-      end;
-    until (FSock.LastError <> 0) or (FResultCode <> 100);
-  end
-  else
-    FHeaders.Add(Status100Error);
-
-  { if need receive headers, receive and parse it }
-  ToClose := FProtocol <> '1.1';
-  if FHeaders.Count > 0 then
-  begin
-    l := TStringList.Create;
-    try
-      repeat
-        s := FSock.RecvString(FTimeout);
-        l.Add(s);
-        if s = '' then
-          Break;
-      until FSock.LastError <> 0;
-      x := 0;
-      while l.Count > x do
-      begin
-        s := NormalizeHeader(l, x);
-        FHeaders.Add(s);
-        su := UpperCase(s);
-        if Pos('CONTENT-LENGTH:', su) = 1 then
-        begin
-          Size := StrToIntDef(Trim(SeparateRight(s, ' ')), -1);
-          if (Size <> -1) and (FTransferEncoding = TE_UNKNOWN) then
-            FTransferEncoding := TE_IDENTITY;
-        end;
-        if Pos('CONTENT-TYPE:', su) = 1 then
-          FMimeType := Trim(SeparateRight(s, ' '));
-        if Pos('TRANSFER-ENCODING:', su) = 1 then
-        begin
-          s := Trim(SeparateRight(su, ' '));
-          if Pos('CHUNKED', s) > 0 then
-            FTransferEncoding := TE_CHUNKED;
-        end;
-        if UsingProxy then
-        begin
-          if Pos('PROXY-CONNECTION:', su) = 1 then
-            if Pos('CLOSE', su) > 0 then
-              ToClose := True;
-        end
-        else
-        begin
-          if Pos('CONNECTION:', su) = 1 then
-            if Pos('CLOSE', su) > 0 then
-              ToClose := True;
-        end;
-      end;
-    finally
-      l.free;
-    end;
-  end;
-
-  Result := FSock.LastError = 0;
-  if not Result then
-    Exit;
-
-  {if need receive response body, read it}
-  Receiving := Method <> 'HEAD';
-  Receiving := Receiving and (FResultCode <> 204);
-  Receiving := Receiving and (FResultCode <> 304);
-  if Receiving then
-    case FTransferEncoding of
-      TE_UNKNOWN:
-        Result := ReadUnknown;
-      TE_IDENTITY:
-        Result := ReadIdentity(Size);
-      TE_CHUNKED:
-        Result := ReadChunked;
-    end;
-
-  FDocument.Seek(0, soFromBeginning);
-  if ToClose then
-  begin
-    FSock.CloseSocket;
-    FAliveHost := '';
-    FAlivePort := '';
-  end;
-  ParseCookies;
-end;
-
-function THTTPSend.ReadUnknown: Boolean;
-var
-  s: string;
-begin
-  Result := false;
-  repeat
-    s := FSock.RecvPacket(FTimeout);
-    if FSock.LastError = 0 then
-      WriteStrToStream(FDocument, s);
-  until FSock.LastError <> 0;
-  if FSock.LastError = WSAECONNRESET then
-  begin
-    Result := true;
-    FSock.ResetLastError;
-  end;
-end;
-
-function THTTPSend.ReadIdentity(Size: Integer): Boolean;
-begin
-  if Size > 0 then
-  begin
-    FDownloadSize := Size;
-    FSock.RecvStreamSize(FDocument, FTimeout, Size);
-    FDocument.Position := FDocument.Size;
-    Result := FSock.LastError = 0;
-  end
-  else
-    Result := true;
-end;
-
-function THTTPSend.ReadChunked: Boolean;
-var
-  s: string;
-  Size: Integer;
-begin
-  repeat
-    repeat
-      s := FSock.RecvString(FTimeout);
-    until (s <> '') or (FSock.LastError <> 0);
-    if FSock.LastError <> 0 then
-      Break;
-    s := Trim(SeparateLeft(s, ' '));
-    s := Trim(SeparateLeft(s, ';'));
-    Size := StrToIntDef('$' + s, 0);
-    if Size = 0 then
-      Break;
-    if not ReadIdentity(Size) then
-      break;
-  until False;
-  Result := FSock.LastError = 0;
-end;
-
-procedure THTTPSend.ParseCookies;
-var
-  n: integer;
-  s: string;
-  sn, sv: string;
-begin
-  for n := 0 to FHeaders.Count - 1 do
-    if Pos('set-cookie:', lowercase(FHeaders[n])) = 1 then
-    begin
-      s := SeparateRight(FHeaders[n], ':');
-      s := trim(SeparateLeft(s, ';'));
-      sn := trim(SeparateLeft(s, '='));
-      sv := trim(SeparateRight(s, '='));
-      FCookies.Values[sn] := sv;
-    end;
-end;
-
-procedure THTTPSend.Abort;
-begin
-  FSock.StopFlag := True;
-end;
-
-{==============================================================================}
-
-function HttpGetText(const URL: string; const Response: TStrings): Boolean;
-var
-  HTTP: THTTPSend;
-begin
-  HTTP := THTTPSend.Create;
-  try
-    Result := HTTP.HTTPMethod('GET', URL);
-    if Result then
-      Response.LoadFromStream(HTTP.Document);
-  finally
-    HTTP.Free;
-  end;
-end;
-
-function HttpGetBinary(const URL: string; const Response: TStream): Boolean;
-var
-  HTTP: THTTPSend;
-begin
-  HTTP := THTTPSend.Create;
-  try
-    Result := HTTP.HTTPMethod('GET', URL);
-    if Result then
-    begin
-      Response.Seek(0, soFromBeginning);
-      Response.CopyFrom(HTTP.Document, 0);
-    end;
-  finally
-    HTTP.Free;
-  end;
-end;
-
-function HttpPostBinary(const URL: string; const Data: TStream): Boolean;
-var
-  HTTP: THTTPSend;
-begin
-  HTTP := THTTPSend.Create;
-  try
-    HTTP.Document.CopyFrom(Data, 0);
-    HTTP.MimeType := 'Application/octet-stream';
-    Result := HTTP.HTTPMethod('POST', URL);
-    Data.Size := 0;
-    if Result then
-    begin
-      Data.Seek(0, soFromBeginning);
-      Data.CopyFrom(HTTP.Document, 0);
-    end;
-  finally
-    HTTP.Free;
-  end;
-end;
-
-function HttpPostURL(const URL, URLData: string; const Data: TStream): Boolean;
-var
-  HTTP: THTTPSend;
-begin
-  HTTP := THTTPSend.Create;
-  try
-    WriteStrToStream(HTTP.Document, URLData);
-    HTTP.MimeType := 'application/x-www-form-urlencoded';
-    Result := HTTP.HTTPMethod('POST', URL);
-    if Result then
-      Data.CopyFrom(HTTP.Document, 0);
-  finally
-    HTTP.Free;
-  end;
-end;
-
-function HttpPostFile(const URL, FieldName, FileName: string;
-  const Data: TStream; const ResultData: TStrings): Boolean;
-var
-  HTTP: THTTPSend;
-  Bound, s: string;
-begin
-  Bound := IntToHex(Random(MaxInt), 8) + '_Synapse_boundary';
-  HTTP := THTTPSend.Create;
-  try
-    s := '--' + Bound + CRLF;
-    s := s + 'content-disposition: form-data; name="' + FieldName + '";';
-    s := s + ' filename="' + FileName +'"' + CRLF;
-    s := s + 'Content-Type: Application/octet-string' + CRLF + CRLF;
-    WriteStrToStream(HTTP.Document, s);
-    HTTP.Document.CopyFrom(Data, 0);
-    s := CRLF + '--' + Bound + '--' + CRLF;
-    WriteStrToStream(HTTP.Document, s);
-    HTTP.MimeType := 'multipart/form-data; boundary=' + Bound;
-    Result := HTTP.HTTPMethod('POST', URL);
-    if Result then
-      ResultData.LoadFromStream(HTTP.Document);
-  finally
-    HTTP.Free;
-  end;
-end;
-
-end.
+{==============================================================================|
+| Project : Ararat Synapse                                       | 003.012.004 |
+|==============================================================================|
+| Content: HTTP client                                                         |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c) 1999-2010.               |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@abstract(HTTP protocol client)
+
+Used RFC: RFC-1867, RFC-1947, RFC-2388, RFC-2616
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+//old Delphi does not have MSWINDOWS define.
+{$IFDEF WIN32}
+  {$IFNDEF MSWINDOWS}
+    {$DEFINE MSWINDOWS}
+  {$ENDIF}
+{$ENDIF}
+
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit httpsend;
+
+interface
+
+uses
+  SysUtils, Classes,
+  blcksock, synautil, synaip, synacode, synsock;
+
+const
+  cHttpProtocol = '80';
+
+type
+  {:These encoding types are used internally by the THTTPSend object to identify
+   the transfer data types.}
+  TTransferEncoding = (TE_UNKNOWN, TE_IDENTITY, TE_CHUNKED);
+
+  {:abstract(Implementation of HTTP protocol.)}
+  THTTPSend = class(TSynaClient)
+  protected
+    FSock: TTCPBlockSocket;
+    FTransferEncoding: TTransferEncoding;
+    FAliveHost: string;
+    FAlivePort: string;
+    FHeaders: TStringList;
+    FDocument: TMemoryStream;
+    FMimeType: string;
+    FProtocol: string;
+    FKeepAlive: Boolean;
+    FKeepAliveTimeout: integer;
+    FStatus100: Boolean;
+    FProxyHost: string;
+    FProxyPort: string;
+    FProxyUser: string;
+    FProxyPass: string;
+    FResultCode: Integer;
+    FResultString: string;
+    FUserAgent: string;
+    FCookies: TStringList;
+    FDownloadSize: integer;
+    FUploadSize: integer;
+    FRangeStart: integer;
+    FRangeEnd: integer;
+    FAddPortNumberToHost: Boolean;
+    function ReadUnknown: Boolean;
+    function ReadIdentity(Size: Integer): Boolean;
+    function ReadChunked: Boolean;
+    procedure ParseCookies;
+    function PrepareHeaders: string;
+    function InternalDoConnect(needssl: Boolean): Boolean;
+    function InternalConnect(needssl: Boolean): Boolean;
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    {:Reset headers and document and Mimetype.}
+    procedure Clear;
+
+    {:Decode ResultCode and ResultString from Value.}
+    procedure DecodeStatus(const Value: string);
+
+    {:Connects to host define in URL and access to resource defined in URL by
+     method. If Document is not empty, send it to server as part of HTTP request.
+     Server response is in Document and headers. Connection may be authorised
+     by username and password in URL. If you define proxy properties, connection
+     is made by this proxy. If all OK, result is @true, else result is @false.
+
+     If you use in URL 'https:' instead only 'http:', then your request is made
+     by SSL/TLS connection (if you not specify port, then port 443 is used
+     instead standard port 80). If you use SSL/TLS request and you have defined
+     HTTP proxy, then HTTP-tunnel mode is automaticly used .}
+    function HTTPMethod(const Method, URL: string): Boolean;
+
+    {:You can call this method from OnStatus event for break current data
+     transfer. (or from another thread.)}
+    procedure Abort;
+  published
+    {:Before HTTP operation you may define any non-standard headers for HTTP
+     request, except of: 'Expect: 100-continue', 'Content-Length', 'Content-Type',
+     'Connection', 'Authorization', 'Proxy-Authorization' and 'Host' headers.
+     After HTTP operation contains full headers of returned document.}
+    property Headers: TStringList read FHeaders;
+
+    {:This is stringlist with name-value stringlist pairs. Each this pair is one
+     cookie. After HTTP request is returned cookies parsed to this stringlist.
+     You can leave this cookies untouched for next HTTP request. You can also
+     save this stringlist for later use.}
+    property Cookies: TStringList read FCookies;
+
+    {:Stream with document to send (before request, or with document received
+     from HTTP server (after request).}
+    property Document: TMemoryStream read FDocument;
+
+    {:If you need download only part of requested document, here specify
+     possition of subpart begin. If here 0, then is requested full document.}
+    property RangeStart: integer read FRangeStart Write FRangeStart;
+
+    {:If you need download only part of requested document, here specify
+     possition of subpart end. If here 0, then is requested document from
+     rangeStart to end of document. (for broken download restoration,
+     for example.)}
+    property RangeEnd: integer read FRangeEnd Write FRangeEnd;
+
+    {:Mime type of sending data. Default is: 'text/html'.}
+    property MimeType: string read FMimeType Write FMimeType;
+
+    {:Define protocol version. Possible values are: '1.1', '1.0' (default)
+     and '0.9'.}
+    property Protocol: string read FProtocol Write FProtocol;
+
+    {:If @true (default value), keepalives in HTTP protocol 1.1 is enabled.}
+    property KeepAlive: Boolean read FKeepAlive Write FKeepAlive;
+
+    {:Define timeout for keepalives in seconds!}
+    property KeepAliveTimeout: integer read FKeepAliveTimeout Write FKeepAliveTimeout;
+
+    {:if @true, then server is requested for 100status capability when uploading
+     data. Default is @false (off).}
+    property Status100: Boolean read FStatus100 Write FStatus100;
+
+    {:Address of proxy server (IP address or domain name) where you want to
+     connect in @link(HTTPMethod) method.}
+    property ProxyHost: string read FProxyHost Write FProxyHost;
+
+    {:Port number for proxy connection. Default value is 8080.}
+    property ProxyPort: string read FProxyPort Write FProxyPort;
+
+    {:Username for connect to proxy server where you want to connect in
+     HTTPMethod method.}
+    property ProxyUser: string read FProxyUser Write FProxyUser;
+
+    {:Password for connect to proxy server where you want to connect in
+     HTTPMethod method.}
+    property ProxyPass: string read FProxyPass Write FProxyPass;
+
+    {:Here you can specify custom User-Agent indentification. By default is
+     used: 'Mozilla/4.0 (compatible; Synapse)'}
+    property UserAgent: string read FUserAgent Write FUserAgent;
+
+    {:After successful @link(HTTPMethod) method contains result code of
+     operation.}
+    property ResultCode: Integer read FResultCode;
+
+    {:After successful @link(HTTPMethod) method contains string after result code.}
+    property ResultString: string read FResultString;
+
+    {:if this value is not 0, then data download pending. In this case you have
+     here total sice of downloaded data. It is good for draw download
+     progressbar from OnStatus event.}
+    property DownloadSize: integer read FDownloadSize;
+
+    {:if this value is not 0, then data upload pending. In this case you have
+     here total sice of uploaded data. It is good for draw upload progressbar
+     from OnStatus event.}
+    property UploadSize: integer read FUploadSize;
+    {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
+    property Sock: TTCPBlockSocket read FSock;
+
+    {:To have possibility to switch off port number in 'Host:' HTTP header, by
+    default @TRUE. Some buggy servers not like port informations in this header.}
+    property AddPortNumberToHost: Boolean read FAddPortNumberToHost write FAddPortNumberToHost;
+  end;
+
+{:A very usefull function, and example of use can be found in the THTTPSend
+ object. It implements the GET method of the HTTP protocol. This function sends
+ the GET method for URL document to an HTTP server. Returned document is in the
+ "Response" stringlist (without any headers). Returns boolean TRUE if all went
+ well.}
+function HttpGetText(const URL: string; const Response: TStrings): Boolean;
+
+{:A very usefull function, and example of use can be found in the THTTPSend
+ object. It implements the GET method of the HTTP protocol. This function sends
+ the GET method for URL document to an HTTP server. Returned document is in the
+ "Response" stream. Returns boolean TRUE if all went well.}
+function HttpGetBinary(const URL: string; const Response: TStream): Boolean;
+
+{:A very useful function, and example of use can be found in the THTTPSend
+ object. It implements the POST method of the HTTP protocol. This function sends
+ the SEND method for a URL document to an HTTP server. The document to be sent
+ is located in "Data" stream. The returned document is in the "Data" stream.
+ Returns boolean TRUE if all went well.}
+function HttpPostBinary(const URL: string; const Data: TStream): Boolean;
+
+{:A very useful function, and example of use can be found in the THTTPSend
+ object. It implements the POST method of the HTTP protocol. This function is
+ good for POSTing form data. It sends the POST method for a URL document to
+ an HTTP server. You must prepare the form data in the same manner as you would
+ the URL data, and pass this prepared data to "URLdata". The following is
+ a sample of how the data would appear: 'name=Lukas&field1=some%20data'.
+ The information in the field must be encoded by EncodeURLElement function.
+ The returned document is in the "Data" stream. Returns boolean TRUE if all
+ went well.}
+function HttpPostURL(const URL, URLData: string; const Data: TStream): Boolean;
+
+{:A very useful function, and example of use can be found in the THTTPSend
+ object. It implements the POST method of the HTTP protocol. This function sends
+ the POST method for a URL document to an HTTP server. This function simulate
+ posting of file by HTML form used method 'multipart/form-data'. Posting file
+ is in DATA stream. Its name is Filename string. Fieldname is for name of
+ formular field with file. (simulate HTML INPUT FILE) The returned document is
+ in the ResultData Stringlist. Returns boolean TRUE if all went well.}
+function HttpPostFile(const URL, FieldName, FileName: string;
+  const Data: TStream; const ResultData: TStrings): Boolean;
+
+implementation
+
+constructor THTTPSend.Create;
+begin
+  inherited Create;
+  FHeaders := TStringList.Create;
+  FCookies := TStringList.Create;
+  FDocument := TMemoryStream.Create;
+  FSock := TTCPBlockSocket.Create;
+  FSock.Owner := self;
+  FSock.ConvertLineEnd := True;
+  FSock.SizeRecvBuffer := c64k;
+  FSock.SizeSendBuffer := c64k;
+  FTimeout := 90000;
+  FTargetPort := cHttpProtocol;
+  FProxyHost := '';
+  FProxyPort := '8080';
+  FProxyUser := '';
+  FProxyPass := '';
+  FAliveHost := '';
+  FAlivePort := '';
+  FProtocol := '1.0';
+  FKeepAlive := True;
+  FStatus100 := False;
+  FUserAgent := 'Mozilla/4.0 (compatible; Synapse)';
+  FDownloadSize := 0;
+  FUploadSize := 0;
+  FAddPortNumberToHost := true;
+  FKeepAliveTimeout := 300;
+  Clear;
+end;
+
+destructor THTTPSend.Destroy;
+begin
+  FSock.Free;
+  FDocument.Free;
+  FCookies.Free;
+  FHeaders.Free;
+  inherited Destroy;
+end;
+
+procedure THTTPSend.Clear;
+begin
+  FRangeStart := 0;
+  FRangeEnd := 0;
+  FDocument.Clear;
+  FHeaders.Clear;
+  FMimeType := 'text/html';
+end;
+
+procedure THTTPSend.DecodeStatus(const Value: string);
+var
+  s, su: string;
+begin
+  s := Trim(SeparateRight(Value, ' '));
+  su := Trim(SeparateLeft(s, ' '));
+  FResultCode := StrToIntDef(su, 0);
+  FResultString := Trim(SeparateRight(s, ' '));
+  if FResultString = s then
+    FResultString := '';
+end;
+
+function THTTPSend.PrepareHeaders: string;
+begin
+  if FProtocol = '0.9' then
+    Result := FHeaders[0] + CRLF
+  else
+{$IFNDEF MSWINDOWS}
+    Result := AdjustLineBreaks(FHeaders.Text, tlbsCRLF);
+{$ELSE}
+    Result := FHeaders.Text;
+{$ENDIF}
+end;
+
+function THTTPSend.InternalDoConnect(needssl: Boolean): Boolean;
+begin
+  Result := False;
+  FSock.CloseSocket;
+  FSock.Bind(FIPInterface, cAnyPort);
+  if FSock.LastError <> 0 then
+    Exit;
+  FSock.Connect(FTargetHost, FTargetPort);
+  if FSock.LastError <> 0 then
+    Exit;
+  if needssl then
+  begin
+    FSock.SSLDoConnect;
+    if FSock.LastError <> 0 then
+      Exit;
+  end;
+  FAliveHost := FTargetHost;
+  FAlivePort := FTargetPort;
+  Result := True;
+end;
+
+function THTTPSend.InternalConnect(needssl: Boolean): Boolean;
+begin
+  if FSock.Socket = INVALID_SOCKET then
+    Result := InternalDoConnect(needssl)
+  else
+    if (FAliveHost <> FTargetHost) or (FAlivePort <> FTargetPort)
+      or FSock.CanRead(0) then
+      Result := InternalDoConnect(needssl)
+    else
+      Result := True;
+end;
+
+function THTTPSend.HTTPMethod(const Method, URL: string): Boolean;
+var
+  Sending, Receiving: Boolean;
+  status100: Boolean;
+  status100error: string;
+  ToClose: Boolean;
+  Size: Integer;
+  Prot, User, Pass, Host, Port, Path, Para, URI: string;
+  s, su: string;
+  HttpTunnel: Boolean;
+  n: integer;
+  pp: string;
+  UsingProxy: boolean;
+  l: TStringList;
+  x: integer;
+begin
+  {initial values}
+  Result := False;
+  FResultCode := 500;
+  FResultString := '';
+  FDownloadSize := 0;
+  FUploadSize := 0;
+
+  URI := ParseURL(URL, Prot, User, Pass, Host, Port, Path, Para);
+  if User = '' then
+  begin
+    User := FUsername;
+    Pass := FPassword;
+  end;
+  if UpperCase(Prot) = 'HTTPS' then
+  begin
+    HttpTunnel := FProxyHost <> '';
+    FSock.HTTPTunnelIP := FProxyHost;
+    FSock.HTTPTunnelPort := FProxyPort;
+    FSock.HTTPTunnelUser := FProxyUser;
+    FSock.HTTPTunnelPass := FProxyPass;
+  end
+  else
+  begin
+    HttpTunnel := False;
+    FSock.HTTPTunnelIP := '';
+    FSock.HTTPTunnelPort := '';
+    FSock.HTTPTunnelUser := '';
+    FSock.HTTPTunnelPass := '';
+  end;
+  UsingProxy := (FProxyHost <> '') and not(HttpTunnel);
+  Sending := FDocument.Size > 0;
+  {Headers for Sending data}
+  status100 := FStatus100 and Sending and (FProtocol = '1.1');
+  if status100 then
+    FHeaders.Insert(0, 'Expect: 100-continue');
+  if Sending then
+  begin
+    FHeaders.Insert(0, 'Content-Length: ' + IntToStr(FDocument.Size));
+    if FMimeType <> '' then
+      FHeaders.Insert(0, 'Content-Type: ' + FMimeType);
+  end;
+  { setting User-agent }
+  if FUserAgent <> '' then
+    FHeaders.Insert(0, 'User-Agent: ' + FUserAgent);
+  { setting Ranges }
+  if (FRangeStart > 0) or (FRangeEnd > 0) then
+  begin
+    if FRangeEnd >= FRangeStart then
+      FHeaders.Insert(0, 'Range: bytes=' + IntToStr(FRangeStart) + '-' + IntToStr(FRangeEnd))
+    else
+      FHeaders.Insert(0, 'Range: bytes=' + IntToStr(FRangeStart) + '-');
+  end;
+  { setting Cookies }
+  s := '';
+  for n := 0 to FCookies.Count - 1 do
+  begin
+    if s <> '' then
+      s := s + '; ';
+    s := s + FCookies[n];
+  end;
+  if s <> '' then
+    FHeaders.Insert(0, 'Cookie: ' + s);
+  { setting KeepAlives }
+  pp := '';
+  if UsingProxy then
+    pp := 'Proxy-';
+  if FKeepAlive then
+  begin
+    FHeaders.Insert(0, pp + 'Connection: keep-alive');
+    FHeaders.Insert(0, 'Keep-Alive: ' + IntToStr(FKeepAliveTimeout));
+  end
+  else
+    FHeaders.Insert(0, pp + 'Connection: close');
+  { set target servers/proxy, authorizations, etc... }
+  if User <> '' then
+    FHeaders.Insert(0, 'Authorization: Basic ' + EncodeBase64(User + ':' + Pass));
+  if UsingProxy and (FProxyUser <> '') then
+    FHeaders.Insert(0, 'Proxy-Authorization: Basic ' +
+      EncodeBase64(FProxyUser + ':' + FProxyPass));
+  if isIP6(Host) then
+    s := '[' + Host + ']'
+  else
+    s := Host;
+  if FAddPortNumberToHost and (Port <> '80') then
+     FHeaders.Insert(0, 'Host: ' + s + ':' + Port)
+  else
+     FHeaders.Insert(0, 'Host: ' + s);
+  if UsingProxy then
+    URI := Prot + '://' + s + ':' + Port + URI;
+  if URI = '/*' then
+    URI := '*';
+  if FProtocol = '0.9' then
+    FHeaders.Insert(0, UpperCase(Method) + ' ' + URI)
+  else
+    FHeaders.Insert(0, UpperCase(Method) + ' ' + URI + ' HTTP/' + FProtocol);
+  if UsingProxy then
+  begin
+    FTargetHost := FProxyHost;
+    FTargetPort := FProxyPort;
+  end
+  else
+  begin
+    FTargetHost := Host;
+    FTargetPort := Port;
+  end;
+  if FHeaders[FHeaders.Count - 1] <> '' then
+    FHeaders.Add('');
+
+  { connect }
+  if not InternalConnect(UpperCase(Prot) = 'HTTPS') then
+  begin
+    FAliveHost := '';
+    FAlivePort := '';
+    Exit;
+  end;
+
+  { reading Status }
+  FDocument.Position := 0;
+  Status100Error := '';
+  if status100 then
+  begin
+    { send Headers }
+    FSock.SendString(PrepareHeaders);
+    if FSock.LastError <> 0 then
+      Exit;
+    repeat
+      s := FSock.RecvString(FTimeout);
+      if s <> '' then
+        Break;
+    until FSock.LastError <> 0;
+    DecodeStatus(s);
+    Status100Error := s;
+    repeat
+      s := FSock.recvstring(FTimeout);
+      if s = '' then
+        Break;
+    until FSock.LastError <> 0;
+    if (FResultCode >= 100) and (FResultCode < 200) then
+    begin
+      { we can upload content }
+      Status100Error := '';
+      FUploadSize := FDocument.Size;
+      FSock.SendBuffer(FDocument.Memory, FDocument.Size);
+    end;
+  end
+  else
+    { upload content }
+    if sending then
+    begin
+      if FDocument.Size >= c64k then
+      begin
+        FSock.SendString(PrepareHeaders);
+        FUploadSize := FDocument.Size;
+        FSock.SendBuffer(FDocument.Memory, FDocument.Size);
+      end
+      else
+      begin
+        s := PrepareHeaders + ReadStrFromStream(FDocument, FDocument.Size);
+        FUploadSize := Length(s);
+        FSock.SendString(s);
+      end;
+    end
+    else
+    begin
+      { we not need to upload document, send headers only }
+      FSock.SendString(PrepareHeaders);
+    end;
+
+  if FSock.LastError <> 0 then
+    Exit;
+
+  Clear;
+  Size := -1;
+  FTransferEncoding := TE_UNKNOWN;
+
+  { read status }
+  if Status100Error = '' then
+  begin
+    repeat
+      repeat
+        s := FSock.RecvString(FTimeout);
+        if s <> '' then
+          Break;
+      until FSock.LastError <> 0;
+      if Pos('HTTP/', UpperCase(s)) = 1 then
+      begin
+        FHeaders.Add(s);
+        DecodeStatus(s);
+      end
+      else
+      begin
+        { old HTTP 0.9 and some buggy servers not send result }
+        s := s + CRLF;
+        WriteStrToStream(FDocument, s);
+        FResultCode := 0;
+      end;
+    until (FSock.LastError <> 0) or (FResultCode <> 100);
+  end
+  else
+    FHeaders.Add(Status100Error);
+
+  { if need receive headers, receive and parse it }
+  ToClose := FProtocol <> '1.1';
+  if FHeaders.Count > 0 then
+  begin
+    l := TStringList.Create;
+    try
+      repeat
+        s := FSock.RecvString(FTimeout);
+        l.Add(s);
+        if s = '' then
+          Break;
+      until FSock.LastError <> 0;
+      x := 0;
+      while l.Count > x do
+      begin
+        s := NormalizeHeader(l, x);
+        FHeaders.Add(s);
+        su := UpperCase(s);
+        if Pos('CONTENT-LENGTH:', su) = 1 then
+        begin
+          Size := StrToIntDef(Trim(SeparateRight(s, ' ')), -1);
+          if (Size <> -1) and (FTransferEncoding = TE_UNKNOWN) then
+            FTransferEncoding := TE_IDENTITY;
+        end;
+        if Pos('CONTENT-TYPE:', su) = 1 then
+          FMimeType := Trim(SeparateRight(s, ' '));
+        if Pos('TRANSFER-ENCODING:', su) = 1 then
+        begin
+          s := Trim(SeparateRight(su, ' '));
+          if Pos('CHUNKED', s) > 0 then
+            FTransferEncoding := TE_CHUNKED;
+        end;
+        if UsingProxy then
+        begin
+          if Pos('PROXY-CONNECTION:', su) = 1 then
+            if Pos('CLOSE', su) > 0 then
+              ToClose := True;
+        end
+        else
+        begin
+          if Pos('CONNECTION:', su) = 1 then
+            if Pos('CLOSE', su) > 0 then
+              ToClose := True;
+        end;
+      end;
+    finally
+      l.free;
+    end;
+  end;
+
+  Result := FSock.LastError = 0;
+  if not Result then
+    Exit;
+
+  {if need receive response body, read it}
+  Receiving := Method <> 'HEAD';
+  Receiving := Receiving and (FResultCode <> 204);
+  Receiving := Receiving and (FResultCode <> 304);
+  if Receiving then
+    case FTransferEncoding of
+      TE_UNKNOWN:
+        Result := ReadUnknown;
+      TE_IDENTITY:
+        Result := ReadIdentity(Size);
+      TE_CHUNKED:
+        Result := ReadChunked;
+    end;
+
+  FDocument.Seek(0, soFromBeginning);
+  if ToClose then
+  begin
+    FSock.CloseSocket;
+    FAliveHost := '';
+    FAlivePort := '';
+  end;
+  ParseCookies;
+end;
+
+function THTTPSend.ReadUnknown: Boolean;
+var
+  s: string;
+begin
+  Result := false;
+  repeat
+    s := FSock.RecvPacket(FTimeout);
+    if FSock.LastError = 0 then
+      WriteStrToStream(FDocument, s);
+  until FSock.LastError <> 0;
+  if FSock.LastError = WSAECONNRESET then
+  begin
+    Result := true;
+    FSock.ResetLastError;
+  end;
+end;
+
+function THTTPSend.ReadIdentity(Size: Integer): Boolean;
+begin
+  if Size > 0 then
+  begin
+    FDownloadSize := Size;
+    FSock.RecvStreamSize(FDocument, FTimeout, Size);
+    FDocument.Position := FDocument.Size;
+    Result := FSock.LastError = 0;
+  end
+  else
+    Result := true;
+end;
+
+function THTTPSend.ReadChunked: Boolean;
+var
+  s: string;
+  Size: Integer;
+begin
+  repeat
+    repeat
+      s := FSock.RecvString(FTimeout);
+    until (s <> '') or (FSock.LastError <> 0);
+    if FSock.LastError <> 0 then
+      Break;
+    s := Trim(SeparateLeft(s, ' '));
+    s := Trim(SeparateLeft(s, ';'));
+    Size := StrToIntDef('$' + s, 0);
+    if Size = 0 then
+      Break;
+    if not ReadIdentity(Size) then
+      break;
+  until False;
+  Result := FSock.LastError = 0;
+end;
+
+procedure THTTPSend.ParseCookies;
+var
+  n: integer;
+  s: string;
+  sn, sv: string;
+begin
+  for n := 0 to FHeaders.Count - 1 do
+    if Pos('set-cookie:', lowercase(FHeaders[n])) = 1 then
+    begin
+      s := SeparateRight(FHeaders[n], ':');
+      s := trim(SeparateLeft(s, ';'));
+      sn := trim(SeparateLeft(s, '='));
+      sv := trim(SeparateRight(s, '='));
+      FCookies.Values[sn] := sv;
+    end;
+end;
+
+procedure THTTPSend.Abort;
+begin
+  FSock.StopFlag := True;
+end;
+
+{==============================================================================}
+
+function HttpGetText(const URL: string; const Response: TStrings): Boolean;
+var
+  HTTP: THTTPSend;
+begin
+  HTTP := THTTPSend.Create;
+  try
+    Result := HTTP.HTTPMethod('GET', URL);
+    if Result then
+      Response.LoadFromStream(HTTP.Document);
+  finally
+    HTTP.Free;
+  end;
+end;
+
+function HttpGetBinary(const URL: string; const Response: TStream): Boolean;
+var
+  HTTP: THTTPSend;
+begin
+  HTTP := THTTPSend.Create;
+  try
+    Result := HTTP.HTTPMethod('GET', URL);
+    if Result then
+    begin
+      Response.Seek(0, soFromBeginning);
+      Response.CopyFrom(HTTP.Document, 0);
+    end;
+  finally
+    HTTP.Free;
+  end;
+end;
+
+function HttpPostBinary(const URL: string; const Data: TStream): Boolean;
+var
+  HTTP: THTTPSend;
+begin
+  HTTP := THTTPSend.Create;
+  try
+    HTTP.Document.CopyFrom(Data, 0);
+    HTTP.MimeType := 'Application/octet-stream';
+    Result := HTTP.HTTPMethod('POST', URL);
+    Data.Size := 0;
+    if Result then
+    begin
+      Data.Seek(0, soFromBeginning);
+      Data.CopyFrom(HTTP.Document, 0);
+    end;
+  finally
+    HTTP.Free;
+  end;
+end;
+
+function HttpPostURL(const URL, URLData: string; const Data: TStream): Boolean;
+var
+  HTTP: THTTPSend;
+begin
+  HTTP := THTTPSend.Create;
+  try
+    WriteStrToStream(HTTP.Document, URLData);
+    HTTP.MimeType := 'application/x-www-form-urlencoded';
+    Result := HTTP.HTTPMethod('POST', URL);
+    if Result then
+      Data.CopyFrom(HTTP.Document, 0);
+  finally
+    HTTP.Free;
+  end;
+end;
+
+function HttpPostFile(const URL, FieldName, FileName: string;
+  const Data: TStream; const ResultData: TStrings): Boolean;
+var
+  HTTP: THTTPSend;
+  Bound, s: string;
+begin
+  Bound := IntToHex(Random(MaxInt), 8) + '_Synapse_boundary';
+  HTTP := THTTPSend.Create;
+  try
+    s := '--' + Bound + CRLF;
+    s := s + 'content-disposition: form-data; name="' + FieldName + '";';
+    s := s + ' filename="' + FileName +'"' + CRLF;
+    s := s + 'Content-Type: Application/octet-string' + CRLF + CRLF;
+    WriteStrToStream(HTTP.Document, s);
+    HTTP.Document.CopyFrom(Data, 0);
+    s := CRLF + '--' + Bound + '--' + CRLF;
+    WriteStrToStream(HTTP.Document, s);
+    HTTP.MimeType := 'multipart/form-data; boundary=' + Bound;
+    Result := HTTP.HTTPMethod('POST', URL);
+    if Result then
+      ResultData.LoadFromStream(HTTP.Document);
+  finally
+    HTTP.Free;
+  end;
+end;
+
+end.
diff --git a/Units/Synapse/imapsend.pas b/Units/Synapse/imapsend.pas
index 55f5339..c1e1a0d 100644
--- a/Units/Synapse/imapsend.pas
+++ b/Units/Synapse/imapsend.pas
@@ -1,869 +1,869 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 002.005.002 |
-|==============================================================================|
-| Content: IMAP4rev1 client                                                    |
-|==============================================================================|
-| Copyright (c)1999-2010, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2001-2010.                |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{:@abstract(IMAP4 rev1 protocol client)
-
-Used RFC: RFC-2060, RFC-2595
-}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$H+}
-
-{$IFDEF UNICODE}
-  {$WARN IMPLICIT_STRING_CAST OFF}
-  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
-{$ENDIF}
-
-unit imapsend;
-
-interface
-
-uses
-  SysUtils, Classes,
-  blcksock, synautil;
-
-const
-  cIMAPProtocol = '143';
-
-type
-  {:@abstract(Implementation of IMAP4 protocol.)
-   Note: Are you missing properties for setting Username and Password? Look to
-   parent @link(TSynaClient) object!
-
-   Are you missing properties for specify server address and port? Look to
-   parent @link(TSynaClient) too!}
-  TIMAPSend = class(TSynaClient)
-  protected
-    FSock: TTCPBlockSocket;
-    FTagCommand: integer;
-    FResultString: string;
-    FFullResult: TStringList;
-    FIMAPcap: TStringList;
-    FAuthDone: Boolean;
-    FSelectedFolder: string;
-    FSelectedCount: integer;
-    FSelectedRecent: integer;
-    FSelectedUIDvalidity: integer;
-    FUID: Boolean;
-    FAutoTLS: Boolean;
-    FFullSSL: Boolean;
-    function ReadResult: string;
-    function AuthLogin: Boolean;
-    function Connect: Boolean;
-    procedure ParseMess(Value:TStrings);
-    procedure ParseFolderList(Value:TStrings);
-    procedure ParseSelect;
-    procedure ParseSearch(Value:TStrings);
-    procedure ProcessLiterals;
-  public
-    constructor Create;
-    destructor Destroy; override;
-
-    {:By this function you can call any IMAP command. Result of this command is
-     in adequate properties.}
-    function IMAPcommand(Value: string): string;
-
-    {:By this function you can call any IMAP command what need upload any data.
-     Result of this command is in adequate properties.}
-    function IMAPuploadCommand(Value: string; const Data:TStrings): string;
-
-    {:Call CAPABILITY command and fill IMAPcap property by new values.}
-    function Capability: Boolean;
-
-    {:Connect to IMAP server and do login to this server. This command begin
-     session.}
-    function Login: Boolean;
-
-    {:Disconnect from IMAP server and terminate session session. If exists some
-     deleted and non-purged messages, these messages are not deleted!}
-    function Logout: Boolean;
-
-    {:Do NOOP. It is for prevent disconnect by timeout.}
-    function NoOp: Boolean;
-
-    {:Lists folder names. You may specify level of listing. If you specify
-     FromFolder as empty string, return is all folders in system.}
-    function List(FromFolder: string; const FolderList: TStrings): Boolean;
-
-    {:Lists folder names what match search criteria. You may specify level of
-     listing. If you specify FromFolder as empty string, return is all folders
-     in system.}
-    function ListSearch(FromFolder, Search: string; const FolderList: TStrings): Boolean;
-
-    {:Lists subscribed folder names. You may specify level of listing. If you
-     specify FromFolder as empty string, return is all subscribed folders in
-     system.}
-    function ListSubscribed(FromFolder: string; const FolderList: TStrings): Boolean;
-
-    {:Lists subscribed folder names what matching search criteria. You may
-     specify level of listing. If you specify FromFolder as empty string, return
-     is all subscribed folders in system.}
-    function ListSearchSubscribed(FromFolder, Search: string; const FolderList: TStrings): Boolean;
-
-    {:Create a new folder.}
-    function CreateFolder(FolderName: string): Boolean;
-
-    {:Delete a folder.}
-    function DeleteFolder(FolderName: string): Boolean;
-
-    {:Rename folder names.}
-    function RenameFolder(FolderName, NewFolderName: string): Boolean;
-
-    {:Subscribe folder.}
-    function SubscribeFolder(FolderName: string): Boolean;
-
-    {:Unsubscribe folder.}
-    function UnsubscribeFolder(FolderName: string): Boolean;
-
-    {:Select folder.}
-    function SelectFolder(FolderName: string): Boolean;
-
-    {:Select folder, but only for reading. Any changes are not allowed!}
-    function SelectROFolder(FolderName: string): Boolean;
-
-    {:Close a folder. (end of Selected state)}
-    function CloseFolder: Boolean;
-
-    {:Ask for given status of folder. I.e. if you specify as value 'UNSEEN',
-     result is number of unseen messages in folder. For another status
-     indentificator check IMAP documentation and documentation of your IMAP
-     server (each IMAP server can have their own statuses.)}
-    function StatusFolder(FolderName, Value: string): integer;
-
-    {:Hardly delete all messages marked as 'deleted' in current selected folder.}
-    function ExpungeFolder: Boolean;
-
-    {:Touch to folder. (use as update status of folder, etc.)}
-    function CheckFolder: Boolean;
-
-    {:Append given message to specified folder.}
-    function AppendMess(ToFolder: string; const Mess: TStrings): Boolean;
-
-    {:'Delete' message from current selected folder. It mark message as Deleted.
-     Real deleting will be done after sucessfull @link(CloseFolder) or
-     @link(ExpungeFolder)}
-    function DeleteMess(MessID: integer): boolean;
-
-    {:Get full message from specified message in selected folder.}
-    function FetchMess(MessID: integer; const Mess: TStrings): Boolean;
-
-    {:Get message headers only from specified message in selected folder.}
-    function FetchHeader(MessID: integer; const Headers: TStrings): Boolean;
-
-    {:Return message size of specified message from current selected folder.}
-    function MessageSize(MessID: integer): integer;
-
-    {:Copy message from current selected folder to another folder.}
-    function CopyMess(MessID: integer; ToFolder: string): Boolean;
-
-    {:Return message numbers from currently selected folder as result
-     of searching. Search criteria is very complex language (see to IMAP
-     specification) similar to SQL (but not same syntax!).}
-    function SearchMess(Criteria: string; const FoundMess: TStrings): Boolean;
-
-    {:Sets flags of message from current selected folder.}
-    function SetFlagsMess(MessID: integer; Flags: string): Boolean;
-
-    {:Gets flags of message from current selected folder.}
-    function GetFlagsMess(MessID: integer; var Flags: string): Boolean;
-
-    {:Add flags to message's flags.}
-    function AddFlagsMess(MessID: integer; Flags: string): Boolean;
-
-    {:Remove flags from message's flags.}
-    function DelFlagsMess(MessID: integer; Flags: string): Boolean;
-
-    {:Call STARTTLS command for upgrade connection to SSL/TLS mode.}
-    function StartTLS: Boolean;
-
-    {:return UID of requested message ID.}
-    function GetUID(MessID: integer; var UID : Integer): Boolean;
-
-    {:Try to find given capabily in capabilty string returned from IMAP server.}
-    function FindCap(const Value: string): string;
-  published
-    {:Status line with result of last operation.}
-    property ResultString: string read FResultString;
-
-    {:Full result of last IMAP operation.}
-    property FullResult: TStringList read FFullResult;
-
-    {:List of server capabilites.}
-    property IMAPcap: TStringList read FIMAPcap;
-
-    {:Authorization is successful done.}
-    property AuthDone: Boolean read FAuthDone;
-
-    {:Turn on or off usage of UID (unicate identificator) of messages instead
-     only sequence numbers.}
-    property UID: Boolean read FUID Write FUID;
-
-    {:Name of currently selected folder.}
-    property SelectedFolder: string read FSelectedFolder;
-
-    {:Count of messages in currently selected folder.}
-    property SelectedCount: integer read FSelectedCount;
-
-    {:Count of not-visited messages in currently selected folder.}
-    property SelectedRecent: integer read FSelectedRecent;
-
-    {:This number with name of folder is unique indentificator of folder.
-     (If someone delete folder and next create new folder with exactly same name
-     of folder, this number is must be different!)}
-    property SelectedUIDvalidity: integer read FSelectedUIDvalidity;
-
-    {:If is set to true, then upgrade to SSL/TLS mode if remote server support it.}
-    property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
-
-    {:SSL/TLS mode is used from first contact to server. Servers with full
-     SSL/TLS mode usualy using non-standard TCP port!}
-    property FullSSL: Boolean read FFullSSL Write FFullSSL;
-
-    {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
-    property Sock: TTCPBlockSocket read FSock;
-  end;
-
-implementation
-
-constructor TIMAPSend.Create;
-begin
-  inherited Create;
-  FFullResult := TStringList.Create;
-  FIMAPcap := TStringList.Create;
-  FSock := TTCPBlockSocket.Create;
-  FSock.Owner := self;
-  FSock.ConvertLineEnd := True;
-  FSock.SizeRecvBuffer := 32768;
-  FSock.SizeSendBuffer := 32768;
-  FTimeout := 60000;
-  FTargetPort := cIMAPProtocol;
-  FTagCommand := 0;
-  FSelectedFolder := '';
-  FSelectedCount := 0;
-  FSelectedRecent := 0;
-  FSelectedUIDvalidity := 0;
-  FUID := False;
-  FAutoTLS := False;
-  FFullSSL := False;
-end;
-
-destructor TIMAPSend.Destroy;
-begin
-  FSock.Free;
-  FIMAPcap.Free;
-  FFullResult.Free;
-  inherited Destroy;
-end;
-
-
-function TIMAPSend.ReadResult: string;
-var
-  s: string;
-  x, l: integer;
-begin
-  Result := '';
-  FFullResult.Clear;
-  FResultString := '';
-  repeat
-    s := FSock.RecvString(FTimeout);
-    if Pos('S' + IntToStr(FTagCommand) + ' ', s) = 1 then
-    begin
-      FResultString := s;
-      break;
-    end
-    else
-      FFullResult.Add(s);
-    if (s <> '') and (s[Length(s)]='}') then
-    begin
-      s := Copy(s, 1, Length(s) - 1);
-      x := RPos('{', s);
-      s := Copy(s, x + 1, Length(s) - x);
-      l := StrToIntDef(s, -1);
-      if l <> -1 then
-      begin
-        s := FSock.RecvBufferStr(l, FTimeout);
-        FFullResult.Add(s);
-      end;
-    end;
-  until FSock.LastError <> 0;
-  s := Trim(separateright(FResultString, ' '));
-  Result:=uppercase(Trim(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);
-  FSock.SendString('S' + IntToStr(FTagCommand) + ' ' + Value + CRLF);
-  Result := ReadResult;
-end;
-
-function TIMAPSend.IMAPuploadCommand(Value: string; const Data:TStrings): string;
-var
-  l: integer;
-begin
-  Inc(FTagCommand);
-  l := Length(Data.Text);
-  FSock.SendString('S' + IntToStr(FTagCommand) + ' ' + Value + ' {'+ IntToStr(l) + '}' + CRLF);
-  FSock.RecvString(FTimeout);
-  FSock.SendString(Data.Text + CRLF);
-  Result := ReadResult;
-end;
-
-procedure TIMAPSend.ParseMess(Value:TStrings);
-var
-  n: integer;
-begin
-  Value.Clear;
-  for n := 0 to FFullResult.Count - 2 do
-    if FFullResult[n][Length(FFullResult[n])] = '}' then
-    begin
-      Value.Text := FFullResult[n + 1];
-      Break;
-    end;
-end;
-
-procedure TIMAPSend.ParseFolderList(Value:TStrings);
-var
-  n, x: integer;
-  s: string;
-begin
-  ProcessLiterals;
-  Value.Clear;
-  for n := 0 to FFullResult.Count - 1 do
-  begin
-    s := FFullResult[n];
-    if (s <> '') and (Pos('\NOSELECT', UpperCase(s)) = 0) then
-    begin
-      if s[Length(s)] = '"' then
-      begin
-        Delete(s, Length(s), 1);
-        x := RPos('"', s);
-      end
-      else
-        x := RPos(' ', s);
-      if (x > 0) then
-        Value.Add(Copy(s, x + 1, Length(s) - x));
-    end;
-  end;
-end;
-
-procedure TIMAPSend.ParseSelect;
-var
-  n: integer;
-  s, t: string;
-begin
-  ProcessLiterals;
-  FSelectedCount := 0;
-  FSelectedRecent := 0;
-  FSelectedUIDvalidity := 0;
-  for n := 0 to FFullResult.Count - 1 do
-  begin
-    s := uppercase(FFullResult[n]);
-    if Pos(' EXISTS', s) > 0 then
-    begin
-      t := Trim(separateleft(s, ' EXISTS'));
-      t := Trim(separateright(t, '* '));
-      FSelectedCount := StrToIntDef(t, 0);
-    end;
-    if Pos(' RECENT', s) > 0 then
-    begin
-      t := Trim(separateleft(s, ' RECENT'));
-      t := Trim(separateright(t, '* '));
-      FSelectedRecent := StrToIntDef(t, 0);
-    end;
-    if Pos('UIDVALIDITY', s) > 0 then
-    begin
-      t := Trim(separateright(s, 'UIDVALIDITY '));
-      t := Trim(separateleft(t, ']'));
-      FSelectedUIDvalidity := StrToIntDef(t, 0);
-    end;
-  end;
-end;
-
-procedure TIMAPSend.ParseSearch(Value:TStrings);
-var
-  n: integer;
-  s: string;
-begin
-  ProcessLiterals;
-  Value.Clear;
-  for n := 0 to FFullResult.Count - 1 do
-  begin
-    s := uppercase(FFullResult[n]);
-    if Pos('* SEARCH', s) = 1 then
-    begin
-      s := Trim(SeparateRight(s, '* SEARCH'));
-      while s <> '' do
-        Value.Add(Fetch(s, ' '));
-    end;
-  end;
-end;
-
-function TIMAPSend.FindCap(const Value: string): string;
-var
-  n: Integer;
-  s: string;
-begin
-  s := UpperCase(Value);
-  Result := '';
-  for n := 0 to FIMAPcap.Count - 1 do
-    if Pos(s, UpperCase(FIMAPcap[n])) = 1 then
-    begin
-      Result := FIMAPcap[n];
-      Break;
-    end;
-end;
-
-function TIMAPSend.AuthLogin: Boolean;
-begin
-  Result := IMAPcommand('LOGIN "' + FUsername + '" "' + FPassword + '"') = 'OK';
-end;
-
-function TIMAPSend.Connect: Boolean;
-begin
-  FSock.CloseSocket;
-  FSock.Bind(FIPInterface, cAnyPort);
-  if FSock.LastError = 0 then
-    FSock.Connect(FTargetHost, FTargetPort);
-  if FSock.LastError = 0 then
-    if FFullSSL then
-      FSock.SSLDoConnect;
-  Result := FSock.LastError = 0;
-end;
-
-function TIMAPSend.Capability: Boolean;
-var
-  n: Integer;
-  s, t: string;
-begin
-  Result := False;
-  FIMAPcap.Clear;
-  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
-        s := Trim(SeparateRight(FFullResult[n], '* CAPABILITY '));
-        while not (s = '') do
-        begin
-          t := Trim(separateleft(s, ' '));
-          s := Trim(separateright(s, ' '));
-          if s = t then
-            s := '';
-          FIMAPcap.Add(t);
-        end;
-      end;
-    Result := True;
-  end;
-end;
-
-function TIMAPSend.Login: Boolean;
-var
-  s: string;
-begin
-  FSelectedFolder := '';
-  FSelectedCount := 0;
-  FSelectedRecent := 0;
-  FSelectedUIDvalidity := 0;
-  Result := False;
-  FAuthDone := False;
-  if not Connect then
-    Exit;
-  s := FSock.RecvString(FTimeout);
-  if Pos('* PREAUTH', s) = 1 then
-    FAuthDone := True
-  else
-    if Pos('* OK', s) = 1 then
-      FAuthDone := False
-    else
-      Exit;
-  if Capability then
-  begin
-    if Findcap('IMAP4rev1') = '' then
-      Exit;
-    if FAutoTLS and (Findcap('STARTTLS') <> '') then
-      if StartTLS then
-        Capability;
-  end;
-  Result := AuthLogin;
-end;
-
-function TIMAPSend.Logout: Boolean;
-begin
-  Result := IMAPcommand('LOGOUT') = 'OK';
-  FSelectedFolder := '';
-  FSock.CloseSocket;
-end;
-
-function TIMAPSend.NoOp: Boolean;
-begin
-  Result := IMAPcommand('NOOP') = 'OK';
-end;
-
-function TIMAPSend.List(FromFolder: string; const FolderList: TStrings): Boolean;
-begin
-  Result := IMAPcommand('LIST "' + FromFolder + '" *') = 'OK';
-  ParseFolderList(FolderList);
-end;
-
-function TIMAPSend.ListSearch(FromFolder, Search: string; const FolderList: TStrings): Boolean;
-begin
-  Result := IMAPcommand('LIST "' + FromFolder + '" "' + Search +'"') = 'OK';
-  ParseFolderList(FolderList);
-end;
-
-function TIMAPSend.ListSubscribed(FromFolder: string; const FolderList: TStrings): Boolean;
-begin
-  Result := IMAPcommand('LSUB "' + FromFolder + '" *') = 'OK';
-  ParseFolderList(FolderList);
-end;
-
-function TIMAPSend.ListSearchSubscribed(FromFolder, Search: string; const FolderList: TStrings): Boolean;
-begin
-  Result := IMAPcommand('LSUB "' + FromFolder + '" "' + Search +'"') = 'OK';
-  ParseFolderList(FolderList);
-end;
-
-function TIMAPSend.CreateFolder(FolderName: string): Boolean;
-begin
-  Result := IMAPcommand('CREATE "' + FolderName + '"') = 'OK';
-end;
-
-function TIMAPSend.DeleteFolder(FolderName: string): Boolean;
-begin
-  Result := IMAPcommand('DELETE "' + FolderName + '"') = 'OK';
-end;
-
-function TIMAPSend.RenameFolder(FolderName, NewFolderName: string): Boolean;
-begin
-  Result := IMAPcommand('RENAME "' + FolderName + '" "' + NewFolderName + '"') = 'OK';
-end;
-
-function TIMAPSend.SubscribeFolder(FolderName: string): Boolean;
-begin
-  Result := IMAPcommand('SUBSCRIBE "' + FolderName + '"') = 'OK';
-end;
-
-function TIMAPSend.UnsubscribeFolder(FolderName: string): Boolean;
-begin
-  Result := IMAPcommand('UNSUBSCRIBE "' + FolderName + '"') = 'OK';
-end;
-
-function TIMAPSend.SelectFolder(FolderName: string): Boolean;
-begin
-  Result := IMAPcommand('SELECT "' + FolderName + '"') = 'OK';
-  FSelectedFolder := FolderName;
-  ParseSelect;
-end;
-
-function TIMAPSend.SelectROFolder(FolderName: string): Boolean;
-begin
-  Result := IMAPcommand('EXAMINE "' + FolderName + '"') = 'OK';
-  FSelectedFolder := FolderName;
-  ParseSelect;
-end;
-
-function TIMAPSend.CloseFolder: Boolean;
-begin
-  Result := IMAPcommand('CLOSE') = 'OK';
-  FSelectedFolder := '';
-end;
-
-function TIMAPSend.StatusFolder(FolderName, Value: string): integer;
-var
-  n: integer;
-  s, t: string;
-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 := FFullResult[n];
-//      s := UpperCase(FFullResult[n]);
-      if (Pos('* ', s) = 1) and (Pos(FolderName, s) >= 1) and (Pos(Value, s) > 0 ) then
-      begin
-        t := SeparateRight(s, Value);
-        t := SeparateLeft(t, ')');
-        t := trim(t);
-        Result := StrToIntDef(t, -1);
-        Break;
-      end;
-    end;
-  end;
-end;
-
-function TIMAPSend.ExpungeFolder: Boolean;
-begin
-  Result := IMAPcommand('EXPUNGE') = 'OK';
-end;
-
-function TIMAPSend.CheckFolder: Boolean;
-begin
-  Result := IMAPcommand('CHECK') = 'OK';
-end;
-
-function TIMAPSend.AppendMess(ToFolder: string; const Mess: TStrings): Boolean;
-begin
-  Result := IMAPuploadCommand('APPEND "' + ToFolder + '"', Mess) = 'OK';
-end;
-
-function TIMAPSend.DeleteMess(MessID: integer): boolean;
-var
-  s: string;
-begin
-  s := 'STORE ' + IntToStr(MessID) + ' +FLAGS.SILENT (\Deleted)';
-  if FUID then
-    s := 'UID ' + s;
-  Result := IMAPcommand(s) = 'OK';
-end;
-
-function TIMAPSend.FetchMess(MessID: integer; const Mess: TStrings): Boolean;
-var
-  s: string;
-begin
-  s := 'FETCH ' + IntToStr(MessID) + ' (RFC822)';
-  if FUID then
-    s := 'UID ' + s;
-  Result := IMAPcommand(s) = 'OK';
-  ParseMess(Mess);
-end;
-
-function TIMAPSend.FetchHeader(MessID: integer; const Headers: TStrings): Boolean;
-var
-  s: string;
-begin
-  s := 'FETCH ' + IntToStr(MessID) + ' (RFC822.HEADER)';
-  if FUID then
-    s := 'UID ' + s;
-  Result := IMAPcommand(s) = 'OK';
-  ParseMess(Headers);
-end;
-
-function TIMAPSend.MessageSize(MessID: integer): integer;
-var
-  n: integer;
-  s, t: string;
-begin
-  Result := -1;
-  s := 'FETCH ' + IntToStr(MessID) + ' (RFC822.SIZE)';
-  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]);
-      if (Pos('* ', s) = 1) and (Pos('RFC822.SIZE', s) > 0 ) then
-      begin
-        t := SeparateRight(s, 'RFC822.SIZE ');
-        t := Trim(SeparateLeft(t, ')'));
-        t := Trim(SeparateLeft(t, ' '));
-        Result := StrToIntDef(t, -1);
-        Break;
-      end;
-    end;
-  end;
-end;
-
-function TIMAPSend.CopyMess(MessID: integer; ToFolder: string): Boolean;
-var
-  s: string;
-begin
-  s := 'COPY ' + IntToStr(MessID) + ' "' + ToFolder + '"';
-  if FUID then
-    s := 'UID ' + s;
-  Result := IMAPcommand(s) = 'OK';
-end;
-
-function TIMAPSend.SearchMess(Criteria: string; const FoundMess: TStrings): Boolean;
-var
-  s: string;
-begin
-  s := 'SEARCH ' + Criteria;
-  if FUID then
-    s := 'UID ' + s;
-  Result := IMAPcommand(s) = 'OK';
-  ParseSearch(FoundMess);
-end;
-
-function TIMAPSend.SetFlagsMess(MessID: integer; Flags: string): Boolean;
-var
-  s: string;
-begin
-  s := 'STORE ' + IntToStr(MessID) + ' FLAGS.SILENT (' + Flags + ')';
-  if FUID then
-    s := 'UID ' + s;
-  Result := IMAPcommand(s) = 'OK';
-end;
-
-function TIMAPSend.AddFlagsMess(MessID: integer; Flags: string): Boolean;
-var
-  s: string;
-begin
-  s := 'STORE ' + IntToStr(MessID) + ' +FLAGS.SILENT (' + Flags + ')';
-  if FUID then
-    s := 'UID ' + s;
-  Result := IMAPcommand(s) = 'OK';
-end;
-
-function TIMAPSend.DelFlagsMess(MessID: integer; Flags: string): Boolean;
-var
-  s: string;
-begin
-  s := 'STORE ' + IntToStr(MessID) + ' -FLAGS.SILENT (' + Flags + ')';
-  if FUID then
-    s := 'UID ' + s;
-  Result := IMAPcommand(s) = 'OK';
-end;
-
-function TIMAPSend.GetFlagsMess(MessID: integer; var Flags: string): Boolean;
-var
-  s: string;
-  n: integer;
-begin
-  Flags := '';
-  s := 'FETCH ' + IntToStr(MessID) + ' (FLAGS)';
-  if FUID then
-    s := 'UID ' + s;
-  Result := IMAPcommand(s) = 'OK';
-  ProcessLiterals;
-  for n := 0 to FFullResult.Count - 1 do
-  begin
-    s := uppercase(FFullResult[n]);
-    if (Pos('* ', s) = 1) and (Pos('FLAGS', s) > 0 ) then
-    begin
-      s := SeparateRight(s, 'FLAGS');
-      s := Separateright(s, '(');
-      Flags := Trim(SeparateLeft(s, ')'));
-    end;
-  end;
-end;
-
-function TIMAPSend.StartTLS: Boolean;
-begin
-  Result := False;
-  if FindCap('STARTTLS') <> '' then
-  begin
-    if IMAPcommand('STARTTLS') = 'OK' then
-    begin
-      Fsock.SSLDoConnect;
-      Result := FSock.LastError = 0;
-    end;
-  end;
-end;
-
-//Paul Buskermolen <p.buskermolen@pinkroccade.com>
-function TIMAPSend.GetUID(MessID: integer; var UID : Integer): boolean;
-var
-  s, sUid: string;
-  n: integer;
-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]);
-    if Pos('FETCH (UID', s) >= 1 then
-    begin
-      s := Separateright(s, '(UID ');
-      sUID := Trim(SeparateLeft(s, ')'));
-    end;
-  end;
-  UID := StrToIntDef(sUID, 0);
-end;
-
-{==============================================================================}
-
-end.
+{==============================================================================|
+| Project : Ararat Synapse                                       | 002.005.002 |
+|==============================================================================|
+| Content: IMAP4rev1 client                                                    |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2001-2010.                |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@abstract(IMAP4 rev1 protocol client)
+
+Used RFC: RFC-2060, RFC-2595
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit imapsend;
+
+interface
+
+uses
+  SysUtils, Classes,
+  blcksock, synautil;
+
+const
+  cIMAPProtocol = '143';
+
+type
+  {:@abstract(Implementation of IMAP4 protocol.)
+   Note: Are you missing properties for setting Username and Password? Look to
+   parent @link(TSynaClient) object!
+
+   Are you missing properties for specify server address and port? Look to
+   parent @link(TSynaClient) too!}
+  TIMAPSend = class(TSynaClient)
+  protected
+    FSock: TTCPBlockSocket;
+    FTagCommand: integer;
+    FResultString: string;
+    FFullResult: TStringList;
+    FIMAPcap: TStringList;
+    FAuthDone: Boolean;
+    FSelectedFolder: string;
+    FSelectedCount: integer;
+    FSelectedRecent: integer;
+    FSelectedUIDvalidity: integer;
+    FUID: Boolean;
+    FAutoTLS: Boolean;
+    FFullSSL: Boolean;
+    function ReadResult: string;
+    function AuthLogin: Boolean;
+    function Connect: Boolean;
+    procedure ParseMess(Value:TStrings);
+    procedure ParseFolderList(Value:TStrings);
+    procedure ParseSelect;
+    procedure ParseSearch(Value:TStrings);
+    procedure ProcessLiterals;
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    {:By this function you can call any IMAP command. Result of this command is
+     in adequate properties.}
+    function IMAPcommand(Value: string): string;
+
+    {:By this function you can call any IMAP command what need upload any data.
+     Result of this command is in adequate properties.}
+    function IMAPuploadCommand(Value: string; const Data:TStrings): string;
+
+    {:Call CAPABILITY command and fill IMAPcap property by new values.}
+    function Capability: Boolean;
+
+    {:Connect to IMAP server and do login to this server. This command begin
+     session.}
+    function Login: Boolean;
+
+    {:Disconnect from IMAP server and terminate session session. If exists some
+     deleted and non-purged messages, these messages are not deleted!}
+    function Logout: Boolean;
+
+    {:Do NOOP. It is for prevent disconnect by timeout.}
+    function NoOp: Boolean;
+
+    {:Lists folder names. You may specify level of listing. If you specify
+     FromFolder as empty string, return is all folders in system.}
+    function List(FromFolder: string; const FolderList: TStrings): Boolean;
+
+    {:Lists folder names what match search criteria. You may specify level of
+     listing. If you specify FromFolder as empty string, return is all folders
+     in system.}
+    function ListSearch(FromFolder, Search: string; const FolderList: TStrings): Boolean;
+
+    {:Lists subscribed folder names. You may specify level of listing. If you
+     specify FromFolder as empty string, return is all subscribed folders in
+     system.}
+    function ListSubscribed(FromFolder: string; const FolderList: TStrings): Boolean;
+
+    {:Lists subscribed folder names what matching search criteria. You may
+     specify level of listing. If you specify FromFolder as empty string, return
+     is all subscribed folders in system.}
+    function ListSearchSubscribed(FromFolder, Search: string; const FolderList: TStrings): Boolean;
+
+    {:Create a new folder.}
+    function CreateFolder(FolderName: string): Boolean;
+
+    {:Delete a folder.}
+    function DeleteFolder(FolderName: string): Boolean;
+
+    {:Rename folder names.}
+    function RenameFolder(FolderName, NewFolderName: string): Boolean;
+
+    {:Subscribe folder.}
+    function SubscribeFolder(FolderName: string): Boolean;
+
+    {:Unsubscribe folder.}
+    function UnsubscribeFolder(FolderName: string): Boolean;
+
+    {:Select folder.}
+    function SelectFolder(FolderName: string): Boolean;
+
+    {:Select folder, but only for reading. Any changes are not allowed!}
+    function SelectROFolder(FolderName: string): Boolean;
+
+    {:Close a folder. (end of Selected state)}
+    function CloseFolder: Boolean;
+
+    {:Ask for given status of folder. I.e. if you specify as value 'UNSEEN',
+     result is number of unseen messages in folder. For another status
+     indentificator check IMAP documentation and documentation of your IMAP
+     server (each IMAP server can have their own statuses.)}
+    function StatusFolder(FolderName, Value: string): integer;
+
+    {:Hardly delete all messages marked as 'deleted' in current selected folder.}
+    function ExpungeFolder: Boolean;
+
+    {:Touch to folder. (use as update status of folder, etc.)}
+    function CheckFolder: Boolean;
+
+    {:Append given message to specified folder.}
+    function AppendMess(ToFolder: string; const Mess: TStrings): Boolean;
+
+    {:'Delete' message from current selected folder. It mark message as Deleted.
+     Real deleting will be done after sucessfull @link(CloseFolder) or
+     @link(ExpungeFolder)}
+    function DeleteMess(MessID: integer): boolean;
+
+    {:Get full message from specified message in selected folder.}
+    function FetchMess(MessID: integer; const Mess: TStrings): Boolean;
+
+    {:Get message headers only from specified message in selected folder.}
+    function FetchHeader(MessID: integer; const Headers: TStrings): Boolean;
+
+    {:Return message size of specified message from current selected folder.}
+    function MessageSize(MessID: integer): integer;
+
+    {:Copy message from current selected folder to another folder.}
+    function CopyMess(MessID: integer; ToFolder: string): Boolean;
+
+    {:Return message numbers from currently selected folder as result
+     of searching. Search criteria is very complex language (see to IMAP
+     specification) similar to SQL (but not same syntax!).}
+    function SearchMess(Criteria: string; const FoundMess: TStrings): Boolean;
+
+    {:Sets flags of message from current selected folder.}
+    function SetFlagsMess(MessID: integer; Flags: string): Boolean;
+
+    {:Gets flags of message from current selected folder.}
+    function GetFlagsMess(MessID: integer; var Flags: string): Boolean;
+
+    {:Add flags to message's flags.}
+    function AddFlagsMess(MessID: integer; Flags: string): Boolean;
+
+    {:Remove flags from message's flags.}
+    function DelFlagsMess(MessID: integer; Flags: string): Boolean;
+
+    {:Call STARTTLS command for upgrade connection to SSL/TLS mode.}
+    function StartTLS: Boolean;
+
+    {:return UID of requested message ID.}
+    function GetUID(MessID: integer; var UID : Integer): Boolean;
+
+    {:Try to find given capabily in capabilty string returned from IMAP server.}
+    function FindCap(const Value: string): string;
+  published
+    {:Status line with result of last operation.}
+    property ResultString: string read FResultString;
+
+    {:Full result of last IMAP operation.}
+    property FullResult: TStringList read FFullResult;
+
+    {:List of server capabilites.}
+    property IMAPcap: TStringList read FIMAPcap;
+
+    {:Authorization is successful done.}
+    property AuthDone: Boolean read FAuthDone;
+
+    {:Turn on or off usage of UID (unicate identificator) of messages instead
+     only sequence numbers.}
+    property UID: Boolean read FUID Write FUID;
+
+    {:Name of currently selected folder.}
+    property SelectedFolder: string read FSelectedFolder;
+
+    {:Count of messages in currently selected folder.}
+    property SelectedCount: integer read FSelectedCount;
+
+    {:Count of not-visited messages in currently selected folder.}
+    property SelectedRecent: integer read FSelectedRecent;
+
+    {:This number with name of folder is unique indentificator of folder.
+     (If someone delete folder and next create new folder with exactly same name
+     of folder, this number is must be different!)}
+    property SelectedUIDvalidity: integer read FSelectedUIDvalidity;
+
+    {:If is set to true, then upgrade to SSL/TLS mode if remote server support it.}
+    property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
+
+    {:SSL/TLS mode is used from first contact to server. Servers with full
+     SSL/TLS mode usualy using non-standard TCP port!}
+    property FullSSL: Boolean read FFullSSL Write FFullSSL;
+
+    {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
+    property Sock: TTCPBlockSocket read FSock;
+  end;
+
+implementation
+
+constructor TIMAPSend.Create;
+begin
+  inherited Create;
+  FFullResult := TStringList.Create;
+  FIMAPcap := TStringList.Create;
+  FSock := TTCPBlockSocket.Create;
+  FSock.Owner := self;
+  FSock.ConvertLineEnd := True;
+  FSock.SizeRecvBuffer := 32768;
+  FSock.SizeSendBuffer := 32768;
+  FTimeout := 60000;
+  FTargetPort := cIMAPProtocol;
+  FTagCommand := 0;
+  FSelectedFolder := '';
+  FSelectedCount := 0;
+  FSelectedRecent := 0;
+  FSelectedUIDvalidity := 0;
+  FUID := False;
+  FAutoTLS := False;
+  FFullSSL := False;
+end;
+
+destructor TIMAPSend.Destroy;
+begin
+  FSock.Free;
+  FIMAPcap.Free;
+  FFullResult.Free;
+  inherited Destroy;
+end;
+
+
+function TIMAPSend.ReadResult: string;
+var
+  s: string;
+  x, l: integer;
+begin
+  Result := '';
+  FFullResult.Clear;
+  FResultString := '';
+  repeat
+    s := FSock.RecvString(FTimeout);
+    if Pos('S' + IntToStr(FTagCommand) + ' ', s) = 1 then
+    begin
+      FResultString := s;
+      break;
+    end
+    else
+      FFullResult.Add(s);
+    if (s <> '') and (s[Length(s)]='}') then
+    begin
+      s := Copy(s, 1, Length(s) - 1);
+      x := RPos('{', s);
+      s := Copy(s, x + 1, Length(s) - x);
+      l := StrToIntDef(s, -1);
+      if l <> -1 then
+      begin
+        s := FSock.RecvBufferStr(l, FTimeout);
+        FFullResult.Add(s);
+      end;
+    end;
+  until FSock.LastError <> 0;
+  s := Trim(separateright(FResultString, ' '));
+  Result:=uppercase(Trim(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);
+  FSock.SendString('S' + IntToStr(FTagCommand) + ' ' + Value + CRLF);
+  Result := ReadResult;
+end;
+
+function TIMAPSend.IMAPuploadCommand(Value: string; const Data:TStrings): string;
+var
+  l: integer;
+begin
+  Inc(FTagCommand);
+  l := Length(Data.Text);
+  FSock.SendString('S' + IntToStr(FTagCommand) + ' ' + Value + ' {'+ IntToStr(l) + '}' + CRLF);
+  FSock.RecvString(FTimeout);
+  FSock.SendString(Data.Text + CRLF);
+  Result := ReadResult;
+end;
+
+procedure TIMAPSend.ParseMess(Value:TStrings);
+var
+  n: integer;
+begin
+  Value.Clear;
+  for n := 0 to FFullResult.Count - 2 do
+    if FFullResult[n][Length(FFullResult[n])] = '}' then
+    begin
+      Value.Text := FFullResult[n + 1];
+      Break;
+    end;
+end;
+
+procedure TIMAPSend.ParseFolderList(Value:TStrings);
+var
+  n, x: integer;
+  s: string;
+begin
+  ProcessLiterals;
+  Value.Clear;
+  for n := 0 to FFullResult.Count - 1 do
+  begin
+    s := FFullResult[n];
+    if (s <> '') and (Pos('\NOSELECT', UpperCase(s)) = 0) then
+    begin
+      if s[Length(s)] = '"' then
+      begin
+        Delete(s, Length(s), 1);
+        x := RPos('"', s);
+      end
+      else
+        x := RPos(' ', s);
+      if (x > 0) then
+        Value.Add(Copy(s, x + 1, Length(s) - x));
+    end;
+  end;
+end;
+
+procedure TIMAPSend.ParseSelect;
+var
+  n: integer;
+  s, t: string;
+begin
+  ProcessLiterals;
+  FSelectedCount := 0;
+  FSelectedRecent := 0;
+  FSelectedUIDvalidity := 0;
+  for n := 0 to FFullResult.Count - 1 do
+  begin
+    s := uppercase(FFullResult[n]);
+    if Pos(' EXISTS', s) > 0 then
+    begin
+      t := Trim(separateleft(s, ' EXISTS'));
+      t := Trim(separateright(t, '* '));
+      FSelectedCount := StrToIntDef(t, 0);
+    end;
+    if Pos(' RECENT', s) > 0 then
+    begin
+      t := Trim(separateleft(s, ' RECENT'));
+      t := Trim(separateright(t, '* '));
+      FSelectedRecent := StrToIntDef(t, 0);
+    end;
+    if Pos('UIDVALIDITY', s) > 0 then
+    begin
+      t := Trim(separateright(s, 'UIDVALIDITY '));
+      t := Trim(separateleft(t, ']'));
+      FSelectedUIDvalidity := StrToIntDef(t, 0);
+    end;
+  end;
+end;
+
+procedure TIMAPSend.ParseSearch(Value:TStrings);
+var
+  n: integer;
+  s: string;
+begin
+  ProcessLiterals;
+  Value.Clear;
+  for n := 0 to FFullResult.Count - 1 do
+  begin
+    s := uppercase(FFullResult[n]);
+    if Pos('* SEARCH', s) = 1 then
+    begin
+      s := Trim(SeparateRight(s, '* SEARCH'));
+      while s <> '' do
+        Value.Add(Fetch(s, ' '));
+    end;
+  end;
+end;
+
+function TIMAPSend.FindCap(const Value: string): string;
+var
+  n: Integer;
+  s: string;
+begin
+  s := UpperCase(Value);
+  Result := '';
+  for n := 0 to FIMAPcap.Count - 1 do
+    if Pos(s, UpperCase(FIMAPcap[n])) = 1 then
+    begin
+      Result := FIMAPcap[n];
+      Break;
+    end;
+end;
+
+function TIMAPSend.AuthLogin: Boolean;
+begin
+  Result := IMAPcommand('LOGIN "' + FUsername + '" "' + FPassword + '"') = 'OK';
+end;
+
+function TIMAPSend.Connect: Boolean;
+begin
+  FSock.CloseSocket;
+  FSock.Bind(FIPInterface, cAnyPort);
+  if FSock.LastError = 0 then
+    FSock.Connect(FTargetHost, FTargetPort);
+  if FSock.LastError = 0 then
+    if FFullSSL then
+      FSock.SSLDoConnect;
+  Result := FSock.LastError = 0;
+end;
+
+function TIMAPSend.Capability: Boolean;
+var
+  n: Integer;
+  s, t: string;
+begin
+  Result := False;
+  FIMAPcap.Clear;
+  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
+        s := Trim(SeparateRight(FFullResult[n], '* CAPABILITY '));
+        while not (s = '') do
+        begin
+          t := Trim(separateleft(s, ' '));
+          s := Trim(separateright(s, ' '));
+          if s = t then
+            s := '';
+          FIMAPcap.Add(t);
+        end;
+      end;
+    Result := True;
+  end;
+end;
+
+function TIMAPSend.Login: Boolean;
+var
+  s: string;
+begin
+  FSelectedFolder := '';
+  FSelectedCount := 0;
+  FSelectedRecent := 0;
+  FSelectedUIDvalidity := 0;
+  Result := False;
+  FAuthDone := False;
+  if not Connect then
+    Exit;
+  s := FSock.RecvString(FTimeout);
+  if Pos('* PREAUTH', s) = 1 then
+    FAuthDone := True
+  else
+    if Pos('* OK', s) = 1 then
+      FAuthDone := False
+    else
+      Exit;
+  if Capability then
+  begin
+    if Findcap('IMAP4rev1') = '' then
+      Exit;
+    if FAutoTLS and (Findcap('STARTTLS') <> '') then
+      if StartTLS then
+        Capability;
+  end;
+  Result := AuthLogin;
+end;
+
+function TIMAPSend.Logout: Boolean;
+begin
+  Result := IMAPcommand('LOGOUT') = 'OK';
+  FSelectedFolder := '';
+  FSock.CloseSocket;
+end;
+
+function TIMAPSend.NoOp: Boolean;
+begin
+  Result := IMAPcommand('NOOP') = 'OK';
+end;
+
+function TIMAPSend.List(FromFolder: string; const FolderList: TStrings): Boolean;
+begin
+  Result := IMAPcommand('LIST "' + FromFolder + '" *') = 'OK';
+  ParseFolderList(FolderList);
+end;
+
+function TIMAPSend.ListSearch(FromFolder, Search: string; const FolderList: TStrings): Boolean;
+begin
+  Result := IMAPcommand('LIST "' + FromFolder + '" "' + Search +'"') = 'OK';
+  ParseFolderList(FolderList);
+end;
+
+function TIMAPSend.ListSubscribed(FromFolder: string; const FolderList: TStrings): Boolean;
+begin
+  Result := IMAPcommand('LSUB "' + FromFolder + '" *') = 'OK';
+  ParseFolderList(FolderList);
+end;
+
+function TIMAPSend.ListSearchSubscribed(FromFolder, Search: string; const FolderList: TStrings): Boolean;
+begin
+  Result := IMAPcommand('LSUB "' + FromFolder + '" "' + Search +'"') = 'OK';
+  ParseFolderList(FolderList);
+end;
+
+function TIMAPSend.CreateFolder(FolderName: string): Boolean;
+begin
+  Result := IMAPcommand('CREATE "' + FolderName + '"') = 'OK';
+end;
+
+function TIMAPSend.DeleteFolder(FolderName: string): Boolean;
+begin
+  Result := IMAPcommand('DELETE "' + FolderName + '"') = 'OK';
+end;
+
+function TIMAPSend.RenameFolder(FolderName, NewFolderName: string): Boolean;
+begin
+  Result := IMAPcommand('RENAME "' + FolderName + '" "' + NewFolderName + '"') = 'OK';
+end;
+
+function TIMAPSend.SubscribeFolder(FolderName: string): Boolean;
+begin
+  Result := IMAPcommand('SUBSCRIBE "' + FolderName + '"') = 'OK';
+end;
+
+function TIMAPSend.UnsubscribeFolder(FolderName: string): Boolean;
+begin
+  Result := IMAPcommand('UNSUBSCRIBE "' + FolderName + '"') = 'OK';
+end;
+
+function TIMAPSend.SelectFolder(FolderName: string): Boolean;
+begin
+  Result := IMAPcommand('SELECT "' + FolderName + '"') = 'OK';
+  FSelectedFolder := FolderName;
+  ParseSelect;
+end;
+
+function TIMAPSend.SelectROFolder(FolderName: string): Boolean;
+begin
+  Result := IMAPcommand('EXAMINE "' + FolderName + '"') = 'OK';
+  FSelectedFolder := FolderName;
+  ParseSelect;
+end;
+
+function TIMAPSend.CloseFolder: Boolean;
+begin
+  Result := IMAPcommand('CLOSE') = 'OK';
+  FSelectedFolder := '';
+end;
+
+function TIMAPSend.StatusFolder(FolderName, Value: string): integer;
+var
+  n: integer;
+  s, t: string;
+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 := FFullResult[n];
+//      s := UpperCase(FFullResult[n]);
+      if (Pos('* ', s) = 1) and (Pos(FolderName, s) >= 1) and (Pos(Value, s) > 0 ) then
+      begin
+        t := SeparateRight(s, Value);
+        t := SeparateLeft(t, ')');
+        t := trim(t);
+        Result := StrToIntDef(t, -1);
+        Break;
+      end;
+    end;
+  end;
+end;
+
+function TIMAPSend.ExpungeFolder: Boolean;
+begin
+  Result := IMAPcommand('EXPUNGE') = 'OK';
+end;
+
+function TIMAPSend.CheckFolder: Boolean;
+begin
+  Result := IMAPcommand('CHECK') = 'OK';
+end;
+
+function TIMAPSend.AppendMess(ToFolder: string; const Mess: TStrings): Boolean;
+begin
+  Result := IMAPuploadCommand('APPEND "' + ToFolder + '"', Mess) = 'OK';
+end;
+
+function TIMAPSend.DeleteMess(MessID: integer): boolean;
+var
+  s: string;
+begin
+  s := 'STORE ' + IntToStr(MessID) + ' +FLAGS.SILENT (\Deleted)';
+  if FUID then
+    s := 'UID ' + s;
+  Result := IMAPcommand(s) = 'OK';
+end;
+
+function TIMAPSend.FetchMess(MessID: integer; const Mess: TStrings): Boolean;
+var
+  s: string;
+begin
+  s := 'FETCH ' + IntToStr(MessID) + ' (RFC822)';
+  if FUID then
+    s := 'UID ' + s;
+  Result := IMAPcommand(s) = 'OK';
+  ParseMess(Mess);
+end;
+
+function TIMAPSend.FetchHeader(MessID: integer; const Headers: TStrings): Boolean;
+var
+  s: string;
+begin
+  s := 'FETCH ' + IntToStr(MessID) + ' (RFC822.HEADER)';
+  if FUID then
+    s := 'UID ' + s;
+  Result := IMAPcommand(s) = 'OK';
+  ParseMess(Headers);
+end;
+
+function TIMAPSend.MessageSize(MessID: integer): integer;
+var
+  n: integer;
+  s, t: string;
+begin
+  Result := -1;
+  s := 'FETCH ' + IntToStr(MessID) + ' (RFC822.SIZE)';
+  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]);
+      if (Pos('* ', s) = 1) and (Pos('RFC822.SIZE', s) > 0 ) then
+      begin
+        t := SeparateRight(s, 'RFC822.SIZE ');
+        t := Trim(SeparateLeft(t, ')'));
+        t := Trim(SeparateLeft(t, ' '));
+        Result := StrToIntDef(t, -1);
+        Break;
+      end;
+    end;
+  end;
+end;
+
+function TIMAPSend.CopyMess(MessID: integer; ToFolder: string): Boolean;
+var
+  s: string;
+begin
+  s := 'COPY ' + IntToStr(MessID) + ' "' + ToFolder + '"';
+  if FUID then
+    s := 'UID ' + s;
+  Result := IMAPcommand(s) = 'OK';
+end;
+
+function TIMAPSend.SearchMess(Criteria: string; const FoundMess: TStrings): Boolean;
+var
+  s: string;
+begin
+  s := 'SEARCH ' + Criteria;
+  if FUID then
+    s := 'UID ' + s;
+  Result := IMAPcommand(s) = 'OK';
+  ParseSearch(FoundMess);
+end;
+
+function TIMAPSend.SetFlagsMess(MessID: integer; Flags: string): Boolean;
+var
+  s: string;
+begin
+  s := 'STORE ' + IntToStr(MessID) + ' FLAGS.SILENT (' + Flags + ')';
+  if FUID then
+    s := 'UID ' + s;
+  Result := IMAPcommand(s) = 'OK';
+end;
+
+function TIMAPSend.AddFlagsMess(MessID: integer; Flags: string): Boolean;
+var
+  s: string;
+begin
+  s := 'STORE ' + IntToStr(MessID) + ' +FLAGS.SILENT (' + Flags + ')';
+  if FUID then
+    s := 'UID ' + s;
+  Result := IMAPcommand(s) = 'OK';
+end;
+
+function TIMAPSend.DelFlagsMess(MessID: integer; Flags: string): Boolean;
+var
+  s: string;
+begin
+  s := 'STORE ' + IntToStr(MessID) + ' -FLAGS.SILENT (' + Flags + ')';
+  if FUID then
+    s := 'UID ' + s;
+  Result := IMAPcommand(s) = 'OK';
+end;
+
+function TIMAPSend.GetFlagsMess(MessID: integer; var Flags: string): Boolean;
+var
+  s: string;
+  n: integer;
+begin
+  Flags := '';
+  s := 'FETCH ' + IntToStr(MessID) + ' (FLAGS)';
+  if FUID then
+    s := 'UID ' + s;
+  Result := IMAPcommand(s) = 'OK';
+  ProcessLiterals;
+  for n := 0 to FFullResult.Count - 1 do
+  begin
+    s := uppercase(FFullResult[n]);
+    if (Pos('* ', s) = 1) and (Pos('FLAGS', s) > 0 ) then
+    begin
+      s := SeparateRight(s, 'FLAGS');
+      s := Separateright(s, '(');
+      Flags := Trim(SeparateLeft(s, ')'));
+    end;
+  end;
+end;
+
+function TIMAPSend.StartTLS: Boolean;
+begin
+  Result := False;
+  if FindCap('STARTTLS') <> '' then
+  begin
+    if IMAPcommand('STARTTLS') = 'OK' then
+    begin
+      Fsock.SSLDoConnect;
+      Result := FSock.LastError = 0;
+    end;
+  end;
+end;
+
+//Paul Buskermolen <p.buskermolen@pinkroccade.com>
+function TIMAPSend.GetUID(MessID: integer; var UID : Integer): boolean;
+var
+  s, sUid: string;
+  n: integer;
+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]);
+    if Pos('FETCH (UID', s) >= 1 then
+    begin
+      s := Separateright(s, '(UID ');
+      sUID := Trim(SeparateLeft(s, ')'));
+    end;
+  end;
+  UID := StrToIntDef(sUID, 0);
+end;
+
+{==============================================================================}
+
+end.
diff --git a/Units/Synapse/ldapsend.pas b/Units/Synapse/ldapsend.pas
index ece52d6..350ea94 100644
--- a/Units/Synapse/ldapsend.pas
+++ b/Units/Synapse/ldapsend.pas
@@ -1,1208 +1,1208 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 001.007.000 |
-|==============================================================================|
-| Content: LDAP client                                                         |
-|==============================================================================|
-| Copyright (c)1999-2010, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2003-2010.                |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{:@abstract(LDAP client)
-
-Used RFC: RFC-2251, RFC-2254, RFC-2829, RFC-2830
-}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$H+}
-
-{$IFDEF UNICODE}
-  {$WARN IMPLICIT_STRING_CAST OFF}
-  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
-{$ENDIF}
-
-unit ldapsend;
-
-interface
-
-uses
-  SysUtils, Classes,
-  blcksock, synautil, asn1util, synacode;
-
-const
-  cLDAPProtocol = '389';
-
-  LDAP_ASN1_BIND_REQUEST = $60;
-  LDAP_ASN1_BIND_RESPONSE = $61;
-  LDAP_ASN1_UNBIND_REQUEST = $42;
-  LDAP_ASN1_SEARCH_REQUEST = $63;
-  LDAP_ASN1_SEARCH_ENTRY = $64;
-  LDAP_ASN1_SEARCH_DONE = $65;
-  LDAP_ASN1_SEARCH_REFERENCE = $73;
-  LDAP_ASN1_MODIFY_REQUEST = $66;
-  LDAP_ASN1_MODIFY_RESPONSE = $67;
-  LDAP_ASN1_ADD_REQUEST = $68;
-  LDAP_ASN1_ADD_RESPONSE = $69;
-  LDAP_ASN1_DEL_REQUEST = $4A;
-  LDAP_ASN1_DEL_RESPONSE = $6B;
-  LDAP_ASN1_MODIFYDN_REQUEST = $6C;
-  LDAP_ASN1_MODIFYDN_RESPONSE = $6D;
-  LDAP_ASN1_COMPARE_REQUEST = $6E;
-  LDAP_ASN1_COMPARE_RESPONSE = $6F;
-  LDAP_ASN1_ABANDON_REQUEST = $70;
-  LDAP_ASN1_EXT_REQUEST = $77;
-  LDAP_ASN1_EXT_RESPONSE = $78;
-
-
-type
-
-  {:@abstract(LDAP attribute with list of their values)
-   This class holding name of LDAP attribute and list of their values. This is
-   descendant of TStringList class enhanced by some new properties.}
-  TLDAPAttribute = class(TStringList)
-  private
-    FAttributeName: AnsiString;
-    FIsBinary: Boolean;
-  protected
-    function Get(Index: integer): string; override;
-    procedure Put(Index: integer; const Value: string); override;
-    procedure SetAttributeName(Value: AnsiString);
-  published
-    {:Name of LDAP attribute.}
-    property AttributeName: AnsiString read FAttributeName Write SetAttributeName;
-    {:Return @true when attribute contains binary data.}
-    property IsBinary: Boolean read FIsBinary;
-  end;
-
-  {:@abstract(List of @link(TLDAPAttribute))
-   This object can hold list of TLDAPAttribute objects.}
-  TLDAPAttributeList = class(TObject)
-  private
-    FAttributeList: TList;
-    function GetAttribute(Index: integer): TLDAPAttribute;
-  public
-    constructor Create;
-    destructor Destroy; override;
-    {:Clear list.}
-    procedure Clear;
-    {:Return count of TLDAPAttribute objects in list.}
-    function Count: integer;
-    {:Add new TLDAPAttribute object to list.}
-    function Add: TLDAPAttribute;
-    {:Delete one TLDAPAttribute object from list.}
-    procedure Del(Index: integer);
-    {:Find and return attribute with requested name. Returns nil if not found.}
-    function Find(AttributeName: AnsiString): TLDAPAttribute;
-    {:Find and return attribute value with requested name. Returns empty string if not found.}
-    function Get(AttributeName: AnsiString): string;
-    {:List of TLDAPAttribute objects.}
-    property Items[Index: Integer]: TLDAPAttribute read GetAttribute; default;
-  end;
-
-  {:@abstract(LDAP result object)
-   This object can hold LDAP object. (their name and all their attributes with
-   values)}
-  TLDAPResult = class(TObject)
-  private
-    FObjectName: AnsiString;
-    FAttributes: TLDAPAttributeList;
-  public
-    constructor Create;
-    destructor Destroy; override;
-  published
-    {:Name of this LDAP object.}
-    property ObjectName: AnsiString read FObjectName write FObjectName;
-    {:Here is list of object attributes.}
-    property Attributes: TLDAPAttributeList read FAttributes;
-  end;
-
-  {:@abstract(List of LDAP result objects)
-   This object can hold list of LDAP objects. (for example result of LDAP SEARCH.)}
-  TLDAPResultList = class(TObject)
-  private
-    FResultList: TList;
-    function GetResult(Index: integer): TLDAPResult;
-  public
-    constructor Create;
-    destructor Destroy; override;
-    {:Clear all TLDAPResult objects in list.}
-    procedure Clear;
-    {:Return count of TLDAPResult objects in list.}
-    function Count: integer;
-    {:Create and add new TLDAPResult object to list.}
-    function Add: TLDAPResult;
-    {:List of TLDAPResult objects.}
-    property Items[Index: Integer]: TLDAPResult read GetResult; default;
-  end;
-
-  {:Define possible operations for LDAP MODIFY operations.}
-  TLDAPModifyOp = (
-    MO_Add,
-    MO_Delete,
-    MO_Replace
-  );
-
-  {:Specify possible values for search scope.}
-  TLDAPSearchScope = (
-    SS_BaseObject,
-    SS_SingleLevel,
-    SS_WholeSubtree
-  );
-
-  {:Specify possible values about alias dereferencing.}
-  TLDAPSearchAliases = (
-    SA_NeverDeref,
-    SA_InSearching,
-    SA_FindingBaseObj,
-    SA_Always
-  );
-
-  {:@abstract(Implementation of LDAP client)
-   (version 2 and 3)
-
-   Note: Are you missing properties for setting Username and Password? Look to
-   parent @link(TSynaClient) object!
-
-   Are you missing properties for specify server address and port? Look to
-   parent @link(TSynaClient) too!}
-  TLDAPSend = class(TSynaClient)
-  private
-    FSock: TTCPBlockSocket;
-    FResultCode: Integer;
-    FResultString: AnsiString;
-    FFullResult: AnsiString;
-    FAutoTLS: Boolean;
-    FFullSSL: Boolean;
-    FSeq: integer;
-    FResponseCode: integer;
-    FResponseDN: AnsiString;
-    FReferals: TStringList;
-    FVersion: integer;
-    FSearchScope: TLDAPSearchScope;
-    FSearchAliases: TLDAPSearchAliases;
-    FSearchSizeLimit: integer;
-    FSearchTimeLimit: integer;
-    FSearchResult: TLDAPResultList;
-    FExtName: AnsiString;
-    FExtValue: AnsiString;
-    function Connect: Boolean;
-    function BuildPacket(const Value: AnsiString): AnsiString;
-    function ReceiveResponse: AnsiString;
-    function DecodeResponse(const Value: AnsiString): AnsiString;
-    function LdapSasl(Value: AnsiString): AnsiString;
-    function TranslateFilter(Value: AnsiString): AnsiString;
-    function GetErrorString(Value: integer): AnsiString;
-  public
-    constructor Create;
-    destructor Destroy; override;
-
-    {:Try to connect to LDAP server and start secure channel, when it is required.}
-    function Login: Boolean;
-
-    {:Try to bind to LDAP server with @link(TSynaClient.Username) and
-     @link(TSynaClient.Password). If this is empty strings, then it do annonymous
-     Bind. When you not call Bind on LDAPv3, then is automaticly used anonymous
-     mode.
-
-     This method using plaintext transport of password! It is not secure!}
-    function Bind: Boolean;
-
-    {:Try to bind to LDAP server with @link(TSynaClient.Username) and
-     @link(TSynaClient.Password). If this is empty strings, then it do annonymous
-     Bind. When you not call Bind on LDAPv3, then is automaticly used anonymous
-     mode.
-
-     This method using SASL with DIGEST-MD5 method for secure transfer of your
-     password.}
-    function BindSasl: Boolean;
-
-    {:Close connection to LDAP server.}
-    function Logout: Boolean;
-
-    {:Modify content of LDAP attribute on this object.}
-    function Modify(obj: AnsiString; Op: TLDAPModifyOp; const Value: TLDAPAttribute): Boolean;
-
-    {:Add list of attributes to specified object.}
-    function Add(obj: AnsiString; const Value: TLDAPAttributeList): Boolean;
-
-    {:Delete this LDAP object from server.}
-    function Delete(obj: AnsiString): Boolean;
-
-    {:Modify object name of this LDAP object.}
-    function ModifyDN(obj, newRDN, newSuperior: AnsiString; DeleteoldRDN: Boolean): Boolean;
-
-    {:Try to compare Attribute value with this LDAP object.}
-    function Compare(obj, AttributeValue: AnsiString): Boolean;
-
-    {:Search LDAP base for LDAP objects by Filter.}
-    function Search(obj: AnsiString; TypesOnly: Boolean; Filter: AnsiString;
-      const Attributes: TStrings): Boolean;
-
-    {:Call any LDAPv3 extended command.}
-    function Extended(const Name, Value: AnsiString): Boolean;
-
-    {:Try to start SSL/TLS connection to LDAP server.}
-    function StartTLS: Boolean;
-  published
-    {:Specify version of used LDAP protocol. Default value is 3.}
-    property Version: integer read FVersion Write FVersion;
-
-    {:Result code of last LDAP operation.}
-    property ResultCode: Integer read FResultCode;
-
-    {:Human readable description of result code of last LDAP operation.}
-    property ResultString: AnsiString read FResultString;
-
-    {:Binary string with full last response of LDAP server. This string is
-     encoded by ASN.1 BER encoding! You need this only for debugging.}
-    property FullResult: AnsiString read FFullResult;
-
-    {:If @true, then try to start TSL mode in Login procedure.}
-    property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
-
-    {:If @true, then use connection to LDAP server through SSL/TLS tunnel.}
-    property FullSSL: Boolean read FFullSSL Write FFullSSL;
-
-    {:Sequence number of last LDAp command. It is incremented by any LDAP command.}
-    property Seq: integer read FSeq;
-
-    {:Specify what search scope is used in search command.}
-    property SearchScope: TLDAPSearchScope read FSearchScope Write FSearchScope;
-
-    {:Specify how to handle aliases in search command.}
-    property SearchAliases: TLDAPSearchAliases read FSearchAliases Write FSearchAliases;
-
-    {:Specify result size limit in search command. Value 0 means without limit.}
-    property SearchSizeLimit: integer read FSearchSizeLimit Write FSearchSizeLimit;
-
-    {:Specify search time limit in search command (seconds). Value 0 means
-     without limit.}
-    property SearchTimeLimit: integer read FSearchTimeLimit Write FSearchTimeLimit;
-
-    {:Here is result of search command.}
-    property SearchResult: TLDAPResultList read FSearchResult;
-
-    {:On each LDAP operation can LDAP server return some referals URLs. Here is
-     their list.}
-    property Referals: TStringList read FReferals;
-
-    {:When you call @link(Extended) operation, then here is result Name returned
-     by server.}
-    property ExtName: AnsiString read FExtName;
-
-    {:When you call @link(Extended) operation, then here is result Value returned
-     by server.}
-    property ExtValue: AnsiString read FExtValue;
-
-    {:TCP socket used by all LDAP operations.}
-    property Sock: TTCPBlockSocket read FSock;
-  end;
-
-{:Dump result of LDAP SEARCH into human readable form. Good for debugging.}
-function LDAPResultDump(const Value: TLDAPResultList): AnsiString;
-
-implementation
-
-{==============================================================================}
-function TLDAPAttribute.Get(Index: integer): string;
-begin
-  Result := inherited Get(Index);
-  if FIsbinary then
-    Result := DecodeBase64(Result);
-end;
-
-procedure TLDAPAttribute.Put(Index: integer; const Value: string);
-var
-  s: AnsiString;
-begin
-  s := Value;
-  if FIsbinary then
-    s := EncodeBase64(Value)
-  else
-    s :=UnquoteStr(s, '"');
-  inherited Put(Index, s);
-end;
-
-procedure TLDAPAttribute.SetAttributeName(Value: AnsiString);
-begin
-  FAttributeName := Value;
-  FIsBinary := Pos(';binary', Lowercase(value)) > 0;
-end;
-
-{==============================================================================}
-constructor TLDAPAttributeList.Create;
-begin
-  inherited Create;
-  FAttributeList := TList.Create;
-end;
-
-destructor TLDAPAttributeList.Destroy;
-begin
-  Clear;
-  FAttributeList.Free;
-  inherited Destroy;
-end;
-
-procedure TLDAPAttributeList.Clear;
-var
-  n: integer;
-  x: TLDAPAttribute;
-begin
-  for n := Count - 1 downto 0 do
-  begin
-    x := GetAttribute(n);
-    if Assigned(x) then
-      x.Free;
-  end;
-  FAttributeList.Clear;
-end;
-
-function TLDAPAttributeList.Count: integer;
-begin
-  Result := FAttributeList.Count;
-end;
-
-function TLDAPAttributeList.Get(AttributeName: AnsiString): string;
-var
-  x: TLDAPAttribute;
-begin
-  Result := '';
-  x := self.Find(AttributeName);
-  if x <> nil then
-    if x.Count > 0 then
-      Result := x[0];
-end;
-
-function TLDAPAttributeList.GetAttribute(Index: integer): TLDAPAttribute;
-begin
-  Result := nil;
-  if Index < Count then
-    Result := TLDAPAttribute(FAttributeList[Index]);
-end;
-
-function TLDAPAttributeList.Add: TLDAPAttribute;
-begin
-  Result := TLDAPAttribute.Create;
-  FAttributeList.Add(Result);
-end;
-
-procedure TLDAPAttributeList.Del(Index: integer);
-var
-  x: TLDAPAttribute;
-begin
-  x := GetAttribute(Index);
-  if Assigned(x) then
-    x.free;
-  FAttributeList.Delete(Index);
-end;
-
-function TLDAPAttributeList.Find(AttributeName: AnsiString): TLDAPAttribute;
-var
-  n: integer;
-  x: TLDAPAttribute;
-begin
-  Result := nil;
-  AttributeName := lowercase(AttributeName);
-  for n := 0 to Count - 1 do
-  begin
-    x := GetAttribute(n);
-    if Assigned(x) then
-      if lowercase(x.AttributeName) = Attributename then
-      begin
-        result := x;
-        break;
-      end;
-  end;
-end;
-
-{==============================================================================}
-constructor TLDAPResult.Create;
-begin
-  inherited Create;
-  FAttributes := TLDAPAttributeList.Create;
-end;
-
-destructor TLDAPResult.Destroy;
-begin
-  FAttributes.Free;
-  inherited Destroy;
-end;
-
-{==============================================================================}
-constructor TLDAPResultList.Create;
-begin
-  inherited Create;
-  FResultList := TList.Create;
-end;
-
-destructor TLDAPResultList.Destroy;
-begin
-  Clear;
-  FResultList.Free;
-  inherited Destroy;
-end;
-
-procedure TLDAPResultList.Clear;
-var
-  n: integer;
-  x: TLDAPResult;
-begin
-  for n := Count - 1 downto 0 do
-  begin
-    x := GetResult(n);
-    if Assigned(x) then
-      x.Free;
-  end;
-  FResultList.Clear;
-end;
-
-function TLDAPResultList.Count: integer;
-begin
-  Result := FResultList.Count;
-end;
-
-function TLDAPResultList.GetResult(Index: integer): TLDAPResult;
-begin
-  Result := nil;
-  if Index < Count then
-    Result := TLDAPResult(FResultList[Index]);
-end;
-
-function TLDAPResultList.Add: TLDAPResult;
-begin
-  Result := TLDAPResult.Create;
-  FResultList.Add(Result);
-end;
-
-{==============================================================================}
-constructor TLDAPSend.Create;
-begin
-  inherited Create;
-  FReferals := TStringList.Create;
-  FFullResult := '';
-  FSock := TTCPBlockSocket.Create;
-  FSock.Owner := self;
-  FTimeout := 60000;
-  FTargetPort := cLDAPProtocol;
-  FAutoTLS := False;
-  FFullSSL := False;
-  FSeq := 0;
-  FVersion := 3;
-  FSearchScope := SS_WholeSubtree;
-  FSearchAliases := SA_Always;
-  FSearchSizeLimit := 0;
-  FSearchTimeLimit := 0;
-  FSearchResult := TLDAPResultList.Create;
-end;
-
-destructor TLDAPSend.Destroy;
-begin
-  FSock.Free;
-  FSearchResult.Free;
-  FReferals.Free;
-  inherited Destroy;
-end;
-
-function TLDAPSend.GetErrorString(Value: integer): AnsiString;
-begin
-  case Value of
-    0:
-      Result := 'Success';
-    1:
-      Result := 'Operations error';
-    2:
-      Result := 'Protocol error';
-    3:
-      Result := 'Time limit Exceeded';
-    4:
-      Result := 'Size limit Exceeded';
-    5:
-      Result := 'Compare FALSE';
-    6:
-      Result := 'Compare TRUE';
-    7:
-      Result := 'Auth method not supported';
-    8:
-      Result := 'Strong auth required';
-    9:
-      Result := '-- reserved --';
-    10:
-      Result := 'Referal';
-    11:
-      Result := 'Admin limit exceeded';
-    12:
-      Result := 'Unavailable critical extension';
-    13:
-      Result := 'Confidentality required';
-    14:
-      Result := 'Sasl bind in progress';
-    16:
-      Result := 'No such attribute';
-    17:
-      Result := 'Undefined attribute type';
-    18:
-      Result := 'Inappropriate matching';
-    19:
-      Result := 'Constraint violation';
-    20:
-      Result := 'Attribute or value exists';
-    21:
-      Result := 'Invalid attribute syntax';
-    32:
-      Result := 'No such object';
-    33:
-      Result := 'Alias problem';
-    34:
-      Result := 'Invalid DN syntax';
-    36:
-      Result := 'Alias dereferencing problem';
-    48:
-      Result := 'Inappropriate authentication';
-    49:
-      Result := 'Invalid credentials';
-    50:
-      Result := 'Insufficient access rights';
-    51:
-      Result := 'Busy';
-    52:
-      Result := 'Unavailable';
-    53:
-      Result := 'Unwilling to perform';
-    54:
-      Result := 'Loop detect';
-    64:
-      Result := 'Naming violation';
-    65:
-      Result := 'Object class violation';
-    66:
-      Result := 'Not allowed on non leaf';
-    67:
-      Result := 'Not allowed on RDN';
-    68:
-      Result := 'Entry already exists';
-    69:
-      Result := 'Object class mods prohibited';
-    71:
-      Result := 'Affects multiple DSAs';
-    80:
-      Result := 'Other';
-  else
-    Result := '--unknown--';
-  end;
-end;
-
-function TLDAPSend.Connect: Boolean;
-begin
-  // Do not call this function! It is calling by LOGIN method!
-  FSock.CloseSocket;
-  FSock.LineBuffer := '';
-  FSeq := 0;
-  FSock.Bind(FIPInterface, cAnyPort);
-  if FSock.LastError = 0 then
-    FSock.Connect(FTargetHost, FTargetPort);
-  if FSock.LastError = 0 then
-    if FFullSSL then
-      FSock.SSLDoConnect;
-  Result := FSock.LastError = 0;
-end;
-
-function TLDAPSend.BuildPacket(const Value: AnsiString): AnsiString;
-begin
-  Inc(FSeq);
-  Result := ASNObject(ASNObject(ASNEncInt(FSeq), ASN1_INT) + Value,  ASN1_SEQ);
-end;
-
-function TLDAPSend.ReceiveResponse: AnsiString;
-var
-  x: Byte;
-  i,j: integer;
-begin
-  Result := '';
-  FFullResult := '';
-  x := FSock.RecvByte(FTimeout);
-  if x <> ASN1_SEQ then
-    Exit;
-  Result := AnsiChar(x);
-  x := FSock.RecvByte(FTimeout);
-  Result := Result + AnsiChar(x);
-  if x < $80 then
-    i := 0
-  else
-    i := x and $7F;
-  if i > 0 then
-    Result := Result + FSock.RecvBufferStr(i, Ftimeout);
-  if FSock.LastError <> 0 then
-  begin
-    Result := '';
-    Exit;
-  end;
-  //get length of LDAP packet
-  j := 2;
-  i := ASNDecLen(j, Result);
-  //retreive rest of LDAP packet
-  if i > 0 then
-    Result := Result + FSock.RecvBufferStr(i, Ftimeout);
-  if FSock.LastError <> 0 then
-  begin
-    Result := '';
-    Exit;
-  end;
-  FFullResult := Result;
-end;
-
-function TLDAPSend.DecodeResponse(const Value: AnsiString): AnsiString;
-var
-  i, x: integer;
-  Svt: Integer;
-  s, t: AnsiString;
-begin
-  Result := '';
-  FResultCode := -1;
-  FResultstring := '';
-  FResponseCode := -1;
-  FResponseDN := '';
-  FReferals.Clear;
-  i := 1;
-  ASNItem(i, Value, Svt);
-  x := StrToIntDef(ASNItem(i, Value, Svt), 0);
-  if (svt <> ASN1_INT) or (x <> FSeq) then
-    Exit;
-  s := ASNItem(i, Value, Svt);
-  FResponseCode := svt;
-  if FResponseCode in [LDAP_ASN1_BIND_RESPONSE, LDAP_ASN1_SEARCH_DONE,
-    LDAP_ASN1_MODIFY_RESPONSE, LDAP_ASN1_ADD_RESPONSE, LDAP_ASN1_DEL_RESPONSE,
-    LDAP_ASN1_MODIFYDN_RESPONSE, LDAP_ASN1_COMPARE_RESPONSE,
-    LDAP_ASN1_EXT_RESPONSE] then
-  begin
-    FResultCode := StrToIntDef(ASNItem(i, Value, Svt), -1);
-    FResponseDN := ASNItem(i, Value, Svt);
-    FResultString := ASNItem(i, Value, Svt);
-    if FResultString = '' then
-      FResultString := GetErrorString(FResultCode);
-    if FResultCode = 10 then
-    begin
-      s := ASNItem(i, Value, Svt);
-      if svt = $A3 then
-      begin
-        x := 1;
-        while x < Length(s) do
-        begin
-          t := ASNItem(x, s, Svt);
-          FReferals.Add(t);
-        end;
-      end;
-    end;
-  end;
-  Result := Copy(Value, i, Length(Value) - i + 1);
-end;
-
-function TLDAPSend.LdapSasl(Value: AnsiString): AnsiString;
-var
-  nonce, cnonce, nc, realm, qop, uri, response: AnsiString;
-  s: AnsiString;
-  a1, a2: AnsiString;
-  l: TStringList;
-  n: integer;
-begin
-  l := TStringList.Create;
-  try
-    nonce := '';
-    realm := '';
-    l.CommaText := Value;
-    n := IndexByBegin('nonce=', l);
-    if n >= 0 then
-      nonce := UnQuoteStr(Trim(SeparateRight(l[n], 'nonce=')), '"');
-    n := IndexByBegin('realm=', l);
-    if n >= 0 then
-      realm := UnQuoteStr(Trim(SeparateRight(l[n], 'realm=')), '"');
-    cnonce := IntToHex(GetTick, 8);
-    nc := '00000001';
-    qop := 'auth';
-    uri := 'ldap/' + FSock.ResolveIpToName(FSock.GetRemoteSinIP);
-    a1 := md5(FUsername + ':' + realm + ':' + FPassword)
-      + ':' + nonce + ':' + cnonce;
-    a2 := 'AUTHENTICATE:' + uri;
-    s := strtohex(md5(a1))+':' + nonce + ':' + nc + ':' + cnonce + ':'
-      + qop +':'+strtohex(md5(a2));
-    response := strtohex(md5(s));
-
-    Result := 'username="' + Fusername + '",realm="' + realm + '",nonce="';
-    Result := Result + nonce + '",cnonce="' + cnonce + '",nc=' + nc + ',qop=';
-    Result := Result + qop + ',digest-uri="' + uri + '",response=' + response;
-  finally
-    l.Free;
-  end;
-end;
-
-function TLDAPSend.TranslateFilter(Value: AnsiString): AnsiString;
-var
-  x: integer;
-  s, t, l: AnsiString;
-  r: string;
-  c: Ansichar;
-  attr, rule: AnsiString;
-  dn: Boolean;
-begin
-  Result := '';
-  if Value = '' then
-    Exit;
-  s := Value;
-  if Value[1] = '(' then
-  begin
-    x := RPos(')', Value);
-    s := Copy(Value, 2, x - 2);
-  end;
-  if s = '' then
-    Exit;
-  case s[1] of
-    '!':
-      // NOT rule (recursive call)
-      begin
-        Result := ASNOBject(TranslateFilter(GetBetween('(', ')', s)), $A2);
-      end;
-    '&':
-      // AND rule (recursive call)
-      begin
-        repeat
-          t := GetBetween('(', ')', s);
-          s := Trim(SeparateRight(s, t));
-          if s <> '' then
-            if s[1] = ')' then
-              {$IFDEF CIL}Borland.Delphi.{$ENDIF}System.Delete(s, 1, 1);
-          Result := Result + TranslateFilter(t);
-        until s = '';
-        Result := ASNOBject(Result, $A0);
-      end;
-    '|':
-      // OR rule (recursive call)
-      begin
-        repeat
-          t := GetBetween('(', ')', s);
-          s := Trim(SeparateRight(s, t));
-          if s <> '' then
-            if s[1] = ')' then
-              {$IFDEF CIL}Borland.Delphi.{$ENDIF}System.Delete(s, 1, 1);
-          Result := Result + TranslateFilter(t);
-        until s = '';
-        Result := ASNOBject(Result, $A1);
-      end;
-    else
-      begin
-        l := Trim(SeparateLeft(s, '='));
-        r := Trim(SeparateRight(s, '='));
-        if l <> '' then
-        begin
-          c := l[Length(l)];
-          case c of
-            ':':
-              // Extensible match
-              begin
-                {$IFDEF CIL}Borland.Delphi.{$ENDIF}System.Delete(l, Length(l), 1);
-                dn := False;
-                attr := '';
-                rule := '';
-                if Pos(':dn', l) > 0 then
-                begin
-                  dn := True;
-                  l := ReplaceString(l, ':dn', '');
-                end;
-                attr := Trim(SeparateLeft(l, ':'));
-                rule := Trim(SeparateRight(l, ':'));
-                if rule = l then
-                  rule := '';
-                if rule <> '' then
-                  Result := ASNObject(rule, $81);
-                if attr <> '' then
-                  Result := Result + ASNObject(attr, $82);
-                Result := Result + ASNObject(DecodeTriplet(r, '\'), $83);
-                if dn then
-                  Result := Result + ASNObject(AsnEncInt($ff), $84)
-                else
-                  Result := Result + ASNObject(AsnEncInt(0), $84);
-                Result := ASNOBject(Result, $a9);
-              end;
-            '~':
-              // Approx match
-              begin
-                {$IFDEF CIL}Borland.Delphi.{$ENDIF}System.Delete(l, Length(l), 1);
-                Result := ASNOBject(l, ASN1_OCTSTR)
-                  + ASNOBject(DecodeTriplet(r, '\'), ASN1_OCTSTR);
-                Result := ASNOBject(Result, $a8);
-              end;
-            '>':
-              // Greater or equal match
-              begin
-                {$IFDEF CIL}Borland.Delphi.{$ENDIF}System.Delete(l, Length(l), 1);
-                Result := ASNOBject(l, ASN1_OCTSTR)
-                  + ASNOBject(DecodeTriplet(r, '\'), ASN1_OCTSTR);
-                Result := ASNOBject(Result, $a5);
-              end;
-            '<':
-              // Less or equal match
-              begin
-                {$IFDEF CIL}Borland.Delphi.{$ENDIF}System.Delete(l, Length(l), 1);
-                Result := ASNOBject(l, ASN1_OCTSTR)
-                  + ASNOBject(DecodeTriplet(r, '\'), ASN1_OCTSTR);
-                Result := ASNOBject(Result, $a6);
-              end;
-          else
-            // present
-            if r = '*' then
-              Result := ASNOBject(l, $87)
-            else
-              if Pos('*', r) > 0 then
-              // substrings
-              begin
-                s := Fetch(r, '*');
-                if s <> '' then
-                  Result := ASNOBject(DecodeTriplet(s, '\'), $80);
-                while r <> '' do
-                begin
-                  if Pos('*', r) <= 0 then
-                    break;
-                  s := Fetch(r, '*');
-                  Result := Result + ASNOBject(DecodeTriplet(s, '\'), $81);
-                end;
-                if r <> '' then
-                  Result := Result + ASNOBject(DecodeTriplet(r, '\'), $82);
-                Result := ASNOBject(l, ASN1_OCTSTR)
-                  + ASNOBject(Result, ASN1_SEQ);
-                Result := ASNOBject(Result, $a4);
-              end
-              else
-              begin
-                // Equality match
-                Result := ASNOBject(l, ASN1_OCTSTR)
-                  + ASNOBject(DecodeTriplet(r, '\'), ASN1_OCTSTR);
-                Result := ASNOBject(Result, $a3);
-              end;
-          end;
-        end;
-      end;
-  end;
-end;
-
-function TLDAPSend.Login: Boolean;
-begin
-  Result := False;
-  if not Connect then
-    Exit;
-  Result := True;
-  if FAutoTLS then
-    Result := StartTLS;
-end;
-
-function TLDAPSend.Bind: Boolean;
-var
-  s: AnsiString;
-begin
-  s := ASNObject(ASNEncInt(FVersion), ASN1_INT)
-    + ASNObject(FUsername, ASN1_OCTSTR)
-    + ASNObject(FPassword, $80);
-  s := ASNObject(s, LDAP_ASN1_BIND_REQUEST);
-  Fsock.SendString(BuildPacket(s));
-  s := ReceiveResponse;
-  DecodeResponse(s);
-  Result := FResultCode = 0;
-end;
-
-function TLDAPSend.BindSasl: Boolean;
-var
-  s, t: AnsiString;
-  x, xt: integer;
-  digreq: AnsiString;
-begin
-  Result := False;
-  if FPassword = '' then
-    Result := Bind
-  else
-  begin
-    digreq := ASNObject(ASNEncInt(FVersion), ASN1_INT)
-      + ASNObject('', ASN1_OCTSTR)
-      + ASNObject(ASNObject('DIGEST-MD5', ASN1_OCTSTR), $A3);
-    digreq := ASNObject(digreq, LDAP_ASN1_BIND_REQUEST);
-    Fsock.SendString(BuildPacket(digreq));
-    s := ReceiveResponse;
-    t := DecodeResponse(s);
-    if FResultCode = 14 then
-    begin
-      s := t;
-      x := 1;
-      t := ASNItem(x, s, xt);
-      s := ASNObject(ASNEncInt(FVersion), ASN1_INT)
-        + ASNObject('', ASN1_OCTSTR)
-        + ASNObject(ASNObject('DIGEST-MD5', ASN1_OCTSTR)
-          + ASNObject(LdapSasl(t), ASN1_OCTSTR), $A3);
-      s := ASNObject(s, LDAP_ASN1_BIND_REQUEST);
-      Fsock.SendString(BuildPacket(s));
-      s := ReceiveResponse;
-      DecodeResponse(s);
-      if FResultCode = 14 then
-      begin
-        Fsock.SendString(BuildPacket(digreq));
-        s := ReceiveResponse;
-        DecodeResponse(s);
-      end;
-      Result := FResultCode = 0;
-    end;
-  end;
-end;
-
-function TLDAPSend.Logout: Boolean;
-begin
-  Fsock.SendString(BuildPacket(ASNObject('', LDAP_ASN1_UNBIND_REQUEST)));
-  FSock.CloseSocket;
-  Result := True;
-end;
-
-function TLDAPSend.Modify(obj: AnsiString; Op: TLDAPModifyOp; const Value: TLDAPAttribute): Boolean;
-var
-  s: AnsiString;
-  n: integer;
-begin
-  s := '';
-  for n := 0 to Value.Count -1 do
-    s := s + ASNObject(Value[n], ASN1_OCTSTR);
-  s := ASNObject(Value.AttributeName, ASN1_OCTSTR) + ASNObject(s, ASN1_SETOF);
-  s := ASNObject(ASNEncInt(Ord(Op)), ASN1_ENUM) + ASNObject(s, ASN1_SEQ);
-  s := ASNObject(s, ASN1_SEQ);
-  s := ASNObject(obj, ASN1_OCTSTR) + ASNObject(s, ASN1_SEQ);
-  s := ASNObject(s, LDAP_ASN1_MODIFY_REQUEST);
-  Fsock.SendString(BuildPacket(s));
-  s := ReceiveResponse;
-  DecodeResponse(s);
-  Result := FResultCode = 0;
-end;
-
-function TLDAPSend.Add(obj: AnsiString; const Value: TLDAPAttributeList): Boolean;
-var
-  s, t: AnsiString;
-  n, m: integer;
-begin
-  s := '';
-  for n := 0 to Value.Count - 1 do
-  begin
-    t := '';
-    for m := 0 to Value[n].Count - 1 do
-      t := t + ASNObject(Value[n][m], ASN1_OCTSTR);
-    t := ASNObject(Value[n].AttributeName, ASN1_OCTSTR)
-      + ASNObject(t, ASN1_SETOF);
-    s := s + ASNObject(t, ASN1_SEQ);
-  end;
-  s := ASNObject(obj, ASN1_OCTSTR) + ASNObject(s, ASN1_SEQ);
-  s := ASNObject(s, LDAP_ASN1_ADD_REQUEST);
-  Fsock.SendString(BuildPacket(s));
-  s := ReceiveResponse;
-  DecodeResponse(s);
-  Result := FResultCode = 0;
-end;
-
-function TLDAPSend.Delete(obj: AnsiString): Boolean;
-var
-  s: AnsiString;
-begin
-  s := ASNObject(obj, LDAP_ASN1_DEL_REQUEST);
-  Fsock.SendString(BuildPacket(s));
-  s := ReceiveResponse;
-  DecodeResponse(s);
-  Result := FResultCode = 0;
-end;
-
-function TLDAPSend.ModifyDN(obj, newRDN, newSuperior: AnsiString; DeleteOldRDN: Boolean): Boolean;
-var
-  s: AnsiString;
-begin
-  s := ASNObject(obj, ASN1_OCTSTR) + ASNObject(newRDN, ASN1_OCTSTR);
-  if DeleteOldRDN then
-    s := s + ASNObject(ASNEncInt($ff), ASN1_BOOL)
-  else
-    s := s + ASNObject(ASNEncInt(0), ASN1_BOOL);
-  if newSuperior <> '' then
-    s := s + ASNObject(newSuperior, $80);
-  s := ASNObject(s, LDAP_ASN1_MODIFYDN_REQUEST);
-  Fsock.SendString(BuildPacket(s));
-  s := ReceiveResponse;
-  DecodeResponse(s);
-  Result := FResultCode = 0;
-end;
-
-function TLDAPSend.Compare(obj, AttributeValue: AnsiString): Boolean;
-var
-  s: AnsiString;
-begin
-  s := ASNObject(Trim(SeparateLeft(AttributeValue, '=')), ASN1_OCTSTR)
-    + ASNObject(Trim(SeparateRight(AttributeValue, '=')), ASN1_OCTSTR);
-  s := ASNObject(obj, ASN1_OCTSTR) + ASNObject(s, ASN1_SEQ);
-  s := ASNObject(s, LDAP_ASN1_COMPARE_REQUEST);
-  Fsock.SendString(BuildPacket(s));
-  s := ReceiveResponse;
-  DecodeResponse(s);
-  Result := FResultCode = 0;
-end;
-
-function TLDAPSend.Search(obj: AnsiString; TypesOnly: Boolean; Filter: AnsiString;
-  const Attributes: TStrings): Boolean;
-var
-  s, t, u: AnsiString;
-  n, i, x: integer;
-  r: TLDAPResult;
-  a: TLDAPAttribute;
-begin
-  FSearchResult.Clear;
-  FReferals.Clear;
-  s := ASNObject(obj, ASN1_OCTSTR);
-  s := s + ASNObject(ASNEncInt(Ord(FSearchScope)), ASN1_ENUM);
-  s := s + ASNObject(ASNEncInt(Ord(FSearchAliases)), ASN1_ENUM);
-  s := s + ASNObject(ASNEncInt(FSearchSizeLimit), ASN1_INT);
-  s := s + ASNObject(ASNEncInt(FSearchTimeLimit), ASN1_INT);
-  if TypesOnly then
-    s := s + ASNObject(ASNEncInt($ff), ASN1_BOOL)
-  else
-    s := s + ASNObject(ASNEncInt(0), ASN1_BOOL);
-  if Filter = '' then
-    Filter := '(objectclass=*)';
-  t := TranslateFilter(Filter);
-  if t = '' then
-    s := s + ASNObject('', ASN1_NULL)
-  else
-    s := s + t;
-  t := '';
-  for n := 0 to Attributes.Count - 1 do
-    t := t + ASNObject(Attributes[n], ASN1_OCTSTR);
-  s := s + ASNObject(t, ASN1_SEQ);
-  s := ASNObject(s, LDAP_ASN1_SEARCH_REQUEST);
-  Fsock.SendString(BuildPacket(s));
-  repeat
-    s := ReceiveResponse;
-    t := DecodeResponse(s);
-    if FResponseCode = LDAP_ASN1_SEARCH_ENTRY then
-    begin
-      //dekoduj zaznam
-      r := FSearchResult.Add;
-      n := 1;
-      r.ObjectName := ASNItem(n, t, x);
-      ASNItem(n, t, x);
-      if x = ASN1_SEQ then
-      begin
-        while n < Length(t) do
-        begin
-          s := ASNItem(n, t, x);
-          if x = ASN1_SEQ then
-          begin
-            i := n + Length(s);
-            a := r.Attributes.Add;
-            u := ASNItem(n, t, x);
-            a.AttributeName := u;
-            ASNItem(n, t, x);
-            if x = ASN1_SETOF then
-              while n < i do
-              begin
-                u := ASNItem(n, t, x);
-                a.Add(u);
-              end;
-          end;
-        end;
-      end;
-    end;
-    if FResponseCode = LDAP_ASN1_SEARCH_REFERENCE then
-    begin
-      n := 1;
-      while n < Length(t) do
-        FReferals.Add(ASNItem(n, t, x));
-    end;
-  until FResponseCode = LDAP_ASN1_SEARCH_DONE;
-  Result := FResultCode = 0;
-end;
-
-function TLDAPSend.Extended(const Name, Value: AnsiString): Boolean;
-var
-  s, t: AnsiString;
-  x, xt: integer;
-begin
-  s := ASNObject(Name, $80);
-  if Value <> '' then
-    s := s + ASNObject(Value, $81);
-  s := ASNObject(s, LDAP_ASN1_EXT_REQUEST);
-  Fsock.SendString(BuildPacket(s));
-  s := ReceiveResponse;
-  t := DecodeResponse(s);
-  Result := FResultCode = 0;
-  if Result then
-  begin
-    x := 1;
-    FExtName := ASNItem(x, t, xt);
-    FExtValue := ASNItem(x, t, xt);
-  end;
-end;
-
-
-function TLDAPSend.StartTLS: Boolean;
-begin
-  Result := Extended('1.3.6.1.4.1.1466.20037', '');
-  if Result then
-  begin
-    Fsock.SSLDoConnect;
-    Result := FSock.LastError = 0;
-  end;
-end;
-
-{==============================================================================}
-function LDAPResultDump(const Value: TLDAPResultList): AnsiString;
-var
-  n, m, o: integer;
-  r: TLDAPResult;
-  a: TLDAPAttribute;
-begin
-  Result := 'Results: ' + IntToStr(Value.Count) + CRLF +CRLF;
-  for n := 0 to Value.Count - 1 do
-  begin
-    Result := Result + 'Result: ' + IntToStr(n) + CRLF;
-    r := Value[n];
-    Result := Result + '  Object: ' + r.ObjectName + CRLF;
-    for m := 0 to r.Attributes.Count - 1 do
-    begin
-      a := r.Attributes[m];
-      Result := Result + '  Attribute: ' + a.AttributeName + CRLF;
-      for o := 0 to a.Count - 1 do
-        Result := Result + '    ' + a[o] + CRLF;
-    end;
-  end;
-end;
-
-end.
+{==============================================================================|
+| Project : Ararat Synapse                                       | 001.007.000 |
+|==============================================================================|
+| Content: LDAP client                                                         |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2003-2010.                |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@abstract(LDAP client)
+
+Used RFC: RFC-2251, RFC-2254, RFC-2829, RFC-2830
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit ldapsend;
+
+interface
+
+uses
+  SysUtils, Classes,
+  blcksock, synautil, asn1util, synacode;
+
+const
+  cLDAPProtocol = '389';
+
+  LDAP_ASN1_BIND_REQUEST = $60;
+  LDAP_ASN1_BIND_RESPONSE = $61;
+  LDAP_ASN1_UNBIND_REQUEST = $42;
+  LDAP_ASN1_SEARCH_REQUEST = $63;
+  LDAP_ASN1_SEARCH_ENTRY = $64;
+  LDAP_ASN1_SEARCH_DONE = $65;
+  LDAP_ASN1_SEARCH_REFERENCE = $73;
+  LDAP_ASN1_MODIFY_REQUEST = $66;
+  LDAP_ASN1_MODIFY_RESPONSE = $67;
+  LDAP_ASN1_ADD_REQUEST = $68;
+  LDAP_ASN1_ADD_RESPONSE = $69;
+  LDAP_ASN1_DEL_REQUEST = $4A;
+  LDAP_ASN1_DEL_RESPONSE = $6B;
+  LDAP_ASN1_MODIFYDN_REQUEST = $6C;
+  LDAP_ASN1_MODIFYDN_RESPONSE = $6D;
+  LDAP_ASN1_COMPARE_REQUEST = $6E;
+  LDAP_ASN1_COMPARE_RESPONSE = $6F;
+  LDAP_ASN1_ABANDON_REQUEST = $70;
+  LDAP_ASN1_EXT_REQUEST = $77;
+  LDAP_ASN1_EXT_RESPONSE = $78;
+
+
+type
+
+  {:@abstract(LDAP attribute with list of their values)
+   This class holding name of LDAP attribute and list of their values. This is
+   descendant of TStringList class enhanced by some new properties.}
+  TLDAPAttribute = class(TStringList)
+  private
+    FAttributeName: AnsiString;
+    FIsBinary: Boolean;
+  protected
+    function Get(Index: integer): string; override;
+    procedure Put(Index: integer; const Value: string); override;
+    procedure SetAttributeName(Value: AnsiString);
+  published
+    {:Name of LDAP attribute.}
+    property AttributeName: AnsiString read FAttributeName Write SetAttributeName;
+    {:Return @true when attribute contains binary data.}
+    property IsBinary: Boolean read FIsBinary;
+  end;
+
+  {:@abstract(List of @link(TLDAPAttribute))
+   This object can hold list of TLDAPAttribute objects.}
+  TLDAPAttributeList = class(TObject)
+  private
+    FAttributeList: TList;
+    function GetAttribute(Index: integer): TLDAPAttribute;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    {:Clear list.}
+    procedure Clear;
+    {:Return count of TLDAPAttribute objects in list.}
+    function Count: integer;
+    {:Add new TLDAPAttribute object to list.}
+    function Add: TLDAPAttribute;
+    {:Delete one TLDAPAttribute object from list.}
+    procedure Del(Index: integer);
+    {:Find and return attribute with requested name. Returns nil if not found.}
+    function Find(AttributeName: AnsiString): TLDAPAttribute;
+    {:Find and return attribute value with requested name. Returns empty string if not found.}
+    function Get(AttributeName: AnsiString): string;
+    {:List of TLDAPAttribute objects.}
+    property Items[Index: Integer]: TLDAPAttribute read GetAttribute; default;
+  end;
+
+  {:@abstract(LDAP result object)
+   This object can hold LDAP object. (their name and all their attributes with
+   values)}
+  TLDAPResult = class(TObject)
+  private
+    FObjectName: AnsiString;
+    FAttributes: TLDAPAttributeList;
+  public
+    constructor Create;
+    destructor Destroy; override;
+  published
+    {:Name of this LDAP object.}
+    property ObjectName: AnsiString read FObjectName write FObjectName;
+    {:Here is list of object attributes.}
+    property Attributes: TLDAPAttributeList read FAttributes;
+  end;
+
+  {:@abstract(List of LDAP result objects)
+   This object can hold list of LDAP objects. (for example result of LDAP SEARCH.)}
+  TLDAPResultList = class(TObject)
+  private
+    FResultList: TList;
+    function GetResult(Index: integer): TLDAPResult;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    {:Clear all TLDAPResult objects in list.}
+    procedure Clear;
+    {:Return count of TLDAPResult objects in list.}
+    function Count: integer;
+    {:Create and add new TLDAPResult object to list.}
+    function Add: TLDAPResult;
+    {:List of TLDAPResult objects.}
+    property Items[Index: Integer]: TLDAPResult read GetResult; default;
+  end;
+
+  {:Define possible operations for LDAP MODIFY operations.}
+  TLDAPModifyOp = (
+    MO_Add,
+    MO_Delete,
+    MO_Replace
+  );
+
+  {:Specify possible values for search scope.}
+  TLDAPSearchScope = (
+    SS_BaseObject,
+    SS_SingleLevel,
+    SS_WholeSubtree
+  );
+
+  {:Specify possible values about alias dereferencing.}
+  TLDAPSearchAliases = (
+    SA_NeverDeref,
+    SA_InSearching,
+    SA_FindingBaseObj,
+    SA_Always
+  );
+
+  {:@abstract(Implementation of LDAP client)
+   (version 2 and 3)
+
+   Note: Are you missing properties for setting Username and Password? Look to
+   parent @link(TSynaClient) object!
+
+   Are you missing properties for specify server address and port? Look to
+   parent @link(TSynaClient) too!}
+  TLDAPSend = class(TSynaClient)
+  private
+    FSock: TTCPBlockSocket;
+    FResultCode: Integer;
+    FResultString: AnsiString;
+    FFullResult: AnsiString;
+    FAutoTLS: Boolean;
+    FFullSSL: Boolean;
+    FSeq: integer;
+    FResponseCode: integer;
+    FResponseDN: AnsiString;
+    FReferals: TStringList;
+    FVersion: integer;
+    FSearchScope: TLDAPSearchScope;
+    FSearchAliases: TLDAPSearchAliases;
+    FSearchSizeLimit: integer;
+    FSearchTimeLimit: integer;
+    FSearchResult: TLDAPResultList;
+    FExtName: AnsiString;
+    FExtValue: AnsiString;
+    function Connect: Boolean;
+    function BuildPacket(const Value: AnsiString): AnsiString;
+    function ReceiveResponse: AnsiString;
+    function DecodeResponse(const Value: AnsiString): AnsiString;
+    function LdapSasl(Value: AnsiString): AnsiString;
+    function TranslateFilter(Value: AnsiString): AnsiString;
+    function GetErrorString(Value: integer): AnsiString;
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    {:Try to connect to LDAP server and start secure channel, when it is required.}
+    function Login: Boolean;
+
+    {:Try to bind to LDAP server with @link(TSynaClient.Username) and
+     @link(TSynaClient.Password). If this is empty strings, then it do annonymous
+     Bind. When you not call Bind on LDAPv3, then is automaticly used anonymous
+     mode.
+
+     This method using plaintext transport of password! It is not secure!}
+    function Bind: Boolean;
+
+    {:Try to bind to LDAP server with @link(TSynaClient.Username) and
+     @link(TSynaClient.Password). If this is empty strings, then it do annonymous
+     Bind. When you not call Bind on LDAPv3, then is automaticly used anonymous
+     mode.
+
+     This method using SASL with DIGEST-MD5 method for secure transfer of your
+     password.}
+    function BindSasl: Boolean;
+
+    {:Close connection to LDAP server.}
+    function Logout: Boolean;
+
+    {:Modify content of LDAP attribute on this object.}
+    function Modify(obj: AnsiString; Op: TLDAPModifyOp; const Value: TLDAPAttribute): Boolean;
+
+    {:Add list of attributes to specified object.}
+    function Add(obj: AnsiString; const Value: TLDAPAttributeList): Boolean;
+
+    {:Delete this LDAP object from server.}
+    function Delete(obj: AnsiString): Boolean;
+
+    {:Modify object name of this LDAP object.}
+    function ModifyDN(obj, newRDN, newSuperior: AnsiString; DeleteoldRDN: Boolean): Boolean;
+
+    {:Try to compare Attribute value with this LDAP object.}
+    function Compare(obj, AttributeValue: AnsiString): Boolean;
+
+    {:Search LDAP base for LDAP objects by Filter.}
+    function Search(obj: AnsiString; TypesOnly: Boolean; Filter: AnsiString;
+      const Attributes: TStrings): Boolean;
+
+    {:Call any LDAPv3 extended command.}
+    function Extended(const Name, Value: AnsiString): Boolean;
+
+    {:Try to start SSL/TLS connection to LDAP server.}
+    function StartTLS: Boolean;
+  published
+    {:Specify version of used LDAP protocol. Default value is 3.}
+    property Version: integer read FVersion Write FVersion;
+
+    {:Result code of last LDAP operation.}
+    property ResultCode: Integer read FResultCode;
+
+    {:Human readable description of result code of last LDAP operation.}
+    property ResultString: AnsiString read FResultString;
+
+    {:Binary string with full last response of LDAP server. This string is
+     encoded by ASN.1 BER encoding! You need this only for debugging.}
+    property FullResult: AnsiString read FFullResult;
+
+    {:If @true, then try to start TSL mode in Login procedure.}
+    property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
+
+    {:If @true, then use connection to LDAP server through SSL/TLS tunnel.}
+    property FullSSL: Boolean read FFullSSL Write FFullSSL;
+
+    {:Sequence number of last LDAp command. It is incremented by any LDAP command.}
+    property Seq: integer read FSeq;
+
+    {:Specify what search scope is used in search command.}
+    property SearchScope: TLDAPSearchScope read FSearchScope Write FSearchScope;
+
+    {:Specify how to handle aliases in search command.}
+    property SearchAliases: TLDAPSearchAliases read FSearchAliases Write FSearchAliases;
+
+    {:Specify result size limit in search command. Value 0 means without limit.}
+    property SearchSizeLimit: integer read FSearchSizeLimit Write FSearchSizeLimit;
+
+    {:Specify search time limit in search command (seconds). Value 0 means
+     without limit.}
+    property SearchTimeLimit: integer read FSearchTimeLimit Write FSearchTimeLimit;
+
+    {:Here is result of search command.}
+    property SearchResult: TLDAPResultList read FSearchResult;
+
+    {:On each LDAP operation can LDAP server return some referals URLs. Here is
+     their list.}
+    property Referals: TStringList read FReferals;
+
+    {:When you call @link(Extended) operation, then here is result Name returned
+     by server.}
+    property ExtName: AnsiString read FExtName;
+
+    {:When you call @link(Extended) operation, then here is result Value returned
+     by server.}
+    property ExtValue: AnsiString read FExtValue;
+
+    {:TCP socket used by all LDAP operations.}
+    property Sock: TTCPBlockSocket read FSock;
+  end;
+
+{:Dump result of LDAP SEARCH into human readable form. Good for debugging.}
+function LDAPResultDump(const Value: TLDAPResultList): AnsiString;
+
+implementation
+
+{==============================================================================}
+function TLDAPAttribute.Get(Index: integer): string;
+begin
+  Result := inherited Get(Index);
+  if FIsbinary then
+    Result := DecodeBase64(Result);
+end;
+
+procedure TLDAPAttribute.Put(Index: integer; const Value: string);
+var
+  s: AnsiString;
+begin
+  s := Value;
+  if FIsbinary then
+    s := EncodeBase64(Value)
+  else
+    s :=UnquoteStr(s, '"');
+  inherited Put(Index, s);
+end;
+
+procedure TLDAPAttribute.SetAttributeName(Value: AnsiString);
+begin
+  FAttributeName := Value;
+  FIsBinary := Pos(';binary', Lowercase(value)) > 0;
+end;
+
+{==============================================================================}
+constructor TLDAPAttributeList.Create;
+begin
+  inherited Create;
+  FAttributeList := TList.Create;
+end;
+
+destructor TLDAPAttributeList.Destroy;
+begin
+  Clear;
+  FAttributeList.Free;
+  inherited Destroy;
+end;
+
+procedure TLDAPAttributeList.Clear;
+var
+  n: integer;
+  x: TLDAPAttribute;
+begin
+  for n := Count - 1 downto 0 do
+  begin
+    x := GetAttribute(n);
+    if Assigned(x) then
+      x.Free;
+  end;
+  FAttributeList.Clear;
+end;
+
+function TLDAPAttributeList.Count: integer;
+begin
+  Result := FAttributeList.Count;
+end;
+
+function TLDAPAttributeList.Get(AttributeName: AnsiString): string;
+var
+  x: TLDAPAttribute;
+begin
+  Result := '';
+  x := self.Find(AttributeName);
+  if x <> nil then
+    if x.Count > 0 then
+      Result := x[0];
+end;
+
+function TLDAPAttributeList.GetAttribute(Index: integer): TLDAPAttribute;
+begin
+  Result := nil;
+  if Index < Count then
+    Result := TLDAPAttribute(FAttributeList[Index]);
+end;
+
+function TLDAPAttributeList.Add: TLDAPAttribute;
+begin
+  Result := TLDAPAttribute.Create;
+  FAttributeList.Add(Result);
+end;
+
+procedure TLDAPAttributeList.Del(Index: integer);
+var
+  x: TLDAPAttribute;
+begin
+  x := GetAttribute(Index);
+  if Assigned(x) then
+    x.free;
+  FAttributeList.Delete(Index);
+end;
+
+function TLDAPAttributeList.Find(AttributeName: AnsiString): TLDAPAttribute;
+var
+  n: integer;
+  x: TLDAPAttribute;
+begin
+  Result := nil;
+  AttributeName := lowercase(AttributeName);
+  for n := 0 to Count - 1 do
+  begin
+    x := GetAttribute(n);
+    if Assigned(x) then
+      if lowercase(x.AttributeName) = Attributename then
+      begin
+        result := x;
+        break;
+      end;
+  end;
+end;
+
+{==============================================================================}
+constructor TLDAPResult.Create;
+begin
+  inherited Create;
+  FAttributes := TLDAPAttributeList.Create;
+end;
+
+destructor TLDAPResult.Destroy;
+begin
+  FAttributes.Free;
+  inherited Destroy;
+end;
+
+{==============================================================================}
+constructor TLDAPResultList.Create;
+begin
+  inherited Create;
+  FResultList := TList.Create;
+end;
+
+destructor TLDAPResultList.Destroy;
+begin
+  Clear;
+  FResultList.Free;
+  inherited Destroy;
+end;
+
+procedure TLDAPResultList.Clear;
+var
+  n: integer;
+  x: TLDAPResult;
+begin
+  for n := Count - 1 downto 0 do
+  begin
+    x := GetResult(n);
+    if Assigned(x) then
+      x.Free;
+  end;
+  FResultList.Clear;
+end;
+
+function TLDAPResultList.Count: integer;
+begin
+  Result := FResultList.Count;
+end;
+
+function TLDAPResultList.GetResult(Index: integer): TLDAPResult;
+begin
+  Result := nil;
+  if Index < Count then
+    Result := TLDAPResult(FResultList[Index]);
+end;
+
+function TLDAPResultList.Add: TLDAPResult;
+begin
+  Result := TLDAPResult.Create;
+  FResultList.Add(Result);
+end;
+
+{==============================================================================}
+constructor TLDAPSend.Create;
+begin
+  inherited Create;
+  FReferals := TStringList.Create;
+  FFullResult := '';
+  FSock := TTCPBlockSocket.Create;
+  FSock.Owner := self;
+  FTimeout := 60000;
+  FTargetPort := cLDAPProtocol;
+  FAutoTLS := False;
+  FFullSSL := False;
+  FSeq := 0;
+  FVersion := 3;
+  FSearchScope := SS_WholeSubtree;
+  FSearchAliases := SA_Always;
+  FSearchSizeLimit := 0;
+  FSearchTimeLimit := 0;
+  FSearchResult := TLDAPResultList.Create;
+end;
+
+destructor TLDAPSend.Destroy;
+begin
+  FSock.Free;
+  FSearchResult.Free;
+  FReferals.Free;
+  inherited Destroy;
+end;
+
+function TLDAPSend.GetErrorString(Value: integer): AnsiString;
+begin
+  case Value of
+    0:
+      Result := 'Success';
+    1:
+      Result := 'Operations error';
+    2:
+      Result := 'Protocol error';
+    3:
+      Result := 'Time limit Exceeded';
+    4:
+      Result := 'Size limit Exceeded';
+    5:
+      Result := 'Compare FALSE';
+    6:
+      Result := 'Compare TRUE';
+    7:
+      Result := 'Auth method not supported';
+    8:
+      Result := 'Strong auth required';
+    9:
+      Result := '-- reserved --';
+    10:
+      Result := 'Referal';
+    11:
+      Result := 'Admin limit exceeded';
+    12:
+      Result := 'Unavailable critical extension';
+    13:
+      Result := 'Confidentality required';
+    14:
+      Result := 'Sasl bind in progress';
+    16:
+      Result := 'No such attribute';
+    17:
+      Result := 'Undefined attribute type';
+    18:
+      Result := 'Inappropriate matching';
+    19:
+      Result := 'Constraint violation';
+    20:
+      Result := 'Attribute or value exists';
+    21:
+      Result := 'Invalid attribute syntax';
+    32:
+      Result := 'No such object';
+    33:
+      Result := 'Alias problem';
+    34:
+      Result := 'Invalid DN syntax';
+    36:
+      Result := 'Alias dereferencing problem';
+    48:
+      Result := 'Inappropriate authentication';
+    49:
+      Result := 'Invalid credentials';
+    50:
+      Result := 'Insufficient access rights';
+    51:
+      Result := 'Busy';
+    52:
+      Result := 'Unavailable';
+    53:
+      Result := 'Unwilling to perform';
+    54:
+      Result := 'Loop detect';
+    64:
+      Result := 'Naming violation';
+    65:
+      Result := 'Object class violation';
+    66:
+      Result := 'Not allowed on non leaf';
+    67:
+      Result := 'Not allowed on RDN';
+    68:
+      Result := 'Entry already exists';
+    69:
+      Result := 'Object class mods prohibited';
+    71:
+      Result := 'Affects multiple DSAs';
+    80:
+      Result := 'Other';
+  else
+    Result := '--unknown--';
+  end;
+end;
+
+function TLDAPSend.Connect: Boolean;
+begin
+  // Do not call this function! It is calling by LOGIN method!
+  FSock.CloseSocket;
+  FSock.LineBuffer := '';
+  FSeq := 0;
+  FSock.Bind(FIPInterface, cAnyPort);
+  if FSock.LastError = 0 then
+    FSock.Connect(FTargetHost, FTargetPort);
+  if FSock.LastError = 0 then
+    if FFullSSL then
+      FSock.SSLDoConnect;
+  Result := FSock.LastError = 0;
+end;
+
+function TLDAPSend.BuildPacket(const Value: AnsiString): AnsiString;
+begin
+  Inc(FSeq);
+  Result := ASNObject(ASNObject(ASNEncInt(FSeq), ASN1_INT) + Value,  ASN1_SEQ);
+end;
+
+function TLDAPSend.ReceiveResponse: AnsiString;
+var
+  x: Byte;
+  i,j: integer;
+begin
+  Result := '';
+  FFullResult := '';
+  x := FSock.RecvByte(FTimeout);
+  if x <> ASN1_SEQ then
+    Exit;
+  Result := AnsiChar(x);
+  x := FSock.RecvByte(FTimeout);
+  Result := Result + AnsiChar(x);
+  if x < $80 then
+    i := 0
+  else
+    i := x and $7F;
+  if i > 0 then
+    Result := Result + FSock.RecvBufferStr(i, Ftimeout);
+  if FSock.LastError <> 0 then
+  begin
+    Result := '';
+    Exit;
+  end;
+  //get length of LDAP packet
+  j := 2;
+  i := ASNDecLen(j, Result);
+  //retreive rest of LDAP packet
+  if i > 0 then
+    Result := Result + FSock.RecvBufferStr(i, Ftimeout);
+  if FSock.LastError <> 0 then
+  begin
+    Result := '';
+    Exit;
+  end;
+  FFullResult := Result;
+end;
+
+function TLDAPSend.DecodeResponse(const Value: AnsiString): AnsiString;
+var
+  i, x: integer;
+  Svt: Integer;
+  s, t: AnsiString;
+begin
+  Result := '';
+  FResultCode := -1;
+  FResultstring := '';
+  FResponseCode := -1;
+  FResponseDN := '';
+  FReferals.Clear;
+  i := 1;
+  ASNItem(i, Value, Svt);
+  x := StrToIntDef(ASNItem(i, Value, Svt), 0);
+  if (svt <> ASN1_INT) or (x <> FSeq) then
+    Exit;
+  s := ASNItem(i, Value, Svt);
+  FResponseCode := svt;
+  if FResponseCode in [LDAP_ASN1_BIND_RESPONSE, LDAP_ASN1_SEARCH_DONE,
+    LDAP_ASN1_MODIFY_RESPONSE, LDAP_ASN1_ADD_RESPONSE, LDAP_ASN1_DEL_RESPONSE,
+    LDAP_ASN1_MODIFYDN_RESPONSE, LDAP_ASN1_COMPARE_RESPONSE,
+    LDAP_ASN1_EXT_RESPONSE] then
+  begin
+    FResultCode := StrToIntDef(ASNItem(i, Value, Svt), -1);
+    FResponseDN := ASNItem(i, Value, Svt);
+    FResultString := ASNItem(i, Value, Svt);
+    if FResultString = '' then
+      FResultString := GetErrorString(FResultCode);
+    if FResultCode = 10 then
+    begin
+      s := ASNItem(i, Value, Svt);
+      if svt = $A3 then
+      begin
+        x := 1;
+        while x < Length(s) do
+        begin
+          t := ASNItem(x, s, Svt);
+          FReferals.Add(t);
+        end;
+      end;
+    end;
+  end;
+  Result := Copy(Value, i, Length(Value) - i + 1);
+end;
+
+function TLDAPSend.LdapSasl(Value: AnsiString): AnsiString;
+var
+  nonce, cnonce, nc, realm, qop, uri, response: AnsiString;
+  s: AnsiString;
+  a1, a2: AnsiString;
+  l: TStringList;
+  n: integer;
+begin
+  l := TStringList.Create;
+  try
+    nonce := '';
+    realm := '';
+    l.CommaText := Value;
+    n := IndexByBegin('nonce=', l);
+    if n >= 0 then
+      nonce := UnQuoteStr(Trim(SeparateRight(l[n], 'nonce=')), '"');
+    n := IndexByBegin('realm=', l);
+    if n >= 0 then
+      realm := UnQuoteStr(Trim(SeparateRight(l[n], 'realm=')), '"');
+    cnonce := IntToHex(GetTick, 8);
+    nc := '00000001';
+    qop := 'auth';
+    uri := 'ldap/' + FSock.ResolveIpToName(FSock.GetRemoteSinIP);
+    a1 := md5(FUsername + ':' + realm + ':' + FPassword)
+      + ':' + nonce + ':' + cnonce;
+    a2 := 'AUTHENTICATE:' + uri;
+    s := strtohex(md5(a1))+':' + nonce + ':' + nc + ':' + cnonce + ':'
+      + qop +':'+strtohex(md5(a2));
+    response := strtohex(md5(s));
+
+    Result := 'username="' + Fusername + '",realm="' + realm + '",nonce="';
+    Result := Result + nonce + '",cnonce="' + cnonce + '",nc=' + nc + ',qop=';
+    Result := Result + qop + ',digest-uri="' + uri + '",response=' + response;
+  finally
+    l.Free;
+  end;
+end;
+
+function TLDAPSend.TranslateFilter(Value: AnsiString): AnsiString;
+var
+  x: integer;
+  s, t, l: AnsiString;
+  r: string;
+  c: Ansichar;
+  attr, rule: AnsiString;
+  dn: Boolean;
+begin
+  Result := '';
+  if Value = '' then
+    Exit;
+  s := Value;
+  if Value[1] = '(' then
+  begin
+    x := RPos(')', Value);
+    s := Copy(Value, 2, x - 2);
+  end;
+  if s = '' then
+    Exit;
+  case s[1] of
+    '!':
+      // NOT rule (recursive call)
+      begin
+        Result := ASNOBject(TranslateFilter(GetBetween('(', ')', s)), $A2);
+      end;
+    '&':
+      // AND rule (recursive call)
+      begin
+        repeat
+          t := GetBetween('(', ')', s);
+          s := Trim(SeparateRight(s, t));
+          if s <> '' then
+            if s[1] = ')' then
+              {$IFDEF CIL}Borland.Delphi.{$ENDIF}System.Delete(s, 1, 1);
+          Result := Result + TranslateFilter(t);
+        until s = '';
+        Result := ASNOBject(Result, $A0);
+      end;
+    '|':
+      // OR rule (recursive call)
+      begin
+        repeat
+          t := GetBetween('(', ')', s);
+          s := Trim(SeparateRight(s, t));
+          if s <> '' then
+            if s[1] = ')' then
+              {$IFDEF CIL}Borland.Delphi.{$ENDIF}System.Delete(s, 1, 1);
+          Result := Result + TranslateFilter(t);
+        until s = '';
+        Result := ASNOBject(Result, $A1);
+      end;
+    else
+      begin
+        l := Trim(SeparateLeft(s, '='));
+        r := Trim(SeparateRight(s, '='));
+        if l <> '' then
+        begin
+          c := l[Length(l)];
+          case c of
+            ':':
+              // Extensible match
+              begin
+                {$IFDEF CIL}Borland.Delphi.{$ENDIF}System.Delete(l, Length(l), 1);
+                dn := False;
+                attr := '';
+                rule := '';
+                if Pos(':dn', l) > 0 then
+                begin
+                  dn := True;
+                  l := ReplaceString(l, ':dn', '');
+                end;
+                attr := Trim(SeparateLeft(l, ':'));
+                rule := Trim(SeparateRight(l, ':'));
+                if rule = l then
+                  rule := '';
+                if rule <> '' then
+                  Result := ASNObject(rule, $81);
+                if attr <> '' then
+                  Result := Result + ASNObject(attr, $82);
+                Result := Result + ASNObject(DecodeTriplet(r, '\'), $83);
+                if dn then
+                  Result := Result + ASNObject(AsnEncInt($ff), $84)
+                else
+                  Result := Result + ASNObject(AsnEncInt(0), $84);
+                Result := ASNOBject(Result, $a9);
+              end;
+            '~':
+              // Approx match
+              begin
+                {$IFDEF CIL}Borland.Delphi.{$ENDIF}System.Delete(l, Length(l), 1);
+                Result := ASNOBject(l, ASN1_OCTSTR)
+                  + ASNOBject(DecodeTriplet(r, '\'), ASN1_OCTSTR);
+                Result := ASNOBject(Result, $a8);
+              end;
+            '>':
+              // Greater or equal match
+              begin
+                {$IFDEF CIL}Borland.Delphi.{$ENDIF}System.Delete(l, Length(l), 1);
+                Result := ASNOBject(l, ASN1_OCTSTR)
+                  + ASNOBject(DecodeTriplet(r, '\'), ASN1_OCTSTR);
+                Result := ASNOBject(Result, $a5);
+              end;
+            '<':
+              // Less or equal match
+              begin
+                {$IFDEF CIL}Borland.Delphi.{$ENDIF}System.Delete(l, Length(l), 1);
+                Result := ASNOBject(l, ASN1_OCTSTR)
+                  + ASNOBject(DecodeTriplet(r, '\'), ASN1_OCTSTR);
+                Result := ASNOBject(Result, $a6);
+              end;
+          else
+            // present
+            if r = '*' then
+              Result := ASNOBject(l, $87)
+            else
+              if Pos('*', r) > 0 then
+              // substrings
+              begin
+                s := Fetch(r, '*');
+                if s <> '' then
+                  Result := ASNOBject(DecodeTriplet(s, '\'), $80);
+                while r <> '' do
+                begin
+                  if Pos('*', r) <= 0 then
+                    break;
+                  s := Fetch(r, '*');
+                  Result := Result + ASNOBject(DecodeTriplet(s, '\'), $81);
+                end;
+                if r <> '' then
+                  Result := Result + ASNOBject(DecodeTriplet(r, '\'), $82);
+                Result := ASNOBject(l, ASN1_OCTSTR)
+                  + ASNOBject(Result, ASN1_SEQ);
+                Result := ASNOBject(Result, $a4);
+              end
+              else
+              begin
+                // Equality match
+                Result := ASNOBject(l, ASN1_OCTSTR)
+                  + ASNOBject(DecodeTriplet(r, '\'), ASN1_OCTSTR);
+                Result := ASNOBject(Result, $a3);
+              end;
+          end;
+        end;
+      end;
+  end;
+end;
+
+function TLDAPSend.Login: Boolean;
+begin
+  Result := False;
+  if not Connect then
+    Exit;
+  Result := True;
+  if FAutoTLS then
+    Result := StartTLS;
+end;
+
+function TLDAPSend.Bind: Boolean;
+var
+  s: AnsiString;
+begin
+  s := ASNObject(ASNEncInt(FVersion), ASN1_INT)
+    + ASNObject(FUsername, ASN1_OCTSTR)
+    + ASNObject(FPassword, $80);
+  s := ASNObject(s, LDAP_ASN1_BIND_REQUEST);
+  Fsock.SendString(BuildPacket(s));
+  s := ReceiveResponse;
+  DecodeResponse(s);
+  Result := FResultCode = 0;
+end;
+
+function TLDAPSend.BindSasl: Boolean;
+var
+  s, t: AnsiString;
+  x, xt: integer;
+  digreq: AnsiString;
+begin
+  Result := False;
+  if FPassword = '' then
+    Result := Bind
+  else
+  begin
+    digreq := ASNObject(ASNEncInt(FVersion), ASN1_INT)
+      + ASNObject('', ASN1_OCTSTR)
+      + ASNObject(ASNObject('DIGEST-MD5', ASN1_OCTSTR), $A3);
+    digreq := ASNObject(digreq, LDAP_ASN1_BIND_REQUEST);
+    Fsock.SendString(BuildPacket(digreq));
+    s := ReceiveResponse;
+    t := DecodeResponse(s);
+    if FResultCode = 14 then
+    begin
+      s := t;
+      x := 1;
+      t := ASNItem(x, s, xt);
+      s := ASNObject(ASNEncInt(FVersion), ASN1_INT)
+        + ASNObject('', ASN1_OCTSTR)
+        + ASNObject(ASNObject('DIGEST-MD5', ASN1_OCTSTR)
+          + ASNObject(LdapSasl(t), ASN1_OCTSTR), $A3);
+      s := ASNObject(s, LDAP_ASN1_BIND_REQUEST);
+      Fsock.SendString(BuildPacket(s));
+      s := ReceiveResponse;
+      DecodeResponse(s);
+      if FResultCode = 14 then
+      begin
+        Fsock.SendString(BuildPacket(digreq));
+        s := ReceiveResponse;
+        DecodeResponse(s);
+      end;
+      Result := FResultCode = 0;
+    end;
+  end;
+end;
+
+function TLDAPSend.Logout: Boolean;
+begin
+  Fsock.SendString(BuildPacket(ASNObject('', LDAP_ASN1_UNBIND_REQUEST)));
+  FSock.CloseSocket;
+  Result := True;
+end;
+
+function TLDAPSend.Modify(obj: AnsiString; Op: TLDAPModifyOp; const Value: TLDAPAttribute): Boolean;
+var
+  s: AnsiString;
+  n: integer;
+begin
+  s := '';
+  for n := 0 to Value.Count -1 do
+    s := s + ASNObject(Value[n], ASN1_OCTSTR);
+  s := ASNObject(Value.AttributeName, ASN1_OCTSTR) + ASNObject(s, ASN1_SETOF);
+  s := ASNObject(ASNEncInt(Ord(Op)), ASN1_ENUM) + ASNObject(s, ASN1_SEQ);
+  s := ASNObject(s, ASN1_SEQ);
+  s := ASNObject(obj, ASN1_OCTSTR) + ASNObject(s, ASN1_SEQ);
+  s := ASNObject(s, LDAP_ASN1_MODIFY_REQUEST);
+  Fsock.SendString(BuildPacket(s));
+  s := ReceiveResponse;
+  DecodeResponse(s);
+  Result := FResultCode = 0;
+end;
+
+function TLDAPSend.Add(obj: AnsiString; const Value: TLDAPAttributeList): Boolean;
+var
+  s, t: AnsiString;
+  n, m: integer;
+begin
+  s := '';
+  for n := 0 to Value.Count - 1 do
+  begin
+    t := '';
+    for m := 0 to Value[n].Count - 1 do
+      t := t + ASNObject(Value[n][m], ASN1_OCTSTR);
+    t := ASNObject(Value[n].AttributeName, ASN1_OCTSTR)
+      + ASNObject(t, ASN1_SETOF);
+    s := s + ASNObject(t, ASN1_SEQ);
+  end;
+  s := ASNObject(obj, ASN1_OCTSTR) + ASNObject(s, ASN1_SEQ);
+  s := ASNObject(s, LDAP_ASN1_ADD_REQUEST);
+  Fsock.SendString(BuildPacket(s));
+  s := ReceiveResponse;
+  DecodeResponse(s);
+  Result := FResultCode = 0;
+end;
+
+function TLDAPSend.Delete(obj: AnsiString): Boolean;
+var
+  s: AnsiString;
+begin
+  s := ASNObject(obj, LDAP_ASN1_DEL_REQUEST);
+  Fsock.SendString(BuildPacket(s));
+  s := ReceiveResponse;
+  DecodeResponse(s);
+  Result := FResultCode = 0;
+end;
+
+function TLDAPSend.ModifyDN(obj, newRDN, newSuperior: AnsiString; DeleteOldRDN: Boolean): Boolean;
+var
+  s: AnsiString;
+begin
+  s := ASNObject(obj, ASN1_OCTSTR) + ASNObject(newRDN, ASN1_OCTSTR);
+  if DeleteOldRDN then
+    s := s + ASNObject(ASNEncInt($ff), ASN1_BOOL)
+  else
+    s := s + ASNObject(ASNEncInt(0), ASN1_BOOL);
+  if newSuperior <> '' then
+    s := s + ASNObject(newSuperior, $80);
+  s := ASNObject(s, LDAP_ASN1_MODIFYDN_REQUEST);
+  Fsock.SendString(BuildPacket(s));
+  s := ReceiveResponse;
+  DecodeResponse(s);
+  Result := FResultCode = 0;
+end;
+
+function TLDAPSend.Compare(obj, AttributeValue: AnsiString): Boolean;
+var
+  s: AnsiString;
+begin
+  s := ASNObject(Trim(SeparateLeft(AttributeValue, '=')), ASN1_OCTSTR)
+    + ASNObject(Trim(SeparateRight(AttributeValue, '=')), ASN1_OCTSTR);
+  s := ASNObject(obj, ASN1_OCTSTR) + ASNObject(s, ASN1_SEQ);
+  s := ASNObject(s, LDAP_ASN1_COMPARE_REQUEST);
+  Fsock.SendString(BuildPacket(s));
+  s := ReceiveResponse;
+  DecodeResponse(s);
+  Result := FResultCode = 0;
+end;
+
+function TLDAPSend.Search(obj: AnsiString; TypesOnly: Boolean; Filter: AnsiString;
+  const Attributes: TStrings): Boolean;
+var
+  s, t, u: AnsiString;
+  n, i, x: integer;
+  r: TLDAPResult;
+  a: TLDAPAttribute;
+begin
+  FSearchResult.Clear;
+  FReferals.Clear;
+  s := ASNObject(obj, ASN1_OCTSTR);
+  s := s + ASNObject(ASNEncInt(Ord(FSearchScope)), ASN1_ENUM);
+  s := s + ASNObject(ASNEncInt(Ord(FSearchAliases)), ASN1_ENUM);
+  s := s + ASNObject(ASNEncInt(FSearchSizeLimit), ASN1_INT);
+  s := s + ASNObject(ASNEncInt(FSearchTimeLimit), ASN1_INT);
+  if TypesOnly then
+    s := s + ASNObject(ASNEncInt($ff), ASN1_BOOL)
+  else
+    s := s + ASNObject(ASNEncInt(0), ASN1_BOOL);
+  if Filter = '' then
+    Filter := '(objectclass=*)';
+  t := TranslateFilter(Filter);
+  if t = '' then
+    s := s + ASNObject('', ASN1_NULL)
+  else
+    s := s + t;
+  t := '';
+  for n := 0 to Attributes.Count - 1 do
+    t := t + ASNObject(Attributes[n], ASN1_OCTSTR);
+  s := s + ASNObject(t, ASN1_SEQ);
+  s := ASNObject(s, LDAP_ASN1_SEARCH_REQUEST);
+  Fsock.SendString(BuildPacket(s));
+  repeat
+    s := ReceiveResponse;
+    t := DecodeResponse(s);
+    if FResponseCode = LDAP_ASN1_SEARCH_ENTRY then
+    begin
+      //dekoduj zaznam
+      r := FSearchResult.Add;
+      n := 1;
+      r.ObjectName := ASNItem(n, t, x);
+      ASNItem(n, t, x);
+      if x = ASN1_SEQ then
+      begin
+        while n < Length(t) do
+        begin
+          s := ASNItem(n, t, x);
+          if x = ASN1_SEQ then
+          begin
+            i := n + Length(s);
+            a := r.Attributes.Add;
+            u := ASNItem(n, t, x);
+            a.AttributeName := u;
+            ASNItem(n, t, x);
+            if x = ASN1_SETOF then
+              while n < i do
+              begin
+                u := ASNItem(n, t, x);
+                a.Add(u);
+              end;
+          end;
+        end;
+      end;
+    end;
+    if FResponseCode = LDAP_ASN1_SEARCH_REFERENCE then
+    begin
+      n := 1;
+      while n < Length(t) do
+        FReferals.Add(ASNItem(n, t, x));
+    end;
+  until FResponseCode = LDAP_ASN1_SEARCH_DONE;
+  Result := FResultCode = 0;
+end;
+
+function TLDAPSend.Extended(const Name, Value: AnsiString): Boolean;
+var
+  s, t: AnsiString;
+  x, xt: integer;
+begin
+  s := ASNObject(Name, $80);
+  if Value <> '' then
+    s := s + ASNObject(Value, $81);
+  s := ASNObject(s, LDAP_ASN1_EXT_REQUEST);
+  Fsock.SendString(BuildPacket(s));
+  s := ReceiveResponse;
+  t := DecodeResponse(s);
+  Result := FResultCode = 0;
+  if Result then
+  begin
+    x := 1;
+    FExtName := ASNItem(x, t, xt);
+    FExtValue := ASNItem(x, t, xt);
+  end;
+end;
+
+
+function TLDAPSend.StartTLS: Boolean;
+begin
+  Result := Extended('1.3.6.1.4.1.1466.20037', '');
+  if Result then
+  begin
+    Fsock.SSLDoConnect;
+    Result := FSock.LastError = 0;
+  end;
+end;
+
+{==============================================================================}
+function LDAPResultDump(const Value: TLDAPResultList): AnsiString;
+var
+  n, m, o: integer;
+  r: TLDAPResult;
+  a: TLDAPAttribute;
+begin
+  Result := 'Results: ' + IntToStr(Value.Count) + CRLF +CRLF;
+  for n := 0 to Value.Count - 1 do
+  begin
+    Result := Result + 'Result: ' + IntToStr(n) + CRLF;
+    r := Value[n];
+    Result := Result + '  Object: ' + r.ObjectName + CRLF;
+    for m := 0 to r.Attributes.Count - 1 do
+    begin
+      a := r.Attributes[m];
+      Result := Result + '  Attribute: ' + a.AttributeName + CRLF;
+      for o := 0 to a.Count - 1 do
+        Result := Result + '    ' + a[o] + CRLF;
+    end;
+  end;
+end;
+
+end.
diff --git a/Units/Synapse/mimeinln.pas b/Units/Synapse/mimeinln.pas
index 924dd5f..a6fb506 100644
--- a/Units/Synapse/mimeinln.pas
+++ b/Units/Synapse/mimeinln.pas
@@ -1,263 +1,263 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 001.001.011 |
-|==============================================================================|
-| Content: Inline MIME support procedures and functions                        |
-|==============================================================================|
-| Copyright (c)1999-2006, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2000-2006.                |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{:@abstract(Utilities for inline MIME)
-Support for Inline MIME encoding and decoding.
-
-Used RFC: RFC-2047, RFC-2231
-}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$H+}
-
-{$IFDEF UNICODE}
-  {$WARN IMPLICIT_STRING_CAST OFF}
-  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
-{$ENDIF}
-
-unit mimeinln;
-
-interface
-
-uses
-  SysUtils, Classes,
-  synachar, synacode, synautil;
-
-{:Decodes mime inline encoding (i.e. in headers) uses target characterset "CP".}
-function InlineDecode(const Value: string; CP: TMimeChar): string;
-
-{:Encodes string to MIME inline encoding. The source characterset is "CP", and
- the target charset is "MimeP".}
-function InlineEncode(const Value: string; CP, MimeP: TMimeChar): string;
-
-{:Returns @true, if "Value" contains characters needed for inline coding.}
-function NeedInline(const Value: AnsiString): boolean;
-
-{:Inline mime encoding similar to @link(InlineEncode), but you can specify
- source charset, and the target characterset is automatically assigned.}
-function InlineCodeEx(const Value: string; FromCP: TMimeChar): string;
-
-{:Inline MIME encoding similar to @link(InlineEncode), but the source charset
- is automatically set to the system default charset, and the target charset is
- automatically assigned from set of allowed encoding for MIME.}
-function InlineCode(const Value: string): string;
-
-{:Converts e-mail address to canonical mime form. You can specify source charset.}
-function InlineEmailEx(const Value: string; FromCP: TMimeChar): string;
-
-{:Converts e-mail address to canonical mime form. Source charser it system
- default charset.}
-function InlineEmail(const Value: string): string;
-
-implementation
-
-{==============================================================================}
-
-function InlineDecode(const Value: string; CP: TMimeChar): string;
-var
-  s, su, v: string;
-  x, y, z, n: Integer;
-  ichar: TMimeChar;
-  c: Char;
-
-  function SearchEndInline(const Value: string; be: Integer): Integer;
-  var
-    n, q: Integer;
-  begin
-    q := 0;
-    Result := 0;
-    for n := be + 2 to Length(Value) - 1 do
-      if Value[n] = '?' then
-      begin
-        Inc(q);
-        if (q > 2) and (Value[n + 1] = '=') then
-        begin
-          Result := n;
-          Break;
-        end;
-      end;
-  end;
-
-begin
-  Result := '';
-  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);
-    if Trim(s) <> '' then
-      Result := Result + s;
-    s := Copy(v, x, y - x + 2);
-    Delete(v, 1, y + 1);
-    su := Copy(s, 3, Length(s) - 4);
-    z := Pos('?', su);
-    if (Length(su) >= (z + 2)) and (su[z + 2] = '?') then
-    begin
-      ichar := GetCPFromID(SeparateLeft(Copy(su, 1, z - 1), '*'));
-      c := UpperCase(su)[z + 1];
-      su := Copy(su, z + 3, Length(su) - z - 2);
-      if c = 'B' then
-      begin
-        s := DecodeBase64(su);
-        s := CharsetConversion(s, ichar, CP);
-      end;
-      if c = 'Q' then
-      begin
-        s := '';
-        for n := 1 to Length(su) do
-          if su[n] = '_' then
-            s := s + ' '
-          else
-            s := s + su[n];
-        s := DecodeQuotedPrintable(s);
-        s := CharsetConversion(s, ichar, CP);
-      end;
-    end;
-    Result := Result + s;
-    x := Pos('=?', v);
-    y := SearchEndInline(v, x);
-  end;
-  Result := Result + v;
-end;
-
-{==============================================================================}
-
-function InlineEncode(const Value: string; CP, MimeP: TMimeChar): string;
-var
-  s, s1, e: string;
-  n: Integer;
-begin
-  s := CharsetConversion(Value, CP, MimeP);
-  s := EncodeSafeQuotedPrintable(s);
-  e := GetIdFromCP(MimeP);
-  s1 := '';
-  Result := '';
-  for n := 1 to Length(s) do
-    if s[n] = ' ' then
-    begin
-//      s1 := s1 + '=20';
-      s1 := s1 + '_';
-      if Length(s1) > 32 then
-      begin
-        if Result <> '' then
-          Result := Result + ' ';
-        Result := Result + '=?' + e + '?Q?' + s1 + '?=';
-        s1 := '';
-      end;
-    end
-    else
-      s1 := s1 + s[n];
-  if s1 <> '' then
-  begin
-    if Result <> '' then
-      Result := Result + ' ';
-    Result := Result + '=?' + e + '?Q?' + s1 + '?=';
-  end;
-end;
-
-{==============================================================================}
-
-function NeedInline(const Value: AnsiString): boolean;
-var
-  n: Integer;
-begin
-  Result := False;
-  for n := 1 to Length(Value) do
-    if Value[n] in (SpecialChar + NonAsciiChar - ['_']) then
-    begin
-      Result := True;
-      Break;
-    end;
-end;
-
-{==============================================================================}
-
-function InlineCodeEx(const Value: string; FromCP: TMimeChar): string;
-var
-  c: TMimeChar;
-begin
-  if NeedInline(Value) then
-  begin
-    c := IdealCharsetCoding(Value, FromCP, IdealCharsets);
-    Result := InlineEncode(Value, FromCP, c);
-  end
-  else
-    Result := Value;
-end;
-
-{==============================================================================}
-
-function InlineCode(const Value: string): string;
-begin
-  Result := InlineCodeEx(Value, GetCurCP);
-end;
-
-{==============================================================================}
-
-function InlineEmailEx(const Value: string; FromCP: TMimeChar): string;
-var
-  sd, se: string;
-begin
-  sd := GetEmailDesc(Value);
-  se := GetEmailAddr(Value);
-  if sd = '' then
-    Result := se
-  else
-    Result := '"' + InlineCodeEx(sd, FromCP) + '" <' + se + '>';
-end;
-
-{==============================================================================}
-
-function InlineEmail(const Value: string): string;
-begin
-  Result := InlineEmailEx(Value, GetCurCP);
-end;
-
-end.
+{==============================================================================|
+| Project : Ararat Synapse                                       | 001.001.011 |
+|==============================================================================|
+| Content: Inline MIME support procedures and functions                        |
+|==============================================================================|
+| Copyright (c)1999-2006, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2000-2006.                |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@abstract(Utilities for inline MIME)
+Support for Inline MIME encoding and decoding.
+
+Used RFC: RFC-2047, RFC-2231
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit mimeinln;
+
+interface
+
+uses
+  SysUtils, Classes,
+  synachar, synacode, synautil;
+
+{:Decodes mime inline encoding (i.e. in headers) uses target characterset "CP".}
+function InlineDecode(const Value: string; CP: TMimeChar): string;
+
+{:Encodes string to MIME inline encoding. The source characterset is "CP", and
+ the target charset is "MimeP".}
+function InlineEncode(const Value: string; CP, MimeP: TMimeChar): string;
+
+{:Returns @true, if "Value" contains characters needed for inline coding.}
+function NeedInline(const Value: AnsiString): boolean;
+
+{:Inline mime encoding similar to @link(InlineEncode), but you can specify
+ source charset, and the target characterset is automatically assigned.}
+function InlineCodeEx(const Value: string; FromCP: TMimeChar): string;
+
+{:Inline MIME encoding similar to @link(InlineEncode), but the source charset
+ is automatically set to the system default charset, and the target charset is
+ automatically assigned from set of allowed encoding for MIME.}
+function InlineCode(const Value: string): string;
+
+{:Converts e-mail address to canonical mime form. You can specify source charset.}
+function InlineEmailEx(const Value: string; FromCP: TMimeChar): string;
+
+{:Converts e-mail address to canonical mime form. Source charser it system
+ default charset.}
+function InlineEmail(const Value: string): string;
+
+implementation
+
+{==============================================================================}
+
+function InlineDecode(const Value: string; CP: TMimeChar): string;
+var
+  s, su, v: string;
+  x, y, z, n: Integer;
+  ichar: TMimeChar;
+  c: Char;
+
+  function SearchEndInline(const Value: string; be: Integer): Integer;
+  var
+    n, q: Integer;
+  begin
+    q := 0;
+    Result := 0;
+    for n := be + 2 to Length(Value) - 1 do
+      if Value[n] = '?' then
+      begin
+        Inc(q);
+        if (q > 2) and (Value[n + 1] = '=') then
+        begin
+          Result := n;
+          Break;
+        end;
+      end;
+  end;
+
+begin
+  Result := '';
+  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);
+    if Trim(s) <> '' then
+      Result := Result + s;
+    s := Copy(v, x, y - x + 2);
+    Delete(v, 1, y + 1);
+    su := Copy(s, 3, Length(s) - 4);
+    z := Pos('?', su);
+    if (Length(su) >= (z + 2)) and (su[z + 2] = '?') then
+    begin
+      ichar := GetCPFromID(SeparateLeft(Copy(su, 1, z - 1), '*'));
+      c := UpperCase(su)[z + 1];
+      su := Copy(su, z + 3, Length(su) - z - 2);
+      if c = 'B' then
+      begin
+        s := DecodeBase64(su);
+        s := CharsetConversion(s, ichar, CP);
+      end;
+      if c = 'Q' then
+      begin
+        s := '';
+        for n := 1 to Length(su) do
+          if su[n] = '_' then
+            s := s + ' '
+          else
+            s := s + su[n];
+        s := DecodeQuotedPrintable(s);
+        s := CharsetConversion(s, ichar, CP);
+      end;
+    end;
+    Result := Result + s;
+    x := Pos('=?', v);
+    y := SearchEndInline(v, x);
+  end;
+  Result := Result + v;
+end;
+
+{==============================================================================}
+
+function InlineEncode(const Value: string; CP, MimeP: TMimeChar): string;
+var
+  s, s1, e: string;
+  n: Integer;
+begin
+  s := CharsetConversion(Value, CP, MimeP);
+  s := EncodeSafeQuotedPrintable(s);
+  e := GetIdFromCP(MimeP);
+  s1 := '';
+  Result := '';
+  for n := 1 to Length(s) do
+    if s[n] = ' ' then
+    begin
+//      s1 := s1 + '=20';
+      s1 := s1 + '_';
+      if Length(s1) > 32 then
+      begin
+        if Result <> '' then
+          Result := Result + ' ';
+        Result := Result + '=?' + e + '?Q?' + s1 + '?=';
+        s1 := '';
+      end;
+    end
+    else
+      s1 := s1 + s[n];
+  if s1 <> '' then
+  begin
+    if Result <> '' then
+      Result := Result + ' ';
+    Result := Result + '=?' + e + '?Q?' + s1 + '?=';
+  end;
+end;
+
+{==============================================================================}
+
+function NeedInline(const Value: AnsiString): boolean;
+var
+  n: Integer;
+begin
+  Result := False;
+  for n := 1 to Length(Value) do
+    if Value[n] in (SpecialChar + NonAsciiChar - ['_']) then
+    begin
+      Result := True;
+      Break;
+    end;
+end;
+
+{==============================================================================}
+
+function InlineCodeEx(const Value: string; FromCP: TMimeChar): string;
+var
+  c: TMimeChar;
+begin
+  if NeedInline(Value) then
+  begin
+    c := IdealCharsetCoding(Value, FromCP, IdealCharsets);
+    Result := InlineEncode(Value, FromCP, c);
+  end
+  else
+    Result := Value;
+end;
+
+{==============================================================================}
+
+function InlineCode(const Value: string): string;
+begin
+  Result := InlineCodeEx(Value, GetCurCP);
+end;
+
+{==============================================================================}
+
+function InlineEmailEx(const Value: string; FromCP: TMimeChar): string;
+var
+  sd, se: string;
+begin
+  sd := GetEmailDesc(Value);
+  se := GetEmailAddr(Value);
+  if sd = '' then
+    Result := se
+  else
+    Result := '"' + InlineCodeEx(sd, FromCP) + '" <' + se + '>';
+end;
+
+{==============================================================================}
+
+function InlineEmail(const Value: string): string;
+begin
+  Result := InlineEmailEx(Value, GetCurCP);
+end;
+
+end.
diff --git a/Units/Synapse/mimemess.pas b/Units/Synapse/mimemess.pas
index 261c942..c143ff4 100644
--- a/Units/Synapse/mimemess.pas
+++ b/Units/Synapse/mimemess.pas
@@ -1,824 +1,824 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 002.005.002 |
-|==============================================================================|
-| Content: MIME message object                                                 |
-|==============================================================================|
-| Copyright (c)1999-2006, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2000-2006.                |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM From distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{:@abstract(MIME message handling)
-Classes for easy handling with e-mail message.
-}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$H+}
-
-unit mimemess;
-
-interface
-
-uses
-  Classes, SysUtils,
-  mimepart, synachar, synautil, mimeinln;
-
-type
-
-  {:Possible values for message priority}
-  TMessPriority = (MP_unknown, MP_low, MP_normal, MP_high);
-
-  {:@abstract(Object for basic e-mail header fields.)}
-  TMessHeader = class(TObject)
-  private
-    FFrom: string;
-    FToList: TStringList;
-    FCCList: TStringList;
-    FSubject: string;
-    FOrganization: string;
-    FCustomHeaders: TStringList;
-    FDate: TDateTime;
-    FXMailer: string;
-    FCharsetCode: TMimeChar;
-    FReplyTo: string;
-    FMessageID: string;
-    FPriority: TMessPriority;
-    Fpri: TMessPriority;
-    Fxpri: TMessPriority;
-    Fxmspri: TMessPriority;
-  protected
-    function ParsePriority(value: string): TMessPriority;
-    function DecodeHeader(value: string): boolean; virtual;
-  public
-    constructor Create; virtual;
-    destructor Destroy; override;
-
-    {:Clears all data fields.}
-    procedure Clear; virtual;
-
-    {Add headers from from this object to Value.}
-    procedure EncodeHeaders(const Value: TStrings); virtual;
-
-    {:Parse header from Value to this object.}
-    procedure DecodeHeaders(const Value: TStrings);
-
-    {:Try find specific header in CustomHeader. Search is case insensitive.
-     This is good for reading any non-parsed header.}
-    function FindHeader(Value: string): string;
-
-    {:Try find specific headers in CustomHeader. This metod is for repeatly used
-     headers like 'received' header, etc. Search is case insensitive.
-     This is good for reading ano non-parsed header.}
-    procedure FindHeaderList(Value: string; const HeaderList: TStrings);
-  published
-    {:Sender of message.}
-    property From: string read FFrom Write FFrom;
-
-    {:Stringlist with receivers of message. (one per line)}
-    property ToList: TStringList read FToList;
-
-    {:Stringlist with Carbon Copy receivers of message. (one per line)}
-    property CCList: TStringList read FCCList;
-
-    {:Subject of message.}
-    property Subject: string read FSubject Write FSubject;
-
-    {:Organization string.}
-    property Organization: string read FOrganization Write FOrganization;
-
-    {:After decoding contains all headers lines witch not have parsed to any
-     other structures in this object. It mean: this conatins all other headers
-     except:
-
-     X-MAILER, FROM, SUBJECT, ORGANIZATION, TO, CC, DATE, MIME-VERSION,
-     CONTENT-TYPE, CONTENT-DESCRIPTION, CONTENT-DISPOSITION, CONTENT-ID,
-     CONTENT-TRANSFER-ENCODING, REPLY-TO, MESSAGE-ID, X-MSMAIL-PRIORITY,
-     X-PRIORITY, PRIORITY
-
-     When you encode headers, all this lines is added as headers. Be carefull
-     for duplicites!}
-    property CustomHeaders: TStringList read FCustomHeaders;
-
-    {:Date and time of message.}
-    property Date: TDateTime read FDate Write FDate;
-
-    {:Mailer identification.}
-    property XMailer: string read FXMailer Write FXMailer;
-
-    {:Address for replies}
-    property ReplyTo: string read FReplyTo Write FReplyTo;
-
-    {:message indetifier}
-    property MessageID: string read FMessageID Write FMessageID;
-
-    {:message priority}
-    property Priority: TMessPriority read FPriority Write FPriority;
-
-    {:Specify base charset. By default is used system charset.}
-    property CharsetCode: TMimeChar read FCharsetCode Write FCharsetCode;
-  end;
-
-  TMessHeaderClass = class of TMessHeader;
-
-  {:@abstract(Object for handling of e-mail message.)}
-  TMimeMess = class(TObject)
-  private
-    FMessagePart: TMimePart;
-    FLines: TStringList;
-    FHeader: TMessHeader;
-  public
-    constructor Create;
-    {:create this object and assign your own descendant of @link(TMessHeader)
-     object to @link(header) property. So, you can create your own message
-     headers parser and use it by this object.}
-    constructor CreateAltHeaders(HeadClass: TMessHeaderClass);
-    destructor Destroy; override;
-
-    {:Reset component to default state.}
-    procedure Clear; virtual;
-
-    {:Add MIME part as subpart of PartParent. If you need set root MIME part,
-     then set as PartParent @NIL value. If you need set more then one subpart,
-     you must have PartParent of multipart type!}
-    function AddPart(const PartParent: TMimePart): TMimePart;
-
-    {:Add MIME part as subpart of PartParent. If you need set root MIME part,
-     then set as PartParent @NIL value. If you need set more then 1 subpart, you
-     must have PartParent of multipart type!
-
-     This part is marked as multipart with secondary MIME type specified by
-     MultipartType parameter. (typical value is 'mixed')
-
-     This part can be used as PartParent for another parts (include next
-     multipart). If you need only one part, then you not need Multipart part.}
-    function AddPartMultipart(const MultipartType: String; const PartParent: TMimePart): TMimePart;
-
-    {:Add MIME part as subpart of PartParent. If you need set root MIME part,
-     then set as PartParent @NIL value. If you need set more then 1 subpart, you
-     must have PartParent of multipart type!
-
-     After creation of part set type to text part and set all necessary
-     properties. Content of part is readed from value stringlist.}
-    function AddPartText(const Value: TStrings; const PartParent: TMimePart): TMimepart;
-
-    {:Add MIME part as subpart of PartParent. If you need set root MIME part,
-     then set as PartParent @NIL value. If you need set more then 1 subpart, you
-     must have PartParent of multipart type!
-
-     After creation of part set type to text part and set all necessary
-     properties. Content of part is readed from value stringlist. You can select
-     your charset and your encoding type. If Raw is @true, then it not doing
-     charset conversion!}
-    function AddPartTextEx(const Value: TStrings; const PartParent: TMimePart;
-      PartCharset: TMimeChar; Raw: Boolean; PartEncoding: TMimeEncoding): TMimepart;
-
-    {:Add MIME part as subpart of PartParent. If you need set root MIME part,
-     then set as PartParent @NIL value. If you need set more then 1 subpart, you
-     must have PartParent of multipart type!
-
-     After creation of part set type to text part to HTML type and set all
-     necessary properties. Content of HTML part is readed from Value stringlist.}
-    function AddPartHTML(const Value: TStrings; const PartParent: TMimePart): TMimepart;
-
-    {:Same as @link(AddPartText), but content is readed from file}
-    function AddPartTextFromFile(const FileName: String; const PartParent: TMimePart): TMimepart;
-
-    {:Same as @link(AddPartHTML), but content is readed from file}
-    function AddPartHTMLFromFile(const FileName: String; const PartParent: TMimePart): TMimepart;
-
-    {:Add MIME part as subpart of PartParent. If you need set root MIME part,
-     then set as PartParent @NIL value. If you need set more then 1 subpart,
-     you must have PartParent of multipart type!
-
-     After creation of part set type to binary and set all necessary properties.
-     MIME primary and secondary types defined automaticly by filename extension.
-     Content of binary part is readed from Stream. This binary part is encoded
-     as file attachment.}
-    function AddPartBinary(const Stream: TStream; const FileName: string; const PartParent: TMimePart): TMimepart;
-
-    {:Same as @link(AddPartBinary), but content is readed from file}
-    function AddPartBinaryFromFile(const FileName: string; const PartParent: TMimePart): TMimepart;
-
-    {:Add MIME part as subpart of PartParent. If you need set root MIME part,
-     then set as PartParent @NIL value. If you need set more then 1 subpart, you
-     must have PartParent of multipart type!
-
-     After creation of part set type to binary and set all necessary properties.
-     MIME primary and secondary types defined automaticly by filename extension.
-     Content of binary part is readed from Stream.
-
-     This binary part is encoded as inline data with given Conten ID (cid).
-     Content ID can be used as reference ID in HTML source in HTML part.}
-    function AddPartHTMLBinary(const Stream: TStream; const FileName, Cid: string; const PartParent: TMimePart): TMimepart;
-
-    {:Same as @link(AddPartHTMLBinary), but content is readed from file}
-    function AddPartHTMLBinaryFromFile(const FileName, Cid: string; const PartParent: TMimePart): TMimepart;
-
-    {:Add MIME part as subpart of PartParent. If you need set root MIME part,
-     then set as PartParent @NIL value. If you need set more then 1 subpart, you
-     must have PartParent of multipart type!
-
-     After creation of part set type to message and set all necessary properties.
-     MIME primary and secondary types are setted to 'message/rfc822'.
-     Content of raw RFC-822 message is readed from Stream.}
-    function AddPartMess(const Value: TStrings; const PartParent: TMimePart): TMimepart;
-
-    {:Same as @link(AddPartMess), but content is readed from file}
-    function AddPartMessFromFile(const FileName: string; const PartParent: TMimePart): TMimepart;
-
-    {:Compose message from @link(MessagePart) to @link(Lines). Headers from
-     @link(Header) object is added also.}
-    procedure EncodeMessage;
-
-    {:Decode message from @link(Lines) to @link(MessagePart). Massage headers
-     are parsed into @link(Header) object.}
-    procedure DecodeMessage;
-  published
-    {:@link(TMimePart) object with decoded MIME message. This object can handle
-     any number of nested @link(TMimePart) objects itself. It is used for handle
-     any tree of MIME subparts.}
-    property MessagePart: TMimePart read FMessagePart;
-
-    {:Raw MIME encoded message.}
-    property Lines: TStringList read FLines;
-
-    {:Object for e-mail header fields. This object is created automaticly.
-     Do not free this object!}
-    property Header: TMessHeader read FHeader;
-  end;
-
-implementation
-
-{==============================================================================}
-
-constructor TMessHeader.Create;
-begin
-  inherited Create;
-  FToList := TStringList.Create;
-  FCCList := TStringList.Create;
-  FCustomHeaders := TStringList.Create;
-  FCharsetCode := GetCurCP;
-end;
-
-destructor TMessHeader.Destroy;
-begin
-  FCustomHeaders.Free;
-  FCCList.Free;
-  FToList.Free;
-  inherited Destroy;
-end;
-
-{==============================================================================}
-
-procedure TMessHeader.Clear;
-begin
-  FFrom := '';
-  FToList.Clear;
-  FCCList.Clear;
-  FSubject := '';
-  FOrganization := '';
-  FCustomHeaders.Clear;
-  FDate := 0;
-  FXMailer := '';
-  FReplyTo := '';
-  FMessageID := '';
-  FPriority := MP_unknown;
-end;
-
-procedure TMessHeader.EncodeHeaders(const Value: TStrings);
-var
-  n: Integer;
-  s: string;
-begin
-  if FDate = 0 then
-    FDate := Now;
-  for n := FCustomHeaders.Count - 1 downto 0 do
-    if FCustomHeaders[n] <> '' then
-      Value.Insert(0, FCustomHeaders[n]);
-  if FPriority <> MP_unknown then
-    case FPriority of
-      MP_high:
-        begin
-          Value.Insert(0, 'X-MSMAIL-Priority: High');
-          Value.Insert(0, 'X-Priority: 1');
-          Value.Insert(0, 'Priority: urgent');
-        end;
-      MP_low:
-        begin
-          Value.Insert(0, 'X-MSMAIL-Priority: low');
-          Value.Insert(0, 'X-Priority: 5');
-          Value.Insert(0, 'Priority: non-urgent');
-        end;
-    end;
-  if FReplyTo <> '' then
-    Value.Insert(0, 'Reply-To: ' + GetEmailAddr(FReplyTo));
-  if FMessageID <> '' then
-    Value.Insert(0, 'Message-ID: <' + trim(FMessageID) + '>');
-  if FXMailer = '' then
-    Value.Insert(0, 'X-mailer: Synapse - Pascal TCP/IP library by Lukas Gebauer')
-  else
-    Value.Insert(0, 'X-mailer: ' + FXMailer);
-  Value.Insert(0, 'MIME-Version: 1.0 (produced by Synapse)');
-  if FOrganization <> '' then
-    Value.Insert(0, 'Organization: ' + InlineCodeEx(FOrganization, FCharsetCode));
-  s := '';
-  for n := 0 to FCCList.Count - 1 do
-    if s = '' then
-      s := InlineEmailEx(FCCList[n], FCharsetCode)
-    else
-      s := s + ', ' + InlineEmailEx(FCCList[n], FCharsetCode);
-  if s <> '' then
-    Value.Insert(0, 'CC: ' + s);
-  Value.Insert(0, 'Date: ' + Rfc822DateTime(FDate));
-  if FSubject <> '' then
-    Value.Insert(0, 'Subject: ' + InlineCodeEx(FSubject, FCharsetCode));
-  s := '';
-  for n := 0 to FToList.Count - 1 do
-    if s = '' then
-      s := InlineEmailEx(FToList[n], FCharsetCode)
-    else
-      s := s + ', ' + InlineEmailEx(FToList[n], FCharsetCode);
-  if s <> '' then
-    Value.Insert(0, 'To: ' + s);
-  Value.Insert(0, 'From: ' + InlineEmailEx(FFrom, FCharsetCode));
-end;
-
-function TMessHeader.ParsePriority(value: string): TMessPriority;
-var
-  s: string;
-  x: integer;
-begin
-  Result := MP_unknown;
-  s := Trim(separateright(value, ':'));
-  s := Separateleft(s, ' ');
-  x := StrToIntDef(s, -1);
-  if x >= 0 then
-    case x of
-      1, 2:
-        Result := MP_High;
-      3:
-        Result := MP_Normal;
-      4, 5:
-        Result := MP_Low;
-    end
-  else
-  begin
-    s := lowercase(s);
-    if (s = 'urgent') or (s = 'high') or (s = 'highest') then
-      Result := MP_High;
-    if (s = 'normal') or (s = 'medium') then
-      Result := MP_Normal;
-    if (s = 'low') or (s = 'lowest')
-      or (s = 'no-priority')  or (s = 'non-urgent') then
-      Result := MP_Low;
-  end;
-end;
-
-function TMessHeader.DecodeHeader(value: string): boolean;
-var
-  s, t: string;
-  cp: TMimeChar;
-begin
-  Result := True;
-  cp := FCharsetCode;
-  s := uppercase(value);
-  if Pos('X-MAILER:', s) = 1 then
-  begin
-    FXMailer := Trim(SeparateRight(Value, ':'));
-    Exit;
-  end;
-  if Pos('FROM:', s) = 1 then
-  begin
-    FFrom := InlineDecode(Trim(SeparateRight(Value, ':')), cp);
-    Exit;
-  end;
-  if Pos('SUBJECT:', s) = 1 then
-  begin
-    FSubject := InlineDecode(Trim(SeparateRight(Value, ':')), cp);
-    Exit;
-  end;
-  if Pos('ORGANIZATION:', s) = 1 then
-  begin
-    FOrganization := InlineDecode(Trim(SeparateRight(Value, ':')), cp);
-    Exit;
-  end;
-  if Pos('TO:', s) = 1 then
-  begin
-    s := Trim(SeparateRight(Value, ':'));
-    repeat
-      t := InlineDecode(Trim(FetchEx(s, ',', '"')), cp);
-      if t <> '' then
-        FToList.Add(t);
-    until s = '';
-    Exit;
-  end;
-  if Pos('CC:', s) = 1 then
-  begin
-    s := Trim(SeparateRight(Value, ':'));
-    repeat
-      t := InlineDecode(Trim(FetchEx(s, ',', '"')), cp);
-      if t <> '' then
-        FCCList.Add(t);
-    until s = '';
-    Exit;
-  end;
-  if Pos('DATE:', s) = 1 then
-  begin
-    FDate := DecodeRfcDateTime(Trim(SeparateRight(Value, ':')));
-    Exit;
-  end;
-  if Pos('REPLY-TO:', s) = 1 then
-  begin
-    FReplyTo := InlineDecode(Trim(SeparateRight(Value, ':')), cp);
-    Exit;
-  end;
-  if Pos('MESSAGE-ID:', s) = 1 then
-  begin
-    FMessageID := GetEmailAddr(Trim(SeparateRight(Value, ':')));
-    Exit;
-  end;
-  if Pos('PRIORITY:', s) = 1 then
-  begin
-    FPri := ParsePriority(value);
-    Exit;
-  end;
-  if Pos('X-PRIORITY:', s) = 1 then
-  begin
-    FXPri := ParsePriority(value);
-    Exit;
-  end;
-  if Pos('X-MSMAIL-PRIORITY:', s) = 1 then
-  begin
-    FXmsPri := ParsePriority(value);
-    Exit;
-  end;
-  if Pos('MIME-VERSION:', s) = 1 then
-    Exit;
-  if Pos('CONTENT-TYPE:', s) = 1 then
-    Exit;
-  if Pos('CONTENT-DESCRIPTION:', s) = 1 then
-    Exit;
-  if Pos('CONTENT-DISPOSITION:', s) = 1 then
-    Exit;
-  if Pos('CONTENT-ID:', s) = 1 then
-    Exit;
-  if Pos('CONTENT-TRANSFER-ENCODING:', s) = 1 then
-    Exit;
-  Result := False;
-end;
-
-procedure TMessHeader.DecodeHeaders(const Value: TStrings);
-var
-  s: string;
-  x: Integer;
-begin
-  Clear;
-  Fpri := MP_unknown;
-  Fxpri := MP_unknown;
-  Fxmspri := MP_unknown;
-  x := 0;
-  while Value.Count > x do
-  begin
-    s := NormalizeHeader(Value, x);
-    if s = '' then
-      Break;
-    if not DecodeHeader(s) then
-      FCustomHeaders.Add(s);
-  end;
-  if Fpri <> MP_unknown then
-    FPriority := Fpri
-  else
-    if Fxpri <> MP_unknown then
-      FPriority := Fxpri
-    else
-      if Fxmspri <> MP_unknown then
-        FPriority := Fxmspri
-end;
-
-function TMessHeader.FindHeader(Value: string): string;
-var
-  n: integer;
-begin
-  Result := '';
-  for n := 0 to FCustomHeaders.Count - 1 do
-    if Pos(UpperCase(Value), UpperCase(FCustomHeaders[n])) = 1 then
-    begin
-      Result := Trim(SeparateRight(FCustomHeaders[n], ':'));
-      break;
-    end;
-end;
-
-procedure TMessHeader.FindHeaderList(Value: string; const HeaderList: TStrings);
-var
-  n: integer;
-begin
-  HeaderList.Clear;
-  for n := 0 to FCustomHeaders.Count - 1 do
-    if Pos(UpperCase(Value), UpperCase(FCustomHeaders[n])) = 1 then
-    begin
-      HeaderList.Add(Trim(SeparateRight(FCustomHeaders[n], ':')));
-    end;
-end;
-
-{==============================================================================}
-
-constructor TMimeMess.Create;
-begin
-  CreateAltHeaders(TMessHeader);
-end;
-
-constructor TMimeMess.CreateAltHeaders(HeadClass: TMessHeaderClass);
-begin
-  inherited Create;
-  FMessagePart := TMimePart.Create;
-  FLines := TStringList.Create;
-  FHeader := HeadClass.Create;
-end;
-
-destructor TMimeMess.Destroy;
-begin
-  FMessagePart.Free;
-  FHeader.Free;
-  FLines.Free;
-  inherited Destroy;
-end;
-
-{==============================================================================}
-
-procedure TMimeMess.Clear;
-begin
-  FMessagePart.Clear;
-  FLines.Clear;
-  FHeader.Clear;
-end;
-
-{==============================================================================}
-
-function TMimeMess.AddPart(const PartParent: TMimePart): TMimePart;
-begin
-  if PartParent = nil then
-    Result := FMessagePart
-  else
-    Result := PartParent.AddSubPart;
-  Result.Clear;
-end;
-
-{==============================================================================}
-
-function TMimeMess.AddPartMultipart(const MultipartType: String; const PartParent: TMimePart): TMimePart;
-begin
-  Result := AddPart(PartParent);
-  with Result do
-  begin
-    Primary := 'Multipart';
-    Secondary := MultipartType;
-    Description := 'Multipart message';
-    Boundary := GenerateBoundary;
-    EncodePartHeader;
-  end;
-end;
-
-function TMimeMess.AddPartText(const Value: TStrings; const PartParent: TMimePart): TMimepart;
-begin
-  Result := AddPart(PartParent);
-  with Result do
-  begin
-    Value.SaveToStream(DecodedLines);
-    Primary := 'text';
-    Secondary := 'plain';
-    Description := 'Message text';
-    Disposition := 'inline';
-    CharsetCode := IdealCharsetCoding(Value.Text, TargetCharset, IdealCharsets);
-    EncodingCode := ME_QUOTED_PRINTABLE;
-    EncodePart;
-    EncodePartHeader;
-  end;
-end;
-
-function TMimeMess.AddPartTextEx(const Value: TStrings; const PartParent: TMimePart;
-  PartCharset: TMimeChar; Raw: Boolean; PartEncoding: TMimeEncoding): TMimepart;
-begin
-  Result := AddPart(PartParent);
-  with Result do
-  begin
-    Value.SaveToStream(DecodedLines);
-    Primary := 'text';
-    Secondary := 'plain';
-    Description := 'Message text';
-    Disposition := 'inline';
-    CharsetCode := PartCharset;
-    EncodingCode := PartEncoding;
-    ConvertCharset := not Raw;
-    EncodePart;
-    EncodePartHeader;
-  end;
-end;
-
-function TMimeMess.AddPartHTML(const Value: TStrings; const PartParent: TMimePart): TMimepart;
-begin
-  Result := AddPart(PartParent);
-  with Result do
-  begin
-    Value.SaveToStream(DecodedLines);
-    Primary := 'text';
-    Secondary := 'html';
-    Description := 'HTML text';
-    Disposition := 'inline';
-    CharsetCode := UTF_8;
-    EncodingCode := ME_QUOTED_PRINTABLE;
-    EncodePart;
-    EncodePartHeader;
-  end;
-end;
-
-function TMimeMess.AddPartTextFromFile(const FileName: String; const PartParent: TMimePart): TMimepart;
-var
-  tmp: TStrings;
-begin
-  tmp := TStringList.Create;
-  try
-    tmp.LoadFromFile(FileName);
-    Result := AddPartText(tmp, PartParent);
-  Finally
-    tmp.Free;
-  end;
-end;
-
-function TMimeMess.AddPartHTMLFromFile(const FileName: String; const PartParent: TMimePart): TMimepart;
-var
-  tmp: TStrings;
-begin
-  tmp := TStringList.Create;
-  try
-    tmp.LoadFromFile(FileName);
-    Result := AddPartHTML(tmp, PartParent);
-  Finally
-    tmp.Free;
-  end;
-end;
-
-function TMimeMess.AddPartBinary(const Stream: TStream; const FileName: string; const PartParent: TMimePart): TMimepart;
-begin
-  Result := AddPart(PartParent);
-  Result.DecodedLines.LoadFromStream(Stream);
-  Result.MimeTypeFromExt(FileName);
-  Result.Description := 'Attached file: ' + FileName;
-  Result.Disposition := 'attachment';
-  Result.FileName := FileName;
-  Result.EncodingCode := ME_BASE64;
-  Result.EncodePart;
-  Result.EncodePartHeader;
-end;
-
-function TMimeMess.AddPartBinaryFromFile(const FileName: string; const PartParent: TMimePart): TMimepart;
-var
-  tmp: TMemoryStream;
-begin
-  tmp := TMemoryStream.Create;
-  try
-    tmp.LoadFromFile(FileName);
-    Result := AddPartBinary(tmp, ExtractFileName(FileName), PartParent);
-  finally
-    tmp.Free;
-  end;
-end;
-
-function TMimeMess.AddPartHTMLBinary(const Stream: TStream; const FileName, Cid: string; const PartParent: TMimePart): TMimepart;
-begin
-  Result := AddPart(PartParent);
-  Result.DecodedLines.LoadFromStream(Stream);
-  Result.MimeTypeFromExt(FileName);
-  Result.Description := 'Included file: ' + FileName;
-  Result.Disposition := 'inline';
-  Result.ContentID := Cid;
-  Result.FileName := FileName;
-  Result.EncodingCode := ME_BASE64;
-  Result.EncodePart;
-  Result.EncodePartHeader;
-end;
-
-function TMimeMess.AddPartHTMLBinaryFromFile(const FileName, Cid: string; const PartParent: TMimePart): TMimepart;
-var
-  tmp: TMemoryStream;
-begin
-  tmp := TMemoryStream.Create;
-  try
-    tmp.LoadFromFile(FileName);
-    Result :=AddPartHTMLBinary(tmp, ExtractFileName(FileName), Cid, PartParent);
-  finally
-    tmp.Free;
-  end;
-end;
-
-function TMimeMess.AddPartMess(const Value: TStrings; const PartParent: TMimePart): TMimepart;
-var
-  part: Tmimepart;
-begin
-  Result := AddPart(PartParent);
-  part := AddPart(result);
-  part.lines.addstrings(Value);
-  part.DecomposeParts;
-  with Result do
-  begin
-    Primary := 'message';
-    Secondary := 'rfc822';
-    Description := 'E-mail Message';
-    EncodePart;
-    EncodePartHeader;
-  end;
-end;
-
-function TMimeMess.AddPartMessFromFile(const FileName: String; const PartParent: TMimePart): TMimepart;
-var
-  tmp: TStrings;
-begin
-  tmp := TStringList.Create;
-  try
-    tmp.LoadFromFile(FileName);
-    Result := AddPartMess(tmp, PartParent);
-  Finally
-    tmp.Free;
-  end;
-end;
-
-{==============================================================================}
-
-procedure TMimeMess.EncodeMessage;
-var
-  l: TStringList;
-  x: integer;
-begin
-  //merge headers from THeaders and header field from MessagePart
-  l := TStringList.Create;
-  try
-    FHeader.EncodeHeaders(l);
-    x := IndexByBegin('CONTENT-TYPE', FMessagePart.Headers);
-    if x >= 0 then
-      l.add(FMessagePart.Headers[x]);
-    x := IndexByBegin('CONTENT-DESCRIPTION', FMessagePart.Headers);
-    if x >= 0 then
-      l.add(FMessagePart.Headers[x]);
-    x := IndexByBegin('CONTENT-DISPOSITION', FMessagePart.Headers);
-    if x >= 0 then
-      l.add(FMessagePart.Headers[x]);
-    x := IndexByBegin('CONTENT-ID', FMessagePart.Headers);
-    if x >= 0 then
-      l.add(FMessagePart.Headers[x]);
-    x := IndexByBegin('CONTENT-TRANSFER-ENCODING', FMessagePart.Headers);
-    if x >= 0 then
-      l.add(FMessagePart.Headers[x]);
-    FMessagePart.Headers.Assign(l);
-  finally
-    l.Free;
-  end;
-  FMessagePart.ComposeParts;
-  FLines.Assign(FMessagePart.Lines);
-end;
-
-{==============================================================================}
-
-procedure TMimeMess.DecodeMessage;
-begin
-  FHeader.Clear;
-  FHeader.DecodeHeaders(FLines);
-  FMessagePart.Lines.Assign(FLines);
-  FMessagePart.DecomposeParts;
-end;
-
-end.
+{==============================================================================|
+| Project : Ararat Synapse                                       | 002.005.002 |
+|==============================================================================|
+| Content: MIME message object                                                 |
+|==============================================================================|
+| Copyright (c)1999-2006, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2000-2006.                |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM From distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@abstract(MIME message handling)
+Classes for easy handling with e-mail message.
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+unit mimemess;
+
+interface
+
+uses
+  Classes, SysUtils,
+  mimepart, synachar, synautil, mimeinln;
+
+type
+
+  {:Possible values for message priority}
+  TMessPriority = (MP_unknown, MP_low, MP_normal, MP_high);
+
+  {:@abstract(Object for basic e-mail header fields.)}
+  TMessHeader = class(TObject)
+  private
+    FFrom: string;
+    FToList: TStringList;
+    FCCList: TStringList;
+    FSubject: string;
+    FOrganization: string;
+    FCustomHeaders: TStringList;
+    FDate: TDateTime;
+    FXMailer: string;
+    FCharsetCode: TMimeChar;
+    FReplyTo: string;
+    FMessageID: string;
+    FPriority: TMessPriority;
+    Fpri: TMessPriority;
+    Fxpri: TMessPriority;
+    Fxmspri: TMessPriority;
+  protected
+    function ParsePriority(value: string): TMessPriority;
+    function DecodeHeader(value: string): boolean; virtual;
+  public
+    constructor Create; virtual;
+    destructor Destroy; override;
+
+    {:Clears all data fields.}
+    procedure Clear; virtual;
+
+    {Add headers from from this object to Value.}
+    procedure EncodeHeaders(const Value: TStrings); virtual;
+
+    {:Parse header from Value to this object.}
+    procedure DecodeHeaders(const Value: TStrings);
+
+    {:Try find specific header in CustomHeader. Search is case insensitive.
+     This is good for reading any non-parsed header.}
+    function FindHeader(Value: string): string;
+
+    {:Try find specific headers in CustomHeader. This metod is for repeatly used
+     headers like 'received' header, etc. Search is case insensitive.
+     This is good for reading ano non-parsed header.}
+    procedure FindHeaderList(Value: string; const HeaderList: TStrings);
+  published
+    {:Sender of message.}
+    property From: string read FFrom Write FFrom;
+
+    {:Stringlist with receivers of message. (one per line)}
+    property ToList: TStringList read FToList;
+
+    {:Stringlist with Carbon Copy receivers of message. (one per line)}
+    property CCList: TStringList read FCCList;
+
+    {:Subject of message.}
+    property Subject: string read FSubject Write FSubject;
+
+    {:Organization string.}
+    property Organization: string read FOrganization Write FOrganization;
+
+    {:After decoding contains all headers lines witch not have parsed to any
+     other structures in this object. It mean: this conatins all other headers
+     except:
+
+     X-MAILER, FROM, SUBJECT, ORGANIZATION, TO, CC, DATE, MIME-VERSION,
+     CONTENT-TYPE, CONTENT-DESCRIPTION, CONTENT-DISPOSITION, CONTENT-ID,
+     CONTENT-TRANSFER-ENCODING, REPLY-TO, MESSAGE-ID, X-MSMAIL-PRIORITY,
+     X-PRIORITY, PRIORITY
+
+     When you encode headers, all this lines is added as headers. Be carefull
+     for duplicites!}
+    property CustomHeaders: TStringList read FCustomHeaders;
+
+    {:Date and time of message.}
+    property Date: TDateTime read FDate Write FDate;
+
+    {:Mailer identification.}
+    property XMailer: string read FXMailer Write FXMailer;
+
+    {:Address for replies}
+    property ReplyTo: string read FReplyTo Write FReplyTo;
+
+    {:message indetifier}
+    property MessageID: string read FMessageID Write FMessageID;
+
+    {:message priority}
+    property Priority: TMessPriority read FPriority Write FPriority;
+
+    {:Specify base charset. By default is used system charset.}
+    property CharsetCode: TMimeChar read FCharsetCode Write FCharsetCode;
+  end;
+
+  TMessHeaderClass = class of TMessHeader;
+
+  {:@abstract(Object for handling of e-mail message.)}
+  TMimeMess = class(TObject)
+  private
+    FMessagePart: TMimePart;
+    FLines: TStringList;
+    FHeader: TMessHeader;
+  public
+    constructor Create;
+    {:create this object and assign your own descendant of @link(TMessHeader)
+     object to @link(header) property. So, you can create your own message
+     headers parser and use it by this object.}
+    constructor CreateAltHeaders(HeadClass: TMessHeaderClass);
+    destructor Destroy; override;
+
+    {:Reset component to default state.}
+    procedure Clear; virtual;
+
+    {:Add MIME part as subpart of PartParent. If you need set root MIME part,
+     then set as PartParent @NIL value. If you need set more then one subpart,
+     you must have PartParent of multipart type!}
+    function AddPart(const PartParent: TMimePart): TMimePart;
+
+    {:Add MIME part as subpart of PartParent. If you need set root MIME part,
+     then set as PartParent @NIL value. If you need set more then 1 subpart, you
+     must have PartParent of multipart type!
+
+     This part is marked as multipart with secondary MIME type specified by
+     MultipartType parameter. (typical value is 'mixed')
+
+     This part can be used as PartParent for another parts (include next
+     multipart). If you need only one part, then you not need Multipart part.}
+    function AddPartMultipart(const MultipartType: String; const PartParent: TMimePart): TMimePart;
+
+    {:Add MIME part as subpart of PartParent. If you need set root MIME part,
+     then set as PartParent @NIL value. If you need set more then 1 subpart, you
+     must have PartParent of multipart type!
+
+     After creation of part set type to text part and set all necessary
+     properties. Content of part is readed from value stringlist.}
+    function AddPartText(const Value: TStrings; const PartParent: TMimePart): TMimepart;
+
+    {:Add MIME part as subpart of PartParent. If you need set root MIME part,
+     then set as PartParent @NIL value. If you need set more then 1 subpart, you
+     must have PartParent of multipart type!
+
+     After creation of part set type to text part and set all necessary
+     properties. Content of part is readed from value stringlist. You can select
+     your charset and your encoding type. If Raw is @true, then it not doing
+     charset conversion!}
+    function AddPartTextEx(const Value: TStrings; const PartParent: TMimePart;
+      PartCharset: TMimeChar; Raw: Boolean; PartEncoding: TMimeEncoding): TMimepart;
+
+    {:Add MIME part as subpart of PartParent. If you need set root MIME part,
+     then set as PartParent @NIL value. If you need set more then 1 subpart, you
+     must have PartParent of multipart type!
+
+     After creation of part set type to text part to HTML type and set all
+     necessary properties. Content of HTML part is readed from Value stringlist.}
+    function AddPartHTML(const Value: TStrings; const PartParent: TMimePart): TMimepart;
+
+    {:Same as @link(AddPartText), but content is readed from file}
+    function AddPartTextFromFile(const FileName: String; const PartParent: TMimePart): TMimepart;
+
+    {:Same as @link(AddPartHTML), but content is readed from file}
+    function AddPartHTMLFromFile(const FileName: String; const PartParent: TMimePart): TMimepart;
+
+    {:Add MIME part as subpart of PartParent. If you need set root MIME part,
+     then set as PartParent @NIL value. If you need set more then 1 subpart,
+     you must have PartParent of multipart type!
+
+     After creation of part set type to binary and set all necessary properties.
+     MIME primary and secondary types defined automaticly by filename extension.
+     Content of binary part is readed from Stream. This binary part is encoded
+     as file attachment.}
+    function AddPartBinary(const Stream: TStream; const FileName: string; const PartParent: TMimePart): TMimepart;
+
+    {:Same as @link(AddPartBinary), but content is readed from file}
+    function AddPartBinaryFromFile(const FileName: string; const PartParent: TMimePart): TMimepart;
+
+    {:Add MIME part as subpart of PartParent. If you need set root MIME part,
+     then set as PartParent @NIL value. If you need set more then 1 subpart, you
+     must have PartParent of multipart type!
+
+     After creation of part set type to binary and set all necessary properties.
+     MIME primary and secondary types defined automaticly by filename extension.
+     Content of binary part is readed from Stream.
+
+     This binary part is encoded as inline data with given Conten ID (cid).
+     Content ID can be used as reference ID in HTML source in HTML part.}
+    function AddPartHTMLBinary(const Stream: TStream; const FileName, Cid: string; const PartParent: TMimePart): TMimepart;
+
+    {:Same as @link(AddPartHTMLBinary), but content is readed from file}
+    function AddPartHTMLBinaryFromFile(const FileName, Cid: string; const PartParent: TMimePart): TMimepart;
+
+    {:Add MIME part as subpart of PartParent. If you need set root MIME part,
+     then set as PartParent @NIL value. If you need set more then 1 subpart, you
+     must have PartParent of multipart type!
+
+     After creation of part set type to message and set all necessary properties.
+     MIME primary and secondary types are setted to 'message/rfc822'.
+     Content of raw RFC-822 message is readed from Stream.}
+    function AddPartMess(const Value: TStrings; const PartParent: TMimePart): TMimepart;
+
+    {:Same as @link(AddPartMess), but content is readed from file}
+    function AddPartMessFromFile(const FileName: string; const PartParent: TMimePart): TMimepart;
+
+    {:Compose message from @link(MessagePart) to @link(Lines). Headers from
+     @link(Header) object is added also.}
+    procedure EncodeMessage;
+
+    {:Decode message from @link(Lines) to @link(MessagePart). Massage headers
+     are parsed into @link(Header) object.}
+    procedure DecodeMessage;
+  published
+    {:@link(TMimePart) object with decoded MIME message. This object can handle
+     any number of nested @link(TMimePart) objects itself. It is used for handle
+     any tree of MIME subparts.}
+    property MessagePart: TMimePart read FMessagePart;
+
+    {:Raw MIME encoded message.}
+    property Lines: TStringList read FLines;
+
+    {:Object for e-mail header fields. This object is created automaticly.
+     Do not free this object!}
+    property Header: TMessHeader read FHeader;
+  end;
+
+implementation
+
+{==============================================================================}
+
+constructor TMessHeader.Create;
+begin
+  inherited Create;
+  FToList := TStringList.Create;
+  FCCList := TStringList.Create;
+  FCustomHeaders := TStringList.Create;
+  FCharsetCode := GetCurCP;
+end;
+
+destructor TMessHeader.Destroy;
+begin
+  FCustomHeaders.Free;
+  FCCList.Free;
+  FToList.Free;
+  inherited Destroy;
+end;
+
+{==============================================================================}
+
+procedure TMessHeader.Clear;
+begin
+  FFrom := '';
+  FToList.Clear;
+  FCCList.Clear;
+  FSubject := '';
+  FOrganization := '';
+  FCustomHeaders.Clear;
+  FDate := 0;
+  FXMailer := '';
+  FReplyTo := '';
+  FMessageID := '';
+  FPriority := MP_unknown;
+end;
+
+procedure TMessHeader.EncodeHeaders(const Value: TStrings);
+var
+  n: Integer;
+  s: string;
+begin
+  if FDate = 0 then
+    FDate := Now;
+  for n := FCustomHeaders.Count - 1 downto 0 do
+    if FCustomHeaders[n] <> '' then
+      Value.Insert(0, FCustomHeaders[n]);
+  if FPriority <> MP_unknown then
+    case FPriority of
+      MP_high:
+        begin
+          Value.Insert(0, 'X-MSMAIL-Priority: High');
+          Value.Insert(0, 'X-Priority: 1');
+          Value.Insert(0, 'Priority: urgent');
+        end;
+      MP_low:
+        begin
+          Value.Insert(0, 'X-MSMAIL-Priority: low');
+          Value.Insert(0, 'X-Priority: 5');
+          Value.Insert(0, 'Priority: non-urgent');
+        end;
+    end;
+  if FReplyTo <> '' then
+    Value.Insert(0, 'Reply-To: ' + GetEmailAddr(FReplyTo));
+  if FMessageID <> '' then
+    Value.Insert(0, 'Message-ID: <' + trim(FMessageID) + '>');
+  if FXMailer = '' then
+    Value.Insert(0, 'X-mailer: Synapse - Pascal TCP/IP library by Lukas Gebauer')
+  else
+    Value.Insert(0, 'X-mailer: ' + FXMailer);
+  Value.Insert(0, 'MIME-Version: 1.0 (produced by Synapse)');
+  if FOrganization <> '' then
+    Value.Insert(0, 'Organization: ' + InlineCodeEx(FOrganization, FCharsetCode));
+  s := '';
+  for n := 0 to FCCList.Count - 1 do
+    if s = '' then
+      s := InlineEmailEx(FCCList[n], FCharsetCode)
+    else
+      s := s + ', ' + InlineEmailEx(FCCList[n], FCharsetCode);
+  if s <> '' then
+    Value.Insert(0, 'CC: ' + s);
+  Value.Insert(0, 'Date: ' + Rfc822DateTime(FDate));
+  if FSubject <> '' then
+    Value.Insert(0, 'Subject: ' + InlineCodeEx(FSubject, FCharsetCode));
+  s := '';
+  for n := 0 to FToList.Count - 1 do
+    if s = '' then
+      s := InlineEmailEx(FToList[n], FCharsetCode)
+    else
+      s := s + ', ' + InlineEmailEx(FToList[n], FCharsetCode);
+  if s <> '' then
+    Value.Insert(0, 'To: ' + s);
+  Value.Insert(0, 'From: ' + InlineEmailEx(FFrom, FCharsetCode));
+end;
+
+function TMessHeader.ParsePriority(value: string): TMessPriority;
+var
+  s: string;
+  x: integer;
+begin
+  Result := MP_unknown;
+  s := Trim(separateright(value, ':'));
+  s := Separateleft(s, ' ');
+  x := StrToIntDef(s, -1);
+  if x >= 0 then
+    case x of
+      1, 2:
+        Result := MP_High;
+      3:
+        Result := MP_Normal;
+      4, 5:
+        Result := MP_Low;
+    end
+  else
+  begin
+    s := lowercase(s);
+    if (s = 'urgent') or (s = 'high') or (s = 'highest') then
+      Result := MP_High;
+    if (s = 'normal') or (s = 'medium') then
+      Result := MP_Normal;
+    if (s = 'low') or (s = 'lowest')
+      or (s = 'no-priority')  or (s = 'non-urgent') then
+      Result := MP_Low;
+  end;
+end;
+
+function TMessHeader.DecodeHeader(value: string): boolean;
+var
+  s, t: string;
+  cp: TMimeChar;
+begin
+  Result := True;
+  cp := FCharsetCode;
+  s := uppercase(value);
+  if Pos('X-MAILER:', s) = 1 then
+  begin
+    FXMailer := Trim(SeparateRight(Value, ':'));
+    Exit;
+  end;
+  if Pos('FROM:', s) = 1 then
+  begin
+    FFrom := InlineDecode(Trim(SeparateRight(Value, ':')), cp);
+    Exit;
+  end;
+  if Pos('SUBJECT:', s) = 1 then
+  begin
+    FSubject := InlineDecode(Trim(SeparateRight(Value, ':')), cp);
+    Exit;
+  end;
+  if Pos('ORGANIZATION:', s) = 1 then
+  begin
+    FOrganization := InlineDecode(Trim(SeparateRight(Value, ':')), cp);
+    Exit;
+  end;
+  if Pos('TO:', s) = 1 then
+  begin
+    s := Trim(SeparateRight(Value, ':'));
+    repeat
+      t := InlineDecode(Trim(FetchEx(s, ',', '"')), cp);
+      if t <> '' then
+        FToList.Add(t);
+    until s = '';
+    Exit;
+  end;
+  if Pos('CC:', s) = 1 then
+  begin
+    s := Trim(SeparateRight(Value, ':'));
+    repeat
+      t := InlineDecode(Trim(FetchEx(s, ',', '"')), cp);
+      if t <> '' then
+        FCCList.Add(t);
+    until s = '';
+    Exit;
+  end;
+  if Pos('DATE:', s) = 1 then
+  begin
+    FDate := DecodeRfcDateTime(Trim(SeparateRight(Value, ':')));
+    Exit;
+  end;
+  if Pos('REPLY-TO:', s) = 1 then
+  begin
+    FReplyTo := InlineDecode(Trim(SeparateRight(Value, ':')), cp);
+    Exit;
+  end;
+  if Pos('MESSAGE-ID:', s) = 1 then
+  begin
+    FMessageID := GetEmailAddr(Trim(SeparateRight(Value, ':')));
+    Exit;
+  end;
+  if Pos('PRIORITY:', s) = 1 then
+  begin
+    FPri := ParsePriority(value);
+    Exit;
+  end;
+  if Pos('X-PRIORITY:', s) = 1 then
+  begin
+    FXPri := ParsePriority(value);
+    Exit;
+  end;
+  if Pos('X-MSMAIL-PRIORITY:', s) = 1 then
+  begin
+    FXmsPri := ParsePriority(value);
+    Exit;
+  end;
+  if Pos('MIME-VERSION:', s) = 1 then
+    Exit;
+  if Pos('CONTENT-TYPE:', s) = 1 then
+    Exit;
+  if Pos('CONTENT-DESCRIPTION:', s) = 1 then
+    Exit;
+  if Pos('CONTENT-DISPOSITION:', s) = 1 then
+    Exit;
+  if Pos('CONTENT-ID:', s) = 1 then
+    Exit;
+  if Pos('CONTENT-TRANSFER-ENCODING:', s) = 1 then
+    Exit;
+  Result := False;
+end;
+
+procedure TMessHeader.DecodeHeaders(const Value: TStrings);
+var
+  s: string;
+  x: Integer;
+begin
+  Clear;
+  Fpri := MP_unknown;
+  Fxpri := MP_unknown;
+  Fxmspri := MP_unknown;
+  x := 0;
+  while Value.Count > x do
+  begin
+    s := NormalizeHeader(Value, x);
+    if s = '' then
+      Break;
+    if not DecodeHeader(s) then
+      FCustomHeaders.Add(s);
+  end;
+  if Fpri <> MP_unknown then
+    FPriority := Fpri
+  else
+    if Fxpri <> MP_unknown then
+      FPriority := Fxpri
+    else
+      if Fxmspri <> MP_unknown then
+        FPriority := Fxmspri
+end;
+
+function TMessHeader.FindHeader(Value: string): string;
+var
+  n: integer;
+begin
+  Result := '';
+  for n := 0 to FCustomHeaders.Count - 1 do
+    if Pos(UpperCase(Value), UpperCase(FCustomHeaders[n])) = 1 then
+    begin
+      Result := Trim(SeparateRight(FCustomHeaders[n], ':'));
+      break;
+    end;
+end;
+
+procedure TMessHeader.FindHeaderList(Value: string; const HeaderList: TStrings);
+var
+  n: integer;
+begin
+  HeaderList.Clear;
+  for n := 0 to FCustomHeaders.Count - 1 do
+    if Pos(UpperCase(Value), UpperCase(FCustomHeaders[n])) = 1 then
+    begin
+      HeaderList.Add(Trim(SeparateRight(FCustomHeaders[n], ':')));
+    end;
+end;
+
+{==============================================================================}
+
+constructor TMimeMess.Create;
+begin
+  CreateAltHeaders(TMessHeader);
+end;
+
+constructor TMimeMess.CreateAltHeaders(HeadClass: TMessHeaderClass);
+begin
+  inherited Create;
+  FMessagePart := TMimePart.Create;
+  FLines := TStringList.Create;
+  FHeader := HeadClass.Create;
+end;
+
+destructor TMimeMess.Destroy;
+begin
+  FMessagePart.Free;
+  FHeader.Free;
+  FLines.Free;
+  inherited Destroy;
+end;
+
+{==============================================================================}
+
+procedure TMimeMess.Clear;
+begin
+  FMessagePart.Clear;
+  FLines.Clear;
+  FHeader.Clear;
+end;
+
+{==============================================================================}
+
+function TMimeMess.AddPart(const PartParent: TMimePart): TMimePart;
+begin
+  if PartParent = nil then
+    Result := FMessagePart
+  else
+    Result := PartParent.AddSubPart;
+  Result.Clear;
+end;
+
+{==============================================================================}
+
+function TMimeMess.AddPartMultipart(const MultipartType: String; const PartParent: TMimePart): TMimePart;
+begin
+  Result := AddPart(PartParent);
+  with Result do
+  begin
+    Primary := 'Multipart';
+    Secondary := MultipartType;
+    Description := 'Multipart message';
+    Boundary := GenerateBoundary;
+    EncodePartHeader;
+  end;
+end;
+
+function TMimeMess.AddPartText(const Value: TStrings; const PartParent: TMimePart): TMimepart;
+begin
+  Result := AddPart(PartParent);
+  with Result do
+  begin
+    Value.SaveToStream(DecodedLines);
+    Primary := 'text';
+    Secondary := 'plain';
+    Description := 'Message text';
+    Disposition := 'inline';
+    CharsetCode := IdealCharsetCoding(Value.Text, TargetCharset, IdealCharsets);
+    EncodingCode := ME_QUOTED_PRINTABLE;
+    EncodePart;
+    EncodePartHeader;
+  end;
+end;
+
+function TMimeMess.AddPartTextEx(const Value: TStrings; const PartParent: TMimePart;
+  PartCharset: TMimeChar; Raw: Boolean; PartEncoding: TMimeEncoding): TMimepart;
+begin
+  Result := AddPart(PartParent);
+  with Result do
+  begin
+    Value.SaveToStream(DecodedLines);
+    Primary := 'text';
+    Secondary := 'plain';
+    Description := 'Message text';
+    Disposition := 'inline';
+    CharsetCode := PartCharset;
+    EncodingCode := PartEncoding;
+    ConvertCharset := not Raw;
+    EncodePart;
+    EncodePartHeader;
+  end;
+end;
+
+function TMimeMess.AddPartHTML(const Value: TStrings; const PartParent: TMimePart): TMimepart;
+begin
+  Result := AddPart(PartParent);
+  with Result do
+  begin
+    Value.SaveToStream(DecodedLines);
+    Primary := 'text';
+    Secondary := 'html';
+    Description := 'HTML text';
+    Disposition := 'inline';
+    CharsetCode := UTF_8;
+    EncodingCode := ME_QUOTED_PRINTABLE;
+    EncodePart;
+    EncodePartHeader;
+  end;
+end;
+
+function TMimeMess.AddPartTextFromFile(const FileName: String; const PartParent: TMimePart): TMimepart;
+var
+  tmp: TStrings;
+begin
+  tmp := TStringList.Create;
+  try
+    tmp.LoadFromFile(FileName);
+    Result := AddPartText(tmp, PartParent);
+  Finally
+    tmp.Free;
+  end;
+end;
+
+function TMimeMess.AddPartHTMLFromFile(const FileName: String; const PartParent: TMimePart): TMimepart;
+var
+  tmp: TStrings;
+begin
+  tmp := TStringList.Create;
+  try
+    tmp.LoadFromFile(FileName);
+    Result := AddPartHTML(tmp, PartParent);
+  Finally
+    tmp.Free;
+  end;
+end;
+
+function TMimeMess.AddPartBinary(const Stream: TStream; const FileName: string; const PartParent: TMimePart): TMimepart;
+begin
+  Result := AddPart(PartParent);
+  Result.DecodedLines.LoadFromStream(Stream);
+  Result.MimeTypeFromExt(FileName);
+  Result.Description := 'Attached file: ' + FileName;
+  Result.Disposition := 'attachment';
+  Result.FileName := FileName;
+  Result.EncodingCode := ME_BASE64;
+  Result.EncodePart;
+  Result.EncodePartHeader;
+end;
+
+function TMimeMess.AddPartBinaryFromFile(const FileName: string; const PartParent: TMimePart): TMimepart;
+var
+  tmp: TMemoryStream;
+begin
+  tmp := TMemoryStream.Create;
+  try
+    tmp.LoadFromFile(FileName);
+    Result := AddPartBinary(tmp, ExtractFileName(FileName), PartParent);
+  finally
+    tmp.Free;
+  end;
+end;
+
+function TMimeMess.AddPartHTMLBinary(const Stream: TStream; const FileName, Cid: string; const PartParent: TMimePart): TMimepart;
+begin
+  Result := AddPart(PartParent);
+  Result.DecodedLines.LoadFromStream(Stream);
+  Result.MimeTypeFromExt(FileName);
+  Result.Description := 'Included file: ' + FileName;
+  Result.Disposition := 'inline';
+  Result.ContentID := Cid;
+  Result.FileName := FileName;
+  Result.EncodingCode := ME_BASE64;
+  Result.EncodePart;
+  Result.EncodePartHeader;
+end;
+
+function TMimeMess.AddPartHTMLBinaryFromFile(const FileName, Cid: string; const PartParent: TMimePart): TMimepart;
+var
+  tmp: TMemoryStream;
+begin
+  tmp := TMemoryStream.Create;
+  try
+    tmp.LoadFromFile(FileName);
+    Result :=AddPartHTMLBinary(tmp, ExtractFileName(FileName), Cid, PartParent);
+  finally
+    tmp.Free;
+  end;
+end;
+
+function TMimeMess.AddPartMess(const Value: TStrings; const PartParent: TMimePart): TMimepart;
+var
+  part: Tmimepart;
+begin
+  Result := AddPart(PartParent);
+  part := AddPart(result);
+  part.lines.addstrings(Value);
+  part.DecomposeParts;
+  with Result do
+  begin
+    Primary := 'message';
+    Secondary := 'rfc822';
+    Description := 'E-mail Message';
+    EncodePart;
+    EncodePartHeader;
+  end;
+end;
+
+function TMimeMess.AddPartMessFromFile(const FileName: String; const PartParent: TMimePart): TMimepart;
+var
+  tmp: TStrings;
+begin
+  tmp := TStringList.Create;
+  try
+    tmp.LoadFromFile(FileName);
+    Result := AddPartMess(tmp, PartParent);
+  Finally
+    tmp.Free;
+  end;
+end;
+
+{==============================================================================}
+
+procedure TMimeMess.EncodeMessage;
+var
+  l: TStringList;
+  x: integer;
+begin
+  //merge headers from THeaders and header field from MessagePart
+  l := TStringList.Create;
+  try
+    FHeader.EncodeHeaders(l);
+    x := IndexByBegin('CONTENT-TYPE', FMessagePart.Headers);
+    if x >= 0 then
+      l.add(FMessagePart.Headers[x]);
+    x := IndexByBegin('CONTENT-DESCRIPTION', FMessagePart.Headers);
+    if x >= 0 then
+      l.add(FMessagePart.Headers[x]);
+    x := IndexByBegin('CONTENT-DISPOSITION', FMessagePart.Headers);
+    if x >= 0 then
+      l.add(FMessagePart.Headers[x]);
+    x := IndexByBegin('CONTENT-ID', FMessagePart.Headers);
+    if x >= 0 then
+      l.add(FMessagePart.Headers[x]);
+    x := IndexByBegin('CONTENT-TRANSFER-ENCODING', FMessagePart.Headers);
+    if x >= 0 then
+      l.add(FMessagePart.Headers[x]);
+    FMessagePart.Headers.Assign(l);
+  finally
+    l.Free;
+  end;
+  FMessagePart.ComposeParts;
+  FLines.Assign(FMessagePart.Lines);
+end;
+
+{==============================================================================}
+
+procedure TMimeMess.DecodeMessage;
+begin
+  FHeader.Clear;
+  FHeader.DecodeHeaders(FLines);
+  FMessagePart.Lines.Assign(FLines);
+  FMessagePart.DecomposeParts;
+end;
+
+end.
diff --git a/Units/Synapse/mimepart.pas b/Units/Synapse/mimepart.pas
index 93e0b91..91bb68b 100644
--- a/Units/Synapse/mimepart.pas
+++ b/Units/Synapse/mimepart.pas
@@ -1,1094 +1,1094 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 002.008.000 |
-|==============================================================================|
-| Content: MIME support procedures and functions                               |
-|==============================================================================|
-| Copyright (c)1999-2008, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2000-2008.                |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{:@abstract(MIME part handling)
-Handling with MIME parts.
-
-Used RFC: RFC-2045
-}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$H+}
-{$Q-}
-{$R-}
-
-{$IFDEF UNICODE}
-  {$WARN IMPLICIT_STRING_CAST OFF}
-  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
-{$ENDIF}
-
-unit mimepart;
-
-interface
-
-uses
-  SysUtils, Classes,
-  synafpc,
-  synachar, synacode, synautil, mimeinln;
-
-type
-
-  TMimePart = class;
-
-  {:@abstract(Procedural type for @link(TMimepart.Walkpart) hook). This hook is used for
-   easy walking through MIME subparts.}
-  THookWalkPart = procedure(const Sender: TMimePart) of object;
-
-  {:The four types of MIME parts. (textual, multipart, message or any other
-   binary data.)}
-  TMimePrimary = (MP_TEXT, MP_MULTIPART, MP_MESSAGE, MP_BINARY);
-
-  {:The various types of possible part encodings.}
-  TMimeEncoding = (ME_7BIT, ME_8BIT, ME_QUOTED_PRINTABLE,
-    ME_BASE64, ME_UU, ME_XX);
-
-  {:@abstract(Object for working with parts of MIME e-mail.)
-   Each TMimePart object can handle any number of nested subparts as new
-   TMimepart objects. It can handle any tree hierarchy structure of nested MIME
-   subparts itself.
-
-   Basic tasks are:
-
-   Decoding of MIME message:
-   - store message into Lines property
-   - call DecomposeParts. Now you have decomposed MIME parts in all nested levels!
-   - now you can explore all properties and subparts. (You can use WalkPart method)
-   - if you need decode part, call DecodePart.
-
-   Encoding of MIME message:
-
-   - if you need multipart message, you must create subpart by AddSubPart.
-   - set all properties of all parts.
-   - set content of part into DecodedLines stream
-   - encode this stream by EncodePart.
-   - compose full message by ComposeParts. (it build full MIME message from all subparts. Do not call this method for each subpart! It is needed on root part!)
-   - encoded MIME message is stored in Lines property.
-  }
-  TMimePart = class(TObject)
-  private
-    FPrimary: string;
-    FPrimaryCode: TMimePrimary;
-    FSecondary: string;
-    FEncoding: string;
-    FEncodingCode: TMimeEncoding;
-    FDefaultCharset: string;
-    FCharset: string;
-    FCharsetCode: TMimeChar;
-    FTargetCharset: TMimeChar;
-    FDescription: string;
-    FDisposition: string;
-    FContentID: string;
-    FBoundary: string;
-    FFileName: string;
-    FLines: TStringList;
-    FPartBody: TStringList;
-    FHeaders: TStringList;
-    FPrePart: TStringList;
-    FPostPart: TStringList;
-    FDecodedLines: TMemoryStream;
-    FSubParts: TList;
-    FOnWalkPart: THookWalkPart;
-    FMaxLineLength: integer;
-    FSubLevel: integer;
-    FMaxSubLevel: integer;
-    FAttachInside: boolean;
-    FConvertCharset: Boolean;
-    FForcedHTMLConvert: Boolean;
-    procedure SetPrimary(Value: string);
-    procedure SetEncoding(Value: string);
-    procedure SetCharset(Value: string);
-    function IsUUcode(Value: string): boolean;
-  public
-    constructor Create;
-    destructor Destroy; override;
-
-    {:Assign content of another object to this object. (Only this part,
-     not subparts!)}
-    procedure Assign(Value: TMimePart);
-
-    {:Assign content of another object to this object. (With all subparts!)}
-    procedure AssignSubParts(Value: TMimePart);
-
-    {:Clear all data values to default values. It also call @link(ClearSubparts).}
-    procedure Clear;
-
-    {:Decode Mime part from @link(Lines) to @link(DecodedLines).}
-    procedure DecodePart;
-
-    {:Parse header lines from Headers property into another properties.}
-    procedure DecodePartHeader;
-
-    {:Encode mime part from @link(DecodedLines) to @link(Lines) and build mime
-     headers.}
-    procedure EncodePart;
-
-    {:Build header lines in Headers property from another properties.}
-    procedure EncodePartHeader;
-
-    {:generate primary and secondary mime type from filename extension in value.
-     If type not recognised, it return 'Application/octet-string' type.}
-    procedure MimeTypeFromExt(Value: string);
-
-    {:Return number of decomposed subparts. (On this level! Each of this
-     subparts can hold any number of their own nested subparts!)}
-    function GetSubPartCount: integer;
-
-    {:Get nested subpart object as new TMimePart. For getting maximum possible
-     index you can use @link(GetSubPartCount) method.}
-    function GetSubPart(index: integer): TMimePart;
-
-    {:delete subpart on given index.}
-    procedure DeleteSubPart(index: integer);
-
-    {:Clear and destroy all subpart TMimePart objects.}
-    procedure ClearSubParts;
-
-    {:Add and create new subpart.}
-    function AddSubPart: TMimePart;
-
-    {:E-mail message in @link(Lines) property is parsed into this object.
-     E-mail headers are stored in @link(Headers) property and is parsed into
-     another properties automaticly. Not need call @link(DecodePartHeader)!
-     Content of message (part) is stored into @link(PartBody) property. This
-     part is in undecoded form! If you need decode it, then you must call
-     @link(DecodePart) method by your hands. Lot of another properties is filled
-     also.
-
-     Decoding of parts you must call separately due performance reasons. (Not
-     needed to decode all parts in all reasons.)
-
-     For each MIME subpart is created new TMimepart object (accessible via
-     method @link(GetSubPart)).}
-    procedure DecomposeParts;
-
-    {:This part and all subparts is composed into one MIME message stored in
-     @link(Lines) property.}
-    procedure ComposeParts;
-
-    {:By calling this method is called @link(OnWalkPart) event for each part
-     and their subparts. It is very good for calling some code for each part in
-     MIME message}
-    procedure WalkPart;
-
-    {:Return @true when is possible create next subpart. (@link(maxSublevel)
-     is still not reached)}
-    function CanSubPart: boolean;
-  published
-    {:Primary Mime type of part. (i.e. 'application') Writing to this property
-     automaticly generate value of @link(PrimaryCode).}
-    property Primary: string read FPrimary write SetPrimary;
-
-    {:String representation of used Mime encoding in part. (i.e. 'base64')
-     Writing to this property automaticly generate value of @link(EncodingCode).}
-    property Encoding: string read FEncoding write SetEncoding;
-
-    {:String representation of used Mime charset in part. (i.e. 'iso-8859-1')
-     Writing to this property automaticly generate value of @link(CharsetCode).
-     Charset is used only for text parts.}
-    property Charset: string read FCharset write SetCharset;
-
-    {:Define default charset for decoding text MIME parts without charset
-     specification. Default value is 'ISO-8859-1' by RCF documents.
-     But Microsoft Outlook use windows codings as default. This property allows
-     properly decode textual parts from some broken versions of Microsoft
-     Outlook. (this is bad software!)}
-    property DefaultCharset: string read FDefaultCharset write FDefaultCharset;
-
-    {:Decoded primary type. Possible values are: MP_TEXT, MP_MULTIPART,
-     MP_MESSAGE and MP_BINARY. If type not recognised, result is MP_BINARY.}
-    property PrimaryCode: TMimePrimary read FPrimaryCode Write FPrimaryCode;
-
-    {:Decoded encoding type. Possible values are: ME_7BIT, ME_8BIT,
-     ME_QUOTED_PRINTABLE and ME_BASE64. If type not recognised, result is
-     ME_7BIT.}
-    property EncodingCode: TMimeEncoding read FEncodingCode Write FEncodingCode;
-
-    {:Decoded charset type. Possible values are defined in @link(SynaChar) unit.}
-    property CharsetCode: TMimeChar read FCharsetCode Write FCharsetCode;
-
-    {:System charset type. Default value is charset used by default in your
-     operating system.}
-    property TargetCharset: TMimeChar read FTargetCharset Write FTargetCharset;
-
-    {:If @true, then do internal charset translation of part content between @link(CharsetCode)
-     and @link(TargetCharset)}
-    property ConvertCharset: Boolean read FConvertCharset Write FConvertCharset;
-
-    {:If @true, then allways do internal charset translation of HTML parts
-     by MIME even it have their own charset in META tag. Default is @false.}
-    property ForcedHTMLConvert: Boolean read FForcedHTMLConvert Write FForcedHTMLConvert;
-
-    {:Secondary Mime type of part. (i.e. 'mixed')}
-    property Secondary: string read FSecondary Write FSecondary;
-
-    {:Description of Mime part.}
-    property Description: string read FDescription Write FDescription;
-
-    {:Value of content disposition field. (i.e. 'inline' or 'attachment')}
-    property Disposition: string read FDisposition Write FDisposition;
-
-    {:Content ID.}
-    property ContentID: string read FContentID Write FContentID;
-
-    {:Boundary delimiter of multipart Mime part. Used only in multipart part.}
-    property Boundary: string read FBoundary Write FBoundary;
-
-    {:Filename of file in binary part.}
-    property FileName: string read FFileName Write FFileName;
-
-    {:String list with lines contains mime part (It can be a full message).}
-    property Lines: TStringList read FLines;
-
-    {:Encoded form of MIME part data.}
-    property PartBody: TStringList read FPartBody;
-
-    {:All header lines of MIME part.}
-    property Headers: TStringList read FHeaders;
-
-    {:On multipart this contains part of message between first line of message
-     and first boundary.}
-    property PrePart: TStringList read FPrePart;
-
-    {:On multipart this contains part of message between last boundary and end
-     of message.}
-    property PostPart: TStringList read FPostPart;
-
-    {:Stream with decoded form of budy part.}
-    property DecodedLines: TMemoryStream read FDecodedLines;
-
-    {:Show nested level in subpart tree. Value 0 means root part. 1 means
-     subpart from this root. etc.}
-    property SubLevel: integer read FSubLevel write FSubLevel;
-
-    {:Specify maximum sublevel value for decomposing.}
-    property MaxSubLevel: integer read FMaxSubLevel write FMaxSubLevel;
-
-    {:When is @true, then this part maybe(!) have included some uuencoded binary
-    data.}
-    property AttachInside: boolean read FAttachInside;
-
-    {:Here you can assign hook procedure for walking through all part and their
-     subparts.}
-    property OnWalkPart: THookWalkPart read FOnWalkPart write FOnWalkPart;
-
-    {:Here you can specify maximum line length for encoding of MIME part.
-     If line is longer, then is splitted by standard of MIME. Correct MIME
-     mailers can de-split this line into original length.}
-    property MaxLineLength: integer read FMaxLineLength Write FMaxLineLength;
-  end;
-
-const
-  MaxMimeType = 25;
-  MimeType: array[0..MaxMimeType, 0..2] of string =
-  (
-    ('AU', 'audio', 'basic'),
-    ('AVI', 'video', 'x-msvideo'),
-    ('BMP', 'image', 'BMP'),
-    ('DOC', 'application', 'MSWord'),
-    ('EPS', 'application', 'Postscript'),
-    ('GIF', 'image', 'GIF'),
-    ('JPEG', 'image', 'JPEG'),
-    ('JPG', 'image', 'JPEG'),
-    ('MID', 'audio', 'midi'),
-    ('MOV', 'video', 'quicktime'),
-    ('MPEG', 'video', 'MPEG'),
-    ('MPG', 'video', 'MPEG'),
-    ('MP2', 'audio', 'mpeg'),
-    ('MP3', 'audio', 'mpeg'),
-    ('PDF', 'application', 'PDF'),
-    ('PNG', 'image', 'PNG'),
-    ('PS', 'application', 'Postscript'),
-    ('QT', 'video', 'quicktime'),
-    ('RA', 'audio', 'x-realaudio'),
-    ('RTF', 'application', 'RTF'),
-    ('SND', 'audio', 'basic'),
-    ('TIF', 'image', 'TIFF'),
-    ('TIFF', 'image', 'TIFF'),
-    ('WAV', 'audio', 'x-wav'),
-    ('WPD', 'application', 'Wordperfect5.1'),
-    ('ZIP', 'application', 'ZIP')
-    );
-
-{:Generates a unique boundary string.}
-function GenerateBoundary: string;
-
-implementation
-
-{==============================================================================}
-
-constructor TMIMEPart.Create;
-begin
-  inherited Create;
-  FOnWalkPart := nil;
-  FLines := TStringList.Create;
-  FPartBody := TStringList.Create;
-  FHeaders := TStringList.Create;
-  FPrePart := TStringList.Create;
-  FPostPart := TStringList.Create;
-  FDecodedLines := TMemoryStream.Create;
-  FSubParts := TList.Create;
-  FTargetCharset := GetCurCP;
-  //was 'US-ASCII' before, but RFC-ignorant Outlook sometimes using default
-  //system charset instead.
-  FDefaultCharset := GetIDFromCP(GetCurCP);
-  FMaxLineLength := 78;
-  FSubLevel := 0;
-  FMaxSubLevel := -1;
-  FAttachInside := false;
-  FConvertCharset := true;
-  FForcedHTMLConvert := false;
-end;
-
-destructor TMIMEPart.Destroy;
-begin
-  ClearSubParts;
-  FSubParts.Free;
-  FDecodedLines.Free;
-  FPartBody.Free;
-  FLines.Free;
-  FHeaders.Free;
-  FPrePart.Free;
-  FPostPart.Free;
-  inherited Destroy;
-end;
-
-{==============================================================================}
-
-procedure TMIMEPart.Clear;
-begin
-  FPrimary := '';
-  FEncoding := '';
-  FCharset := '';
-  FPrimaryCode := MP_TEXT;
-  FEncodingCode := ME_7BIT;
-  FCharsetCode := ISO_8859_1;
-  FTargetCharset := GetCurCP;
-  FSecondary := '';
-  FDisposition := '';
-  FContentID := '';
-  FDescription := '';
-  FBoundary := '';
-  FFileName := '';
-  FAttachInside := False;
-  FPartBody.Clear;
-  FHeaders.Clear;
-  FPrePart.Clear;
-  FPostPart.Clear;
-  FDecodedLines.Clear;
-  FConvertCharset := true;
-  FForcedHTMLConvert := false;
-  ClearSubParts;
-end;
-
-{==============================================================================}
-
-procedure TMIMEPart.Assign(Value: TMimePart);
-begin
-  Primary := Value.Primary;
-  Encoding := Value.Encoding;
-  Charset := Value.Charset;
-  DefaultCharset := Value.DefaultCharset;
-  PrimaryCode := Value.PrimaryCode;
-  EncodingCode := Value.EncodingCode;
-  CharsetCode := Value.CharsetCode;
-  TargetCharset := Value.TargetCharset;
-  Secondary := Value.Secondary;
-  Description := Value.Description;
-  Disposition := Value.Disposition;
-  ContentID := Value.ContentID;
-  Boundary := Value.Boundary;
-  FileName := Value.FileName;
-  Lines.Assign(Value.Lines);
-  PartBody.Assign(Value.PartBody);
-  Headers.Assign(Value.Headers);
-  PrePart.Assign(Value.PrePart);
-  PostPart.Assign(Value.PostPart);
-  MaxLineLength := Value.MaxLineLength;
-  FAttachInside := Value.AttachInside;
-  FConvertCharset := Value.ConvertCharset;
-end;
-
-{==============================================================================}
-
-procedure TMIMEPart.AssignSubParts(Value: TMimePart);
-var
-  n: integer;
-  p: TMimePart;
-begin
-  Assign(Value);
-  for n := 0 to Value.GetSubPartCount - 1 do
-  begin
-    p := AddSubPart;
-    p.AssignSubParts(Value.GetSubPart(n));
-  end;
-end;
-
-{==============================================================================}
-
-function TMIMEPart.GetSubPartCount: integer;
-begin
-  Result :=  FSubParts.Count;
-end;
-
-{==============================================================================}
-
-function TMIMEPart.GetSubPart(index: integer): TMimePart;
-begin
-  Result := nil;
-  if Index < GetSubPartCount then
-    Result := TMimePart(FSubParts[Index]);
-end;
-
-{==============================================================================}
-
-procedure TMIMEPart.DeleteSubPart(index: integer);
-begin
-  if Index < GetSubPartCount then
-  begin
-    GetSubPart(Index).Free;
-    FSubParts.Delete(Index);
-  end;
-end;
-
-{==============================================================================}
-
-procedure TMIMEPart.ClearSubParts;
-var
-  n: integer;
-begin
-  for n := 0 to GetSubPartCount - 1 do
-    TMimePart(FSubParts[n]).Free;
-  FSubParts.Clear;
-end;
-
-{==============================================================================}
-
-function TMIMEPart.AddSubPart: TMimePart;
-begin
-  Result := TMimePart.Create;
-  Result.DefaultCharset := FDefaultCharset;
-  FSubParts.Add(Result);
-  Result.SubLevel := FSubLevel + 1;
-  Result.MaxSubLevel := FMaxSubLevel;  
-end;
-
-{==============================================================================}
-
-procedure TMIMEPart.DecomposeParts;
-var
-  x: integer;
-  s: string;
-  Mime: TMimePart;
-
-  procedure SkipEmpty;
-  begin
-    while FLines.Count > x do
-    begin
-      s := TrimRight(FLines[x]);
-      if s <> '' then
-        Break;
-      Inc(x);
-    end;
-  end;
-
-begin
-  x := 0;
-  Clear;
-  //extract headers
-  while FLines.Count > x do
-  begin
-    s := NormalizeHeader(FLines, x);
-    if s = '' then
-      Break;
-    FHeaders.Add(s);
-  end;
-  DecodePartHeader;
-  //extract prepart
-  if FPrimaryCode = MP_MULTIPART then
-  begin
-    while FLines.Count > x do
-    begin
-      s := FLines[x];
-      Inc(x);
-      if TrimRight(s) = '--' + FBoundary then
-        Break;
-      FPrePart.Add(s);
-      if not FAttachInside then
-        FAttachInside := IsUUcode(s);
-    end;
-  end;
-  //extract body part
-  if FPrimaryCode = MP_MULTIPART then
-  begin
-    repeat
-      if CanSubPart then
-      begin
-        Mime := AddSubPart;
-        while FLines.Count > x do
-        begin
-          s := FLines[x];
-          Inc(x);
-          if Pos('--' + FBoundary, s) = 1 then
-            Break;
-          Mime.Lines.Add(s);
-        end;
-        Mime.DecomposeParts;
-      end
-      else
-      begin
-        s := FLines[x];
-        Inc(x);
-        FPartBody.Add(s);
-      end;
-      if x >= FLines.Count then
-        break;
-    until s = '--' + FBoundary + '--';
-  end;
-  if (FPrimaryCode = MP_MESSAGE) and CanSubPart then
-  begin
-    Mime := AddSubPart;
-    SkipEmpty;
-    while FLines.Count > x do
-    begin
-      s := TrimRight(FLines[x]);
-      Inc(x);
-      Mime.Lines.Add(s);
-    end;
-    Mime.DecomposeParts;
-  end
-  else
-  begin
-    while FLines.Count > x do
-    begin
-      s := FLines[x];
-      Inc(x);
-      FPartBody.Add(s);
-      if not FAttachInside then
-        FAttachInside := IsUUcode(s);
-    end;
-  end;
-  //extract postpart
-  if FPrimaryCode = MP_MULTIPART then
-  begin
-    while FLines.Count > x do
-    begin
-      s := TrimRight(FLines[x]);
-      Inc(x);
-      FPostPart.Add(s);
-      if not FAttachInside then
-        FAttachInside := IsUUcode(s);
-    end;
-  end;
-end;
-
-{==============================================================================}
-
-procedure TMIMEPart.ComposeParts;
-var
-  n: integer;
-  mime: TMimePart;
-  s, t: string;
-  d1, d2, d3: integer;
-  x: integer;
-begin
-  FLines.Clear;
-  //add headers
-  for n := 0 to FHeaders.Count -1 do
-  begin
-    s := FHeaders[n];
-    repeat
-      if Length(s) < FMaxLineLength then
-      begin
-        t := s;
-        s := '';
-      end
-      else
-      begin
-        d1 := RPosEx('; ', s, FMaxLineLength);
-        d2 := RPosEx(' ', s, FMaxLineLength);
-        d3 := RPosEx(', ', s, FMaxLineLength);
-        if (d1 <= 1) and (d2 <= 1) and (d3 <= 1) then
-        begin
-          x := Pos(' ', Copy(s, 2, Length(s) - 1));
-          if x < 1 then
-            x := Length(s);
-        end
-        else
-          if d1 > 0 then
-            x := d1
-          else
-            if d3 > 0 then
-              x := d3
-            else
-              x := d2 - 1;
-        t := Copy(s, 1, x);
-        Delete(s, 1, x);
-      end;
-      Flines.Add(t);
-    until s = '';
-  end;
-
-  Flines.Add('');
-  //add body
-  //if multipart
-  if FPrimaryCode = MP_MULTIPART then
-  begin
-    Flines.AddStrings(FPrePart);
-    for n := 0 to GetSubPartCount - 1 do
-    begin
-      Flines.Add('--' + FBoundary);
-      mime := GetSubPart(n);
-      mime.ComposeParts;
-      FLines.AddStrings(mime.Lines);
-    end;
-    Flines.Add('--' + FBoundary + '--');
-    Flines.AddStrings(FPostPart);
-  end;
-  //if message
-  if FPrimaryCode = MP_MESSAGE then
-  begin
-    if GetSubPartCount > 0 then
-    begin
-      mime := GetSubPart(0);
-      mime.ComposeParts;
-      FLines.AddStrings(mime.Lines);
-    end;
-  end
-  else
-  //if normal part
-  begin
-    FLines.AddStrings(FPartBody);
-  end;
-end;
-
-{==============================================================================}
-
-procedure TMIMEPart.DecodePart;
-var
-  n: Integer;
-  s, t, t2: string;
-  b: Boolean;
-begin
-  FDecodedLines.Clear;
-  case FEncodingCode of
-    ME_QUOTED_PRINTABLE:
-      s := DecodeQuotedPrintable(FPartBody.Text);
-    ME_BASE64:
-      s := DecodeBase64(FPartBody.Text);
-    ME_UU, ME_XX:
-      begin
-        s := '';
-        for n := 0 to FPartBody.Count - 1 do
-          if FEncodingCode = ME_UU then
-            s := s + DecodeUU(FPartBody[n])
-          else
-            s := s + DecodeXX(FPartBody[n]);
-      end;
-  else
-    s := FPartBody.Text;
-  end;
-  if FConvertCharset and (FPrimaryCode = MP_TEXT) then
-    if (not FForcedHTMLConvert) and (uppercase(FSecondary) = 'HTML') then
-    begin
-      b := false;
-      t2 := uppercase(s);
-      t := SeparateLeft(t2, '</HEAD>');
-      if length(t) <> length(s) then
-      begin
-        t := SeparateRight(t, '<HEAD>');
-        t := ReplaceString(t, '"', '');
-        t := ReplaceString(t, ' ', '');
-        b := Pos('HTTP-EQUIV=CONTENT-TYPE', t) > 0;
-      end;
-      //workaround for shitty M$ Outlook 11 which is placing this information
-      //outside <head> section
-      if not b then
-      begin
-        t := Copy(t2, 1, 2048);
-        t := ReplaceString(t, '"', '');
-        t := ReplaceString(t, ' ', '');
-        b := Pos('HTTP-EQUIV=CONTENT-TYPE', t) > 0;
-      end;
-      if not b then
-        s := CharsetConversion(s, FCharsetCode, FTargetCharset);
-    end
-    else
-      s := CharsetConversion(s, FCharsetCode, FTargetCharset);
-  WriteStrToStream(FDecodedLines, s);
-  FDecodedLines.Seek(0, soFromBeginning);
-end;
-
-{==============================================================================}
-
-procedure TMIMEPart.DecodePartHeader;
-var
-  n: integer;
-  s, su, fn: string;
-  st, st2: string;
-begin
-  Primary := 'text';
-  FSecondary := 'plain';
-  FDescription := '';
-  Charset := FDefaultCharset;
-  FFileName := '';
-  //was 7bit before, but this is more compatible with RFC-ignorant outlook
-  Encoding := '8BIT';
-  FDisposition := '';
-  FContentID := '';
-  fn := '';
-  for n := 0 to FHeaders.Count - 1 do
-    if FHeaders[n] <> '' then
-    begin
-      s := FHeaders[n];
-      su := UpperCase(s);
-      if Pos('CONTENT-TYPE:', su) = 1 then
-      begin
-        st := Trim(SeparateRight(su, ':'));
-        st2 := Trim(SeparateLeft(st, ';'));
-        Primary := Trim(SeparateLeft(st2, '/'));
-        FSecondary := Trim(SeparateRight(st2, '/'));
-        if (FSecondary = Primary) and (Pos('/', st2) < 1) then
-          FSecondary := '';
-        case FPrimaryCode of
-          MP_TEXT:
-            begin
-              Charset := UpperCase(GetParameter(s, 'charset'));
-              FFileName := GetParameter(s, 'name');
-            end;
-          MP_MULTIPART:
-            FBoundary := GetParameter(s, 'Boundary');
-          MP_MESSAGE:
-            begin
-            end;
-          MP_BINARY:
-            FFileName := GetParameter(s, 'name');
-        end;
-      end;
-      if Pos('CONTENT-TRANSFER-ENCODING:', su) = 1 then
-        Encoding := Trim(SeparateRight(su, ':'));
-      if Pos('CONTENT-DESCRIPTION:', su) = 1 then
-        FDescription := Trim(SeparateRight(s, ':'));
-      if Pos('CONTENT-DISPOSITION:', su) = 1 then
-      begin
-        FDisposition := SeparateRight(su, ':');
-        FDisposition := Trim(SeparateLeft(FDisposition, ';'));
-        fn := GetParameter(s, 'FileName');
-      end;
-      if Pos('CONTENT-ID:', su) = 1 then
-        FContentID := Trim(SeparateRight(s, ':'));
-    end;
-  if fn <> '' then
-    FFileName := fn;
-  FFileName := InlineDecode(FFileName, FTargetCharset);
-  FFileName := ExtractFileName(FFileName);
-end;
-
-{==============================================================================}
-
-procedure TMIMEPart.EncodePart;
-var
-  l: TStringList;
-  s, t: string;
-  n, x: Integer;
-  d1, d2: integer;
-begin
-  if (FEncodingCode = ME_UU) or (FEncodingCode = ME_XX) then
-    Encoding := 'base64';
-  l := TStringList.Create;
-  FPartBody.Clear;
-  FDecodedLines.Seek(0, soFromBeginning);
-  try
-    case FPrimaryCode of
-      MP_MULTIPART, MP_MESSAGE:
-        FPartBody.LoadFromStream(FDecodedLines);
-      MP_TEXT, MP_BINARY:
-        begin
-          s := ReadStrFromStream(FDecodedLines, FDecodedLines.Size);
-          if FConvertCharset and (FPrimaryCode = MP_TEXT) and (FEncodingCode <> ME_7BIT) then
-            s := GetBOM(FCharSetCode) + CharsetConversion(s, FTargetCharset, FCharsetCode);
-          if FEncodingCode = ME_BASE64 then
-          begin
-            x := 1;
-            while x <= length(s) do
-            begin
-              t := copy(s, x, 54);
-              x := x + length(t);
-              t := EncodeBase64(t);
-              FPartBody.Add(t);
-            end;
-          end
-          else
-          begin
-            if FPrimaryCode = MP_BINARY then
-              l.Add(s)
-            else
-              l.Text := s;
-            for n := 0 to l.Count - 1 do
-            begin
-              s := l[n];
-              if FEncodingCode = ME_QUOTED_PRINTABLE then
-              begin
-                s := EncodeQuotedPrintable(s);
-                repeat
-                  if Length(s) < FMaxLineLength then
-                  begin
-                    t := s;
-                    s := '';
-                  end
-                  else
-                  begin
-                    d1 := RPosEx('=', s, FMaxLineLength);
-                    d2 := RPosEx(' ', s, FMaxLineLength);
-                    if (d1 = 0) and (d2 = 0) then
-                      x := FMaxLineLength
-                    else
-                      if d1 > d2 then
-                        x := d1 - 1
-                      else
-                        x := d2 - 1;
-                    if x = 0 then
-                      x := FMaxLineLength;
-                    t := Copy(s, 1, x);
-                    Delete(s, 1, x);
-                    if s <> '' then
-                      t := t + '=';
-                  end;
-                  FPartBody.Add(t);
-                until s = '';
-              end
-              else
-                FPartBody.Add(s);
-            end;
-            if (FPrimaryCode = MP_BINARY)
-              and (FEncodingCode = ME_QUOTED_PRINTABLE) then
-              FPartBody[FPartBody.Count - 1] := FPartBody[FPartBody.Count - 1] + '=';
-          end;
-        end;
-    end;
-  finally
-    l.Free;
-  end;
-end;
-
-{==============================================================================}
-
-procedure TMIMEPart.EncodePartHeader;
-var
-  s: string;
-begin
-  FHeaders.Clear;
-  if FSecondary = '' then
-    case FPrimaryCode of
-      MP_TEXT:
-        FSecondary := 'plain';
-      MP_MULTIPART:
-        FSecondary := 'mixed';
-      MP_MESSAGE:
-        FSecondary := 'rfc822';
-      MP_BINARY:
-        FSecondary := 'octet-stream';
-    end;
-  if FDescription <> '' then
-    FHeaders.Insert(0, 'Content-Description: ' + FDescription);
-  if FDisposition <> '' then
-  begin
-    s := '';
-    if FFileName <> '' then
-      s := '; FileName=' + QuoteStr(InlineCodeEx(FileName, FTargetCharset), '"');
-    FHeaders.Insert(0, 'Content-Disposition: ' + LowerCase(FDisposition) + s);
-  end;
-  if FContentID <> '' then
-    FHeaders.Insert(0, 'Content-ID: ' + FContentID);
-
-  case FEncodingCode of
-    ME_7BIT:
-      s := '7bit';
-    ME_8BIT:
-      s := '8bit';
-    ME_QUOTED_PRINTABLE:
-      s := 'Quoted-printable';
-    ME_BASE64:
-      s := 'Base64';
-  end;
-  case FPrimaryCode of
-    MP_TEXT,
-      MP_BINARY: FHeaders.Insert(0, 'Content-Transfer-Encoding: ' + s);
-  end;
-  case FPrimaryCode of
-    MP_TEXT:
-      s := FPrimary + '/' + FSecondary + '; charset=' + GetIDfromCP(FCharsetCode);
-    MP_MULTIPART:
-      s := FPrimary + '/' + FSecondary + '; boundary="' + FBoundary + '"';
-    MP_MESSAGE, MP_BINARY:
-      s := FPrimary + '/' + FSecondary;
-  end;
-  if FFileName <> '' then
-    s := s + '; name=' + QuoteStr(InlineCodeEx(FileName, FTargetCharset), '"');
-  FHeaders.Insert(0, 'Content-type: ' + s);
-end;
-
-{==============================================================================}
-
-procedure TMIMEPart.MimeTypeFromExt(Value: string);
-var
-  s: string;
-  n: Integer;
-begin
-  Primary := '';
-  FSecondary := '';
-  s := UpperCase(ExtractFileExt(Value));
-  if s = '' then
-    s := UpperCase(Value);
-  s := SeparateRight(s, '.');
-  for n := 0 to MaxMimeType do
-    if MimeType[n, 0] = s then
-    begin
-      Primary := MimeType[n, 1];
-      FSecondary := MimeType[n, 2];
-      Break;
-    end;
-  if Primary = '' then
-    Primary := 'application';
-  if FSecondary = '' then
-    FSecondary := 'octet-stream';
-end;
-
-{==============================================================================}
-
-procedure TMIMEPart.WalkPart;
-var
-  n: integer;
-  m: TMimepart;
-begin
-  if assigned(OnWalkPart) then
-  begin
-    OnWalkPart(self);
-    for n := 0 to GetSubPartCount - 1 do
-    begin
-      m := GetSubPart(n);
-      m.OnWalkPart := OnWalkPart;
-      m.WalkPart;
-    end;
-  end;
-end;
-
-{==============================================================================}
-
-procedure TMIMEPart.SetPrimary(Value: string);
-var
-  s: string;
-begin
-  FPrimary := Value;
-  s := UpperCase(Value);
-  FPrimaryCode := MP_BINARY;
-  if Pos('TEXT', s) = 1 then
-    FPrimaryCode := MP_TEXT;
-  if Pos('MULTIPART', s) = 1 then
-    FPrimaryCode := MP_MULTIPART;
-  if Pos('MESSAGE', s) = 1 then
-    FPrimaryCode := MP_MESSAGE;
-end;
-
-procedure TMIMEPart.SetEncoding(Value: string);
-var
-  s: string;
-begin
-  FEncoding := Value;
-  s := UpperCase(Value);
-  FEncodingCode := ME_7BIT;
-  if Pos('8BIT', s) = 1 then
-    FEncodingCode := ME_8BIT;
-  if Pos('QUOTED-PRINTABLE', s) = 1 then
-    FEncodingCode := ME_QUOTED_PRINTABLE;
-  if Pos('BASE64', s) = 1 then
-    FEncodingCode := ME_BASE64;
-  if Pos('X-UU', s) = 1 then
-    FEncodingCode := ME_UU;
-  if Pos('X-XX', s) = 1 then
-    FEncodingCode := ME_XX;
-end;
-
-procedure TMIMEPart.SetCharset(Value: string);
-begin
-  if value <> '' then
-  begin
-    FCharset := Value;
-    FCharsetCode := GetCPFromID(Value);
-  end;
-end;
-
-function TMIMEPart.CanSubPart: boolean;
-begin
-  Result := True;
-  if FMaxSubLevel <> -1 then
-    Result := FMaxSubLevel > FSubLevel;
-end;
-
-function TMIMEPart.IsUUcode(Value: string): boolean;
-begin
-  Value := UpperCase(Value);
-  Result := (pos('BEGIN ', Value) = 1) and (Trim(SeparateRight(Value, ' ')) <> '');
-end;
-
-{==============================================================================}
-
-function GenerateBoundary: string;
-var
-  x, y: Integer;
-begin
-  y := GetTick;
-  x := y;
-  while TickDelta(y, x) = 0 do
-  begin
-    Sleep(1);
-    x := GetTick;
-  end;
-  Randomize;
-  y := Random(MaxInt);
-  Result := IntToHex(x, 8) + '_' + IntToHex(y, 8) + '_Synapse_boundary';
-end;
-
-end.
+{==============================================================================|
+| Project : Ararat Synapse                                       | 002.008.000 |
+|==============================================================================|
+| Content: MIME support procedures and functions                               |
+|==============================================================================|
+| Copyright (c)1999-2008, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2000-2008.                |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@abstract(MIME part handling)
+Handling with MIME parts.
+
+Used RFC: RFC-2045
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+{$Q-}
+{$R-}
+
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit mimepart;
+
+interface
+
+uses
+  SysUtils, Classes,
+  synafpc,
+  synachar, synacode, synautil, mimeinln;
+
+type
+
+  TMimePart = class;
+
+  {:@abstract(Procedural type for @link(TMimepart.Walkpart) hook). This hook is used for
+   easy walking through MIME subparts.}
+  THookWalkPart = procedure(const Sender: TMimePart) of object;
+
+  {:The four types of MIME parts. (textual, multipart, message or any other
+   binary data.)}
+  TMimePrimary = (MP_TEXT, MP_MULTIPART, MP_MESSAGE, MP_BINARY);
+
+  {:The various types of possible part encodings.}
+  TMimeEncoding = (ME_7BIT, ME_8BIT, ME_QUOTED_PRINTABLE,
+    ME_BASE64, ME_UU, ME_XX);
+
+  {:@abstract(Object for working with parts of MIME e-mail.)
+   Each TMimePart object can handle any number of nested subparts as new
+   TMimepart objects. It can handle any tree hierarchy structure of nested MIME
+   subparts itself.
+
+   Basic tasks are:
+
+   Decoding of MIME message:
+   - store message into Lines property
+   - call DecomposeParts. Now you have decomposed MIME parts in all nested levels!
+   - now you can explore all properties and subparts. (You can use WalkPart method)
+   - if you need decode part, call DecodePart.
+
+   Encoding of MIME message:
+
+   - if you need multipart message, you must create subpart by AddSubPart.
+   - set all properties of all parts.
+   - set content of part into DecodedLines stream
+   - encode this stream by EncodePart.
+   - compose full message by ComposeParts. (it build full MIME message from all subparts. Do not call this method for each subpart! It is needed on root part!)
+   - encoded MIME message is stored in Lines property.
+  }
+  TMimePart = class(TObject)
+  private
+    FPrimary: string;
+    FPrimaryCode: TMimePrimary;
+    FSecondary: string;
+    FEncoding: string;
+    FEncodingCode: TMimeEncoding;
+    FDefaultCharset: string;
+    FCharset: string;
+    FCharsetCode: TMimeChar;
+    FTargetCharset: TMimeChar;
+    FDescription: string;
+    FDisposition: string;
+    FContentID: string;
+    FBoundary: string;
+    FFileName: string;
+    FLines: TStringList;
+    FPartBody: TStringList;
+    FHeaders: TStringList;
+    FPrePart: TStringList;
+    FPostPart: TStringList;
+    FDecodedLines: TMemoryStream;
+    FSubParts: TList;
+    FOnWalkPart: THookWalkPart;
+    FMaxLineLength: integer;
+    FSubLevel: integer;
+    FMaxSubLevel: integer;
+    FAttachInside: boolean;
+    FConvertCharset: Boolean;
+    FForcedHTMLConvert: Boolean;
+    procedure SetPrimary(Value: string);
+    procedure SetEncoding(Value: string);
+    procedure SetCharset(Value: string);
+    function IsUUcode(Value: string): boolean;
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    {:Assign content of another object to this object. (Only this part,
+     not subparts!)}
+    procedure Assign(Value: TMimePart);
+
+    {:Assign content of another object to this object. (With all subparts!)}
+    procedure AssignSubParts(Value: TMimePart);
+
+    {:Clear all data values to default values. It also call @link(ClearSubparts).}
+    procedure Clear;
+
+    {:Decode Mime part from @link(Lines) to @link(DecodedLines).}
+    procedure DecodePart;
+
+    {:Parse header lines from Headers property into another properties.}
+    procedure DecodePartHeader;
+
+    {:Encode mime part from @link(DecodedLines) to @link(Lines) and build mime
+     headers.}
+    procedure EncodePart;
+
+    {:Build header lines in Headers property from another properties.}
+    procedure EncodePartHeader;
+
+    {:generate primary and secondary mime type from filename extension in value.
+     If type not recognised, it return 'Application/octet-string' type.}
+    procedure MimeTypeFromExt(Value: string);
+
+    {:Return number of decomposed subparts. (On this level! Each of this
+     subparts can hold any number of their own nested subparts!)}
+    function GetSubPartCount: integer;
+
+    {:Get nested subpart object as new TMimePart. For getting maximum possible
+     index you can use @link(GetSubPartCount) method.}
+    function GetSubPart(index: integer): TMimePart;
+
+    {:delete subpart on given index.}
+    procedure DeleteSubPart(index: integer);
+
+    {:Clear and destroy all subpart TMimePart objects.}
+    procedure ClearSubParts;
+
+    {:Add and create new subpart.}
+    function AddSubPart: TMimePart;
+
+    {:E-mail message in @link(Lines) property is parsed into this object.
+     E-mail headers are stored in @link(Headers) property and is parsed into
+     another properties automaticly. Not need call @link(DecodePartHeader)!
+     Content of message (part) is stored into @link(PartBody) property. This
+     part is in undecoded form! If you need decode it, then you must call
+     @link(DecodePart) method by your hands. Lot of another properties is filled
+     also.
+
+     Decoding of parts you must call separately due performance reasons. (Not
+     needed to decode all parts in all reasons.)
+
+     For each MIME subpart is created new TMimepart object (accessible via
+     method @link(GetSubPart)).}
+    procedure DecomposeParts;
+
+    {:This part and all subparts is composed into one MIME message stored in
+     @link(Lines) property.}
+    procedure ComposeParts;
+
+    {:By calling this method is called @link(OnWalkPart) event for each part
+     and their subparts. It is very good for calling some code for each part in
+     MIME message}
+    procedure WalkPart;
+
+    {:Return @true when is possible create next subpart. (@link(maxSublevel)
+     is still not reached)}
+    function CanSubPart: boolean;
+  published
+    {:Primary Mime type of part. (i.e. 'application') Writing to this property
+     automaticly generate value of @link(PrimaryCode).}
+    property Primary: string read FPrimary write SetPrimary;
+
+    {:String representation of used Mime encoding in part. (i.e. 'base64')
+     Writing to this property automaticly generate value of @link(EncodingCode).}
+    property Encoding: string read FEncoding write SetEncoding;
+
+    {:String representation of used Mime charset in part. (i.e. 'iso-8859-1')
+     Writing to this property automaticly generate value of @link(CharsetCode).
+     Charset is used only for text parts.}
+    property Charset: string read FCharset write SetCharset;
+
+    {:Define default charset for decoding text MIME parts without charset
+     specification. Default value is 'ISO-8859-1' by RCF documents.
+     But Microsoft Outlook use windows codings as default. This property allows
+     properly decode textual parts from some broken versions of Microsoft
+     Outlook. (this is bad software!)}
+    property DefaultCharset: string read FDefaultCharset write FDefaultCharset;
+
+    {:Decoded primary type. Possible values are: MP_TEXT, MP_MULTIPART,
+     MP_MESSAGE and MP_BINARY. If type not recognised, result is MP_BINARY.}
+    property PrimaryCode: TMimePrimary read FPrimaryCode Write FPrimaryCode;
+
+    {:Decoded encoding type. Possible values are: ME_7BIT, ME_8BIT,
+     ME_QUOTED_PRINTABLE and ME_BASE64. If type not recognised, result is
+     ME_7BIT.}
+    property EncodingCode: TMimeEncoding read FEncodingCode Write FEncodingCode;
+
+    {:Decoded charset type. Possible values are defined in @link(SynaChar) unit.}
+    property CharsetCode: TMimeChar read FCharsetCode Write FCharsetCode;
+
+    {:System charset type. Default value is charset used by default in your
+     operating system.}
+    property TargetCharset: TMimeChar read FTargetCharset Write FTargetCharset;
+
+    {:If @true, then do internal charset translation of part content between @link(CharsetCode)
+     and @link(TargetCharset)}
+    property ConvertCharset: Boolean read FConvertCharset Write FConvertCharset;
+
+    {:If @true, then allways do internal charset translation of HTML parts
+     by MIME even it have their own charset in META tag. Default is @false.}
+    property ForcedHTMLConvert: Boolean read FForcedHTMLConvert Write FForcedHTMLConvert;
+
+    {:Secondary Mime type of part. (i.e. 'mixed')}
+    property Secondary: string read FSecondary Write FSecondary;
+
+    {:Description of Mime part.}
+    property Description: string read FDescription Write FDescription;
+
+    {:Value of content disposition field. (i.e. 'inline' or 'attachment')}
+    property Disposition: string read FDisposition Write FDisposition;
+
+    {:Content ID.}
+    property ContentID: string read FContentID Write FContentID;
+
+    {:Boundary delimiter of multipart Mime part. Used only in multipart part.}
+    property Boundary: string read FBoundary Write FBoundary;
+
+    {:Filename of file in binary part.}
+    property FileName: string read FFileName Write FFileName;
+
+    {:String list with lines contains mime part (It can be a full message).}
+    property Lines: TStringList read FLines;
+
+    {:Encoded form of MIME part data.}
+    property PartBody: TStringList read FPartBody;
+
+    {:All header lines of MIME part.}
+    property Headers: TStringList read FHeaders;
+
+    {:On multipart this contains part of message between first line of message
+     and first boundary.}
+    property PrePart: TStringList read FPrePart;
+
+    {:On multipart this contains part of message between last boundary and end
+     of message.}
+    property PostPart: TStringList read FPostPart;
+
+    {:Stream with decoded form of budy part.}
+    property DecodedLines: TMemoryStream read FDecodedLines;
+
+    {:Show nested level in subpart tree. Value 0 means root part. 1 means
+     subpart from this root. etc.}
+    property SubLevel: integer read FSubLevel write FSubLevel;
+
+    {:Specify maximum sublevel value for decomposing.}
+    property MaxSubLevel: integer read FMaxSubLevel write FMaxSubLevel;
+
+    {:When is @true, then this part maybe(!) have included some uuencoded binary
+    data.}
+    property AttachInside: boolean read FAttachInside;
+
+    {:Here you can assign hook procedure for walking through all part and their
+     subparts.}
+    property OnWalkPart: THookWalkPart read FOnWalkPart write FOnWalkPart;
+
+    {:Here you can specify maximum line length for encoding of MIME part.
+     If line is longer, then is splitted by standard of MIME. Correct MIME
+     mailers can de-split this line into original length.}
+    property MaxLineLength: integer read FMaxLineLength Write FMaxLineLength;
+  end;
+
+const
+  MaxMimeType = 25;
+  MimeType: array[0..MaxMimeType, 0..2] of string =
+  (
+    ('AU', 'audio', 'basic'),
+    ('AVI', 'video', 'x-msvideo'),
+    ('BMP', 'image', 'BMP'),
+    ('DOC', 'application', 'MSWord'),
+    ('EPS', 'application', 'Postscript'),
+    ('GIF', 'image', 'GIF'),
+    ('JPEG', 'image', 'JPEG'),
+    ('JPG', 'image', 'JPEG'),
+    ('MID', 'audio', 'midi'),
+    ('MOV', 'video', 'quicktime'),
+    ('MPEG', 'video', 'MPEG'),
+    ('MPG', 'video', 'MPEG'),
+    ('MP2', 'audio', 'mpeg'),
+    ('MP3', 'audio', 'mpeg'),
+    ('PDF', 'application', 'PDF'),
+    ('PNG', 'image', 'PNG'),
+    ('PS', 'application', 'Postscript'),
+    ('QT', 'video', 'quicktime'),
+    ('RA', 'audio', 'x-realaudio'),
+    ('RTF', 'application', 'RTF'),
+    ('SND', 'audio', 'basic'),
+    ('TIF', 'image', 'TIFF'),
+    ('TIFF', 'image', 'TIFF'),
+    ('WAV', 'audio', 'x-wav'),
+    ('WPD', 'application', 'Wordperfect5.1'),
+    ('ZIP', 'application', 'ZIP')
+    );
+
+{:Generates a unique boundary string.}
+function GenerateBoundary: string;
+
+implementation
+
+{==============================================================================}
+
+constructor TMIMEPart.Create;
+begin
+  inherited Create;
+  FOnWalkPart := nil;
+  FLines := TStringList.Create;
+  FPartBody := TStringList.Create;
+  FHeaders := TStringList.Create;
+  FPrePart := TStringList.Create;
+  FPostPart := TStringList.Create;
+  FDecodedLines := TMemoryStream.Create;
+  FSubParts := TList.Create;
+  FTargetCharset := GetCurCP;
+  //was 'US-ASCII' before, but RFC-ignorant Outlook sometimes using default
+  //system charset instead.
+  FDefaultCharset := GetIDFromCP(GetCurCP);
+  FMaxLineLength := 78;
+  FSubLevel := 0;
+  FMaxSubLevel := -1;
+  FAttachInside := false;
+  FConvertCharset := true;
+  FForcedHTMLConvert := false;
+end;
+
+destructor TMIMEPart.Destroy;
+begin
+  ClearSubParts;
+  FSubParts.Free;
+  FDecodedLines.Free;
+  FPartBody.Free;
+  FLines.Free;
+  FHeaders.Free;
+  FPrePart.Free;
+  FPostPart.Free;
+  inherited Destroy;
+end;
+
+{==============================================================================}
+
+procedure TMIMEPart.Clear;
+begin
+  FPrimary := '';
+  FEncoding := '';
+  FCharset := '';
+  FPrimaryCode := MP_TEXT;
+  FEncodingCode := ME_7BIT;
+  FCharsetCode := ISO_8859_1;
+  FTargetCharset := GetCurCP;
+  FSecondary := '';
+  FDisposition := '';
+  FContentID := '';
+  FDescription := '';
+  FBoundary := '';
+  FFileName := '';
+  FAttachInside := False;
+  FPartBody.Clear;
+  FHeaders.Clear;
+  FPrePart.Clear;
+  FPostPart.Clear;
+  FDecodedLines.Clear;
+  FConvertCharset := true;
+  FForcedHTMLConvert := false;
+  ClearSubParts;
+end;
+
+{==============================================================================}
+
+procedure TMIMEPart.Assign(Value: TMimePart);
+begin
+  Primary := Value.Primary;
+  Encoding := Value.Encoding;
+  Charset := Value.Charset;
+  DefaultCharset := Value.DefaultCharset;
+  PrimaryCode := Value.PrimaryCode;
+  EncodingCode := Value.EncodingCode;
+  CharsetCode := Value.CharsetCode;
+  TargetCharset := Value.TargetCharset;
+  Secondary := Value.Secondary;
+  Description := Value.Description;
+  Disposition := Value.Disposition;
+  ContentID := Value.ContentID;
+  Boundary := Value.Boundary;
+  FileName := Value.FileName;
+  Lines.Assign(Value.Lines);
+  PartBody.Assign(Value.PartBody);
+  Headers.Assign(Value.Headers);
+  PrePart.Assign(Value.PrePart);
+  PostPart.Assign(Value.PostPart);
+  MaxLineLength := Value.MaxLineLength;
+  FAttachInside := Value.AttachInside;
+  FConvertCharset := Value.ConvertCharset;
+end;
+
+{==============================================================================}
+
+procedure TMIMEPart.AssignSubParts(Value: TMimePart);
+var
+  n: integer;
+  p: TMimePart;
+begin
+  Assign(Value);
+  for n := 0 to Value.GetSubPartCount - 1 do
+  begin
+    p := AddSubPart;
+    p.AssignSubParts(Value.GetSubPart(n));
+  end;
+end;
+
+{==============================================================================}
+
+function TMIMEPart.GetSubPartCount: integer;
+begin
+  Result :=  FSubParts.Count;
+end;
+
+{==============================================================================}
+
+function TMIMEPart.GetSubPart(index: integer): TMimePart;
+begin
+  Result := nil;
+  if Index < GetSubPartCount then
+    Result := TMimePart(FSubParts[Index]);
+end;
+
+{==============================================================================}
+
+procedure TMIMEPart.DeleteSubPart(index: integer);
+begin
+  if Index < GetSubPartCount then
+  begin
+    GetSubPart(Index).Free;
+    FSubParts.Delete(Index);
+  end;
+end;
+
+{==============================================================================}
+
+procedure TMIMEPart.ClearSubParts;
+var
+  n: integer;
+begin
+  for n := 0 to GetSubPartCount - 1 do
+    TMimePart(FSubParts[n]).Free;
+  FSubParts.Clear;
+end;
+
+{==============================================================================}
+
+function TMIMEPart.AddSubPart: TMimePart;
+begin
+  Result := TMimePart.Create;
+  Result.DefaultCharset := FDefaultCharset;
+  FSubParts.Add(Result);
+  Result.SubLevel := FSubLevel + 1;
+  Result.MaxSubLevel := FMaxSubLevel;  
+end;
+
+{==============================================================================}
+
+procedure TMIMEPart.DecomposeParts;
+var
+  x: integer;
+  s: string;
+  Mime: TMimePart;
+
+  procedure SkipEmpty;
+  begin
+    while FLines.Count > x do
+    begin
+      s := TrimRight(FLines[x]);
+      if s <> '' then
+        Break;
+      Inc(x);
+    end;
+  end;
+
+begin
+  x := 0;
+  Clear;
+  //extract headers
+  while FLines.Count > x do
+  begin
+    s := NormalizeHeader(FLines, x);
+    if s = '' then
+      Break;
+    FHeaders.Add(s);
+  end;
+  DecodePartHeader;
+  //extract prepart
+  if FPrimaryCode = MP_MULTIPART then
+  begin
+    while FLines.Count > x do
+    begin
+      s := FLines[x];
+      Inc(x);
+      if TrimRight(s) = '--' + FBoundary then
+        Break;
+      FPrePart.Add(s);
+      if not FAttachInside then
+        FAttachInside := IsUUcode(s);
+    end;
+  end;
+  //extract body part
+  if FPrimaryCode = MP_MULTIPART then
+  begin
+    repeat
+      if CanSubPart then
+      begin
+        Mime := AddSubPart;
+        while FLines.Count > x do
+        begin
+          s := FLines[x];
+          Inc(x);
+          if Pos('--' + FBoundary, s) = 1 then
+            Break;
+          Mime.Lines.Add(s);
+        end;
+        Mime.DecomposeParts;
+      end
+      else
+      begin
+        s := FLines[x];
+        Inc(x);
+        FPartBody.Add(s);
+      end;
+      if x >= FLines.Count then
+        break;
+    until s = '--' + FBoundary + '--';
+  end;
+  if (FPrimaryCode = MP_MESSAGE) and CanSubPart then
+  begin
+    Mime := AddSubPart;
+    SkipEmpty;
+    while FLines.Count > x do
+    begin
+      s := TrimRight(FLines[x]);
+      Inc(x);
+      Mime.Lines.Add(s);
+    end;
+    Mime.DecomposeParts;
+  end
+  else
+  begin
+    while FLines.Count > x do
+    begin
+      s := FLines[x];
+      Inc(x);
+      FPartBody.Add(s);
+      if not FAttachInside then
+        FAttachInside := IsUUcode(s);
+    end;
+  end;
+  //extract postpart
+  if FPrimaryCode = MP_MULTIPART then
+  begin
+    while FLines.Count > x do
+    begin
+      s := TrimRight(FLines[x]);
+      Inc(x);
+      FPostPart.Add(s);
+      if not FAttachInside then
+        FAttachInside := IsUUcode(s);
+    end;
+  end;
+end;
+
+{==============================================================================}
+
+procedure TMIMEPart.ComposeParts;
+var
+  n: integer;
+  mime: TMimePart;
+  s, t: string;
+  d1, d2, d3: integer;
+  x: integer;
+begin
+  FLines.Clear;
+  //add headers
+  for n := 0 to FHeaders.Count -1 do
+  begin
+    s := FHeaders[n];
+    repeat
+      if Length(s) < FMaxLineLength then
+      begin
+        t := s;
+        s := '';
+      end
+      else
+      begin
+        d1 := RPosEx('; ', s, FMaxLineLength);
+        d2 := RPosEx(' ', s, FMaxLineLength);
+        d3 := RPosEx(', ', s, FMaxLineLength);
+        if (d1 <= 1) and (d2 <= 1) and (d3 <= 1) then
+        begin
+          x := Pos(' ', Copy(s, 2, Length(s) - 1));
+          if x < 1 then
+            x := Length(s);
+        end
+        else
+          if d1 > 0 then
+            x := d1
+          else
+            if d3 > 0 then
+              x := d3
+            else
+              x := d2 - 1;
+        t := Copy(s, 1, x);
+        Delete(s, 1, x);
+      end;
+      Flines.Add(t);
+    until s = '';
+  end;
+
+  Flines.Add('');
+  //add body
+  //if multipart
+  if FPrimaryCode = MP_MULTIPART then
+  begin
+    Flines.AddStrings(FPrePart);
+    for n := 0 to GetSubPartCount - 1 do
+    begin
+      Flines.Add('--' + FBoundary);
+      mime := GetSubPart(n);
+      mime.ComposeParts;
+      FLines.AddStrings(mime.Lines);
+    end;
+    Flines.Add('--' + FBoundary + '--');
+    Flines.AddStrings(FPostPart);
+  end;
+  //if message
+  if FPrimaryCode = MP_MESSAGE then
+  begin
+    if GetSubPartCount > 0 then
+    begin
+      mime := GetSubPart(0);
+      mime.ComposeParts;
+      FLines.AddStrings(mime.Lines);
+    end;
+  end
+  else
+  //if normal part
+  begin
+    FLines.AddStrings(FPartBody);
+  end;
+end;
+
+{==============================================================================}
+
+procedure TMIMEPart.DecodePart;
+var
+  n: Integer;
+  s, t, t2: string;
+  b: Boolean;
+begin
+  FDecodedLines.Clear;
+  case FEncodingCode of
+    ME_QUOTED_PRINTABLE:
+      s := DecodeQuotedPrintable(FPartBody.Text);
+    ME_BASE64:
+      s := DecodeBase64(FPartBody.Text);
+    ME_UU, ME_XX:
+      begin
+        s := '';
+        for n := 0 to FPartBody.Count - 1 do
+          if FEncodingCode = ME_UU then
+            s := s + DecodeUU(FPartBody[n])
+          else
+            s := s + DecodeXX(FPartBody[n]);
+      end;
+  else
+    s := FPartBody.Text;
+  end;
+  if FConvertCharset and (FPrimaryCode = MP_TEXT) then
+    if (not FForcedHTMLConvert) and (uppercase(FSecondary) = 'HTML') then
+    begin
+      b := false;
+      t2 := uppercase(s);
+      t := SeparateLeft(t2, '</HEAD>');
+      if length(t) <> length(s) then
+      begin
+        t := SeparateRight(t, '<HEAD>');
+        t := ReplaceString(t, '"', '');
+        t := ReplaceString(t, ' ', '');
+        b := Pos('HTTP-EQUIV=CONTENT-TYPE', t) > 0;
+      end;
+      //workaround for shitty M$ Outlook 11 which is placing this information
+      //outside <head> section
+      if not b then
+      begin
+        t := Copy(t2, 1, 2048);
+        t := ReplaceString(t, '"', '');
+        t := ReplaceString(t, ' ', '');
+        b := Pos('HTTP-EQUIV=CONTENT-TYPE', t) > 0;
+      end;
+      if not b then
+        s := CharsetConversion(s, FCharsetCode, FTargetCharset);
+    end
+    else
+      s := CharsetConversion(s, FCharsetCode, FTargetCharset);
+  WriteStrToStream(FDecodedLines, s);
+  FDecodedLines.Seek(0, soFromBeginning);
+end;
+
+{==============================================================================}
+
+procedure TMIMEPart.DecodePartHeader;
+var
+  n: integer;
+  s, su, fn: string;
+  st, st2: string;
+begin
+  Primary := 'text';
+  FSecondary := 'plain';
+  FDescription := '';
+  Charset := FDefaultCharset;
+  FFileName := '';
+  //was 7bit before, but this is more compatible with RFC-ignorant outlook
+  Encoding := '8BIT';
+  FDisposition := '';
+  FContentID := '';
+  fn := '';
+  for n := 0 to FHeaders.Count - 1 do
+    if FHeaders[n] <> '' then
+    begin
+      s := FHeaders[n];
+      su := UpperCase(s);
+      if Pos('CONTENT-TYPE:', su) = 1 then
+      begin
+        st := Trim(SeparateRight(su, ':'));
+        st2 := Trim(SeparateLeft(st, ';'));
+        Primary := Trim(SeparateLeft(st2, '/'));
+        FSecondary := Trim(SeparateRight(st2, '/'));
+        if (FSecondary = Primary) and (Pos('/', st2) < 1) then
+          FSecondary := '';
+        case FPrimaryCode of
+          MP_TEXT:
+            begin
+              Charset := UpperCase(GetParameter(s, 'charset'));
+              FFileName := GetParameter(s, 'name');
+            end;
+          MP_MULTIPART:
+            FBoundary := GetParameter(s, 'Boundary');
+          MP_MESSAGE:
+            begin
+            end;
+          MP_BINARY:
+            FFileName := GetParameter(s, 'name');
+        end;
+      end;
+      if Pos('CONTENT-TRANSFER-ENCODING:', su) = 1 then
+        Encoding := Trim(SeparateRight(su, ':'));
+      if Pos('CONTENT-DESCRIPTION:', su) = 1 then
+        FDescription := Trim(SeparateRight(s, ':'));
+      if Pos('CONTENT-DISPOSITION:', su) = 1 then
+      begin
+        FDisposition := SeparateRight(su, ':');
+        FDisposition := Trim(SeparateLeft(FDisposition, ';'));
+        fn := GetParameter(s, 'FileName');
+      end;
+      if Pos('CONTENT-ID:', su) = 1 then
+        FContentID := Trim(SeparateRight(s, ':'));
+    end;
+  if fn <> '' then
+    FFileName := fn;
+  FFileName := InlineDecode(FFileName, FTargetCharset);
+  FFileName := ExtractFileName(FFileName);
+end;
+
+{==============================================================================}
+
+procedure TMIMEPart.EncodePart;
+var
+  l: TStringList;
+  s, t: string;
+  n, x: Integer;
+  d1, d2: integer;
+begin
+  if (FEncodingCode = ME_UU) or (FEncodingCode = ME_XX) then
+    Encoding := 'base64';
+  l := TStringList.Create;
+  FPartBody.Clear;
+  FDecodedLines.Seek(0, soFromBeginning);
+  try
+    case FPrimaryCode of
+      MP_MULTIPART, MP_MESSAGE:
+        FPartBody.LoadFromStream(FDecodedLines);
+      MP_TEXT, MP_BINARY:
+        begin
+          s := ReadStrFromStream(FDecodedLines, FDecodedLines.Size);
+          if FConvertCharset and (FPrimaryCode = MP_TEXT) and (FEncodingCode <> ME_7BIT) then
+            s := GetBOM(FCharSetCode) + CharsetConversion(s, FTargetCharset, FCharsetCode);
+          if FEncodingCode = ME_BASE64 then
+          begin
+            x := 1;
+            while x <= length(s) do
+            begin
+              t := copy(s, x, 54);
+              x := x + length(t);
+              t := EncodeBase64(t);
+              FPartBody.Add(t);
+            end;
+          end
+          else
+          begin
+            if FPrimaryCode = MP_BINARY then
+              l.Add(s)
+            else
+              l.Text := s;
+            for n := 0 to l.Count - 1 do
+            begin
+              s := l[n];
+              if FEncodingCode = ME_QUOTED_PRINTABLE then
+              begin
+                s := EncodeQuotedPrintable(s);
+                repeat
+                  if Length(s) < FMaxLineLength then
+                  begin
+                    t := s;
+                    s := '';
+                  end
+                  else
+                  begin
+                    d1 := RPosEx('=', s, FMaxLineLength);
+                    d2 := RPosEx(' ', s, FMaxLineLength);
+                    if (d1 = 0) and (d2 = 0) then
+                      x := FMaxLineLength
+                    else
+                      if d1 > d2 then
+                        x := d1 - 1
+                      else
+                        x := d2 - 1;
+                    if x = 0 then
+                      x := FMaxLineLength;
+                    t := Copy(s, 1, x);
+                    Delete(s, 1, x);
+                    if s <> '' then
+                      t := t + '=';
+                  end;
+                  FPartBody.Add(t);
+                until s = '';
+              end
+              else
+                FPartBody.Add(s);
+            end;
+            if (FPrimaryCode = MP_BINARY)
+              and (FEncodingCode = ME_QUOTED_PRINTABLE) then
+              FPartBody[FPartBody.Count - 1] := FPartBody[FPartBody.Count - 1] + '=';
+          end;
+        end;
+    end;
+  finally
+    l.Free;
+  end;
+end;
+
+{==============================================================================}
+
+procedure TMIMEPart.EncodePartHeader;
+var
+  s: string;
+begin
+  FHeaders.Clear;
+  if FSecondary = '' then
+    case FPrimaryCode of
+      MP_TEXT:
+        FSecondary := 'plain';
+      MP_MULTIPART:
+        FSecondary := 'mixed';
+      MP_MESSAGE:
+        FSecondary := 'rfc822';
+      MP_BINARY:
+        FSecondary := 'octet-stream';
+    end;
+  if FDescription <> '' then
+    FHeaders.Insert(0, 'Content-Description: ' + FDescription);
+  if FDisposition <> '' then
+  begin
+    s := '';
+    if FFileName <> '' then
+      s := '; FileName=' + QuoteStr(InlineCodeEx(FileName, FTargetCharset), '"');
+    FHeaders.Insert(0, 'Content-Disposition: ' + LowerCase(FDisposition) + s);
+  end;
+  if FContentID <> '' then
+    FHeaders.Insert(0, 'Content-ID: ' + FContentID);
+
+  case FEncodingCode of
+    ME_7BIT:
+      s := '7bit';
+    ME_8BIT:
+      s := '8bit';
+    ME_QUOTED_PRINTABLE:
+      s := 'Quoted-printable';
+    ME_BASE64:
+      s := 'Base64';
+  end;
+  case FPrimaryCode of
+    MP_TEXT,
+      MP_BINARY: FHeaders.Insert(0, 'Content-Transfer-Encoding: ' + s);
+  end;
+  case FPrimaryCode of
+    MP_TEXT:
+      s := FPrimary + '/' + FSecondary + '; charset=' + GetIDfromCP(FCharsetCode);
+    MP_MULTIPART:
+      s := FPrimary + '/' + FSecondary + '; boundary="' + FBoundary + '"';
+    MP_MESSAGE, MP_BINARY:
+      s := FPrimary + '/' + FSecondary;
+  end;
+  if FFileName <> '' then
+    s := s + '; name=' + QuoteStr(InlineCodeEx(FileName, FTargetCharset), '"');
+  FHeaders.Insert(0, 'Content-type: ' + s);
+end;
+
+{==============================================================================}
+
+procedure TMIMEPart.MimeTypeFromExt(Value: string);
+var
+  s: string;
+  n: Integer;
+begin
+  Primary := '';
+  FSecondary := '';
+  s := UpperCase(ExtractFileExt(Value));
+  if s = '' then
+    s := UpperCase(Value);
+  s := SeparateRight(s, '.');
+  for n := 0 to MaxMimeType do
+    if MimeType[n, 0] = s then
+    begin
+      Primary := MimeType[n, 1];
+      FSecondary := MimeType[n, 2];
+      Break;
+    end;
+  if Primary = '' then
+    Primary := 'application';
+  if FSecondary = '' then
+    FSecondary := 'octet-stream';
+end;
+
+{==============================================================================}
+
+procedure TMIMEPart.WalkPart;
+var
+  n: integer;
+  m: TMimepart;
+begin
+  if assigned(OnWalkPart) then
+  begin
+    OnWalkPart(self);
+    for n := 0 to GetSubPartCount - 1 do
+    begin
+      m := GetSubPart(n);
+      m.OnWalkPart := OnWalkPart;
+      m.WalkPart;
+    end;
+  end;
+end;
+
+{==============================================================================}
+
+procedure TMIMEPart.SetPrimary(Value: string);
+var
+  s: string;
+begin
+  FPrimary := Value;
+  s := UpperCase(Value);
+  FPrimaryCode := MP_BINARY;
+  if Pos('TEXT', s) = 1 then
+    FPrimaryCode := MP_TEXT;
+  if Pos('MULTIPART', s) = 1 then
+    FPrimaryCode := MP_MULTIPART;
+  if Pos('MESSAGE', s) = 1 then
+    FPrimaryCode := MP_MESSAGE;
+end;
+
+procedure TMIMEPart.SetEncoding(Value: string);
+var
+  s: string;
+begin
+  FEncoding := Value;
+  s := UpperCase(Value);
+  FEncodingCode := ME_7BIT;
+  if Pos('8BIT', s) = 1 then
+    FEncodingCode := ME_8BIT;
+  if Pos('QUOTED-PRINTABLE', s) = 1 then
+    FEncodingCode := ME_QUOTED_PRINTABLE;
+  if Pos('BASE64', s) = 1 then
+    FEncodingCode := ME_BASE64;
+  if Pos('X-UU', s) = 1 then
+    FEncodingCode := ME_UU;
+  if Pos('X-XX', s) = 1 then
+    FEncodingCode := ME_XX;
+end;
+
+procedure TMIMEPart.SetCharset(Value: string);
+begin
+  if value <> '' then
+  begin
+    FCharset := Value;
+    FCharsetCode := GetCPFromID(Value);
+  end;
+end;
+
+function TMIMEPart.CanSubPart: boolean;
+begin
+  Result := True;
+  if FMaxSubLevel <> -1 then
+    Result := FMaxSubLevel > FSubLevel;
+end;
+
+function TMIMEPart.IsUUcode(Value: string): boolean;
+begin
+  Value := UpperCase(Value);
+  Result := (pos('BEGIN ', Value) = 1) and (Trim(SeparateRight(Value, ' ')) <> '');
+end;
+
+{==============================================================================}
+
+function GenerateBoundary: string;
+var
+  x, y: Integer;
+begin
+  y := GetTick;
+  x := y;
+  while TickDelta(y, x) = 0 do
+  begin
+    Sleep(1);
+    x := GetTick;
+  end;
+  Randomize;
+  y := Random(MaxInt);
+  Result := IntToHex(x, 8) + '_' + IntToHex(y, 8) + '_Synapse_boundary';
+end;
+
+end.
diff --git a/Units/Synapse/nntpsend.pas b/Units/Synapse/nntpsend.pas
index d0c1960..4ef0c87 100644
--- a/Units/Synapse/nntpsend.pas
+++ b/Units/Synapse/nntpsend.pas
@@ -1,481 +1,481 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 001.005.002 |
-|==============================================================================|
-| Content: NNTP client                                                         |
-|==============================================================================|
-| Copyright (c)1999-2010, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c) 1999-2010.               |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{:@abstract(NNTP client)
-NNTP (network news transfer protocol)
-
-Used RFC: RFC-977, RFC-2980
-}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$H+}
-
-{$IFDEF UNICODE}
-  {$WARN IMPLICIT_STRING_CAST OFF}
-  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
-  {$WARN SUSPICIOUS_TYPECAST OFF}
-{$ENDIF}
-
-unit nntpsend;
-
-interface
-
-uses
-  SysUtils, Classes,
-  blcksock, synautil;
-
-const
-  cNNTPProtocol = '119';
-
-type
-
-  {:abstract(Implementation of Network News Transfer Protocol.
-
-   Note: Are you missing properties for setting Username and Password? Look to
-   parent @link(TSynaClient) object!
-
-   Are you missing properties for specify server address and port? Look to
-   parent @link(TSynaClient) too!}
-  TNNTPSend = class(TSynaClient)
-  private
-    FSock: TTCPBlockSocket;
-    FResultCode: Integer;
-    FResultString: string;
-    FData: TStringList;
-    FDataToSend: TStringList;
-    FAutoTLS: Boolean;
-    FFullSSL: Boolean;
-    FNNTPcap: TStringList;
-    function ReadResult: Integer;
-    function ReadData: boolean;
-    function SendData: boolean;
-    function Connect: Boolean;
-  public
-    constructor Create;
-    destructor Destroy; override;
-
-    {:Connects to NNTP server and begin session.}
-    function Login: Boolean;
-
-    {:Logout from NNTP server and terminate session.}
-    function Logout: Boolean;
-
-    {:By this you can call any NNTP command.}
-    function DoCommand(const Command: string): boolean;
-
-    {:by this you can call any NNTP command. This variant is used for commands
-     for download information from server.}
-    function DoCommandRead(const Command: string): boolean;
-
-    {:by this you can call any NNTP command. This variant is used for commands
-     for upload information to server.}
-    function DoCommandWrite(const Command: string): boolean;
-
-    {:Download full message to @link(data) property. Value can be number of
-     message or message-id (in brackets).}
-    function GetArticle(const Value: string): Boolean;
-
-    {:Download only body of message to @link(data) property. Value can be number
-     of message or message-id (in brackets).}
-    function GetBody(const Value: string): Boolean;
-
-    {:Download only headers of message to @link(data) property. Value can be
-     number of message or message-id (in brackets).}
-    function GetHead(const Value: string): Boolean;
-
-    {:Get message status. Value can be number of message or message-id
-     (in brackets).}
-    function GetStat(const Value: string): Boolean;
-
-    {:Select given group.}
-    function SelectGroup(const Value: string): Boolean;
-
-    {:Tell to server 'I have mesage with given message-ID.' If server need this
-     message, message is uploaded to server.}
-    function IHave(const MessID: string): Boolean;
-
-    {:Move message pointer to last item in group.}
-    function GotoLast: Boolean;
-
-    {:Move message pointer to next item in group.}
-    function GotoNext: Boolean;
-
-    {:Download to @link(data) property list of all groups on NNTP server.}
-    function ListGroups: Boolean;
-
-    {:Download to @link(data) property list of all groups created after given time.}
-    function ListNewGroups(Since: TDateTime): Boolean;
-
-    {:Download to @link(data) property list of message-ids in given group since
-     given time.}
-    function NewArticles(const Group: string; Since: TDateTime): Boolean;
-
-    {:Upload new article to server. (for new messages by you)}
-    function PostArticle: Boolean;
-
-    {:Tells to remote NNTP server 'I am not NNTP client, but I am another NNTP
-     server'.}
-    function SwitchToSlave: Boolean;
-
-    {:Call NNTP XOVER command.}
-    function Xover(xoStart, xoEnd: string): boolean;
-
-    {:Call STARTTLS command for upgrade connection to SSL/TLS mode.}
-    function StartTLS: Boolean;
-
-    {:Try to find given capability in extension list. This list is getted after
-     successful login to NNTP server. If extension capability is not found,
-     then return is empty string.}
-    function FindCap(const Value: string): string;
-
-    {:Try get list of server extensions. List is returned in @link(data) property.}
-    function ListExtensions: Boolean;
-  published
-    {:Result code number of last operation.}
-    property ResultCode: Integer read FResultCode;
-
-    {:String description of last result code from NNTP server.}
-    property ResultString: string read FResultString;
-
-    {:Readed data. (message, etc.)}
-    property Data: TStringList read FData;
-
-    {:If is set to @true, then upgrade to SSL/TLS mode after login if remote
-     server support it.}
-    property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
-
-    {:SSL/TLS mode is used from first contact to server. Servers with full
-     SSL/TLS mode usualy using non-standard TCP port!}
-    property FullSSL: Boolean read FFullSSL Write FFullSSL;
-
-    {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
-    property Sock: TTCPBlockSocket read FSock;
-  end;
-
-implementation
-
-constructor TNNTPSend.Create;
-begin
-  inherited Create;
-  FSock := TTCPBlockSocket.Create;
-  FSock.Owner := self;
-  FData := TStringList.Create;
-  FDataToSend := TStringList.Create;
-  FNNTPcap := TStringList.Create;
-  FSock.ConvertLineEnd := True;
-  FTimeout := 60000;
-  FTargetPort := cNNTPProtocol;
-  FAutoTLS := False;
-  FFullSSL := False;
-end;
-
-destructor TNNTPSend.Destroy;
-begin
-  FSock.Free;
-  FDataToSend.Free;
-  FData.Free;
-  FNNTPcap.Free;
-  inherited Destroy;
-end;
-
-function TNNTPSend.ReadResult: Integer;
-var
-  s: string;
-begin
-  Result := 0;
-  FData.Clear;
-  s := FSock.RecvString(FTimeout);
-  FResultString := Copy(s, 5, Length(s) - 4);
-  if FSock.LastError <> 0 then
-    Exit;
-  if Length(s) >= 3 then
-    Result := StrToIntDef(Copy(s, 1, 3), 0);
-  FResultCode := Result;
-end;
-
-function TNNTPSend.ReadData: boolean;
-var
-  s: string;
-begin
-  repeat
-    s := FSock.RecvString(FTimeout);
-    if s = '.' then
-      break;
-    if (s <> '') and (s[1] = '.') then
-      s := Copy(s, 2, Length(s) - 1);
-    FData.Add(s);
-  until FSock.LastError <> 0;
-  Result := FSock.LastError = 0;
-end;
-
-function TNNTPSend.SendData: boolean;
-var
-  s: string;
-  n: integer;
-begin
-  for n := 0 to FDataToSend.Count - 1 do
-  begin
-    s := FDataToSend[n];
-    if (s <> '') and (s[1] = '.') then
-      s := s + '.';
-    FSock.SendString(s + CRLF);
-    if FSock.LastError <> 0 then
-      break;
-  end;
-  if FDataToSend.Count = 0 then
-    FSock.SendString(CRLF);
-  if FSock.LastError = 0 then
-    FSock.SendString('.' + CRLF);
-  FDataToSend.Clear;
-  Result := FSock.LastError = 0;
-end;
-
-function TNNTPSend.Connect: Boolean;
-begin
-  FSock.CloseSocket;
-  FSock.Bind(FIPInterface, cAnyPort);
-  if FSock.LastError = 0 then
-    FSock.Connect(FTargetHost, FTargetPort);
-  if FSock.LastError = 0 then
-    if FFullSSL then
-      FSock.SSLDoConnect;
-  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);
-    if (ReadResult div 100) = 3 then
-    begin
-      FSock.SendString('AUTHINFO PASS ' + FPassword + CRLF);
-      Result := (ReadResult div 100) = 2;
-    end;
-  end;
-end;
-
-function TNNTPSend.Logout: Boolean;
-begin
-  FSock.SendString('QUIT' + CRLF);
-  Result := (ReadResult div 100) = 2;
-  FSock.CloseSocket;
-end;
-
-function TNNTPSend.DoCommand(const Command: string): Boolean;
-begin
-  FSock.SendString(Command + CRLF);
-  Result := (ReadResult div 100) = 2;
-  Result := Result and (FSock.LastError = 0);
-end;
-
-function TNNTPSend.DoCommandRead(const Command: string): Boolean;
-begin
-  Result := DoCommand(Command);
-  if Result then
-  begin
-    Result := ReadData;
-    Result := Result and (FSock.LastError = 0);
-  end;
-end;
-
-function TNNTPSend.DoCommandWrite(const Command: string): Boolean;
-var
-  x: integer;
-begin
-  FDataToSend.Assign(FData);
-  FSock.SendString(Command + CRLF);
-  x := (ReadResult div 100);
-  if x = 3 then
-  begin
-    SendData;
-    x := (ReadResult div 100);
-  end;
-  Result := x = 2;
-  Result := Result and (FSock.LastError = 0);
-end;
-
-function TNNTPSend.GetArticle(const Value: string): Boolean;
-var
-  s: string;
-begin
-  s := 'ARTICLE';
-  if Value <> '' then
-    s := s + ' ' + Value;
-  Result := DoCommandRead(s);
-end;
-
-function TNNTPSend.GetBody(const Value: string): Boolean;
-var
-  s: string;
-begin
-  s := 'BODY';
-  if Value <> '' then
-    s := s + ' ' + Value;
-  Result := DoCommandRead(s);
-end;
-
-function TNNTPSend.GetHead(const Value: string): Boolean;
-var
-  s: string;
-begin
-  s := 'HEAD';
-  if Value <> '' then
-    s := s + ' ' + Value;
-  Result := DoCommandRead(s);
-end;
-
-function TNNTPSend.GetStat(const Value: string): Boolean;
-var
-  s: string;
-begin
-  s := 'STAT';
-  if Value <> '' then
-    s := s + ' ' + Value;
-  Result := DoCommand(s);
-end;
-
-function TNNTPSend.SelectGroup(const Value: string): Boolean;
-begin
-  Result := DoCommand('GROUP ' + Value);
-end;
-
-function TNNTPSend.IHave(const MessID: string): Boolean;
-begin
-  Result := DoCommandWrite('IHAVE ' + MessID);
-end;
-
-function TNNTPSend.GotoLast: Boolean;
-begin
-  Result := DoCommand('LAST');
-end;
-
-function TNNTPSend.GotoNext: Boolean;
-begin
-  Result := DoCommand('NEXT');
-end;
-
-function TNNTPSend.ListGroups: Boolean;
-begin
-  Result := DoCommandRead('LIST');
-end;
-
-function TNNTPSend.ListNewGroups(Since: TDateTime): Boolean;
-begin
-  Result := DoCommandRead('NEWGROUPS ' + SimpleDateTime(Since) + ' GMT');
-end;
-
-function TNNTPSend.NewArticles(const Group: string; Since: TDateTime): Boolean;
-begin
-  Result := DoCommandRead('NEWNEWS ' + Group + ' ' + SimpleDateTime(Since) + ' GMT');
-end;
-
-function TNNTPSend.PostArticle: Boolean;
-begin
-  Result := DoCommandWrite('POST');
-end;
-
-function TNNTPSend.SwitchToSlave: Boolean;
-begin
-  Result := DoCommand('SLAVE');
-end;
-
-function TNNTPSend.Xover(xoStart, xoEnd: string): Boolean;
-var
-  s: string;
-begin
-  s := 'XOVER ' + xoStart;
-  if xoEnd <> xoStart then
-    s := s + '-' + xoEnd;
-  Result := DoCommandRead(s);
-end;
-
-function TNNTPSend.StartTLS: Boolean;
-begin
-  Result := False;
-  if FindCap('STARTTLS') <> '' then
-  begin
-    if DoCommand('STARTTLS') then
-    begin
-      Fsock.SSLDoConnect;
-      Result := FSock.LastError = 0;
-    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.
+{==============================================================================|
+| Project : Ararat Synapse                                       | 001.005.002 |
+|==============================================================================|
+| Content: NNTP client                                                         |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c) 1999-2010.               |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@abstract(NNTP client)
+NNTP (network news transfer protocol)
+
+Used RFC: RFC-977, RFC-2980
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+  {$WARN SUSPICIOUS_TYPECAST OFF}
+{$ENDIF}
+
+unit nntpsend;
+
+interface
+
+uses
+  SysUtils, Classes,
+  blcksock, synautil;
+
+const
+  cNNTPProtocol = '119';
+
+type
+
+  {:abstract(Implementation of Network News Transfer Protocol.
+
+   Note: Are you missing properties for setting Username and Password? Look to
+   parent @link(TSynaClient) object!
+
+   Are you missing properties for specify server address and port? Look to
+   parent @link(TSynaClient) too!}
+  TNNTPSend = class(TSynaClient)
+  private
+    FSock: TTCPBlockSocket;
+    FResultCode: Integer;
+    FResultString: string;
+    FData: TStringList;
+    FDataToSend: TStringList;
+    FAutoTLS: Boolean;
+    FFullSSL: Boolean;
+    FNNTPcap: TStringList;
+    function ReadResult: Integer;
+    function ReadData: boolean;
+    function SendData: boolean;
+    function Connect: Boolean;
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    {:Connects to NNTP server and begin session.}
+    function Login: Boolean;
+
+    {:Logout from NNTP server and terminate session.}
+    function Logout: Boolean;
+
+    {:By this you can call any NNTP command.}
+    function DoCommand(const Command: string): boolean;
+
+    {:by this you can call any NNTP command. This variant is used for commands
+     for download information from server.}
+    function DoCommandRead(const Command: string): boolean;
+
+    {:by this you can call any NNTP command. This variant is used for commands
+     for upload information to server.}
+    function DoCommandWrite(const Command: string): boolean;
+
+    {:Download full message to @link(data) property. Value can be number of
+     message or message-id (in brackets).}
+    function GetArticle(const Value: string): Boolean;
+
+    {:Download only body of message to @link(data) property. Value can be number
+     of message or message-id (in brackets).}
+    function GetBody(const Value: string): Boolean;
+
+    {:Download only headers of message to @link(data) property. Value can be
+     number of message or message-id (in brackets).}
+    function GetHead(const Value: string): Boolean;
+
+    {:Get message status. Value can be number of message or message-id
+     (in brackets).}
+    function GetStat(const Value: string): Boolean;
+
+    {:Select given group.}
+    function SelectGroup(const Value: string): Boolean;
+
+    {:Tell to server 'I have mesage with given message-ID.' If server need this
+     message, message is uploaded to server.}
+    function IHave(const MessID: string): Boolean;
+
+    {:Move message pointer to last item in group.}
+    function GotoLast: Boolean;
+
+    {:Move message pointer to next item in group.}
+    function GotoNext: Boolean;
+
+    {:Download to @link(data) property list of all groups on NNTP server.}
+    function ListGroups: Boolean;
+
+    {:Download to @link(data) property list of all groups created after given time.}
+    function ListNewGroups(Since: TDateTime): Boolean;
+
+    {:Download to @link(data) property list of message-ids in given group since
+     given time.}
+    function NewArticles(const Group: string; Since: TDateTime): Boolean;
+
+    {:Upload new article to server. (for new messages by you)}
+    function PostArticle: Boolean;
+
+    {:Tells to remote NNTP server 'I am not NNTP client, but I am another NNTP
+     server'.}
+    function SwitchToSlave: Boolean;
+
+    {:Call NNTP XOVER command.}
+    function Xover(xoStart, xoEnd: string): boolean;
+
+    {:Call STARTTLS command for upgrade connection to SSL/TLS mode.}
+    function StartTLS: Boolean;
+
+    {:Try to find given capability in extension list. This list is getted after
+     successful login to NNTP server. If extension capability is not found,
+     then return is empty string.}
+    function FindCap(const Value: string): string;
+
+    {:Try get list of server extensions. List is returned in @link(data) property.}
+    function ListExtensions: Boolean;
+  published
+    {:Result code number of last operation.}
+    property ResultCode: Integer read FResultCode;
+
+    {:String description of last result code from NNTP server.}
+    property ResultString: string read FResultString;
+
+    {:Readed data. (message, etc.)}
+    property Data: TStringList read FData;
+
+    {:If is set to @true, then upgrade to SSL/TLS mode after login if remote
+     server support it.}
+    property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
+
+    {:SSL/TLS mode is used from first contact to server. Servers with full
+     SSL/TLS mode usualy using non-standard TCP port!}
+    property FullSSL: Boolean read FFullSSL Write FFullSSL;
+
+    {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
+    property Sock: TTCPBlockSocket read FSock;
+  end;
+
+implementation
+
+constructor TNNTPSend.Create;
+begin
+  inherited Create;
+  FSock := TTCPBlockSocket.Create;
+  FSock.Owner := self;
+  FData := TStringList.Create;
+  FDataToSend := TStringList.Create;
+  FNNTPcap := TStringList.Create;
+  FSock.ConvertLineEnd := True;
+  FTimeout := 60000;
+  FTargetPort := cNNTPProtocol;
+  FAutoTLS := False;
+  FFullSSL := False;
+end;
+
+destructor TNNTPSend.Destroy;
+begin
+  FSock.Free;
+  FDataToSend.Free;
+  FData.Free;
+  FNNTPcap.Free;
+  inherited Destroy;
+end;
+
+function TNNTPSend.ReadResult: Integer;
+var
+  s: string;
+begin
+  Result := 0;
+  FData.Clear;
+  s := FSock.RecvString(FTimeout);
+  FResultString := Copy(s, 5, Length(s) - 4);
+  if FSock.LastError <> 0 then
+    Exit;
+  if Length(s) >= 3 then
+    Result := StrToIntDef(Copy(s, 1, 3), 0);
+  FResultCode := Result;
+end;
+
+function TNNTPSend.ReadData: boolean;
+var
+  s: string;
+begin
+  repeat
+    s := FSock.RecvString(FTimeout);
+    if s = '.' then
+      break;
+    if (s <> '') and (s[1] = '.') then
+      s := Copy(s, 2, Length(s) - 1);
+    FData.Add(s);
+  until FSock.LastError <> 0;
+  Result := FSock.LastError = 0;
+end;
+
+function TNNTPSend.SendData: boolean;
+var
+  s: string;
+  n: integer;
+begin
+  for n := 0 to FDataToSend.Count - 1 do
+  begin
+    s := FDataToSend[n];
+    if (s <> '') and (s[1] = '.') then
+      s := s + '.';
+    FSock.SendString(s + CRLF);
+    if FSock.LastError <> 0 then
+      break;
+  end;
+  if FDataToSend.Count = 0 then
+    FSock.SendString(CRLF);
+  if FSock.LastError = 0 then
+    FSock.SendString('.' + CRLF);
+  FDataToSend.Clear;
+  Result := FSock.LastError = 0;
+end;
+
+function TNNTPSend.Connect: Boolean;
+begin
+  FSock.CloseSocket;
+  FSock.Bind(FIPInterface, cAnyPort);
+  if FSock.LastError = 0 then
+    FSock.Connect(FTargetHost, FTargetPort);
+  if FSock.LastError = 0 then
+    if FFullSSL then
+      FSock.SSLDoConnect;
+  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);
+    if (ReadResult div 100) = 3 then
+    begin
+      FSock.SendString('AUTHINFO PASS ' + FPassword + CRLF);
+      Result := (ReadResult div 100) = 2;
+    end;
+  end;
+end;
+
+function TNNTPSend.Logout: Boolean;
+begin
+  FSock.SendString('QUIT' + CRLF);
+  Result := (ReadResult div 100) = 2;
+  FSock.CloseSocket;
+end;
+
+function TNNTPSend.DoCommand(const Command: string): Boolean;
+begin
+  FSock.SendString(Command + CRLF);
+  Result := (ReadResult div 100) = 2;
+  Result := Result and (FSock.LastError = 0);
+end;
+
+function TNNTPSend.DoCommandRead(const Command: string): Boolean;
+begin
+  Result := DoCommand(Command);
+  if Result then
+  begin
+    Result := ReadData;
+    Result := Result and (FSock.LastError = 0);
+  end;
+end;
+
+function TNNTPSend.DoCommandWrite(const Command: string): Boolean;
+var
+  x: integer;
+begin
+  FDataToSend.Assign(FData);
+  FSock.SendString(Command + CRLF);
+  x := (ReadResult div 100);
+  if x = 3 then
+  begin
+    SendData;
+    x := (ReadResult div 100);
+  end;
+  Result := x = 2;
+  Result := Result and (FSock.LastError = 0);
+end;
+
+function TNNTPSend.GetArticle(const Value: string): Boolean;
+var
+  s: string;
+begin
+  s := 'ARTICLE';
+  if Value <> '' then
+    s := s + ' ' + Value;
+  Result := DoCommandRead(s);
+end;
+
+function TNNTPSend.GetBody(const Value: string): Boolean;
+var
+  s: string;
+begin
+  s := 'BODY';
+  if Value <> '' then
+    s := s + ' ' + Value;
+  Result := DoCommandRead(s);
+end;
+
+function TNNTPSend.GetHead(const Value: string): Boolean;
+var
+  s: string;
+begin
+  s := 'HEAD';
+  if Value <> '' then
+    s := s + ' ' + Value;
+  Result := DoCommandRead(s);
+end;
+
+function TNNTPSend.GetStat(const Value: string): Boolean;
+var
+  s: string;
+begin
+  s := 'STAT';
+  if Value <> '' then
+    s := s + ' ' + Value;
+  Result := DoCommand(s);
+end;
+
+function TNNTPSend.SelectGroup(const Value: string): Boolean;
+begin
+  Result := DoCommand('GROUP ' + Value);
+end;
+
+function TNNTPSend.IHave(const MessID: string): Boolean;
+begin
+  Result := DoCommandWrite('IHAVE ' + MessID);
+end;
+
+function TNNTPSend.GotoLast: Boolean;
+begin
+  Result := DoCommand('LAST');
+end;
+
+function TNNTPSend.GotoNext: Boolean;
+begin
+  Result := DoCommand('NEXT');
+end;
+
+function TNNTPSend.ListGroups: Boolean;
+begin
+  Result := DoCommandRead('LIST');
+end;
+
+function TNNTPSend.ListNewGroups(Since: TDateTime): Boolean;
+begin
+  Result := DoCommandRead('NEWGROUPS ' + SimpleDateTime(Since) + ' GMT');
+end;
+
+function TNNTPSend.NewArticles(const Group: string; Since: TDateTime): Boolean;
+begin
+  Result := DoCommandRead('NEWNEWS ' + Group + ' ' + SimpleDateTime(Since) + ' GMT');
+end;
+
+function TNNTPSend.PostArticle: Boolean;
+begin
+  Result := DoCommandWrite('POST');
+end;
+
+function TNNTPSend.SwitchToSlave: Boolean;
+begin
+  Result := DoCommand('SLAVE');
+end;
+
+function TNNTPSend.Xover(xoStart, xoEnd: string): Boolean;
+var
+  s: string;
+begin
+  s := 'XOVER ' + xoStart;
+  if xoEnd <> xoStart then
+    s := s + '-' + xoEnd;
+  Result := DoCommandRead(s);
+end;
+
+function TNNTPSend.StartTLS: Boolean;
+begin
+  Result := False;
+  if FindCap('STARTTLS') <> '' then
+  begin
+    if DoCommand('STARTTLS') then
+    begin
+      Fsock.SSLDoConnect;
+      Result := FSock.LastError = 0;
+    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.
diff --git a/Units/Synapse/pingsend.pas b/Units/Synapse/pingsend.pas
index 1a4e331..10ca8ba 100644
--- a/Units/Synapse/pingsend.pas
+++ b/Units/Synapse/pingsend.pas
@@ -1,720 +1,720 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 004.000.002 |
-|==============================================================================|
-| Content: PING sender                                                         |
-|==============================================================================|
-| Copyright (c)1999-2010, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2000-2010.                |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{:@abstract(ICMP PING implementation.)
-Allows create PING and TRACEROUTE. Or you can diagnose your network.
-
-This unit using IpHlpApi (on WinXP or higher) if available. Otherwise it trying
- to use RAW sockets.
-
-Warning: For use of RAW sockets you must have some special rights on some
- systems. So, it working allways when you have administator/root rights.
- Otherwise you can have problems!
-
-Note: This unit is NOT portable to .NET!
-  Use native .NET classes for Ping instead.
-}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$Q-}
-{$R-}
-{$H+}
-
-{$IFDEF CIL}
-  Sorry, this unit is not for .NET!
-{$ENDIF}
-//old Delphi does not have MSWINDOWS define.
-{$IFDEF WIN32}
-  {$IFNDEF MSWINDOWS}
-    {$DEFINE MSWINDOWS}
-  {$ENDIF}
-{$ENDIF}
-
-{$IFDEF UNICODE}
-  {$WARN IMPLICIT_STRING_CAST OFF}
-  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
-{$ENDIF}
-
-unit pingsend;
-
-interface
-
-uses
-  SysUtils,
-  synsock, blcksock, synautil, synafpc, synaip
-{$IFDEF MSWINDOWS}
-  , windows
-{$ENDIF}
-  ;
-
-const
-  ICMP_ECHO = 8;
-  ICMP_ECHOREPLY = 0;
-  ICMP_UNREACH = 3;
-  ICMP_TIME_EXCEEDED = 11;
-//rfc-2292
-  ICMP6_ECHO = 128;
-  ICMP6_ECHOREPLY = 129;
-  ICMP6_UNREACH = 1;
-  ICMP6_TIME_EXCEEDED = 3;
-
-type
-  {:List of possible ICMP reply packet types.}
-  TICMPError = (
-    IE_NoError,
-    IE_Other,
-    IE_TTLExceed,
-    IE_UnreachOther,
-    IE_UnreachRoute,
-    IE_UnreachAdmin,
-    IE_UnreachAddr,
-    IE_UnreachPort
-    );
-
-  {:@abstract(Implementation of ICMP PING and ICMPv6 PING.)}
-  TPINGSend = class(TSynaClient)
-  private
-    FSock: TICMPBlockSocket;
-    FBuffer: Ansistring;
-    FSeq: Integer;
-    FId: Integer;
-    FPacketSize: Integer;
-    FPingTime: Integer;
-    FIcmpEcho: Byte;
-    FIcmpEchoReply: Byte;
-    FIcmpUnreach: Byte;
-    FReplyFrom: string;
-    FReplyType: byte;
-    FReplyCode: byte;
-    FReplyError: TICMPError;
-    FReplyErrorDesc: string;
-    FTTL: Byte;
-    Fsin: TVarSin;
-    function Checksum(Value: AnsiString): Word;
-    function Checksum6(Value: AnsiString): Word;
-    function ReadPacket: Boolean;
-    procedure TranslateError;
-    procedure TranslateErrorIpHlp(value: integer);
-    function InternalPing(const Host: string): Boolean;
-    function InternalPingIpHlp(const Host: string): Boolean;
-    function IsHostIP6(const Host: string): Boolean;
-    procedure GenErrorDesc;
-  public
-    {:Send ICMP ping to host and count @link(pingtime). If ping OK, result is
-     @true.}
-    function Ping(const Host: string): Boolean;
-    constructor Create;
-    destructor Destroy; override;
-  published
-    {:Size of PING packet. Default size is 32 bytes.}
-    property PacketSize: Integer read FPacketSize Write FPacketSize;
-
-    {:Time between request and reply.}
-    property PingTime: Integer read FPingTime;
-
-    {:From this address is sended reply for your PING request. It maybe not your
-     requested destination, when some error occured!}
-    property ReplyFrom: string read FReplyFrom;
-
-    {:ICMP type of PING reply. Each protocol using another values! For IPv4 and
-     IPv6 are used different values!}
-    property ReplyType: byte read FReplyType;
-
-    {:ICMP code of PING reply. Each protocol using another values! For IPv4 and
-     IPv6 are used different values! For protocol independent value look to
-     @link(ReplyError)}
-    property ReplyCode: byte read FReplyCode;
-
-    {:Return type of returned ICMP message. This value is independent on used
-     protocol!}
-    property ReplyError: TICMPError read FReplyError;
-
-    {:Return human readable description of returned packet type.}
-    property ReplyErrorDesc: string read FReplyErrorDesc;
-
-    {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
-    property Sock: TICMPBlockSocket read FSock;
-
-    {:TTL value for ICMP query}
-    property TTL: byte read FTTL write FTTL;
-  end;
-
-{:A very useful function and example of its use would be found in the TPINGSend
- object. Use it to ping to any host. If successful, returns the ping time in
- milliseconds.  Returns -1 if an error occurred.}
-function PingHost(const Host: string): Integer;
-
-{:A very useful function and example of its use would be found in the TPINGSend
- object. Use it to TraceRoute to any host.}
-function TraceRouteHost(const Host: string): string;
-
-implementation
-
-type
-  {:Record for ICMP ECHO packet header.}
-  TIcmpEchoHeader = packed record
-    i_type: Byte;
-    i_code: Byte;
-    i_checkSum: Word;
-    i_Id: Word;
-    i_seq: Word;
-    TimeStamp: integer;
-  end;
-
-  {:record used internally by TPingSend for compute checksum of ICMPv6 packet
-   pseudoheader.}
-  TICMP6Packet = packed record
-    in_source: TInAddr6;
-    in_dest: TInAddr6;
-    Length: integer;
-    free0: Byte;
-    free1: Byte;
-    free2: Byte;
-    proto: Byte;
-  end;
-
-{$IFDEF MSWINDOWS}
-const
-  DLLIcmpName = 'iphlpapi.dll';
-type
-  TIP_OPTION_INFORMATION = record
-    TTL: Byte;
-    TOS: Byte;
-    Flags: Byte;
-    OptionsSize: Byte;
-    OptionsData: PAnsiChar;
-  end;
-  PIP_OPTION_INFORMATION = ^TIP_OPTION_INFORMATION;
-
-  TICMP_ECHO_REPLY = record
-    Address: TInAddr;
-    Status: integer;
-    RoundTripTime: integer;
-    DataSize: Word;
-    Reserved: Word;
-    Data: pointer;
-    Options: TIP_OPTION_INFORMATION;
-  end;
-  PICMP_ECHO_REPLY = ^TICMP_ECHO_REPLY;
-
-  TICMPV6_ECHO_REPLY = record
-    Address: TSockAddrIn6;
-    Status: integer;
-    RoundTripTime: integer;
-  end;
-  PICMPV6_ECHO_REPLY = ^TICMPV6_ECHO_REPLY;
-
-  TIcmpCreateFile = function: integer; stdcall;
-  TIcmpCloseHandle = function(handle: integer): boolean; stdcall;
-  TIcmpSendEcho2 = function(handle: integer; Event: pointer; ApcRoutine: pointer;
-    ApcContext: pointer; DestinationAddress: TInAddr; RequestData: pointer;
-    RequestSize: integer; RequestOptions: PIP_OPTION_INFORMATION;
-    ReplyBuffer: pointer; ReplySize: integer; Timeout: Integer): integer; stdcall;
-  TIcmp6CreateFile = function: integer; stdcall;
-  TIcmp6SendEcho2 = function(handle: integer; Event: pointer; ApcRoutine: pointer;
-    ApcContext: pointer; SourceAddress: PSockAddrIn6; DestinationAddress: PSockAddrIn6;
-    RequestData: pointer; RequestSize: integer; RequestOptions: PIP_OPTION_INFORMATION;
-    ReplyBuffer: pointer; ReplySize: integer; Timeout: Integer): integer; stdcall;
-
-var
-  IcmpDllHandle: TLibHandle = 0;
-  IcmpHelper4: boolean = false;
-  IcmpHelper6: boolean = false;
-  IcmpCreateFile: TIcmpCreateFile = nil;
-  IcmpCloseHandle: TIcmpCloseHandle = nil;
-  IcmpSendEcho2: TIcmpSendEcho2 = nil;
-  Icmp6CreateFile: TIcmp6CreateFile = nil;
-  Icmp6SendEcho2: TIcmp6SendEcho2 = nil;
-{$ENDIF}
-{==============================================================================}
-
-constructor TPINGSend.Create;
-begin
-  inherited Create;
-  FSock := TICMPBlockSocket.Create;
-  FSock.Owner := self;
-  FTimeout := 5000;
-  FPacketSize := 32;
-  FSeq := 0;
-  Randomize;
-  FTTL := 128;
-end;
-
-destructor TPINGSend.Destroy;
-begin
-  FSock.Free;
-  inherited Destroy;
-end;
-
-function TPINGSend.ReadPacket: Boolean;
-begin
-  FBuffer := FSock.RecvPacket(Ftimeout);
-  Result := FSock.LastError = 0;
-end;
-
-procedure TPINGSend.GenErrorDesc;
-begin
-  case FReplyError of
-    IE_NoError:
-      FReplyErrorDesc := '';
-    IE_Other:
-      FReplyErrorDesc := 'Unknown error';
-    IE_TTLExceed:
-      FReplyErrorDesc := 'TTL Exceeded';
-    IE_UnreachOther:
-      FReplyErrorDesc := 'Unknown unreachable';
-    IE_UnreachRoute:
-      FReplyErrorDesc := 'No route to destination';
-    IE_UnreachAdmin:
-      FReplyErrorDesc := 'Administratively prohibited';
-    IE_UnreachAddr:
-      FReplyErrorDesc := 'Address unreachable';
-    IE_UnreachPort:
-      FReplyErrorDesc := 'Port unreachable';
-  end;
-end;
-
-function TPINGSend.IsHostIP6(const Host: string): Boolean;
-var
-  f: integer;
-begin
-  f := AF_UNSPEC;
-  if IsIp(Host) then
-    f := AF_INET
-  else
-    if IsIp6(Host) then
-      f := AF_INET6;
-  synsock.SetVarSin(Fsin, host, '0', f,
-    IPPROTO_UDP, SOCK_DGRAM, Fsock.PreferIP4);
-  result := Fsin.sin_family = AF_INET6;
-end;
-
-function TPINGSend.Ping(const Host: string): Boolean;
-var
-  b: boolean;
-begin
-  FPingTime := -1;
-  FReplyFrom := '';
-  FReplyType := 0;
-  FReplyCode := 0;
-  FReplyError := IE_Other;
-  GenErrorDesc;
-  FBuffer := StringOfChar(#55, SizeOf(TICMPEchoHeader) + FPacketSize);
-{$IFDEF MSWINDOWS}
-  b := IsHostIP6(host);
-  if not(b) and IcmpHelper4 then
-    result := InternalPingIpHlp(host)
-  else
-    if b and IcmpHelper6 then
-      result := InternalPingIpHlp(host)
-    else
-      result := InternalPing(host);
-{$ELSE}
-   result := InternalPing(host);
-{$ENDIF}
-end;
-
-function TPINGSend.InternalPing(const Host: string): Boolean;
-var
-  IPHeadPtr: ^TIPHeader;
-  IpHdrLen: Integer;
-  IcmpEchoHeaderPtr: ^TICMPEchoHeader;
-  t: Boolean;
-  x: cardinal;
-  IcmpReqHead: string;
-begin
-  Result := False;
-  FSock.TTL := FTTL;
-  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;
-    FIcmpUnreach := ICMP6_UNREACH;
-  end
-  else
-  begin
-    FIcmpEcho := ICMP_ECHO;
-    FIcmpEchoReply := ICMP_ECHOREPLY;
-    FIcmpUnreach := ICMP_UNREACH;
-  end;
-  IcmpEchoHeaderPtr := Pointer(FBuffer);
-  with IcmpEchoHeaderPtr^ do
-  begin
-    i_type := FIcmpEcho;
-    i_code := 0;
-    i_CheckSum := 0;
-    FId := System.Random(32767);
-    i_Id := FId;
-    TimeStamp := GetTick;
-    Inc(FSeq);
-    i_Seq := FSeq;
-    if fSock.IP6used then
-      i_CheckSum := CheckSum6(FBuffer)
-    else
-      i_CheckSum := CheckSum(FBuffer);
-  end;
-  FSock.SendString(FBuffer);
-  // remember first 8 bytes of ICMP packet
-  IcmpReqHead := Copy(FBuffer, 1, 8);
-  x := GetTick;
-  repeat
-    t := ReadPacket;
-    if not t then
-      break;
-    if fSock.IP6used then
-    begin
-{$IFNDEF MSWINDOWS}
-      IcmpEchoHeaderPtr := Pointer(FBuffer);
-{$ELSE}
-//WinXP SP1 with networking update doing this think by another way ;-O
-//      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;
-  //check for timeout
-    if TickDelta(x, GetTick) > FTimeout then
-    begin
-      t := false;
-      Break;
-    end;
-  //it discard sometimes possible 'echoes' of previosly sended packet
-  //or other unwanted ICMP packets...
-  until (IcmpEchoHeaderPtr^.i_type <> FIcmpEcho)
-    and ((IcmpEchoHeaderPtr^.i_id = FId)
-    or (Pos(IcmpReqHead, FBuffer) > 0));
-  if t then
-    begin
-      FPingTime := TickDelta(x, GetTick);
-      FReplyFrom := FSock.GetRemoteSinIP;
-      FReplyType := IcmpEchoHeaderPtr^.i_type;
-      FReplyCode := IcmpEchoHeaderPtr^.i_code;
-      TranslateError;
-      Result := True;
-    end;
-end;
-
-function TPINGSend.Checksum(Value: AnsiString): Word;
-var
-  CkSum: integer;
-  Num, Remain: Integer;
-  n, i: Integer;
-begin
-  Num := Length(Value) div 2;
-  Remain := Length(Value) mod 2;
-  CkSum := 0;
-  i := 1;
-  for n := 0 to Num - 1 do
-  begin
-    CkSum := CkSum + Synsock.HtoNs(DecodeInt(Value, i));
-    inc(i, 2);
-  end;
-  if Remain <> 0 then
-    CkSum := CkSum + Ord(Value[Length(Value)]);
-  CkSum := (CkSum shr 16) + (CkSum and $FFFF);
-  CkSum := CkSum + (CkSum shr 16);
-  Result := Word(not CkSum);
-end;
-
-function TPINGSend.Checksum6(Value: AnsiString): 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: AnsiString;
-  b: integer;
-  ip6: TSockAddrIn6;
-  x: integer;
-begin
-  Result := 0;
-{$IFDEF MSWINDOWS}
-  s := StringOfChar(#0, SizeOf(TICMP6Packet)) + Value;
-  ICMP6Ptr := Pointer(s);
-  x := synsock.WSAIoctl(FSock.Socket, SIO_ROUTING_INTERFACE_QUERY,
-    @FSock.RemoteSin, SizeOf(FSock.RemoteSin),
-    @ip6, SizeOf(ip6), @b, nil, nil);
-  if x <> -1 then
-    ICMP6Ptr^.in_dest := ip6.sin6_addr
-  else
-    ICMP6Ptr^.in_dest := FSock.LocalSin.sin6_addr;
-  ICMP6Ptr^.in_source := FSock.RemoteSin.sin6_addr;
-  ICMP6Ptr^.Length := synsock.htonl(Length(Value));
-  ICMP6Ptr^.proto := IPPROTO_ICMPV6;
-  Result := Checksum(s);
-{$ENDIF}
-end;
-
-procedure TPINGSend.TranslateError;
-begin
-  if fSock.IP6used then
-  begin
-    case FReplyType of
-      ICMP6_ECHOREPLY:
-        FReplyError := IE_NoError;
-      ICMP6_TIME_EXCEEDED:
-        FReplyError := IE_TTLExceed;
-      ICMP6_UNREACH:
-        case FReplyCode of
-          0:
-            FReplyError := IE_UnreachRoute;
-          3:
-            FReplyError := IE_UnreachAddr;
-          4:
-            FReplyError := IE_UnreachPort;
-          1:
-            FReplyError := IE_UnreachAdmin;
-        else
-          FReplyError := IE_UnreachOther;
-        end;
-    else
-      FReplyError := IE_Other;
-    end;
-  end
-  else
-  begin
-    case FReplyType of
-      ICMP_ECHOREPLY:
-        FReplyError := IE_NoError;
-      ICMP_TIME_EXCEEDED:
-        FReplyError := IE_TTLExceed;
-      ICMP_UNREACH:
-        case FReplyCode of
-          0:
-            FReplyError := IE_UnreachRoute;
-          1:
-            FReplyError := IE_UnreachAddr;
-          3:
-            FReplyError := IE_UnreachPort;
-          13:
-            FReplyError := IE_UnreachAdmin;
-        else
-          FReplyError := IE_UnreachOther;
-        end;
-    else
-      FReplyError := IE_Other;
-    end;
-  end;
-  GenErrorDesc;
-end;
-
-procedure TPINGSend.TranslateErrorIpHlp(value: integer);
-begin
-  case value of
-    11000, 0:
-      FReplyError := IE_NoError;
-    11013:
-      FReplyError := IE_TTLExceed;
-    11002:
-      FReplyError := IE_UnreachRoute;
-    11003:
-      FReplyError := IE_UnreachAddr;
-    11005:
-      FReplyError := IE_UnreachPort;
-    11004:
-      FReplyError := IE_UnreachAdmin;
-  else
-    FReplyError := IE_Other;
-  end;
-  GenErrorDesc;
-end;
-
-function TPINGSend.InternalPingIpHlp(const Host: string): Boolean;
-{$IFDEF MSWINDOWS}
-var
-  PingIp6: boolean;
-  PingHandle: integer;
-  r: integer;
-  ipo: TIP_OPTION_INFORMATION;
-  RBuff: Ansistring;
-  ip4reply: PICMP_ECHO_REPLY;
-  ip6reply: PICMPV6_ECHO_REPLY;
-  ip6: TSockAddrIn6;
-begin
-  Result := False;
-  PingIp6 := Fsin.sin_family = AF_INET6;
-  if pingIp6 then
-    PingHandle := Icmp6CreateFile
-  else
-    PingHandle := IcmpCreateFile;
-  if PingHandle <> -1 then
-  begin
-    try
-      ipo.TTL := FTTL;
-      ipo.TOS := 0;
-      ipo.Flags := 0;
-      ipo.OptionsSize := 0;
-      ipo.OptionsData := nil;
-      setlength(RBuff, 4096);
-      if pingIp6 then
-      begin
-        FillChar(ip6, sizeof(ip6), 0);
-        r := Icmp6SendEcho2(PingHandle, nil, nil, nil, @ip6, @Fsin,
-          PAnsichar(FBuffer), length(FBuffer), @ipo, pAnsichar(RBuff), length(RBuff), FTimeout);
-        if r > 0 then
-        begin
-          RBuff := #0 + #0 + RBuff;
-          ip6reply := PICMPV6_ECHO_REPLY(pointer(RBuff));
-          FPingTime := ip6reply^.RoundTripTime;
-          ip6reply^.Address.sin6_family := AF_INET6;
-          FReplyFrom := GetSinIp(TVarSin(ip6reply^.Address));
-          TranslateErrorIpHlp(ip6reply^.Status);
-          Result := True;
-        end;
-      end
-      else
-      begin
-        r := IcmpSendEcho2(PingHandle, nil, nil, nil, Fsin.sin_addr,
-          PAnsichar(FBuffer), length(FBuffer), @ipo, pAnsichar(RBuff), length(RBuff), FTimeout);
-        if r > 0 then
-        begin
-          ip4reply := PICMP_ECHO_REPLY(pointer(RBuff));
-          FPingTime := ip4reply^.RoundTripTime;
-          FReplyFrom := IpToStr(swapbytes(ip4reply^.Address.S_addr));
-          TranslateErrorIpHlp(ip4reply^.Status);
-          Result := True;
-        end;
-      end
-    finally
-      IcmpCloseHandle(PingHandle);
-    end;
-  end;
-end;
-{$ELSE}
-begin
-  result := false;
-end;
-{$ENDIF}
-
-{==============================================================================}
-
-function PingHost(const Host: string): Integer;
-begin
-  with TPINGSend.Create do
-  try
-    Result := -1;
-    if Ping(Host) then
-      if ReplyError = IE_NoError then
-        Result := PingTime;
-  finally
-    Free;
-  end;
-end;
-
-function TraceRouteHost(const Host: string): string;
-var
-  Ping: TPingSend;
-  ttl : byte;
-begin
-  Result := '';
-  Ping := TPINGSend.Create;
-  try
-    ttl := 1;
-    repeat
-      ping.TTL := ttl;
-      inc(ttl);
-      if ttl > 30 then
-        Break;
-      if not ping.Ping(Host) then
-      begin
-        Result := Result + cAnyHost+ ' Timeout' + CRLF;
-        continue;
-      end;
-      if (ping.ReplyError <> IE_NoError)
-        and (ping.ReplyError <> IE_TTLExceed) then
-      begin
-        Result := Result + Ping.ReplyFrom + ' ' + Ping.ReplyErrorDesc + CRLF;
-        break;
-      end;
-      Result := Result + Ping.ReplyFrom + ' ' + IntToStr(Ping.PingTime) + CRLF;
-    until ping.ReplyError = IE_NoError;
-  finally
-    Ping.Free;
-  end;
-end;
-
-{$IFDEF MSWINDOWS}
-initialization
-begin
-  IcmpHelper4 := false;
-  IcmpHelper6 := false;
-  IcmpDllHandle := LoadLibrary(DLLIcmpName);
-  if IcmpDllHandle <> 0 then
-  begin
-    IcmpCreateFile := GetProcAddress(IcmpDLLHandle, 'IcmpCreateFile');
-    IcmpCloseHandle := GetProcAddress(IcmpDLLHandle, 'IcmpCloseHandle');
-    IcmpSendEcho2 := GetProcAddress(IcmpDLLHandle, 'IcmpSendEcho2');
-    Icmp6CreateFile := GetProcAddress(IcmpDLLHandle, 'Icmp6CreateFile');
-    Icmp6SendEcho2 := GetProcAddress(IcmpDLLHandle, 'Icmp6SendEcho2');
-    IcmpHelper4 := assigned(IcmpCreateFile)
-      and assigned(IcmpCloseHandle)
-      and assigned(IcmpSendEcho2);
-    IcmpHelper6 := assigned(Icmp6CreateFile)
-      and assigned(Icmp6SendEcho2);
-  end;
-end;
-
-finalization
-begin
-  FreeLibrary(IcmpDllHandle);
-end;
-{$ENDIF}
-
-end.
+{==============================================================================|
+| Project : Ararat Synapse                                       | 004.000.002 |
+|==============================================================================|
+| Content: PING sender                                                         |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2000-2010.                |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@abstract(ICMP PING implementation.)
+Allows create PING and TRACEROUTE. Or you can diagnose your network.
+
+This unit using IpHlpApi (on WinXP or higher) if available. Otherwise it trying
+ to use RAW sockets.
+
+Warning: For use of RAW sockets you must have some special rights on some
+ systems. So, it working allways when you have administator/root rights.
+ Otherwise you can have problems!
+
+Note: This unit is NOT portable to .NET!
+  Use native .NET classes for Ping instead.
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$Q-}
+{$R-}
+{$H+}
+
+{$IFDEF CIL}
+  Sorry, this unit is not for .NET!
+{$ENDIF}
+//old Delphi does not have MSWINDOWS define.
+{$IFDEF WIN32}
+  {$IFNDEF MSWINDOWS}
+    {$DEFINE MSWINDOWS}
+  {$ENDIF}
+{$ENDIF}
+
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit pingsend;
+
+interface
+
+uses
+  SysUtils,
+  synsock, blcksock, synautil, synafpc, synaip
+{$IFDEF MSWINDOWS}
+  , windows
+{$ENDIF}
+  ;
+
+const
+  ICMP_ECHO = 8;
+  ICMP_ECHOREPLY = 0;
+  ICMP_UNREACH = 3;
+  ICMP_TIME_EXCEEDED = 11;
+//rfc-2292
+  ICMP6_ECHO = 128;
+  ICMP6_ECHOREPLY = 129;
+  ICMP6_UNREACH = 1;
+  ICMP6_TIME_EXCEEDED = 3;
+
+type
+  {:List of possible ICMP reply packet types.}
+  TICMPError = (
+    IE_NoError,
+    IE_Other,
+    IE_TTLExceed,
+    IE_UnreachOther,
+    IE_UnreachRoute,
+    IE_UnreachAdmin,
+    IE_UnreachAddr,
+    IE_UnreachPort
+    );
+
+  {:@abstract(Implementation of ICMP PING and ICMPv6 PING.)}
+  TPINGSend = class(TSynaClient)
+  private
+    FSock: TICMPBlockSocket;
+    FBuffer: Ansistring;
+    FSeq: Integer;
+    FId: Integer;
+    FPacketSize: Integer;
+    FPingTime: Integer;
+    FIcmpEcho: Byte;
+    FIcmpEchoReply: Byte;
+    FIcmpUnreach: Byte;
+    FReplyFrom: string;
+    FReplyType: byte;
+    FReplyCode: byte;
+    FReplyError: TICMPError;
+    FReplyErrorDesc: string;
+    FTTL: Byte;
+    Fsin: TVarSin;
+    function Checksum(Value: AnsiString): Word;
+    function Checksum6(Value: AnsiString): Word;
+    function ReadPacket: Boolean;
+    procedure TranslateError;
+    procedure TranslateErrorIpHlp(value: integer);
+    function InternalPing(const Host: string): Boolean;
+    function InternalPingIpHlp(const Host: string): Boolean;
+    function IsHostIP6(const Host: string): Boolean;
+    procedure GenErrorDesc;
+  public
+    {:Send ICMP ping to host and count @link(pingtime). If ping OK, result is
+     @true.}
+    function Ping(const Host: string): Boolean;
+    constructor Create;
+    destructor Destroy; override;
+  published
+    {:Size of PING packet. Default size is 32 bytes.}
+    property PacketSize: Integer read FPacketSize Write FPacketSize;
+
+    {:Time between request and reply.}
+    property PingTime: Integer read FPingTime;
+
+    {:From this address is sended reply for your PING request. It maybe not your
+     requested destination, when some error occured!}
+    property ReplyFrom: string read FReplyFrom;
+
+    {:ICMP type of PING reply. Each protocol using another values! For IPv4 and
+     IPv6 are used different values!}
+    property ReplyType: byte read FReplyType;
+
+    {:ICMP code of PING reply. Each protocol using another values! For IPv4 and
+     IPv6 are used different values! For protocol independent value look to
+     @link(ReplyError)}
+    property ReplyCode: byte read FReplyCode;
+
+    {:Return type of returned ICMP message. This value is independent on used
+     protocol!}
+    property ReplyError: TICMPError read FReplyError;
+
+    {:Return human readable description of returned packet type.}
+    property ReplyErrorDesc: string read FReplyErrorDesc;
+
+    {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
+    property Sock: TICMPBlockSocket read FSock;
+
+    {:TTL value for ICMP query}
+    property TTL: byte read FTTL write FTTL;
+  end;
+
+{:A very useful function and example of its use would be found in the TPINGSend
+ object. Use it to ping to any host. If successful, returns the ping time in
+ milliseconds.  Returns -1 if an error occurred.}
+function PingHost(const Host: string): Integer;
+
+{:A very useful function and example of its use would be found in the TPINGSend
+ object. Use it to TraceRoute to any host.}
+function TraceRouteHost(const Host: string): string;
+
+implementation
+
+type
+  {:Record for ICMP ECHO packet header.}
+  TIcmpEchoHeader = packed record
+    i_type: Byte;
+    i_code: Byte;
+    i_checkSum: Word;
+    i_Id: Word;
+    i_seq: Word;
+    TimeStamp: integer;
+  end;
+
+  {:record used internally by TPingSend for compute checksum of ICMPv6 packet
+   pseudoheader.}
+  TICMP6Packet = packed record
+    in_source: TInAddr6;
+    in_dest: TInAddr6;
+    Length: integer;
+    free0: Byte;
+    free1: Byte;
+    free2: Byte;
+    proto: Byte;
+  end;
+
+{$IFDEF MSWINDOWS}
+const
+  DLLIcmpName = 'iphlpapi.dll';
+type
+  TIP_OPTION_INFORMATION = record
+    TTL: Byte;
+    TOS: Byte;
+    Flags: Byte;
+    OptionsSize: Byte;
+    OptionsData: PAnsiChar;
+  end;
+  PIP_OPTION_INFORMATION = ^TIP_OPTION_INFORMATION;
+
+  TICMP_ECHO_REPLY = record
+    Address: TInAddr;
+    Status: integer;
+    RoundTripTime: integer;
+    DataSize: Word;
+    Reserved: Word;
+    Data: pointer;
+    Options: TIP_OPTION_INFORMATION;
+  end;
+  PICMP_ECHO_REPLY = ^TICMP_ECHO_REPLY;
+
+  TICMPV6_ECHO_REPLY = record
+    Address: TSockAddrIn6;
+    Status: integer;
+    RoundTripTime: integer;
+  end;
+  PICMPV6_ECHO_REPLY = ^TICMPV6_ECHO_REPLY;
+
+  TIcmpCreateFile = function: integer; stdcall;
+  TIcmpCloseHandle = function(handle: integer): boolean; stdcall;
+  TIcmpSendEcho2 = function(handle: integer; Event: pointer; ApcRoutine: pointer;
+    ApcContext: pointer; DestinationAddress: TInAddr; RequestData: pointer;
+    RequestSize: integer; RequestOptions: PIP_OPTION_INFORMATION;
+    ReplyBuffer: pointer; ReplySize: integer; Timeout: Integer): integer; stdcall;
+  TIcmp6CreateFile = function: integer; stdcall;
+  TIcmp6SendEcho2 = function(handle: integer; Event: pointer; ApcRoutine: pointer;
+    ApcContext: pointer; SourceAddress: PSockAddrIn6; DestinationAddress: PSockAddrIn6;
+    RequestData: pointer; RequestSize: integer; RequestOptions: PIP_OPTION_INFORMATION;
+    ReplyBuffer: pointer; ReplySize: integer; Timeout: Integer): integer; stdcall;
+
+var
+  IcmpDllHandle: TLibHandle = 0;
+  IcmpHelper4: boolean = false;
+  IcmpHelper6: boolean = false;
+  IcmpCreateFile: TIcmpCreateFile = nil;
+  IcmpCloseHandle: TIcmpCloseHandle = nil;
+  IcmpSendEcho2: TIcmpSendEcho2 = nil;
+  Icmp6CreateFile: TIcmp6CreateFile = nil;
+  Icmp6SendEcho2: TIcmp6SendEcho2 = nil;
+{$ENDIF}
+{==============================================================================}
+
+constructor TPINGSend.Create;
+begin
+  inherited Create;
+  FSock := TICMPBlockSocket.Create;
+  FSock.Owner := self;
+  FTimeout := 5000;
+  FPacketSize := 32;
+  FSeq := 0;
+  Randomize;
+  FTTL := 128;
+end;
+
+destructor TPINGSend.Destroy;
+begin
+  FSock.Free;
+  inherited Destroy;
+end;
+
+function TPINGSend.ReadPacket: Boolean;
+begin
+  FBuffer := FSock.RecvPacket(Ftimeout);
+  Result := FSock.LastError = 0;
+end;
+
+procedure TPINGSend.GenErrorDesc;
+begin
+  case FReplyError of
+    IE_NoError:
+      FReplyErrorDesc := '';
+    IE_Other:
+      FReplyErrorDesc := 'Unknown error';
+    IE_TTLExceed:
+      FReplyErrorDesc := 'TTL Exceeded';
+    IE_UnreachOther:
+      FReplyErrorDesc := 'Unknown unreachable';
+    IE_UnreachRoute:
+      FReplyErrorDesc := 'No route to destination';
+    IE_UnreachAdmin:
+      FReplyErrorDesc := 'Administratively prohibited';
+    IE_UnreachAddr:
+      FReplyErrorDesc := 'Address unreachable';
+    IE_UnreachPort:
+      FReplyErrorDesc := 'Port unreachable';
+  end;
+end;
+
+function TPINGSend.IsHostIP6(const Host: string): Boolean;
+var
+  f: integer;
+begin
+  f := AF_UNSPEC;
+  if IsIp(Host) then
+    f := AF_INET
+  else
+    if IsIp6(Host) then
+      f := AF_INET6;
+  synsock.SetVarSin(Fsin, host, '0', f,
+    IPPROTO_UDP, SOCK_DGRAM, Fsock.PreferIP4);
+  result := Fsin.sin_family = AF_INET6;
+end;
+
+function TPINGSend.Ping(const Host: string): Boolean;
+var
+  b: boolean;
+begin
+  FPingTime := -1;
+  FReplyFrom := '';
+  FReplyType := 0;
+  FReplyCode := 0;
+  FReplyError := IE_Other;
+  GenErrorDesc;
+  FBuffer := StringOfChar(#55, SizeOf(TICMPEchoHeader) + FPacketSize);
+{$IFDEF MSWINDOWS}
+  b := IsHostIP6(host);
+  if not(b) and IcmpHelper4 then
+    result := InternalPingIpHlp(host)
+  else
+    if b and IcmpHelper6 then
+      result := InternalPingIpHlp(host)
+    else
+      result := InternalPing(host);
+{$ELSE}
+   result := InternalPing(host);
+{$ENDIF}
+end;
+
+function TPINGSend.InternalPing(const Host: string): Boolean;
+var
+  IPHeadPtr: ^TIPHeader;
+  IpHdrLen: Integer;
+  IcmpEchoHeaderPtr: ^TICMPEchoHeader;
+  t: Boolean;
+  x: cardinal;
+  IcmpReqHead: string;
+begin
+  Result := False;
+  FSock.TTL := FTTL;
+  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;
+    FIcmpUnreach := ICMP6_UNREACH;
+  end
+  else
+  begin
+    FIcmpEcho := ICMP_ECHO;
+    FIcmpEchoReply := ICMP_ECHOREPLY;
+    FIcmpUnreach := ICMP_UNREACH;
+  end;
+  IcmpEchoHeaderPtr := Pointer(FBuffer);
+  with IcmpEchoHeaderPtr^ do
+  begin
+    i_type := FIcmpEcho;
+    i_code := 0;
+    i_CheckSum := 0;
+    FId := System.Random(32767);
+    i_Id := FId;
+    TimeStamp := GetTick;
+    Inc(FSeq);
+    i_Seq := FSeq;
+    if fSock.IP6used then
+      i_CheckSum := CheckSum6(FBuffer)
+    else
+      i_CheckSum := CheckSum(FBuffer);
+  end;
+  FSock.SendString(FBuffer);
+  // remember first 8 bytes of ICMP packet
+  IcmpReqHead := Copy(FBuffer, 1, 8);
+  x := GetTick;
+  repeat
+    t := ReadPacket;
+    if not t then
+      break;
+    if fSock.IP6used then
+    begin
+{$IFNDEF MSWINDOWS}
+      IcmpEchoHeaderPtr := Pointer(FBuffer);
+{$ELSE}
+//WinXP SP1 with networking update doing this think by another way ;-O
+//      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;
+  //check for timeout
+    if TickDelta(x, GetTick) > FTimeout then
+    begin
+      t := false;
+      Break;
+    end;
+  //it discard sometimes possible 'echoes' of previosly sended packet
+  //or other unwanted ICMP packets...
+  until (IcmpEchoHeaderPtr^.i_type <> FIcmpEcho)
+    and ((IcmpEchoHeaderPtr^.i_id = FId)
+    or (Pos(IcmpReqHead, FBuffer) > 0));
+  if t then
+    begin
+      FPingTime := TickDelta(x, GetTick);
+      FReplyFrom := FSock.GetRemoteSinIP;
+      FReplyType := IcmpEchoHeaderPtr^.i_type;
+      FReplyCode := IcmpEchoHeaderPtr^.i_code;
+      TranslateError;
+      Result := True;
+    end;
+end;
+
+function TPINGSend.Checksum(Value: AnsiString): Word;
+var
+  CkSum: integer;
+  Num, Remain: Integer;
+  n, i: Integer;
+begin
+  Num := Length(Value) div 2;
+  Remain := Length(Value) mod 2;
+  CkSum := 0;
+  i := 1;
+  for n := 0 to Num - 1 do
+  begin
+    CkSum := CkSum + Synsock.HtoNs(DecodeInt(Value, i));
+    inc(i, 2);
+  end;
+  if Remain <> 0 then
+    CkSum := CkSum + Ord(Value[Length(Value)]);
+  CkSum := (CkSum shr 16) + (CkSum and $FFFF);
+  CkSum := CkSum + (CkSum shr 16);
+  Result := Word(not CkSum);
+end;
+
+function TPINGSend.Checksum6(Value: AnsiString): 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: AnsiString;
+  b: integer;
+  ip6: TSockAddrIn6;
+  x: integer;
+begin
+  Result := 0;
+{$IFDEF MSWINDOWS}
+  s := StringOfChar(#0, SizeOf(TICMP6Packet)) + Value;
+  ICMP6Ptr := Pointer(s);
+  x := synsock.WSAIoctl(FSock.Socket, SIO_ROUTING_INTERFACE_QUERY,
+    @FSock.RemoteSin, SizeOf(FSock.RemoteSin),
+    @ip6, SizeOf(ip6), @b, nil, nil);
+  if x <> -1 then
+    ICMP6Ptr^.in_dest := ip6.sin6_addr
+  else
+    ICMP6Ptr^.in_dest := FSock.LocalSin.sin6_addr;
+  ICMP6Ptr^.in_source := FSock.RemoteSin.sin6_addr;
+  ICMP6Ptr^.Length := synsock.htonl(Length(Value));
+  ICMP6Ptr^.proto := IPPROTO_ICMPV6;
+  Result := Checksum(s);
+{$ENDIF}
+end;
+
+procedure TPINGSend.TranslateError;
+begin
+  if fSock.IP6used then
+  begin
+    case FReplyType of
+      ICMP6_ECHOREPLY:
+        FReplyError := IE_NoError;
+      ICMP6_TIME_EXCEEDED:
+        FReplyError := IE_TTLExceed;
+      ICMP6_UNREACH:
+        case FReplyCode of
+          0:
+            FReplyError := IE_UnreachRoute;
+          3:
+            FReplyError := IE_UnreachAddr;
+          4:
+            FReplyError := IE_UnreachPort;
+          1:
+            FReplyError := IE_UnreachAdmin;
+        else
+          FReplyError := IE_UnreachOther;
+        end;
+    else
+      FReplyError := IE_Other;
+    end;
+  end
+  else
+  begin
+    case FReplyType of
+      ICMP_ECHOREPLY:
+        FReplyError := IE_NoError;
+      ICMP_TIME_EXCEEDED:
+        FReplyError := IE_TTLExceed;
+      ICMP_UNREACH:
+        case FReplyCode of
+          0:
+            FReplyError := IE_UnreachRoute;
+          1:
+            FReplyError := IE_UnreachAddr;
+          3:
+            FReplyError := IE_UnreachPort;
+          13:
+            FReplyError := IE_UnreachAdmin;
+        else
+          FReplyError := IE_UnreachOther;
+        end;
+    else
+      FReplyError := IE_Other;
+    end;
+  end;
+  GenErrorDesc;
+end;
+
+procedure TPINGSend.TranslateErrorIpHlp(value: integer);
+begin
+  case value of
+    11000, 0:
+      FReplyError := IE_NoError;
+    11013:
+      FReplyError := IE_TTLExceed;
+    11002:
+      FReplyError := IE_UnreachRoute;
+    11003:
+      FReplyError := IE_UnreachAddr;
+    11005:
+      FReplyError := IE_UnreachPort;
+    11004:
+      FReplyError := IE_UnreachAdmin;
+  else
+    FReplyError := IE_Other;
+  end;
+  GenErrorDesc;
+end;
+
+function TPINGSend.InternalPingIpHlp(const Host: string): Boolean;
+{$IFDEF MSWINDOWS}
+var
+  PingIp6: boolean;
+  PingHandle: integer;
+  r: integer;
+  ipo: TIP_OPTION_INFORMATION;
+  RBuff: Ansistring;
+  ip4reply: PICMP_ECHO_REPLY;
+  ip6reply: PICMPV6_ECHO_REPLY;
+  ip6: TSockAddrIn6;
+begin
+  Result := False;
+  PingIp6 := Fsin.sin_family = AF_INET6;
+  if pingIp6 then
+    PingHandle := Icmp6CreateFile
+  else
+    PingHandle := IcmpCreateFile;
+  if PingHandle <> -1 then
+  begin
+    try
+      ipo.TTL := FTTL;
+      ipo.TOS := 0;
+      ipo.Flags := 0;
+      ipo.OptionsSize := 0;
+      ipo.OptionsData := nil;
+      setlength(RBuff, 4096);
+      if pingIp6 then
+      begin
+        FillChar(ip6, sizeof(ip6), 0);
+        r := Icmp6SendEcho2(PingHandle, nil, nil, nil, @ip6, @Fsin,
+          PAnsichar(FBuffer), length(FBuffer), @ipo, pAnsichar(RBuff), length(RBuff), FTimeout);
+        if r > 0 then
+        begin
+          RBuff := #0 + #0 + RBuff;
+          ip6reply := PICMPV6_ECHO_REPLY(pointer(RBuff));
+          FPingTime := ip6reply^.RoundTripTime;
+          ip6reply^.Address.sin6_family := AF_INET6;
+          FReplyFrom := GetSinIp(TVarSin(ip6reply^.Address));
+          TranslateErrorIpHlp(ip6reply^.Status);
+          Result := True;
+        end;
+      end
+      else
+      begin
+        r := IcmpSendEcho2(PingHandle, nil, nil, nil, Fsin.sin_addr,
+          PAnsichar(FBuffer), length(FBuffer), @ipo, pAnsichar(RBuff), length(RBuff), FTimeout);
+        if r > 0 then
+        begin
+          ip4reply := PICMP_ECHO_REPLY(pointer(RBuff));
+          FPingTime := ip4reply^.RoundTripTime;
+          FReplyFrom := IpToStr(swapbytes(ip4reply^.Address.S_addr));
+          TranslateErrorIpHlp(ip4reply^.Status);
+          Result := True;
+        end;
+      end
+    finally
+      IcmpCloseHandle(PingHandle);
+    end;
+  end;
+end;
+{$ELSE}
+begin
+  result := false;
+end;
+{$ENDIF}
+
+{==============================================================================}
+
+function PingHost(const Host: string): Integer;
+begin
+  with TPINGSend.Create do
+  try
+    Result := -1;
+    if Ping(Host) then
+      if ReplyError = IE_NoError then
+        Result := PingTime;
+  finally
+    Free;
+  end;
+end;
+
+function TraceRouteHost(const Host: string): string;
+var
+  Ping: TPingSend;
+  ttl : byte;
+begin
+  Result := '';
+  Ping := TPINGSend.Create;
+  try
+    ttl := 1;
+    repeat
+      ping.TTL := ttl;
+      inc(ttl);
+      if ttl > 30 then
+        Break;
+      if not ping.Ping(Host) then
+      begin
+        Result := Result + cAnyHost+ ' Timeout' + CRLF;
+        continue;
+      end;
+      if (ping.ReplyError <> IE_NoError)
+        and (ping.ReplyError <> IE_TTLExceed) then
+      begin
+        Result := Result + Ping.ReplyFrom + ' ' + Ping.ReplyErrorDesc + CRLF;
+        break;
+      end;
+      Result := Result + Ping.ReplyFrom + ' ' + IntToStr(Ping.PingTime) + CRLF;
+    until ping.ReplyError = IE_NoError;
+  finally
+    Ping.Free;
+  end;
+end;
+
+{$IFDEF MSWINDOWS}
+initialization
+begin
+  IcmpHelper4 := false;
+  IcmpHelper6 := false;
+  IcmpDllHandle := LoadLibrary(DLLIcmpName);
+  if IcmpDllHandle <> 0 then
+  begin
+    IcmpCreateFile := GetProcAddress(IcmpDLLHandle, 'IcmpCreateFile');
+    IcmpCloseHandle := GetProcAddress(IcmpDLLHandle, 'IcmpCloseHandle');
+    IcmpSendEcho2 := GetProcAddress(IcmpDLLHandle, 'IcmpSendEcho2');
+    Icmp6CreateFile := GetProcAddress(IcmpDLLHandle, 'Icmp6CreateFile');
+    Icmp6SendEcho2 := GetProcAddress(IcmpDLLHandle, 'Icmp6SendEcho2');
+    IcmpHelper4 := assigned(IcmpCreateFile)
+      and assigned(IcmpCloseHandle)
+      and assigned(IcmpSendEcho2);
+    IcmpHelper6 := assigned(Icmp6CreateFile)
+      and assigned(Icmp6SendEcho2);
+  end;
+end;
+
+finalization
+begin
+  FreeLibrary(IcmpDllHandle);
+end;
+{$ENDIF}
+
+end.
diff --git a/Units/Synapse/pop3send.pas b/Units/Synapse/pop3send.pas
index 05c5ac0..90d14de 100644
--- a/Units/Synapse/pop3send.pas
+++ b/Units/Synapse/pop3send.pas
@@ -1,483 +1,483 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 002.006.002 |
-|==============================================================================|
-| Content: POP3 client                                                         |
-|==============================================================================|
-| Copyright (c)1999-2010, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2001-2010.                |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{:@abstract(POP3 protocol client)
-
-Used RFC: RFC-1734, RFC-1939, RFC-2195, RFC-2449, RFC-2595
-}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$H+}
-{$M+}
-
-{$IFDEF UNICODE}
-  {$WARN IMPLICIT_STRING_CAST OFF}
-  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
-{$ENDIF}
-
-unit pop3send;
-
-interface
-
-uses
-  SysUtils, Classes,
-  blcksock, synautil, synacode;
-
-const
-  cPop3Protocol = '110';
-
-type
-
-  {:The three types of possible authorization methods for "logging in" to a POP3
-   server.}
-  TPOP3AuthType = (POP3AuthAll, POP3AuthLogin, POP3AuthAPOP);
-
-  {:@abstract(Implementation of POP3 client protocol.)
-
-   Note: Are you missing properties for setting Username and Password? Look to
-   parent @link(TSynaClient) object!
-
-   Are you missing properties for specify server address and port? Look to
-   parent @link(TSynaClient) too!}
-  TPOP3Send = class(TSynaClient)
-  private
-    FSock: TTCPBlockSocket;
-    FResultCode: Integer;
-    FResultString: string;
-    FFullResult: TStringList;
-    FStatCount: Integer;
-    FStatSize: Integer;
-    FListSize: Integer;
-    FTimeStamp: string;
-    FAuthType: TPOP3AuthType;
-    FPOP3cap: TStringList;
-    FAutoTLS: Boolean;
-    FFullSSL: Boolean;
-    function ReadResult(Full: Boolean): Integer;
-    function Connect: Boolean;
-    function AuthLogin: Boolean;
-    function AuthApop: Boolean;
-  public
-    constructor Create;
-    destructor Destroy; override;
-
-    {:You can call any custom by this method. Call Command without trailing CRLF.
-      If MultiLine parameter is @true, multilined response are expected.
-      Result is @true on sucess.}
-    function CustomCommand(const Command: string; MultiLine: Boolean): boolean;
-
-    {:Call CAPA command for get POP3 server capabilites.
-     note: not all servers support this command!}
-    function Capability: Boolean;
-
-    {:Connect to remote POP3 host. If all OK, result is @true.}
-    function Login: Boolean;
-
-    {:Disconnects from POP3 server.}
-    function Logout: Boolean;
-
-    {:Send RSET command. If all OK, result is @true.}
-    function Reset: Boolean;
-
-    {:Send NOOP command. If all OK, result is @true.}
-    function NoOp: Boolean;
-
-    {:Send STAT command and fill @link(StatCount) and @link(StatSize) property.
-     If all OK, result is @true.}
-    function Stat: Boolean;
-
-    {:Send LIST command. If Value is 0, LIST is for all messages. After
-     successful operation is listing in FullResult. If all OK, result is @True.}
-    function List(Value: Integer): Boolean;
-
-    {:Send RETR command. After successful operation dowloaded message in
-     @link(FullResult). If all OK, result is @true.}
-    function Retr(Value: Integer): Boolean;
-
-    {:Send RETR command. After successful operation dowloaded message in
-     @link(Stream). If all OK, result is @true.}
-    function RetrStream(Value: Integer; Stream: TStream): Boolean;
-
-    {:Send DELE command for delete specified message. If all OK, result is @true.}
-    function Dele(Value: Integer): Boolean;
-
-    {:Send TOP command. After successful operation dowloaded headers of message
-     and maxlines count of message in @link(FullResult). If all OK, result is
-     @true.}
-    function Top(Value, Maxlines: Integer): Boolean;
-
-    {:Send UIDL command. If Value is 0, UIDL is for all messages. After
-     successful operation is listing in FullResult. If all OK, result is @True.}
-    function Uidl(Value: Integer): Boolean;
-
-    {:Call STLS command for upgrade connection to SSL/TLS mode.}
-    function StartTLS: Boolean;
-
-    {:Try to find given capabily in capabilty string returned from POP3 server
-     by CAPA command.}
-    function FindCap(const Value: string): string;
-  published
-    {:Result code of last POP3 operation. 0 - error, 1 - OK.}
-    property ResultCode: Integer read FResultCode;
-
-    {:Result string of last POP3 operation.}
-    property ResultString: string read FResultString;
-
-    {:Stringlist with full lines returned as result of POP3 operation. I.e. if
-     operation is LIST, this property is filled by list of messages. If
-     operation is RETR, this property have downloaded message.}
-    property FullResult: TStringList read FFullResult;
-
-    {:After STAT command is there count of messages in inbox.}
-    property StatCount: Integer read FStatCount;
-
-    {:After STAT command is there size of all messages in inbox.}
-    property StatSize: Integer read  FStatSize;
-
-    {:After LIST 0 command size of all messages on server, After LIST x size of message x on server}
-    property ListSize: Integer read  FListSize;
-
-    {:If server support this, after comnnect is in this property timestamp of
-     remote server.}
-    property TimeStamp: string read FTimeStamp;
-
-    {:Type of authorisation for login to POP3 server. Dafault is autodetect one
-     of possible authorisation. Autodetect do this:
-
-     If remote POP3 server support APOP, try login by APOP method. If APOP is
-     not supported, or if APOP login failed, try classic USER+PASS login method.}
-    property AuthType: TPOP3AuthType read FAuthType Write FAuthType;
-
-    {:If is set to @true, then upgrade to SSL/TLS mode if remote server support it.}
-    property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
-
-    {:SSL/TLS mode is used from first contact to server. Servers with full
-     SSL/TLS mode usualy using non-standard TCP port!}
-    property FullSSL: Boolean read FFullSSL Write FFullSSL;
-    {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
-    property Sock: TTCPBlockSocket read FSock;
-  end;
-
-implementation
-
-constructor TPOP3Send.Create;
-begin
-  inherited Create;
-  FFullResult := TStringList.Create;
-  FPOP3cap := TStringList.Create;
-  FSock := TTCPBlockSocket.Create;
-  FSock.Owner := self;
-  FSock.ConvertLineEnd := true;
-  FTimeout := 60000;
-  FTargetPort := cPop3Protocol;
-  FStatCount := 0;
-  FStatSize := 0;
-  FListSize := 0;
-  FAuthType := POP3AuthAll;
-  FAutoTLS := False;
-  FFullSSL := False;
-end;
-
-destructor TPOP3Send.Destroy;
-begin
-  FSock.Free;
-  FPOP3cap.Free;
-  FullResult.Free;
-  inherited Destroy;
-end;
-
-function TPOP3Send.ReadResult(Full: Boolean): Integer;
-var
-  s: AnsiString;
-begin
-  Result := 0;
-  FFullResult.Clear;
-  s := FSock.RecvString(FTimeout);
-  if Pos('+OK', s) = 1 then
-    Result := 1;
-  FResultString := s;
-  if Full and (Result = 1) then
-    repeat
-      s := FSock.RecvString(FTimeout);
-      if s = '.' then
-        Break;
-      if s <> '' then
-        if s[1] = '.' then
-          Delete(s, 1, 1);
-      FFullResult.Add(s);
-    until FSock.LastError <> 0;
-  if not Full and (Result = 1) then
-    FFullResult.Add(SeparateRight(FResultString, ' '));
-  if FSock.LastError <> 0 then
-    Result := 0;
-  FResultCode := Result;
-end;
-
-function TPOP3Send.CustomCommand(const Command: string; MultiLine: Boolean): boolean;
-begin
-  FSock.SendString(Command + CRLF);
-  Result := ReadResult(MultiLine) <> 0;
-end;
-
-function TPOP3Send.AuthLogin: Boolean;
-begin
-  Result := False;
-  if not CustomCommand('USER ' + FUserName, False) then
-    exit;
-  Result := CustomCommand('PASS ' + FPassword, False)
-end;
-
-function TPOP3Send.AuthAPOP: Boolean;
-var
-  s: string;
-begin
-  s := StrToHex(MD5(FTimeStamp + FPassWord));
-  Result := CustomCommand('APOP ' + FUserName + ' ' + s, False);
-end;
-
-function TPOP3Send.Connect: Boolean;
-begin
-  // Do not call this function! It is calling by LOGIN method!
-  FStatCount := 0;
-  FStatSize := 0;
-  FSock.CloseSocket;
-  FSock.LineBuffer := '';
-  FSock.Bind(FIPInterface, cAnyPort);
-  if FSock.LastError = 0 then
-    FSock.Connect(FTargetHost, FTargetPort);
-  if FSock.LastError = 0 then
-    if FFullSSL then
-      FSock.SSLDoConnect;
-  Result := FSock.LastError = 0;
-end;
-
-function TPOP3Send.Capability: Boolean;
-begin
-  FPOP3cap.Clear;
-  Result := CustomCommand('CAPA', True);
-  if Result then
-    FPOP3cap.AddStrings(FFullResult);
-end;
-
-function TPOP3Send.Login: Boolean;
-var
-  s, s1: string;
-begin
-  Result := False;
-  FTimeStamp := '';
-  if not Connect then
-    Exit;
-  if ReadResult(False) <> 1 then
-    Exit;
-  s := SeparateRight(FResultString, '<');
-  if s <> FResultString then
-  begin
-    s1 := Trim(SeparateLeft(s, '>'));
-    if s1 <> s then
-      FTimeStamp := '<' + s1 + '>';
-  end;
-  Result := False;
-  if Capability then
-    if FAutoTLS and (Findcap('STLS') <> '') then
-      if StartTLS then
-        Capability
-      else
-      begin
-        Result := False;
-        Exit;
-      end;
-  if (FTimeStamp <> '') and not (FAuthType = POP3AuthLogin) then
-  begin
-    Result := AuthApop;
-    if not Result then
-    begin
-      if not Connect then
-        Exit;
-      if ReadResult(False) <> 1 then
-        Exit;
-    end;
-  end;
-  if not Result and not (FAuthType = POP3AuthAPOP) then
-    Result := AuthLogin;
-end;
-
-function TPOP3Send.Logout: Boolean;
-begin
-  Result := CustomCommand('QUIT', False);
-  FSock.CloseSocket;
-end;
-
-function TPOP3Send.Reset: Boolean;
-begin
-  Result := CustomCommand('RSET', False);
-end;
-
-function TPOP3Send.NoOp: Boolean;
-begin
-  Result := CustomCommand('NOOP', False);
-end;
-
-function TPOP3Send.Stat: Boolean;
-var
-  s: string;
-begin
-  Result := CustomCommand('STAT', False);
-  if Result then
-  begin
-    s := SeparateRight(ResultString, '+OK ');
-    FStatCount := StrToIntDef(Trim(SeparateLeft(s, ' ')), 0);
-    FStatSize := StrToIntDef(Trim(SeparateRight(s, ' ')), 0);
-  end;
-end;
-
-function TPOP3Send.List(Value: Integer): Boolean;
-var
-  s: string;
-  n: integer;
-begin
-  if Value = 0 then
-    s := 'LIST'
-  else
-    s := 'LIST ' + IntToStr(Value);
-  Result := CustomCommand(s, Value = 0);
-  FListSize := 0;
-  if Result then
-    if Value <> 0 then
-    begin
-      s := SeparateRight(ResultString, '+OK ');
-      FListSize := StrToIntDef(SeparateLeft(SeparateRight(s, ' '), ' '), 0);
-    end
-    else
-      for n := 0 to FFullResult.Count - 1 do
-        FListSize := FListSize + StrToIntDef(SeparateLeft(SeparateRight(s, ' '), ' '), 0);
-end;
-
-function TPOP3Send.Retr(Value: Integer): Boolean;
-begin
-  Result := CustomCommand('RETR ' + IntToStr(Value), True);
-end;
-
-//based on code by Miha Vrhovnik
-function TPOP3Send.RetrStream(Value: Integer; Stream: TStream): Boolean;
-var
-  s: string;
-begin
-  Result := False;
-  FFullResult.Clear;
-  Stream.Size := 0;
-  FSock.SendString('RETR ' + IntToStr(Value) + CRLF);
-
-  s := FSock.RecvString(FTimeout);
-  if Pos('+OK', s) = 1 then
-    Result := True;
-  FResultString := s;
-  if Result then begin
-    repeat
-      s := FSock.RecvString(FTimeout);
-      if s = '.' then
-        Break;
-      if s <> '' then begin
-        if s[1] = '.' then
-          Delete(s, 1, 1);
-      end;
-      WriteStrToStream(Stream, s);
-      WriteStrToStream(Stream, CRLF);
-    until FSock.LastError <> 0;
-  end;
-
-  if Result then
-    FResultCode := 1
-  else
-    FResultCode := 0;
-end;
-
-function TPOP3Send.Dele(Value: Integer): Boolean;
-begin
-  Result := CustomCommand('DELE ' + IntToStr(Value), False);
-end;
-
-function TPOP3Send.Top(Value, Maxlines: Integer): Boolean;
-begin
-  Result := CustomCommand('TOP ' + IntToStr(Value) + ' ' + IntToStr(Maxlines), True);
-end;
-
-function TPOP3Send.Uidl(Value: Integer): Boolean;
-var
-  s: string;
-begin
-  if Value = 0 then
-    s := 'UIDL'
-  else
-    s := 'UIDL ' + IntToStr(Value);
-  Result := CustomCommand(s, Value = 0);
-end;
-
-function TPOP3Send.StartTLS: Boolean;
-begin
-  Result := False;
-  if CustomCommand('STLS', False) then
-  begin
-    Fsock.SSLDoConnect;
-    Result := FSock.LastError = 0;
-  end;
-end;
-
-function TPOP3Send.FindCap(const Value: string): string;
-var
-  n: Integer;
-  s: string;
-begin
-  s := UpperCase(Value);
-  Result := '';
-  for n := 0 to FPOP3cap.Count - 1 do
-    if Pos(s, UpperCase(FPOP3cap[n])) = 1 then
-    begin
-      Result := FPOP3cap[n];
-      Break;
-    end;
-end;
-
-end.
+{==============================================================================|
+| Project : Ararat Synapse                                       | 002.006.002 |
+|==============================================================================|
+| Content: POP3 client                                                         |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2001-2010.                |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@abstract(POP3 protocol client)
+
+Used RFC: RFC-1734, RFC-1939, RFC-2195, RFC-2449, RFC-2595
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+{$M+}
+
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit pop3send;
+
+interface
+
+uses
+  SysUtils, Classes,
+  blcksock, synautil, synacode;
+
+const
+  cPop3Protocol = '110';
+
+type
+
+  {:The three types of possible authorization methods for "logging in" to a POP3
+   server.}
+  TPOP3AuthType = (POP3AuthAll, POP3AuthLogin, POP3AuthAPOP);
+
+  {:@abstract(Implementation of POP3 client protocol.)
+
+   Note: Are you missing properties for setting Username and Password? Look to
+   parent @link(TSynaClient) object!
+
+   Are you missing properties for specify server address and port? Look to
+   parent @link(TSynaClient) too!}
+  TPOP3Send = class(TSynaClient)
+  private
+    FSock: TTCPBlockSocket;
+    FResultCode: Integer;
+    FResultString: string;
+    FFullResult: TStringList;
+    FStatCount: Integer;
+    FStatSize: Integer;
+    FListSize: Integer;
+    FTimeStamp: string;
+    FAuthType: TPOP3AuthType;
+    FPOP3cap: TStringList;
+    FAutoTLS: Boolean;
+    FFullSSL: Boolean;
+    function ReadResult(Full: Boolean): Integer;
+    function Connect: Boolean;
+    function AuthLogin: Boolean;
+    function AuthApop: Boolean;
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    {:You can call any custom by this method. Call Command without trailing CRLF.
+      If MultiLine parameter is @true, multilined response are expected.
+      Result is @true on sucess.}
+    function CustomCommand(const Command: string; MultiLine: Boolean): boolean;
+
+    {:Call CAPA command for get POP3 server capabilites.
+     note: not all servers support this command!}
+    function Capability: Boolean;
+
+    {:Connect to remote POP3 host. If all OK, result is @true.}
+    function Login: Boolean;
+
+    {:Disconnects from POP3 server.}
+    function Logout: Boolean;
+
+    {:Send RSET command. If all OK, result is @true.}
+    function Reset: Boolean;
+
+    {:Send NOOP command. If all OK, result is @true.}
+    function NoOp: Boolean;
+
+    {:Send STAT command and fill @link(StatCount) and @link(StatSize) property.
+     If all OK, result is @true.}
+    function Stat: Boolean;
+
+    {:Send LIST command. If Value is 0, LIST is for all messages. After
+     successful operation is listing in FullResult. If all OK, result is @True.}
+    function List(Value: Integer): Boolean;
+
+    {:Send RETR command. After successful operation dowloaded message in
+     @link(FullResult). If all OK, result is @true.}
+    function Retr(Value: Integer): Boolean;
+
+    {:Send RETR command. After successful operation dowloaded message in
+     @link(Stream). If all OK, result is @true.}
+    function RetrStream(Value: Integer; Stream: TStream): Boolean;
+
+    {:Send DELE command for delete specified message. If all OK, result is @true.}
+    function Dele(Value: Integer): Boolean;
+
+    {:Send TOP command. After successful operation dowloaded headers of message
+     and maxlines count of message in @link(FullResult). If all OK, result is
+     @true.}
+    function Top(Value, Maxlines: Integer): Boolean;
+
+    {:Send UIDL command. If Value is 0, UIDL is for all messages. After
+     successful operation is listing in FullResult. If all OK, result is @True.}
+    function Uidl(Value: Integer): Boolean;
+
+    {:Call STLS command for upgrade connection to SSL/TLS mode.}
+    function StartTLS: Boolean;
+
+    {:Try to find given capabily in capabilty string returned from POP3 server
+     by CAPA command.}
+    function FindCap(const Value: string): string;
+  published
+    {:Result code of last POP3 operation. 0 - error, 1 - OK.}
+    property ResultCode: Integer read FResultCode;
+
+    {:Result string of last POP3 operation.}
+    property ResultString: string read FResultString;
+
+    {:Stringlist with full lines returned as result of POP3 operation. I.e. if
+     operation is LIST, this property is filled by list of messages. If
+     operation is RETR, this property have downloaded message.}
+    property FullResult: TStringList read FFullResult;
+
+    {:After STAT command is there count of messages in inbox.}
+    property StatCount: Integer read FStatCount;
+
+    {:After STAT command is there size of all messages in inbox.}
+    property StatSize: Integer read  FStatSize;
+
+    {:After LIST 0 command size of all messages on server, After LIST x size of message x on server}
+    property ListSize: Integer read  FListSize;
+
+    {:If server support this, after comnnect is in this property timestamp of
+     remote server.}
+    property TimeStamp: string read FTimeStamp;
+
+    {:Type of authorisation for login to POP3 server. Dafault is autodetect one
+     of possible authorisation. Autodetect do this:
+
+     If remote POP3 server support APOP, try login by APOP method. If APOP is
+     not supported, or if APOP login failed, try classic USER+PASS login method.}
+    property AuthType: TPOP3AuthType read FAuthType Write FAuthType;
+
+    {:If is set to @true, then upgrade to SSL/TLS mode if remote server support it.}
+    property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
+
+    {:SSL/TLS mode is used from first contact to server. Servers with full
+     SSL/TLS mode usualy using non-standard TCP port!}
+    property FullSSL: Boolean read FFullSSL Write FFullSSL;
+    {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
+    property Sock: TTCPBlockSocket read FSock;
+  end;
+
+implementation
+
+constructor TPOP3Send.Create;
+begin
+  inherited Create;
+  FFullResult := TStringList.Create;
+  FPOP3cap := TStringList.Create;
+  FSock := TTCPBlockSocket.Create;
+  FSock.Owner := self;
+  FSock.ConvertLineEnd := true;
+  FTimeout := 60000;
+  FTargetPort := cPop3Protocol;
+  FStatCount := 0;
+  FStatSize := 0;
+  FListSize := 0;
+  FAuthType := POP3AuthAll;
+  FAutoTLS := False;
+  FFullSSL := False;
+end;
+
+destructor TPOP3Send.Destroy;
+begin
+  FSock.Free;
+  FPOP3cap.Free;
+  FullResult.Free;
+  inherited Destroy;
+end;
+
+function TPOP3Send.ReadResult(Full: Boolean): Integer;
+var
+  s: AnsiString;
+begin
+  Result := 0;
+  FFullResult.Clear;
+  s := FSock.RecvString(FTimeout);
+  if Pos('+OK', s) = 1 then
+    Result := 1;
+  FResultString := s;
+  if Full and (Result = 1) then
+    repeat
+      s := FSock.RecvString(FTimeout);
+      if s = '.' then
+        Break;
+      if s <> '' then
+        if s[1] = '.' then
+          Delete(s, 1, 1);
+      FFullResult.Add(s);
+    until FSock.LastError <> 0;
+  if not Full and (Result = 1) then
+    FFullResult.Add(SeparateRight(FResultString, ' '));
+  if FSock.LastError <> 0 then
+    Result := 0;
+  FResultCode := Result;
+end;
+
+function TPOP3Send.CustomCommand(const Command: string; MultiLine: Boolean): boolean;
+begin
+  FSock.SendString(Command + CRLF);
+  Result := ReadResult(MultiLine) <> 0;
+end;
+
+function TPOP3Send.AuthLogin: Boolean;
+begin
+  Result := False;
+  if not CustomCommand('USER ' + FUserName, False) then
+    exit;
+  Result := CustomCommand('PASS ' + FPassword, False)
+end;
+
+function TPOP3Send.AuthAPOP: Boolean;
+var
+  s: string;
+begin
+  s := StrToHex(MD5(FTimeStamp + FPassWord));
+  Result := CustomCommand('APOP ' + FUserName + ' ' + s, False);
+end;
+
+function TPOP3Send.Connect: Boolean;
+begin
+  // Do not call this function! It is calling by LOGIN method!
+  FStatCount := 0;
+  FStatSize := 0;
+  FSock.CloseSocket;
+  FSock.LineBuffer := '';
+  FSock.Bind(FIPInterface, cAnyPort);
+  if FSock.LastError = 0 then
+    FSock.Connect(FTargetHost, FTargetPort);
+  if FSock.LastError = 0 then
+    if FFullSSL then
+      FSock.SSLDoConnect;
+  Result := FSock.LastError = 0;
+end;
+
+function TPOP3Send.Capability: Boolean;
+begin
+  FPOP3cap.Clear;
+  Result := CustomCommand('CAPA', True);
+  if Result then
+    FPOP3cap.AddStrings(FFullResult);
+end;
+
+function TPOP3Send.Login: Boolean;
+var
+  s, s1: string;
+begin
+  Result := False;
+  FTimeStamp := '';
+  if not Connect then
+    Exit;
+  if ReadResult(False) <> 1 then
+    Exit;
+  s := SeparateRight(FResultString, '<');
+  if s <> FResultString then
+  begin
+    s1 := Trim(SeparateLeft(s, '>'));
+    if s1 <> s then
+      FTimeStamp := '<' + s1 + '>';
+  end;
+  Result := False;
+  if Capability then
+    if FAutoTLS and (Findcap('STLS') <> '') then
+      if StartTLS then
+        Capability
+      else
+      begin
+        Result := False;
+        Exit;
+      end;
+  if (FTimeStamp <> '') and not (FAuthType = POP3AuthLogin) then
+  begin
+    Result := AuthApop;
+    if not Result then
+    begin
+      if not Connect then
+        Exit;
+      if ReadResult(False) <> 1 then
+        Exit;
+    end;
+  end;
+  if not Result and not (FAuthType = POP3AuthAPOP) then
+    Result := AuthLogin;
+end;
+
+function TPOP3Send.Logout: Boolean;
+begin
+  Result := CustomCommand('QUIT', False);
+  FSock.CloseSocket;
+end;
+
+function TPOP3Send.Reset: Boolean;
+begin
+  Result := CustomCommand('RSET', False);
+end;
+
+function TPOP3Send.NoOp: Boolean;
+begin
+  Result := CustomCommand('NOOP', False);
+end;
+
+function TPOP3Send.Stat: Boolean;
+var
+  s: string;
+begin
+  Result := CustomCommand('STAT', False);
+  if Result then
+  begin
+    s := SeparateRight(ResultString, '+OK ');
+    FStatCount := StrToIntDef(Trim(SeparateLeft(s, ' ')), 0);
+    FStatSize := StrToIntDef(Trim(SeparateRight(s, ' ')), 0);
+  end;
+end;
+
+function TPOP3Send.List(Value: Integer): Boolean;
+var
+  s: string;
+  n: integer;
+begin
+  if Value = 0 then
+    s := 'LIST'
+  else
+    s := 'LIST ' + IntToStr(Value);
+  Result := CustomCommand(s, Value = 0);
+  FListSize := 0;
+  if Result then
+    if Value <> 0 then
+    begin
+      s := SeparateRight(ResultString, '+OK ');
+      FListSize := StrToIntDef(SeparateLeft(SeparateRight(s, ' '), ' '), 0);
+    end
+    else
+      for n := 0 to FFullResult.Count - 1 do
+        FListSize := FListSize + StrToIntDef(SeparateLeft(SeparateRight(s, ' '), ' '), 0);
+end;
+
+function TPOP3Send.Retr(Value: Integer): Boolean;
+begin
+  Result := CustomCommand('RETR ' + IntToStr(Value), True);
+end;
+
+//based on code by Miha Vrhovnik
+function TPOP3Send.RetrStream(Value: Integer; Stream: TStream): Boolean;
+var
+  s: string;
+begin
+  Result := False;
+  FFullResult.Clear;
+  Stream.Size := 0;
+  FSock.SendString('RETR ' + IntToStr(Value) + CRLF);
+
+  s := FSock.RecvString(FTimeout);
+  if Pos('+OK', s) = 1 then
+    Result := True;
+  FResultString := s;
+  if Result then begin
+    repeat
+      s := FSock.RecvString(FTimeout);
+      if s = '.' then
+        Break;
+      if s <> '' then begin
+        if s[1] = '.' then
+          Delete(s, 1, 1);
+      end;
+      WriteStrToStream(Stream, s);
+      WriteStrToStream(Stream, CRLF);
+    until FSock.LastError <> 0;
+  end;
+
+  if Result then
+    FResultCode := 1
+  else
+    FResultCode := 0;
+end;
+
+function TPOP3Send.Dele(Value: Integer): Boolean;
+begin
+  Result := CustomCommand('DELE ' + IntToStr(Value), False);
+end;
+
+function TPOP3Send.Top(Value, Maxlines: Integer): Boolean;
+begin
+  Result := CustomCommand('TOP ' + IntToStr(Value) + ' ' + IntToStr(Maxlines), True);
+end;
+
+function TPOP3Send.Uidl(Value: Integer): Boolean;
+var
+  s: string;
+begin
+  if Value = 0 then
+    s := 'UIDL'
+  else
+    s := 'UIDL ' + IntToStr(Value);
+  Result := CustomCommand(s, Value = 0);
+end;
+
+function TPOP3Send.StartTLS: Boolean;
+begin
+  Result := False;
+  if CustomCommand('STLS', False) then
+  begin
+    Fsock.SSLDoConnect;
+    Result := FSock.LastError = 0;
+  end;
+end;
+
+function TPOP3Send.FindCap(const Value: string): string;
+var
+  n: Integer;
+  s: string;
+begin
+  s := UpperCase(Value);
+  Result := '';
+  for n := 0 to FPOP3cap.Count - 1 do
+    if Pos(s, UpperCase(FPOP3cap[n])) = 1 then
+    begin
+      Result := FPOP3cap[n];
+      Break;
+    end;
+end;
+
+end.
diff --git a/Units/Synapse/slogsend.pas b/Units/Synapse/slogsend.pas
index 900f6c0..e9ba387 100644
--- a/Units/Synapse/slogsend.pas
+++ b/Units/Synapse/slogsend.pas
@@ -1,320 +1,320 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 001.002.003 |
-|==============================================================================|
-| Content: SysLog client                                                       |
-|==============================================================================|
-| Copyright (c)1999-2010, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2001-2010.                |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|    Christian Brosius                                                         |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{:@abstract(BSD SYSLOG protocol)
-
-Used RFC: RFC-3164
-}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$Q-}
-{$H+}
-
-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
-  {:@abstract(Define possible priority of Syslog message)}
-  TSyslogSeverity = (Emergency, Alert, Critical, Error, Warning, Notice, Info,
-    Debug);
-
-  {:@abstract(encoding or decoding of SYSLOG message)}
-  TSyslogMessage = class(TObject)
-  private
-    FFacility:Byte;
-    FSeverity:TSyslogSeverity;
-    FDateTime:TDateTime;
-    FTag:String;
-    FMessage:String;
-    FLocalIP:String;
-    function GetPacketBuf:String;
-    procedure SetPacketBuf(Value:String);
-  public
-    {:Reset values to defaults}
-    procedure Clear;
-  published
-    {:Define facilicity of Syslog message. For specify you may use predefined
-     FCL_* constants. Default is "FCL_Local0".}
-    property Facility:Byte read FFacility write FFacility;
-
-    {:Define possible priority of Syslog message. Default is "Debug".}
-    property Severity:TSyslogSeverity read FSeverity write FSeverity;
-
-    {:date and time of Syslog message}
-    property DateTime:TDateTime read FDateTime write FDateTime;
-
-    {:This is used for identify process of this message. Default is filename
-     of your executable file.}
-    property Tag:String read FTag write FTag;
-
-    {:Text of your message for log.}
-    property LogMessage:String read FMessage write FMessage;
-
-    {:IP address of message sender.}
-    property LocalIP:String read FLocalIP write FLocalIP;
-
-    {:This property holds encoded binary SYSLOG packet}
-    property PacketBuf:String read GetPacketBuf write SetPacketBuf;
-  end;
-
-  {:@abstract(This object implement BSD SysLog client)
-
-   Note: Are you missing properties for specify server address and port? Look to
-   parent @link(TSynaClient) too!}
-  TSyslogSend = class(TSynaClient)
-  private
-    FSock: TUDPBlockSocket;
-    FSysLogMessage: TSysLogMessage;
-  public
-    constructor Create;
-    destructor Destroy; override;
-    {:Send Syslog UDP packet defined by @link(SysLogMessage).}
-    function DoIt: Boolean;
-  published
-    {:Syslog message for send}
-    property SysLogMessage:TSysLogMessage read FSysLogMessage write FSysLogMessage;
-  end;
-
-{:Simply send packet to specified Syslog server.}
-function ToSysLog(const SyslogServer: string; Facil: Byte;
-  Sever: TSyslogSeverity; const Content: string): Boolean;
-
-implementation
-
-function TSyslogMessage.GetPacketBuf:String;
-begin
-  Result := '<' + IntToStr((FFacility * 8) + Ord(FSeverity)) + '>';
-  Result := Result + CDateTime(FDateTime) + ' ';
-  Result := Result + FLocalIP + ' ';
-  Result := Result + FTag + ': ' + FMessage;
-end;
-
-procedure TSyslogMessage.SetPacketBuf(Value:String);
-var StrBuf:String;
-    IntBuf,Pos:Integer;
-begin
-  if Length(Value) < 1 then exit;
-  Pos := 1;
-  if Value[Pos] <> '<' then exit;
-  Inc(Pos);
-  // Facility and Severity
-  StrBuf := '';
-  while (Value[Pos] <> '>')do
-  begin
-    StrBuf := StrBuf + Value[Pos];
-    Inc(Pos);
-  end;
-  IntBuf := StrToInt(StrBuf);
-  FFacility := IntBuf div 8;
-  case (IntBuf mod 8)of
-    0:FSeverity := Emergency;
-    1:FSeverity := Alert;
-    2:FSeverity := Critical;
-    3:FSeverity := Error;
-    4:FSeverity := Warning;
-    5:FSeverity := Notice;
-    6:FSeverity := Info;
-    7:FSeverity := Debug;
-  end;
-  // DateTime
-  Inc(Pos);
-  StrBuf := '';
-    // Month
-  while (Value[Pos] <> ' ')do
-    begin
-      StrBuf := StrBuf + Value[Pos];
-      Inc(Pos);
-    end;
-    StrBuf := StrBuf + Value[Pos];
-    Inc(Pos);
-    // Day
-  while (Value[Pos] <> ' ')do
-    begin
-      StrBuf := StrBuf + Value[Pos];
-      Inc(Pos);
-    end;
-    StrBuf := StrBuf + Value[Pos];
-    Inc(Pos);
-    // Time
-  while (Value[Pos] <> ' ')do
-    begin
-      StrBuf := StrBuf + Value[Pos];
-      Inc(Pos);
-    end;
-  FDateTime := DecodeRFCDateTime(StrBuf);
-  Inc(Pos);
-
-  // LocalIP
-  StrBuf := '';
-  while (Value[Pos] <> ' ')do
-    begin
-      StrBuf := StrBuf + Value[Pos];
-      Inc(Pos);
-    end;
-  FLocalIP := StrBuf;
-  Inc(Pos);
-  // Tag
-  StrBuf := '';
-  while (Value[Pos] <> ':')do
-    begin
-      StrBuf := StrBuf + Value[Pos];
-      Inc(Pos);
-    end;
-  FTag := StrBuf;
-  // LogMessage
-  Inc(Pos);
-  StrBuf := '';
-  while (Pos <= Length(Value))do
-    begin
-      StrBuf := StrBuf + Value[Pos];
-      Inc(Pos);
-    end;
-  FMessage := TrimSP(StrBuf);
-end;
-
-procedure TSysLogMessage.Clear;
-begin
-  FFacility := FCL_Local0;
-  FSeverity := Debug;
-  FTag := ExtractFileName(ParamStr(0));
-  FMessage := '';
-  FLocalIP  := '0.0.0.0';
-end;
-
-//------------------------------------------------------------------------------
-
-constructor TSyslogSend.Create;
-begin
-  inherited Create;
-  FSock := TUDPBlockSocket.Create;
-  FSock.Owner := self;
-  FSysLogMessage := TSysLogMessage.Create;
-  FTargetPort := cSysLogProtocol;
-end;
-
-destructor TSyslogSend.Destroy;
-begin
-  FSock.Free;
-  FSysLogMessage.Free;
-  inherited Destroy;
-end;
-
-function TSyslogSend.DoIt: Boolean;
-var
-  L: TStringList;
-begin
-  Result := False;
-  L := TStringList.Create;
-  try
-    FSock.ResolveNameToIP(FSock.Localname, L);
-    if L.Count < 1 then
-      FSysLogMessage.LocalIP := '0.0.0.0'
-    else
-      FSysLogMessage.LocalIP := L[0];
-  finally
-    L.Free;
-  end;
-  FSysLogMessage.DateTime := Now;
-  if Length(FSysLogMessage.PacketBuf) <= 1024 then
-  begin
-    FSock.Connect(FTargetHost, FTargetPort);
-    FSock.SendString(FSysLogMessage.PacketBuf);
-    Result := FSock.LastError = 0;
-  end;
-end;
-
-{==============================================================================}
-
-function ToSysLog(const SyslogServer: string; Facil: Byte;
-  Sever: TSyslogSeverity; const Content: string): Boolean;
-begin
-  with TSyslogSend.Create do
-    try
-      TargetHost :=SyslogServer;
-      SysLogMessage.Facility := Facil;
-      SysLogMessage.Severity := Sever;
-      SysLogMessage.LogMessage := Content;
-      Result := DoIt;
-    finally
-      Free;
-    end;
-end;
-
-end.
+{==============================================================================|
+| Project : Ararat Synapse                                       | 001.002.003 |
+|==============================================================================|
+| Content: SysLog client                                                       |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2001-2010.                |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|    Christian Brosius                                                         |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@abstract(BSD SYSLOG protocol)
+
+Used RFC: RFC-3164
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$Q-}
+{$H+}
+
+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
+  {:@abstract(Define possible priority of Syslog message)}
+  TSyslogSeverity = (Emergency, Alert, Critical, Error, Warning, Notice, Info,
+    Debug);
+
+  {:@abstract(encoding or decoding of SYSLOG message)}
+  TSyslogMessage = class(TObject)
+  private
+    FFacility:Byte;
+    FSeverity:TSyslogSeverity;
+    FDateTime:TDateTime;
+    FTag:String;
+    FMessage:String;
+    FLocalIP:String;
+    function GetPacketBuf:String;
+    procedure SetPacketBuf(Value:String);
+  public
+    {:Reset values to defaults}
+    procedure Clear;
+  published
+    {:Define facilicity of Syslog message. For specify you may use predefined
+     FCL_* constants. Default is "FCL_Local0".}
+    property Facility:Byte read FFacility write FFacility;
+
+    {:Define possible priority of Syslog message. Default is "Debug".}
+    property Severity:TSyslogSeverity read FSeverity write FSeverity;
+
+    {:date and time of Syslog message}
+    property DateTime:TDateTime read FDateTime write FDateTime;
+
+    {:This is used for identify process of this message. Default is filename
+     of your executable file.}
+    property Tag:String read FTag write FTag;
+
+    {:Text of your message for log.}
+    property LogMessage:String read FMessage write FMessage;
+
+    {:IP address of message sender.}
+    property LocalIP:String read FLocalIP write FLocalIP;
+
+    {:This property holds encoded binary SYSLOG packet}
+    property PacketBuf:String read GetPacketBuf write SetPacketBuf;
+  end;
+
+  {:@abstract(This object implement BSD SysLog client)
+
+   Note: Are you missing properties for specify server address and port? Look to
+   parent @link(TSynaClient) too!}
+  TSyslogSend = class(TSynaClient)
+  private
+    FSock: TUDPBlockSocket;
+    FSysLogMessage: TSysLogMessage;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    {:Send Syslog UDP packet defined by @link(SysLogMessage).}
+    function DoIt: Boolean;
+  published
+    {:Syslog message for send}
+    property SysLogMessage:TSysLogMessage read FSysLogMessage write FSysLogMessage;
+  end;
+
+{:Simply send packet to specified Syslog server.}
+function ToSysLog(const SyslogServer: string; Facil: Byte;
+  Sever: TSyslogSeverity; const Content: string): Boolean;
+
+implementation
+
+function TSyslogMessage.GetPacketBuf:String;
+begin
+  Result := '<' + IntToStr((FFacility * 8) + Ord(FSeverity)) + '>';
+  Result := Result + CDateTime(FDateTime) + ' ';
+  Result := Result + FLocalIP + ' ';
+  Result := Result + FTag + ': ' + FMessage;
+end;
+
+procedure TSyslogMessage.SetPacketBuf(Value:String);
+var StrBuf:String;
+    IntBuf,Pos:Integer;
+begin
+  if Length(Value) < 1 then exit;
+  Pos := 1;
+  if Value[Pos] <> '<' then exit;
+  Inc(Pos);
+  // Facility and Severity
+  StrBuf := '';
+  while (Value[Pos] <> '>')do
+  begin
+    StrBuf := StrBuf + Value[Pos];
+    Inc(Pos);
+  end;
+  IntBuf := StrToInt(StrBuf);
+  FFacility := IntBuf div 8;
+  case (IntBuf mod 8)of
+    0:FSeverity := Emergency;
+    1:FSeverity := Alert;
+    2:FSeverity := Critical;
+    3:FSeverity := Error;
+    4:FSeverity := Warning;
+    5:FSeverity := Notice;
+    6:FSeverity := Info;
+    7:FSeverity := Debug;
+  end;
+  // DateTime
+  Inc(Pos);
+  StrBuf := '';
+    // Month
+  while (Value[Pos] <> ' ')do
+    begin
+      StrBuf := StrBuf + Value[Pos];
+      Inc(Pos);
+    end;
+    StrBuf := StrBuf + Value[Pos];
+    Inc(Pos);
+    // Day
+  while (Value[Pos] <> ' ')do
+    begin
+      StrBuf := StrBuf + Value[Pos];
+      Inc(Pos);
+    end;
+    StrBuf := StrBuf + Value[Pos];
+    Inc(Pos);
+    // Time
+  while (Value[Pos] <> ' ')do
+    begin
+      StrBuf := StrBuf + Value[Pos];
+      Inc(Pos);
+    end;
+  FDateTime := DecodeRFCDateTime(StrBuf);
+  Inc(Pos);
+
+  // LocalIP
+  StrBuf := '';
+  while (Value[Pos] <> ' ')do
+    begin
+      StrBuf := StrBuf + Value[Pos];
+      Inc(Pos);
+    end;
+  FLocalIP := StrBuf;
+  Inc(Pos);
+  // Tag
+  StrBuf := '';
+  while (Value[Pos] <> ':')do
+    begin
+      StrBuf := StrBuf + Value[Pos];
+      Inc(Pos);
+    end;
+  FTag := StrBuf;
+  // LogMessage
+  Inc(Pos);
+  StrBuf := '';
+  while (Pos <= Length(Value))do
+    begin
+      StrBuf := StrBuf + Value[Pos];
+      Inc(Pos);
+    end;
+  FMessage := TrimSP(StrBuf);
+end;
+
+procedure TSysLogMessage.Clear;
+begin
+  FFacility := FCL_Local0;
+  FSeverity := Debug;
+  FTag := ExtractFileName(ParamStr(0));
+  FMessage := '';
+  FLocalIP  := '0.0.0.0';
+end;
+
+//------------------------------------------------------------------------------
+
+constructor TSyslogSend.Create;
+begin
+  inherited Create;
+  FSock := TUDPBlockSocket.Create;
+  FSock.Owner := self;
+  FSysLogMessage := TSysLogMessage.Create;
+  FTargetPort := cSysLogProtocol;
+end;
+
+destructor TSyslogSend.Destroy;
+begin
+  FSock.Free;
+  FSysLogMessage.Free;
+  inherited Destroy;
+end;
+
+function TSyslogSend.DoIt: Boolean;
+var
+  L: TStringList;
+begin
+  Result := False;
+  L := TStringList.Create;
+  try
+    FSock.ResolveNameToIP(FSock.Localname, L);
+    if L.Count < 1 then
+      FSysLogMessage.LocalIP := '0.0.0.0'
+    else
+      FSysLogMessage.LocalIP := L[0];
+  finally
+    L.Free;
+  end;
+  FSysLogMessage.DateTime := Now;
+  if Length(FSysLogMessage.PacketBuf) <= 1024 then
+  begin
+    FSock.Connect(FTargetHost, FTargetPort);
+    FSock.SendString(FSysLogMessage.PacketBuf);
+    Result := FSock.LastError = 0;
+  end;
+end;
+
+{==============================================================================}
+
+function ToSysLog(const SyslogServer: string; Facil: Byte;
+  Sever: TSyslogSeverity; const Content: string): Boolean;
+begin
+  with TSyslogSend.Create do
+    try
+      TargetHost :=SyslogServer;
+      SysLogMessage.Facility := Facil;
+      SysLogMessage.Severity := Sever;
+      SysLogMessage.LogMessage := Content;
+      Result := DoIt;
+    finally
+      Free;
+    end;
+end;
+
+end.
diff --git a/Units/Synapse/smtpsend.pas b/Units/Synapse/smtpsend.pas
index 532af07..2c25343 100644
--- a/Units/Synapse/smtpsend.pas
+++ b/Units/Synapse/smtpsend.pas
@@ -1,725 +1,725 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 003.005.001 |
-|==============================================================================|
-| Content: SMTP client                                                         |
-|==============================================================================|
-| Copyright (c)1999-2010, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c) 1999-2010.               |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{:@abstract(SMTP client)
-
-Used RFC: RFC-1869, RFC-1870, RFC-1893, RFC-2034, RFC-2104, RFC-2195, RFC-2487,
- RFC-2554, RFC-2821
-}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$H+}
-
-{$IFDEF UNICODE}
-  {$WARN IMPLICIT_STRING_CAST OFF}
-  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
-{$ENDIF}
-
-unit smtpsend;
-
-interface
-
-uses
-  SysUtils, Classes,
-  blcksock, synautil, synacode;
-
-const
-  cSmtpProtocol = '25';
-
-type
-  {:@abstract(Implementation of SMTP and ESMTP procotol),
-   include some ESMTP extensions, include SSL/TLS too.
-
-   Note: Are you missing properties for setting Username and Password for ESMTP?
-   Look to parent @link(TSynaClient) object!
-
-   Are you missing properties for specify server address and port? Look to
-   parent @link(TSynaClient) too!}
-  TSMTPSend = class(TSynaClient)
-  private
-    FSock: TTCPBlockSocket;
-    FResultCode: Integer;
-    FResultString: string;
-    FFullResult: TStringList;
-    FESMTPcap: TStringList;
-    FESMTP: Boolean;
-    FAuthDone: Boolean;
-    FESMTPSize: Boolean;
-    FMaxSize: Integer;
-    FEnhCode1: Integer;
-    FEnhCode2: Integer;
-    FEnhCode3: Integer;
-    FSystemName: string;
-    FAutoTLS: Boolean;
-    FFullSSL: Boolean;
-    procedure EnhancedCode(const Value: string);
-    function ReadResult: Integer;
-    function AuthLogin: Boolean;
-    function AuthCram: Boolean;
-    function AuthPlain: Boolean;
-    function Helo: Boolean;
-    function Ehlo: Boolean;
-    function Connect: Boolean;
-  public
-    constructor Create;
-    destructor Destroy; override;
-
-    {:Connects to SMTP server (defined in @link(TSynaClient.TargetHost)) and
-     begin SMTP session. (First try ESMTP EHLO, next old HELO handshake). Parses
-     ESMTP capabilites and if you specified Username and password and remote
-     server can handle AUTH command, try login by AUTH command. Preffered login
-     method is CRAM-MD5 (if safer!). If all OK, result is @true, else result is
-     @false.}
-    function Login: Boolean;
-
-    {:Close SMTP session (QUIT command) and disconnect from SMTP server.}
-    function Logout: Boolean;
-
-    {:Send RSET SMTP command for reset SMTP session. If all OK, result is @true,
-     else result is @false.}
-    function Reset: Boolean;
-
-    {:Send NOOP SMTP command for keep SMTP session. If all OK, result is @true,
-     else result is @false.}
-    function NoOp: Boolean;
-
-    {:Send MAIL FROM SMTP command for set sender e-mail address. If sender's
-     e-mail address is empty string, transmited message is error message.
-
-     If size not 0 and remote server can handle SIZE parameter, append SIZE
-     parameter to request. If all OK, result is @true, else result is @false.}
-    function MailFrom(const Value: string; Size: Integer): Boolean;
-
-    {:Send RCPT TO SMTP command for set receiver e-mail address. It cannot be an
-     empty string. If all OK, result is @true, else result is @false.}
-    function MailTo(const Value: string): Boolean;
-
-    {:Send DATA SMTP command and transmit message data. If all OK, result is
-     @true, else result is @false.}
-    function MailData(const Value: Tstrings): Boolean;
-
-    {:Send ETRN SMTP command for start sending of remote queue for domain in
-     Value. If all OK, result is @true, else result is @false.}
-    function Etrn(const Value: string): Boolean;
-
-    {:Send VRFY SMTP command for check receiver e-mail address. It cannot be
-     an empty string. If all OK, result is @true, else result is @false.}
-    function Verify(const Value: string): Boolean;
-
-    {:Call STARTTLS command for upgrade connection to SSL/TLS mode.}
-    function StartTLS: Boolean;
-
-    {:Return string descriptive text for enhanced result codes stored in
-     @link(EnhCode1), @link(EnhCode2) and @link(EnhCode3).}
-    function EnhCodeString: string;
-
-    {:Try to find specified capability in ESMTP response.}
-    function FindCap(const Value: string): string;
-  published
-    {:result code of last SMTP command.}
-    property ResultCode: Integer read FResultCode;
-
-    {:result string of last SMTP command (begin with string representation of
-     result code).}
-    property ResultString: string read FResultString;
-
-    {:All result strings of last SMTP command (result is maybe multiline!).}
-    property FullResult: TStringList read FFullResult;
-
-    {:List of ESMTP capabilites of remote ESMTP server. (If you connect to ESMTP
-     server only!).}
-    property ESMTPcap: TStringList read FESMTPcap;
-
-    {:@TRUE if you successfuly logged to ESMTP server.}
-    property ESMTP: Boolean read FESMTP;
-
-    {:@TRUE if you successfuly pass authorisation to remote server.}
-    property AuthDone: Boolean read FAuthDone;
-
-    {:@TRUE if remote server can handle SIZE parameter.}
-    property ESMTPSize: Boolean read FESMTPSize;
-
-    {:When @link(ESMTPsize) is @TRUE, contains max length of message that remote
-     server can handle.}
-    property MaxSize: Integer read FMaxSize;
-
-    {:First digit of Enhanced result code. If last operation does not have
-     enhanced result code, values is 0.}
-    property EnhCode1: Integer read FEnhCode1;
-
-    {:Second digit of Enhanced result code. If last operation does not have
-     enhanced result code, values is 0.}
-    property EnhCode2: Integer read FEnhCode2;
-
-    {:Third digit of Enhanced result code. If last operation does not have
-     enhanced result code, values is 0.}
-    property EnhCode3: Integer read FEnhCode3;
-
-    {:name of our system used in HELO and EHLO command. Implicit value is
-     internet address of your machine.}
-    property SystemName: string read FSystemName Write FSystemName;
-
-    {:If is set to true, then upgrade to SSL/TLS mode if remote server support it.}
-    property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
-
-    {:SSL/TLS mode is used from first contact to server. Servers with full
-     SSL/TLS mode usualy using non-standard TCP port!}
-    property FullSSL: Boolean read FFullSSL Write FFullSSL;
-
-    {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
-    property Sock: TTCPBlockSocket read FSock;
-  end;
-
-{:A very useful function and example of its use would be found in the TSMTPsend
- object. Send maildata (text of e-mail with all SMTP headers! For example when
- text of message is created by @link(TMimemess) object) from "MailFrom" e-mail
- address to "MailTo" e-mail address (If you need more then one receiver, then
- separate their addresses by comma).
-
- Function sends e-mail to a SMTP server defined in "SMTPhost" parameter.
- Username and password are used for authorization to the "SMTPhost". If you
- don't want authorization, set "Username" and "Password" to empty strings. If
- e-mail message is successfully sent, the result returns @true.
-
- If you need use different port number then standard, then add this port number
- to SMTPhost after colon. (i.e. '127.0.0.1:1025')}
-function SendToRaw(const MailFrom, MailTo, SMTPHost: string;
-  const MailData: TStrings; const Username, Password: string): Boolean;
-
-{:A very useful function and example of its use would be found in the TSMTPsend
- object. Send "Maildata" (text of e-mail without any SMTP headers!) from
- "MailFrom" e-mail address to "MailTo" e-mail address with "Subject".  (If you
- need more then one receiver, then separate their addresses by comma).
-
- This function constructs all needed SMTP headers (with DATE header) and sends
- the e-mail to the SMTP server defined in the "SMTPhost" parameter. If the
- e-mail message is successfully sent, the result will be @TRUE.
-
- If you need use different port number then standard, then add this port number
- to SMTPhost after colon. (i.e. '127.0.0.1:1025')}
-function SendTo(const MailFrom, MailTo, Subject, SMTPHost: string;
-  const MailData: TStrings): Boolean;
-
-{:A very useful function and example of its use would be found in the TSMTPsend
- object. Sends "MailData" (text of e-mail without any SMTP headers!) from
- "MailFrom" e-mail address to "MailTo" e-mail address (If you need more then one
- receiver, then separate their addresses by comma).
-
- This function sends the e-mail to the SMTP server defined in the "SMTPhost"
- parameter. Username and password are used for authorization to the "SMTPhost".
- If you dont want authorization, set "Username" and "Password" to empty Strings.
- If the e-mail message is successfully sent, the result will be @TRUE.
-
- If you need use different port number then standard, then add this port number
- to SMTPhost after colon. (i.e. '127.0.0.1:1025')}
-function SendToEx(const MailFrom, MailTo, Subject, SMTPHost: string;
-  const MailData: TStrings; const Username, Password: string): Boolean;
-
-implementation
-
-constructor TSMTPSend.Create;
-begin
-  inherited Create;
-  FFullResult := TStringList.Create;
-  FESMTPcap := TStringList.Create;
-  FSock := TTCPBlockSocket.Create;
-  FSock.Owner := self;
-  FSock.ConvertLineEnd := true;
-  FTimeout := 60000;
-  FTargetPort := cSmtpProtocol;
-  FSystemName := FSock.LocalName;
-  FAutoTLS := False;
-  FFullSSL := False;
-end;
-
-destructor TSMTPSend.Destroy;
-begin
-  FSock.Free;
-  FESMTPcap.Free;
-  FFullResult.Free;
-  inherited Destroy;
-end;
-
-procedure TSMTPSend.EnhancedCode(const Value: string);
-var
-  s, t: string;
-  e1, e2, e3: Integer;
-begin
-  FEnhCode1 := 0;
-  FEnhCode2 := 0;
-  FEnhCode3 := 0;
-  s := Copy(Value, 5, Length(Value) - 4);
-  t := Trim(SeparateLeft(s, '.'));
-  s := Trim(SeparateRight(s, '.'));
-  if t = '' then
-    Exit;
-  if Length(t) > 1 then
-    Exit;
-  e1 := StrToIntDef(t, 0);
-  if e1 = 0 then
-    Exit;
-  t := Trim(SeparateLeft(s, '.'));
-  s := Trim(SeparateRight(s, '.'));
-  if t = '' then
-    Exit;
-  if Length(t) > 3 then
-    Exit;
-  e2 := StrToIntDef(t, 0);
-  t := Trim(SeparateLeft(s, ' '));
-  if t = '' then
-    Exit;
-  if Length(t) > 3 then
-    Exit;
-  e3 := StrToIntDef(t, 0);
-  FEnhCode1 := e1;
-  FEnhCode2 := e2;
-  FEnhCode3 := e3;
-end;
-
-function TSMTPSend.ReadResult: Integer;
-var
-  s: String;
-begin
-  Result := 0;
-  FFullResult.Clear;
-  repeat
-    s := FSock.RecvString(FTimeout);
-    FResultString := s;
-    FFullResult.Add(s);
-    if FSock.LastError <> 0 then
-      Break;
-  until Pos('-', s) <> 4;
-  s := FFullResult[0];
-  if Length(s) >= 3 then
-    Result := StrToIntDef(Copy(s, 1, 3), 0);
-  FResultCode := Result;
-  EnhancedCode(s);
-end;
-
-function TSMTPSend.AuthLogin: Boolean;
-begin
-  Result := False;
-  FSock.SendString('AUTH LOGIN' + CRLF);
-  if ReadResult <> 334 then
-    Exit;
-  FSock.SendString(EncodeBase64(FUsername) + CRLF);
-  if ReadResult <> 334 then
-    Exit;
-  FSock.SendString(EncodeBase64(FPassword) + CRLF);
-  Result := ReadResult = 235;
-end;
-
-function TSMTPSend.AuthCram: Boolean;
-var
-  s: ansistring;
-begin
-  Result := False;
-  FSock.SendString('AUTH CRAM-MD5' + CRLF);
-  if ReadResult <> 334 then
-    Exit;
-  s := Copy(FResultString, 5, Length(FResultString) - 4);
-  s := DecodeBase64(s);
-  s := HMAC_MD5(s, FPassword);
-  s := FUsername + ' ' + StrToHex(s);
-  FSock.SendString(EncodeBase64(s) + CRLF);
-  Result := ReadResult = 235;
-end;
-
-function TSMTPSend.AuthPlain: Boolean;
-var
-  s: ansistring;
-begin
-  Result := False;
-  s := ansichar(0) + FUsername + ansichar(0) + FPassword;
-  FSock.SendString('AUTH PLAIN ' + EncodeBase64(s) + CRLF);
-  Result := ReadResult = 235;
-end;
-
-function TSMTPSend.Connect: Boolean;
-begin
-  FSock.CloseSocket;
-  FSock.Bind(FIPInterface, cAnyPort);
-  if FSock.LastError = 0 then
-    FSock.Connect(FTargetHost, FTargetPort);
-  if FSock.LastError = 0 then
-    if FFullSSL then
-      FSock.SSLDoConnect;
-  Result := FSock.LastError = 0;
-end;
-
-function TSMTPSend.Helo: Boolean;
-var
-  x: Integer;
-begin
-  FSock.SendString('HELO ' + FSystemName + CRLF);
-  x := ReadResult;
-  Result := (x >= 250) and (x <= 259);
-end;
-
-function TSMTPSend.Ehlo: Boolean;
-var
-  x: Integer;
-begin
-  FSock.SendString('EHLO ' + FSystemName + CRLF);
-  x := ReadResult;
-  Result := (x >= 250) and (x <= 259);
-end;
-
-function TSMTPSend.Login: Boolean;
-var
-  n: Integer;
-  auths: string;
-  s: string;
-begin
-  Result := False;
-  FESMTP := True;
-  FAuthDone := False;
-  FESMTPcap.clear;
-  FESMTPSize := False;
-  FMaxSize := 0;
-  if not Connect then
-    Exit;
-  if ReadResult <> 220 then
-    Exit;
-  if not Ehlo then
-  begin
-    FESMTP := False;
-    if not Helo then
-      Exit;
-  end;
-  Result := True;
-  if FESMTP then
-  begin
-    for n := 1 to FFullResult.Count - 1 do
-      FESMTPcap.Add(Copy(FFullResult[n], 5, Length(FFullResult[n]) - 4));
-    if (not FullSSL) and FAutoTLS and (FindCap('STARTTLS') <> '') then
-      if StartTLS then
-      begin
-        Ehlo;
-        FESMTPcap.Clear;
-        for n := 1 to FFullResult.Count - 1 do
-          FESMTPcap.Add(Copy(FFullResult[n], 5, Length(FFullResult[n]) - 4));
-      end
-      else
-      begin
-        Result := False;
-        Exit;
-      end;
-    if not ((FUsername = '') and (FPassword = '')) then
-    begin
-      s := FindCap('AUTH ');
-      if s = '' then
-        s := FindCap('AUTH=');
-      auths := UpperCase(s);
-      if s <> '' then
-      begin
-        if Pos('CRAM-MD5', auths) > 0 then
-          FAuthDone := AuthCram;
-        if (not FauthDone) and (Pos('PLAIN', auths) > 0) then
-          FAuthDone := AuthPlain;
-        if (not FauthDone) and (Pos('LOGIN', auths) > 0) then
-          FAuthDone := AuthLogin;
-      end;
-    end;
-    s := FindCap('SIZE');
-    if s <> '' then
-    begin
-      FESMTPsize := True;
-      FMaxSize := StrToIntDef(Copy(s, 6, Length(s) - 5), 0);
-    end;
-  end;
-end;
-
-function TSMTPSend.Logout: Boolean;
-begin
-  FSock.SendString('QUIT' + CRLF);
-  Result := ReadResult = 221;
-  FSock.CloseSocket;
-end;
-
-function TSMTPSend.Reset: Boolean;
-begin
-  FSock.SendString('RSET' + CRLF);
-  Result := ReadResult div 100 = 2;
-end;
-
-function TSMTPSend.NoOp: Boolean;
-begin
-  FSock.SendString('NOOP' + CRLF);
-  Result := ReadResult div 100 = 2;
-end;
-
-function TSMTPSend.MailFrom(const Value: string; Size: Integer): Boolean;
-var
-  s: string;
-begin
-  s := 'MAIL FROM:<' + Value + '>';
-  if FESMTPsize and (Size > 0) then
-    s := s + ' SIZE=' + IntToStr(Size);
-  FSock.SendString(s + CRLF);
-  Result := ReadResult div 100 = 2;
-end;
-
-function TSMTPSend.MailTo(const Value: string): Boolean;
-begin
-  FSock.SendString('RCPT TO:<' + Value + '>' + CRLF);
-  Result := ReadResult div 100 = 2;
-end;
-
-function TSMTPSend.MailData(const Value: TStrings): Boolean;
-var
-  n: Integer;
-  s: string;
-  t: string;
-  x: integer;
-begin
-  Result := False;
-  FSock.SendString('DATA' + CRLF);
-  if ReadResult <> 354 then
-    Exit;
-  t := '';
-  x := 1500;
-  for n := 0 to Value.Count - 1 do
-  begin
-    s := Value[n];
-    if Length(s) >= 1 then
-      if s[1] = '.' then
-        s := '.' + s;
-    if Length(t) + Length(s) >= x then
-    begin
-      FSock.SendString(t);
-      t := '';
-    end;
-    t := t + s + CRLF;
-  end;
-  if t <> '' then
-    FSock.SendString(t);
-  FSock.SendString('.' + CRLF);
-  Result := ReadResult div 100 = 2;
-end;
-
-function TSMTPSend.Etrn(const Value: string): Boolean;
-var
-  x: Integer;
-begin
-  FSock.SendString('ETRN ' + Value + CRLF);
-  x := ReadResult;
-  Result := (x >= 250) and (x <= 259);
-end;
-
-function TSMTPSend.Verify(const Value: string): Boolean;
-var
-  x: Integer;
-begin
-  FSock.SendString('VRFY ' + Value + CRLF);
-  x := ReadResult;
-  Result := (x >= 250) and (x <= 259);
-end;
-
-function TSMTPSend.StartTLS: Boolean;
-begin
-  Result := False;
-  if FindCap('STARTTLS') <> '' then
-  begin
-    FSock.SendString('STARTTLS' + CRLF);
-    if (ReadResult = 220) and (FSock.LastError = 0) then
-    begin
-      Fsock.SSLDoConnect;
-      Result := FSock.LastError = 0;
-    end;
-  end;
-end;
-
-function TSMTPSend.EnhCodeString: string;
-var
-  s, t: string;
-begin
-  s := IntToStr(FEnhCode2) + '.' + IntToStr(FEnhCode3);
-  t := '';
-  if s = '0.0' then t := 'Other undefined Status';
-  if s = '1.0' then t := 'Other address status';
-  if s = '1.1' then t := 'Bad destination mailbox address';
-  if s = '1.2' then t := 'Bad destination system address';
-  if s = '1.3' then t := 'Bad destination mailbox address syntax';
-  if s = '1.4' then t := 'Destination mailbox address ambiguous';
-  if s = '1.5' then t := 'Destination mailbox address valid';
-  if s = '1.6' then t := 'Mailbox has moved';
-  if s = '1.7' then t := 'Bad sender''s mailbox address syntax';
-  if s = '1.8' then t := 'Bad sender''s system address';
-  if s = '2.0' then t := 'Other or undefined mailbox status';
-  if s = '2.1' then t := 'Mailbox disabled, not accepting messages';
-  if s = '2.2' then t := 'Mailbox full';
-  if s = '2.3' then t := 'Message Length exceeds administrative limit';
-  if s = '2.4' then t := 'Mailing list expansion problem';
-  if s = '3.0' then t := 'Other or undefined mail system status';
-  if s = '3.1' then t := 'Mail system full';
-  if s = '3.2' then t := 'System not accepting network messages';
-  if s = '3.3' then t := 'System not capable of selected features';
-  if s = '3.4' then t := 'Message too big for system';
-  if s = '3.5' then t := 'System incorrectly configured';
-  if s = '4.0' then t := 'Other or undefined network or routing status';
-  if s = '4.1' then t := 'No answer from host';
-  if s = '4.2' then t := 'Bad connection';
-  if s = '4.3' then t := 'Routing server failure';
-  if s = '4.4' then t := 'Unable to route';
-  if s = '4.5' then t := 'Network congestion';
-  if s = '4.6' then t := 'Routing loop detected';
-  if s = '4.7' then t := 'Delivery time expired';
-  if s = '5.0' then t := 'Other or undefined protocol status';
-  if s = '5.1' then t := 'Invalid command';
-  if s = '5.2' then t := 'Syntax error';
-  if s = '5.3' then t := 'Too many recipients';
-  if s = '5.4' then t := 'Invalid command arguments';
-  if s = '5.5' then t := 'Wrong protocol version';
-  if s = '6.0' then t := 'Other or undefined media error';
-  if s = '6.1' then t := 'Media not supported';
-  if s = '6.2' then t := 'Conversion required and prohibited';
-  if s = '6.3' then t := 'Conversion required but not supported';
-  if s = '6.4' then t := 'Conversion with loss performed';
-  if s = '6.5' then t := 'Conversion failed';
-  if s = '7.0' then t := 'Other or undefined security status';
-  if s = '7.1' then t := 'Delivery not authorized, message refused';
-  if s = '7.2' then t := 'Mailing list expansion prohibited';
-  if s = '7.3' then t := 'Security conversion required but not possible';
-  if s = '7.4' then t := 'Security features not supported';
-  if s = '7.5' then t := 'Cryptographic failure';
-  if s = '7.6' then t := 'Cryptographic algorithm not supported';
-  if s = '7.7' then t := 'Message integrity failure';
-  s := '???-';
-  if FEnhCode1 = 2 then s := 'Success-';
-  if FEnhCode1 = 4 then s := 'Persistent Transient Failure-';
-  if FEnhCode1 = 5 then s := 'Permanent Failure-';
-  Result := s + t;
-end;
-
-function TSMTPSend.FindCap(const Value: string): string;
-var
-  n: Integer;
-  s: string;
-begin
-  s := UpperCase(Value);
-  Result := '';
-  for n := 0 to FESMTPcap.Count - 1 do
-    if Pos(s, UpperCase(FESMTPcap[n])) = 1 then
-    begin
-      Result := FESMTPcap[n];
-      Break;
-    end;
-end;
-
-{==============================================================================}
-
-function SendToRaw(const MailFrom, MailTo, SMTPHost: string;
-  const MailData: TStrings; const Username, Password: string): Boolean;
-var
-  SMTP: TSMTPSend;
-  s, t: string;
-begin
-  Result := False;
-  SMTP := TSMTPSend.Create;
-  try
-// if you need SOCKS5 support, uncomment next lines:
-    // SMTP.Sock.SocksIP := '127.0.0.1';
-    // SMTP.Sock.SocksPort := '1080';
-// if you need support for upgrade session to TSL/SSL, uncomment next lines:
-    // SMTP.AutoTLS := True;
-// if you need support for TSL/SSL tunnel, uncomment next lines:
-    // SMTP.FullSSL := True;
-    SMTP.TargetHost := Trim(SeparateLeft(SMTPHost, ':'));
-    s := Trim(SeparateRight(SMTPHost, ':'));
-    if (s <> '') and (s <> SMTPHost) then
-      SMTP.TargetPort := s;
-    SMTP.Username := Username;
-    SMTP.Password := Password;
-    if SMTP.Login then
-    begin
-      if SMTP.MailFrom(GetEmailAddr(MailFrom), Length(MailData.Text)) then
-      begin
-        s := MailTo;
-        repeat
-          t := GetEmailAddr(Trim(FetchEx(s, ',', '"')));
-          if t <> '' then
-            Result := SMTP.MailTo(t);
-          if not Result then
-            Break;
-        until s = '';
-        if Result then
-          Result := SMTP.MailData(MailData);
-      end;
-      SMTP.Logout;
-    end;
-  finally
-    SMTP.Free;
-  end;
-end;
-
-function SendToEx(const MailFrom, MailTo, Subject, SMTPHost: string;
-  const MailData: TStrings; const Username, Password: string): Boolean;
-var
-  t: TStrings;
-begin
-  t := TStringList.Create;
-  try
-    t.Assign(MailData);
-    t.Insert(0, '');
-    t.Insert(0, 'X-mailer: Synapse - Delphi & Kylix TCP/IP library by Lukas Gebauer');
-    t.Insert(0, 'Subject: ' + Subject);
-    t.Insert(0, 'Date: ' + Rfc822DateTime(now));
-    t.Insert(0, 'To: ' + MailTo);
-    t.Insert(0, 'From: ' + MailFrom);
-    Result := SendToRaw(MailFrom, MailTo, SMTPHost, t, Username, Password);
-  finally
-    t.Free;
-  end;
-end;
-
-function SendTo(const MailFrom, MailTo, Subject, SMTPHost: string;
-  const MailData: TStrings): Boolean;
-begin
-  Result := SendToEx(MailFrom, MailTo, Subject, SMTPHost, MailData, '', '');
-end;
-
-end.
+{==============================================================================|
+| Project : Ararat Synapse                                       | 003.005.001 |
+|==============================================================================|
+| Content: SMTP client                                                         |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c) 1999-2010.               |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@abstract(SMTP client)
+
+Used RFC: RFC-1869, RFC-1870, RFC-1893, RFC-2034, RFC-2104, RFC-2195, RFC-2487,
+ RFC-2554, RFC-2821
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit smtpsend;
+
+interface
+
+uses
+  SysUtils, Classes,
+  blcksock, synautil, synacode;
+
+const
+  cSmtpProtocol = '25';
+
+type
+  {:@abstract(Implementation of SMTP and ESMTP procotol),
+   include some ESMTP extensions, include SSL/TLS too.
+
+   Note: Are you missing properties for setting Username and Password for ESMTP?
+   Look to parent @link(TSynaClient) object!
+
+   Are you missing properties for specify server address and port? Look to
+   parent @link(TSynaClient) too!}
+  TSMTPSend = class(TSynaClient)
+  private
+    FSock: TTCPBlockSocket;
+    FResultCode: Integer;
+    FResultString: string;
+    FFullResult: TStringList;
+    FESMTPcap: TStringList;
+    FESMTP: Boolean;
+    FAuthDone: Boolean;
+    FESMTPSize: Boolean;
+    FMaxSize: Integer;
+    FEnhCode1: Integer;
+    FEnhCode2: Integer;
+    FEnhCode3: Integer;
+    FSystemName: string;
+    FAutoTLS: Boolean;
+    FFullSSL: Boolean;
+    procedure EnhancedCode(const Value: string);
+    function ReadResult: Integer;
+    function AuthLogin: Boolean;
+    function AuthCram: Boolean;
+    function AuthPlain: Boolean;
+    function Helo: Boolean;
+    function Ehlo: Boolean;
+    function Connect: Boolean;
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    {:Connects to SMTP server (defined in @link(TSynaClient.TargetHost)) and
+     begin SMTP session. (First try ESMTP EHLO, next old HELO handshake). Parses
+     ESMTP capabilites and if you specified Username and password and remote
+     server can handle AUTH command, try login by AUTH command. Preffered login
+     method is CRAM-MD5 (if safer!). If all OK, result is @true, else result is
+     @false.}
+    function Login: Boolean;
+
+    {:Close SMTP session (QUIT command) and disconnect from SMTP server.}
+    function Logout: Boolean;
+
+    {:Send RSET SMTP command for reset SMTP session. If all OK, result is @true,
+     else result is @false.}
+    function Reset: Boolean;
+
+    {:Send NOOP SMTP command for keep SMTP session. If all OK, result is @true,
+     else result is @false.}
+    function NoOp: Boolean;
+
+    {:Send MAIL FROM SMTP command for set sender e-mail address. If sender's
+     e-mail address is empty string, transmited message is error message.
+
+     If size not 0 and remote server can handle SIZE parameter, append SIZE
+     parameter to request. If all OK, result is @true, else result is @false.}
+    function MailFrom(const Value: string; Size: Integer): Boolean;
+
+    {:Send RCPT TO SMTP command for set receiver e-mail address. It cannot be an
+     empty string. If all OK, result is @true, else result is @false.}
+    function MailTo(const Value: string): Boolean;
+
+    {:Send DATA SMTP command and transmit message data. If all OK, result is
+     @true, else result is @false.}
+    function MailData(const Value: Tstrings): Boolean;
+
+    {:Send ETRN SMTP command for start sending of remote queue for domain in
+     Value. If all OK, result is @true, else result is @false.}
+    function Etrn(const Value: string): Boolean;
+
+    {:Send VRFY SMTP command for check receiver e-mail address. It cannot be
+     an empty string. If all OK, result is @true, else result is @false.}
+    function Verify(const Value: string): Boolean;
+
+    {:Call STARTTLS command for upgrade connection to SSL/TLS mode.}
+    function StartTLS: Boolean;
+
+    {:Return string descriptive text for enhanced result codes stored in
+     @link(EnhCode1), @link(EnhCode2) and @link(EnhCode3).}
+    function EnhCodeString: string;
+
+    {:Try to find specified capability in ESMTP response.}
+    function FindCap(const Value: string): string;
+  published
+    {:result code of last SMTP command.}
+    property ResultCode: Integer read FResultCode;
+
+    {:result string of last SMTP command (begin with string representation of
+     result code).}
+    property ResultString: string read FResultString;
+
+    {:All result strings of last SMTP command (result is maybe multiline!).}
+    property FullResult: TStringList read FFullResult;
+
+    {:List of ESMTP capabilites of remote ESMTP server. (If you connect to ESMTP
+     server only!).}
+    property ESMTPcap: TStringList read FESMTPcap;
+
+    {:@TRUE if you successfuly logged to ESMTP server.}
+    property ESMTP: Boolean read FESMTP;
+
+    {:@TRUE if you successfuly pass authorisation to remote server.}
+    property AuthDone: Boolean read FAuthDone;
+
+    {:@TRUE if remote server can handle SIZE parameter.}
+    property ESMTPSize: Boolean read FESMTPSize;
+
+    {:When @link(ESMTPsize) is @TRUE, contains max length of message that remote
+     server can handle.}
+    property MaxSize: Integer read FMaxSize;
+
+    {:First digit of Enhanced result code. If last operation does not have
+     enhanced result code, values is 0.}
+    property EnhCode1: Integer read FEnhCode1;
+
+    {:Second digit of Enhanced result code. If last operation does not have
+     enhanced result code, values is 0.}
+    property EnhCode2: Integer read FEnhCode2;
+
+    {:Third digit of Enhanced result code. If last operation does not have
+     enhanced result code, values is 0.}
+    property EnhCode3: Integer read FEnhCode3;
+
+    {:name of our system used in HELO and EHLO command. Implicit value is
+     internet address of your machine.}
+    property SystemName: string read FSystemName Write FSystemName;
+
+    {:If is set to true, then upgrade to SSL/TLS mode if remote server support it.}
+    property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
+
+    {:SSL/TLS mode is used from first contact to server. Servers with full
+     SSL/TLS mode usualy using non-standard TCP port!}
+    property FullSSL: Boolean read FFullSSL Write FFullSSL;
+
+    {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
+    property Sock: TTCPBlockSocket read FSock;
+  end;
+
+{:A very useful function and example of its use would be found in the TSMTPsend
+ object. Send maildata (text of e-mail with all SMTP headers! For example when
+ text of message is created by @link(TMimemess) object) from "MailFrom" e-mail
+ address to "MailTo" e-mail address (If you need more then one receiver, then
+ separate their addresses by comma).
+
+ Function sends e-mail to a SMTP server defined in "SMTPhost" parameter.
+ Username and password are used for authorization to the "SMTPhost". If you
+ don't want authorization, set "Username" and "Password" to empty strings. If
+ e-mail message is successfully sent, the result returns @true.
+
+ If you need use different port number then standard, then add this port number
+ to SMTPhost after colon. (i.e. '127.0.0.1:1025')}
+function SendToRaw(const MailFrom, MailTo, SMTPHost: string;
+  const MailData: TStrings; const Username, Password: string): Boolean;
+
+{:A very useful function and example of its use would be found in the TSMTPsend
+ object. Send "Maildata" (text of e-mail without any SMTP headers!) from
+ "MailFrom" e-mail address to "MailTo" e-mail address with "Subject".  (If you
+ need more then one receiver, then separate their addresses by comma).
+
+ This function constructs all needed SMTP headers (with DATE header) and sends
+ the e-mail to the SMTP server defined in the "SMTPhost" parameter. If the
+ e-mail message is successfully sent, the result will be @TRUE.
+
+ If you need use different port number then standard, then add this port number
+ to SMTPhost after colon. (i.e. '127.0.0.1:1025')}
+function SendTo(const MailFrom, MailTo, Subject, SMTPHost: string;
+  const MailData: TStrings): Boolean;
+
+{:A very useful function and example of its use would be found in the TSMTPsend
+ object. Sends "MailData" (text of e-mail without any SMTP headers!) from
+ "MailFrom" e-mail address to "MailTo" e-mail address (If you need more then one
+ receiver, then separate their addresses by comma).
+
+ This function sends the e-mail to the SMTP server defined in the "SMTPhost"
+ parameter. Username and password are used for authorization to the "SMTPhost".
+ If you dont want authorization, set "Username" and "Password" to empty Strings.
+ If the e-mail message is successfully sent, the result will be @TRUE.
+
+ If you need use different port number then standard, then add this port number
+ to SMTPhost after colon. (i.e. '127.0.0.1:1025')}
+function SendToEx(const MailFrom, MailTo, Subject, SMTPHost: string;
+  const MailData: TStrings; const Username, Password: string): Boolean;
+
+implementation
+
+constructor TSMTPSend.Create;
+begin
+  inherited Create;
+  FFullResult := TStringList.Create;
+  FESMTPcap := TStringList.Create;
+  FSock := TTCPBlockSocket.Create;
+  FSock.Owner := self;
+  FSock.ConvertLineEnd := true;
+  FTimeout := 60000;
+  FTargetPort := cSmtpProtocol;
+  FSystemName := FSock.LocalName;
+  FAutoTLS := False;
+  FFullSSL := False;
+end;
+
+destructor TSMTPSend.Destroy;
+begin
+  FSock.Free;
+  FESMTPcap.Free;
+  FFullResult.Free;
+  inherited Destroy;
+end;
+
+procedure TSMTPSend.EnhancedCode(const Value: string);
+var
+  s, t: string;
+  e1, e2, e3: Integer;
+begin
+  FEnhCode1 := 0;
+  FEnhCode2 := 0;
+  FEnhCode3 := 0;
+  s := Copy(Value, 5, Length(Value) - 4);
+  t := Trim(SeparateLeft(s, '.'));
+  s := Trim(SeparateRight(s, '.'));
+  if t = '' then
+    Exit;
+  if Length(t) > 1 then
+    Exit;
+  e1 := StrToIntDef(t, 0);
+  if e1 = 0 then
+    Exit;
+  t := Trim(SeparateLeft(s, '.'));
+  s := Trim(SeparateRight(s, '.'));
+  if t = '' then
+    Exit;
+  if Length(t) > 3 then
+    Exit;
+  e2 := StrToIntDef(t, 0);
+  t := Trim(SeparateLeft(s, ' '));
+  if t = '' then
+    Exit;
+  if Length(t) > 3 then
+    Exit;
+  e3 := StrToIntDef(t, 0);
+  FEnhCode1 := e1;
+  FEnhCode2 := e2;
+  FEnhCode3 := e3;
+end;
+
+function TSMTPSend.ReadResult: Integer;
+var
+  s: String;
+begin
+  Result := 0;
+  FFullResult.Clear;
+  repeat
+    s := FSock.RecvString(FTimeout);
+    FResultString := s;
+    FFullResult.Add(s);
+    if FSock.LastError <> 0 then
+      Break;
+  until Pos('-', s) <> 4;
+  s := FFullResult[0];
+  if Length(s) >= 3 then
+    Result := StrToIntDef(Copy(s, 1, 3), 0);
+  FResultCode := Result;
+  EnhancedCode(s);
+end;
+
+function TSMTPSend.AuthLogin: Boolean;
+begin
+  Result := False;
+  FSock.SendString('AUTH LOGIN' + CRLF);
+  if ReadResult <> 334 then
+    Exit;
+  FSock.SendString(EncodeBase64(FUsername) + CRLF);
+  if ReadResult <> 334 then
+    Exit;
+  FSock.SendString(EncodeBase64(FPassword) + CRLF);
+  Result := ReadResult = 235;
+end;
+
+function TSMTPSend.AuthCram: Boolean;
+var
+  s: ansistring;
+begin
+  Result := False;
+  FSock.SendString('AUTH CRAM-MD5' + CRLF);
+  if ReadResult <> 334 then
+    Exit;
+  s := Copy(FResultString, 5, Length(FResultString) - 4);
+  s := DecodeBase64(s);
+  s := HMAC_MD5(s, FPassword);
+  s := FUsername + ' ' + StrToHex(s);
+  FSock.SendString(EncodeBase64(s) + CRLF);
+  Result := ReadResult = 235;
+end;
+
+function TSMTPSend.AuthPlain: Boolean;
+var
+  s: ansistring;
+begin
+  Result := False;
+  s := ansichar(0) + FUsername + ansichar(0) + FPassword;
+  FSock.SendString('AUTH PLAIN ' + EncodeBase64(s) + CRLF);
+  Result := ReadResult = 235;
+end;
+
+function TSMTPSend.Connect: Boolean;
+begin
+  FSock.CloseSocket;
+  FSock.Bind(FIPInterface, cAnyPort);
+  if FSock.LastError = 0 then
+    FSock.Connect(FTargetHost, FTargetPort);
+  if FSock.LastError = 0 then
+    if FFullSSL then
+      FSock.SSLDoConnect;
+  Result := FSock.LastError = 0;
+end;
+
+function TSMTPSend.Helo: Boolean;
+var
+  x: Integer;
+begin
+  FSock.SendString('HELO ' + FSystemName + CRLF);
+  x := ReadResult;
+  Result := (x >= 250) and (x <= 259);
+end;
+
+function TSMTPSend.Ehlo: Boolean;
+var
+  x: Integer;
+begin
+  FSock.SendString('EHLO ' + FSystemName + CRLF);
+  x := ReadResult;
+  Result := (x >= 250) and (x <= 259);
+end;
+
+function TSMTPSend.Login: Boolean;
+var
+  n: Integer;
+  auths: string;
+  s: string;
+begin
+  Result := False;
+  FESMTP := True;
+  FAuthDone := False;
+  FESMTPcap.clear;
+  FESMTPSize := False;
+  FMaxSize := 0;
+  if not Connect then
+    Exit;
+  if ReadResult <> 220 then
+    Exit;
+  if not Ehlo then
+  begin
+    FESMTP := False;
+    if not Helo then
+      Exit;
+  end;
+  Result := True;
+  if FESMTP then
+  begin
+    for n := 1 to FFullResult.Count - 1 do
+      FESMTPcap.Add(Copy(FFullResult[n], 5, Length(FFullResult[n]) - 4));
+    if (not FullSSL) and FAutoTLS and (FindCap('STARTTLS') <> '') then
+      if StartTLS then
+      begin
+        Ehlo;
+        FESMTPcap.Clear;
+        for n := 1 to FFullResult.Count - 1 do
+          FESMTPcap.Add(Copy(FFullResult[n], 5, Length(FFullResult[n]) - 4));
+      end
+      else
+      begin
+        Result := False;
+        Exit;
+      end;
+    if not ((FUsername = '') and (FPassword = '')) then
+    begin
+      s := FindCap('AUTH ');
+      if s = '' then
+        s := FindCap('AUTH=');
+      auths := UpperCase(s);
+      if s <> '' then
+      begin
+        if Pos('CRAM-MD5', auths) > 0 then
+          FAuthDone := AuthCram;
+        if (not FauthDone) and (Pos('PLAIN', auths) > 0) then
+          FAuthDone := AuthPlain;
+        if (not FauthDone) and (Pos('LOGIN', auths) > 0) then
+          FAuthDone := AuthLogin;
+      end;
+    end;
+    s := FindCap('SIZE');
+    if s <> '' then
+    begin
+      FESMTPsize := True;
+      FMaxSize := StrToIntDef(Copy(s, 6, Length(s) - 5), 0);
+    end;
+  end;
+end;
+
+function TSMTPSend.Logout: Boolean;
+begin
+  FSock.SendString('QUIT' + CRLF);
+  Result := ReadResult = 221;
+  FSock.CloseSocket;
+end;
+
+function TSMTPSend.Reset: Boolean;
+begin
+  FSock.SendString('RSET' + CRLF);
+  Result := ReadResult div 100 = 2;
+end;
+
+function TSMTPSend.NoOp: Boolean;
+begin
+  FSock.SendString('NOOP' + CRLF);
+  Result := ReadResult div 100 = 2;
+end;
+
+function TSMTPSend.MailFrom(const Value: string; Size: Integer): Boolean;
+var
+  s: string;
+begin
+  s := 'MAIL FROM:<' + Value + '>';
+  if FESMTPsize and (Size > 0) then
+    s := s + ' SIZE=' + IntToStr(Size);
+  FSock.SendString(s + CRLF);
+  Result := ReadResult div 100 = 2;
+end;
+
+function TSMTPSend.MailTo(const Value: string): Boolean;
+begin
+  FSock.SendString('RCPT TO:<' + Value + '>' + CRLF);
+  Result := ReadResult div 100 = 2;
+end;
+
+function TSMTPSend.MailData(const Value: TStrings): Boolean;
+var
+  n: Integer;
+  s: string;
+  t: string;
+  x: integer;
+begin
+  Result := False;
+  FSock.SendString('DATA' + CRLF);
+  if ReadResult <> 354 then
+    Exit;
+  t := '';
+  x := 1500;
+  for n := 0 to Value.Count - 1 do
+  begin
+    s := Value[n];
+    if Length(s) >= 1 then
+      if s[1] = '.' then
+        s := '.' + s;
+    if Length(t) + Length(s) >= x then
+    begin
+      FSock.SendString(t);
+      t := '';
+    end;
+    t := t + s + CRLF;
+  end;
+  if t <> '' then
+    FSock.SendString(t);
+  FSock.SendString('.' + CRLF);
+  Result := ReadResult div 100 = 2;
+end;
+
+function TSMTPSend.Etrn(const Value: string): Boolean;
+var
+  x: Integer;
+begin
+  FSock.SendString('ETRN ' + Value + CRLF);
+  x := ReadResult;
+  Result := (x >= 250) and (x <= 259);
+end;
+
+function TSMTPSend.Verify(const Value: string): Boolean;
+var
+  x: Integer;
+begin
+  FSock.SendString('VRFY ' + Value + CRLF);
+  x := ReadResult;
+  Result := (x >= 250) and (x <= 259);
+end;
+
+function TSMTPSend.StartTLS: Boolean;
+begin
+  Result := False;
+  if FindCap('STARTTLS') <> '' then
+  begin
+    FSock.SendString('STARTTLS' + CRLF);
+    if (ReadResult = 220) and (FSock.LastError = 0) then
+    begin
+      Fsock.SSLDoConnect;
+      Result := FSock.LastError = 0;
+    end;
+  end;
+end;
+
+function TSMTPSend.EnhCodeString: string;
+var
+  s, t: string;
+begin
+  s := IntToStr(FEnhCode2) + '.' + IntToStr(FEnhCode3);
+  t := '';
+  if s = '0.0' then t := 'Other undefined Status';
+  if s = '1.0' then t := 'Other address status';
+  if s = '1.1' then t := 'Bad destination mailbox address';
+  if s = '1.2' then t := 'Bad destination system address';
+  if s = '1.3' then t := 'Bad destination mailbox address syntax';
+  if s = '1.4' then t := 'Destination mailbox address ambiguous';
+  if s = '1.5' then t := 'Destination mailbox address valid';
+  if s = '1.6' then t := 'Mailbox has moved';
+  if s = '1.7' then t := 'Bad sender''s mailbox address syntax';
+  if s = '1.8' then t := 'Bad sender''s system address';
+  if s = '2.0' then t := 'Other or undefined mailbox status';
+  if s = '2.1' then t := 'Mailbox disabled, not accepting messages';
+  if s = '2.2' then t := 'Mailbox full';
+  if s = '2.3' then t := 'Message Length exceeds administrative limit';
+  if s = '2.4' then t := 'Mailing list expansion problem';
+  if s = '3.0' then t := 'Other or undefined mail system status';
+  if s = '3.1' then t := 'Mail system full';
+  if s = '3.2' then t := 'System not accepting network messages';
+  if s = '3.3' then t := 'System not capable of selected features';
+  if s = '3.4' then t := 'Message too big for system';
+  if s = '3.5' then t := 'System incorrectly configured';
+  if s = '4.0' then t := 'Other or undefined network or routing status';
+  if s = '4.1' then t := 'No answer from host';
+  if s = '4.2' then t := 'Bad connection';
+  if s = '4.3' then t := 'Routing server failure';
+  if s = '4.4' then t := 'Unable to route';
+  if s = '4.5' then t := 'Network congestion';
+  if s = '4.6' then t := 'Routing loop detected';
+  if s = '4.7' then t := 'Delivery time expired';
+  if s = '5.0' then t := 'Other or undefined protocol status';
+  if s = '5.1' then t := 'Invalid command';
+  if s = '5.2' then t := 'Syntax error';
+  if s = '5.3' then t := 'Too many recipients';
+  if s = '5.4' then t := 'Invalid command arguments';
+  if s = '5.5' then t := 'Wrong protocol version';
+  if s = '6.0' then t := 'Other or undefined media error';
+  if s = '6.1' then t := 'Media not supported';
+  if s = '6.2' then t := 'Conversion required and prohibited';
+  if s = '6.3' then t := 'Conversion required but not supported';
+  if s = '6.4' then t := 'Conversion with loss performed';
+  if s = '6.5' then t := 'Conversion failed';
+  if s = '7.0' then t := 'Other or undefined security status';
+  if s = '7.1' then t := 'Delivery not authorized, message refused';
+  if s = '7.2' then t := 'Mailing list expansion prohibited';
+  if s = '7.3' then t := 'Security conversion required but not possible';
+  if s = '7.4' then t := 'Security features not supported';
+  if s = '7.5' then t := 'Cryptographic failure';
+  if s = '7.6' then t := 'Cryptographic algorithm not supported';
+  if s = '7.7' then t := 'Message integrity failure';
+  s := '???-';
+  if FEnhCode1 = 2 then s := 'Success-';
+  if FEnhCode1 = 4 then s := 'Persistent Transient Failure-';
+  if FEnhCode1 = 5 then s := 'Permanent Failure-';
+  Result := s + t;
+end;
+
+function TSMTPSend.FindCap(const Value: string): string;
+var
+  n: Integer;
+  s: string;
+begin
+  s := UpperCase(Value);
+  Result := '';
+  for n := 0 to FESMTPcap.Count - 1 do
+    if Pos(s, UpperCase(FESMTPcap[n])) = 1 then
+    begin
+      Result := FESMTPcap[n];
+      Break;
+    end;
+end;
+
+{==============================================================================}
+
+function SendToRaw(const MailFrom, MailTo, SMTPHost: string;
+  const MailData: TStrings; const Username, Password: string): Boolean;
+var
+  SMTP: TSMTPSend;
+  s, t: string;
+begin
+  Result := False;
+  SMTP := TSMTPSend.Create;
+  try
+// if you need SOCKS5 support, uncomment next lines:
+    // SMTP.Sock.SocksIP := '127.0.0.1';
+    // SMTP.Sock.SocksPort := '1080';
+// if you need support for upgrade session to TSL/SSL, uncomment next lines:
+    // SMTP.AutoTLS := True;
+// if you need support for TSL/SSL tunnel, uncomment next lines:
+    // SMTP.FullSSL := True;
+    SMTP.TargetHost := Trim(SeparateLeft(SMTPHost, ':'));
+    s := Trim(SeparateRight(SMTPHost, ':'));
+    if (s <> '') and (s <> SMTPHost) then
+      SMTP.TargetPort := s;
+    SMTP.Username := Username;
+    SMTP.Password := Password;
+    if SMTP.Login then
+    begin
+      if SMTP.MailFrom(GetEmailAddr(MailFrom), Length(MailData.Text)) then
+      begin
+        s := MailTo;
+        repeat
+          t := GetEmailAddr(Trim(FetchEx(s, ',', '"')));
+          if t <> '' then
+            Result := SMTP.MailTo(t);
+          if not Result then
+            Break;
+        until s = '';
+        if Result then
+          Result := SMTP.MailData(MailData);
+      end;
+      SMTP.Logout;
+    end;
+  finally
+    SMTP.Free;
+  end;
+end;
+
+function SendToEx(const MailFrom, MailTo, Subject, SMTPHost: string;
+  const MailData: TStrings; const Username, Password: string): Boolean;
+var
+  t: TStrings;
+begin
+  t := TStringList.Create;
+  try
+    t.Assign(MailData);
+    t.Insert(0, '');
+    t.Insert(0, 'X-mailer: Synapse - Delphi & Kylix TCP/IP library by Lukas Gebauer');
+    t.Insert(0, 'Subject: ' + Subject);
+    t.Insert(0, 'Date: ' + Rfc822DateTime(now));
+    t.Insert(0, 'To: ' + MailTo);
+    t.Insert(0, 'From: ' + MailFrom);
+    Result := SendToRaw(MailFrom, MailTo, SMTPHost, t, Username, Password);
+  finally
+    t.Free;
+  end;
+end;
+
+function SendTo(const MailFrom, MailTo, Subject, SMTPHost: string;
+  const MailData: TStrings): Boolean;
+begin
+  Result := SendToEx(MailFrom, MailTo, Subject, SMTPHost, MailData, '', '');
+end;
+
+end.
diff --git a/Units/Synapse/snmpsend.pas b/Units/Synapse/snmpsend.pas
index 431f5e4..e7723d5 100644
--- a/Units/Synapse/snmpsend.pas
+++ b/Units/Synapse/snmpsend.pas
@@ -1,1089 +1,1089 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 003.000.010 |
-|==============================================================================|
-| Content: SNMP client                                                         |
-|==============================================================================|
-| Copyright (c)1999-2010, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2000-2010.                |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|   Jean-Fabien Connault (cycocrew@worldnet.fr)                                |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{:@abstract(SNMP client)
-Supports SNMPv1 include traps, SNMPv2c and SNMPv3 include authorization
- (encryption not yet supported!)
-
-Used RFC: RFC-1157, RFC-1901, RFC-3412, RFC-3414, RFC-3416
-}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$Q-}
-{$H+}
-
-{$IFDEF UNICODE}
-  {$WARN IMPLICIT_STRING_CAST OFF}
-  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
-{$ENDIF}
-
-unit snmpsend;
-
-interface
-
-uses
-  Classes, SysUtils,
-  blcksock, synautil, asn1util, synaip, synacode;
-
-const
-  cSnmpProtocol = '161';
-  cSnmpTrapProtocol = '162';
-
-  SNMP_V1 = 0;
-  SNMP_V2C = 1;
-  SNMP_V3 = 3;
-
-  //PDU type
-  PDUGetRequest = $A0;
-  PDUGetNextRequest = $A1;
-  PDUGetResponse = $A2;
-  PDUSetRequest = $A3;
-  PDUTrap = $A4; //Obsolete
-  //for SNMPv2
-  PDUGetBulkRequest = $A5;
-  PDUInformRequest = $A6;
-  PDUTrapV2 = $A7;
-  PDUReport = $A8;
-
-  //errors
-  ENoError = 0;
-  ETooBig = 1;
-  ENoSuchName = 2;
-  EBadValue = 3;
-  EReadOnly = 4;
-  EGenErr = 5;
-  //errors SNMPv2
-  ENoAccess = 6;
-  EWrongType = 7;
-  EWrongLength = 8;
-  EWrongEncoding = 9;
-  EWrongValue = 10;
-  ENoCreation = 11;
-  EInconsistentValue = 12;
-  EResourceUnavailable = 13;
-  ECommitFailed = 14;
-  EUndoFailed = 15;
-  EAuthorizationError = 16;
-  ENotWritable = 17;
-  EInconsistentName = 18;
-
-type
-
-  {:@abstract(Possible values for SNMPv3 flags.)
-   This flags specify level of authorization and encryption.}
-  TV3Flags = (
-    NoAuthNoPriv,
-    AuthNoPriv,
-    AuthPriv);
-
-  {:@abstract(Type of SNMPv3 authorization)}
-  TV3Auth = (
-    AuthMD5,
-    AuthSHA1);
-
-  {:@abstract(Data object with one record of MIB OID and corresponding values.)}
-  TSNMPMib = class(TObject)
-  protected
-    FOID: AnsiString;
-    FValue: AnsiString;
-    FValueType: Integer;
-  published
-    {:OID number in string format.}
-    property OID: AnsiString read FOID write FOID;
-
-    {:Value of OID object in string format.}
-    property Value: AnsiString read FValue write FValue;
-
-    {:Define type of Value. Supported values are defined in @link(asn1util).
-     For queries use ASN1_NULL, becouse you don't know type in response!}
-    property ValueType: Integer read FValueType write FValueType;
-  end;
-
-  {:@abstract(It holding all information for SNMPv3 agent synchronization)
-   Used internally.}
-  TV3Sync = record
-    EngineID: AnsiString;
-    EngineBoots: integer;
-    EngineTime: integer;
-    EngineStamp: Cardinal;
-  end;
-
-  {:@abstract(Data object abstracts SNMP data packet)}
-  TSNMPRec = class(TObject)
-  protected
-    FVersion: Integer;
-    FPDUType: Integer;
-    FID: Integer;
-    FErrorStatus: Integer;
-    FErrorIndex: Integer;
-    FCommunity: AnsiString;
-    FSNMPMibList: TList;
-    FMaxSize: Integer;
-    FFlags: TV3Flags;
-    FFlagReportable: Boolean;
-    FContextEngineID: AnsiString;
-    FContextName: AnsiString;
-    FAuthMode: TV3Auth;
-    FAuthEngineID: AnsiString;
-    FAuthEngineBoots: integer;
-    FAuthEngineTime: integer;
-    FAuthEngineTimeStamp: cardinal;
-    FUserName: AnsiString;
-    FPassword: AnsiString;
-    FAuthKey: AnsiString;
-    FPrivKey: AnsiString;
-    FOldTrapEnterprise: AnsiString;
-    FOldTrapHost: AnsiString;
-    FOldTrapGen: Integer;
-    FOldTrapSpec: Integer;
-    FOldTrapTimeTicks: Integer;
-    function Pass2Key(const Value: AnsiString): AnsiString;
-  public
-    constructor Create;
-    destructor Destroy; override;
-
-    {:Decode SNMP packet in buffer to object properties.}
-    function DecodeBuf(const Buffer: AnsiString): Boolean;
-
-    {:Encode obeject properties to SNMP packet.}
-    function EncodeBuf: AnsiString;
-
-    {:Clears all object properties to default values.}
-    procedure Clear;
-
-    {:Add entry to @link(SNMPMibList). For queries use value as empty string,
-     and ValueType as ASN1_NULL.}
-    procedure MIBAdd(const MIB, Value: AnsiString; ValueType: Integer);
-
-    {:Delete entry from @link(SNMPMibList).}
-    procedure MIBDelete(Index: Integer);
-
-    {:Search @link(SNMPMibList) list for MIB and return correspond value.}
-    function MIBGet(const MIB: AnsiString): AnsiString;
-
-    {:return number of entries in MIB array.}
-    function MIBCount: integer;
-
-    {:Return MIB information from given row of MIB array.}
-    function MIBByIndex(Index: Integer): TSNMPMib;
-
-    {:List of @link(TSNMPMib) objects.}
-    property SNMPMibList: TList read FSNMPMibList;
-  published
-    {:Version of SNMP packet. Default value is 0 (SNMP ver. 1). You can use
-     value 1 for SNMPv2c or value 3 for SNMPv3.}
-    property Version: Integer read FVersion write FVersion;
-
-    {:Community string for autorize access to SNMP server. (Case sensitive!)
-     Community string is not used in SNMPv3! Use @link(Username) and
-     @link(password) instead!}
-    property Community: AnsiString read FCommunity write FCommunity;
-
-    {:Define type of SNMP operation.}
-    property PDUType: Integer read FPDUType write FPDUType;
-
-    {:Contains ID number. Not need to use.}
-    property ID: Integer read FID write FID;
-
-    {:When packet is reply, contains error code. Supported values are defined by
-     E* constants.}
-    property ErrorStatus: Integer read FErrorStatus write FErrorStatus;
-
-    {:Point to error position in reply packet. Not usefull for users. It only
-     good for debugging!}
-    property ErrorIndex: Integer read FErrorIndex write FErrorIndex;
-
-    {:special value for GetBulkRequest of SNMPv2 and v3.}
-    property NonRepeaters: Integer read FErrorStatus write FErrorStatus;
-
-    {:special value for GetBulkRequest of SNMPv2 and v3.}
-    property MaxRepetitions: Integer read FErrorIndex write FErrorIndex;
-
-    {:Maximum message size in bytes for SNMPv3. For sending is default 1472 bytes.}
-    property MaxSize: Integer read FMaxSize write FMaxSize;
-
-    {:Specify if message is authorised or encrypted. Used only in SNMPv3, and
-     encryption is not yet supported!}
-    property Flags: TV3Flags read FFlags write FFlags;
-
-    {:For SNMPv3.... If is @true, SNMP agent must send reply (at least with some
-     error).}
-    property FlagReportable: Boolean read FFlagReportable write FFlagReportable;
-
-    {:For SNMPv3. If not specified, is used value from @link(AuthEngineID)}
-    property ContextEngineID: AnsiString read FContextEngineID write FContextEngineID;
-
-    {:For SNMPv3.}
-    property ContextName: AnsiString read FContextName write FContextName;
-
-    {:For SNMPv3. Specify Authorization mode. (specify used hash for
-     authorization)}
-    property AuthMode: TV3Auth read FAuthMode write FAuthMode;
-
-    {:value used by SNMPv3 authorisation for synchronization with SNMP agent.}
-    property AuthEngineID: AnsiString read FAuthEngineID write FAuthEngineID;
-
-    {:value used by SNMPv3 authorisation for synchronization with SNMP agent.}
-    property AuthEngineBoots: Integer read FAuthEngineBoots write FAuthEngineBoots;
-
-    {:value used by SNMPv3 authorisation for synchronization with SNMP agent.}
-    property AuthEngineTime: Integer read FAuthEngineTime write FAuthEngineTime;
-
-    {:value used by SNMPv3 authorisation for synchronization with SNMP agent.}
-    property AuthEngineTimeStamp: Cardinal read FAuthEngineTimeStamp Write FAuthEngineTimeStamp;
-
-    {:SNMPv3 authorization username}
-    property UserName: AnsiString read FUserName write FUserName;
-
-    {:SNMPv3 authorization password}
-    property Password: AnsiString read FPassword write FPassword;
-
-    {:For SNMPv3. Computed Athorization key from @link(password).}
-    property AuthKey: AnsiString read FAuthKey write FAuthKey;
-
-    {:For SNMPv3. Encryption key for message encryption. Not yet used!}
-    property PrivKey: AnsiString read FPrivKey write FPrivKey;
-
-    {:MIB value to identify the object that sent the TRAPv1.}
-    property OldTrapEnterprise: AnsiString read FOldTrapEnterprise write FOldTrapEnterprise;
-
-    {:Address of TRAPv1 sender (IP address).}
-    property OldTrapHost: AnsiString read FOldTrapHost write FOldTrapHost;
-
-    {:Generic TRAPv1 identification.}
-    property OldTrapGen: Integer read FOldTrapGen write FOldTrapGen;
-
-    {:Specific TRAPv1 identification.}
-    property OldTrapSpec: Integer read FOldTrapSpec write FOldTrapSpec;
-
-    {:Number of 1/100th of seconds since last reboot or power up. (for TRAPv1)}
-    property OldTrapTimeTicks: Integer read FOldTrapTimeTicks write FOldTrapTimeTicks;
-  end;
-
-  {:@abstract(Implementation of SNMP protocol.)
-
-   Note: Are you missing properties for specify server address and port? Look to
-   parent @link(TSynaClient) too!}
-  TSNMPSend = class(TSynaClient)
-  protected
-    FSock: TUDPBlockSocket;
-    FBuffer: AnsiString;
-    FHostIP: AnsiString;
-    FQuery: TSNMPRec;
-    FReply: TSNMPRec;
-    function InternalSendSnmp(const Value: TSNMPRec): Boolean;
-    function InternalRecvSnmp(const Value: TSNMPRec): Boolean;
-    function InternalSendRequest(const QValue, RValue: TSNMPRec): Boolean;
-    function GetV3EngineID: AnsiString;
-    function GetV3Sync: TV3Sync;
-  public
-    constructor Create;
-    destructor Destroy; override;
-
-    {:Connects to a Host and send there query. If in timeout SNMP server send
-     back query, result is @true. If is used SNMPv3, then it synchronize self
-     with SNMPv3 agent first. (It is needed for SNMPv3 auhorization!)}
-    function SendRequest: Boolean;
-
-    {:Send SNMP packet only, but not waits for reply. Good for sending traps.}
-    function SendTrap: Boolean;
-
-    {:Receive SNMP packet only. Good for receiving traps.}
-    function RecvTrap: Boolean;
-
-    {:Mapped to @link(SendRequest) internally. This function is only for
-     backward compatibility.}
-    function DoIt: Boolean;
-  published
-    {:contains raw binary form of SNMP packet. Good for debugging.}
-    property Buffer: AnsiString read FBuffer write FBuffer;
-
-    {:After SNMP operation hold IP address of remote side.}
-    property HostIP: AnsiString read FHostIP;
-
-    {:Data object contains SNMP query.}
-    property Query: TSNMPRec read FQuery;
-
-    {:Data object contains SNMP reply.}
-    property Reply: TSNMPRec read FReply;
-
-    {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
-    property Sock: TUDPBlockSocket read FSock;
-  end;
-
-{:A very useful function and example of its use would be found in the TSNMPSend
- object. It implements basic GET method of the SNMP protocol. The MIB value is
- located in the "OID" variable, and is sent to the requested "SNMPHost" with
- the proper "Community" access identifier. Upon a successful retrieval, "Value"
- will contain the information requested. If the SNMP operation is successful,
- the result returns @true.}
-function SNMPGet(const OID, Community, SNMPHost: AnsiString; var Value: AnsiString): Boolean;
-
-{:This is useful function and example of use TSNMPSend object. It implements
- the basic SET method of the SNMP protocol. If the SNMP operation is successful,
- the result is @true. "Value" is value of MIB Oid for "SNMPHost" with "Community"
- access identifier. You must specify "ValueType" too.}
-function SNMPSet(const OID, Community, SNMPHost, Value: AnsiString; ValueType: Integer): Boolean;
-
-{:A very useful function and example of its use would be found in the TSNMPSend
- object. It implements basic GETNEXT method of the SNMP protocol. The MIB value
- is located in the "OID" variable, and is sent to the requested "SNMPHost" with
- the proper "Community" access identifier. Upon a successful retrieval, "Value"
- will contain the information requested. If the SNMP operation is successful,
- the result returns @true.}
-function SNMPGetNext(var OID: AnsiString; const Community, SNMPHost: AnsiString; var Value: AnsiString): Boolean;
-
-{:A very useful function and example of its use would be found in the TSNMPSend
- object. It implements basic read of SNMP MIB tables. As BaseOID you must
- specify basic MIB OID of requested table (base IOD is OID without row and
- column specificator!)
- Table is readed into stringlist, where each string is comma delimited string.
-
- Warning: this function is not have best performance. For better performance
- you must write your own function. best performace you can get by knowledge
- of structuture of table and by more then one MIB on one query. }
-function SNMPGetTable(const BaseOID, Community, SNMPHost: AnsiString; const Value: TStrings): Boolean;
-
-{:A very useful function and example of its use would be found in the TSNMPSend
- object. It implements basic read of SNMP MIB table element. As BaseOID you must
- specify basic MIB OID of requested table (base IOD is OID without row and
- column specificator!)
- As next you must specify identificator of row and column for specify of needed
- field of table.}
-function SNMPGetTableElement(const BaseOID, RowID, ColID, Community, SNMPHost: AnsiString; var Value: AnsiString): Boolean;
-
-{:A very useful function and example of its use would be found in the TSNMPSend
- object. It implements a TRAPv1 to send with all data in the parameters.}
-function SendTrap(const Dest, Source, Enterprise, Community: AnsiString;
-  Generic, Specific, Seconds: Integer; const MIBName, MIBValue: AnsiString;
-  MIBtype: Integer): Integer;
-
-{:A very useful function and example of its use would be found in the TSNMPSend
- object. It receives a TRAPv1 and returns all the data that comes with it.}
-function RecvTrap(var Dest, Source, Enterprise, Community: AnsiString;
-  var Generic, Specific, Seconds: Integer; const MIBName,
-  MIBValue: TStringList): Integer;
-
-implementation
-
-{==============================================================================}
-
-constructor TSNMPRec.Create;
-begin
-  inherited Create;
-  FSNMPMibList := TList.Create;
-  Clear;
-  FID := 1;
-  FMaxSize := 1472;
-end;
-
-destructor TSNMPRec.Destroy;
-var
-  i: Integer;
-begin
-  for i := 0 to FSNMPMibList.Count - 1 do
-    TSNMPMib(FSNMPMibList[i]).Free;
-  FSNMPMibList.Clear;
-  FSNMPMibList.Free;
-  inherited Destroy;
-end;
-
-function TSNMPRec.Pass2Key(const Value: AnsiString): AnsiString;
-var
-  key: AnsiString;
-begin
-  case FAuthMode of
-    AuthMD5:
-      begin
-        key := MD5LongHash(Value, 1048576);
-        Result := MD5(key + FAuthEngineID + key);
-      end;
-    AuthSHA1:
-      begin
-        key := SHA1LongHash(Value, 1048576);
-        Result := SHA1(key + FAuthEngineID + key);
-      end;
-  else
-    Result := '';
-  end;
-end;
-
-
-function TSNMPRec.DecodeBuf(const Buffer: AnsiString): Boolean;
-var
-  Pos: Integer;
-  EndPos: Integer;
-  sm, sv: AnsiString;
-  Svt: Integer;
-  s: AnsiString;
-  Spos: integer;
-  x: Byte;
-begin
-  Clear;
-  Result := False;
-  if Length(Buffer) < 2 then
-    Exit;
-  if (Ord(Buffer[1]) and $20) = 0 then
-    Exit;
-  Pos := 2;
-  EndPos := ASNDecLen(Pos, Buffer);
-  if Length(Buffer) < (EndPos + 2) then
-    Exit;
-  Self.FVersion := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
-
-  if FVersion = 3 then
-  begin
-    ASNItem(Pos, Buffer, Svt);  //header data seq
-    ASNItem(Pos, Buffer, Svt);  //ID
-    FMaxSize := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
-    s := ASNItem(Pos, Buffer, Svt);
-    x := 0;
-    if s <> '' then
-      x := Ord(s[1]);
-    FFlagReportable := (x and 4) > 0;
-    x := x and 3;
-    case x of
-      1:
-        FFlags := AuthNoPriv;
-      3:
-        FFlags := AuthPriv;
-    else
-      FFlags := NoAuthNoPriv;
-    end;
-
-    x := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
-    s := ASNItem(Pos, Buffer, Svt); //SecurityParameters
-    //if SecurityModel is USM, then try to decode SecurityParameters
-    if (x = 3) and (s <> '') then
-    begin
-      spos := 1;
-      ASNItem(SPos, s, Svt);
-      FAuthEngineID := ASNItem(SPos, s, Svt);
-      FAuthEngineBoots := StrToIntDef(ASNItem(SPos, s, Svt), 0);
-      FAuthEngineTime := StrToIntDef(ASNItem(SPos, s, Svt), 0);
-      FAuthEngineTimeStamp := GetTick;
-      FUserName := ASNItem(SPos, s, Svt);
-      FAuthKey := ASNItem(SPos, s, Svt);
-      FPrivKey := ASNItem(SPos, s, Svt);
-    end;
-    //scopedPDU
-    s := ASNItem(Pos, Buffer, Svt);
-    if Svt = ASN1_OCTSTR then
-    begin
-      //decrypt!
-    end;
-    FContextEngineID := ASNItem(Pos, Buffer, Svt);
-    FContextName := ASNItem(Pos, Buffer, Svt);
-  end
-  else
-  begin
-    //old packet
-    Self.FCommunity := ASNItem(Pos, Buffer, Svt);
-  end;
-
-  ASNItem(Pos, Buffer, Svt);
-  Self.FPDUType := Svt;
-  if Self.FPDUType = PDUTrap then
-  begin
-    FOldTrapEnterprise := ASNItem(Pos, Buffer, Svt);
-    FOldTrapHost := ASNItem(Pos, Buffer, Svt);
-    FOldTrapGen := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
-    FOldTrapSpec := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
-    FOldTrapTimeTicks := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
-  end
-  else
-  begin
-    Self.FID := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
-    Self.FErrorStatus := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
-    Self.FErrorIndex := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
-  end;
-  ASNItem(Pos, Buffer, Svt);
-  while Pos < EndPos do
-  begin
-    ASNItem(Pos, Buffer, Svt);
-    Sm := ASNItem(Pos, Buffer, Svt);
-    Sv := ASNItem(Pos, Buffer, Svt);
-    Self.MIBAdd(sm, sv, Svt);
-  end;
-  Result := True;
-end;
-
-function TSNMPRec.EncodeBuf: AnsiString;
-var
-  s: AnsiString;
-  SNMPMib: TSNMPMib;
-  n: Integer;
-  pdu, head, auth, authbeg: AnsiString;
-  x: Byte;
-begin
-  pdu := '';
-  for n := 0 to FSNMPMibList.Count - 1 do
-  begin
-    SNMPMib := TSNMPMib(FSNMPMibList[n]);
-    case SNMPMib.ValueType of
-      ASN1_INT:
-        s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) +
-          ASNObject(ASNEncInt(StrToIntDef(SNMPMib.Value, 0)), SNMPMib.ValueType);
-      ASN1_COUNTER, ASN1_GAUGE, ASN1_TIMETICKS:
-        s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) +
-          ASNObject(ASNEncUInt(StrToIntDef(SNMPMib.Value, 0)), SNMPMib.ValueType);
-      ASN1_OBJID:
-        s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) +
-          ASNObject(MibToID(SNMPMib.Value), SNMPMib.ValueType);
-      ASN1_IPADDR:
-        s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) +
-          ASNObject(IPToID(SNMPMib.Value), SNMPMib.ValueType);
-      ASN1_NULL:
-        s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) +
-          ASNObject('', ASN1_NULL);
-    else
-      s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) +
-        ASNObject(SNMPMib.Value, SNMPMib.ValueType);
-    end;
-    pdu := pdu + ASNObject(s, ASN1_SEQ);
-  end;
-  pdu := ASNObject(pdu, ASN1_SEQ);
-
-  if Self.FPDUType = PDUTrap then
-    pdu := ASNObject(MibToID(FOldTrapEnterprise), ASN1_OBJID) +
-      ASNObject(IPToID(FOldTrapHost), ASN1_IPADDR) +
-      ASNObject(ASNEncInt(FOldTrapGen), ASN1_INT) +
-      ASNObject(ASNEncInt(FOldTrapSpec), ASN1_INT) +
-      ASNObject(ASNEncUInt(FOldTrapTimeTicks), ASN1_TIMETICKS) +
-      pdu
-  else
-    pdu := ASNObject(ASNEncInt(Self.FID), ASN1_INT) +
-      ASNObject(ASNEncInt(Self.FErrorStatus), ASN1_INT) +
-      ASNObject(ASNEncInt(Self.FErrorIndex), ASN1_INT) +
-      pdu;
-  pdu := ASNObject(pdu, Self.FPDUType);
-
-  if FVersion = 3 then
-  begin
-    if FContextEngineID = '' then
-      FContextEngineID := FAuthEngineID;
-    //complete PDUv3...
-    pdu := ASNObject(FContextEngineID, ASN1_OCTSTR)
-      + ASNObject(FContextName, ASN1_OCTSTR)
-      + pdu;
-    //maybe encrypt pdu... in future
-    pdu := ASNObject(pdu, ASN1_SEQ);
-
-    //prepare flags
-    case FFlags of
-      AuthNoPriv:
-        x := 1;
-      AuthPriv:
-        x := 3;
-    else
-      x := 0;
-    end;
-    if FFlagReportable then
-      x := x or 4;
-    head := ASNObject(ASNEncInt(Self.FVersion), ASN1_INT);
-    s := ASNObject(ASNEncInt(FID), ASN1_INT)
-      + ASNObject(ASNEncInt(FMaxSize), ASN1_INT)
-      + ASNObject(AnsiChar(x), ASN1_OCTSTR)
-    //encode security model USM
-      + ASNObject(ASNEncInt(3), ASN1_INT);
-    head := head + ASNObject(s, ASN1_SEQ);
-
-    //compute engine time difference
-    x := TickDelta(FAuthEngineTimeStamp, GetTick) div 1000;
-
-    authbeg := ASNObject(FAuthEngineID, ASN1_OCTSTR)
-      + ASNObject(ASNEncInt(FAuthEngineBoots), ASN1_INT)
-      + ASNObject(ASNEncInt(FAuthEngineTime + x), ASN1_INT)
-      + ASNObject(FUserName, ASN1_OCTSTR);
-
-
-    case FFlags of
-      AuthNoPriv,
-      AuthPriv:
-        begin
-          s := authbeg + ASNObject(StringOfChar(#0, 12), ASN1_OCTSTR)
-             + ASNObject(FPrivKey, ASN1_OCTSTR);
-          s := ASNObject(s, ASN1_SEQ);
-          s := head + ASNObject(s, ASN1_OCTSTR);
-          s := ASNObject(s + pdu, ASN1_SEQ);
-          //in s is entire packet without auth info...
-          case FAuthMode of
-            AuthMD5:
-              begin
-                s := HMAC_MD5(s, Pass2Key(FPassword) + StringOfChar(#0, 48));
-                //strip to HMAC-MD5-96
-                delete(s, 13, 4);
-              end;
-            AuthSHA1:
-              begin
-                s := HMAC_SHA1(s, Pass2Key(FPassword) + StringOfChar(#0, 44));
-                //strip to HMAC-SHA-96
-                delete(s, 13, 8);
-              end;
-          else
-            s := '';
-          end;
-          FAuthKey := s;
-        end;
-    end;
-
-    auth := authbeg + ASNObject(FAuthKey, ASN1_OCTSTR)
-     + ASNObject(FPrivKey, ASN1_OCTSTR);
-    auth := ASNObject(auth, ASN1_SEQ);
-
-    head := head + ASNObject(auth, ASN1_OCTSTR);
-    Result := ASNObject(head + pdu, ASN1_SEQ);
-  end
-  else
-  begin
-    head := ASNObject(ASNEncInt(Self.FVersion), ASN1_INT) +
-      ASNObject(Self.FCommunity, ASN1_OCTSTR);
-    Result := ASNObject(head + pdu, ASN1_SEQ);
-  end;
-  inc(self.FID);
-end;
-
-procedure TSNMPRec.Clear;
-var
-  i: Integer;
-begin
-  FVersion := SNMP_V1;
-  FCommunity := 'public';
-  FUserName := '';
-  FPassword := '';
-  FPDUType := 0;
-  FErrorStatus := 0;
-  FErrorIndex := 0;
-  for i := 0 to FSNMPMibList.Count - 1 do
-    TSNMPMib(FSNMPMibList[i]).Free;
-  FSNMPMibList.Clear;
-  FOldTrapEnterprise := '';
-  FOldTrapHost := '';
-  FOldTrapGen := 0;
-  FOldTrapSpec := 0;
-  FOldTrapTimeTicks := 0;
-  FFlags := NoAuthNoPriv;
-  FFlagReportable := false;
-  FContextEngineID := '';
-  FContextName := '';
-  FAuthMode := AuthMD5;
-  FAuthEngineID := '';
-  FAuthEngineBoots := 0;
-  FAuthEngineTime := 0;
-  FAuthEngineTimeStamp := 0;
-  FAuthKey := '';
-  FPrivKey := '';
-end;
-
-procedure TSNMPRec.MIBAdd(const MIB, Value: AnsiString; ValueType: Integer);
-var
-  SNMPMib: TSNMPMib;
-begin
-  SNMPMib := TSNMPMib.Create;
-  SNMPMib.OID := MIB;
-  SNMPMib.Value := Value;
-  SNMPMib.ValueType := ValueType;
-  FSNMPMibList.Add(SNMPMib);
-end;
-
-procedure TSNMPRec.MIBDelete(Index: Integer);
-begin
-  if (Index >= 0) and (Index < MIBCount) then
-  begin
-    TSNMPMib(FSNMPMibList[Index]).Free;
-    FSNMPMibList.Delete(Index);
-  end;
-end;
-
-function TSNMPRec.MIBCount: integer;
-begin
-  Result := FSNMPMibList.Count;
-end;
-
-function TSNMPRec.MIBByIndex(Index: Integer): TSNMPMib;
-begin
-  Result := nil;
-  if (Index >= 0) and (Index < MIBCount) then
-    Result := TSNMPMib(FSNMPMibList[Index]);
-end;
-
-function TSNMPRec.MIBGet(const MIB: AnsiString): AnsiString;
-var
-  i: Integer;
-begin
-  Result := '';
-  for i := 0 to MIBCount - 1 do
-  begin
-    if ((TSNMPMib(FSNMPMibList[i])).OID = MIB) then
-    begin
-      Result := (TSNMPMib(FSNMPMibList[i])).Value;
-      Break;
-    end;
-  end;
-end;
-
-{==============================================================================}
-
-constructor TSNMPSend.Create;
-begin
-  inherited Create;
-  FQuery := TSNMPRec.Create;
-  FReply := TSNMPRec.Create;
-  FQuery.Clear;
-  FReply.Clear;
-  FSock := TUDPBlockSocket.Create;
-  FSock.Owner := self;
-  FTimeout := 5000;
-  FTargetPort := cSnmpProtocol;
-  FHostIP := '';
-end;
-
-destructor TSNMPSend.Destroy;
-begin
-  FSock.Free;
-  FReply.Free;
-  FQuery.Free;
-  inherited Destroy;
-end;
-
-function TSNMPSend.InternalSendSnmp(const Value: TSNMPRec): Boolean;
-begin
-  FBuffer := Value.EncodeBuf;
-  FSock.SendString(FBuffer);
-  Result := FSock.LastError = 0;
-end;
-
-function TSNMPSend.InternalRecvSnmp(const Value: TSNMPRec): Boolean;
-begin
-  Result := False;
-  FReply.Clear;
-  FHostIP := cAnyHost;
-  FBuffer := FSock.RecvPacket(FTimeout);
-  if FSock.LastError = 0 then
-  begin
-    FHostIP := FSock.GetRemoteSinIP;
-    Result := Value.DecodeBuf(FBuffer);
-  end;
-end;
-
-function TSNMPSend.InternalSendRequest(const QValue, RValue: TSNMPRec): Boolean;
-begin
-  Result := False;
-  FSock.Bind(FIPInterface, cAnyPort);
-  FSock.Connect(FTargetHost, FTargetPort);
-  if InternalSendSnmp(QValue) then
-    Result := InternalRecvSnmp(RValue);
-end;
-
-function TSNMPSend.SendRequest: Boolean;
-var
-  sync: TV3Sync;
-begin
-  Result := False;
-  if FQuery.FVersion = 3 then
-  begin
-    sync := GetV3Sync;
-    FQuery.AuthEngineBoots := Sync.EngineBoots;
-    FQuery.AuthEngineTime := Sync.EngineTime;
-    FQuery.AuthEngineTimeStamp := Sync.EngineStamp;
-    FQuery.AuthEngineID := Sync.EngineID;
-  end;
-  FSock.Bind(FIPInterface, cAnyPort);
-  FSock.Connect(FTargetHost, FTargetPort);
-  if InternalSendSnmp(FQuery) then
-    Result := InternalRecvSnmp(FReply);
-end;
-
-function TSNMPSend.SendTrap: Boolean;
-begin
-  FSock.Bind(FIPInterface, cAnyPort);
-  FSock.Connect(FTargetHost, FTargetPort);
-  Result := InternalSendSnmp(FQuery);
-end;
-
-function TSNMPSend.RecvTrap: Boolean;
-begin
-  FSock.Bind(FIPInterface, FTargetPort);
-  Result := InternalRecvSnmp(FReply);
-end;
-
-function TSNMPSend.DoIt: Boolean;
-begin
-  Result := SendRequest;
-end;
-
-function TSNMPSend.GetV3EngineID: AnsiString;
-var
-  DisQuery: TSNMPRec;
-begin
-  Result := '';
-  DisQuery := TSNMPRec.Create;
-  try
-    DisQuery.Version := 3;
-    DisQuery.UserName := '';
-    DisQuery.FlagReportable := True;
-    DisQuery.PDUType := PDUGetRequest;
-    if InternalSendRequest(DisQuery, FReply) then
-      Result := FReply.FAuthEngineID;
-  finally
-    DisQuery.Free;
-  end;
-end;
-
-function TSNMPSend.GetV3Sync: TV3Sync;
-var
-  SyncQuery: TSNMPRec;
-begin
-  Result.EngineID := GetV3EngineID;
-  Result.EngineBoots := FReply.AuthEngineBoots;
-  Result.EngineTime := FReply.AuthEngineTime;
-  Result.EngineStamp := FReply.AuthEngineTimeStamp;
-  if Result.EngineTime = 0 then
-  begin
-    //still not have sync...
-    SyncQuery := TSNMPRec.Create;
-    try
-      SyncQuery.Version := 3;
-      SyncQuery.UserName := FQuery.UserName;
-      SyncQuery.Password := FQuery.Password;
-      SyncQuery.FlagReportable := True;
-      SyncQuery.Flags := FQuery.Flags;
-      SyncQuery.PDUType := PDUGetRequest;
-      SyncQuery.AuthEngineID := FReply.FAuthEngineID;
-      if InternalSendRequest(SyncQuery, FReply) then
-      begin
-        Result.EngineBoots := FReply.AuthEngineBoots;
-        Result.EngineTime := FReply.AuthEngineTime;
-        Result.EngineStamp := FReply.AuthEngineTimeStamp;
-      end;
-    finally
-      SyncQuery.Free;
-    end;
-  end;
-end;
-
-{==============================================================================}
-
-function SNMPGet(const OID, Community, SNMPHost: AnsiString; var Value: AnsiString): Boolean;
-var
-  SNMPSend: TSNMPSend;
-begin
-  SNMPSend := TSNMPSend.Create;
-  try
-    SNMPSend.Query.Clear;
-    SNMPSend.Query.Community := Community;
-    SNMPSend.Query.PDUType := PDUGetRequest;
-    SNMPSend.Query.MIBAdd(OID, '', ASN1_NULL);
-    SNMPSend.TargetHost := SNMPHost;
-    Result := SNMPSend.SendRequest;
-    Value := '';
-    if Result then
-      Value := SNMPSend.Reply.MIBGet(OID);
-  finally
-    SNMPSend.Free;
-  end;
-end;
-
-function SNMPSet(const OID, Community, SNMPHost, Value: AnsiString; ValueType: Integer): Boolean;
-var
-  SNMPSend: TSNMPSend;
-begin
-  SNMPSend := TSNMPSend.Create;
-  try
-    SNMPSend.Query.Clear;
-    SNMPSend.Query.Community := Community;
-    SNMPSend.Query.PDUType := PDUSetRequest;
-    SNMPSend.Query.MIBAdd(OID, Value, ValueType);
-    SNMPSend.TargetHost := SNMPHost;
-    Result := SNMPSend.Sendrequest = True;
-  finally
-    SNMPSend.Free;
-  end;
-end;
-
-function InternalGetNext(const SNMPSend: TSNMPSend; var OID: AnsiString;
-  const Community: AnsiString; var Value: AnsiString): Boolean;
-begin
-  SNMPSend.Query.Clear;
-  SNMPSend.Query.ID := SNMPSend.Query.ID + 1;
-  SNMPSend.Query.Community := Community;
-  SNMPSend.Query.PDUType := PDUGetNextRequest;
-  SNMPSend.Query.MIBAdd(OID, '', ASN1_NULL);
-  Result := SNMPSend.Sendrequest;
-  Value := '';
-  if Result then
-    if SNMPSend.Reply.SNMPMibList.Count > 0 then
-    begin
-      OID := TSNMPMib(SNMPSend.Reply.SNMPMibList[0]).OID;
-      Value := TSNMPMib(SNMPSend.Reply.SNMPMibList[0]).Value;
-    end;
-end;
-
-function SNMPGetNext(var OID: AnsiString; const Community, SNMPHost: AnsiString; var Value: AnsiString): Boolean;
-var
-  SNMPSend: TSNMPSend;
-begin
-  SNMPSend := TSNMPSend.Create;
-  try
-    SNMPSend.TargetHost := SNMPHost;
-    Result := InternalGetNext(SNMPSend, OID, Community, Value);
-  finally
-    SNMPSend.Free;
-  end;
-end;
-
-function SNMPGetTable(const BaseOID, Community, SNMPHost: AnsiString; const Value: TStrings): Boolean;
-var
-  OID: AnsiString;
-  s: AnsiString;
-  col,row: String;
-  x: integer;
-  SNMPSend: TSNMPSend;
-  RowList: TStringList;
-begin
-  Value.Clear;
-  SNMPSend := TSNMPSend.Create;
-  RowList := TStringList.Create;
-  try
-    SNMPSend.TargetHost := SNMPHost;
-    OID := BaseOID;
-    repeat
-      Result := InternalGetNext(SNMPSend, OID, Community, s);
-      if Pos(BaseOID, OID) <> 1 then
-          break;
-      row := separateright(oid, baseoid + '.');
-      col := fetch(row, '.');
-
-      if IsBinaryString(s) then
-        s := StrToHex(s);
-      x := RowList.indexOf(Row);
-      if x < 0 then
-      begin
-        x := RowList.add(Row);
-        Value.Add('');
-      end;
-      if (Value[x] <> '') then
-        Value[x] := Value[x] + ',';
-      Value[x] := Value[x] + AnsiQuotedStr(s, '"');
-    until not result;
-  finally
-    SNMPSend.Free;
-    RowList.Free;
-  end;
-end;
-
-function SNMPGetTableElement(const BaseOID, RowID, ColID, Community, SNMPHost: AnsiString; var Value: AnsiString): Boolean;
-var
-  s: AnsiString;
-begin
-  s := BaseOID + '.' + ColID + '.' + RowID;
-  Result := SnmpGet(s, Community, SNMPHost, Value);
-end;
-
-function SendTrap(const Dest, Source, Enterprise, Community: AnsiString;
-  Generic, Specific, Seconds: Integer; const MIBName, MIBValue: AnsiString;
-  MIBtype: Integer): Integer;
-var
-  SNMPSend: TSNMPSend;
-begin
-  SNMPSend := TSNMPSend.Create;
-  try
-    SNMPSend.TargetHost := Dest;
-    SNMPSend.TargetPort := cSnmpTrapProtocol;
-    SNMPSend.Query.Community := Community;
-    SNMPSend.Query.Version := SNMP_V1;
-    SNMPSend.Query.PDUType := PDUTrap;
-    SNMPSend.Query.OldTrapHost := Source;
-    SNMPSend.Query.OldTrapEnterprise := Enterprise;
-    SNMPSend.Query.OldTrapGen := Generic;
-    SNMPSend.Query.OldTrapSpec := Specific;
-    SNMPSend.Query.OldTrapTimeTicks := Seconds;
-    SNMPSend.Query.MIBAdd(MIBName, MIBValue, MIBType);
-    Result := Ord(SNMPSend.SendTrap);
-  finally
-    SNMPSend.Free;
-  end;
-end;
-
-function RecvTrap(var Dest, Source, Enterprise, Community: AnsiString;
-  var Generic, Specific, Seconds: Integer;
-  const MIBName, MIBValue: TStringList): Integer;
-var
-  SNMPSend: TSNMPSend;
-  i: Integer;
-begin
-  SNMPSend := TSNMPSend.Create;
-  try
-    Result := 0;
-    SNMPSend.TargetPort := cSnmpTrapProtocol;
-    if SNMPSend.RecvTrap then
-    begin
-      Result := 1;
-      Dest := SNMPSend.HostIP;
-      Community := SNMPSend.Reply.Community;
-      Source := SNMPSend.Reply.OldTrapHost;
-      Enterprise := SNMPSend.Reply.OldTrapEnterprise;
-      Generic := SNMPSend.Reply.OldTrapGen;
-      Specific := SNMPSend.Reply.OldTrapSpec;
-      Seconds := SNMPSend.Reply.OldTrapTimeTicks;
-      MIBName.Clear;
-      MIBValue.Clear;
-      for i := 0 to SNMPSend.Reply.SNMPMibList.Count - 1 do
-      begin
-        MIBName.Add(TSNMPMib(SNMPSend.Reply.SNMPMibList[i]).OID);
-        MIBValue.Add(TSNMPMib(SNMPSend.Reply.SNMPMibList[i]).Value);
-      end;
-    end;
-  finally
-    SNMPSend.Free;
-  end;
-end;
-
-
-end.
-
-
+{==============================================================================|
+| Project : Ararat Synapse                                       | 003.000.010 |
+|==============================================================================|
+| Content: SNMP client                                                         |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2000-2010.                |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|   Jean-Fabien Connault (cycocrew@worldnet.fr)                                |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@abstract(SNMP client)
+Supports SNMPv1 include traps, SNMPv2c and SNMPv3 include authorization
+ (encryption not yet supported!)
+
+Used RFC: RFC-1157, RFC-1901, RFC-3412, RFC-3414, RFC-3416
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$Q-}
+{$H+}
+
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit snmpsend;
+
+interface
+
+uses
+  Classes, SysUtils,
+  blcksock, synautil, asn1util, synaip, synacode;
+
+const
+  cSnmpProtocol = '161';
+  cSnmpTrapProtocol = '162';
+
+  SNMP_V1 = 0;
+  SNMP_V2C = 1;
+  SNMP_V3 = 3;
+
+  //PDU type
+  PDUGetRequest = $A0;
+  PDUGetNextRequest = $A1;
+  PDUGetResponse = $A2;
+  PDUSetRequest = $A3;
+  PDUTrap = $A4; //Obsolete
+  //for SNMPv2
+  PDUGetBulkRequest = $A5;
+  PDUInformRequest = $A6;
+  PDUTrapV2 = $A7;
+  PDUReport = $A8;
+
+  //errors
+  ENoError = 0;
+  ETooBig = 1;
+  ENoSuchName = 2;
+  EBadValue = 3;
+  EReadOnly = 4;
+  EGenErr = 5;
+  //errors SNMPv2
+  ENoAccess = 6;
+  EWrongType = 7;
+  EWrongLength = 8;
+  EWrongEncoding = 9;
+  EWrongValue = 10;
+  ENoCreation = 11;
+  EInconsistentValue = 12;
+  EResourceUnavailable = 13;
+  ECommitFailed = 14;
+  EUndoFailed = 15;
+  EAuthorizationError = 16;
+  ENotWritable = 17;
+  EInconsistentName = 18;
+
+type
+
+  {:@abstract(Possible values for SNMPv3 flags.)
+   This flags specify level of authorization and encryption.}
+  TV3Flags = (
+    NoAuthNoPriv,
+    AuthNoPriv,
+    AuthPriv);
+
+  {:@abstract(Type of SNMPv3 authorization)}
+  TV3Auth = (
+    AuthMD5,
+    AuthSHA1);
+
+  {:@abstract(Data object with one record of MIB OID and corresponding values.)}
+  TSNMPMib = class(TObject)
+  protected
+    FOID: AnsiString;
+    FValue: AnsiString;
+    FValueType: Integer;
+  published
+    {:OID number in string format.}
+    property OID: AnsiString read FOID write FOID;
+
+    {:Value of OID object in string format.}
+    property Value: AnsiString read FValue write FValue;
+
+    {:Define type of Value. Supported values are defined in @link(asn1util).
+     For queries use ASN1_NULL, becouse you don't know type in response!}
+    property ValueType: Integer read FValueType write FValueType;
+  end;
+
+  {:@abstract(It holding all information for SNMPv3 agent synchronization)
+   Used internally.}
+  TV3Sync = record
+    EngineID: AnsiString;
+    EngineBoots: integer;
+    EngineTime: integer;
+    EngineStamp: Cardinal;
+  end;
+
+  {:@abstract(Data object abstracts SNMP data packet)}
+  TSNMPRec = class(TObject)
+  protected
+    FVersion: Integer;
+    FPDUType: Integer;
+    FID: Integer;
+    FErrorStatus: Integer;
+    FErrorIndex: Integer;
+    FCommunity: AnsiString;
+    FSNMPMibList: TList;
+    FMaxSize: Integer;
+    FFlags: TV3Flags;
+    FFlagReportable: Boolean;
+    FContextEngineID: AnsiString;
+    FContextName: AnsiString;
+    FAuthMode: TV3Auth;
+    FAuthEngineID: AnsiString;
+    FAuthEngineBoots: integer;
+    FAuthEngineTime: integer;
+    FAuthEngineTimeStamp: cardinal;
+    FUserName: AnsiString;
+    FPassword: AnsiString;
+    FAuthKey: AnsiString;
+    FPrivKey: AnsiString;
+    FOldTrapEnterprise: AnsiString;
+    FOldTrapHost: AnsiString;
+    FOldTrapGen: Integer;
+    FOldTrapSpec: Integer;
+    FOldTrapTimeTicks: Integer;
+    function Pass2Key(const Value: AnsiString): AnsiString;
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    {:Decode SNMP packet in buffer to object properties.}
+    function DecodeBuf(const Buffer: AnsiString): Boolean;
+
+    {:Encode obeject properties to SNMP packet.}
+    function EncodeBuf: AnsiString;
+
+    {:Clears all object properties to default values.}
+    procedure Clear;
+
+    {:Add entry to @link(SNMPMibList). For queries use value as empty string,
+     and ValueType as ASN1_NULL.}
+    procedure MIBAdd(const MIB, Value: AnsiString; ValueType: Integer);
+
+    {:Delete entry from @link(SNMPMibList).}
+    procedure MIBDelete(Index: Integer);
+
+    {:Search @link(SNMPMibList) list for MIB and return correspond value.}
+    function MIBGet(const MIB: AnsiString): AnsiString;
+
+    {:return number of entries in MIB array.}
+    function MIBCount: integer;
+
+    {:Return MIB information from given row of MIB array.}
+    function MIBByIndex(Index: Integer): TSNMPMib;
+
+    {:List of @link(TSNMPMib) objects.}
+    property SNMPMibList: TList read FSNMPMibList;
+  published
+    {:Version of SNMP packet. Default value is 0 (SNMP ver. 1). You can use
+     value 1 for SNMPv2c or value 3 for SNMPv3.}
+    property Version: Integer read FVersion write FVersion;
+
+    {:Community string for autorize access to SNMP server. (Case sensitive!)
+     Community string is not used in SNMPv3! Use @link(Username) and
+     @link(password) instead!}
+    property Community: AnsiString read FCommunity write FCommunity;
+
+    {:Define type of SNMP operation.}
+    property PDUType: Integer read FPDUType write FPDUType;
+
+    {:Contains ID number. Not need to use.}
+    property ID: Integer read FID write FID;
+
+    {:When packet is reply, contains error code. Supported values are defined by
+     E* constants.}
+    property ErrorStatus: Integer read FErrorStatus write FErrorStatus;
+
+    {:Point to error position in reply packet. Not usefull for users. It only
+     good for debugging!}
+    property ErrorIndex: Integer read FErrorIndex write FErrorIndex;
+
+    {:special value for GetBulkRequest of SNMPv2 and v3.}
+    property NonRepeaters: Integer read FErrorStatus write FErrorStatus;
+
+    {:special value for GetBulkRequest of SNMPv2 and v3.}
+    property MaxRepetitions: Integer read FErrorIndex write FErrorIndex;
+
+    {:Maximum message size in bytes for SNMPv3. For sending is default 1472 bytes.}
+    property MaxSize: Integer read FMaxSize write FMaxSize;
+
+    {:Specify if message is authorised or encrypted. Used only in SNMPv3, and
+     encryption is not yet supported!}
+    property Flags: TV3Flags read FFlags write FFlags;
+
+    {:For SNMPv3.... If is @true, SNMP agent must send reply (at least with some
+     error).}
+    property FlagReportable: Boolean read FFlagReportable write FFlagReportable;
+
+    {:For SNMPv3. If not specified, is used value from @link(AuthEngineID)}
+    property ContextEngineID: AnsiString read FContextEngineID write FContextEngineID;
+
+    {:For SNMPv3.}
+    property ContextName: AnsiString read FContextName write FContextName;
+
+    {:For SNMPv3. Specify Authorization mode. (specify used hash for
+     authorization)}
+    property AuthMode: TV3Auth read FAuthMode write FAuthMode;
+
+    {:value used by SNMPv3 authorisation for synchronization with SNMP agent.}
+    property AuthEngineID: AnsiString read FAuthEngineID write FAuthEngineID;
+
+    {:value used by SNMPv3 authorisation for synchronization with SNMP agent.}
+    property AuthEngineBoots: Integer read FAuthEngineBoots write FAuthEngineBoots;
+
+    {:value used by SNMPv3 authorisation for synchronization with SNMP agent.}
+    property AuthEngineTime: Integer read FAuthEngineTime write FAuthEngineTime;
+
+    {:value used by SNMPv3 authorisation for synchronization with SNMP agent.}
+    property AuthEngineTimeStamp: Cardinal read FAuthEngineTimeStamp Write FAuthEngineTimeStamp;
+
+    {:SNMPv3 authorization username}
+    property UserName: AnsiString read FUserName write FUserName;
+
+    {:SNMPv3 authorization password}
+    property Password: AnsiString read FPassword write FPassword;
+
+    {:For SNMPv3. Computed Athorization key from @link(password).}
+    property AuthKey: AnsiString read FAuthKey write FAuthKey;
+
+    {:For SNMPv3. Encryption key for message encryption. Not yet used!}
+    property PrivKey: AnsiString read FPrivKey write FPrivKey;
+
+    {:MIB value to identify the object that sent the TRAPv1.}
+    property OldTrapEnterprise: AnsiString read FOldTrapEnterprise write FOldTrapEnterprise;
+
+    {:Address of TRAPv1 sender (IP address).}
+    property OldTrapHost: AnsiString read FOldTrapHost write FOldTrapHost;
+
+    {:Generic TRAPv1 identification.}
+    property OldTrapGen: Integer read FOldTrapGen write FOldTrapGen;
+
+    {:Specific TRAPv1 identification.}
+    property OldTrapSpec: Integer read FOldTrapSpec write FOldTrapSpec;
+
+    {:Number of 1/100th of seconds since last reboot or power up. (for TRAPv1)}
+    property OldTrapTimeTicks: Integer read FOldTrapTimeTicks write FOldTrapTimeTicks;
+  end;
+
+  {:@abstract(Implementation of SNMP protocol.)
+
+   Note: Are you missing properties for specify server address and port? Look to
+   parent @link(TSynaClient) too!}
+  TSNMPSend = class(TSynaClient)
+  protected
+    FSock: TUDPBlockSocket;
+    FBuffer: AnsiString;
+    FHostIP: AnsiString;
+    FQuery: TSNMPRec;
+    FReply: TSNMPRec;
+    function InternalSendSnmp(const Value: TSNMPRec): Boolean;
+    function InternalRecvSnmp(const Value: TSNMPRec): Boolean;
+    function InternalSendRequest(const QValue, RValue: TSNMPRec): Boolean;
+    function GetV3EngineID: AnsiString;
+    function GetV3Sync: TV3Sync;
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    {:Connects to a Host and send there query. If in timeout SNMP server send
+     back query, result is @true. If is used SNMPv3, then it synchronize self
+     with SNMPv3 agent first. (It is needed for SNMPv3 auhorization!)}
+    function SendRequest: Boolean;
+
+    {:Send SNMP packet only, but not waits for reply. Good for sending traps.}
+    function SendTrap: Boolean;
+
+    {:Receive SNMP packet only. Good for receiving traps.}
+    function RecvTrap: Boolean;
+
+    {:Mapped to @link(SendRequest) internally. This function is only for
+     backward compatibility.}
+    function DoIt: Boolean;
+  published
+    {:contains raw binary form of SNMP packet. Good for debugging.}
+    property Buffer: AnsiString read FBuffer write FBuffer;
+
+    {:After SNMP operation hold IP address of remote side.}
+    property HostIP: AnsiString read FHostIP;
+
+    {:Data object contains SNMP query.}
+    property Query: TSNMPRec read FQuery;
+
+    {:Data object contains SNMP reply.}
+    property Reply: TSNMPRec read FReply;
+
+    {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
+    property Sock: TUDPBlockSocket read FSock;
+  end;
+
+{:A very useful function and example of its use would be found in the TSNMPSend
+ object. It implements basic GET method of the SNMP protocol. The MIB value is
+ located in the "OID" variable, and is sent to the requested "SNMPHost" with
+ the proper "Community" access identifier. Upon a successful retrieval, "Value"
+ will contain the information requested. If the SNMP operation is successful,
+ the result returns @true.}
+function SNMPGet(const OID, Community, SNMPHost: AnsiString; var Value: AnsiString): Boolean;
+
+{:This is useful function and example of use TSNMPSend object. It implements
+ the basic SET method of the SNMP protocol. If the SNMP operation is successful,
+ the result is @true. "Value" is value of MIB Oid for "SNMPHost" with "Community"
+ access identifier. You must specify "ValueType" too.}
+function SNMPSet(const OID, Community, SNMPHost, Value: AnsiString; ValueType: Integer): Boolean;
+
+{:A very useful function and example of its use would be found in the TSNMPSend
+ object. It implements basic GETNEXT method of the SNMP protocol. The MIB value
+ is located in the "OID" variable, and is sent to the requested "SNMPHost" with
+ the proper "Community" access identifier. Upon a successful retrieval, "Value"
+ will contain the information requested. If the SNMP operation is successful,
+ the result returns @true.}
+function SNMPGetNext(var OID: AnsiString; const Community, SNMPHost: AnsiString; var Value: AnsiString): Boolean;
+
+{:A very useful function and example of its use would be found in the TSNMPSend
+ object. It implements basic read of SNMP MIB tables. As BaseOID you must
+ specify basic MIB OID of requested table (base IOD is OID without row and
+ column specificator!)
+ Table is readed into stringlist, where each string is comma delimited string.
+
+ Warning: this function is not have best performance. For better performance
+ you must write your own function. best performace you can get by knowledge
+ of structuture of table and by more then one MIB on one query. }
+function SNMPGetTable(const BaseOID, Community, SNMPHost: AnsiString; const Value: TStrings): Boolean;
+
+{:A very useful function and example of its use would be found in the TSNMPSend
+ object. It implements basic read of SNMP MIB table element. As BaseOID you must
+ specify basic MIB OID of requested table (base IOD is OID without row and
+ column specificator!)
+ As next you must specify identificator of row and column for specify of needed
+ field of table.}
+function SNMPGetTableElement(const BaseOID, RowID, ColID, Community, SNMPHost: AnsiString; var Value: AnsiString): Boolean;
+
+{:A very useful function and example of its use would be found in the TSNMPSend
+ object. It implements a TRAPv1 to send with all data in the parameters.}
+function SendTrap(const Dest, Source, Enterprise, Community: AnsiString;
+  Generic, Specific, Seconds: Integer; const MIBName, MIBValue: AnsiString;
+  MIBtype: Integer): Integer;
+
+{:A very useful function and example of its use would be found in the TSNMPSend
+ object. It receives a TRAPv1 and returns all the data that comes with it.}
+function RecvTrap(var Dest, Source, Enterprise, Community: AnsiString;
+  var Generic, Specific, Seconds: Integer; const MIBName,
+  MIBValue: TStringList): Integer;
+
+implementation
+
+{==============================================================================}
+
+constructor TSNMPRec.Create;
+begin
+  inherited Create;
+  FSNMPMibList := TList.Create;
+  Clear;
+  FID := 1;
+  FMaxSize := 1472;
+end;
+
+destructor TSNMPRec.Destroy;
+var
+  i: Integer;
+begin
+  for i := 0 to FSNMPMibList.Count - 1 do
+    TSNMPMib(FSNMPMibList[i]).Free;
+  FSNMPMibList.Clear;
+  FSNMPMibList.Free;
+  inherited Destroy;
+end;
+
+function TSNMPRec.Pass2Key(const Value: AnsiString): AnsiString;
+var
+  key: AnsiString;
+begin
+  case FAuthMode of
+    AuthMD5:
+      begin
+        key := MD5LongHash(Value, 1048576);
+        Result := MD5(key + FAuthEngineID + key);
+      end;
+    AuthSHA1:
+      begin
+        key := SHA1LongHash(Value, 1048576);
+        Result := SHA1(key + FAuthEngineID + key);
+      end;
+  else
+    Result := '';
+  end;
+end;
+
+
+function TSNMPRec.DecodeBuf(const Buffer: AnsiString): Boolean;
+var
+  Pos: Integer;
+  EndPos: Integer;
+  sm, sv: AnsiString;
+  Svt: Integer;
+  s: AnsiString;
+  Spos: integer;
+  x: Byte;
+begin
+  Clear;
+  Result := False;
+  if Length(Buffer) < 2 then
+    Exit;
+  if (Ord(Buffer[1]) and $20) = 0 then
+    Exit;
+  Pos := 2;
+  EndPos := ASNDecLen(Pos, Buffer);
+  if Length(Buffer) < (EndPos + 2) then
+    Exit;
+  Self.FVersion := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
+
+  if FVersion = 3 then
+  begin
+    ASNItem(Pos, Buffer, Svt);  //header data seq
+    ASNItem(Pos, Buffer, Svt);  //ID
+    FMaxSize := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
+    s := ASNItem(Pos, Buffer, Svt);
+    x := 0;
+    if s <> '' then
+      x := Ord(s[1]);
+    FFlagReportable := (x and 4) > 0;
+    x := x and 3;
+    case x of
+      1:
+        FFlags := AuthNoPriv;
+      3:
+        FFlags := AuthPriv;
+    else
+      FFlags := NoAuthNoPriv;
+    end;
+
+    x := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
+    s := ASNItem(Pos, Buffer, Svt); //SecurityParameters
+    //if SecurityModel is USM, then try to decode SecurityParameters
+    if (x = 3) and (s <> '') then
+    begin
+      spos := 1;
+      ASNItem(SPos, s, Svt);
+      FAuthEngineID := ASNItem(SPos, s, Svt);
+      FAuthEngineBoots := StrToIntDef(ASNItem(SPos, s, Svt), 0);
+      FAuthEngineTime := StrToIntDef(ASNItem(SPos, s, Svt), 0);
+      FAuthEngineTimeStamp := GetTick;
+      FUserName := ASNItem(SPos, s, Svt);
+      FAuthKey := ASNItem(SPos, s, Svt);
+      FPrivKey := ASNItem(SPos, s, Svt);
+    end;
+    //scopedPDU
+    s := ASNItem(Pos, Buffer, Svt);
+    if Svt = ASN1_OCTSTR then
+    begin
+      //decrypt!
+    end;
+    FContextEngineID := ASNItem(Pos, Buffer, Svt);
+    FContextName := ASNItem(Pos, Buffer, Svt);
+  end
+  else
+  begin
+    //old packet
+    Self.FCommunity := ASNItem(Pos, Buffer, Svt);
+  end;
+
+  ASNItem(Pos, Buffer, Svt);
+  Self.FPDUType := Svt;
+  if Self.FPDUType = PDUTrap then
+  begin
+    FOldTrapEnterprise := ASNItem(Pos, Buffer, Svt);
+    FOldTrapHost := ASNItem(Pos, Buffer, Svt);
+    FOldTrapGen := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
+    FOldTrapSpec := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
+    FOldTrapTimeTicks := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
+  end
+  else
+  begin
+    Self.FID := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
+    Self.FErrorStatus := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
+    Self.FErrorIndex := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0);
+  end;
+  ASNItem(Pos, Buffer, Svt);
+  while Pos < EndPos do
+  begin
+    ASNItem(Pos, Buffer, Svt);
+    Sm := ASNItem(Pos, Buffer, Svt);
+    Sv := ASNItem(Pos, Buffer, Svt);
+    Self.MIBAdd(sm, sv, Svt);
+  end;
+  Result := True;
+end;
+
+function TSNMPRec.EncodeBuf: AnsiString;
+var
+  s: AnsiString;
+  SNMPMib: TSNMPMib;
+  n: Integer;
+  pdu, head, auth, authbeg: AnsiString;
+  x: Byte;
+begin
+  pdu := '';
+  for n := 0 to FSNMPMibList.Count - 1 do
+  begin
+    SNMPMib := TSNMPMib(FSNMPMibList[n]);
+    case SNMPMib.ValueType of
+      ASN1_INT:
+        s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) +
+          ASNObject(ASNEncInt(StrToIntDef(SNMPMib.Value, 0)), SNMPMib.ValueType);
+      ASN1_COUNTER, ASN1_GAUGE, ASN1_TIMETICKS:
+        s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) +
+          ASNObject(ASNEncUInt(StrToIntDef(SNMPMib.Value, 0)), SNMPMib.ValueType);
+      ASN1_OBJID:
+        s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) +
+          ASNObject(MibToID(SNMPMib.Value), SNMPMib.ValueType);
+      ASN1_IPADDR:
+        s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) +
+          ASNObject(IPToID(SNMPMib.Value), SNMPMib.ValueType);
+      ASN1_NULL:
+        s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) +
+          ASNObject('', ASN1_NULL);
+    else
+      s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) +
+        ASNObject(SNMPMib.Value, SNMPMib.ValueType);
+    end;
+    pdu := pdu + ASNObject(s, ASN1_SEQ);
+  end;
+  pdu := ASNObject(pdu, ASN1_SEQ);
+
+  if Self.FPDUType = PDUTrap then
+    pdu := ASNObject(MibToID(FOldTrapEnterprise), ASN1_OBJID) +
+      ASNObject(IPToID(FOldTrapHost), ASN1_IPADDR) +
+      ASNObject(ASNEncInt(FOldTrapGen), ASN1_INT) +
+      ASNObject(ASNEncInt(FOldTrapSpec), ASN1_INT) +
+      ASNObject(ASNEncUInt(FOldTrapTimeTicks), ASN1_TIMETICKS) +
+      pdu
+  else
+    pdu := ASNObject(ASNEncInt(Self.FID), ASN1_INT) +
+      ASNObject(ASNEncInt(Self.FErrorStatus), ASN1_INT) +
+      ASNObject(ASNEncInt(Self.FErrorIndex), ASN1_INT) +
+      pdu;
+  pdu := ASNObject(pdu, Self.FPDUType);
+
+  if FVersion = 3 then
+  begin
+    if FContextEngineID = '' then
+      FContextEngineID := FAuthEngineID;
+    //complete PDUv3...
+    pdu := ASNObject(FContextEngineID, ASN1_OCTSTR)
+      + ASNObject(FContextName, ASN1_OCTSTR)
+      + pdu;
+    //maybe encrypt pdu... in future
+    pdu := ASNObject(pdu, ASN1_SEQ);
+
+    //prepare flags
+    case FFlags of
+      AuthNoPriv:
+        x := 1;
+      AuthPriv:
+        x := 3;
+    else
+      x := 0;
+    end;
+    if FFlagReportable then
+      x := x or 4;
+    head := ASNObject(ASNEncInt(Self.FVersion), ASN1_INT);
+    s := ASNObject(ASNEncInt(FID), ASN1_INT)
+      + ASNObject(ASNEncInt(FMaxSize), ASN1_INT)
+      + ASNObject(AnsiChar(x), ASN1_OCTSTR)
+    //encode security model USM
+      + ASNObject(ASNEncInt(3), ASN1_INT);
+    head := head + ASNObject(s, ASN1_SEQ);
+
+    //compute engine time difference
+    x := TickDelta(FAuthEngineTimeStamp, GetTick) div 1000;
+
+    authbeg := ASNObject(FAuthEngineID, ASN1_OCTSTR)
+      + ASNObject(ASNEncInt(FAuthEngineBoots), ASN1_INT)
+      + ASNObject(ASNEncInt(FAuthEngineTime + x), ASN1_INT)
+      + ASNObject(FUserName, ASN1_OCTSTR);
+
+
+    case FFlags of
+      AuthNoPriv,
+      AuthPriv:
+        begin
+          s := authbeg + ASNObject(StringOfChar(#0, 12), ASN1_OCTSTR)
+             + ASNObject(FPrivKey, ASN1_OCTSTR);
+          s := ASNObject(s, ASN1_SEQ);
+          s := head + ASNObject(s, ASN1_OCTSTR);
+          s := ASNObject(s + pdu, ASN1_SEQ);
+          //in s is entire packet without auth info...
+          case FAuthMode of
+            AuthMD5:
+              begin
+                s := HMAC_MD5(s, Pass2Key(FPassword) + StringOfChar(#0, 48));
+                //strip to HMAC-MD5-96
+                delete(s, 13, 4);
+              end;
+            AuthSHA1:
+              begin
+                s := HMAC_SHA1(s, Pass2Key(FPassword) + StringOfChar(#0, 44));
+                //strip to HMAC-SHA-96
+                delete(s, 13, 8);
+              end;
+          else
+            s := '';
+          end;
+          FAuthKey := s;
+        end;
+    end;
+
+    auth := authbeg + ASNObject(FAuthKey, ASN1_OCTSTR)
+     + ASNObject(FPrivKey, ASN1_OCTSTR);
+    auth := ASNObject(auth, ASN1_SEQ);
+
+    head := head + ASNObject(auth, ASN1_OCTSTR);
+    Result := ASNObject(head + pdu, ASN1_SEQ);
+  end
+  else
+  begin
+    head := ASNObject(ASNEncInt(Self.FVersion), ASN1_INT) +
+      ASNObject(Self.FCommunity, ASN1_OCTSTR);
+    Result := ASNObject(head + pdu, ASN1_SEQ);
+  end;
+  inc(self.FID);
+end;
+
+procedure TSNMPRec.Clear;
+var
+  i: Integer;
+begin
+  FVersion := SNMP_V1;
+  FCommunity := 'public';
+  FUserName := '';
+  FPassword := '';
+  FPDUType := 0;
+  FErrorStatus := 0;
+  FErrorIndex := 0;
+  for i := 0 to FSNMPMibList.Count - 1 do
+    TSNMPMib(FSNMPMibList[i]).Free;
+  FSNMPMibList.Clear;
+  FOldTrapEnterprise := '';
+  FOldTrapHost := '';
+  FOldTrapGen := 0;
+  FOldTrapSpec := 0;
+  FOldTrapTimeTicks := 0;
+  FFlags := NoAuthNoPriv;
+  FFlagReportable := false;
+  FContextEngineID := '';
+  FContextName := '';
+  FAuthMode := AuthMD5;
+  FAuthEngineID := '';
+  FAuthEngineBoots := 0;
+  FAuthEngineTime := 0;
+  FAuthEngineTimeStamp := 0;
+  FAuthKey := '';
+  FPrivKey := '';
+end;
+
+procedure TSNMPRec.MIBAdd(const MIB, Value: AnsiString; ValueType: Integer);
+var
+  SNMPMib: TSNMPMib;
+begin
+  SNMPMib := TSNMPMib.Create;
+  SNMPMib.OID := MIB;
+  SNMPMib.Value := Value;
+  SNMPMib.ValueType := ValueType;
+  FSNMPMibList.Add(SNMPMib);
+end;
+
+procedure TSNMPRec.MIBDelete(Index: Integer);
+begin
+  if (Index >= 0) and (Index < MIBCount) then
+  begin
+    TSNMPMib(FSNMPMibList[Index]).Free;
+    FSNMPMibList.Delete(Index);
+  end;
+end;
+
+function TSNMPRec.MIBCount: integer;
+begin
+  Result := FSNMPMibList.Count;
+end;
+
+function TSNMPRec.MIBByIndex(Index: Integer): TSNMPMib;
+begin
+  Result := nil;
+  if (Index >= 0) and (Index < MIBCount) then
+    Result := TSNMPMib(FSNMPMibList[Index]);
+end;
+
+function TSNMPRec.MIBGet(const MIB: AnsiString): AnsiString;
+var
+  i: Integer;
+begin
+  Result := '';
+  for i := 0 to MIBCount - 1 do
+  begin
+    if ((TSNMPMib(FSNMPMibList[i])).OID = MIB) then
+    begin
+      Result := (TSNMPMib(FSNMPMibList[i])).Value;
+      Break;
+    end;
+  end;
+end;
+
+{==============================================================================}
+
+constructor TSNMPSend.Create;
+begin
+  inherited Create;
+  FQuery := TSNMPRec.Create;
+  FReply := TSNMPRec.Create;
+  FQuery.Clear;
+  FReply.Clear;
+  FSock := TUDPBlockSocket.Create;
+  FSock.Owner := self;
+  FTimeout := 5000;
+  FTargetPort := cSnmpProtocol;
+  FHostIP := '';
+end;
+
+destructor TSNMPSend.Destroy;
+begin
+  FSock.Free;
+  FReply.Free;
+  FQuery.Free;
+  inherited Destroy;
+end;
+
+function TSNMPSend.InternalSendSnmp(const Value: TSNMPRec): Boolean;
+begin
+  FBuffer := Value.EncodeBuf;
+  FSock.SendString(FBuffer);
+  Result := FSock.LastError = 0;
+end;
+
+function TSNMPSend.InternalRecvSnmp(const Value: TSNMPRec): Boolean;
+begin
+  Result := False;
+  FReply.Clear;
+  FHostIP := cAnyHost;
+  FBuffer := FSock.RecvPacket(FTimeout);
+  if FSock.LastError = 0 then
+  begin
+    FHostIP := FSock.GetRemoteSinIP;
+    Result := Value.DecodeBuf(FBuffer);
+  end;
+end;
+
+function TSNMPSend.InternalSendRequest(const QValue, RValue: TSNMPRec): Boolean;
+begin
+  Result := False;
+  FSock.Bind(FIPInterface, cAnyPort);
+  FSock.Connect(FTargetHost, FTargetPort);
+  if InternalSendSnmp(QValue) then
+    Result := InternalRecvSnmp(RValue);
+end;
+
+function TSNMPSend.SendRequest: Boolean;
+var
+  sync: TV3Sync;
+begin
+  Result := False;
+  if FQuery.FVersion = 3 then
+  begin
+    sync := GetV3Sync;
+    FQuery.AuthEngineBoots := Sync.EngineBoots;
+    FQuery.AuthEngineTime := Sync.EngineTime;
+    FQuery.AuthEngineTimeStamp := Sync.EngineStamp;
+    FQuery.AuthEngineID := Sync.EngineID;
+  end;
+  FSock.Bind(FIPInterface, cAnyPort);
+  FSock.Connect(FTargetHost, FTargetPort);
+  if InternalSendSnmp(FQuery) then
+    Result := InternalRecvSnmp(FReply);
+end;
+
+function TSNMPSend.SendTrap: Boolean;
+begin
+  FSock.Bind(FIPInterface, cAnyPort);
+  FSock.Connect(FTargetHost, FTargetPort);
+  Result := InternalSendSnmp(FQuery);
+end;
+
+function TSNMPSend.RecvTrap: Boolean;
+begin
+  FSock.Bind(FIPInterface, FTargetPort);
+  Result := InternalRecvSnmp(FReply);
+end;
+
+function TSNMPSend.DoIt: Boolean;
+begin
+  Result := SendRequest;
+end;
+
+function TSNMPSend.GetV3EngineID: AnsiString;
+var
+  DisQuery: TSNMPRec;
+begin
+  Result := '';
+  DisQuery := TSNMPRec.Create;
+  try
+    DisQuery.Version := 3;
+    DisQuery.UserName := '';
+    DisQuery.FlagReportable := True;
+    DisQuery.PDUType := PDUGetRequest;
+    if InternalSendRequest(DisQuery, FReply) then
+      Result := FReply.FAuthEngineID;
+  finally
+    DisQuery.Free;
+  end;
+end;
+
+function TSNMPSend.GetV3Sync: TV3Sync;
+var
+  SyncQuery: TSNMPRec;
+begin
+  Result.EngineID := GetV3EngineID;
+  Result.EngineBoots := FReply.AuthEngineBoots;
+  Result.EngineTime := FReply.AuthEngineTime;
+  Result.EngineStamp := FReply.AuthEngineTimeStamp;
+  if Result.EngineTime = 0 then
+  begin
+    //still not have sync...
+    SyncQuery := TSNMPRec.Create;
+    try
+      SyncQuery.Version := 3;
+      SyncQuery.UserName := FQuery.UserName;
+      SyncQuery.Password := FQuery.Password;
+      SyncQuery.FlagReportable := True;
+      SyncQuery.Flags := FQuery.Flags;
+      SyncQuery.PDUType := PDUGetRequest;
+      SyncQuery.AuthEngineID := FReply.FAuthEngineID;
+      if InternalSendRequest(SyncQuery, FReply) then
+      begin
+        Result.EngineBoots := FReply.AuthEngineBoots;
+        Result.EngineTime := FReply.AuthEngineTime;
+        Result.EngineStamp := FReply.AuthEngineTimeStamp;
+      end;
+    finally
+      SyncQuery.Free;
+    end;
+  end;
+end;
+
+{==============================================================================}
+
+function SNMPGet(const OID, Community, SNMPHost: AnsiString; var Value: AnsiString): Boolean;
+var
+  SNMPSend: TSNMPSend;
+begin
+  SNMPSend := TSNMPSend.Create;
+  try
+    SNMPSend.Query.Clear;
+    SNMPSend.Query.Community := Community;
+    SNMPSend.Query.PDUType := PDUGetRequest;
+    SNMPSend.Query.MIBAdd(OID, '', ASN1_NULL);
+    SNMPSend.TargetHost := SNMPHost;
+    Result := SNMPSend.SendRequest;
+    Value := '';
+    if Result then
+      Value := SNMPSend.Reply.MIBGet(OID);
+  finally
+    SNMPSend.Free;
+  end;
+end;
+
+function SNMPSet(const OID, Community, SNMPHost, Value: AnsiString; ValueType: Integer): Boolean;
+var
+  SNMPSend: TSNMPSend;
+begin
+  SNMPSend := TSNMPSend.Create;
+  try
+    SNMPSend.Query.Clear;
+    SNMPSend.Query.Community := Community;
+    SNMPSend.Query.PDUType := PDUSetRequest;
+    SNMPSend.Query.MIBAdd(OID, Value, ValueType);
+    SNMPSend.TargetHost := SNMPHost;
+    Result := SNMPSend.Sendrequest = True;
+  finally
+    SNMPSend.Free;
+  end;
+end;
+
+function InternalGetNext(const SNMPSend: TSNMPSend; var OID: AnsiString;
+  const Community: AnsiString; var Value: AnsiString): Boolean;
+begin
+  SNMPSend.Query.Clear;
+  SNMPSend.Query.ID := SNMPSend.Query.ID + 1;
+  SNMPSend.Query.Community := Community;
+  SNMPSend.Query.PDUType := PDUGetNextRequest;
+  SNMPSend.Query.MIBAdd(OID, '', ASN1_NULL);
+  Result := SNMPSend.Sendrequest;
+  Value := '';
+  if Result then
+    if SNMPSend.Reply.SNMPMibList.Count > 0 then
+    begin
+      OID := TSNMPMib(SNMPSend.Reply.SNMPMibList[0]).OID;
+      Value := TSNMPMib(SNMPSend.Reply.SNMPMibList[0]).Value;
+    end;
+end;
+
+function SNMPGetNext(var OID: AnsiString; const Community, SNMPHost: AnsiString; var Value: AnsiString): Boolean;
+var
+  SNMPSend: TSNMPSend;
+begin
+  SNMPSend := TSNMPSend.Create;
+  try
+    SNMPSend.TargetHost := SNMPHost;
+    Result := InternalGetNext(SNMPSend, OID, Community, Value);
+  finally
+    SNMPSend.Free;
+  end;
+end;
+
+function SNMPGetTable(const BaseOID, Community, SNMPHost: AnsiString; const Value: TStrings): Boolean;
+var
+  OID: AnsiString;
+  s: AnsiString;
+  col,row: String;
+  x: integer;
+  SNMPSend: TSNMPSend;
+  RowList: TStringList;
+begin
+  Value.Clear;
+  SNMPSend := TSNMPSend.Create;
+  RowList := TStringList.Create;
+  try
+    SNMPSend.TargetHost := SNMPHost;
+    OID := BaseOID;
+    repeat
+      Result := InternalGetNext(SNMPSend, OID, Community, s);
+      if Pos(BaseOID, OID) <> 1 then
+          break;
+      row := separateright(oid, baseoid + '.');
+      col := fetch(row, '.');
+
+      if IsBinaryString(s) then
+        s := StrToHex(s);
+      x := RowList.indexOf(Row);
+      if x < 0 then
+      begin
+        x := RowList.add(Row);
+        Value.Add('');
+      end;
+      if (Value[x] <> '') then
+        Value[x] := Value[x] + ',';
+      Value[x] := Value[x] + AnsiQuotedStr(s, '"');
+    until not result;
+  finally
+    SNMPSend.Free;
+    RowList.Free;
+  end;
+end;
+
+function SNMPGetTableElement(const BaseOID, RowID, ColID, Community, SNMPHost: AnsiString; var Value: AnsiString): Boolean;
+var
+  s: AnsiString;
+begin
+  s := BaseOID + '.' + ColID + '.' + RowID;
+  Result := SnmpGet(s, Community, SNMPHost, Value);
+end;
+
+function SendTrap(const Dest, Source, Enterprise, Community: AnsiString;
+  Generic, Specific, Seconds: Integer; const MIBName, MIBValue: AnsiString;
+  MIBtype: Integer): Integer;
+var
+  SNMPSend: TSNMPSend;
+begin
+  SNMPSend := TSNMPSend.Create;
+  try
+    SNMPSend.TargetHost := Dest;
+    SNMPSend.TargetPort := cSnmpTrapProtocol;
+    SNMPSend.Query.Community := Community;
+    SNMPSend.Query.Version := SNMP_V1;
+    SNMPSend.Query.PDUType := PDUTrap;
+    SNMPSend.Query.OldTrapHost := Source;
+    SNMPSend.Query.OldTrapEnterprise := Enterprise;
+    SNMPSend.Query.OldTrapGen := Generic;
+    SNMPSend.Query.OldTrapSpec := Specific;
+    SNMPSend.Query.OldTrapTimeTicks := Seconds;
+    SNMPSend.Query.MIBAdd(MIBName, MIBValue, MIBType);
+    Result := Ord(SNMPSend.SendTrap);
+  finally
+    SNMPSend.Free;
+  end;
+end;
+
+function RecvTrap(var Dest, Source, Enterprise, Community: AnsiString;
+  var Generic, Specific, Seconds: Integer;
+  const MIBName, MIBValue: TStringList): Integer;
+var
+  SNMPSend: TSNMPSend;
+  i: Integer;
+begin
+  SNMPSend := TSNMPSend.Create;
+  try
+    Result := 0;
+    SNMPSend.TargetPort := cSnmpTrapProtocol;
+    if SNMPSend.RecvTrap then
+    begin
+      Result := 1;
+      Dest := SNMPSend.HostIP;
+      Community := SNMPSend.Reply.Community;
+      Source := SNMPSend.Reply.OldTrapHost;
+      Enterprise := SNMPSend.Reply.OldTrapEnterprise;
+      Generic := SNMPSend.Reply.OldTrapGen;
+      Specific := SNMPSend.Reply.OldTrapSpec;
+      Seconds := SNMPSend.Reply.OldTrapTimeTicks;
+      MIBName.Clear;
+      MIBValue.Clear;
+      for i := 0 to SNMPSend.Reply.SNMPMibList.Count - 1 do
+      begin
+        MIBName.Add(TSNMPMib(SNMPSend.Reply.SNMPMibList[i]).OID);
+        MIBValue.Add(TSNMPMib(SNMPSend.Reply.SNMPMibList[i]).Value);
+      end;
+    end;
+  finally
+    SNMPSend.Free;
+  end;
+end;
+
+
+end.
+
+
diff --git a/Units/Synapse/sntpsend.pas b/Units/Synapse/sntpsend.pas
index 4aa0bbf..908f8e3 100644
--- a/Units/Synapse/sntpsend.pas
+++ b/Units/Synapse/sntpsend.pas
@@ -1,374 +1,374 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 003.000.003 |
-|==============================================================================|
-| Content: SNTP client                                                         |
-|==============================================================================|
-| Copyright (c)1999-2010, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2000-2010.                |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|   Patrick Chevalley                                                          |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{:@abstract( NTP and SNTP client)
-
-Used RFC: RFC-1305, RFC-2030
-}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$Q-}
-{$H+}
-
-unit sntpsend;
-
-interface
-
-uses
-  SysUtils,
-  synsock, blcksock, synautil;
-
-const
-  cNtpProtocol = '123';
-
-type
-
-  {:@abstract(Record containing the NTP packet.)}
-  TNtp = packed record
-    mode: Byte;
-    stratum: Byte;
-    poll: Byte;
-    Precision: Byte;
-    RootDelay: Longint;
-    RootDisperson: Longint;
-    RefID: Longint;
-    Ref1: Longint;
-    Ref2: Longint;
-    Org1: Longint;
-    Org2: Longint;
-    Rcv1: Longint;
-    Rcv2: Longint;
-    Xmit1: Longint;
-    Xmit2: Longint;
-  end;
-
-  {:@abstract(Implementation of NTP and SNTP client protocol),
-   include time synchronisation. It can send NTP or SNTP time queries, or it
-   can receive NTP broadcasts too.
-   
-   Note: Are you missing properties for specify server address and port? Look to
-   parent @link(TSynaClient) too!}
-  TSNTPSend = class(TSynaClient)
-  private
-    FNTPReply: TNtp;
-    FNTPTime: TDateTime;
-    FNTPOffset: double;
-    FNTPDelay: double;
-    FMaxSyncDiff: double;
-    FSyncTime: Boolean;
-    FSock: TUDPBlockSocket;
-    FBuffer: AnsiString;
-    FLi, FVn, Fmode : byte;
-    function StrToNTP(const Value: AnsiString): TNtp;
-    function NTPtoStr(const Value: Tntp): AnsiString;
-    procedure ClearNTP(var Value: Tntp);
-  public
-    constructor Create;
-    destructor Destroy; override;
-
-    {:Decode 128 bit timestamp used in NTP packet to TDateTime type.}
-    function DecodeTs(Nsec, Nfrac: Longint): TDateTime;
-
-    {:Decode TDateTime type to 128 bit timestamp used in NTP packet.}
-    procedure EncodeTs(dt: TDateTime; var Nsec, Nfrac: Longint);
-
-    {:Send request to @link(TSynaClient.TargetHost) and wait for reply. If all
-     is OK, then result is @true and @link(NTPReply) and @link(NTPTime) are
-     valid.}
-    function GetSNTP: Boolean;
-
-    {:Send request to @link(TSynaClient.TargetHost) and wait for reply. If all
-     is OK, then result is @true and @link(NTPReply) and @link(NTPTime) are
-     valid. Result time is after all needed corrections.}
-    function GetNTP: Boolean;
-
-    {:Wait for broadcast NTP packet. If all OK, result is @true and
-     @link(NTPReply) and @link(NTPTime) are valid.}
-    function GetBroadcastNTP: Boolean;
-
-    {:Holds last received NTP packet.}
-    property NTPReply: TNtp read FNTPReply;
-  published
-    {:Date and time of remote NTP or SNTP server. (UTC time!!!)}
-    property NTPTime: TDateTime read FNTPTime;
-
-    {:Offset between your computer and remote NTP or SNTP server.}
-    property NTPOffset: Double read FNTPOffset;
-
-    {:Delay between your computer and remote NTP or SNTP server.}
-    property NTPDelay: Double read FNTPDelay;
-
-    {:Define allowed maximum difference between your time and remote time for
-     synchronising time. If difference is bigger, your system time is not
-     changed!}
-    property MaxSyncDiff: double read FMaxSyncDiff write FMaxSyncDiff;
-
-    {:If @true, after successfull getting time is local computer clock
-     synchronised to given time.
-     For synchronising time you must have proper rights! (Usually Administrator)}
-    property SyncTime: Boolean read FSyncTime write FSyncTime;
-
-    {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
-    property Sock: TUDPBlockSocket read FSock;
-  end;
-
-implementation
-
-constructor TSNTPSend.Create;
-begin
-  inherited Create;
-  FSock := TUDPBlockSocket.Create;
-  FSock.Owner := self;
-  FTimeout := 5000;
-  FTargetPort := cNtpProtocol;
-  FMaxSyncDiff := 3600;
-  FSyncTime := False;
-end;
-
-destructor TSNTPSend.Destroy;
-begin
-  FSock.Free;
-  inherited Destroy;
-end;
-
-function TSNTPSend.StrToNTP(const Value: AnsiString): TNtp;
-begin
-  if length(FBuffer) >= SizeOf(Result) then
-  begin
-    Result.mode := ord(Value[1]);
-    Result.stratum := ord(Value[2]);
-    Result.poll := ord(Value[3]);
-    Result.Precision := ord(Value[4]);
-    Result.RootDelay := DecodeLongInt(value, 5);
-    Result.RootDisperson := DecodeLongInt(value, 9);
-    Result.RefID := DecodeLongInt(value, 13);
-    Result.Ref1 := DecodeLongInt(value, 17);
-    Result.Ref2 := DecodeLongInt(value, 21);
-    Result.Org1 := DecodeLongInt(value, 25);
-    Result.Org2 := DecodeLongInt(value, 29);
-    Result.Rcv1 := DecodeLongInt(value, 33);
-    Result.Rcv2 := DecodeLongInt(value, 37);
-    Result.Xmit1 := DecodeLongInt(value, 41);
-    Result.Xmit2 := DecodeLongInt(value, 45);
-  end;
-
-end;
-
-function TSNTPSend.NTPtoStr(const Value: Tntp): AnsiString;
-begin
-  SetLength(Result, 4);
-  Result[1] := AnsiChar(Value.mode);
-  Result[2] := AnsiChar(Value.stratum);
-  Result[3] := AnsiChar(Value.poll);
-  Result[4] := AnsiChar(Value.precision);
-  Result := Result + CodeLongInt(Value.RootDelay);
-  Result := Result + CodeLongInt(Value.RootDisperson);
-  Result := Result + CodeLongInt(Value.RefID);
-  Result := Result + CodeLongInt(Value.Ref1);
-  Result := Result + CodeLongInt(Value.Ref2);
-  Result := Result + CodeLongInt(Value.Org1);
-  Result := Result + CodeLongInt(Value.Org2);
-  Result := Result + CodeLongInt(Value.Rcv1);
-  Result := Result + CodeLongInt(Value.Rcv2);
-  Result := Result + CodeLongInt(Value.Xmit1);
-  Result := Result + CodeLongInt(Value.Xmit2);
-end;
-
-procedure TSNTPSend.ClearNTP(var Value: Tntp);
-begin
-  Value.mode := 0;
-  Value.stratum := 0;
-  Value.poll := 0;
-  Value.Precision := 0;
-  Value.RootDelay := 0;
-  Value.RootDisperson := 0;
-  Value.RefID := 0;
-  Value.Ref1 := 0;
-  Value.Ref2 := 0;
-  Value.Org1 := 0;
-  Value.Org2 := 0;
-  Value.Rcv1 := 0;
-  Value.Rcv2 := 0;
-  Value.Xmit1 := 0;
-  Value.Xmit2 := 0;
-end;
-
-function TSNTPSend.DecodeTs(Nsec, Nfrac: Longint): TDateTime;
-const
-  maxi = 4294967295.0;
-var
-  d, d1: Double;
-begin
-  d := Nsec;
-  if d < 0 then
-    d := maxi + d + 1;
-  d1 := Nfrac;
-  if d1 < 0 then
-    d1 := maxi + d1 + 1;
-  d1 := d1 / maxi;
-  d1 := Trunc(d1 * 10000) / 10000;
-  Result := (d + d1) / 86400;
-  Result := Result + 2;
-end;
-
-procedure TSNTPSend.EncodeTs(dt: TDateTime; var Nsec, Nfrac: Longint);
-const
-  maxi = 4294967295.0;
-  maxilongint = 2147483647;
-var
-  d, d1: Double;
-begin
-  d  := (dt - 2) * 86400;
-  d1 := frac(d);
-  if d > maxilongint then
-     d := d - maxi - 1;
-  d  := trunc(d);
-  d1 := Trunc(d1 * 10000) / 10000;
-  d1 := d1 * maxi;
-  if d1 > maxilongint then
-     d1 := d1 - maxi - 1;
-  Nsec:=trunc(d);
-  Nfrac:=trunc(d1);
-end;
-
-function TSNTPSend.GetBroadcastNTP: Boolean;
-var
-  x: Integer;
-begin
-  Result := False;
-  FSock.Bind(FIPInterface, FTargetPort);
-  FBuffer := FSock.RecvPacket(FTimeout);
-  if FSock.LastError = 0 then
-  begin
-    x := Length(FBuffer);
-    if (FTargetHost = '0.0.0.0') or (FSock.GetRemoteSinIP = FSock.ResolveName(FTargetHost)) then
-      if x >= SizeOf(NTPReply) then
-      begin
-        FNTPReply := StrToNTP(FBuffer);
-        FNTPTime := DecodeTs(NTPReply.Xmit1, NTPReply.Xmit2);
-        if FSyncTime and ((abs(FNTPTime - GetUTTime) * 86400) <= FMaxSyncDiff) then
-          SetUTTime(FNTPTime);
-        Result := True;
-      end;
-  end;
-end;
-
-function TSNTPSend.GetSNTP: Boolean;
-var
-  q: TNtp;
-  x: Integer;
-begin
-  Result := False;
-  FSock.CloseSocket;
-  FSock.Bind(FIPInterface, cAnyPort);
-  FSock.Connect(FTargetHost, FTargetPort);
-  ClearNtp(q);
-  q.mode := $1B;
-  FBuffer := NTPtoStr(q);
-  FSock.SendString(FBuffer);
-  FBuffer := FSock.RecvPacket(FTimeout);
-  if FSock.LastError = 0 then
-  begin
-    x := Length(FBuffer);
-    if x >= SizeOf(NTPReply) then
-    begin
-      FNTPReply := StrToNTP(FBuffer);
-      FNTPTime := DecodeTs(NTPReply.Xmit1, NTPReply.Xmit2);
-      if FSyncTime and ((abs(FNTPTime - GetUTTime) * 86400) <= FMaxSyncDiff) then
-        SetUTTime(FNTPTime);
-      Result := True;
-    end;
-  end;
-end;
-
-function TSNTPSend.GetNTP: Boolean;
-var
-  q: TNtp;
-  x: Integer;
-  t1, t2, t3, t4 : TDateTime;
-begin
-  Result := False;
-  FSock.CloseSocket;
-  FSock.Bind(FIPInterface, cAnyPort);
-  FSock.Connect(FTargetHost, FTargetPort);
-  ClearNtp(q);
-  q.mode := $1B;
-  t1 := GetUTTime;
-  EncodeTs(t1, q.org1, q.org2);
-  FBuffer := NTPtoStr(q);
-  FSock.SendString(FBuffer);
-  FBuffer := FSock.RecvPacket(FTimeout);
-  if FSock.LastError = 0 then
-  begin
-    x := Length(FBuffer);
-    t4 := GetUTTime;
-    if x >= SizeOf(NTPReply) then
-    begin
-      FNTPReply := StrToNTP(FBuffer);
-      FLi := (NTPReply.mode and $C0) shr 6;
-      FVn := (NTPReply.mode and $38) shr 3;
-      Fmode := NTPReply.mode and $07;
-      if (Fli < 3) and (Fmode = 4) and
-         (NTPReply.stratum >= 1) and (NTPReply.stratum <= 15) and
-         (NTPReply.Rcv1 <> 0) and (NTPReply.Xmit1 <> 0)
-         then begin
-           t2 := DecodeTs(NTPReply.Rcv1, NTPReply.Rcv2);
-           t3 := DecodeTs(NTPReply.Xmit1, NTPReply.Xmit2);
-           FNTPDelay := (T4 - T1) - (T2 - T3);
-           FNTPTime := t3 + FNTPDelay / 2;
-           FNTPOffset := (((T2 - T1) + (T3 - T4)) / 2) * 86400;
-           FNTPDelay := FNTPDelay * 86400;
-           if FSyncTime and ((abs(FNTPTime - t1) * 86400) <= FMaxSyncDiff) then
-             SetUTTime(FNTPTime);
-           Result := True;
-           end
-         else result:=false;
-    end;
-  end;
-end;
-
-end.
+{==============================================================================|
+| Project : Ararat Synapse                                       | 003.000.003 |
+|==============================================================================|
+| Content: SNTP client                                                         |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2000-2010.                |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|   Patrick Chevalley                                                          |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@abstract( NTP and SNTP client)
+
+Used RFC: RFC-1305, RFC-2030
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$Q-}
+{$H+}
+
+unit sntpsend;
+
+interface
+
+uses
+  SysUtils,
+  synsock, blcksock, synautil;
+
+const
+  cNtpProtocol = '123';
+
+type
+
+  {:@abstract(Record containing the NTP packet.)}
+  TNtp = packed record
+    mode: Byte;
+    stratum: Byte;
+    poll: Byte;
+    Precision: Byte;
+    RootDelay: Longint;
+    RootDisperson: Longint;
+    RefID: Longint;
+    Ref1: Longint;
+    Ref2: Longint;
+    Org1: Longint;
+    Org2: Longint;
+    Rcv1: Longint;
+    Rcv2: Longint;
+    Xmit1: Longint;
+    Xmit2: Longint;
+  end;
+
+  {:@abstract(Implementation of NTP and SNTP client protocol),
+   include time synchronisation. It can send NTP or SNTP time queries, or it
+   can receive NTP broadcasts too.
+   
+   Note: Are you missing properties for specify server address and port? Look to
+   parent @link(TSynaClient) too!}
+  TSNTPSend = class(TSynaClient)
+  private
+    FNTPReply: TNtp;
+    FNTPTime: TDateTime;
+    FNTPOffset: double;
+    FNTPDelay: double;
+    FMaxSyncDiff: double;
+    FSyncTime: Boolean;
+    FSock: TUDPBlockSocket;
+    FBuffer: AnsiString;
+    FLi, FVn, Fmode : byte;
+    function StrToNTP(const Value: AnsiString): TNtp;
+    function NTPtoStr(const Value: Tntp): AnsiString;
+    procedure ClearNTP(var Value: Tntp);
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    {:Decode 128 bit timestamp used in NTP packet to TDateTime type.}
+    function DecodeTs(Nsec, Nfrac: Longint): TDateTime;
+
+    {:Decode TDateTime type to 128 bit timestamp used in NTP packet.}
+    procedure EncodeTs(dt: TDateTime; var Nsec, Nfrac: Longint);
+
+    {:Send request to @link(TSynaClient.TargetHost) and wait for reply. If all
+     is OK, then result is @true and @link(NTPReply) and @link(NTPTime) are
+     valid.}
+    function GetSNTP: Boolean;
+
+    {:Send request to @link(TSynaClient.TargetHost) and wait for reply. If all
+     is OK, then result is @true and @link(NTPReply) and @link(NTPTime) are
+     valid. Result time is after all needed corrections.}
+    function GetNTP: Boolean;
+
+    {:Wait for broadcast NTP packet. If all OK, result is @true and
+     @link(NTPReply) and @link(NTPTime) are valid.}
+    function GetBroadcastNTP: Boolean;
+
+    {:Holds last received NTP packet.}
+    property NTPReply: TNtp read FNTPReply;
+  published
+    {:Date and time of remote NTP or SNTP server. (UTC time!!!)}
+    property NTPTime: TDateTime read FNTPTime;
+
+    {:Offset between your computer and remote NTP or SNTP server.}
+    property NTPOffset: Double read FNTPOffset;
+
+    {:Delay between your computer and remote NTP or SNTP server.}
+    property NTPDelay: Double read FNTPDelay;
+
+    {:Define allowed maximum difference between your time and remote time for
+     synchronising time. If difference is bigger, your system time is not
+     changed!}
+    property MaxSyncDiff: double read FMaxSyncDiff write FMaxSyncDiff;
+
+    {:If @true, after successfull getting time is local computer clock
+     synchronised to given time.
+     For synchronising time you must have proper rights! (Usually Administrator)}
+    property SyncTime: Boolean read FSyncTime write FSyncTime;
+
+    {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
+    property Sock: TUDPBlockSocket read FSock;
+  end;
+
+implementation
+
+constructor TSNTPSend.Create;
+begin
+  inherited Create;
+  FSock := TUDPBlockSocket.Create;
+  FSock.Owner := self;
+  FTimeout := 5000;
+  FTargetPort := cNtpProtocol;
+  FMaxSyncDiff := 3600;
+  FSyncTime := False;
+end;
+
+destructor TSNTPSend.Destroy;
+begin
+  FSock.Free;
+  inherited Destroy;
+end;
+
+function TSNTPSend.StrToNTP(const Value: AnsiString): TNtp;
+begin
+  if length(FBuffer) >= SizeOf(Result) then
+  begin
+    Result.mode := ord(Value[1]);
+    Result.stratum := ord(Value[2]);
+    Result.poll := ord(Value[3]);
+    Result.Precision := ord(Value[4]);
+    Result.RootDelay := DecodeLongInt(value, 5);
+    Result.RootDisperson := DecodeLongInt(value, 9);
+    Result.RefID := DecodeLongInt(value, 13);
+    Result.Ref1 := DecodeLongInt(value, 17);
+    Result.Ref2 := DecodeLongInt(value, 21);
+    Result.Org1 := DecodeLongInt(value, 25);
+    Result.Org2 := DecodeLongInt(value, 29);
+    Result.Rcv1 := DecodeLongInt(value, 33);
+    Result.Rcv2 := DecodeLongInt(value, 37);
+    Result.Xmit1 := DecodeLongInt(value, 41);
+    Result.Xmit2 := DecodeLongInt(value, 45);
+  end;
+
+end;
+
+function TSNTPSend.NTPtoStr(const Value: Tntp): AnsiString;
+begin
+  SetLength(Result, 4);
+  Result[1] := AnsiChar(Value.mode);
+  Result[2] := AnsiChar(Value.stratum);
+  Result[3] := AnsiChar(Value.poll);
+  Result[4] := AnsiChar(Value.precision);
+  Result := Result + CodeLongInt(Value.RootDelay);
+  Result := Result + CodeLongInt(Value.RootDisperson);
+  Result := Result + CodeLongInt(Value.RefID);
+  Result := Result + CodeLongInt(Value.Ref1);
+  Result := Result + CodeLongInt(Value.Ref2);
+  Result := Result + CodeLongInt(Value.Org1);
+  Result := Result + CodeLongInt(Value.Org2);
+  Result := Result + CodeLongInt(Value.Rcv1);
+  Result := Result + CodeLongInt(Value.Rcv2);
+  Result := Result + CodeLongInt(Value.Xmit1);
+  Result := Result + CodeLongInt(Value.Xmit2);
+end;
+
+procedure TSNTPSend.ClearNTP(var Value: Tntp);
+begin
+  Value.mode := 0;
+  Value.stratum := 0;
+  Value.poll := 0;
+  Value.Precision := 0;
+  Value.RootDelay := 0;
+  Value.RootDisperson := 0;
+  Value.RefID := 0;
+  Value.Ref1 := 0;
+  Value.Ref2 := 0;
+  Value.Org1 := 0;
+  Value.Org2 := 0;
+  Value.Rcv1 := 0;
+  Value.Rcv2 := 0;
+  Value.Xmit1 := 0;
+  Value.Xmit2 := 0;
+end;
+
+function TSNTPSend.DecodeTs(Nsec, Nfrac: Longint): TDateTime;
+const
+  maxi = 4294967295.0;
+var
+  d, d1: Double;
+begin
+  d := Nsec;
+  if d < 0 then
+    d := maxi + d + 1;
+  d1 := Nfrac;
+  if d1 < 0 then
+    d1 := maxi + d1 + 1;
+  d1 := d1 / maxi;
+  d1 := Trunc(d1 * 10000) / 10000;
+  Result := (d + d1) / 86400;
+  Result := Result + 2;
+end;
+
+procedure TSNTPSend.EncodeTs(dt: TDateTime; var Nsec, Nfrac: Longint);
+const
+  maxi = 4294967295.0;
+  maxilongint = 2147483647;
+var
+  d, d1: Double;
+begin
+  d  := (dt - 2) * 86400;
+  d1 := frac(d);
+  if d > maxilongint then
+     d := d - maxi - 1;
+  d  := trunc(d);
+  d1 := Trunc(d1 * 10000) / 10000;
+  d1 := d1 * maxi;
+  if d1 > maxilongint then
+     d1 := d1 - maxi - 1;
+  Nsec:=trunc(d);
+  Nfrac:=trunc(d1);
+end;
+
+function TSNTPSend.GetBroadcastNTP: Boolean;
+var
+  x: Integer;
+begin
+  Result := False;
+  FSock.Bind(FIPInterface, FTargetPort);
+  FBuffer := FSock.RecvPacket(FTimeout);
+  if FSock.LastError = 0 then
+  begin
+    x := Length(FBuffer);
+    if (FTargetHost = '0.0.0.0') or (FSock.GetRemoteSinIP = FSock.ResolveName(FTargetHost)) then
+      if x >= SizeOf(NTPReply) then
+      begin
+        FNTPReply := StrToNTP(FBuffer);
+        FNTPTime := DecodeTs(NTPReply.Xmit1, NTPReply.Xmit2);
+        if FSyncTime and ((abs(FNTPTime - GetUTTime) * 86400) <= FMaxSyncDiff) then
+          SetUTTime(FNTPTime);
+        Result := True;
+      end;
+  end;
+end;
+
+function TSNTPSend.GetSNTP: Boolean;
+var
+  q: TNtp;
+  x: Integer;
+begin
+  Result := False;
+  FSock.CloseSocket;
+  FSock.Bind(FIPInterface, cAnyPort);
+  FSock.Connect(FTargetHost, FTargetPort);
+  ClearNtp(q);
+  q.mode := $1B;
+  FBuffer := NTPtoStr(q);
+  FSock.SendString(FBuffer);
+  FBuffer := FSock.RecvPacket(FTimeout);
+  if FSock.LastError = 0 then
+  begin
+    x := Length(FBuffer);
+    if x >= SizeOf(NTPReply) then
+    begin
+      FNTPReply := StrToNTP(FBuffer);
+      FNTPTime := DecodeTs(NTPReply.Xmit1, NTPReply.Xmit2);
+      if FSyncTime and ((abs(FNTPTime - GetUTTime) * 86400) <= FMaxSyncDiff) then
+        SetUTTime(FNTPTime);
+      Result := True;
+    end;
+  end;
+end;
+
+function TSNTPSend.GetNTP: Boolean;
+var
+  q: TNtp;
+  x: Integer;
+  t1, t2, t3, t4 : TDateTime;
+begin
+  Result := False;
+  FSock.CloseSocket;
+  FSock.Bind(FIPInterface, cAnyPort);
+  FSock.Connect(FTargetHost, FTargetPort);
+  ClearNtp(q);
+  q.mode := $1B;
+  t1 := GetUTTime;
+  EncodeTs(t1, q.org1, q.org2);
+  FBuffer := NTPtoStr(q);
+  FSock.SendString(FBuffer);
+  FBuffer := FSock.RecvPacket(FTimeout);
+  if FSock.LastError = 0 then
+  begin
+    x := Length(FBuffer);
+    t4 := GetUTTime;
+    if x >= SizeOf(NTPReply) then
+    begin
+      FNTPReply := StrToNTP(FBuffer);
+      FLi := (NTPReply.mode and $C0) shr 6;
+      FVn := (NTPReply.mode and $38) shr 3;
+      Fmode := NTPReply.mode and $07;
+      if (Fli < 3) and (Fmode = 4) and
+         (NTPReply.stratum >= 1) and (NTPReply.stratum <= 15) and
+         (NTPReply.Rcv1 <> 0) and (NTPReply.Xmit1 <> 0)
+         then begin
+           t2 := DecodeTs(NTPReply.Rcv1, NTPReply.Rcv2);
+           t3 := DecodeTs(NTPReply.Xmit1, NTPReply.Xmit2);
+           FNTPDelay := (T4 - T1) - (T2 - T3);
+           FNTPTime := t3 + FNTPDelay / 2;
+           FNTPOffset := (((T2 - T1) + (T3 - T4)) / 2) * 86400;
+           FNTPDelay := FNTPDelay * 86400;
+           if FSyncTime and ((abs(FNTPTime - t1) * 86400) <= FMaxSyncDiff) then
+             SetUTTime(FNTPTime);
+           Result := True;
+           end
+         else result:=false;
+    end;
+  end;
+end;
+
+end.
diff --git a/Units/Synapse/ssdotnet.pas b/Units/Synapse/ssdotnet.pas
index 8a54cd8..1537491 100644
--- a/Units/Synapse/ssdotnet.pas
+++ b/Units/Synapse/ssdotnet.pas
@@ -1,1099 +1,1099 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 001.000.002 |
-|==============================================================================|
-| Content: Socket Independent Platform Layer - .NET definition include         |
-|==============================================================================|
-| Copyright (c)2004, Lukas Gebauer                                             |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2004.                     |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{:@exclude}
-
-{$IFDEF CIL}
-
-interface
-
-uses
-  SyncObjs, SysUtils, Classes,
-  System.Net,
-  System.Net.Sockets;
-
-const
-  DLLStackName = '';
-  WinsockLevel = $0202;
-
-function InitSocketInterface(stack: string): Boolean;
-function DestroySocketInterface: Boolean;
-
-type
-  u_char = Char;
-  u_short = Word;
-  u_int = Integer;
-  u_long = Longint;
-  pu_long = ^u_long;
-  pu_short = ^u_short;
-  PSockAddr = IPEndPoint;
-  DWORD = integer;
-  ULong = cardinal;
-  TMemory = Array of byte;
-  TLinger = LingerOption;
-  TSocket = socket;
-  TAddrFamily = AddressFamily;
-
-const
-  WSADESCRIPTION_LEN     =   256;
-  WSASYS_STATUS_LEN      =   128;
-type
-  PWSAData = ^TWSAData;
-  TWSAData = packed record
-    wVersion: Word;
-    wHighVersion: Word;
-    szDescription: array[0..WSADESCRIPTION_LEN] of Char;
-    szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char;
-    iMaxSockets: Word;
-    iMaxUdpDg: Word;
-//    lpVendorInfo: PChar;
-  end;
-
-const
-  MSG_NOSIGNAL = 0;
-  INVALID_SOCKET = nil;
-  AF_UNSPEC = AddressFamily.Unspecified;
-  AF_INET = AddressFamily.InterNetwork;
-  AF_INET6 = AddressFamily.InterNetworkV6;
-  SOCKET_ERROR = integer(-1);
-
-  FIONREAD     = integer($4004667f);
-  FIONBIO      = integer($8004667e);
-  FIOASYNC     = integer($8004667d);
-
-  SOMAXCONN       = integer($7fffffff);
-
-  IPPROTO_IP = ProtocolType.IP;
-  IPPROTO_ICMP = ProtocolType.Icmp;
-  IPPROTO_IGMP = ProtocolType.Igmp;
-  IPPROTO_TCP = ProtocolType.Tcp;
-  IPPROTO_UDP = ProtocolType.Udp;
-  IPPROTO_RAW = ProtocolType.Raw;
-  IPPROTO_IPV6 = ProtocolType.IPV6;
-//
-  IPPROTO_ICMPV6 = ProtocolType.Icmp; //??
-
-  SOCK_STREAM     = SocketType.Stream;
-  SOCK_DGRAM      = SocketType.Dgram;
-  SOCK_RAW        = SocketType.Raw;
-  SOCK_RDM        = SocketType.Rdm;
-  SOCK_SEQPACKET  = SocketType.Seqpacket;
-
-  SOL_SOCKET = SocketOptionLevel.Socket;
-  SOL_IP = SocketOptionLevel.Ip;
-
-
-  IP_OPTIONS          = SocketOptionName.IPOptions;
-  IP_HDRINCL          = SocketOptionName.HeaderIncluded;
-  IP_TOS              = SocketOptionName.TypeOfService;           { set/get IP Type Of Service       }
-  IP_TTL              = SocketOptionName.IpTimeToLive;           { set/get IP Time To Live          }
-  IP_MULTICAST_IF     = SocketOptionName.MulticastInterface;           { set/get IP multicast interface   }
-  IP_MULTICAST_TTL    = SocketOptionName.MulticastTimeToLive;           { set/get IP multicast timetolive  }
-  IP_MULTICAST_LOOP   = SocketOptionName.MulticastLoopback;           { set/get IP multicast loopback    }
-  IP_ADD_MEMBERSHIP   = SocketOptionName.AddMembership;           { add  an IP group membership      }
-  IP_DROP_MEMBERSHIP  = SocketOptionName.DropMembership;           { drop an IP group membership      }
-  IP_DONTFRAGMENT     = SocketOptionName.DontFragment;           { set/get IP Don't Fragment flag   }
-
-  IPV6_UNICAST_HOPS      = 8;  // TTL
-  IPV6_MULTICAST_IF      = 9;  // set/get IP multicast i/f
-  IPV6_MULTICAST_HOPS    = 10; // set/get IP multicast ttl
-  IPV6_MULTICAST_LOOP    = 11; // set/get IP multicast loopback
-  IPV6_JOIN_GROUP        = 12; // add an IP group membership
-  IPV6_LEAVE_GROUP       = 13; // drop an IP group membership
-
-  SO_DEBUG        = SocketOptionName.Debug;          { turn on debugging info recording }
-  SO_ACCEPTCONN   = SocketOptionName.AcceptConnection;          { socket has had listen() }
-  SO_REUSEADDR    = SocketOptionName.ReuseAddress;          { allow local address reuse }
-  SO_KEEPALIVE    = SocketOptionName.KeepAlive;          { keep connections alive }
-  SO_DONTROUTE    = SocketOptionName.DontRoute;          { just use interface addresses }
-  SO_BROADCAST    = SocketOptionName.Broadcast;          { permit sending of broadcast msgs }
-  SO_USELOOPBACK  = SocketOptionName.UseLoopback;          { bypass hardware when possible }
-  SO_LINGER       = SocketOptionName.Linger;          { linger on close if data present }
-  SO_OOBINLINE    = SocketOptionName.OutOfBandInline;          { leave received OOB data in line }
-  SO_DONTLINGER   = SocketOptionName.DontLinger;
-{ Additional options. }
-  SO_SNDBUF       = SocketOptionName.SendBuffer;          { send buffer size }
-  SO_RCVBUF       = SocketOptionName.ReceiveBuffer;          { receive buffer size }
-  SO_SNDLOWAT     = SocketOptionName.SendLowWater;          { send low-water mark }
-  SO_RCVLOWAT     = SocketOptionName.ReceiveLowWater;          { receive low-water mark }
-  SO_SNDTIMEO     = SocketOptionName.SendTimeout;          { send timeout }
-  SO_RCVTIMEO     = SocketOptionName.ReceiveTimeout;          { receive timeout }
-  SO_ERROR        = SocketOptionName.Error;          { get error status and clear }
-  SO_TYPE         = SocketOptionName.Type;          { get socket type }
-
-{ WinSock 2 extension -- new options }
-//  SO_GROUP_ID       = $2001; { ID of a socket group}
-//  SO_GROUP_PRIORITY = $2002; { the relative priority within a group}
-//  SO_MAX_MSG_SIZE   = $2003; { maximum message size }
-//  SO_PROTOCOL_INFOA = $2004; { WSAPROTOCOL_INFOA structure }
-//  SO_PROTOCOL_INFOW = $2005; { WSAPROTOCOL_INFOW structure }
-//  SO_PROTOCOL_INFO  = SO_PROTOCOL_INFOA;
-//  PVD_CONFIG        = $3001; {configuration info for service provider }
-{ Option for opening sockets for synchronous access. }
-//  SO_OPENTYPE     = $7008;
-//  SO_SYNCHRONOUS_ALERT    = $10;
-//  SO_SYNCHRONOUS_NONALERT = $20;
-{ Other NT-specific options. }
-//  SO_MAXDG        = $7009;
-//  SO_MAXPATHDG    = $700A;
-//  SO_UPDATE_ACCEPT_CONTEXT     = $700B;
-//  SO_CONNECT_TIME = $700C;
-
-
-  { All Windows Sockets error constants are biased by WSABASEERR from the "normal" }
-  WSABASEERR              = 10000;
-
-{ Windows Sockets definitions of regular Microsoft C error constants }
-
-  WSAEINTR                = (WSABASEERR+4);
-  WSAEBADF                = (WSABASEERR+9);
-  WSAEACCES               = (WSABASEERR+13);
-  WSAEFAULT               = (WSABASEERR+14);
-  WSAEINVAL               = (WSABASEERR+22);
-  WSAEMFILE               = (WSABASEERR+24);
-
-{ Windows Sockets definitions of regular Berkeley error constants }
-
-  WSAEWOULDBLOCK          = (WSABASEERR+35);
-  WSAEINPROGRESS          = (WSABASEERR+36);
-  WSAEALREADY             = (WSABASEERR+37);
-  WSAENOTSOCK             = (WSABASEERR+38);
-  WSAEDESTADDRREQ         = (WSABASEERR+39);
-  WSAEMSGSIZE             = (WSABASEERR+40);
-  WSAEPROTOTYPE           = (WSABASEERR+41);
-  WSAENOPROTOOPT          = (WSABASEERR+42);
-  WSAEPROTONOSUPPORT      = (WSABASEERR+43);
-  WSAESOCKTNOSUPPORT      = (WSABASEERR+44);
-  WSAEOPNOTSUPP           = (WSABASEERR+45);
-  WSAEPFNOSUPPORT         = (WSABASEERR+46);
-  WSAEAFNOSUPPORT         = (WSABASEERR+47);
-  WSAEADDRINUSE           = (WSABASEERR+48);
-  WSAEADDRNOTAVAIL        = (WSABASEERR+49);
-  WSAENETDOWN             = (WSABASEERR+50);
-  WSAENETUNREACH          = (WSABASEERR+51);
-  WSAENETRESET            = (WSABASEERR+52);
-  WSAECONNABORTED         = (WSABASEERR+53);
-  WSAECONNRESET           = (WSABASEERR+54);
-  WSAENOBUFS              = (WSABASEERR+55);
-  WSAEISCONN              = (WSABASEERR+56);
-  WSAENOTCONN             = (WSABASEERR+57);
-  WSAESHUTDOWN            = (WSABASEERR+58);
-  WSAETOOMANYREFS         = (WSABASEERR+59);
-  WSAETIMEDOUT            = (WSABASEERR+60);
-  WSAECONNREFUSED         = (WSABASEERR+61);
-  WSAELOOP                = (WSABASEERR+62);
-  WSAENAMETOOLONG         = (WSABASEERR+63);
-  WSAEHOSTDOWN            = (WSABASEERR+64);
-  WSAEHOSTUNREACH         = (WSABASEERR+65);
-  WSAENOTEMPTY            = (WSABASEERR+66);
-  WSAEPROCLIM             = (WSABASEERR+67);
-  WSAEUSERS               = (WSABASEERR+68);
-  WSAEDQUOT               = (WSABASEERR+69);
-  WSAESTALE               = (WSABASEERR+70);
-  WSAEREMOTE              = (WSABASEERR+71);
-
-{ Extended Windows Sockets error constant definitions }
-
-  WSASYSNOTREADY          = (WSABASEERR+91);
-  WSAVERNOTSUPPORTED      = (WSABASEERR+92);
-  WSANOTINITIALISED       = (WSABASEERR+93);
-  WSAEDISCON              = (WSABASEERR+101);
-  WSAENOMORE              = (WSABASEERR+102);
-  WSAECANCELLED           = (WSABASEERR+103);
-  WSAEEINVALIDPROCTABLE   = (WSABASEERR+104);
-  WSAEINVALIDPROVIDER     = (WSABASEERR+105);
-  WSAEPROVIDERFAILEDINIT  = (WSABASEERR+106);
-  WSASYSCALLFAILURE       = (WSABASEERR+107);
-  WSASERVICE_NOT_FOUND    = (WSABASEERR+108);
-  WSATYPE_NOT_FOUND       = (WSABASEERR+109);
-  WSA_E_NO_MORE           = (WSABASEERR+110);
-  WSA_E_CANCELLED         = (WSABASEERR+111);
-  WSAEREFUSED             = (WSABASEERR+112);
-
-{ Error return codes from gethostbyname() and gethostbyaddr()
-  (when using the resolver). Note that these errors are
-  retrieved via WSAGetLastError() and must therefore follow
-  the rules for avoiding clashes with error numbers from
-  specific implementations or language run-time systems.
-  For this reason the codes are based at WSABASEERR+1001.
-  Note also that [WSA]NO_ADDRESS is defined only for
-  compatibility purposes. }
-
-{ Authoritative Answer: Host not found }
-  WSAHOST_NOT_FOUND       = (WSABASEERR+1001);
-  HOST_NOT_FOUND          = WSAHOST_NOT_FOUND;
-{ Non-Authoritative: Host not found, or SERVERFAIL }
-  WSATRY_AGAIN            = (WSABASEERR+1002);
-  TRY_AGAIN               = WSATRY_AGAIN;
-{ Non recoverable errors, FORMERR, REFUSED, NOTIMP }
-  WSANO_RECOVERY          = (WSABASEERR+1003);
-  NO_RECOVERY             = WSANO_RECOVERY;
-{ Valid name, no data record of requested type }
-  WSANO_DATA              = (WSABASEERR+1004);
-  NO_DATA                 = WSANO_DATA;
-{ no address, look for MX record }
-  WSANO_ADDRESS           = WSANO_DATA;
-  NO_ADDRESS              = WSANO_ADDRESS;
-
-  EWOULDBLOCK        =  WSAEWOULDBLOCK;
-  EINPROGRESS        =  WSAEINPROGRESS;
-  EALREADY           =  WSAEALREADY;
-  ENOTSOCK           =  WSAENOTSOCK;
-  EDESTADDRREQ       =  WSAEDESTADDRREQ;
-  EMSGSIZE           =  WSAEMSGSIZE;
-  EPROTOTYPE         =  WSAEPROTOTYPE;
-  ENOPROTOOPT        =  WSAENOPROTOOPT;
-  EPROTONOSUPPORT    =  WSAEPROTONOSUPPORT;
-  ESOCKTNOSUPPORT    =  WSAESOCKTNOSUPPORT;
-  EOPNOTSUPP         =  WSAEOPNOTSUPP;
-  EPFNOSUPPORT       =  WSAEPFNOSUPPORT;
-  EAFNOSUPPORT       =  WSAEAFNOSUPPORT;
-  EADDRINUSE         =  WSAEADDRINUSE;
-  EADDRNOTAVAIL      =  WSAEADDRNOTAVAIL;
-  ENETDOWN           =  WSAENETDOWN;
-  ENETUNREACH        =  WSAENETUNREACH;
-  ENETRESET          =  WSAENETRESET;
-  ECONNABORTED       =  WSAECONNABORTED;
-  ECONNRESET         =  WSAECONNRESET;
-  ENOBUFS            =  WSAENOBUFS;
-  EISCONN            =  WSAEISCONN;
-  ENOTCONN           =  WSAENOTCONN;
-  ESHUTDOWN          =  WSAESHUTDOWN;
-  ETOOMANYREFS       =  WSAETOOMANYREFS;
-  ETIMEDOUT          =  WSAETIMEDOUT;
-  ECONNREFUSED       =  WSAECONNREFUSED;
-  ELOOP              =  WSAELOOP;
-  ENAMETOOLONG       =  WSAENAMETOOLONG;
-  EHOSTDOWN          =  WSAEHOSTDOWN;
-  EHOSTUNREACH       =  WSAEHOSTUNREACH;
-  ENOTEMPTY          =  WSAENOTEMPTY;
-  EPROCLIM           =  WSAEPROCLIM;
-  EUSERS             =  WSAEUSERS;
-  EDQUOT             =  WSAEDQUOT;
-  ESTALE             =  WSAESTALE;
-  EREMOTE            =  WSAEREMOTE;
-
-
-type
-  TVarSin = IPEndpoint;
-
-{  function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
-  function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
-  function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
-  function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
-  function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
-  function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6):boolean;
-  procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
-  procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
-var
-  in6addr_any, in6addr_loopback : TInAddr6;
-}
-
-{procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet);
-function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean;
-procedure FD_SET(Socket: TSocket; var FDSet: TFDSet);
-procedure FD_ZERO(var FDSet: TFDSet);
-}
-{=============================================================================}
-
-  function WSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer;
-  function WSACleanup: Integer;
-  function WSAGetLastError: Integer;
-  function WSAGetLastErrorDesc: String;
-  function GetHostName: string;
-  function Shutdown(s: TSocket; how: Integer): Integer;
-//  function SetSockOpt(s: TSocket; level, optname: Integer; optval: PChar;
-//    optlen: Integer): Integer;
-  function SetSockOpt(s: TSocket; level, optname: Integer; optval: TMemory;
-    optlen: Integer): Integer;
-  function SetSockOptObj(s: TSocket; level, optname: Integer; optval: TObject): Integer;
-  function GetSockOpt(s: TSocket; level, optname: Integer; optval: TMemory;
-    var optlen: Integer): Integer;
-//  function SendTo(s: TSocket; const Buf; len, flags: Integer; addrto: PSockAddr;
-//    tolen: Integer): Integer;
-///  function SendTo(s: TSocket; const Buf; len, flags: Integer; addrto: TVarSin): Integer;
-///  function Send(s: TSocket; const Buf; len, flags: Integer): Integer;
-///  function  Recv(s: TSocket; var Buf; len, flags: Integer): Integer;
-//  function  RecvFrom(s: TSocket; var Buf; len, flags: Integer; from: PSockAddr;
-//    var fromlen: Integer): Integer;
-///  function  RecvFrom(s: TSocket; var Buf; len, flags: Integer; from: TVarSin): Integer;
-function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
-function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
-function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
-function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
-  function  ntohs(netshort: u_short): u_short;
-  function  ntohl(netlong: u_long): u_long;
-  function  Listen(s: TSocket; backlog: Integer): Integer;
-  function  IoctlSocket(s: TSocket; cmd: DWORD; var arg: integer): Integer;
-  function  htons(hostshort: u_short): u_short;
-  function  htonl(hostlong: u_long): u_long;
-//  function  GetSockName(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
-  function  GetSockName(s: TSocket; var name: TVarSin): Integer;
-//  function  GetPeerName(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
-  function  GetPeerName(s: TSocket; var name: TVarSin): Integer;
-//  function  Connect(s: TSocket; name: PSockAddr; namelen: Integer): Integer;
-  function  Connect(s: TSocket; const name: TVarSin): Integer;
-  function  CloseSocket(s: TSocket): Integer;
-//  function  Bind(s: TSocket; addr: PSockAddr; namelen: Integer): Integer;
-  function  Bind(s: TSocket; const addr: TVarSin): Integer;
-//  function  Accept(s: TSocket; addr: PSockAddr; var addrlen: Integer): TSocket;
-  function  Accept(s: TSocket; var addr: TVarSin): TSocket;
-  function  Socket(af, Struc, Protocol: Integer): TSocket;
-//  Select = function(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
-//    timeout: PTimeVal): Longint;
-//    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};
-
-//  TWSAIoctl = function (s: TSocket; dwIoControlCode: DWORD; lpvInBuffer: Pointer;
-//    cbInBuffer: DWORD; lpvOutBuffer: Pointer; cbOutBuffer: DWORD;
-//    lpcbBytesReturned: PDWORD; lpOverlapped: Pointer;
-//    lpCompletionRoutine: pointer): u_int;
-//    stdcall;
-
-  function GetPortService(value: string): integer;
-
-function IsNewApi(Family: TAddrFamily): Boolean;
-function SetVarSin(var Sin: TVarSin; IP, Port: string; Family: TAddrFamily; SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
-function GetSinIP(Sin: TVarSin): string;
-function GetSinPort(Sin: TVarSin): Integer;
-procedure ResolveNameToIP(Name: string; Family: TAddrFamily; SockProtocol, SockType: integer; const IPList: TStrings);
-function ResolveIPToName(IP: string; Family: TAddrFamily; SockProtocol, SockType: integer): string;
-function ResolvePort(Port: string; Family: TAddrFamily; SockProtocol, SockType: integer): Word;
-
-var
-  SynSockCS: SyncObjs.TCriticalSection;
-  SockEnhancedApi: Boolean;
-  SockWship6Api: Boolean;
-
-{==============================================================================}
-implementation
-
-threadvar
-  WSALastError: integer;
-  WSALastErrorDesc: string;
-
-var
-  services: Array [0..139, 0..1] of string =
-  (
-    ('echo', '7'),
-    ('discard', '9'),
-    ('sink', '9'),
-    ('null', '9'),
-    ('systat', '11'),
-    ('users', '11'),
-    ('daytime', '13'),
-    ('qotd', '17'),
-    ('quote', '17'),
-    ('chargen', '19'),
-    ('ttytst', '19'),
-    ('source', '19'),
-    ('ftp-data', '20'),
-    ('ftp', '21'),
-    ('telnet', '23'),
-    ('smtp', '25'),
-    ('mail', '25'),
-    ('time', '37'),
-    ('timeserver', '37'),
-    ('rlp', '39'),
-    ('nameserver', '42'),
-    ('name', '42'),
-    ('nickname', '43'),
-    ('whois', '43'),
-    ('domain', '53'),
-    ('bootps', '67'),
-    ('dhcps', '67'),
-    ('bootpc', '68'),
-    ('dhcpc', '68'),
-    ('tftp', '69'),
-    ('gopher', '70'),
-    ('finger', '79'),
-    ('http', '80'),
-    ('www', '80'),
-    ('www-http', '80'),
-    ('kerberos', '88'),
-    ('hostname', '101'),
-    ('hostnames', '101'),
-    ('iso-tsap', '102'),
-    ('rtelnet', '107'),
-    ('pop2', '109'),
-    ('postoffice', '109'),
-    ('pop3', '110'),
-    ('sunrpc', '111'),
-    ('rpcbind', '111'),
-    ('portmap', '111'),
-    ('auth', '113'),
-    ('ident', '113'),
-    ('tap', '113'),
-    ('uucp-path', '117'),
-    ('nntp', '119'),
-    ('usenet', '119'),
-    ('ntp', '123'),
-    ('epmap', '135'),
-    ('loc-srv', '135'),
-    ('netbios-ns', '137'),
-    ('nbname', '137'),
-    ('netbios-dgm', '138'),
-    ('nbdatagram', '138'),
-    ('netbios-ssn', '139'),
-    ('nbsession', '139'),
-    ('imap', '143'),
-    ('imap4', '143'),
-    ('pcmail-srv', '158'),
-    ('snmp', '161'),
-    ('snmptrap', '162'),
-    ('snmp-trap', '162'),
-    ('print-srv', '170'),
-    ('bgp', '179'),
-    ('irc', '194'),
-    ('ipx', '213'),
-    ('ldap', '389'),
-    ('https', '443'),
-    ('mcom', '443'),
-    ('microsoft-ds', '445'),
-    ('kpasswd', '464'),
-    ('isakmp', '500'),
-    ('ike', '500'),
-    ('exec', '512'),
-    ('biff', '512'),
-    ('comsat', '512'),
-    ('login', '513'),
-    ('who', '513'),
-    ('whod', '513'),
-    ('cmd', '514'),
-    ('shell', '514'),
-    ('syslog', '514'),
-    ('printer', '515'),
-    ('spooler', '515'),
-    ('talk', '517'),
-    ('ntalk', '517'),
-    ('efs', '520'),
-    ('router', '520'),
-    ('route', '520'),
-    ('routed', '520'),
-    ('timed', '525'),
-    ('timeserver', '525'),
-    ('tempo', '526'),
-    ('newdate', '526'),
-    ('courier', '530'),
-    ('rpc', '530'),
-    ('conference', '531'),
-    ('chat', '531'),
-    ('netnews', '532'),
-    ('readnews', '532'),
-    ('netwall', '533'),
-    ('uucp', '540'),
-    ('uucpd', '540'),
-    ('klogin', '543'),
-    ('kshell', '544'),
-    ('krcmd', '544'),
-    ('new-rwho', '550'),
-    ('new-who', '550'),
-    ('remotefs', '556'),
-    ('rfs', '556'),
-    ('rfs_server', '556'),
-    ('rmonitor', '560'),
-    ('rmonitord', '560'),
-    ('monitor', '561'),
-    ('ldaps', '636'),
-    ('sldap', '636'),
-    ('doom', '666'),
-    ('kerberos-adm', '749'),
-    ('kerberos-iv', '750'),
-    ('kpop', '1109'),
-    ('phone', '1167'),
-    ('ms-sql-s', '1433'),
-    ('ms-sql-m', '1434'),
-    ('wins', '1512'),
-    ('ingreslock', '1524'),
-    ('ingres', '1524'),
-    ('l2tp', '1701'),
-    ('pptp', '1723'),
-    ('radius', '1812'),
-    ('radacct', '1813'),
-    ('nfsd', '2049'),
-    ('nfs', '2049'),
-    ('knetd', '2053'),
-    ('gds_db', '3050'),
-    ('man', '9535')
-    );
-
-{function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
-begin
-  Result := ((a^.s_un_dw.s_dw1 = 0) and (a^.s_un_dw.s_dw2 = 0) and
-             (a^.s_un_dw.s_dw3 = 0) and (a^.s_un_dw.s_dw4 = 0));
-end;
-
-function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
-begin
-  Result := ((a^.s_un_dw.s_dw1 = 0) and (a^.s_un_dw.s_dw2 = 0) and
-             (a^.s_un_dw.s_dw3 = 0) and
-             (a^.s_un_b.s_b13 = char(0)) and (a^.s_un_b.s_b14 = char(0)) and
-             (a^.s_un_b.s_b15 = char(0)) and (a^.s_un_b.s_b16 = char(1)));
-end;
-
-function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
-begin
-  Result := ((a^.s_un_b.s_b1 = u_char($FE)) and (a^.s_un_b.s_b2 = u_char($80)));
-end;
-
-function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
-begin
-  Result := ((a^.s_un_b.s_b1 = u_char($FE)) and (a^.s_un_b.s_b2 = u_char($C0)));
-end;
-
-function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
-begin
-  Result := (a^.s_un_b.s_b1 = char($FF));
-end;
-
-function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6): boolean;
-begin
-  Result := (CompareMem( a, b, sizeof(TInAddr6)));
-end;
-
-procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
-begin
-  FillChar(a^, sizeof(TInAddr6), 0);
-end;
-
-procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
-begin
-  FillChar(a^, sizeof(TInAddr6), 0);
-  a^.s_un_b.s_b16 := char(1);
-end;
-}
-
-{=============================================================================}
-
-procedure NullErr;
-begin
-  WSALastError := 0;
-  WSALastErrorDesc := '';
-end;
-
-procedure GetErrCode(E: System.Exception);
-var
-  SE: System.Net.Sockets.SocketException;
-begin
-  if E is System.Net.Sockets.SocketException then
-  begin
-    SE := E as System.Net.Sockets.SocketException;
-    WSALastError := SE.ErrorCode;
-    WSALastErrorDesc := SE.Message;
-  end
-end;
-
-function WSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer;
-begin
-  NullErr;
-  with WSData do
-  begin
-    wVersion := wVersionRequired;
-    wHighVersion := $202;
-    szDescription := 'Synsock - Synapse Platform Independent Socket Layer';
-    szSystemStatus := 'Running on .NET';
-    iMaxSockets := 32768;
-    iMaxUdpDg := 8192;
-  end;
-  Result := 0;
-end;
-
-function WSACleanup: Integer;
-begin
-  NullErr;
-  Result := 0;
-end;
-
-function WSAGetLastError: Integer;
-begin
-  Result := WSALastError;
-end;
-
-function WSAGetLastErrorDesc: String;
-begin
-  Result := WSALastErrorDesc;
-end;
-
-function GetHostName: string;
-begin
-  Result := System.Net.DNS.GetHostName;
-end;
-
-function Shutdown(s: TSocket; how: Integer): Integer;
-begin
-  Result := 0;
-  NullErr;
-  try
-    s.ShutDown(SocketShutdown(how));
-  except
-    on e: System.Net.Sockets.SocketException do
-    begin
-      GetErrCode(e);
-      Result := integer(SOCKET_ERROR);
-    end;
-  end;
-end;
-
-function SetSockOpt(s: TSocket; level, optname: Integer; optval: Tmemory;
-  optlen: Integer): Integer;
-begin
-  Result := 0;
-  NullErr;
-  try
-    s.SetSocketOption(SocketOptionLevel(level), SocketOptionName(optname), optval);
-  except
-    on e: System.Net.Sockets.SocketException do
-    begin
-      GetErrCode(e);
-      Result := integer(SOCKET_ERROR);
-    end;
-  end;
-end;
-
-function SetSockOptObj(s: TSocket; level, optname: Integer; optval: TObject): Integer;
-begin
-  Result := 0;
-  NullErr;
-  try
-    s.SetSocketOption(SocketOptionLevel(level), SocketOptionName(optname), optval);
-  except
-    on e: System.Net.Sockets.SocketException do
-    begin
-      GetErrCode(e);
-      Result := integer(SOCKET_ERROR);
-    end;
-  end;
-end;
-
-function GetSockOpt(s: TSocket; level, optname: Integer; optval: Tmemory;
-  var optlen: Integer): Integer;
-begin
-  Result := 0;
-  NullErr;
-  try
-    s.GetSocketOption(SocketOptionLevel(level), SocketOptionName(optname), optval);
-  except
-    on e: System.Net.Sockets.SocketException do
-    begin
-      GetErrCode(e);
-      Result := integer(SOCKET_ERROR);
-    end;
-  end;
-end;
-
-function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
-//function SendTo(s: TSocket; const Buf; len, flags: Integer; addrto: TVarSin): Integer;
-begin
-  NullErr;
-  try
-    result := s.SendTo(Buf, len, SocketFlags(flags), addrto);
-  except
-    on e: System.Net.Sockets.SocketException do
-    begin
-      GetErrCode(e);
-      Result := integer(SOCKET_ERROR);
-    end;
-  end;
-end;
-
-function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
-//function Send(s: TSocket; const Buf; len, flags: Integer): Integer;
-begin
-  NullErr;
-  try
-    result := s.Send(Buf, len, SocketFlags(flags));
-  except
-    on e: System.Net.Sockets.SocketException do
-    begin
-      GetErrCode(e);
-      Result := integer(SOCKET_ERROR);
-    end;
-  end;
-end;
-
-function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
-//function  Recv(s: TSocket; var Buf; len, flags: Integer): Integer;
-begin
-  NullErr;
-  try
-    result := s.Receive(Buf, len, SocketFlags(flags));
-  except
-    on e: System.Net.Sockets.SocketException do
-    begin
-      GetErrCode(e);
-      Result := integer(SOCKET_ERROR);
-    end;
-  end;
-end;
-
-//function  RecvFrom(s: TSocket; var Buf; len, flags: Integer; from: PSockAddr;
-//  var fromlen: Integer): Integer;
-function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
-//function  RecvFrom(s: TSocket; var Buf; len, flags: Integer; from: TVarSin): Integer;
-var
-  EP: EndPoint;
-begin
-  NullErr;
-  try
-    EP := from;
-    result := s.ReceiveFrom(Buf, len, SocketFlags(flags), EndPoint(EP));
-    from := EP as IPEndPoint;
-  except
-    on e: System.Net.Sockets.SocketException do
-    begin
-      GetErrCode(e);
-      Result := integer(SOCKET_ERROR);
-    end;
-  end;
-end;
-
-function  ntohs(netshort: u_short): u_short;
-begin
-  Result := IPAddress.NetworkToHostOrder(NetShort);
-end;
-
-function  ntohl(netlong: u_long): u_long;
-begin
-  Result := IPAddress.NetworkToHostOrder(NetLong);
-end;
-
-function  Listen(s: TSocket; backlog: Integer): Integer;
-begin
-  Result := 0;
-  NullErr;
-  try
-    s.Listen(backlog);
-  except
-    on e: System.Net.Sockets.SocketException do
-    begin
-      GetErrCode(e);
-      Result := integer(SOCKET_ERROR);
-    end;
-  end;
-end;
-
-function  IoctlSocket(s: TSocket; cmd: DWORD; var arg: integer): Integer;
-var
-  inv, outv: TMemory;
-begin
-  Result := 0;
-  NullErr;
-  try
-    if cmd = DWORD(FIONBIO) then
-      s.Blocking := arg = 0
-    else
-    begin
-      inv := BitConverter.GetBytes(arg);
-      outv := BitConverter.GetBytes(integer(0));
-      s.IOControl(cmd, inv, outv);
-      arg := BitConverter.ToInt32(outv, 0);
-    end;
-  except
-    on e: System.Net.Sockets.SocketException do
-    begin
-      GetErrCode(e);
-      Result := integer(SOCKET_ERROR);
-    end;
-  end;
-end;
-
-function  htons(hostshort: u_short): u_short;
-begin
-  Result := IPAddress.HostToNetworkOrder(Hostshort);
-end;
-
-function  htonl(hostlong: u_long): u_long;
-begin
-  Result := IPAddress.HostToNetworkOrder(HostLong);
-end;
-
-//function  GetSockName(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
-function  GetSockName(s: TSocket; var name: TVarSin): Integer;
-begin
-  Result := 0;
-  NullErr;
-  try
-    Name := s.localEndPoint as IPEndpoint;
-  except
-    on e: System.Net.Sockets.SocketException do
-    begin
-      GetErrCode(e);
-      Result := integer(SOCKET_ERROR);
-    end;
-  end;
-end;
-
-//function  GetPeerName(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
-function  GetPeerName(s: TSocket; var name: TVarSin): Integer;
-begin
-  Result := 0;
-  NullErr;
-  try
-    Name := s.RemoteEndPoint as IPEndpoint;
-  except
-    on e: System.Net.Sockets.SocketException do
-    begin
-      GetErrCode(e);
-      Result := integer(SOCKET_ERROR);
-    end;
-  end;
-end;
-
-//function  Connect(s: TSocket; name: PSockAddr; namelen: Integer): Integer;
-function Connect(s: TSocket; const name: TVarSin): Integer;
-begin
-  Result := 0;
-  NullErr;
-  try
-    s.Connect(name);
-  except
-    on e: System.Net.Sockets.SocketException do
-    begin
-      GetErrCode(e);
-      Result := integer(SOCKET_ERROR);
-    end;
-  end;
-end;
-
-function CloseSocket(s: TSocket): Integer;
-begin
-  Result := 0;
-  NullErr;
-  try
-    s.Close;
-  except
-    on e: System.Net.Sockets.SocketException do
-    begin
-      Result := integer(SOCKET_ERROR);
-    end;
-  end;
-end;
-
-//function  Bind(s: TSocket; addr: PSockAddr; namelen: Integer): Integer;
-function Bind(s: TSocket; const addr: TVarSin): Integer;
-begin
-  Result := 0;
-  NullErr;
-  try
-    s.Bind(addr);
-  except
-    on e: System.Net.Sockets.SocketException do
-    begin
-      GetErrCode(e);
-      Result := integer(SOCKET_ERROR);
-    end;
-  end;
-end;
-
-//function  Accept(s: TSocket; addr: PSockAddr; var addrlen: Integer): TSocket;
-function Accept(s: TSocket; var addr: TVarSin): TSocket;
-begin
-  NullErr;
-  try
-    result := s.Accept();
-  except
-    on e: System.Net.Sockets.SocketException do
-    begin
-      GetErrCode(e);
-      Result := nil;
-    end;
-  end;
-end;
-
-function Socket(af, Struc, Protocol: Integer): TSocket;
-begin
-  NullErr;
-  try
-    result := TSocket.Create(AddressFamily(af), SocketType(Struc), ProtocolType(Protocol));
-  except
-    on e: System.Net.Sockets.SocketException do
-    begin
-      GetErrCode(e);
-      Result := nil;
-    end;
-  end;
-end;
-
-{=============================================================================}
-function GetPortService(value: string): integer;
-var
-  n: integer;
-begin
-  Result := 0;
-  value := Lowercase(value);
-  for n := 0 to High(Services) do
-    if services[n, 0] = value then
-    begin
-      Result := strtointdef(services[n, 1], 0);
-      break;
-    end;
-  if Result = 0 then
-    Result := StrToIntDef(value, 0);
-end;
-
-{=============================================================================}
-function IsNewApi(Family: TAddrFamily): Boolean;
-begin
-  Result := true;
-end;
-
-function SetVarSin(var Sin: TVarSin; IP, Port: string; Family: TAddrFamily; SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
-var
-  IPs: array of IPAddress;
-  n: integer;
-  ip4, ip6: string;
-  sip: string;
-begin
-  sip := '';
-  ip4 := '';
-  ip6 := '';
-  IPs := Dns.Resolve(IP).AddressList;
-  for n :=low(IPs) to high(IPs) do begin
-    if (ip4 = '') and (IPs[n].AddressFamily = AF_INET) then
-      ip4 := IPs[n].toString;
-    if (ip6 = '') and (IPs[n].AddressFamily = AF_INET6) then
-      ip6 := IPs[n].toString;
-    if (ip4 <> '') and (ip6 <> '') then
-      break;
-  end;
-  case Family of
-    AF_UNSPEC:
-      begin
-        if (ip4 <> '') and (ip6 <> '') then
-        begin
-          if PreferIP4 then
-            sip := ip4
-          else
-            Sip := ip6;
-          end
-        else
-        begin
-          sip := ip4;
-          if (ip6 <> '') then
-            sip := ip6;
-        end;
-      end;
-    AF_INET:
-      sip := ip4;
-    AF_INET6:
-      sip := ip6;
-  end;
-  sin := TVarSin.Create(IPAddress.Parse(sip), GetPortService(Port));
-end;
-
-function GetSinIP(Sin: TVarSin): string;
-begin
-  Result := Sin.Address.ToString;
-end;
-
-function GetSinPort(Sin: TVarSin): Integer;
-begin
-  Result := Sin.Port;
-end;
-
-procedure ResolveNameToIP(Name: string; Family: TAddrFamily; SockProtocol, SockType: integer; const IPList: TStrings);
-var
-  IPs :array of IPAddress;
-  n: integer;
-begin
-  IPList.Clear;
-  IPs := Dns.Resolve(Name).AddressList;
-  for n := low(IPs) to high(IPs) do
-  begin
-    if not(((Family = AF_INET6) and (IPs[n].AddressFamily = AF_INET))
-      or ((Family = AF_INET) and (IPs[n].AddressFamily = AF_INET6))) then
-    begin
-      IPList.Add(IPs[n].toString);
-    end;
-  end;
-end;
-
-function ResolvePort(Port: string; Family: TAddrFamily; SockProtocol, SockType: integer): Word;
-var
-  n: integer;
-begin
-  Result := StrToIntDef(port, 0);
-  if Result = 0 then
-  begin
-    port := Lowercase(port);
-    for n := 0 to High(Services) do
-      if services[n, 0] = port then
-      begin
-        Result := strtointdef(services[n, 1], 0);
-        break;
-      end;
-  end;
-end;
-
-function ResolveIPToName(IP: string; Family: TAddrFamily; SockProtocol, SockType: integer): string;
-begin
-  Result := Dns.GetHostByAddress(IP).HostName;
-end;
-
-
-{=============================================================================}
-function InitSocketInterface(stack: string): Boolean;
-begin
-  Result := True;
-end;
-
-function DestroySocketInterface: Boolean;
-begin
-  NullErr;
-  Result := True;
-end;
-
-initialization
-begin
-  SynSockCS := SyncObjs.TCriticalSection.Create;
-//  SET_IN6_IF_ADDR_ANY (@in6addr_any);
-//  SET_LOOPBACK_ADDR6  (@in6addr_loopback);
-end;
-
-finalization
-begin
-  NullErr;
-  SynSockCS.Free;
-end;
-
-{$ENDIF}
+{==============================================================================|
+| Project : Ararat Synapse                                       | 001.000.002 |
+|==============================================================================|
+| Content: Socket Independent Platform Layer - .NET definition include         |
+|==============================================================================|
+| Copyright (c)2004, Lukas Gebauer                                             |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2004.                     |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@exclude}
+
+{$IFDEF CIL}
+
+interface
+
+uses
+  SyncObjs, SysUtils, Classes,
+  System.Net,
+  System.Net.Sockets;
+
+const
+  DLLStackName = '';
+  WinsockLevel = $0202;
+
+function InitSocketInterface(stack: string): Boolean;
+function DestroySocketInterface: Boolean;
+
+type
+  u_char = Char;
+  u_short = Word;
+  u_int = Integer;
+  u_long = Longint;
+  pu_long = ^u_long;
+  pu_short = ^u_short;
+  PSockAddr = IPEndPoint;
+  DWORD = integer;
+  ULong = cardinal;
+  TMemory = Array of byte;
+  TLinger = LingerOption;
+  TSocket = socket;
+  TAddrFamily = AddressFamily;
+
+const
+  WSADESCRIPTION_LEN     =   256;
+  WSASYS_STATUS_LEN      =   128;
+type
+  PWSAData = ^TWSAData;
+  TWSAData = packed record
+    wVersion: Word;
+    wHighVersion: Word;
+    szDescription: array[0..WSADESCRIPTION_LEN] of Char;
+    szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char;
+    iMaxSockets: Word;
+    iMaxUdpDg: Word;
+//    lpVendorInfo: PChar;
+  end;
+
+const
+  MSG_NOSIGNAL = 0;
+  INVALID_SOCKET = nil;
+  AF_UNSPEC = AddressFamily.Unspecified;
+  AF_INET = AddressFamily.InterNetwork;
+  AF_INET6 = AddressFamily.InterNetworkV6;
+  SOCKET_ERROR = integer(-1);
+
+  FIONREAD     = integer($4004667f);
+  FIONBIO      = integer($8004667e);
+  FIOASYNC     = integer($8004667d);
+
+  SOMAXCONN       = integer($7fffffff);
+
+  IPPROTO_IP = ProtocolType.IP;
+  IPPROTO_ICMP = ProtocolType.Icmp;
+  IPPROTO_IGMP = ProtocolType.Igmp;
+  IPPROTO_TCP = ProtocolType.Tcp;
+  IPPROTO_UDP = ProtocolType.Udp;
+  IPPROTO_RAW = ProtocolType.Raw;
+  IPPROTO_IPV6 = ProtocolType.IPV6;
+//
+  IPPROTO_ICMPV6 = ProtocolType.Icmp; //??
+
+  SOCK_STREAM     = SocketType.Stream;
+  SOCK_DGRAM      = SocketType.Dgram;
+  SOCK_RAW        = SocketType.Raw;
+  SOCK_RDM        = SocketType.Rdm;
+  SOCK_SEQPACKET  = SocketType.Seqpacket;
+
+  SOL_SOCKET = SocketOptionLevel.Socket;
+  SOL_IP = SocketOptionLevel.Ip;
+
+
+  IP_OPTIONS          = SocketOptionName.IPOptions;
+  IP_HDRINCL          = SocketOptionName.HeaderIncluded;
+  IP_TOS              = SocketOptionName.TypeOfService;           { set/get IP Type Of Service       }
+  IP_TTL              = SocketOptionName.IpTimeToLive;           { set/get IP Time To Live          }
+  IP_MULTICAST_IF     = SocketOptionName.MulticastInterface;           { set/get IP multicast interface   }
+  IP_MULTICAST_TTL    = SocketOptionName.MulticastTimeToLive;           { set/get IP multicast timetolive  }
+  IP_MULTICAST_LOOP   = SocketOptionName.MulticastLoopback;           { set/get IP multicast loopback    }
+  IP_ADD_MEMBERSHIP   = SocketOptionName.AddMembership;           { add  an IP group membership      }
+  IP_DROP_MEMBERSHIP  = SocketOptionName.DropMembership;           { drop an IP group membership      }
+  IP_DONTFRAGMENT     = SocketOptionName.DontFragment;           { set/get IP Don't Fragment flag   }
+
+  IPV6_UNICAST_HOPS      = 8;  // TTL
+  IPV6_MULTICAST_IF      = 9;  // set/get IP multicast i/f
+  IPV6_MULTICAST_HOPS    = 10; // set/get IP multicast ttl
+  IPV6_MULTICAST_LOOP    = 11; // set/get IP multicast loopback
+  IPV6_JOIN_GROUP        = 12; // add an IP group membership
+  IPV6_LEAVE_GROUP       = 13; // drop an IP group membership
+
+  SO_DEBUG        = SocketOptionName.Debug;          { turn on debugging info recording }
+  SO_ACCEPTCONN   = SocketOptionName.AcceptConnection;          { socket has had listen() }
+  SO_REUSEADDR    = SocketOptionName.ReuseAddress;          { allow local address reuse }
+  SO_KEEPALIVE    = SocketOptionName.KeepAlive;          { keep connections alive }
+  SO_DONTROUTE    = SocketOptionName.DontRoute;          { just use interface addresses }
+  SO_BROADCAST    = SocketOptionName.Broadcast;          { permit sending of broadcast msgs }
+  SO_USELOOPBACK  = SocketOptionName.UseLoopback;          { bypass hardware when possible }
+  SO_LINGER       = SocketOptionName.Linger;          { linger on close if data present }
+  SO_OOBINLINE    = SocketOptionName.OutOfBandInline;          { leave received OOB data in line }
+  SO_DONTLINGER   = SocketOptionName.DontLinger;
+{ Additional options. }
+  SO_SNDBUF       = SocketOptionName.SendBuffer;          { send buffer size }
+  SO_RCVBUF       = SocketOptionName.ReceiveBuffer;          { receive buffer size }
+  SO_SNDLOWAT     = SocketOptionName.SendLowWater;          { send low-water mark }
+  SO_RCVLOWAT     = SocketOptionName.ReceiveLowWater;          { receive low-water mark }
+  SO_SNDTIMEO     = SocketOptionName.SendTimeout;          { send timeout }
+  SO_RCVTIMEO     = SocketOptionName.ReceiveTimeout;          { receive timeout }
+  SO_ERROR        = SocketOptionName.Error;          { get error status and clear }
+  SO_TYPE         = SocketOptionName.Type;          { get socket type }
+
+{ WinSock 2 extension -- new options }
+//  SO_GROUP_ID       = $2001; { ID of a socket group}
+//  SO_GROUP_PRIORITY = $2002; { the relative priority within a group}
+//  SO_MAX_MSG_SIZE   = $2003; { maximum message size }
+//  SO_PROTOCOL_INFOA = $2004; { WSAPROTOCOL_INFOA structure }
+//  SO_PROTOCOL_INFOW = $2005; { WSAPROTOCOL_INFOW structure }
+//  SO_PROTOCOL_INFO  = SO_PROTOCOL_INFOA;
+//  PVD_CONFIG        = $3001; {configuration info for service provider }
+{ Option for opening sockets for synchronous access. }
+//  SO_OPENTYPE     = $7008;
+//  SO_SYNCHRONOUS_ALERT    = $10;
+//  SO_SYNCHRONOUS_NONALERT = $20;
+{ Other NT-specific options. }
+//  SO_MAXDG        = $7009;
+//  SO_MAXPATHDG    = $700A;
+//  SO_UPDATE_ACCEPT_CONTEXT     = $700B;
+//  SO_CONNECT_TIME = $700C;
+
+
+  { All Windows Sockets error constants are biased by WSABASEERR from the "normal" }
+  WSABASEERR              = 10000;
+
+{ Windows Sockets definitions of regular Microsoft C error constants }
+
+  WSAEINTR                = (WSABASEERR+4);
+  WSAEBADF                = (WSABASEERR+9);
+  WSAEACCES               = (WSABASEERR+13);
+  WSAEFAULT               = (WSABASEERR+14);
+  WSAEINVAL               = (WSABASEERR+22);
+  WSAEMFILE               = (WSABASEERR+24);
+
+{ Windows Sockets definitions of regular Berkeley error constants }
+
+  WSAEWOULDBLOCK          = (WSABASEERR+35);
+  WSAEINPROGRESS          = (WSABASEERR+36);
+  WSAEALREADY             = (WSABASEERR+37);
+  WSAENOTSOCK             = (WSABASEERR+38);
+  WSAEDESTADDRREQ         = (WSABASEERR+39);
+  WSAEMSGSIZE             = (WSABASEERR+40);
+  WSAEPROTOTYPE           = (WSABASEERR+41);
+  WSAENOPROTOOPT          = (WSABASEERR+42);
+  WSAEPROTONOSUPPORT      = (WSABASEERR+43);
+  WSAESOCKTNOSUPPORT      = (WSABASEERR+44);
+  WSAEOPNOTSUPP           = (WSABASEERR+45);
+  WSAEPFNOSUPPORT         = (WSABASEERR+46);
+  WSAEAFNOSUPPORT         = (WSABASEERR+47);
+  WSAEADDRINUSE           = (WSABASEERR+48);
+  WSAEADDRNOTAVAIL        = (WSABASEERR+49);
+  WSAENETDOWN             = (WSABASEERR+50);
+  WSAENETUNREACH          = (WSABASEERR+51);
+  WSAENETRESET            = (WSABASEERR+52);
+  WSAECONNABORTED         = (WSABASEERR+53);
+  WSAECONNRESET           = (WSABASEERR+54);
+  WSAENOBUFS              = (WSABASEERR+55);
+  WSAEISCONN              = (WSABASEERR+56);
+  WSAENOTCONN             = (WSABASEERR+57);
+  WSAESHUTDOWN            = (WSABASEERR+58);
+  WSAETOOMANYREFS         = (WSABASEERR+59);
+  WSAETIMEDOUT            = (WSABASEERR+60);
+  WSAECONNREFUSED         = (WSABASEERR+61);
+  WSAELOOP                = (WSABASEERR+62);
+  WSAENAMETOOLONG         = (WSABASEERR+63);
+  WSAEHOSTDOWN            = (WSABASEERR+64);
+  WSAEHOSTUNREACH         = (WSABASEERR+65);
+  WSAENOTEMPTY            = (WSABASEERR+66);
+  WSAEPROCLIM             = (WSABASEERR+67);
+  WSAEUSERS               = (WSABASEERR+68);
+  WSAEDQUOT               = (WSABASEERR+69);
+  WSAESTALE               = (WSABASEERR+70);
+  WSAEREMOTE              = (WSABASEERR+71);
+
+{ Extended Windows Sockets error constant definitions }
+
+  WSASYSNOTREADY          = (WSABASEERR+91);
+  WSAVERNOTSUPPORTED      = (WSABASEERR+92);
+  WSANOTINITIALISED       = (WSABASEERR+93);
+  WSAEDISCON              = (WSABASEERR+101);
+  WSAENOMORE              = (WSABASEERR+102);
+  WSAECANCELLED           = (WSABASEERR+103);
+  WSAEEINVALIDPROCTABLE   = (WSABASEERR+104);
+  WSAEINVALIDPROVIDER     = (WSABASEERR+105);
+  WSAEPROVIDERFAILEDINIT  = (WSABASEERR+106);
+  WSASYSCALLFAILURE       = (WSABASEERR+107);
+  WSASERVICE_NOT_FOUND    = (WSABASEERR+108);
+  WSATYPE_NOT_FOUND       = (WSABASEERR+109);
+  WSA_E_NO_MORE           = (WSABASEERR+110);
+  WSA_E_CANCELLED         = (WSABASEERR+111);
+  WSAEREFUSED             = (WSABASEERR+112);
+
+{ Error return codes from gethostbyname() and gethostbyaddr()
+  (when using the resolver). Note that these errors are
+  retrieved via WSAGetLastError() and must therefore follow
+  the rules for avoiding clashes with error numbers from
+  specific implementations or language run-time systems.
+  For this reason the codes are based at WSABASEERR+1001.
+  Note also that [WSA]NO_ADDRESS is defined only for
+  compatibility purposes. }
+
+{ Authoritative Answer: Host not found }
+  WSAHOST_NOT_FOUND       = (WSABASEERR+1001);
+  HOST_NOT_FOUND          = WSAHOST_NOT_FOUND;
+{ Non-Authoritative: Host not found, or SERVERFAIL }
+  WSATRY_AGAIN            = (WSABASEERR+1002);
+  TRY_AGAIN               = WSATRY_AGAIN;
+{ Non recoverable errors, FORMERR, REFUSED, NOTIMP }
+  WSANO_RECOVERY          = (WSABASEERR+1003);
+  NO_RECOVERY             = WSANO_RECOVERY;
+{ Valid name, no data record of requested type }
+  WSANO_DATA              = (WSABASEERR+1004);
+  NO_DATA                 = WSANO_DATA;
+{ no address, look for MX record }
+  WSANO_ADDRESS           = WSANO_DATA;
+  NO_ADDRESS              = WSANO_ADDRESS;
+
+  EWOULDBLOCK        =  WSAEWOULDBLOCK;
+  EINPROGRESS        =  WSAEINPROGRESS;
+  EALREADY           =  WSAEALREADY;
+  ENOTSOCK           =  WSAENOTSOCK;
+  EDESTADDRREQ       =  WSAEDESTADDRREQ;
+  EMSGSIZE           =  WSAEMSGSIZE;
+  EPROTOTYPE         =  WSAEPROTOTYPE;
+  ENOPROTOOPT        =  WSAENOPROTOOPT;
+  EPROTONOSUPPORT    =  WSAEPROTONOSUPPORT;
+  ESOCKTNOSUPPORT    =  WSAESOCKTNOSUPPORT;
+  EOPNOTSUPP         =  WSAEOPNOTSUPP;
+  EPFNOSUPPORT       =  WSAEPFNOSUPPORT;
+  EAFNOSUPPORT       =  WSAEAFNOSUPPORT;
+  EADDRINUSE         =  WSAEADDRINUSE;
+  EADDRNOTAVAIL      =  WSAEADDRNOTAVAIL;
+  ENETDOWN           =  WSAENETDOWN;
+  ENETUNREACH        =  WSAENETUNREACH;
+  ENETRESET          =  WSAENETRESET;
+  ECONNABORTED       =  WSAECONNABORTED;
+  ECONNRESET         =  WSAECONNRESET;
+  ENOBUFS            =  WSAENOBUFS;
+  EISCONN            =  WSAEISCONN;
+  ENOTCONN           =  WSAENOTCONN;
+  ESHUTDOWN          =  WSAESHUTDOWN;
+  ETOOMANYREFS       =  WSAETOOMANYREFS;
+  ETIMEDOUT          =  WSAETIMEDOUT;
+  ECONNREFUSED       =  WSAECONNREFUSED;
+  ELOOP              =  WSAELOOP;
+  ENAMETOOLONG       =  WSAENAMETOOLONG;
+  EHOSTDOWN          =  WSAEHOSTDOWN;
+  EHOSTUNREACH       =  WSAEHOSTUNREACH;
+  ENOTEMPTY          =  WSAENOTEMPTY;
+  EPROCLIM           =  WSAEPROCLIM;
+  EUSERS             =  WSAEUSERS;
+  EDQUOT             =  WSAEDQUOT;
+  ESTALE             =  WSAESTALE;
+  EREMOTE            =  WSAEREMOTE;
+
+
+type
+  TVarSin = IPEndpoint;
+
+{  function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
+  function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
+  function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
+  function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
+  function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
+  function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6):boolean;
+  procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
+  procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
+var
+  in6addr_any, in6addr_loopback : TInAddr6;
+}
+
+{procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet);
+function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean;
+procedure FD_SET(Socket: TSocket; var FDSet: TFDSet);
+procedure FD_ZERO(var FDSet: TFDSet);
+}
+{=============================================================================}
+
+  function WSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer;
+  function WSACleanup: Integer;
+  function WSAGetLastError: Integer;
+  function WSAGetLastErrorDesc: String;
+  function GetHostName: string;
+  function Shutdown(s: TSocket; how: Integer): Integer;
+//  function SetSockOpt(s: TSocket; level, optname: Integer; optval: PChar;
+//    optlen: Integer): Integer;
+  function SetSockOpt(s: TSocket; level, optname: Integer; optval: TMemory;
+    optlen: Integer): Integer;
+  function SetSockOptObj(s: TSocket; level, optname: Integer; optval: TObject): Integer;
+  function GetSockOpt(s: TSocket; level, optname: Integer; optval: TMemory;
+    var optlen: Integer): Integer;
+//  function SendTo(s: TSocket; const Buf; len, flags: Integer; addrto: PSockAddr;
+//    tolen: Integer): Integer;
+///  function SendTo(s: TSocket; const Buf; len, flags: Integer; addrto: TVarSin): Integer;
+///  function Send(s: TSocket; const Buf; len, flags: Integer): Integer;
+///  function  Recv(s: TSocket; var Buf; len, flags: Integer): Integer;
+//  function  RecvFrom(s: TSocket; var Buf; len, flags: Integer; from: PSockAddr;
+//    var fromlen: Integer): Integer;
+///  function  RecvFrom(s: TSocket; var Buf; len, flags: Integer; from: TVarSin): Integer;
+function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
+function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
+  function  ntohs(netshort: u_short): u_short;
+  function  ntohl(netlong: u_long): u_long;
+  function  Listen(s: TSocket; backlog: Integer): Integer;
+  function  IoctlSocket(s: TSocket; cmd: DWORD; var arg: integer): Integer;
+  function  htons(hostshort: u_short): u_short;
+  function  htonl(hostlong: u_long): u_long;
+//  function  GetSockName(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
+  function  GetSockName(s: TSocket; var name: TVarSin): Integer;
+//  function  GetPeerName(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
+  function  GetPeerName(s: TSocket; var name: TVarSin): Integer;
+//  function  Connect(s: TSocket; name: PSockAddr; namelen: Integer): Integer;
+  function  Connect(s: TSocket; const name: TVarSin): Integer;
+  function  CloseSocket(s: TSocket): Integer;
+//  function  Bind(s: TSocket; addr: PSockAddr; namelen: Integer): Integer;
+  function  Bind(s: TSocket; const addr: TVarSin): Integer;
+//  function  Accept(s: TSocket; addr: PSockAddr; var addrlen: Integer): TSocket;
+  function  Accept(s: TSocket; var addr: TVarSin): TSocket;
+  function  Socket(af, Struc, Protocol: Integer): TSocket;
+//  Select = function(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
+//    timeout: PTimeVal): Longint;
+//    {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF};
+
+//  TWSAIoctl = function (s: TSocket; dwIoControlCode: DWORD; lpvInBuffer: Pointer;
+//    cbInBuffer: DWORD; lpvOutBuffer: Pointer; cbOutBuffer: DWORD;
+//    lpcbBytesReturned: PDWORD; lpOverlapped: Pointer;
+//    lpCompletionRoutine: pointer): u_int;
+//    stdcall;
+
+  function GetPortService(value: string): integer;
+
+function IsNewApi(Family: TAddrFamily): Boolean;
+function SetVarSin(var Sin: TVarSin; IP, Port: string; Family: TAddrFamily; SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+function GetSinIP(Sin: TVarSin): string;
+function GetSinPort(Sin: TVarSin): Integer;
+procedure ResolveNameToIP(Name: string; Family: TAddrFamily; SockProtocol, SockType: integer; const IPList: TStrings);
+function ResolveIPToName(IP: string; Family: TAddrFamily; SockProtocol, SockType: integer): string;
+function ResolvePort(Port: string; Family: TAddrFamily; SockProtocol, SockType: integer): Word;
+
+var
+  SynSockCS: SyncObjs.TCriticalSection;
+  SockEnhancedApi: Boolean;
+  SockWship6Api: Boolean;
+
+{==============================================================================}
+implementation
+
+threadvar
+  WSALastError: integer;
+  WSALastErrorDesc: string;
+
+var
+  services: Array [0..139, 0..1] of string =
+  (
+    ('echo', '7'),
+    ('discard', '9'),
+    ('sink', '9'),
+    ('null', '9'),
+    ('systat', '11'),
+    ('users', '11'),
+    ('daytime', '13'),
+    ('qotd', '17'),
+    ('quote', '17'),
+    ('chargen', '19'),
+    ('ttytst', '19'),
+    ('source', '19'),
+    ('ftp-data', '20'),
+    ('ftp', '21'),
+    ('telnet', '23'),
+    ('smtp', '25'),
+    ('mail', '25'),
+    ('time', '37'),
+    ('timeserver', '37'),
+    ('rlp', '39'),
+    ('nameserver', '42'),
+    ('name', '42'),
+    ('nickname', '43'),
+    ('whois', '43'),
+    ('domain', '53'),
+    ('bootps', '67'),
+    ('dhcps', '67'),
+    ('bootpc', '68'),
+    ('dhcpc', '68'),
+    ('tftp', '69'),
+    ('gopher', '70'),
+    ('finger', '79'),
+    ('http', '80'),
+    ('www', '80'),
+    ('www-http', '80'),
+    ('kerberos', '88'),
+    ('hostname', '101'),
+    ('hostnames', '101'),
+    ('iso-tsap', '102'),
+    ('rtelnet', '107'),
+    ('pop2', '109'),
+    ('postoffice', '109'),
+    ('pop3', '110'),
+    ('sunrpc', '111'),
+    ('rpcbind', '111'),
+    ('portmap', '111'),
+    ('auth', '113'),
+    ('ident', '113'),
+    ('tap', '113'),
+    ('uucp-path', '117'),
+    ('nntp', '119'),
+    ('usenet', '119'),
+    ('ntp', '123'),
+    ('epmap', '135'),
+    ('loc-srv', '135'),
+    ('netbios-ns', '137'),
+    ('nbname', '137'),
+    ('netbios-dgm', '138'),
+    ('nbdatagram', '138'),
+    ('netbios-ssn', '139'),
+    ('nbsession', '139'),
+    ('imap', '143'),
+    ('imap4', '143'),
+    ('pcmail-srv', '158'),
+    ('snmp', '161'),
+    ('snmptrap', '162'),
+    ('snmp-trap', '162'),
+    ('print-srv', '170'),
+    ('bgp', '179'),
+    ('irc', '194'),
+    ('ipx', '213'),
+    ('ldap', '389'),
+    ('https', '443'),
+    ('mcom', '443'),
+    ('microsoft-ds', '445'),
+    ('kpasswd', '464'),
+    ('isakmp', '500'),
+    ('ike', '500'),
+    ('exec', '512'),
+    ('biff', '512'),
+    ('comsat', '512'),
+    ('login', '513'),
+    ('who', '513'),
+    ('whod', '513'),
+    ('cmd', '514'),
+    ('shell', '514'),
+    ('syslog', '514'),
+    ('printer', '515'),
+    ('spooler', '515'),
+    ('talk', '517'),
+    ('ntalk', '517'),
+    ('efs', '520'),
+    ('router', '520'),
+    ('route', '520'),
+    ('routed', '520'),
+    ('timed', '525'),
+    ('timeserver', '525'),
+    ('tempo', '526'),
+    ('newdate', '526'),
+    ('courier', '530'),
+    ('rpc', '530'),
+    ('conference', '531'),
+    ('chat', '531'),
+    ('netnews', '532'),
+    ('readnews', '532'),
+    ('netwall', '533'),
+    ('uucp', '540'),
+    ('uucpd', '540'),
+    ('klogin', '543'),
+    ('kshell', '544'),
+    ('krcmd', '544'),
+    ('new-rwho', '550'),
+    ('new-who', '550'),
+    ('remotefs', '556'),
+    ('rfs', '556'),
+    ('rfs_server', '556'),
+    ('rmonitor', '560'),
+    ('rmonitord', '560'),
+    ('monitor', '561'),
+    ('ldaps', '636'),
+    ('sldap', '636'),
+    ('doom', '666'),
+    ('kerberos-adm', '749'),
+    ('kerberos-iv', '750'),
+    ('kpop', '1109'),
+    ('phone', '1167'),
+    ('ms-sql-s', '1433'),
+    ('ms-sql-m', '1434'),
+    ('wins', '1512'),
+    ('ingreslock', '1524'),
+    ('ingres', '1524'),
+    ('l2tp', '1701'),
+    ('pptp', '1723'),
+    ('radius', '1812'),
+    ('radacct', '1813'),
+    ('nfsd', '2049'),
+    ('nfs', '2049'),
+    ('knetd', '2053'),
+    ('gds_db', '3050'),
+    ('man', '9535')
+    );
+
+{function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
+begin
+  Result := ((a^.s_un_dw.s_dw1 = 0) and (a^.s_un_dw.s_dw2 = 0) and
+             (a^.s_un_dw.s_dw3 = 0) and (a^.s_un_dw.s_dw4 = 0));
+end;
+
+function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
+begin
+  Result := ((a^.s_un_dw.s_dw1 = 0) and (a^.s_un_dw.s_dw2 = 0) and
+             (a^.s_un_dw.s_dw3 = 0) and
+             (a^.s_un_b.s_b13 = char(0)) and (a^.s_un_b.s_b14 = char(0)) and
+             (a^.s_un_b.s_b15 = char(0)) and (a^.s_un_b.s_b16 = char(1)));
+end;
+
+function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
+begin
+  Result := ((a^.s_un_b.s_b1 = u_char($FE)) and (a^.s_un_b.s_b2 = u_char($80)));
+end;
+
+function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
+begin
+  Result := ((a^.s_un_b.s_b1 = u_char($FE)) and (a^.s_un_b.s_b2 = u_char($C0)));
+end;
+
+function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
+begin
+  Result := (a^.s_un_b.s_b1 = char($FF));
+end;
+
+function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6): boolean;
+begin
+  Result := (CompareMem( a, b, sizeof(TInAddr6)));
+end;
+
+procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
+begin
+  FillChar(a^, sizeof(TInAddr6), 0);
+end;
+
+procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
+begin
+  FillChar(a^, sizeof(TInAddr6), 0);
+  a^.s_un_b.s_b16 := char(1);
+end;
+}
+
+{=============================================================================}
+
+procedure NullErr;
+begin
+  WSALastError := 0;
+  WSALastErrorDesc := '';
+end;
+
+procedure GetErrCode(E: System.Exception);
+var
+  SE: System.Net.Sockets.SocketException;
+begin
+  if E is System.Net.Sockets.SocketException then
+  begin
+    SE := E as System.Net.Sockets.SocketException;
+    WSALastError := SE.ErrorCode;
+    WSALastErrorDesc := SE.Message;
+  end
+end;
+
+function WSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer;
+begin
+  NullErr;
+  with WSData do
+  begin
+    wVersion := wVersionRequired;
+    wHighVersion := $202;
+    szDescription := 'Synsock - Synapse Platform Independent Socket Layer';
+    szSystemStatus := 'Running on .NET';
+    iMaxSockets := 32768;
+    iMaxUdpDg := 8192;
+  end;
+  Result := 0;
+end;
+
+function WSACleanup: Integer;
+begin
+  NullErr;
+  Result := 0;
+end;
+
+function WSAGetLastError: Integer;
+begin
+  Result := WSALastError;
+end;
+
+function WSAGetLastErrorDesc: String;
+begin
+  Result := WSALastErrorDesc;
+end;
+
+function GetHostName: string;
+begin
+  Result := System.Net.DNS.GetHostName;
+end;
+
+function Shutdown(s: TSocket; how: Integer): Integer;
+begin
+  Result := 0;
+  NullErr;
+  try
+    s.ShutDown(SocketShutdown(how));
+  except
+    on e: System.Net.Sockets.SocketException do
+    begin
+      GetErrCode(e);
+      Result := integer(SOCKET_ERROR);
+    end;
+  end;
+end;
+
+function SetSockOpt(s: TSocket; level, optname: Integer; optval: Tmemory;
+  optlen: Integer): Integer;
+begin
+  Result := 0;
+  NullErr;
+  try
+    s.SetSocketOption(SocketOptionLevel(level), SocketOptionName(optname), optval);
+  except
+    on e: System.Net.Sockets.SocketException do
+    begin
+      GetErrCode(e);
+      Result := integer(SOCKET_ERROR);
+    end;
+  end;
+end;
+
+function SetSockOptObj(s: TSocket; level, optname: Integer; optval: TObject): Integer;
+begin
+  Result := 0;
+  NullErr;
+  try
+    s.SetSocketOption(SocketOptionLevel(level), SocketOptionName(optname), optval);
+  except
+    on e: System.Net.Sockets.SocketException do
+    begin
+      GetErrCode(e);
+      Result := integer(SOCKET_ERROR);
+    end;
+  end;
+end;
+
+function GetSockOpt(s: TSocket; level, optname: Integer; optval: Tmemory;
+  var optlen: Integer): Integer;
+begin
+  Result := 0;
+  NullErr;
+  try
+    s.GetSocketOption(SocketOptionLevel(level), SocketOptionName(optname), optval);
+  except
+    on e: System.Net.Sockets.SocketException do
+    begin
+      GetErrCode(e);
+      Result := integer(SOCKET_ERROR);
+    end;
+  end;
+end;
+
+function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
+//function SendTo(s: TSocket; const Buf; len, flags: Integer; addrto: TVarSin): Integer;
+begin
+  NullErr;
+  try
+    result := s.SendTo(Buf, len, SocketFlags(flags), addrto);
+  except
+    on e: System.Net.Sockets.SocketException do
+    begin
+      GetErrCode(e);
+      Result := integer(SOCKET_ERROR);
+    end;
+  end;
+end;
+
+function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+//function Send(s: TSocket; const Buf; len, flags: Integer): Integer;
+begin
+  NullErr;
+  try
+    result := s.Send(Buf, len, SocketFlags(flags));
+  except
+    on e: System.Net.Sockets.SocketException do
+    begin
+      GetErrCode(e);
+      Result := integer(SOCKET_ERROR);
+    end;
+  end;
+end;
+
+function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+//function  Recv(s: TSocket; var Buf; len, flags: Integer): Integer;
+begin
+  NullErr;
+  try
+    result := s.Receive(Buf, len, SocketFlags(flags));
+  except
+    on e: System.Net.Sockets.SocketException do
+    begin
+      GetErrCode(e);
+      Result := integer(SOCKET_ERROR);
+    end;
+  end;
+end;
+
+//function  RecvFrom(s: TSocket; var Buf; len, flags: Integer; from: PSockAddr;
+//  var fromlen: Integer): Integer;
+function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
+//function  RecvFrom(s: TSocket; var Buf; len, flags: Integer; from: TVarSin): Integer;
+var
+  EP: EndPoint;
+begin
+  NullErr;
+  try
+    EP := from;
+    result := s.ReceiveFrom(Buf, len, SocketFlags(flags), EndPoint(EP));
+    from := EP as IPEndPoint;
+  except
+    on e: System.Net.Sockets.SocketException do
+    begin
+      GetErrCode(e);
+      Result := integer(SOCKET_ERROR);
+    end;
+  end;
+end;
+
+function  ntohs(netshort: u_short): u_short;
+begin
+  Result := IPAddress.NetworkToHostOrder(NetShort);
+end;
+
+function  ntohl(netlong: u_long): u_long;
+begin
+  Result := IPAddress.NetworkToHostOrder(NetLong);
+end;
+
+function  Listen(s: TSocket; backlog: Integer): Integer;
+begin
+  Result := 0;
+  NullErr;
+  try
+    s.Listen(backlog);
+  except
+    on e: System.Net.Sockets.SocketException do
+    begin
+      GetErrCode(e);
+      Result := integer(SOCKET_ERROR);
+    end;
+  end;
+end;
+
+function  IoctlSocket(s: TSocket; cmd: DWORD; var arg: integer): Integer;
+var
+  inv, outv: TMemory;
+begin
+  Result := 0;
+  NullErr;
+  try
+    if cmd = DWORD(FIONBIO) then
+      s.Blocking := arg = 0
+    else
+    begin
+      inv := BitConverter.GetBytes(arg);
+      outv := BitConverter.GetBytes(integer(0));
+      s.IOControl(cmd, inv, outv);
+      arg := BitConverter.ToInt32(outv, 0);
+    end;
+  except
+    on e: System.Net.Sockets.SocketException do
+    begin
+      GetErrCode(e);
+      Result := integer(SOCKET_ERROR);
+    end;
+  end;
+end;
+
+function  htons(hostshort: u_short): u_short;
+begin
+  Result := IPAddress.HostToNetworkOrder(Hostshort);
+end;
+
+function  htonl(hostlong: u_long): u_long;
+begin
+  Result := IPAddress.HostToNetworkOrder(HostLong);
+end;
+
+//function  GetSockName(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
+function  GetSockName(s: TSocket; var name: TVarSin): Integer;
+begin
+  Result := 0;
+  NullErr;
+  try
+    Name := s.localEndPoint as IPEndpoint;
+  except
+    on e: System.Net.Sockets.SocketException do
+    begin
+      GetErrCode(e);
+      Result := integer(SOCKET_ERROR);
+    end;
+  end;
+end;
+
+//function  GetPeerName(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
+function  GetPeerName(s: TSocket; var name: TVarSin): Integer;
+begin
+  Result := 0;
+  NullErr;
+  try
+    Name := s.RemoteEndPoint as IPEndpoint;
+  except
+    on e: System.Net.Sockets.SocketException do
+    begin
+      GetErrCode(e);
+      Result := integer(SOCKET_ERROR);
+    end;
+  end;
+end;
+
+//function  Connect(s: TSocket; name: PSockAddr; namelen: Integer): Integer;
+function Connect(s: TSocket; const name: TVarSin): Integer;
+begin
+  Result := 0;
+  NullErr;
+  try
+    s.Connect(name);
+  except
+    on e: System.Net.Sockets.SocketException do
+    begin
+      GetErrCode(e);
+      Result := integer(SOCKET_ERROR);
+    end;
+  end;
+end;
+
+function CloseSocket(s: TSocket): Integer;
+begin
+  Result := 0;
+  NullErr;
+  try
+    s.Close;
+  except
+    on e: System.Net.Sockets.SocketException do
+    begin
+      Result := integer(SOCKET_ERROR);
+    end;
+  end;
+end;
+
+//function  Bind(s: TSocket; addr: PSockAddr; namelen: Integer): Integer;
+function Bind(s: TSocket; const addr: TVarSin): Integer;
+begin
+  Result := 0;
+  NullErr;
+  try
+    s.Bind(addr);
+  except
+    on e: System.Net.Sockets.SocketException do
+    begin
+      GetErrCode(e);
+      Result := integer(SOCKET_ERROR);
+    end;
+  end;
+end;
+
+//function  Accept(s: TSocket; addr: PSockAddr; var addrlen: Integer): TSocket;
+function Accept(s: TSocket; var addr: TVarSin): TSocket;
+begin
+  NullErr;
+  try
+    result := s.Accept();
+  except
+    on e: System.Net.Sockets.SocketException do
+    begin
+      GetErrCode(e);
+      Result := nil;
+    end;
+  end;
+end;
+
+function Socket(af, Struc, Protocol: Integer): TSocket;
+begin
+  NullErr;
+  try
+    result := TSocket.Create(AddressFamily(af), SocketType(Struc), ProtocolType(Protocol));
+  except
+    on e: System.Net.Sockets.SocketException do
+    begin
+      GetErrCode(e);
+      Result := nil;
+    end;
+  end;
+end;
+
+{=============================================================================}
+function GetPortService(value: string): integer;
+var
+  n: integer;
+begin
+  Result := 0;
+  value := Lowercase(value);
+  for n := 0 to High(Services) do
+    if services[n, 0] = value then
+    begin
+      Result := strtointdef(services[n, 1], 0);
+      break;
+    end;
+  if Result = 0 then
+    Result := StrToIntDef(value, 0);
+end;
+
+{=============================================================================}
+function IsNewApi(Family: TAddrFamily): Boolean;
+begin
+  Result := true;
+end;
+
+function SetVarSin(var Sin: TVarSin; IP, Port: string; Family: TAddrFamily; SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+var
+  IPs: array of IPAddress;
+  n: integer;
+  ip4, ip6: string;
+  sip: string;
+begin
+  sip := '';
+  ip4 := '';
+  ip6 := '';
+  IPs := Dns.Resolve(IP).AddressList;
+  for n :=low(IPs) to high(IPs) do begin
+    if (ip4 = '') and (IPs[n].AddressFamily = AF_INET) then
+      ip4 := IPs[n].toString;
+    if (ip6 = '') and (IPs[n].AddressFamily = AF_INET6) then
+      ip6 := IPs[n].toString;
+    if (ip4 <> '') and (ip6 <> '') then
+      break;
+  end;
+  case Family of
+    AF_UNSPEC:
+      begin
+        if (ip4 <> '') and (ip6 <> '') then
+        begin
+          if PreferIP4 then
+            sip := ip4
+          else
+            Sip := ip6;
+          end
+        else
+        begin
+          sip := ip4;
+          if (ip6 <> '') then
+            sip := ip6;
+        end;
+      end;
+    AF_INET:
+      sip := ip4;
+    AF_INET6:
+      sip := ip6;
+  end;
+  sin := TVarSin.Create(IPAddress.Parse(sip), GetPortService(Port));
+end;
+
+function GetSinIP(Sin: TVarSin): string;
+begin
+  Result := Sin.Address.ToString;
+end;
+
+function GetSinPort(Sin: TVarSin): Integer;
+begin
+  Result := Sin.Port;
+end;
+
+procedure ResolveNameToIP(Name: string; Family: TAddrFamily; SockProtocol, SockType: integer; const IPList: TStrings);
+var
+  IPs :array of IPAddress;
+  n: integer;
+begin
+  IPList.Clear;
+  IPs := Dns.Resolve(Name).AddressList;
+  for n := low(IPs) to high(IPs) do
+  begin
+    if not(((Family = AF_INET6) and (IPs[n].AddressFamily = AF_INET))
+      or ((Family = AF_INET) and (IPs[n].AddressFamily = AF_INET6))) then
+    begin
+      IPList.Add(IPs[n].toString);
+    end;
+  end;
+end;
+
+function ResolvePort(Port: string; Family: TAddrFamily; SockProtocol, SockType: integer): Word;
+var
+  n: integer;
+begin
+  Result := StrToIntDef(port, 0);
+  if Result = 0 then
+  begin
+    port := Lowercase(port);
+    for n := 0 to High(Services) do
+      if services[n, 0] = port then
+      begin
+        Result := strtointdef(services[n, 1], 0);
+        break;
+      end;
+  end;
+end;
+
+function ResolveIPToName(IP: string; Family: TAddrFamily; SockProtocol, SockType: integer): string;
+begin
+  Result := Dns.GetHostByAddress(IP).HostName;
+end;
+
+
+{=============================================================================}
+function InitSocketInterface(stack: string): Boolean;
+begin
+  Result := True;
+end;
+
+function DestroySocketInterface: Boolean;
+begin
+  NullErr;
+  Result := True;
+end;
+
+initialization
+begin
+  SynSockCS := SyncObjs.TCriticalSection.Create;
+//  SET_IN6_IF_ADDR_ANY (@in6addr_any);
+//  SET_LOOPBACK_ADDR6  (@in6addr_loopback);
+end;
+
+finalization
+begin
+  NullErr;
+  SynSockCS.Free;
+end;
+
+{$ENDIF}
diff --git a/Units/Synapse/ssfpc.pas b/Units/Synapse/ssfpc.pas
index aa275e7..7411dc5 100644
--- a/Units/Synapse/ssfpc.pas
+++ b/Units/Synapse/ssfpc.pas
@@ -1,892 +1,892 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 001.001.001 |
-|==============================================================================|
-| Content: Socket Independent Platform Layer - FreePascal definition include   |
-|==============================================================================|
-| Copyright (c)2006-2010, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2006-2010.                |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{:@exclude}
-
-{$IFDEF FPC}
-{For FreePascal 2.x.x}
-
-//{$DEFINE FORCEOLDAPI}
-{Note about define FORCEOLDAPI:
-If you activate this compiler directive, then is allways used old socket API
-for name resolution. If you leave this directive inactive, then the new API
-is used, when running system allows it.
-
-For IPv6 support you must have new API!
-}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$H+}
-
-{$ifdef FreeBSD}
-{$DEFINE SOCK_HAS_SINLEN}               // BSD definition of scoketaddr
-{$endif}
-{$ifdef darwin}
-{$DEFINE SOCK_HAS_SINLEN}               // BSD definition of scoketaddr
-{$endif}
-
-interface
-
-uses
-  SyncObjs, SysUtils, Classes,
-  synafpc, BaseUnix, Unix, termio, sockets, netdb;
-
-function InitSocketInterface(stack: string): Boolean;
-function DestroySocketInterface: Boolean;
-
-const
-  DLLStackName = '';
-  WinsockLevel = $0202;
-
-  cLocalHost = '127.0.0.1';
-  cAnyHost = '0.0.0.0';
-  c6AnyHost = '::0';
-  c6Localhost = '::1';
-  cLocalHostStr = 'localhost';
-
-type
-  TSocket = longint;
-  TAddrFamily = integer;
-
-  TMemory = pointer;
-
-
-type
-  TFDSet = Baseunix.TFDSet;
-  PFDSet = ^TFDSet;
-  Ptimeval = Baseunix.ptimeval;
-  Ttimeval = Baseunix.ttimeval;
-
-const
-  FIONREAD        = termio.FIONREAD;
-  FIONBIO         = termio.FIONBIO;
-  FIOASYNC        = termio.FIOASYNC;
-
-const
-  IPPROTO_IP     =   0;		{ Dummy					}
-  IPPROTO_ICMP   =   1;		{ Internet Control Message Protocol }
-  IPPROTO_IGMP   =   2;		{ Internet Group Management Protocol}
-  IPPROTO_TCP    =   6;		{ TCP           			}
-  IPPROTO_UDP    =   17;	{ User Datagram Protocol		}
-  IPPROTO_IPV6   =   41;
-  IPPROTO_ICMPV6 =   58;
-  IPPROTO_RM     =  113;
-
-  IPPROTO_RAW    =   255;
-  IPPROTO_MAX    =   256;
-
-type
-  PInAddr = ^TInAddr;
-  TInAddr = sockets.in_addr;
-
-  PSockAddrIn = ^TSockAddrIn;
-  TSockAddrIn = sockets.TInetSockAddr;
-
-
-  TIP_mreq =  record
-    imr_multiaddr: TInAddr;     // IP multicast address of group
-    imr_interface: TInAddr;     // local IP address of interface
-  end;
-
-
-  PInAddr6 = ^TInAddr6;
-  TInAddr6 = sockets.Tin6_addr;
-
-  PSockAddrIn6 = ^TSockAddrIn6;
-  TSockAddrIn6 = sockets.TInetSockAddr6;
-
-
-  TIPv6_mreq = record
-    ipv6mr_multiaddr: TInAddr6; // IPv6 multicast address.
-    ipv6mr_interface: integer;   // Interface index.
-  end;
-
-const
-  INADDR_ANY       = $00000000;
-  INADDR_LOOPBACK  = $7F000001;
-  INADDR_BROADCAST = $FFFFFFFF;
-  INADDR_NONE      = $FFFFFFFF;
-  ADDR_ANY		 = INADDR_ANY;
-  INVALID_SOCKET		= TSocket(NOT(0));
-  SOCKET_ERROR			= -1;
-
-Const
-  IP_TOS             = sockets.IP_TOS;             { int; IP type of service and precedence.  }
-  IP_TTL             = sockets.IP_TTL;             { int; IP time to live.  }
-  IP_HDRINCL         = sockets.IP_HDRINCL;         { int; Header is included with data.  }
-  IP_OPTIONS         = sockets.IP_OPTIONS;         { ip_opts; IP per-packet options.  }
-//  IP_ROUTER_ALERT    = sockets.IP_ROUTER_ALERT;    { bool }
-  IP_RECVOPTS        = sockets.IP_RECVOPTS;        { bool }
-  IP_RETOPTS         = sockets.IP_RETOPTS;         { bool }
-//  IP_PKTINFO         = sockets.IP_PKTINFO;         { bool }
-//  IP_PKTOPTIONS      = sockets.IP_PKTOPTIONS;
-//  IP_PMTUDISC        = sockets.IP_PMTUDISC;        { obsolete name? }
-//  IP_MTU_DISCOVER    = sockets.IP_MTU_DISCOVER;    { int; see below }
-//  IP_RECVERR         = sockets.IP_RECVERR;         { bool }
-//  IP_RECVTTL         = sockets.IP_RECVTTL;         { bool }
-//  IP_RECVTOS         = sockets.IP_RECVTOS;         { bool }
-  IP_MULTICAST_IF    = sockets.IP_MULTICAST_IF;    { in_addr; set/get IP multicast i/f }
-  IP_MULTICAST_TTL   = sockets.IP_MULTICAST_TTL;   { u_char; set/get IP multicast ttl }
-  IP_MULTICAST_LOOP  = sockets.IP_MULTICAST_LOOP;  { i_char; set/get IP multicast loopback }
-  IP_ADD_MEMBERSHIP  = sockets.IP_ADD_MEMBERSHIP;  { ip_mreq; add an IP group membership }
-  IP_DROP_MEMBERSHIP = sockets.IP_DROP_MEMBERSHIP; { ip_mreq; drop an IP group membership }
-
-  SOL_SOCKET    = sockets.SOL_SOCKET;
-
-  SO_DEBUG      = sockets.SO_DEBUG;
-  SO_REUSEADDR  = sockets.SO_REUSEADDR;
-  SO_TYPE       = sockets.SO_TYPE;
-  SO_ERROR      = sockets.SO_ERROR;
-  SO_DONTROUTE  = sockets.SO_DONTROUTE;
-  SO_BROADCAST  = sockets.SO_BROADCAST;
-  SO_SNDBUF     = sockets.SO_SNDBUF;
-  SO_RCVBUF     = sockets.SO_RCVBUF;
-  SO_KEEPALIVE  = sockets.SO_KEEPALIVE;
-  SO_OOBINLINE  = sockets.SO_OOBINLINE;
-//  SO_NO_CHECK   = sockets.SO_NO_CHECK;
-//  SO_PRIORITY   = sockets.SO_PRIORITY;
-  SO_LINGER     = sockets.SO_LINGER;
-//  SO_BSDCOMPAT  = sockets.SO_BSDCOMPAT;
-//  SO_REUSEPORT  = sockets.SO_REUSEPORT;
-//  SO_PASSCRED   = sockets.SO_PASSCRED;
-//  SO_PEERCRED   = sockets.SO_PEERCRED;
-  SO_RCVLOWAT   = sockets.SO_RCVLOWAT;
-  SO_SNDLOWAT   = sockets.SO_SNDLOWAT;
-  SO_RCVTIMEO   = sockets.SO_RCVTIMEO;
-  SO_SNDTIMEO   = sockets.SO_SNDTIMEO;
-{ Security levels - as per NRL IPv6 - don't actually do anything }
-//  SO_SECURITY_AUTHENTICATION       = sockets.SO_SECURITY_AUTHENTICATION;
-//  SO_SECURITY_ENCRYPTION_TRANSPORT = sockets.SO_SECURITY_ENCRYPTION_TRANSPORT;
-//  SO_SECURITY_ENCRYPTION_NETWORK   = sockets.SO_SECURITY_ENCRYPTION_NETWORK;
-//  SO_BINDTODEVICE                  = sockets.SO_BINDTODEVICE;
-{ Socket filtering }
-//  SO_ATTACH_FILTER = sockets.SO_ATTACH_FILTER;
-//  SO_DETACH_FILTER = sockets.SO_DETACH_FILTER;
-
-  SOMAXCONN       = 1024;
-
-  IPV6_UNICAST_HOPS     = sockets.IPV6_UNICAST_HOPS;
-  IPV6_MULTICAST_IF     = sockets.IPV6_MULTICAST_IF;
-  IPV6_MULTICAST_HOPS   = sockets.IPV6_MULTICAST_HOPS;
-  IPV6_MULTICAST_LOOP   = sockets.IPV6_MULTICAST_LOOP;
-  IPV6_JOIN_GROUP       = sockets.IPV6_JOIN_GROUP;
-  IPV6_LEAVE_GROUP      = sockets.IPV6_LEAVE_GROUP;
-
-const
-  SOCK_STREAM     = 1;               { stream socket }
-  SOCK_DGRAM      = 2;               { datagram socket }
-  SOCK_RAW        = 3;               { raw-protocol interface }
-  SOCK_RDM        = 4;               { reliably-delivered message }
-  SOCK_SEQPACKET  = 5;               { sequenced packet stream }
-
-{ TCP options. }
-  TCP_NODELAY     = $0001;
-
-{ Address families. }
-
-  AF_UNSPEC       = 0;               { unspecified }
-  AF_INET         = 2;               { internetwork: UDP, TCP, etc. }
-  AF_INET6        = 10;              { Internetwork Version 6 }
-  AF_MAX          = 24;
-
-{ Protocol families, same as address families for now. }
-  PF_UNSPEC       = AF_UNSPEC;
-  PF_INET         = AF_INET;
-  PF_INET6        = AF_INET6;
-  PF_MAX          = AF_MAX;
-
-type
-{ Structure used for manipulating linger option. }
-  PLinger = ^TLinger;
-  TLinger = packed record
-    l_onoff: integer;
-    l_linger: integer;
-  end;
-
-const
-
-  MSG_OOB       = sockets.MSG_OOB;      // Process out-of-band data.
-  MSG_PEEK      = sockets.MSG_PEEK;     // Peek at incoming messages.
-  MSG_NOSIGNAL  = sockets.MSG_NOSIGNAL; // Do not generate SIGPIPE.
-
-const
-  WSAEINTR = ESysEINTR;
-  WSAEBADF = ESysEBADF;
-  WSAEACCES = ESysEACCES;
-  WSAEFAULT = ESysEFAULT;
-  WSAEINVAL = ESysEINVAL;
-  WSAEMFILE = ESysEMFILE;
-  WSAEWOULDBLOCK = ESysEWOULDBLOCK;
-  WSAEINPROGRESS = ESysEINPROGRESS;
-  WSAEALREADY = ESysEALREADY;
-  WSAENOTSOCK = ESysENOTSOCK;
-  WSAEDESTADDRREQ = ESysEDESTADDRREQ;
-  WSAEMSGSIZE = ESysEMSGSIZE;
-  WSAEPROTOTYPE = ESysEPROTOTYPE;
-  WSAENOPROTOOPT = ESysENOPROTOOPT;
-  WSAEPROTONOSUPPORT = ESysEPROTONOSUPPORT;
-  WSAESOCKTNOSUPPORT = ESysESOCKTNOSUPPORT;
-  WSAEOPNOTSUPP = ESysEOPNOTSUPP;
-  WSAEPFNOSUPPORT = ESysEPFNOSUPPORT;
-  WSAEAFNOSUPPORT = ESysEAFNOSUPPORT;
-  WSAEADDRINUSE = ESysEADDRINUSE;
-  WSAEADDRNOTAVAIL = ESysEADDRNOTAVAIL;
-  WSAENETDOWN = ESysENETDOWN;
-  WSAENETUNREACH = ESysENETUNREACH;
-  WSAENETRESET = ESysENETRESET;
-  WSAECONNABORTED = ESysECONNABORTED;
-  WSAECONNRESET = ESysECONNRESET;
-  WSAENOBUFS = ESysENOBUFS;
-  WSAEISCONN = ESysEISCONN;
-  WSAENOTCONN = ESysENOTCONN;
-  WSAESHUTDOWN = ESysESHUTDOWN;
-  WSAETOOMANYREFS = ESysETOOMANYREFS;
-  WSAETIMEDOUT = ESysETIMEDOUT;
-  WSAECONNREFUSED = ESysECONNREFUSED;
-  WSAELOOP = ESysELOOP;
-  WSAENAMETOOLONG = ESysENAMETOOLONG;
-  WSAEHOSTDOWN = ESysEHOSTDOWN;
-  WSAEHOSTUNREACH = ESysEHOSTUNREACH;
-  WSAENOTEMPTY = ESysENOTEMPTY;
-  WSAEPROCLIM = -1;
-  WSAEUSERS = ESysEUSERS;
-  WSAEDQUOT = ESysEDQUOT;
-  WSAESTALE = ESysESTALE;
-  WSAEREMOTE = ESysEREMOTE;
-  WSASYSNOTREADY = -2;
-  WSAVERNOTSUPPORTED = -3;
-  WSANOTINITIALISED = -4;
-  WSAEDISCON = -5;
-  WSAHOST_NOT_FOUND = 1;
-  WSATRY_AGAIN = 2;
-  WSANO_RECOVERY = 3;
-  WSANO_DATA = -6;
-
-const
-  WSADESCRIPTION_LEN     =   256;
-  WSASYS_STATUS_LEN      =   128;
-type
-  PWSAData = ^TWSAData;
-  TWSAData = packed record
-    wVersion: Word;
-    wHighVersion: Word;
-    szDescription: array[0..WSADESCRIPTION_LEN] of Char;
-    szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char;
-    iMaxSockets: Word;
-    iMaxUdpDg: Word;
-    lpVendorInfo: PChar;
-  end;
-
-  function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
-  function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
-  function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
-  function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
-  function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
-  function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6):boolean;
-  procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
-  procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
-
-var
-  in6addr_any, in6addr_loopback : TInAddr6;
-
-procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet);
-function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean;
-procedure FD_SET(Socket: TSocket; var FDSet: TFDSet);
-procedure FD_ZERO(var FDSet: TFDSet);
-
-{=============================================================================}
-
-var
-  SynSockCS: SyncObjs.TCriticalSection;
-  SockEnhancedApi: Boolean;
-  SockWship6Api: Boolean;
-
-type
-  TVarSin = packed record
-  {$ifdef SOCK_HAS_SINLEN}
-     sin_len     : cuchar;
-  {$endif}
-    case integer of
-      0: (AddressFamily: sa_family_t);
-      1: (
-        case sin_family: sa_family_t of
-          AF_INET: (sin_port: word;
-                    sin_addr: TInAddr;
-                    sin_zero: array[0..7] of Char);
-          AF_INET6: (sin6_port:     word;
-                		sin6_flowinfo: longword;
-      	    	      sin6_addr:     TInAddr6;
-      		          sin6_scope_id: longword);
-          );
-  end;
-
-function SizeOfVarSin(sin: TVarSin): integer;
-
-  function WSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer;
-  function WSACleanup: Integer;
-  function WSAGetLastError: Integer;
-  function GetHostName: string;
-  function Shutdown(s: TSocket; how: Integer): Integer;
-  function SetSockOpt(s: TSocket; level, optname: Integer; optval: TMemory;
-    optlen: Integer): Integer;
-  function GetSockOpt(s: TSocket; level, optname: Integer; optval: TMemory;
-    var optlen: Integer): Integer;
-  function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
-  function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
-  function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
-  function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
-  function ntohs(netshort: word): word;
-  function ntohl(netlong: longword): longword;
-  function Listen(s: TSocket; backlog: Integer): Integer;
-  function IoctlSocket(s: TSocket; cmd: DWORD; var arg: integer): Integer;
-  function htons(hostshort: word): word;
-  function htonl(hostlong: longword): longword;
-  function GetSockName(s: TSocket; var name: TVarSin): Integer;
-  function GetPeerName(s: TSocket; var name: TVarSin): Integer;
-  function Connect(s: TSocket; const name: TVarSin): Integer;
-  function CloseSocket(s: TSocket): Integer;
-  function Bind(s: TSocket; const addr: TVarSin): Integer;
-  function Accept(s: TSocket; var addr: TVarSin): TSocket;
-  function Socket(af, Struc, Protocol: Integer): TSocket;
-  function Select(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
-    timeout: PTimeVal): Longint;
-
-function IsNewApi(Family: integer): Boolean;
-function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
-function GetSinIP(Sin: TVarSin): string;
-function GetSinPort(Sin: TVarSin): Integer;
-procedure ResolveNameToIP(Name: string;  Family, SockProtocol, SockType: integer; const IPList: TStrings);
-function ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): string;
-function ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word;
-
-
-{==============================================================================}
-implementation
-
-
-function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
-begin
-  Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
-             (a^.u6_addr32[2] = 0) and (a^.u6_addr32[3] = 0));
-end;
-
-function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
-begin
-  Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
-             (a^.u6_addr32[2] = 0) and
-             (a^.u6_addr8[12] = 0) and (a^.u6_addr8[13] = 0) and
-             (a^.u6_addr8[14] = 0) and (a^.u6_addr8[15] = 1));
-end;
-
-function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
-begin
-  Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $80));
-end;
-
-function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
-begin
-  Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $C0));
-end;
-
-function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
-begin
-  Result := (a^.u6_addr8[0] = $FF);
-end;
-
-function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6): boolean;
-begin
-  Result := (CompareMem( a, b, sizeof(TInAddr6)));
-end;
-
-procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
-begin
-  FillChar(a^, sizeof(TInAddr6), 0);
-end;
-
-procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
-begin
-  FillChar(a^, sizeof(TInAddr6), 0);
-  a^.u6_addr8[15] := 1;
-end;
-
-{=============================================================================}
-
-function WSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer;
-begin
-  with WSData do
-  begin
-    wVersion := wVersionRequired;
-    wHighVersion := $202;
-    szDescription := 'Synsock - Synapse Platform Independent Socket Layer';
-    szSystemStatus := 'Running on Unix/Linux by FreePascal';
-    iMaxSockets := 32768;
-    iMaxUdpDg := 8192;
-  end;
-  Result := 0;
-end;
-
-function WSACleanup: Integer;
-begin
-  Result := 0;
-end;
-
-function WSAGetLastError: Integer;
-begin
-  Result := fpGetErrno; 
-end;
-
-function FD_ISSET(Socket: TSocket; var fdset: TFDSet): Boolean;
-begin
-  Result := fpFD_ISSET(socket, fdset) <> 0;
-end;
-
-procedure FD_SET(Socket: TSocket; var fdset: TFDSet);
-begin
-  fpFD_SET(Socket, fdset);
-end;
-
-procedure FD_CLR(Socket: TSocket; var fdset: TFDSet);
-begin
-  fpFD_CLR(Socket, fdset);
-end;
-
-procedure FD_ZERO(var fdset: TFDSet);
-begin
-  fpFD_ZERO(fdset);
-end;
-
-{=============================================================================}
-
-function SizeOfVarSin(sin: TVarSin): integer;
-begin
-  case sin.sin_family of
-    AF_INET:
-            Result := SizeOf(TSockAddrIn);
-    AF_INET6:
-            Result := SizeOf(TSockAddrIn6);
-  else
-    Result := 0;
-  end;
-end;
-
-{=============================================================================}
-
-function Bind(s: TSocket; const addr: TVarSin): Integer;
-begin
-  if fpBind(s, @addr, SizeOfVarSin(addr)) = 0 then
-    Result := 0
-  else
-    Result := SOCKET_ERROR;
-end;
-
-function Connect(s: TSocket; const name: TVarSin): Integer;
-begin
-  if fpConnect(s, @name, SizeOfVarSin(name)) = 0 then
-    Result := 0
-  else
-    Result := SOCKET_ERROR;
-end;
-
-function GetSockName(s: TSocket; var name: TVarSin): Integer;
-var
-  len: integer;
-begin
-  len := SizeOf(name);
-  FillChar(name, len, 0);
-  Result := fpGetSockName(s, @name, @Len);
-end;
-
-function GetPeerName(s: TSocket; var name: TVarSin): Integer;
-var
-  len: integer;
-begin
-  len := SizeOf(name);
-  FillChar(name, len, 0);
-  Result := fpGetPeerName(s, @name, @Len);
-end;
-
-function GetHostName: string;
-begin
-  Result := unix.GetHostName;
-end;
-
-function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
-begin
-  Result := fpSend(s, pointer(Buf), len, flags);
-end;
-
-function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
-begin
-  Result := fpRecv(s, pointer(Buf), len, flags);
-end;
-
-function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
-begin
-  Result := fpSendTo(s, pointer(Buf), len, flags, @addrto, SizeOfVarSin(addrto));
-end;
-
-function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
-var
-  x: integer;
-begin
-  x := SizeOf(from);
-  Result := fpRecvFrom(s, pointer(Buf), len, flags, @from, @x);
-end;
-
-function Accept(s: TSocket; var addr: TVarSin): TSocket;
-var
-  x: integer;
-begin
-  x := SizeOf(addr);
-  Result := fpAccept(s, @addr, @x);
-end;
-
-function Shutdown(s: TSocket; how: Integer): Integer;
-begin
-  Result := fpShutdown(s, how);
-end;
-
-function SetSockOpt(s: TSocket; level, optname: Integer; optval: Tmemory;
-  optlen: Integer): Integer;
-begin
-  Result := fpsetsockopt(s, level, optname, pointer(optval), optlen);
-end;
-
-function GetSockOpt(s: TSocket; level, optname: Integer; optval: Tmemory;
-  var optlen: Integer): Integer;
-begin
-  Result := fpgetsockopt(s, level, optname, pointer(optval), @optlen);
-end;
-
-function  ntohs(netshort: word): word;
-begin
-  Result := sockets.ntohs(NetShort);
-end;
-
-function  ntohl(netlong: longword): longword;
-begin
-  Result := sockets.ntohl(NetLong);
-end;
-
-function  Listen(s: TSocket; backlog: Integer): Integer;
-begin
-  if fpListen(s, backlog) = 0 then
-    Result := 0
-  else
-    Result := SOCKET_ERROR;
-end;
-
-function  IoctlSocket(s: TSocket; cmd: DWORD; var arg: integer): Integer;
-begin
-  Result := fpIoctl(s, cmd, @arg);
-end;
-
-function  htons(hostshort: word): word;
-begin
-  Result := sockets.htons(Hostshort);
-end;
-
-function  htonl(hostlong: longword): longword;
-begin
-  Result := sockets.htonl(HostLong);
-end;
-
-function CloseSocket(s: TSocket): Integer;
-begin
-  Result := sockets.CloseSocket(s);
-end;
-
-function Socket(af, Struc, Protocol: Integer): TSocket;
-begin
-  Result := fpSocket(af, struc, protocol);
-end;
-
-function Select(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
-  timeout: PTimeVal): Longint;
-begin
-  Result := fpSelect(nfds, readfds, writefds, exceptfds, timeout);
-end;
-
-{=============================================================================}
-function IsNewApi(Family: integer): Boolean;
-begin
-  Result := SockEnhancedApi;
-  if not Result then
-    Result := (Family = AF_INET6) and SockWship6Api;
-end;
-
-function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
-var
-  TwoPass: boolean;
-  f1, f2: integer;
-
-  function GetAddr(f:integer): integer;
-  var
-    a4: array [1..1] of in_addr;
-    a6: array [1..1] of Tin6_addr;
-  begin
-    Result := WSAEPROTONOSUPPORT;
-    case f of
-      AF_INET:
-        begin
-          if IP = cAnyHost then
-          begin
-            Sin.sin_family := AF_INET;
-            Result := 0;
-          end
-          else
-          begin
-            if lowercase(IP) = cLocalHostStr then
-              a4[1].s_addr := htonl(INADDR_LOOPBACK)
-            else
-            begin
-              a4[1].s_addr := 0;
-              Result := WSAHOST_NOT_FOUND;
-              a4[1] := StrTonetAddr(IP);
-              if a4[1].s_addr = INADDR_ANY then
-                Resolvename(ip, a4);
-            end;
-            if a4[1].s_addr <> INADDR_ANY then
-            begin
-              Sin.sin_family := AF_INET;
-              sin.sin_addr := a4[1];
-              Result := 0;
-            end;
-          end;
-        end;
-      AF_INET6:
-        begin
-          if IP = c6AnyHost then
-          begin
-            Sin.sin_family := AF_INET6;
-            Result := 0;
-          end
-          else
-          begin
-            if lowercase(IP) = cLocalHostStr then
-              SET_LOOPBACK_ADDR6(@a6[1])
-            else
-            begin
-              Result := WSAHOST_NOT_FOUND;
-              SET_IN6_IF_ADDR_ANY(@a6[1]);
-              a6[1] := StrTonetAddr6(IP);
-              if IN6_IS_ADDR_UNSPECIFIED(@a6[1]) then
-                Resolvename6(ip, a6);
-            end;
-            if IN6_IS_ADDR_UNSPECIFIED(@a6[1]) then
-            begin
-              Sin.sin_family := AF_INET6;
-              sin.sin6_addr := a6[1];
-              Result := 0;
-            end;
-          end;
-        end;
-    end;
-  end;
-begin
-  Result := 0;
-  FillChar(Sin, Sizeof(Sin), 0);
-  Sin.sin_port := Resolveport(port, family, SockProtocol, SockType);
-  TwoPass := False;
-  if Family = AF_UNSPEC then
-  begin
-    if PreferIP4 then
-    begin
-      f1 := AF_INET;
-      f2 := AF_INET6;
-      TwoPass := True;
-    end
-    else
-    begin
-      f2 := AF_INET;
-      f1 := AF_INET6;
-      TwoPass := True;
-    end;
-  end
-  else
-    f1 := Family;
-  Result := GetAddr(f1);
-  if Result <> 0 then
-    if TwoPass then
-      Result := GetAddr(f2);
-end;
-
-function GetSinIP(Sin: TVarSin): string;
-begin
-  Result := '';
-  case sin.AddressFamily of
-    AF_INET:
-      begin
-        result := NetAddrToStr(sin.sin_addr);
-      end;
-    AF_INET6:
-      begin
-        result := NetAddrToStr6(sin.sin6_addr);
-      end;
-  end;
-end;
-
-function GetSinPort(Sin: TVarSin): Integer;
-begin
-  if (Sin.sin_family = AF_INET6) then
-    Result := synsock.ntohs(Sin.sin6_port)
-  else
-    Result := synsock.ntohs(Sin.sin_port);
-end;
-
-procedure ResolveNameToIP(Name: string; Family, SockProtocol, SockType: integer; const IPList: TStrings);
-var
-  x, n: integer;
-  a4: array [1..255] of in_addr;
-  a6: array [1..255] of Tin6_addr;
-begin
-  IPList.Clear;
-  if (family = AF_INET) or (family = AF_UNSPEC) then
-  begin
-    if lowercase(name) = cLocalHostStr then
-      IpList.Add(cLocalHost)
-    else
-    begin
-      a4[1] := StrTonetAddr(name);
-      if a4[1].s_addr = INADDR_ANY then
-        x := Resolvename(name, a4)
-      else
-        x := 1;
-      for n := 1  to x do
-        IpList.Add(netaddrToStr(a4[n]));
-    end;
-  end;
-
-  if (family = AF_INET6) or (family = AF_UNSPEC) then
-  begin
-    if lowercase(name) = cLocalHostStr then
-      IpList.Add(c6LocalHost)
-    else
-    begin
-      a6[1] := StrTonetAddr6(name);
-      if IN6_IS_ADDR_UNSPECIFIED(@a6[1]) then
-        x := Resolvename6(name, a6)
-      else
-        x := 1;
-      for n := 1  to x do
-        IpList.Add(netaddrToStr6(a6[n]));
-    end;
-  end;
-
-  if IPList.Count = 0 then
-    IPList.Add(cLocalHost);
-end;
-
-function ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word;
-var
-  ProtoEnt: TProtocolEntry;
-  ServEnt: TServiceEntry;
-begin
-  Result := synsock.htons(StrToIntDef(Port, 0));
-  if Result = 0 then
-  begin
-    ProtoEnt.Name := '';
-    GetProtocolByNumber(SockProtocol, ProtoEnt);
-    ServEnt.port := 0;
-    GetServiceByName(Port, ProtoEnt.Name, ServEnt);
-    Result := ServEnt.port;  
-  end;
-end;
-
-function ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): string;
-var
-  n: integer;
-  a4: array [1..1] of in_addr;
-  a6: array [1..1] of Tin6_addr;
-  a: array [1..1] of string;
-begin
-  Result := IP;
-  a4[1] := StrToNetAddr(IP);
-  if a4[1].s_addr <> INADDR_ANY then
-  begin
-//why ResolveAddress need address in HOST order? :-O 
-    n := ResolveAddress(nettohost(a4[1]), a);
-    if n > 0 then
-      Result := a[1];
-  end
-  else
-  begin
-    a6[1] := StrToNetAddr6(IP);
-    n := ResolveAddress6(a6[1], a);
-    if n > 0 then
-      Result := a[1];
-  end;
-end;
-
-{=============================================================================}
-
-function InitSocketInterface(stack: string): Boolean;
-begin
-  SockEnhancedApi := False;
-  SockWship6Api := False;
-//  Libc.Signal(Libc.SIGPIPE, TSignalHandler(Libc.SIG_IGN));
-  Result := True;
-end;
-
-function DestroySocketInterface: Boolean;
-begin
-  Result := True;
-end;
-
-initialization
-begin
-  SynSockCS := SyncObjs.TCriticalSection.Create;
-  SET_IN6_IF_ADDR_ANY (@in6addr_any);
-  SET_LOOPBACK_ADDR6  (@in6addr_loopback);
-end;
-
-finalization
-begin
-  SynSockCS.Free;
-end;
-
-{$ENDIF}
-
+{==============================================================================|
+| Project : Ararat Synapse                                       | 001.001.001 |
+|==============================================================================|
+| Content: Socket Independent Platform Layer - FreePascal definition include   |
+|==============================================================================|
+| Copyright (c)2006-2010, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2006-2010.                |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@exclude}
+
+{$IFDEF FPC}
+{For FreePascal 2.x.x}
+
+//{$DEFINE FORCEOLDAPI}
+{Note about define FORCEOLDAPI:
+If you activate this compiler directive, then is allways used old socket API
+for name resolution. If you leave this directive inactive, then the new API
+is used, when running system allows it.
+
+For IPv6 support you must have new API!
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+{$ifdef FreeBSD}
+{$DEFINE SOCK_HAS_SINLEN}               // BSD definition of scoketaddr
+{$endif}
+{$ifdef darwin}
+{$DEFINE SOCK_HAS_SINLEN}               // BSD definition of scoketaddr
+{$endif}
+
+interface
+
+uses
+  SyncObjs, SysUtils, Classes,
+  synafpc, BaseUnix, Unix, termio, sockets, netdb;
+
+function InitSocketInterface(stack: string): Boolean;
+function DestroySocketInterface: Boolean;
+
+const
+  DLLStackName = '';
+  WinsockLevel = $0202;
+
+  cLocalHost = '127.0.0.1';
+  cAnyHost = '0.0.0.0';
+  c6AnyHost = '::0';
+  c6Localhost = '::1';
+  cLocalHostStr = 'localhost';
+
+type
+  TSocket = longint;
+  TAddrFamily = integer;
+
+  TMemory = pointer;
+
+
+type
+  TFDSet = Baseunix.TFDSet;
+  PFDSet = ^TFDSet;
+  Ptimeval = Baseunix.ptimeval;
+  Ttimeval = Baseunix.ttimeval;
+
+const
+  FIONREAD        = termio.FIONREAD;
+  FIONBIO         = termio.FIONBIO;
+  FIOASYNC        = termio.FIOASYNC;
+
+const
+  IPPROTO_IP     =   0;		{ Dummy					}
+  IPPROTO_ICMP   =   1;		{ Internet Control Message Protocol }
+  IPPROTO_IGMP   =   2;		{ Internet Group Management Protocol}
+  IPPROTO_TCP    =   6;		{ TCP           			}
+  IPPROTO_UDP    =   17;	{ User Datagram Protocol		}
+  IPPROTO_IPV6   =   41;
+  IPPROTO_ICMPV6 =   58;
+  IPPROTO_RM     =  113;
+
+  IPPROTO_RAW    =   255;
+  IPPROTO_MAX    =   256;
+
+type
+  PInAddr = ^TInAddr;
+  TInAddr = sockets.in_addr;
+
+  PSockAddrIn = ^TSockAddrIn;
+  TSockAddrIn = sockets.TInetSockAddr;
+
+
+  TIP_mreq =  record
+    imr_multiaddr: TInAddr;     // IP multicast address of group
+    imr_interface: TInAddr;     // local IP address of interface
+  end;
+
+
+  PInAddr6 = ^TInAddr6;
+  TInAddr6 = sockets.Tin6_addr;
+
+  PSockAddrIn6 = ^TSockAddrIn6;
+  TSockAddrIn6 = sockets.TInetSockAddr6;
+
+
+  TIPv6_mreq = record
+    ipv6mr_multiaddr: TInAddr6; // IPv6 multicast address.
+    ipv6mr_interface: integer;   // Interface index.
+  end;
+
+const
+  INADDR_ANY       = $00000000;
+  INADDR_LOOPBACK  = $7F000001;
+  INADDR_BROADCAST = $FFFFFFFF;
+  INADDR_NONE      = $FFFFFFFF;
+  ADDR_ANY		 = INADDR_ANY;
+  INVALID_SOCKET		= TSocket(NOT(0));
+  SOCKET_ERROR			= -1;
+
+Const
+  IP_TOS             = sockets.IP_TOS;             { int; IP type of service and precedence.  }
+  IP_TTL             = sockets.IP_TTL;             { int; IP time to live.  }
+  IP_HDRINCL         = sockets.IP_HDRINCL;         { int; Header is included with data.  }
+  IP_OPTIONS         = sockets.IP_OPTIONS;         { ip_opts; IP per-packet options.  }
+//  IP_ROUTER_ALERT    = sockets.IP_ROUTER_ALERT;    { bool }
+  IP_RECVOPTS        = sockets.IP_RECVOPTS;        { bool }
+  IP_RETOPTS         = sockets.IP_RETOPTS;         { bool }
+//  IP_PKTINFO         = sockets.IP_PKTINFO;         { bool }
+//  IP_PKTOPTIONS      = sockets.IP_PKTOPTIONS;
+//  IP_PMTUDISC        = sockets.IP_PMTUDISC;        { obsolete name? }
+//  IP_MTU_DISCOVER    = sockets.IP_MTU_DISCOVER;    { int; see below }
+//  IP_RECVERR         = sockets.IP_RECVERR;         { bool }
+//  IP_RECVTTL         = sockets.IP_RECVTTL;         { bool }
+//  IP_RECVTOS         = sockets.IP_RECVTOS;         { bool }
+  IP_MULTICAST_IF    = sockets.IP_MULTICAST_IF;    { in_addr; set/get IP multicast i/f }
+  IP_MULTICAST_TTL   = sockets.IP_MULTICAST_TTL;   { u_char; set/get IP multicast ttl }
+  IP_MULTICAST_LOOP  = sockets.IP_MULTICAST_LOOP;  { i_char; set/get IP multicast loopback }
+  IP_ADD_MEMBERSHIP  = sockets.IP_ADD_MEMBERSHIP;  { ip_mreq; add an IP group membership }
+  IP_DROP_MEMBERSHIP = sockets.IP_DROP_MEMBERSHIP; { ip_mreq; drop an IP group membership }
+
+  SOL_SOCKET    = sockets.SOL_SOCKET;
+
+  SO_DEBUG      = sockets.SO_DEBUG;
+  SO_REUSEADDR  = sockets.SO_REUSEADDR;
+  SO_TYPE       = sockets.SO_TYPE;
+  SO_ERROR      = sockets.SO_ERROR;
+  SO_DONTROUTE  = sockets.SO_DONTROUTE;
+  SO_BROADCAST  = sockets.SO_BROADCAST;
+  SO_SNDBUF     = sockets.SO_SNDBUF;
+  SO_RCVBUF     = sockets.SO_RCVBUF;
+  SO_KEEPALIVE  = sockets.SO_KEEPALIVE;
+  SO_OOBINLINE  = sockets.SO_OOBINLINE;
+//  SO_NO_CHECK   = sockets.SO_NO_CHECK;
+//  SO_PRIORITY   = sockets.SO_PRIORITY;
+  SO_LINGER     = sockets.SO_LINGER;
+//  SO_BSDCOMPAT  = sockets.SO_BSDCOMPAT;
+//  SO_REUSEPORT  = sockets.SO_REUSEPORT;
+//  SO_PASSCRED   = sockets.SO_PASSCRED;
+//  SO_PEERCRED   = sockets.SO_PEERCRED;
+  SO_RCVLOWAT   = sockets.SO_RCVLOWAT;
+  SO_SNDLOWAT   = sockets.SO_SNDLOWAT;
+  SO_RCVTIMEO   = sockets.SO_RCVTIMEO;
+  SO_SNDTIMEO   = sockets.SO_SNDTIMEO;
+{ Security levels - as per NRL IPv6 - don't actually do anything }
+//  SO_SECURITY_AUTHENTICATION       = sockets.SO_SECURITY_AUTHENTICATION;
+//  SO_SECURITY_ENCRYPTION_TRANSPORT = sockets.SO_SECURITY_ENCRYPTION_TRANSPORT;
+//  SO_SECURITY_ENCRYPTION_NETWORK   = sockets.SO_SECURITY_ENCRYPTION_NETWORK;
+//  SO_BINDTODEVICE                  = sockets.SO_BINDTODEVICE;
+{ Socket filtering }
+//  SO_ATTACH_FILTER = sockets.SO_ATTACH_FILTER;
+//  SO_DETACH_FILTER = sockets.SO_DETACH_FILTER;
+
+  SOMAXCONN       = 1024;
+
+  IPV6_UNICAST_HOPS     = sockets.IPV6_UNICAST_HOPS;
+  IPV6_MULTICAST_IF     = sockets.IPV6_MULTICAST_IF;
+  IPV6_MULTICAST_HOPS   = sockets.IPV6_MULTICAST_HOPS;
+  IPV6_MULTICAST_LOOP   = sockets.IPV6_MULTICAST_LOOP;
+  IPV6_JOIN_GROUP       = sockets.IPV6_JOIN_GROUP;
+  IPV6_LEAVE_GROUP      = sockets.IPV6_LEAVE_GROUP;
+
+const
+  SOCK_STREAM     = 1;               { stream socket }
+  SOCK_DGRAM      = 2;               { datagram socket }
+  SOCK_RAW        = 3;               { raw-protocol interface }
+  SOCK_RDM        = 4;               { reliably-delivered message }
+  SOCK_SEQPACKET  = 5;               { sequenced packet stream }
+
+{ TCP options. }
+  TCP_NODELAY     = $0001;
+
+{ Address families. }
+
+  AF_UNSPEC       = 0;               { unspecified }
+  AF_INET         = 2;               { internetwork: UDP, TCP, etc. }
+  AF_INET6        = 10;              { Internetwork Version 6 }
+  AF_MAX          = 24;
+
+{ Protocol families, same as address families for now. }
+  PF_UNSPEC       = AF_UNSPEC;
+  PF_INET         = AF_INET;
+  PF_INET6        = AF_INET6;
+  PF_MAX          = AF_MAX;
+
+type
+{ Structure used for manipulating linger option. }
+  PLinger = ^TLinger;
+  TLinger = packed record
+    l_onoff: integer;
+    l_linger: integer;
+  end;
+
+const
+
+  MSG_OOB       = sockets.MSG_OOB;      // Process out-of-band data.
+  MSG_PEEK      = sockets.MSG_PEEK;     // Peek at incoming messages.
+  MSG_NOSIGNAL  = sockets.MSG_NOSIGNAL; // Do not generate SIGPIPE.
+
+const
+  WSAEINTR = ESysEINTR;
+  WSAEBADF = ESysEBADF;
+  WSAEACCES = ESysEACCES;
+  WSAEFAULT = ESysEFAULT;
+  WSAEINVAL = ESysEINVAL;
+  WSAEMFILE = ESysEMFILE;
+  WSAEWOULDBLOCK = ESysEWOULDBLOCK;
+  WSAEINPROGRESS = ESysEINPROGRESS;
+  WSAEALREADY = ESysEALREADY;
+  WSAENOTSOCK = ESysENOTSOCK;
+  WSAEDESTADDRREQ = ESysEDESTADDRREQ;
+  WSAEMSGSIZE = ESysEMSGSIZE;
+  WSAEPROTOTYPE = ESysEPROTOTYPE;
+  WSAENOPROTOOPT = ESysENOPROTOOPT;
+  WSAEPROTONOSUPPORT = ESysEPROTONOSUPPORT;
+  WSAESOCKTNOSUPPORT = ESysESOCKTNOSUPPORT;
+  WSAEOPNOTSUPP = ESysEOPNOTSUPP;
+  WSAEPFNOSUPPORT = ESysEPFNOSUPPORT;
+  WSAEAFNOSUPPORT = ESysEAFNOSUPPORT;
+  WSAEADDRINUSE = ESysEADDRINUSE;
+  WSAEADDRNOTAVAIL = ESysEADDRNOTAVAIL;
+  WSAENETDOWN = ESysENETDOWN;
+  WSAENETUNREACH = ESysENETUNREACH;
+  WSAENETRESET = ESysENETRESET;
+  WSAECONNABORTED = ESysECONNABORTED;
+  WSAECONNRESET = ESysECONNRESET;
+  WSAENOBUFS = ESysENOBUFS;
+  WSAEISCONN = ESysEISCONN;
+  WSAENOTCONN = ESysENOTCONN;
+  WSAESHUTDOWN = ESysESHUTDOWN;
+  WSAETOOMANYREFS = ESysETOOMANYREFS;
+  WSAETIMEDOUT = ESysETIMEDOUT;
+  WSAECONNREFUSED = ESysECONNREFUSED;
+  WSAELOOP = ESysELOOP;
+  WSAENAMETOOLONG = ESysENAMETOOLONG;
+  WSAEHOSTDOWN = ESysEHOSTDOWN;
+  WSAEHOSTUNREACH = ESysEHOSTUNREACH;
+  WSAENOTEMPTY = ESysENOTEMPTY;
+  WSAEPROCLIM = -1;
+  WSAEUSERS = ESysEUSERS;
+  WSAEDQUOT = ESysEDQUOT;
+  WSAESTALE = ESysESTALE;
+  WSAEREMOTE = ESysEREMOTE;
+  WSASYSNOTREADY = -2;
+  WSAVERNOTSUPPORTED = -3;
+  WSANOTINITIALISED = -4;
+  WSAEDISCON = -5;
+  WSAHOST_NOT_FOUND = 1;
+  WSATRY_AGAIN = 2;
+  WSANO_RECOVERY = 3;
+  WSANO_DATA = -6;
+
+const
+  WSADESCRIPTION_LEN     =   256;
+  WSASYS_STATUS_LEN      =   128;
+type
+  PWSAData = ^TWSAData;
+  TWSAData = packed record
+    wVersion: Word;
+    wHighVersion: Word;
+    szDescription: array[0..WSADESCRIPTION_LEN] of Char;
+    szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char;
+    iMaxSockets: Word;
+    iMaxUdpDg: Word;
+    lpVendorInfo: PChar;
+  end;
+
+  function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
+  function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
+  function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
+  function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
+  function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
+  function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6):boolean;
+  procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
+  procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
+
+var
+  in6addr_any, in6addr_loopback : TInAddr6;
+
+procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet);
+function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean;
+procedure FD_SET(Socket: TSocket; var FDSet: TFDSet);
+procedure FD_ZERO(var FDSet: TFDSet);
+
+{=============================================================================}
+
+var
+  SynSockCS: SyncObjs.TCriticalSection;
+  SockEnhancedApi: Boolean;
+  SockWship6Api: Boolean;
+
+type
+  TVarSin = packed record
+  {$ifdef SOCK_HAS_SINLEN}
+     sin_len     : cuchar;
+  {$endif}
+    case integer of
+      0: (AddressFamily: sa_family_t);
+      1: (
+        case sin_family: sa_family_t of
+          AF_INET: (sin_port: word;
+                    sin_addr: TInAddr;
+                    sin_zero: array[0..7] of Char);
+          AF_INET6: (sin6_port:     word;
+                		sin6_flowinfo: longword;
+      	    	      sin6_addr:     TInAddr6;
+      		          sin6_scope_id: longword);
+          );
+  end;
+
+function SizeOfVarSin(sin: TVarSin): integer;
+
+  function WSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer;
+  function WSACleanup: Integer;
+  function WSAGetLastError: Integer;
+  function GetHostName: string;
+  function Shutdown(s: TSocket; how: Integer): Integer;
+  function SetSockOpt(s: TSocket; level, optname: Integer; optval: TMemory;
+    optlen: Integer): Integer;
+  function GetSockOpt(s: TSocket; level, optname: Integer; optval: TMemory;
+    var optlen: Integer): Integer;
+  function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+  function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+  function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
+  function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
+  function ntohs(netshort: word): word;
+  function ntohl(netlong: longword): longword;
+  function Listen(s: TSocket; backlog: Integer): Integer;
+  function IoctlSocket(s: TSocket; cmd: DWORD; var arg: integer): Integer;
+  function htons(hostshort: word): word;
+  function htonl(hostlong: longword): longword;
+  function GetSockName(s: TSocket; var name: TVarSin): Integer;
+  function GetPeerName(s: TSocket; var name: TVarSin): Integer;
+  function Connect(s: TSocket; const name: TVarSin): Integer;
+  function CloseSocket(s: TSocket): Integer;
+  function Bind(s: TSocket; const addr: TVarSin): Integer;
+  function Accept(s: TSocket; var addr: TVarSin): TSocket;
+  function Socket(af, Struc, Protocol: Integer): TSocket;
+  function Select(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
+    timeout: PTimeVal): Longint;
+
+function IsNewApi(Family: integer): Boolean;
+function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+function GetSinIP(Sin: TVarSin): string;
+function GetSinPort(Sin: TVarSin): Integer;
+procedure ResolveNameToIP(Name: string;  Family, SockProtocol, SockType: integer; const IPList: TStrings);
+function ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): string;
+function ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word;
+
+
+{==============================================================================}
+implementation
+
+
+function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
+begin
+  Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
+             (a^.u6_addr32[2] = 0) and (a^.u6_addr32[3] = 0));
+end;
+
+function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
+begin
+  Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
+             (a^.u6_addr32[2] = 0) and
+             (a^.u6_addr8[12] = 0) and (a^.u6_addr8[13] = 0) and
+             (a^.u6_addr8[14] = 0) and (a^.u6_addr8[15] = 1));
+end;
+
+function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
+begin
+  Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $80));
+end;
+
+function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
+begin
+  Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $C0));
+end;
+
+function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
+begin
+  Result := (a^.u6_addr8[0] = $FF);
+end;
+
+function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6): boolean;
+begin
+  Result := (CompareMem( a, b, sizeof(TInAddr6)));
+end;
+
+procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
+begin
+  FillChar(a^, sizeof(TInAddr6), 0);
+end;
+
+procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
+begin
+  FillChar(a^, sizeof(TInAddr6), 0);
+  a^.u6_addr8[15] := 1;
+end;
+
+{=============================================================================}
+
+function WSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer;
+begin
+  with WSData do
+  begin
+    wVersion := wVersionRequired;
+    wHighVersion := $202;
+    szDescription := 'Synsock - Synapse Platform Independent Socket Layer';
+    szSystemStatus := 'Running on Unix/Linux by FreePascal';
+    iMaxSockets := 32768;
+    iMaxUdpDg := 8192;
+  end;
+  Result := 0;
+end;
+
+function WSACleanup: Integer;
+begin
+  Result := 0;
+end;
+
+function WSAGetLastError: Integer;
+begin
+  Result := fpGetErrno; 
+end;
+
+function FD_ISSET(Socket: TSocket; var fdset: TFDSet): Boolean;
+begin
+  Result := fpFD_ISSET(socket, fdset) <> 0;
+end;
+
+procedure FD_SET(Socket: TSocket; var fdset: TFDSet);
+begin
+  fpFD_SET(Socket, fdset);
+end;
+
+procedure FD_CLR(Socket: TSocket; var fdset: TFDSet);
+begin
+  fpFD_CLR(Socket, fdset);
+end;
+
+procedure FD_ZERO(var fdset: TFDSet);
+begin
+  fpFD_ZERO(fdset);
+end;
+
+{=============================================================================}
+
+function SizeOfVarSin(sin: TVarSin): integer;
+begin
+  case sin.sin_family of
+    AF_INET:
+            Result := SizeOf(TSockAddrIn);
+    AF_INET6:
+            Result := SizeOf(TSockAddrIn6);
+  else
+    Result := 0;
+  end;
+end;
+
+{=============================================================================}
+
+function Bind(s: TSocket; const addr: TVarSin): Integer;
+begin
+  if fpBind(s, @addr, SizeOfVarSin(addr)) = 0 then
+    Result := 0
+  else
+    Result := SOCKET_ERROR;
+end;
+
+function Connect(s: TSocket; const name: TVarSin): Integer;
+begin
+  if fpConnect(s, @name, SizeOfVarSin(name)) = 0 then
+    Result := 0
+  else
+    Result := SOCKET_ERROR;
+end;
+
+function GetSockName(s: TSocket; var name: TVarSin): Integer;
+var
+  len: integer;
+begin
+  len := SizeOf(name);
+  FillChar(name, len, 0);
+  Result := fpGetSockName(s, @name, @Len);
+end;
+
+function GetPeerName(s: TSocket; var name: TVarSin): Integer;
+var
+  len: integer;
+begin
+  len := SizeOf(name);
+  FillChar(name, len, 0);
+  Result := fpGetPeerName(s, @name, @Len);
+end;
+
+function GetHostName: string;
+begin
+  Result := unix.GetHostName;
+end;
+
+function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+begin
+  Result := fpSend(s, pointer(Buf), len, flags);
+end;
+
+function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+begin
+  Result := fpRecv(s, pointer(Buf), len, flags);
+end;
+
+function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
+begin
+  Result := fpSendTo(s, pointer(Buf), len, flags, @addrto, SizeOfVarSin(addrto));
+end;
+
+function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
+var
+  x: integer;
+begin
+  x := SizeOf(from);
+  Result := fpRecvFrom(s, pointer(Buf), len, flags, @from, @x);
+end;
+
+function Accept(s: TSocket; var addr: TVarSin): TSocket;
+var
+  x: integer;
+begin
+  x := SizeOf(addr);
+  Result := fpAccept(s, @addr, @x);
+end;
+
+function Shutdown(s: TSocket; how: Integer): Integer;
+begin
+  Result := fpShutdown(s, how);
+end;
+
+function SetSockOpt(s: TSocket; level, optname: Integer; optval: Tmemory;
+  optlen: Integer): Integer;
+begin
+  Result := fpsetsockopt(s, level, optname, pointer(optval), optlen);
+end;
+
+function GetSockOpt(s: TSocket; level, optname: Integer; optval: Tmemory;
+  var optlen: Integer): Integer;
+begin
+  Result := fpgetsockopt(s, level, optname, pointer(optval), @optlen);
+end;
+
+function  ntohs(netshort: word): word;
+begin
+  Result := sockets.ntohs(NetShort);
+end;
+
+function  ntohl(netlong: longword): longword;
+begin
+  Result := sockets.ntohl(NetLong);
+end;
+
+function  Listen(s: TSocket; backlog: Integer): Integer;
+begin
+  if fpListen(s, backlog) = 0 then
+    Result := 0
+  else
+    Result := SOCKET_ERROR;
+end;
+
+function  IoctlSocket(s: TSocket; cmd: DWORD; var arg: integer): Integer;
+begin
+  Result := fpIoctl(s, cmd, @arg);
+end;
+
+function  htons(hostshort: word): word;
+begin
+  Result := sockets.htons(Hostshort);
+end;
+
+function  htonl(hostlong: longword): longword;
+begin
+  Result := sockets.htonl(HostLong);
+end;
+
+function CloseSocket(s: TSocket): Integer;
+begin
+  Result := sockets.CloseSocket(s);
+end;
+
+function Socket(af, Struc, Protocol: Integer): TSocket;
+begin
+  Result := fpSocket(af, struc, protocol);
+end;
+
+function Select(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
+  timeout: PTimeVal): Longint;
+begin
+  Result := fpSelect(nfds, readfds, writefds, exceptfds, timeout);
+end;
+
+{=============================================================================}
+function IsNewApi(Family: integer): Boolean;
+begin
+  Result := SockEnhancedApi;
+  if not Result then
+    Result := (Family = AF_INET6) and SockWship6Api;
+end;
+
+function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+var
+  TwoPass: boolean;
+  f1, f2: integer;
+
+  function GetAddr(f:integer): integer;
+  var
+    a4: array [1..1] of in_addr;
+    a6: array [1..1] of Tin6_addr;
+  begin
+    Result := WSAEPROTONOSUPPORT;
+    case f of
+      AF_INET:
+        begin
+          if IP = cAnyHost then
+          begin
+            Sin.sin_family := AF_INET;
+            Result := 0;
+          end
+          else
+          begin
+            if lowercase(IP) = cLocalHostStr then
+              a4[1].s_addr := htonl(INADDR_LOOPBACK)
+            else
+            begin
+              a4[1].s_addr := 0;
+              Result := WSAHOST_NOT_FOUND;
+              a4[1] := StrTonetAddr(IP);
+              if a4[1].s_addr = INADDR_ANY then
+                Resolvename(ip, a4);
+            end;
+            if a4[1].s_addr <> INADDR_ANY then
+            begin
+              Sin.sin_family := AF_INET;
+              sin.sin_addr := a4[1];
+              Result := 0;
+            end;
+          end;
+        end;
+      AF_INET6:
+        begin
+          if IP = c6AnyHost then
+          begin
+            Sin.sin_family := AF_INET6;
+            Result := 0;
+          end
+          else
+          begin
+            if lowercase(IP) = cLocalHostStr then
+              SET_LOOPBACK_ADDR6(@a6[1])
+            else
+            begin
+              Result := WSAHOST_NOT_FOUND;
+              SET_IN6_IF_ADDR_ANY(@a6[1]);
+              a6[1] := StrTonetAddr6(IP);
+              if IN6_IS_ADDR_UNSPECIFIED(@a6[1]) then
+                Resolvename6(ip, a6);
+            end;
+            if IN6_IS_ADDR_UNSPECIFIED(@a6[1]) then
+            begin
+              Sin.sin_family := AF_INET6;
+              sin.sin6_addr := a6[1];
+              Result := 0;
+            end;
+          end;
+        end;
+    end;
+  end;
+begin
+  Result := 0;
+  FillChar(Sin, Sizeof(Sin), 0);
+  Sin.sin_port := Resolveport(port, family, SockProtocol, SockType);
+  TwoPass := False;
+  if Family = AF_UNSPEC then
+  begin
+    if PreferIP4 then
+    begin
+      f1 := AF_INET;
+      f2 := AF_INET6;
+      TwoPass := True;
+    end
+    else
+    begin
+      f2 := AF_INET;
+      f1 := AF_INET6;
+      TwoPass := True;
+    end;
+  end
+  else
+    f1 := Family;
+  Result := GetAddr(f1);
+  if Result <> 0 then
+    if TwoPass then
+      Result := GetAddr(f2);
+end;
+
+function GetSinIP(Sin: TVarSin): string;
+begin
+  Result := '';
+  case sin.AddressFamily of
+    AF_INET:
+      begin
+        result := NetAddrToStr(sin.sin_addr);
+      end;
+    AF_INET6:
+      begin
+        result := NetAddrToStr6(sin.sin6_addr);
+      end;
+  end;
+end;
+
+function GetSinPort(Sin: TVarSin): Integer;
+begin
+  if (Sin.sin_family = AF_INET6) then
+    Result := synsock.ntohs(Sin.sin6_port)
+  else
+    Result := synsock.ntohs(Sin.sin_port);
+end;
+
+procedure ResolveNameToIP(Name: string; Family, SockProtocol, SockType: integer; const IPList: TStrings);
+var
+  x, n: integer;
+  a4: array [1..255] of in_addr;
+  a6: array [1..255] of Tin6_addr;
+begin
+  IPList.Clear;
+  if (family = AF_INET) or (family = AF_UNSPEC) then
+  begin
+    if lowercase(name) = cLocalHostStr then
+      IpList.Add(cLocalHost)
+    else
+    begin
+      a4[1] := StrTonetAddr(name);
+      if a4[1].s_addr = INADDR_ANY then
+        x := Resolvename(name, a4)
+      else
+        x := 1;
+      for n := 1  to x do
+        IpList.Add(netaddrToStr(a4[n]));
+    end;
+  end;
+
+  if (family = AF_INET6) or (family = AF_UNSPEC) then
+  begin
+    if lowercase(name) = cLocalHostStr then
+      IpList.Add(c6LocalHost)
+    else
+    begin
+      a6[1] := StrTonetAddr6(name);
+      if IN6_IS_ADDR_UNSPECIFIED(@a6[1]) then
+        x := Resolvename6(name, a6)
+      else
+        x := 1;
+      for n := 1  to x do
+        IpList.Add(netaddrToStr6(a6[n]));
+    end;
+  end;
+
+  if IPList.Count = 0 then
+    IPList.Add(cLocalHost);
+end;
+
+function ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word;
+var
+  ProtoEnt: TProtocolEntry;
+  ServEnt: TServiceEntry;
+begin
+  Result := synsock.htons(StrToIntDef(Port, 0));
+  if Result = 0 then
+  begin
+    ProtoEnt.Name := '';
+    GetProtocolByNumber(SockProtocol, ProtoEnt);
+    ServEnt.port := 0;
+    GetServiceByName(Port, ProtoEnt.Name, ServEnt);
+    Result := ServEnt.port;  
+  end;
+end;
+
+function ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): string;
+var
+  n: integer;
+  a4: array [1..1] of in_addr;
+  a6: array [1..1] of Tin6_addr;
+  a: array [1..1] of string;
+begin
+  Result := IP;
+  a4[1] := StrToNetAddr(IP);
+  if a4[1].s_addr <> INADDR_ANY then
+  begin
+//why ResolveAddress need address in HOST order? :-O 
+    n := ResolveAddress(nettohost(a4[1]), a);
+    if n > 0 then
+      Result := a[1];
+  end
+  else
+  begin
+    a6[1] := StrToNetAddr6(IP);
+    n := ResolveAddress6(a6[1], a);
+    if n > 0 then
+      Result := a[1];
+  end;
+end;
+
+{=============================================================================}
+
+function InitSocketInterface(stack: string): Boolean;
+begin
+  SockEnhancedApi := False;
+  SockWship6Api := False;
+//  Libc.Signal(Libc.SIGPIPE, TSignalHandler(Libc.SIG_IGN));
+  Result := True;
+end;
+
+function DestroySocketInterface: Boolean;
+begin
+  Result := True;
+end;
+
+initialization
+begin
+  SynSockCS := SyncObjs.TCriticalSection.Create;
+  SET_IN6_IF_ADDR_ANY (@in6addr_any);
+  SET_LOOPBACK_ADDR6  (@in6addr_loopback);
+end;
+
+finalization
+begin
+  SynSockCS.Free;
+end;
+
+{$ENDIF}
+
diff --git a/Units/Synapse/ssl_cryptlib.pas b/Units/Synapse/ssl_cryptlib.pas
index 84dd4d8..f84ea96 100644
--- a/Units/Synapse/ssl_cryptlib.pas
+++ b/Units/Synapse/ssl_cryptlib.pas
@@ -1,569 +1,569 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 001.001.000 |
-|==============================================================================|
-| Content: SSL/SSH support by Peter Gutmann's CryptLib                         |
-|==============================================================================|
-| Copyright (c)1999-2005, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2005.                     |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{:@abstract(SSL/SSH plugin for CryptLib)
-
-This plugin requires cl32.dll at least version 3.2.0! It can be used on Win32
-and Linux. This library is staticly linked - when you compile your application
-with this plugin, you MUST distribute it with Cryptib library, otherwise you
-cannot run your application!
-
-It can work with keys and certificates stored as PKCS#15 only! It must be stored
-as disk file only, you cannot load them from memory! Each file can hold multiple
-keys and certificates. You must identify it by 'label' stored in
-@link(TSSLCryptLib.PrivateKeyLabel).
-
-If you need to use secure connection and authorize self by certificate
-(each SSL/TLS server or client with client authorization), then use
-@link(TCustomSSL.PrivateKeyFile), @link(TSSLCryptLib.PrivateKeyLabel) and
-@link(TCustomSSL.KeyPassword) properties.
-
-If you need to use server what verifying client certificates, then use
-@link(TCustomSSL.CertCAFile) as PKCS#15 file with public keyas of allowed clients. Clients
-with non-matching certificates will be rejected by cryptLib.
-
-This plugin is capable to create Ad-Hoc certificates. When you start SSL/TLS
-server without explicitly assigned key and certificate, then this plugin create
-Ad-Hoc key and certificate for each incomming connection by self. It slowdown
-accepting of new connections!
-
-You can use this plugin for SSHv2 connections too! You must explicitly set
-@link(TCustomSSL.SSLType) to value LT_SSHv2 and set @link(TCustomSSL.username)
-and @link(TCustomSSL.password). You can use special SSH channels too, see
-@link(TCustomSSL).
-}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$H+}
-
-unit ssl_cryptlib;
-
-interface
-
-uses
-  SysUtils,
-  blcksock, synsock, synautil, synacode,
-  cryptlib;
-
-type
-  {:@abstract(class implementing CryptLib SSL/SSH plugin.)
-   Instance of this class will be created for each @link(TTCPBlockSocket).
-   You not need to create instance of this class, all is done by Synapse itself!}
-  TSSLCryptLib = class(TCustomSSL)
-  protected
-    FCryptSession: CRYPT_SESSION;
-    FPrivateKeyLabel: string;
-    FDelCert: Boolean;
-    FReadBuffer: string;
-    function SSLCheck(Value: integer): Boolean;
-    function Init(server:Boolean): Boolean;
-    function DeInit: Boolean;
-    function Prepare(server:Boolean): Boolean;
-    function GetString(const cryptHandle: CRYPT_HANDLE; const attributeType: CRYPT_ATTRIBUTE_TYPE): string;
-    function CreateSelfSignedCert(Host: string): Boolean; override;
-    function PopAll: string;
-  public
-    {:See @inherited}
-    constructor Create(const Value: TTCPBlockSocket); override;
-    destructor Destroy; override;
-    {:See @inherited}
-    function LibVersion: String; override;
-    {:See @inherited}
-    function LibName: String; override;
-    {:See @inherited}
-    procedure Assign(const Value: TCustomSSL); override;
-    {:See @inherited and @link(ssl_cryptlib) for more details.}
-    function Connect: boolean; override;
-    {:See @inherited and @link(ssl_cryptlib) for more details.}
-    function Accept: boolean; override;
-    {:See @inherited}
-    function Shutdown: boolean; override;
-    {:See @inherited}
-    function BiShutdown: boolean; override;
-    {:See @inherited}
-    function SendBuffer(Buffer: TMemory; Len: Integer): Integer; override;
-    {:See @inherited}
-    function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; override;
-    {:See @inherited}
-    function WaitingData: Integer; override;
-    {:See @inherited}
-    function GetSSLVersion: string; override;
-    {:See @inherited}
-    function GetPeerSubject: string; override;
-    {:See @inherited}
-    function GetPeerIssuer: string; override;
-    {:See @inherited}
-    function GetPeerName: string; override;
-    {:See @inherited}
-    function GetPeerFingerprint: string; override;
-  published
-    {:name of certificate/key within PKCS#15 file. It can hold more then one
-     certificate/key and each certificate/key must have unique label within one file.}
-    property PrivateKeyLabel: string read FPrivateKeyLabel Write FPrivateKeyLabel;
-  end;
-
-implementation
-
-{==============================================================================}
-
-constructor TSSLCryptLib.Create(const Value: TTCPBlockSocket);
-begin
-  inherited Create(Value);
-  FcryptSession := CRYPT_SESSION(CRYPT_SESSION_NONE);
-  FPrivateKeyLabel := 'synapse';
-  FDelCert := false;
-end;
-
-destructor TSSLCryptLib.Destroy;
-begin
-  DeInit;
-  inherited Destroy;
-end;
-
-procedure TSSLCryptLib.Assign(const Value: TCustomSSL);
-begin
-  inherited Assign(Value);
-  if Value is TSSLCryptLib then
-  begin
-    FPrivateKeyLabel := TSSLCryptLib(Value).privatekeyLabel;
-  end;
-end;
-
-function TSSLCryptLib.GetString(const cryptHandle: CRYPT_HANDLE; const attributeType: CRYPT_ATTRIBUTE_TYPE): string;
-var
-  l: integer;
-begin
-  l := 0;
-  cryptGetAttributeString(cryptHandle, attributeType, nil, l);
-  setlength(Result, l);
-  cryptGetAttributeString(cryptHandle, attributeType, pointer(Result), l);
-  setlength(Result, l);
-end;
-
-function TSSLCryptLib.LibVersion: String;
-var
-  x: integer;
-begin
-  Result := GetString(CRYPT_UNUSED, CRYPT_OPTION_INFO_DESCRIPTION);
-  cryptGetAttribute(CRYPT_UNUSED, CRYPT_OPTION_INFO_MAJORVERSION, x);
-  Result := Result + ' v' + IntToStr(x);
-  cryptGetAttribute(CRYPT_UNUSED, CRYPT_OPTION_INFO_MINORVERSION, x);
-  Result := Result + '.' + IntToStr(x);
-  cryptGetAttribute(CRYPT_UNUSED, CRYPT_OPTION_INFO_STEPPING, x);
-  Result := Result + '.' + IntToStr(x);
-end;
-
-function TSSLCryptLib.LibName: String;
-begin
-  Result := 'ssl_cryptlib';
-end;
-
-function TSSLCryptLib.SSLCheck(Value: integer): Boolean;
-begin
-  Result := true;
-  FLastErrorDesc := '';
-  if Value = CRYPT_ERROR_COMPLETE then
-    Value := 0;
-  FLastError := Value;
-  if FLastError <> 0 then
-  begin
-    Result := False;
-    FLastErrorDesc := GetString(FCryptSession, CRYPT_ATTRIBUTE_INT_ERRORMESSAGE);
-  end;
-end;
-
-function TSSLCryptLib.CreateSelfSignedCert(Host: string): Boolean;
-var
-  privateKey: CRYPT_CONTEXT;
-  keyset: CRYPT_KEYSET;
-  cert: CRYPT_CERTIFICATE;
-  publicKey: CRYPT_CONTEXT;
-begin
-  Result := False;
-  if FPrivatekeyFile = '' then
-    FPrivatekeyFile := GetTempFile('', 'key');
-  cryptCreateContext(privateKey, CRYPT_UNUSED, CRYPT_ALGO_RSA);
-  cryptSetAttributeString(privateKey, CRYPT_CTXINFO_LABEL, Pointer(FPrivatekeyLabel),
-    Length(FPrivatekeyLabel));
-  cryptSetAttribute(privateKey, CRYPT_CTXINFO_KEYSIZE, 1024);
-  cryptGenerateKey(privateKey);
-  cryptKeysetOpen(keyset, CRYPT_UNUSED, CRYPT_KEYSET_FILE, PChar(FPrivatekeyFile), CRYPT_KEYOPT_CREATE);
-  FDelCert := True;
-  cryptAddPrivateKey(keyset, privateKey, PChar(FKeyPassword));
-  cryptCreateCert(cert, CRYPT_UNUSED, CRYPT_CERTTYPE_CERTIFICATE);
-  cryptSetAttribute(cert, CRYPT_CERTINFO_XYZZY, 1);
-  cryptGetPublicKey(keyset, publicKey, CRYPT_KEYID_NAME, PChar(FPrivatekeyLabel));
-  cryptSetAttribute(cert, CRYPT_CERTINFO_SUBJECTPUBLICKEYINFO, publicKey);
-  cryptSetAttributeString(cert, CRYPT_CERTINFO_COMMONNAME, Pointer(host), Length(host));
-  cryptSignCert(cert, privateKey);
-  cryptAddPublicKey(keyset, cert);
-  cryptKeysetClose(keyset);
-  cryptDestroyCert(cert);
-  cryptDestroyContext(privateKey);
-  cryptDestroyContext(publicKey);
-  Result := True;
-end;
-
-function TSSLCryptLib.PopAll: string;
-const
-  BufferMaxSize = 32768;
-var
-  Outbuffer: string;
-  WriteLen: integer;
-begin
-  Result := '';
-  repeat
-    setlength(outbuffer, BufferMaxSize);
-    Writelen := 0;
-    SSLCheck(CryptPopData(FCryptSession, @OutBuffer[1], BufferMaxSize, Writelen));
-    if FLastError <> 0 then
-      Break;
-    if WriteLen > 0 then
-    begin
-      setlength(outbuffer, WriteLen);
-      Result := Result + outbuffer;
-    end;
-  until WriteLen = 0;
-end;
-
-function TSSLCryptLib.Init(server:Boolean): Boolean;
-var
-  st: CRYPT_SESSION_TYPE;
-  keysetobj: CRYPT_KEYSET;
-  cryptContext: CRYPT_CONTEXT;
-  x: integer;
-begin
-  Result := False;
-  FLastErrorDesc := '';
-  FLastError := 0;
-  FDelCert := false;
-  FcryptSession := CRYPT_SESSION(CRYPT_SESSION_NONE);
-  if server then
-    case FSSLType of
-      LT_all, LT_SSLv3, LT_TLSv1, LT_TLSv1_1:
-        st := CRYPT_SESSION_SSL_SERVER;
-      LT_SSHv2:
-        st := CRYPT_SESSION_SSH_SERVER;
-    else
-      Exit;
-    end
-  else
-    case FSSLType of
-      LT_all, LT_SSLv3, LT_TLSv1, LT_TLSv1_1:
-        st := CRYPT_SESSION_SSL;
-      LT_SSHv2:
-        st := CRYPT_SESSION_SSH;
-    else
-      Exit;
-    end;
-  if not SSLCheck(cryptCreateSession(FcryptSession, CRYPT_UNUSED, st)) then
-    Exit;
-  x := -1;
-  case FSSLType of
-    LT_SSLv3:
-      x := 0;
-    LT_TLSv1:
-      x := 1;
-    LT_TLSv1_1:
-      x := 2;
-  end;
-  if x >= 0 then
-    if not SSLCheck(cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_VERSION, x)) then
-      Exit;
-  if FUsername <> '' then
-  begin
-    cryptSetAttributeString(FcryptSession, CRYPT_SESSINFO_USERNAME,
-      Pointer(FUsername), Length(FUsername));
-    cryptSetAttributeString(FcryptSession, CRYPT_SESSINFO_PASSWORD,
-      Pointer(FPassword), Length(FPassword));
-  end;
-  if FSSLType = LT_SSHv2 then
-    if FSSHChannelType <> '' then
-    begin
-      cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_SSH_CHANNEL, CRYPT_UNUSED);
-      cryptSetAttributeString(FCryptSession, CRYPT_SESSINFO_SSH_CHANNEL_TYPE,
-        Pointer(FSSHChannelType), Length(FSSHChannelType));
-      if FSSHChannelArg1 <> '' then
-        cryptSetAttributeString(FCryptSession, CRYPT_SESSINFO_SSH_CHANNEL_ARG1,
-          Pointer(FSSHChannelArg1), Length(FSSHChannelArg1));
-      if FSSHChannelArg2 <> '' then
-        cryptSetAttributeString(FCryptSession, CRYPT_SESSINFO_SSH_CHANNEL_ARG2,
-          Pointer(FSSHChannelArg2), Length(FSSHChannelArg2));
-    end;
-
-
-  if server and (FPrivatekeyFile = '') then
-  begin
-    if FPrivatekeyLabel = '' then
-      FPrivatekeyLabel := 'synapse';
-    if FkeyPassword = '' then
-      FkeyPassword := 'synapse';
-    CreateSelfSignedcert(FSocket.ResolveIPToName(FSocket.GetRemoteSinIP));
-  end;
-
-  if (FPrivatekeyLabel <> '') and (FPrivatekeyFile <> '') then
-  begin
-    if not SSLCheck(cryptKeysetOpen(KeySetObj, CRYPT_UNUSED, CRYPT_KEYSET_FILE,
-      PChar(FPrivatekeyFile), CRYPT_KEYOPT_READONLY)) then
-      Exit;
-    try
-    if not SSLCheck(cryptGetPrivateKey(KeySetObj, cryptcontext, CRYPT_KEYID_NAME,
-      PChar(FPrivatekeyLabel), PChar(FKeyPassword))) then
-      Exit;
-    if not SSLCheck(cryptSetAttribute(FcryptSession, CRYPT_SESSINFO_PRIVATEKEY,
-      cryptcontext)) then
-      Exit;
-    finally
-      cryptKeysetClose(keySetObj);
-      cryptDestroyContext(cryptcontext);
-    end;
-  end;
-  if server and FVerifyCert then
-  begin
-    if not SSLCheck(cryptKeysetOpen(KeySetObj, CRYPT_UNUSED, CRYPT_KEYSET_FILE,
-      PChar(FCertCAFile), CRYPT_KEYOPT_READONLY)) then
-      Exit;
-    try
-    if not SSLCheck(cryptSetAttribute(FcryptSession, CRYPT_SESSINFO_KEYSET,
-      keySetObj)) then
-      Exit;
-    finally
-      cryptKeysetClose(keySetObj);
-    end;
-  end;
-  Result := true;
-end;
-
-function TSSLCryptLib.DeInit: Boolean;
-begin
-  Result := True;
-  if FcryptSession <> CRYPT_SESSION(CRYPT_SESSION_NONE) then
-    CryptDestroySession(FcryptSession);
-  FcryptSession := CRYPT_SESSION(CRYPT_SESSION_NONE);
-  FSSLEnabled := False;
-  if FDelCert then
-    Deletefile(FPrivatekeyFile);
-end;
-
-function TSSLCryptLib.Prepare(server:Boolean): Boolean;
-begin
-  Result := false;
-  DeInit;
-  if Init(server) then
-    Result := true
-  else
-    DeInit;
-end;
-
-function TSSLCryptLib.Connect: boolean;
-begin
-  Result := False;
-  if FSocket.Socket = INVALID_SOCKET then
-    Exit;
-  if Prepare(false) then
-  begin
-    if not SSLCheck(cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_NETWORKSOCKET, FSocket.Socket)) then
-      Exit;
-    if not SSLCheck(cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_ACTIVE, 1)) then
-      Exit;
-    FSSLEnabled := True;
-    Result := True;
-    FReadBuffer := '';
-  end;
-end;
-
-function TSSLCryptLib.Accept: boolean;
-begin
-  Result := False;
-  if FSocket.Socket = INVALID_SOCKET then
-    Exit;
-  if Prepare(true) then
-  begin
-    if not SSLCheck(cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_NETWORKSOCKET, FSocket.Socket)) then
-      Exit;
-    if not SSLCheck(cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_ACTIVE, 1)) then
-      Exit;
-    FSSLEnabled := True;
-    Result := True;
-    FReadBuffer := '';
-  end;
-end;
-
-function TSSLCryptLib.Shutdown: boolean;
-begin
-  Result := BiShutdown;
-end;
-
-function TSSLCryptLib.BiShutdown: boolean;
-begin
-  if FcryptSession <> CRYPT_SESSION(CRYPT_SESSION_NONE) then
-    cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_ACTIVE, 0);
-  DeInit;
-  FReadBuffer := '';
-  Result := True;
-end;
-
-function TSSLCryptLib.SendBuffer(Buffer: TMemory; Len: Integer): Integer;
-var
-  l: integer;
-begin
-  FLastError := 0;
-  FLastErrorDesc := '';
-  SSLCheck(cryptPushData(FCryptSession, Buffer, Len, L));
-  cryptFlushData(FcryptSession);
-  Result := l;
-end;
-
-function TSSLCryptLib.RecvBuffer(Buffer: TMemory; Len: Integer): Integer;
-var
-  l: integer;
-begin
-  FLastError := 0;
-  FLastErrorDesc := '';
-  if Length(FReadBuffer) = 0 then
-    FReadBuffer := PopAll;
-  if Len > Length(FReadBuffer) then
-    Len := Length(FReadBuffer);
-  Move(Pointer(FReadBuffer)^, buffer^, Len);
-  Delete(FReadBuffer, 1, Len);
-  Result := Len;
-end;
-
-function TSSLCryptLib.WaitingData: Integer;
-begin
-  Result := Length(FReadBuffer);
-end;
-
-function TSSLCryptLib.GetSSLVersion: string;
-var
-  x: integer;
-begin
-  Result := '';
-  if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then
-    Exit;
-  cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_VERSION, x);
-  if FSSLType in [LT_SSLv3, LT_TLSv1, LT_TLSv1_1, LT_all] then
-    case x of
-      0:
-        Result := 'SSLv3';
-      1:
-        Result := 'TLSv1';
-      2:
-        Result := 'TLSv1.1';
-    end;
-  if FSSLType in [LT_SSHv2] then
-    case x of
-      0:
-        Result := 'SSHv1';
-      1:
-        Result := 'SSHv2';
-    end;
-end;
-
-function TSSLCryptLib.GetPeerSubject: string;
-var
-  cert: CRYPT_CERTIFICATE;
-begin
-  Result := '';
-  if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then
-    Exit;
-  cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_RESPONSE, cert);
-  cryptSetAttribute(cert, CRYPT_CERTINFO_SUBJECTNAME, CRYPT_UNUSED);
-  Result := GetString(cert, CRYPT_CERTINFO_DN);
-  cryptDestroyCert(cert);
-end;
-
-function TSSLCryptLib.GetPeerName: string;
-var
-  cert: CRYPT_CERTIFICATE;
-begin
-  Result := '';
-  if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then
-    Exit;
-  cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_RESPONSE, cert);
-  cryptSetAttribute(cert, CRYPT_CERTINFO_ISSUERNAME, CRYPT_UNUSED);
-  Result := GetString(cert, CRYPT_CERTINFO_COMMONNAME);
-  cryptDestroyCert(cert);
-end;
-
-function TSSLCryptLib.GetPeerIssuer: string;
-var
-  cert: CRYPT_CERTIFICATE;
-begin
-  Result := '';
-  if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then
-    Exit;
-  cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_RESPONSE, cert);
-  cryptSetAttribute(cert, CRYPT_CERTINFO_ISSUERNAME, CRYPT_UNUSED);
-  Result := GetString(cert, CRYPT_CERTINFO_DN);
-  cryptDestroyCert(cert);
-end;
-
-function TSSLCryptLib.GetPeerFingerprint: string;
-var
-  cert: CRYPT_CERTIFICATE;
-begin
-  Result := '';
-  if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then
-    Exit;
-  cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_RESPONSE, cert);
-  Result := GetString(cert, CRYPT_CERTINFO_FINGERPRINT);
-  Result := MD5(Result);
-  cryptDestroyCert(cert);
-end;
-
-{==============================================================================}
-
-initialization
-  if cryptInit = CRYPT_OK then
-    SSLImplementation := TSSLCryptLib;
-  cryptAddRandom(nil, CRYPT_RANDOM_SLOWPOLL);
-
-finalization
-  cryptEnd;
-
-end.
-
+{==============================================================================|
+| Project : Ararat Synapse                                       | 001.001.000 |
+|==============================================================================|
+| Content: SSL/SSH support by Peter Gutmann's CryptLib                         |
+|==============================================================================|
+| Copyright (c)1999-2005, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2005.                     |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@abstract(SSL/SSH plugin for CryptLib)
+
+This plugin requires cl32.dll at least version 3.2.0! It can be used on Win32
+and Linux. This library is staticly linked - when you compile your application
+with this plugin, you MUST distribute it with Cryptib library, otherwise you
+cannot run your application!
+
+It can work with keys and certificates stored as PKCS#15 only! It must be stored
+as disk file only, you cannot load them from memory! Each file can hold multiple
+keys and certificates. You must identify it by 'label' stored in
+@link(TSSLCryptLib.PrivateKeyLabel).
+
+If you need to use secure connection and authorize self by certificate
+(each SSL/TLS server or client with client authorization), then use
+@link(TCustomSSL.PrivateKeyFile), @link(TSSLCryptLib.PrivateKeyLabel) and
+@link(TCustomSSL.KeyPassword) properties.
+
+If you need to use server what verifying client certificates, then use
+@link(TCustomSSL.CertCAFile) as PKCS#15 file with public keyas of allowed clients. Clients
+with non-matching certificates will be rejected by cryptLib.
+
+This plugin is capable to create Ad-Hoc certificates. When you start SSL/TLS
+server without explicitly assigned key and certificate, then this plugin create
+Ad-Hoc key and certificate for each incomming connection by self. It slowdown
+accepting of new connections!
+
+You can use this plugin for SSHv2 connections too! You must explicitly set
+@link(TCustomSSL.SSLType) to value LT_SSHv2 and set @link(TCustomSSL.username)
+and @link(TCustomSSL.password). You can use special SSH channels too, see
+@link(TCustomSSL).
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+unit ssl_cryptlib;
+
+interface
+
+uses
+  SysUtils,
+  blcksock, synsock, synautil, synacode,
+  cryptlib;
+
+type
+  {:@abstract(class implementing CryptLib SSL/SSH plugin.)
+   Instance of this class will be created for each @link(TTCPBlockSocket).
+   You not need to create instance of this class, all is done by Synapse itself!}
+  TSSLCryptLib = class(TCustomSSL)
+  protected
+    FCryptSession: CRYPT_SESSION;
+    FPrivateKeyLabel: string;
+    FDelCert: Boolean;
+    FReadBuffer: string;
+    function SSLCheck(Value: integer): Boolean;
+    function Init(server:Boolean): Boolean;
+    function DeInit: Boolean;
+    function Prepare(server:Boolean): Boolean;
+    function GetString(const cryptHandle: CRYPT_HANDLE; const attributeType: CRYPT_ATTRIBUTE_TYPE): string;
+    function CreateSelfSignedCert(Host: string): Boolean; override;
+    function PopAll: string;
+  public
+    {:See @inherited}
+    constructor Create(const Value: TTCPBlockSocket); override;
+    destructor Destroy; override;
+    {:See @inherited}
+    function LibVersion: String; override;
+    {:See @inherited}
+    function LibName: String; override;
+    {:See @inherited}
+    procedure Assign(const Value: TCustomSSL); override;
+    {:See @inherited and @link(ssl_cryptlib) for more details.}
+    function Connect: boolean; override;
+    {:See @inherited and @link(ssl_cryptlib) for more details.}
+    function Accept: boolean; override;
+    {:See @inherited}
+    function Shutdown: boolean; override;
+    {:See @inherited}
+    function BiShutdown: boolean; override;
+    {:See @inherited}
+    function SendBuffer(Buffer: TMemory; Len: Integer): Integer; override;
+    {:See @inherited}
+    function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; override;
+    {:See @inherited}
+    function WaitingData: Integer; override;
+    {:See @inherited}
+    function GetSSLVersion: string; override;
+    {:See @inherited}
+    function GetPeerSubject: string; override;
+    {:See @inherited}
+    function GetPeerIssuer: string; override;
+    {:See @inherited}
+    function GetPeerName: string; override;
+    {:See @inherited}
+    function GetPeerFingerprint: string; override;
+  published
+    {:name of certificate/key within PKCS#15 file. It can hold more then one
+     certificate/key and each certificate/key must have unique label within one file.}
+    property PrivateKeyLabel: string read FPrivateKeyLabel Write FPrivateKeyLabel;
+  end;
+
+implementation
+
+{==============================================================================}
+
+constructor TSSLCryptLib.Create(const Value: TTCPBlockSocket);
+begin
+  inherited Create(Value);
+  FcryptSession := CRYPT_SESSION(CRYPT_SESSION_NONE);
+  FPrivateKeyLabel := 'synapse';
+  FDelCert := false;
+end;
+
+destructor TSSLCryptLib.Destroy;
+begin
+  DeInit;
+  inherited Destroy;
+end;
+
+procedure TSSLCryptLib.Assign(const Value: TCustomSSL);
+begin
+  inherited Assign(Value);
+  if Value is TSSLCryptLib then
+  begin
+    FPrivateKeyLabel := TSSLCryptLib(Value).privatekeyLabel;
+  end;
+end;
+
+function TSSLCryptLib.GetString(const cryptHandle: CRYPT_HANDLE; const attributeType: CRYPT_ATTRIBUTE_TYPE): string;
+var
+  l: integer;
+begin
+  l := 0;
+  cryptGetAttributeString(cryptHandle, attributeType, nil, l);
+  setlength(Result, l);
+  cryptGetAttributeString(cryptHandle, attributeType, pointer(Result), l);
+  setlength(Result, l);
+end;
+
+function TSSLCryptLib.LibVersion: String;
+var
+  x: integer;
+begin
+  Result := GetString(CRYPT_UNUSED, CRYPT_OPTION_INFO_DESCRIPTION);
+  cryptGetAttribute(CRYPT_UNUSED, CRYPT_OPTION_INFO_MAJORVERSION, x);
+  Result := Result + ' v' + IntToStr(x);
+  cryptGetAttribute(CRYPT_UNUSED, CRYPT_OPTION_INFO_MINORVERSION, x);
+  Result := Result + '.' + IntToStr(x);
+  cryptGetAttribute(CRYPT_UNUSED, CRYPT_OPTION_INFO_STEPPING, x);
+  Result := Result + '.' + IntToStr(x);
+end;
+
+function TSSLCryptLib.LibName: String;
+begin
+  Result := 'ssl_cryptlib';
+end;
+
+function TSSLCryptLib.SSLCheck(Value: integer): Boolean;
+begin
+  Result := true;
+  FLastErrorDesc := '';
+  if Value = CRYPT_ERROR_COMPLETE then
+    Value := 0;
+  FLastError := Value;
+  if FLastError <> 0 then
+  begin
+    Result := False;
+    FLastErrorDesc := GetString(FCryptSession, CRYPT_ATTRIBUTE_INT_ERRORMESSAGE);
+  end;
+end;
+
+function TSSLCryptLib.CreateSelfSignedCert(Host: string): Boolean;
+var
+  privateKey: CRYPT_CONTEXT;
+  keyset: CRYPT_KEYSET;
+  cert: CRYPT_CERTIFICATE;
+  publicKey: CRYPT_CONTEXT;
+begin
+  Result := False;
+  if FPrivatekeyFile = '' then
+    FPrivatekeyFile := GetTempFile('', 'key');
+  cryptCreateContext(privateKey, CRYPT_UNUSED, CRYPT_ALGO_RSA);
+  cryptSetAttributeString(privateKey, CRYPT_CTXINFO_LABEL, Pointer(FPrivatekeyLabel),
+    Length(FPrivatekeyLabel));
+  cryptSetAttribute(privateKey, CRYPT_CTXINFO_KEYSIZE, 1024);
+  cryptGenerateKey(privateKey);
+  cryptKeysetOpen(keyset, CRYPT_UNUSED, CRYPT_KEYSET_FILE, PChar(FPrivatekeyFile), CRYPT_KEYOPT_CREATE);
+  FDelCert := True;
+  cryptAddPrivateKey(keyset, privateKey, PChar(FKeyPassword));
+  cryptCreateCert(cert, CRYPT_UNUSED, CRYPT_CERTTYPE_CERTIFICATE);
+  cryptSetAttribute(cert, CRYPT_CERTINFO_XYZZY, 1);
+  cryptGetPublicKey(keyset, publicKey, CRYPT_KEYID_NAME, PChar(FPrivatekeyLabel));
+  cryptSetAttribute(cert, CRYPT_CERTINFO_SUBJECTPUBLICKEYINFO, publicKey);
+  cryptSetAttributeString(cert, CRYPT_CERTINFO_COMMONNAME, Pointer(host), Length(host));
+  cryptSignCert(cert, privateKey);
+  cryptAddPublicKey(keyset, cert);
+  cryptKeysetClose(keyset);
+  cryptDestroyCert(cert);
+  cryptDestroyContext(privateKey);
+  cryptDestroyContext(publicKey);
+  Result := True;
+end;
+
+function TSSLCryptLib.PopAll: string;
+const
+  BufferMaxSize = 32768;
+var
+  Outbuffer: string;
+  WriteLen: integer;
+begin
+  Result := '';
+  repeat
+    setlength(outbuffer, BufferMaxSize);
+    Writelen := 0;
+    SSLCheck(CryptPopData(FCryptSession, @OutBuffer[1], BufferMaxSize, Writelen));
+    if FLastError <> 0 then
+      Break;
+    if WriteLen > 0 then
+    begin
+      setlength(outbuffer, WriteLen);
+      Result := Result + outbuffer;
+    end;
+  until WriteLen = 0;
+end;
+
+function TSSLCryptLib.Init(server:Boolean): Boolean;
+var
+  st: CRYPT_SESSION_TYPE;
+  keysetobj: CRYPT_KEYSET;
+  cryptContext: CRYPT_CONTEXT;
+  x: integer;
+begin
+  Result := False;
+  FLastErrorDesc := '';
+  FLastError := 0;
+  FDelCert := false;
+  FcryptSession := CRYPT_SESSION(CRYPT_SESSION_NONE);
+  if server then
+    case FSSLType of
+      LT_all, LT_SSLv3, LT_TLSv1, LT_TLSv1_1:
+        st := CRYPT_SESSION_SSL_SERVER;
+      LT_SSHv2:
+        st := CRYPT_SESSION_SSH_SERVER;
+    else
+      Exit;
+    end
+  else
+    case FSSLType of
+      LT_all, LT_SSLv3, LT_TLSv1, LT_TLSv1_1:
+        st := CRYPT_SESSION_SSL;
+      LT_SSHv2:
+        st := CRYPT_SESSION_SSH;
+    else
+      Exit;
+    end;
+  if not SSLCheck(cryptCreateSession(FcryptSession, CRYPT_UNUSED, st)) then
+    Exit;
+  x := -1;
+  case FSSLType of
+    LT_SSLv3:
+      x := 0;
+    LT_TLSv1:
+      x := 1;
+    LT_TLSv1_1:
+      x := 2;
+  end;
+  if x >= 0 then
+    if not SSLCheck(cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_VERSION, x)) then
+      Exit;
+  if FUsername <> '' then
+  begin
+    cryptSetAttributeString(FcryptSession, CRYPT_SESSINFO_USERNAME,
+      Pointer(FUsername), Length(FUsername));
+    cryptSetAttributeString(FcryptSession, CRYPT_SESSINFO_PASSWORD,
+      Pointer(FPassword), Length(FPassword));
+  end;
+  if FSSLType = LT_SSHv2 then
+    if FSSHChannelType <> '' then
+    begin
+      cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_SSH_CHANNEL, CRYPT_UNUSED);
+      cryptSetAttributeString(FCryptSession, CRYPT_SESSINFO_SSH_CHANNEL_TYPE,
+        Pointer(FSSHChannelType), Length(FSSHChannelType));
+      if FSSHChannelArg1 <> '' then
+        cryptSetAttributeString(FCryptSession, CRYPT_SESSINFO_SSH_CHANNEL_ARG1,
+          Pointer(FSSHChannelArg1), Length(FSSHChannelArg1));
+      if FSSHChannelArg2 <> '' then
+        cryptSetAttributeString(FCryptSession, CRYPT_SESSINFO_SSH_CHANNEL_ARG2,
+          Pointer(FSSHChannelArg2), Length(FSSHChannelArg2));
+    end;
+
+
+  if server and (FPrivatekeyFile = '') then
+  begin
+    if FPrivatekeyLabel = '' then
+      FPrivatekeyLabel := 'synapse';
+    if FkeyPassword = '' then
+      FkeyPassword := 'synapse';
+    CreateSelfSignedcert(FSocket.ResolveIPToName(FSocket.GetRemoteSinIP));
+  end;
+
+  if (FPrivatekeyLabel <> '') and (FPrivatekeyFile <> '') then
+  begin
+    if not SSLCheck(cryptKeysetOpen(KeySetObj, CRYPT_UNUSED, CRYPT_KEYSET_FILE,
+      PChar(FPrivatekeyFile), CRYPT_KEYOPT_READONLY)) then
+      Exit;
+    try
+    if not SSLCheck(cryptGetPrivateKey(KeySetObj, cryptcontext, CRYPT_KEYID_NAME,
+      PChar(FPrivatekeyLabel), PChar(FKeyPassword))) then
+      Exit;
+    if not SSLCheck(cryptSetAttribute(FcryptSession, CRYPT_SESSINFO_PRIVATEKEY,
+      cryptcontext)) then
+      Exit;
+    finally
+      cryptKeysetClose(keySetObj);
+      cryptDestroyContext(cryptcontext);
+    end;
+  end;
+  if server and FVerifyCert then
+  begin
+    if not SSLCheck(cryptKeysetOpen(KeySetObj, CRYPT_UNUSED, CRYPT_KEYSET_FILE,
+      PChar(FCertCAFile), CRYPT_KEYOPT_READONLY)) then
+      Exit;
+    try
+    if not SSLCheck(cryptSetAttribute(FcryptSession, CRYPT_SESSINFO_KEYSET,
+      keySetObj)) then
+      Exit;
+    finally
+      cryptKeysetClose(keySetObj);
+    end;
+  end;
+  Result := true;
+end;
+
+function TSSLCryptLib.DeInit: Boolean;
+begin
+  Result := True;
+  if FcryptSession <> CRYPT_SESSION(CRYPT_SESSION_NONE) then
+    CryptDestroySession(FcryptSession);
+  FcryptSession := CRYPT_SESSION(CRYPT_SESSION_NONE);
+  FSSLEnabled := False;
+  if FDelCert then
+    Deletefile(FPrivatekeyFile);
+end;
+
+function TSSLCryptLib.Prepare(server:Boolean): Boolean;
+begin
+  Result := false;
+  DeInit;
+  if Init(server) then
+    Result := true
+  else
+    DeInit;
+end;
+
+function TSSLCryptLib.Connect: boolean;
+begin
+  Result := False;
+  if FSocket.Socket = INVALID_SOCKET then
+    Exit;
+  if Prepare(false) then
+  begin
+    if not SSLCheck(cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_NETWORKSOCKET, FSocket.Socket)) then
+      Exit;
+    if not SSLCheck(cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_ACTIVE, 1)) then
+      Exit;
+    FSSLEnabled := True;
+    Result := True;
+    FReadBuffer := '';
+  end;
+end;
+
+function TSSLCryptLib.Accept: boolean;
+begin
+  Result := False;
+  if FSocket.Socket = INVALID_SOCKET then
+    Exit;
+  if Prepare(true) then
+  begin
+    if not SSLCheck(cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_NETWORKSOCKET, FSocket.Socket)) then
+      Exit;
+    if not SSLCheck(cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_ACTIVE, 1)) then
+      Exit;
+    FSSLEnabled := True;
+    Result := True;
+    FReadBuffer := '';
+  end;
+end;
+
+function TSSLCryptLib.Shutdown: boolean;
+begin
+  Result := BiShutdown;
+end;
+
+function TSSLCryptLib.BiShutdown: boolean;
+begin
+  if FcryptSession <> CRYPT_SESSION(CRYPT_SESSION_NONE) then
+    cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_ACTIVE, 0);
+  DeInit;
+  FReadBuffer := '';
+  Result := True;
+end;
+
+function TSSLCryptLib.SendBuffer(Buffer: TMemory; Len: Integer): Integer;
+var
+  l: integer;
+begin
+  FLastError := 0;
+  FLastErrorDesc := '';
+  SSLCheck(cryptPushData(FCryptSession, Buffer, Len, L));
+  cryptFlushData(FcryptSession);
+  Result := l;
+end;
+
+function TSSLCryptLib.RecvBuffer(Buffer: TMemory; Len: Integer): Integer;
+var
+  l: integer;
+begin
+  FLastError := 0;
+  FLastErrorDesc := '';
+  if Length(FReadBuffer) = 0 then
+    FReadBuffer := PopAll;
+  if Len > Length(FReadBuffer) then
+    Len := Length(FReadBuffer);
+  Move(Pointer(FReadBuffer)^, buffer^, Len);
+  Delete(FReadBuffer, 1, Len);
+  Result := Len;
+end;
+
+function TSSLCryptLib.WaitingData: Integer;
+begin
+  Result := Length(FReadBuffer);
+end;
+
+function TSSLCryptLib.GetSSLVersion: string;
+var
+  x: integer;
+begin
+  Result := '';
+  if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then
+    Exit;
+  cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_VERSION, x);
+  if FSSLType in [LT_SSLv3, LT_TLSv1, LT_TLSv1_1, LT_all] then
+    case x of
+      0:
+        Result := 'SSLv3';
+      1:
+        Result := 'TLSv1';
+      2:
+        Result := 'TLSv1.1';
+    end;
+  if FSSLType in [LT_SSHv2] then
+    case x of
+      0:
+        Result := 'SSHv1';
+      1:
+        Result := 'SSHv2';
+    end;
+end;
+
+function TSSLCryptLib.GetPeerSubject: string;
+var
+  cert: CRYPT_CERTIFICATE;
+begin
+  Result := '';
+  if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then
+    Exit;
+  cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_RESPONSE, cert);
+  cryptSetAttribute(cert, CRYPT_CERTINFO_SUBJECTNAME, CRYPT_UNUSED);
+  Result := GetString(cert, CRYPT_CERTINFO_DN);
+  cryptDestroyCert(cert);
+end;
+
+function TSSLCryptLib.GetPeerName: string;
+var
+  cert: CRYPT_CERTIFICATE;
+begin
+  Result := '';
+  if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then
+    Exit;
+  cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_RESPONSE, cert);
+  cryptSetAttribute(cert, CRYPT_CERTINFO_ISSUERNAME, CRYPT_UNUSED);
+  Result := GetString(cert, CRYPT_CERTINFO_COMMONNAME);
+  cryptDestroyCert(cert);
+end;
+
+function TSSLCryptLib.GetPeerIssuer: string;
+var
+  cert: CRYPT_CERTIFICATE;
+begin
+  Result := '';
+  if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then
+    Exit;
+  cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_RESPONSE, cert);
+  cryptSetAttribute(cert, CRYPT_CERTINFO_ISSUERNAME, CRYPT_UNUSED);
+  Result := GetString(cert, CRYPT_CERTINFO_DN);
+  cryptDestroyCert(cert);
+end;
+
+function TSSLCryptLib.GetPeerFingerprint: string;
+var
+  cert: CRYPT_CERTIFICATE;
+begin
+  Result := '';
+  if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then
+    Exit;
+  cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_RESPONSE, cert);
+  Result := GetString(cert, CRYPT_CERTINFO_FINGERPRINT);
+  Result := MD5(Result);
+  cryptDestroyCert(cert);
+end;
+
+{==============================================================================}
+
+initialization
+  if cryptInit = CRYPT_OK then
+    SSLImplementation := TSSLCryptLib;
+  cryptAddRandom(nil, CRYPT_RANDOM_SLOWPOLL);
+
+finalization
+  cryptEnd;
+
+end.
+
diff --git a/Units/Synapse/ssl_openssl.pas b/Units/Synapse/ssl_openssl.pas
index 1629bab..c87a1dd 100644
--- a/Units/Synapse/ssl_openssl.pas
+++ b/Units/Synapse/ssl_openssl.pas
@@ -1,825 +1,825 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 001.001.001 |
-|==============================================================================|
-| Content: SSL support by OpenSSL                                              |
-|==============================================================================|
-| Copyright (c)1999-2008, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2005-2008.                |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-//requires OpenSSL libraries!
-
-{:@abstract(SSL plugin for OpenSSL)
-
-You need OpenSSL libraries version 0.9.7. It can work with 0.9.6 too, but
-application mysteriously crashing when you are using freePascal on Linux.
-Use Kylix on Linux is OK! If you have version 0.9.7 on Linux, then I not see
-any problems with FreePascal.
-
-OpenSSL libraries are loaded dynamicly - you not need OpenSSl librares even you
-compile your application with this unit. SSL just not working when you not have
-OpenSSL libraries.
-
-This plugin have limited support for .NET too! Because is not possible to use
-callbacks with CDECL calling convention under .NET, is not supported
-key/certificate passwords and multithread locking. :-(
-
-For handling keys and certificates you can use this properties:
-
-@link(TCustomSSL.CertificateFile) for PEM or ASN1 DER (cer) format. @br
-@link(TCustomSSL.Certificate) for ASN1 DER format only. @br
-@link(TCustomSSL.PrivateKeyFile) for PEM or ASN1 DER (key) format. @br
-@link(TCustomSSL.PrivateKey) for ASN1 DER format only. @br
-@link(TCustomSSL.CertCAFile) for PEM CA certificate bundle. @br
-@link(TCustomSSL.PFXFile) for PFX format. @br
-@link(TCustomSSL.PFX) for PFX format from binary string. @br
-
-This plugin is capable to create Ad-Hoc certificates. When you start SSL/TLS
-server without explicitly assigned key and certificate, then this plugin create
-Ad-Hoc key and certificate for each incomming connection by self. It slowdown
-accepting of new connections!
-}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$H+}
-
-{$IFDEF UNICODE}
-  {$WARN IMPLICIT_STRING_CAST OFF}
-  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
-{$ENDIF}
-
-unit ssl_openssl;
-
-interface
-
-uses
-  SysUtils, Classes,
-  blcksock, synsock, synautil,
-{$IFDEF CIL}
-  System.Text,
-{$ENDIF}
-  ssl_openssl_lib;
-
-type
-  {:@abstract(class implementing OpenSSL SSL plugin.)
-   Instance of this class will be created for each @link(TTCPBlockSocket).
-   You not need to create instance of this class, all is done by Synapse itself!}
-  TSSLOpenSSL = class(TCustomSSL)
-  protected
-    FSsl: PSSL;
-    Fctx: PSSL_CTX;
-    function SSLCheck: Boolean;
-    function SetSslKeys: boolean;
-    function Init(server:Boolean): Boolean;
-    function DeInit: Boolean;
-    function Prepare(server:Boolean): Boolean;
-    function LoadPFX(pfxdata: ansistring): Boolean;
-    function CreateSelfSignedCert(Host: string): Boolean; override;
-  public
-    {:See @inherited}
-    constructor Create(const Value: TTCPBlockSocket); override;
-    destructor Destroy; override;
-    {:See @inherited}
-    function LibVersion: String; override;
-    {:See @inherited}
-    function LibName: String; override;
-    {:See @inherited and @link(ssl_cryptlib) for more details.}
-    function Connect: boolean; override;
-    {:See @inherited and @link(ssl_cryptlib) for more details.}
-    function Accept: boolean; override;
-    {:See @inherited}
-    function Shutdown: boolean; override;
-    {:See @inherited}
-    function BiShutdown: boolean; override;
-    {:See @inherited}
-    function SendBuffer(Buffer: TMemory; Len: Integer): Integer; override;
-    {:See @inherited}
-    function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; override;
-    {:See @inherited}
-    function WaitingData: Integer; override;
-    {:See @inherited}
-    function GetSSLVersion: string; override;
-    {:See @inherited}
-    function GetPeerSubject: string; override;
-    {:See @inherited}
-    function GetPeerIssuer: string; override;
-    {:See @inherited}
-    function GetPeerName: string; override;
-    {:See @inherited}
-    function GetPeerFingerprint: string; override;
-    {:See @inherited}
-    function GetCertInfo: string; override;
-    {:See @inherited}
-    function GetCipherName: string; override;
-    {:See @inherited}
-    function GetCipherBits: integer; override;
-    {:See @inherited}
-    function GetCipherAlgBits: integer; override;
-    {:See @inherited}
-    function GetVerifyCert: integer; override;
-  end;
-
-implementation
-
-{==============================================================================}
-
-{$IFNDEF CIL}
-function PasswordCallback(buf:PAnsiChar; size:Integer; rwflag:Integer; userdata: Pointer):Integer; cdecl;
-var
-  Password: AnsiString;
-begin
-  Password := '';
-  if TCustomSSL(userdata) is TCustomSSL then
-    Password := TCustomSSL(userdata).KeyPassword;
-  if Length(Password) > (Size - 1) then
-    SetLength(Password, Size - 1);
-  Result := Length(Password);
-  StrLCopy(buf, PAnsiChar(Password + #0), Result + 1);
-end;
-{$ENDIF}
-
-{==============================================================================}
-
-constructor TSSLOpenSSL.Create(const Value: TTCPBlockSocket);
-begin
-  inherited Create(Value);
-  FCiphers := 'DEFAULT';
-  FSsl := nil;
-  Fctx := nil;
-end;
-
-destructor TSSLOpenSSL.Destroy;
-begin
-  DeInit;
-  inherited Destroy;
-end;
-
-function TSSLOpenSSL.LibVersion: String;
-begin
-  Result := SSLeayversion(0);
-end;
-
-function TSSLOpenSSL.LibName: String;
-begin
-  Result := 'ssl_openssl';
-end;
-
-function TSSLOpenSSL.SSLCheck: Boolean;
-var
-{$IFDEF CIL}
-  sb: StringBuilder;
-{$ENDIF}
-  s : AnsiString;
-begin
-  Result := true;
-  FLastErrorDesc := '';
-  FLastError := ErrGetError;
-  ErrClearError;
-  if FLastError <> 0 then
-  begin
-    Result := False;
-{$IFDEF CIL}
-    sb := StringBuilder.Create(256);
-    ErrErrorString(FLastError, sb, 256);
-    FLastErrorDesc := Trim(sb.ToString);
-{$ELSE}
-    s := StringOfChar(#0, 256);
-    ErrErrorString(FLastError, s, Length(s));
-    FLastErrorDesc := s;
-{$ENDIF}
-  end;
-end;
-
-function TSSLOpenSSL.CreateSelfSignedCert(Host: string): Boolean;
-var
-  pk: EVP_PKEY;
-  x: PX509;
-  rsa: PRSA;
-  t: PASN1_UTCTIME;
-  name: PX509_NAME;
-  b: PBIO;
-  xn, y: integer;
-  s: AnsiString;
-{$IFDEF CIL}
-  sb: StringBuilder;
-{$ENDIF}
-begin
-  Result := True;
-  pk := EvpPkeynew;
-  x := X509New;
-  try
-    rsa := RsaGenerateKey(1024, $10001, nil, nil);
-    EvpPkeyAssign(pk, EVP_PKEY_RSA, rsa);
-    X509SetVersion(x, 2);
-    Asn1IntegerSet(X509getSerialNumber(x), 0);
-    t := Asn1UtctimeNew;
-    try
-      X509GmtimeAdj(t, -60 * 60 *24);
-      X509SetNotBefore(x, t);
-      X509GmtimeAdj(t, 60 * 60 * 60 *24);
-      X509SetNotAfter(x, t);
-    finally
-      Asn1UtctimeFree(t);
-    end;
-    X509SetPubkey(x, pk);
-    Name := X509GetSubjectName(x);
-    X509NameAddEntryByTxt(Name, 'C', $1001, 'CZ', -1, -1, 0);
-    X509NameAddEntryByTxt(Name, 'CN', $1001, host, -1, -1, 0);
-    x509SetIssuerName(x, Name);
-    x509Sign(x, pk, EvpGetDigestByName('SHA1'));
-    b := BioNew(BioSMem);
-    try
-      i2dX509Bio(b, x);
-      xn := bioctrlpending(b);
-{$IFDEF CIL}
-      sb := StringBuilder.Create(xn);
-      y := bioread(b, sb, xn);
-      if y > 0 then
-      begin
-        sb.Length := y;
-        s := sb.ToString;
-      end;
-{$ELSE}
-      setlength(s, xn);
-      y := bioread(b, s, xn);
-      if y > 0 then
-        setlength(s, y);
-{$ENDIF}
-    finally
-      BioFreeAll(b);
-    end;
-    FCertificate := s;
-    b := BioNew(BioSMem);
-    try
-      i2dPrivatekeyBio(b, pk);
-      xn := bioctrlpending(b);
-{$IFDEF CIL}
-      sb := StringBuilder.Create(xn);
-      y := bioread(b, sb, xn);
-      if y > 0 then
-      begin
-        sb.Length := y;
-        s := sb.ToString;
-      end;
-{$ELSE}
-      setlength(s, xn);
-      y := bioread(b, s, xn);
-      if y > 0 then
-        setlength(s, y);
-{$ENDIF}
-    finally
-      BioFreeAll(b);
-    end;
-    FPrivatekey := s;
-  finally
-    X509free(x);
-    EvpPkeyFree(pk);
-  end;
-end;
-
-function TSSLOpenSSL.LoadPFX(pfxdata: Ansistring): Boolean;
-var
-  cert, pkey, ca: SslPtr;
-  b: PBIO;
-  p12: SslPtr;
-begin
-  Result := False;
-  b := BioNew(BioSMem);
-  try
-    BioWrite(b, pfxdata, Length(PfxData));
-    p12 := d2iPKCS12bio(b, nil);
-    if not Assigned(p12) then
-      Exit;
-    try
-      cert := nil;
-      pkey := nil;
-      ca := nil;
-      if PKCS12parse(p12, FKeyPassword, pkey, cert, ca) > 0 then
-        if SSLCTXusecertificate(Fctx, cert) > 0 then
-          if SSLCTXusePrivateKey(Fctx, pkey) > 0 then
-            Result := True;
-    finally
-      PKCS12free(p12);
-    end;
-  finally
-    BioFreeAll(b);
-  end;
-end;
-
-function TSSLOpenSSL.SetSslKeys: boolean;
-var
-  st: TFileStream;
-  s: string;
-begin
-  Result := False;
-  if not assigned(FCtx) then
-    Exit;
-  try
-    if FCertificateFile <> '' then
-      if SslCtxUseCertificateChainFile(FCtx, FCertificateFile) <> 1 then
-        if SslCtxUseCertificateFile(FCtx, FCertificateFile, SSL_FILETYPE_PEM) <> 1 then
-          if SslCtxUseCertificateFile(FCtx, FCertificateFile, SSL_FILETYPE_ASN1) <> 1 then
-            Exit;
-    if FCertificate <> '' then
-      if SslCtxUseCertificateASN1(FCtx, length(FCertificate), FCertificate) <> 1 then
-        Exit;
-    SSLCheck;
-    if FPrivateKeyFile <> '' then
-      if SslCtxUsePrivateKeyFile(FCtx, FPrivateKeyFile, SSL_FILETYPE_PEM) <> 1 then
-        if SslCtxUsePrivateKeyFile(FCtx, FPrivateKeyFile, SSL_FILETYPE_ASN1) <> 1 then
-          Exit;
-    if FPrivateKey <> '' then
-      if SslCtxUsePrivateKeyASN1(EVP_PKEY_RSA, FCtx, FPrivateKey, length(FPrivateKey)) <> 1 then
-        Exit;
-    SSLCheck;
-    if FCertCAFile <> '' then
-      if SslCtxLoadVerifyLocations(FCtx, FCertCAFile, '') <> 1 then
-        Exit;
-    if FPFXfile <> '' then
-    begin
-      try
-        st := TFileStream.Create(FPFXfile, fmOpenRead	 or fmShareDenyNone);
-        try
-          s := ReadStrFromStream(st, st.Size);
-        finally
-          st.Free;
-        end;
-        if not LoadPFX(s) then
-          Exit;
-      except
-        on Exception do
-          Exit;
-      end;
-    end;
-    if FPFX <> '' then
-      if not LoadPFX(FPfx) then
-        Exit;
-    SSLCheck;
-    Result := True;
-  finally
-    SSLCheck;
-  end;
-end;
-
-function TSSLOpenSSL.Init(server:Boolean): Boolean;
-var
-  s: AnsiString;
-begin
-  Result := False;
-  FLastErrorDesc := '';
-  FLastError := 0;
-  Fctx := nil;
-  case FSSLType of
-    LT_SSLv2:
-      Fctx := SslCtxNew(SslMethodV2);
-    LT_SSLv3:
-      Fctx := SslCtxNew(SslMethodV3);
-    LT_TLSv1:
-      Fctx := SslCtxNew(SslMethodTLSV1);
-    LT_all:
-      Fctx := SslCtxNew(SslMethodV23);
-  else
-    Exit;
-  end;
-  if Fctx = nil then
-  begin
-    SSLCheck;
-    Exit;
-  end
-  else
-  begin
-    s := FCiphers;
-    SslCtxSetCipherList(Fctx, s);
-    if FVerifyCert then
-      SslCtxSetVerify(FCtx, SSL_VERIFY_PEER, nil)
-    else
-      SslCtxSetVerify(FCtx, SSL_VERIFY_NONE, nil);
-{$IFNDEF CIL}
-    SslCtxSetDefaultPasswdCb(FCtx, @PasswordCallback);
-    SslCtxSetDefaultPasswdCbUserdata(FCtx, self);
-{$ENDIF}
-
-    if server and (FCertificateFile = '') and (FCertificate = '')
-      and (FPFXfile = '') and (FPFX = '') then
-    begin
-      CreateSelfSignedcert(FSocket.ResolveIPToName(FSocket.GetRemoteSinIP));
-    end;
-
-    if not SetSSLKeys then
-      Exit
-    else
-    begin
-      Fssl := nil;
-      Fssl := SslNew(Fctx);
-      if Fssl = nil then
-      begin
-        SSLCheck;
-        exit;
-      end;
-    end;
-  end;
-  Result := true;
-end;
-
-function TSSLOpenSSL.DeInit: Boolean;
-begin
-  Result := True;
-  if assigned (Fssl) then
-    sslfree(Fssl);
-  Fssl := nil;
-  if assigned (Fctx) then
-  begin
-    SslCtxFree(Fctx);
-    Fctx := nil;
-    ErrRemoveState(0);
-  end;
-  FSSLEnabled := False;
-end;
-
-function TSSLOpenSSL.Prepare(server:Boolean): Boolean;
-begin
-  Result := false;
-  DeInit;
-  if Init(server) then
-    Result := true
-  else
-    DeInit;
-end;
-
-function TSSLOpenSSL.Connect: boolean;
-var
-  x: integer;
-begin
-  Result := False;
-  if FSocket.Socket = INVALID_SOCKET then
-    Exit;
-  if Prepare(False) then
-  begin
-{$IFDEF CIL}
-    if sslsetfd(FSsl, FSocket.Socket.Handle.ToInt32) < 1 then
-{$ELSE}
-    if sslsetfd(FSsl, FSocket.Socket) < 1 then
-{$ENDIF}
-    begin
-      SSLCheck;
-      Exit;
-    end;
-    x := sslconnect(FSsl);
-    if x < 1 then
-    begin
-      SSLcheck;
-      Exit;
-    end;
-  if FverifyCert then
-    if GetVerifyCert <> 0 then
-      Exit;
-    FSSLEnabled := True;
-    Result := True;
-  end;
-end;
-
-function TSSLOpenSSL.Accept: boolean;
-var
-  x: integer;
-begin
-  Result := False;
-  if FSocket.Socket = INVALID_SOCKET then
-    Exit;
-  if Prepare(True) then
-  begin
-{$IFDEF CIL}
-    if sslsetfd(FSsl, FSocket.Socket.Handle.ToInt32) < 1 then
-{$ELSE}
-    if sslsetfd(FSsl, FSocket.Socket) < 1 then
-{$ENDIF}
-    begin
-      SSLCheck;
-      Exit;
-    end;
-    x := sslAccept(FSsl);
-    if x < 1 then
-    begin
-      SSLcheck;
-      Exit;
-    end;
-    FSSLEnabled := True;
-    Result := True;
-  end;
-end;
-
-function TSSLOpenSSL.Shutdown: boolean;
-begin
-  if assigned(FSsl) then
-    sslshutdown(FSsl);
-  DeInit;
-  Result := True;
-end;
-
-function TSSLOpenSSL.BiShutdown: boolean;
-var
-  x: integer;
-begin
-  if assigned(FSsl) then
-  begin
-    x := sslshutdown(FSsl);
-    if x = 0 then
-    begin
-      Synsock.Shutdown(FSocket.Socket, 1);
-      sslshutdown(FSsl);
-    end;
-  end;
-  DeInit;
-  Result := True;
-end;
-
-function TSSLOpenSSL.SendBuffer(Buffer: TMemory; Len: Integer): Integer;
-var
-  err: integer;
-{$IFDEF CIL}
-  s: ansistring;
-{$ENDIF}
-begin
-  FLastError := 0;
-  FLastErrorDesc := '';
-  repeat
-{$IFDEF CIL}
-    s := StringOf(Buffer);
-    Result := SslWrite(FSsl, s, Len);
-{$ELSE}
-    Result := SslWrite(FSsl, Buffer , Len);
-{$ENDIF}
-    err := SslGetError(FSsl, Result);
-  until (err <> SSL_ERROR_WANT_READ) and (err <> SSL_ERROR_WANT_WRITE);
-  if err = SSL_ERROR_ZERO_RETURN then
-    Result := 0
-  else
-    if (err <> 0) then
-      FLastError := err;
-end;
-
-function TSSLOpenSSL.RecvBuffer(Buffer: TMemory; Len: Integer): Integer;
-var
-  err: integer;
-{$IFDEF CIL}
-  sb: stringbuilder;
-  s: ansistring;
-{$ENDIF}
-begin
-  FLastError := 0;
-  FLastErrorDesc := '';
-  repeat
-{$IFDEF CIL}
-    sb := StringBuilder.Create(Len);
-    Result := SslRead(FSsl, sb, Len);
-    if Result > 0 then
-    begin
-      sb.Length := Result;
-      s := sb.ToString;
-      System.Array.Copy(BytesOf(s), Buffer, length(s));
-    end;
-{$ELSE}
-    Result := SslRead(FSsl, Buffer , Len);
-{$ENDIF}
-    err := SslGetError(FSsl, Result);
-  until (err <> SSL_ERROR_WANT_READ) and (err <> SSL_ERROR_WANT_WRITE);
-  if err = SSL_ERROR_ZERO_RETURN then
-    Result := 0;
-  if (err <> 0) then
-    FLastError := err;
-end;
-
-function TSSLOpenSSL.WaitingData: Integer;
-begin
-  Result := sslpending(Fssl);
-end;
-
-function TSSLOpenSSL.GetSSLVersion: string;
-begin
-  if not assigned(FSsl) then
-    Result := ''
-  else
-    Result := SSlGetVersion(FSsl);
-end;
-
-function TSSLOpenSSL.GetPeerSubject: string;
-var
-  cert: PX509;
-  s: ansistring;
-{$IFDEF CIL}
-  sb: StringBuilder;
-{$ENDIF}
-begin
-  if not assigned(FSsl) then
-  begin
-    Result := '';
-    Exit;
-  end;
-  cert := SSLGetPeerCertificate(Fssl);
-  if not assigned(cert) then
-  begin
-    Result := '';
-    Exit;
-  end;
-{$IFDEF CIL}
-  sb := StringBuilder.Create(4096);
-  Result := X509NameOneline(X509GetSubjectName(cert), sb, 4096);
-{$ELSE}
-  setlength(s, 4096);
-  Result := X509NameOneline(X509GetSubjectName(cert), s, Length(s));
-{$ENDIF}
-  X509Free(cert);
-end;
-
-function TSSLOpenSSL.GetPeerName: string;
-var
-  s: ansistring;
-begin
-  s := GetPeerSubject;
-  s := SeparateRight(s, '/CN=');
-  Result := Trim(SeparateLeft(s, '/'));
-end;
-
-function TSSLOpenSSL.GetPeerIssuer: string;
-var
-  cert: PX509;
-  s: ansistring;
-{$IFDEF CIL}
-  sb: StringBuilder;
-{$ENDIF}
-begin
-  if not assigned(FSsl) then
-  begin
-    Result := '';
-    Exit;
-  end;
-  cert := SSLGetPeerCertificate(Fssl);
-  if not assigned(cert) then
-  begin
-    Result := '';
-    Exit;
-  end;
-{$IFDEF CIL}
-  sb := StringBuilder.Create(4096);
-  Result := X509NameOneline(X509GetIssuerName(cert), sb, 4096);
-{$ELSE}
-  setlength(s, 4096);
-  Result := X509NameOneline(X509GetIssuerName(cert), s, Length(s));
-{$ENDIF}
-  X509Free(cert);
-end;
-
-function TSSLOpenSSL.GetPeerFingerprint: string;
-var
-  cert: PX509;
-  x: integer;
-{$IFDEF CIL}
-  sb: StringBuilder;
-{$ENDIF}
-begin
-  if not assigned(FSsl) then
-  begin
-    Result := '';
-    Exit;
-  end;
-  cert := SSLGetPeerCertificate(Fssl);
-  if not assigned(cert) then
-  begin
-    Result := '';
-    Exit;
-  end;
-{$IFDEF CIL}
-  sb := StringBuilder.Create(EVP_MAX_MD_SIZE);
-  X509Digest(cert, EvpGetDigestByName('MD5'), sb, x);
-  sb.Length := x;
-  Result := sb.ToString;
-{$ELSE}
-  setlength(Result, EVP_MAX_MD_SIZE);
-  X509Digest(cert, EvpGetDigestByName('MD5'), Result, x);
-  SetLength(Result, x);
-{$ENDIF}
-  X509Free(cert);
-end;
-
-function TSSLOpenSSL.GetCertInfo: string;
-var
-  cert: PX509;
-  x, y: integer;
-  b: PBIO;
-  s: AnsiString;
-{$IFDEF CIL}
-  sb: stringbuilder;
-{$ENDIF}
-begin
-  if not assigned(FSsl) then
-  begin
-    Result := '';
-    Exit;
-  end;
-  cert := SSLGetPeerCertificate(Fssl);
-  if not assigned(cert) then
-  begin
-    Result := '';
-    Exit;
-  end;
-  b := BioNew(BioSMem);
-  try
-    X509Print(b, cert);
-    x := bioctrlpending(b);
-{$IFDEF CIL}
-    sb := StringBuilder.Create(x);
-    y := bioread(b, sb, x);
-    if y > 0 then
-    begin
-      sb.Length := y;
-      s := sb.ToString;
-    end;
-{$ELSE}
-    setlength(s,x);
-    y := bioread(b,s,x);
-    if y > 0 then
-      setlength(s, y);
-{$ENDIF}
-    Result := ReplaceString(s, LF, CRLF);
-  finally
-    BioFreeAll(b);
-  end;
-end;
-
-function TSSLOpenSSL.GetCipherName: string;
-begin
-  if not assigned(FSsl) then
-    Result := ''
-  else
-    Result := SslCipherGetName(SslGetCurrentCipher(FSsl));
-end;
-
-function TSSLOpenSSL.GetCipherBits: integer;
-var
-  x: integer;
-begin
-  if not assigned(FSsl) then
-    Result := 0
-  else
-    Result := SSLCipherGetBits(SslGetCurrentCipher(FSsl), x);
-end;
-
-function TSSLOpenSSL.GetCipherAlgBits: integer;
-begin
-  if not assigned(FSsl) then
-    Result := 0
-  else
-    SSLCipherGetBits(SslGetCurrentCipher(FSsl), Result);
-end;
-
-function TSSLOpenSSL.GetVerifyCert: integer;
-begin
-  if not assigned(FSsl) then
-    Result := 1
-  else
-    Result := SslGetVerifyResult(FSsl);
-end;
-
-{==============================================================================}
-
-initialization
-  if InitSSLInterface then
-    SSLImplementation := TSSLOpenSSL;
-
-end.
+{==============================================================================|
+| Project : Ararat Synapse                                       | 001.001.001 |
+|==============================================================================|
+| Content: SSL support by OpenSSL                                              |
+|==============================================================================|
+| Copyright (c)1999-2008, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2005-2008.                |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+//requires OpenSSL libraries!
+
+{:@abstract(SSL plugin for OpenSSL)
+
+You need OpenSSL libraries version 0.9.7. It can work with 0.9.6 too, but
+application mysteriously crashing when you are using freePascal on Linux.
+Use Kylix on Linux is OK! If you have version 0.9.7 on Linux, then I not see
+any problems with FreePascal.
+
+OpenSSL libraries are loaded dynamicly - you not need OpenSSl librares even you
+compile your application with this unit. SSL just not working when you not have
+OpenSSL libraries.
+
+This plugin have limited support for .NET too! Because is not possible to use
+callbacks with CDECL calling convention under .NET, is not supported
+key/certificate passwords and multithread locking. :-(
+
+For handling keys and certificates you can use this properties:
+
+@link(TCustomSSL.CertificateFile) for PEM or ASN1 DER (cer) format. @br
+@link(TCustomSSL.Certificate) for ASN1 DER format only. @br
+@link(TCustomSSL.PrivateKeyFile) for PEM or ASN1 DER (key) format. @br
+@link(TCustomSSL.PrivateKey) for ASN1 DER format only. @br
+@link(TCustomSSL.CertCAFile) for PEM CA certificate bundle. @br
+@link(TCustomSSL.PFXFile) for PFX format. @br
+@link(TCustomSSL.PFX) for PFX format from binary string. @br
+
+This plugin is capable to create Ad-Hoc certificates. When you start SSL/TLS
+server without explicitly assigned key and certificate, then this plugin create
+Ad-Hoc key and certificate for each incomming connection by self. It slowdown
+accepting of new connections!
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit ssl_openssl;
+
+interface
+
+uses
+  SysUtils, Classes,
+  blcksock, synsock, synautil,
+{$IFDEF CIL}
+  System.Text,
+{$ENDIF}
+  ssl_openssl_lib;
+
+type
+  {:@abstract(class implementing OpenSSL SSL plugin.)
+   Instance of this class will be created for each @link(TTCPBlockSocket).
+   You not need to create instance of this class, all is done by Synapse itself!}
+  TSSLOpenSSL = class(TCustomSSL)
+  protected
+    FSsl: PSSL;
+    Fctx: PSSL_CTX;
+    function SSLCheck: Boolean;
+    function SetSslKeys: boolean;
+    function Init(server:Boolean): Boolean;
+    function DeInit: Boolean;
+    function Prepare(server:Boolean): Boolean;
+    function LoadPFX(pfxdata: ansistring): Boolean;
+    function CreateSelfSignedCert(Host: string): Boolean; override;
+  public
+    {:See @inherited}
+    constructor Create(const Value: TTCPBlockSocket); override;
+    destructor Destroy; override;
+    {:See @inherited}
+    function LibVersion: String; override;
+    {:See @inherited}
+    function LibName: String; override;
+    {:See @inherited and @link(ssl_cryptlib) for more details.}
+    function Connect: boolean; override;
+    {:See @inherited and @link(ssl_cryptlib) for more details.}
+    function Accept: boolean; override;
+    {:See @inherited}
+    function Shutdown: boolean; override;
+    {:See @inherited}
+    function BiShutdown: boolean; override;
+    {:See @inherited}
+    function SendBuffer(Buffer: TMemory; Len: Integer): Integer; override;
+    {:See @inherited}
+    function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; override;
+    {:See @inherited}
+    function WaitingData: Integer; override;
+    {:See @inherited}
+    function GetSSLVersion: string; override;
+    {:See @inherited}
+    function GetPeerSubject: string; override;
+    {:See @inherited}
+    function GetPeerIssuer: string; override;
+    {:See @inherited}
+    function GetPeerName: string; override;
+    {:See @inherited}
+    function GetPeerFingerprint: string; override;
+    {:See @inherited}
+    function GetCertInfo: string; override;
+    {:See @inherited}
+    function GetCipherName: string; override;
+    {:See @inherited}
+    function GetCipherBits: integer; override;
+    {:See @inherited}
+    function GetCipherAlgBits: integer; override;
+    {:See @inherited}
+    function GetVerifyCert: integer; override;
+  end;
+
+implementation
+
+{==============================================================================}
+
+{$IFNDEF CIL}
+function PasswordCallback(buf:PAnsiChar; size:Integer; rwflag:Integer; userdata: Pointer):Integer; cdecl;
+var
+  Password: AnsiString;
+begin
+  Password := '';
+  if TCustomSSL(userdata) is TCustomSSL then
+    Password := TCustomSSL(userdata).KeyPassword;
+  if Length(Password) > (Size - 1) then
+    SetLength(Password, Size - 1);
+  Result := Length(Password);
+  StrLCopy(buf, PAnsiChar(Password + #0), Result + 1);
+end;
+{$ENDIF}
+
+{==============================================================================}
+
+constructor TSSLOpenSSL.Create(const Value: TTCPBlockSocket);
+begin
+  inherited Create(Value);
+  FCiphers := 'DEFAULT';
+  FSsl := nil;
+  Fctx := nil;
+end;
+
+destructor TSSLOpenSSL.Destroy;
+begin
+  DeInit;
+  inherited Destroy;
+end;
+
+function TSSLOpenSSL.LibVersion: String;
+begin
+  Result := SSLeayversion(0);
+end;
+
+function TSSLOpenSSL.LibName: String;
+begin
+  Result := 'ssl_openssl';
+end;
+
+function TSSLOpenSSL.SSLCheck: Boolean;
+var
+{$IFDEF CIL}
+  sb: StringBuilder;
+{$ENDIF}
+  s : AnsiString;
+begin
+  Result := true;
+  FLastErrorDesc := '';
+  FLastError := ErrGetError;
+  ErrClearError;
+  if FLastError <> 0 then
+  begin
+    Result := False;
+{$IFDEF CIL}
+    sb := StringBuilder.Create(256);
+    ErrErrorString(FLastError, sb, 256);
+    FLastErrorDesc := Trim(sb.ToString);
+{$ELSE}
+    s := StringOfChar(#0, 256);
+    ErrErrorString(FLastError, s, Length(s));
+    FLastErrorDesc := s;
+{$ENDIF}
+  end;
+end;
+
+function TSSLOpenSSL.CreateSelfSignedCert(Host: string): Boolean;
+var
+  pk: EVP_PKEY;
+  x: PX509;
+  rsa: PRSA;
+  t: PASN1_UTCTIME;
+  name: PX509_NAME;
+  b: PBIO;
+  xn, y: integer;
+  s: AnsiString;
+{$IFDEF CIL}
+  sb: StringBuilder;
+{$ENDIF}
+begin
+  Result := True;
+  pk := EvpPkeynew;
+  x := X509New;
+  try
+    rsa := RsaGenerateKey(1024, $10001, nil, nil);
+    EvpPkeyAssign(pk, EVP_PKEY_RSA, rsa);
+    X509SetVersion(x, 2);
+    Asn1IntegerSet(X509getSerialNumber(x), 0);
+    t := Asn1UtctimeNew;
+    try
+      X509GmtimeAdj(t, -60 * 60 *24);
+      X509SetNotBefore(x, t);
+      X509GmtimeAdj(t, 60 * 60 * 60 *24);
+      X509SetNotAfter(x, t);
+    finally
+      Asn1UtctimeFree(t);
+    end;
+    X509SetPubkey(x, pk);
+    Name := X509GetSubjectName(x);
+    X509NameAddEntryByTxt(Name, 'C', $1001, 'CZ', -1, -1, 0);
+    X509NameAddEntryByTxt(Name, 'CN', $1001, host, -1, -1, 0);
+    x509SetIssuerName(x, Name);
+    x509Sign(x, pk, EvpGetDigestByName('SHA1'));
+    b := BioNew(BioSMem);
+    try
+      i2dX509Bio(b, x);
+      xn := bioctrlpending(b);
+{$IFDEF CIL}
+      sb := StringBuilder.Create(xn);
+      y := bioread(b, sb, xn);
+      if y > 0 then
+      begin
+        sb.Length := y;
+        s := sb.ToString;
+      end;
+{$ELSE}
+      setlength(s, xn);
+      y := bioread(b, s, xn);
+      if y > 0 then
+        setlength(s, y);
+{$ENDIF}
+    finally
+      BioFreeAll(b);
+    end;
+    FCertificate := s;
+    b := BioNew(BioSMem);
+    try
+      i2dPrivatekeyBio(b, pk);
+      xn := bioctrlpending(b);
+{$IFDEF CIL}
+      sb := StringBuilder.Create(xn);
+      y := bioread(b, sb, xn);
+      if y > 0 then
+      begin
+        sb.Length := y;
+        s := sb.ToString;
+      end;
+{$ELSE}
+      setlength(s, xn);
+      y := bioread(b, s, xn);
+      if y > 0 then
+        setlength(s, y);
+{$ENDIF}
+    finally
+      BioFreeAll(b);
+    end;
+    FPrivatekey := s;
+  finally
+    X509free(x);
+    EvpPkeyFree(pk);
+  end;
+end;
+
+function TSSLOpenSSL.LoadPFX(pfxdata: Ansistring): Boolean;
+var
+  cert, pkey, ca: SslPtr;
+  b: PBIO;
+  p12: SslPtr;
+begin
+  Result := False;
+  b := BioNew(BioSMem);
+  try
+    BioWrite(b, pfxdata, Length(PfxData));
+    p12 := d2iPKCS12bio(b, nil);
+    if not Assigned(p12) then
+      Exit;
+    try
+      cert := nil;
+      pkey := nil;
+      ca := nil;
+      if PKCS12parse(p12, FKeyPassword, pkey, cert, ca) > 0 then
+        if SSLCTXusecertificate(Fctx, cert) > 0 then
+          if SSLCTXusePrivateKey(Fctx, pkey) > 0 then
+            Result := True;
+    finally
+      PKCS12free(p12);
+    end;
+  finally
+    BioFreeAll(b);
+  end;
+end;
+
+function TSSLOpenSSL.SetSslKeys: boolean;
+var
+  st: TFileStream;
+  s: string;
+begin
+  Result := False;
+  if not assigned(FCtx) then
+    Exit;
+  try
+    if FCertificateFile <> '' then
+      if SslCtxUseCertificateChainFile(FCtx, FCertificateFile) <> 1 then
+        if SslCtxUseCertificateFile(FCtx, FCertificateFile, SSL_FILETYPE_PEM) <> 1 then
+          if SslCtxUseCertificateFile(FCtx, FCertificateFile, SSL_FILETYPE_ASN1) <> 1 then
+            Exit;
+    if FCertificate <> '' then
+      if SslCtxUseCertificateASN1(FCtx, length(FCertificate), FCertificate) <> 1 then
+        Exit;
+    SSLCheck;
+    if FPrivateKeyFile <> '' then
+      if SslCtxUsePrivateKeyFile(FCtx, FPrivateKeyFile, SSL_FILETYPE_PEM) <> 1 then
+        if SslCtxUsePrivateKeyFile(FCtx, FPrivateKeyFile, SSL_FILETYPE_ASN1) <> 1 then
+          Exit;
+    if FPrivateKey <> '' then
+      if SslCtxUsePrivateKeyASN1(EVP_PKEY_RSA, FCtx, FPrivateKey, length(FPrivateKey)) <> 1 then
+        Exit;
+    SSLCheck;
+    if FCertCAFile <> '' then
+      if SslCtxLoadVerifyLocations(FCtx, FCertCAFile, '') <> 1 then
+        Exit;
+    if FPFXfile <> '' then
+    begin
+      try
+        st := TFileStream.Create(FPFXfile, fmOpenRead	 or fmShareDenyNone);
+        try
+          s := ReadStrFromStream(st, st.Size);
+        finally
+          st.Free;
+        end;
+        if not LoadPFX(s) then
+          Exit;
+      except
+        on Exception do
+          Exit;
+      end;
+    end;
+    if FPFX <> '' then
+      if not LoadPFX(FPfx) then
+        Exit;
+    SSLCheck;
+    Result := True;
+  finally
+    SSLCheck;
+  end;
+end;
+
+function TSSLOpenSSL.Init(server:Boolean): Boolean;
+var
+  s: AnsiString;
+begin
+  Result := False;
+  FLastErrorDesc := '';
+  FLastError := 0;
+  Fctx := nil;
+  case FSSLType of
+    LT_SSLv2:
+      Fctx := SslCtxNew(SslMethodV2);
+    LT_SSLv3:
+      Fctx := SslCtxNew(SslMethodV3);
+    LT_TLSv1:
+      Fctx := SslCtxNew(SslMethodTLSV1);
+    LT_all:
+      Fctx := SslCtxNew(SslMethodV23);
+  else
+    Exit;
+  end;
+  if Fctx = nil then
+  begin
+    SSLCheck;
+    Exit;
+  end
+  else
+  begin
+    s := FCiphers;
+    SslCtxSetCipherList(Fctx, s);
+    if FVerifyCert then
+      SslCtxSetVerify(FCtx, SSL_VERIFY_PEER, nil)
+    else
+      SslCtxSetVerify(FCtx, SSL_VERIFY_NONE, nil);
+{$IFNDEF CIL}
+    SslCtxSetDefaultPasswdCb(FCtx, @PasswordCallback);
+    SslCtxSetDefaultPasswdCbUserdata(FCtx, self);
+{$ENDIF}
+
+    if server and (FCertificateFile = '') and (FCertificate = '')
+      and (FPFXfile = '') and (FPFX = '') then
+    begin
+      CreateSelfSignedcert(FSocket.ResolveIPToName(FSocket.GetRemoteSinIP));
+    end;
+
+    if not SetSSLKeys then
+      Exit
+    else
+    begin
+      Fssl := nil;
+      Fssl := SslNew(Fctx);
+      if Fssl = nil then
+      begin
+        SSLCheck;
+        exit;
+      end;
+    end;
+  end;
+  Result := true;
+end;
+
+function TSSLOpenSSL.DeInit: Boolean;
+begin
+  Result := True;
+  if assigned (Fssl) then
+    sslfree(Fssl);
+  Fssl := nil;
+  if assigned (Fctx) then
+  begin
+    SslCtxFree(Fctx);
+    Fctx := nil;
+    ErrRemoveState(0);
+  end;
+  FSSLEnabled := False;
+end;
+
+function TSSLOpenSSL.Prepare(server:Boolean): Boolean;
+begin
+  Result := false;
+  DeInit;
+  if Init(server) then
+    Result := true
+  else
+    DeInit;
+end;
+
+function TSSLOpenSSL.Connect: boolean;
+var
+  x: integer;
+begin
+  Result := False;
+  if FSocket.Socket = INVALID_SOCKET then
+    Exit;
+  if Prepare(False) then
+  begin
+{$IFDEF CIL}
+    if sslsetfd(FSsl, FSocket.Socket.Handle.ToInt32) < 1 then
+{$ELSE}
+    if sslsetfd(FSsl, FSocket.Socket) < 1 then
+{$ENDIF}
+    begin
+      SSLCheck;
+      Exit;
+    end;
+    x := sslconnect(FSsl);
+    if x < 1 then
+    begin
+      SSLcheck;
+      Exit;
+    end;
+  if FverifyCert then
+    if GetVerifyCert <> 0 then
+      Exit;
+    FSSLEnabled := True;
+    Result := True;
+  end;
+end;
+
+function TSSLOpenSSL.Accept: boolean;
+var
+  x: integer;
+begin
+  Result := False;
+  if FSocket.Socket = INVALID_SOCKET then
+    Exit;
+  if Prepare(True) then
+  begin
+{$IFDEF CIL}
+    if sslsetfd(FSsl, FSocket.Socket.Handle.ToInt32) < 1 then
+{$ELSE}
+    if sslsetfd(FSsl, FSocket.Socket) < 1 then
+{$ENDIF}
+    begin
+      SSLCheck;
+      Exit;
+    end;
+    x := sslAccept(FSsl);
+    if x < 1 then
+    begin
+      SSLcheck;
+      Exit;
+    end;
+    FSSLEnabled := True;
+    Result := True;
+  end;
+end;
+
+function TSSLOpenSSL.Shutdown: boolean;
+begin
+  if assigned(FSsl) then
+    sslshutdown(FSsl);
+  DeInit;
+  Result := True;
+end;
+
+function TSSLOpenSSL.BiShutdown: boolean;
+var
+  x: integer;
+begin
+  if assigned(FSsl) then
+  begin
+    x := sslshutdown(FSsl);
+    if x = 0 then
+    begin
+      Synsock.Shutdown(FSocket.Socket, 1);
+      sslshutdown(FSsl);
+    end;
+  end;
+  DeInit;
+  Result := True;
+end;
+
+function TSSLOpenSSL.SendBuffer(Buffer: TMemory; Len: Integer): Integer;
+var
+  err: integer;
+{$IFDEF CIL}
+  s: ansistring;
+{$ENDIF}
+begin
+  FLastError := 0;
+  FLastErrorDesc := '';
+  repeat
+{$IFDEF CIL}
+    s := StringOf(Buffer);
+    Result := SslWrite(FSsl, s, Len);
+{$ELSE}
+    Result := SslWrite(FSsl, Buffer , Len);
+{$ENDIF}
+    err := SslGetError(FSsl, Result);
+  until (err <> SSL_ERROR_WANT_READ) and (err <> SSL_ERROR_WANT_WRITE);
+  if err = SSL_ERROR_ZERO_RETURN then
+    Result := 0
+  else
+    if (err <> 0) then
+      FLastError := err;
+end;
+
+function TSSLOpenSSL.RecvBuffer(Buffer: TMemory; Len: Integer): Integer;
+var
+  err: integer;
+{$IFDEF CIL}
+  sb: stringbuilder;
+  s: ansistring;
+{$ENDIF}
+begin
+  FLastError := 0;
+  FLastErrorDesc := '';
+  repeat
+{$IFDEF CIL}
+    sb := StringBuilder.Create(Len);
+    Result := SslRead(FSsl, sb, Len);
+    if Result > 0 then
+    begin
+      sb.Length := Result;
+      s := sb.ToString;
+      System.Array.Copy(BytesOf(s), Buffer, length(s));
+    end;
+{$ELSE}
+    Result := SslRead(FSsl, Buffer , Len);
+{$ENDIF}
+    err := SslGetError(FSsl, Result);
+  until (err <> SSL_ERROR_WANT_READ) and (err <> SSL_ERROR_WANT_WRITE);
+  if err = SSL_ERROR_ZERO_RETURN then
+    Result := 0;
+  if (err <> 0) then
+    FLastError := err;
+end;
+
+function TSSLOpenSSL.WaitingData: Integer;
+begin
+  Result := sslpending(Fssl);
+end;
+
+function TSSLOpenSSL.GetSSLVersion: string;
+begin
+  if not assigned(FSsl) then
+    Result := ''
+  else
+    Result := SSlGetVersion(FSsl);
+end;
+
+function TSSLOpenSSL.GetPeerSubject: string;
+var
+  cert: PX509;
+  s: ansistring;
+{$IFDEF CIL}
+  sb: StringBuilder;
+{$ENDIF}
+begin
+  if not assigned(FSsl) then
+  begin
+    Result := '';
+    Exit;
+  end;
+  cert := SSLGetPeerCertificate(Fssl);
+  if not assigned(cert) then
+  begin
+    Result := '';
+    Exit;
+  end;
+{$IFDEF CIL}
+  sb := StringBuilder.Create(4096);
+  Result := X509NameOneline(X509GetSubjectName(cert), sb, 4096);
+{$ELSE}
+  setlength(s, 4096);
+  Result := X509NameOneline(X509GetSubjectName(cert), s, Length(s));
+{$ENDIF}
+  X509Free(cert);
+end;
+
+function TSSLOpenSSL.GetPeerName: string;
+var
+  s: ansistring;
+begin
+  s := GetPeerSubject;
+  s := SeparateRight(s, '/CN=');
+  Result := Trim(SeparateLeft(s, '/'));
+end;
+
+function TSSLOpenSSL.GetPeerIssuer: string;
+var
+  cert: PX509;
+  s: ansistring;
+{$IFDEF CIL}
+  sb: StringBuilder;
+{$ENDIF}
+begin
+  if not assigned(FSsl) then
+  begin
+    Result := '';
+    Exit;
+  end;
+  cert := SSLGetPeerCertificate(Fssl);
+  if not assigned(cert) then
+  begin
+    Result := '';
+    Exit;
+  end;
+{$IFDEF CIL}
+  sb := StringBuilder.Create(4096);
+  Result := X509NameOneline(X509GetIssuerName(cert), sb, 4096);
+{$ELSE}
+  setlength(s, 4096);
+  Result := X509NameOneline(X509GetIssuerName(cert), s, Length(s));
+{$ENDIF}
+  X509Free(cert);
+end;
+
+function TSSLOpenSSL.GetPeerFingerprint: string;
+var
+  cert: PX509;
+  x: integer;
+{$IFDEF CIL}
+  sb: StringBuilder;
+{$ENDIF}
+begin
+  if not assigned(FSsl) then
+  begin
+    Result := '';
+    Exit;
+  end;
+  cert := SSLGetPeerCertificate(Fssl);
+  if not assigned(cert) then
+  begin
+    Result := '';
+    Exit;
+  end;
+{$IFDEF CIL}
+  sb := StringBuilder.Create(EVP_MAX_MD_SIZE);
+  X509Digest(cert, EvpGetDigestByName('MD5'), sb, x);
+  sb.Length := x;
+  Result := sb.ToString;
+{$ELSE}
+  setlength(Result, EVP_MAX_MD_SIZE);
+  X509Digest(cert, EvpGetDigestByName('MD5'), Result, x);
+  SetLength(Result, x);
+{$ENDIF}
+  X509Free(cert);
+end;
+
+function TSSLOpenSSL.GetCertInfo: string;
+var
+  cert: PX509;
+  x, y: integer;
+  b: PBIO;
+  s: AnsiString;
+{$IFDEF CIL}
+  sb: stringbuilder;
+{$ENDIF}
+begin
+  if not assigned(FSsl) then
+  begin
+    Result := '';
+    Exit;
+  end;
+  cert := SSLGetPeerCertificate(Fssl);
+  if not assigned(cert) then
+  begin
+    Result := '';
+    Exit;
+  end;
+  b := BioNew(BioSMem);
+  try
+    X509Print(b, cert);
+    x := bioctrlpending(b);
+{$IFDEF CIL}
+    sb := StringBuilder.Create(x);
+    y := bioread(b, sb, x);
+    if y > 0 then
+    begin
+      sb.Length := y;
+      s := sb.ToString;
+    end;
+{$ELSE}
+    setlength(s,x);
+    y := bioread(b,s,x);
+    if y > 0 then
+      setlength(s, y);
+{$ENDIF}
+    Result := ReplaceString(s, LF, CRLF);
+  finally
+    BioFreeAll(b);
+  end;
+end;
+
+function TSSLOpenSSL.GetCipherName: string;
+begin
+  if not assigned(FSsl) then
+    Result := ''
+  else
+    Result := SslCipherGetName(SslGetCurrentCipher(FSsl));
+end;
+
+function TSSLOpenSSL.GetCipherBits: integer;
+var
+  x: integer;
+begin
+  if not assigned(FSsl) then
+    Result := 0
+  else
+    Result := SSLCipherGetBits(SslGetCurrentCipher(FSsl), x);
+end;
+
+function TSSLOpenSSL.GetCipherAlgBits: integer;
+begin
+  if not assigned(FSsl) then
+    Result := 0
+  else
+    SSLCipherGetBits(SslGetCurrentCipher(FSsl), Result);
+end;
+
+function TSSLOpenSSL.GetVerifyCert: integer;
+begin
+  if not assigned(FSsl) then
+    Result := 1
+  else
+    Result := SslGetVerifyResult(FSsl);
+end;
+
+{==============================================================================}
+
+initialization
+  if InitSSLInterface then
+    SSLImplementation := TSSLOpenSSL;
+
+end.
diff --git a/Units/Synapse/ssl_openssl_lib.pas b/Units/Synapse/ssl_openssl_lib.pas
index b9fe056..fa85f70 100644
--- a/Units/Synapse/ssl_openssl_lib.pas
+++ b/Units/Synapse/ssl_openssl_lib.pas
@@ -1,2043 +1,2043 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 003.006.001 |
-|==============================================================================|
-| Content: SSL support by OpenSSL                                              |
-|==============================================================================|
-| Copyright (c)1999-2010, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2002-2010.                |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{
-Special thanks to Gregor Ibic <gregor.ibic@intelicom.si>
- (Intelicom d.o.o., http://www.intelicom.si)
- for good inspiration about begin with SSL programming.
-}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$H+}
-{$IFDEF VER125}
-  {$DEFINE BCB}
-{$ENDIF}
-{$IFDEF BCB}
-  {$ObjExportAll On}
-  (*$HPPEMIT 'namespace ssl_openssl_lib { using System::Shortint; }' *)
-{$ENDIF}
-
-//old Delphi does not have MSWINDOWS define.
-{$IFDEF WIN32}
-  {$IFNDEF MSWINDOWS}
-    {$DEFINE MSWINDOWS}
-  {$ENDIF}
-{$ENDIF}
-
-{:@abstract(OpenSSL support)
-
-This unit is Pascal interface to OpenSSL library (used by @link(ssl_openssl) unit).
-OpenSSL is loaded dynamicly on-demand. If this library is not found in system,
-requested OpenSSL function just return errorcode.
-}
-unit ssl_openssl_lib;
-
-interface
-
-uses
-{$IFDEF CIL}
-  System.Runtime.InteropServices,
-  System.Text,
-{$ENDIF}
-  Classes,
-  synafpc,
-{$IFNDEF MSWINDOWS}
-  Libc, SysUtils;
-{$ELSE}
-  Windows;
-{$ENDIF}
-
-
-{$IFDEF CIL}
-const
-  {$IFDEF LINUX}
-  DLLSSLName = 'libssl.so';
-  DLLUtilName = 'libcrypto.so';
-  {$ELSE}
-  DLLSSLName = 'ssleay32.dll';
-  DLLUtilName = 'libeay32.dll';
-  {$ENDIF}
-{$ELSE}
-var
-  {$IFNDEF MSWINDOWS}
-  DLLSSLName: string = 'libssl.so';
-  DLLUtilName: string = 'libcrypto.so';
-  {$ELSE}
-  DLLSSLName: string = 'ssleay32.dll';
-  DLLSSLName2: string = 'libssl32.dll';
-  DLLUtilName: string = 'libeay32.dll';
-  {$ENDIF}
-{$ENDIF}
-
-type
-{$IFDEF CIL}
-  SslPtr = IntPtr;
-{$ELSE}
-  SslPtr = Pointer;
-{$ENDIF}
-  PSslPtr = ^SslPtr;
-  PSSL_CTX = SslPtr;
-  PSSL = SslPtr;
-  PSSL_METHOD = SslPtr;
-  PX509 = SslPtr;
-  PX509_NAME = SslPtr;
-  PEVP_MD	= SslPtr;
-  PInteger = ^Integer;
-  PBIO_METHOD = SslPtr;
-  PBIO = SslPtr;
-  EVP_PKEY = SslPtr;
-  PRSA = SslPtr;
-  PASN1_UTCTIME = SslPtr;
-  PASN1_INTEGER = SslPtr;
-  PPasswdCb = SslPtr;
-  PFunction = procedure;
-
-  DES_cblock = array[0..7] of Byte;
-  PDES_cblock = ^DES_cblock;
-  des_ks_struct = packed record
-    ks: DES_cblock;
-    weak_key: Integer;
-  end;
-  des_key_schedule = array[1..16] of des_ks_struct;
-
-const
-  EVP_MAX_MD_SIZE = 16 + 20;
-
-  SSL_ERROR_NONE = 0;
-  SSL_ERROR_SSL = 1;
-  SSL_ERROR_WANT_READ = 2;
-  SSL_ERROR_WANT_WRITE = 3;
-  SSL_ERROR_WANT_X509_LOOKUP = 4;
-  SSL_ERROR_SYSCALL = 5; //look at error stack/return value/errno
-  SSL_ERROR_ZERO_RETURN = 6;
-  SSL_ERROR_WANT_CONNECT = 7;
-  SSL_ERROR_WANT_ACCEPT = 8;
-
-  SSL_OP_NO_SSLv2 = $01000000;
-  SSL_OP_NO_SSLv3 = $02000000;
-  SSL_OP_NO_TLSv1 = $04000000;
-  SSL_OP_ALL = $000FFFFF;
-  SSL_VERIFY_NONE = $00;
-  SSL_VERIFY_PEER = $01;
-
-  OPENSSL_DES_DECRYPT = 0;
-  OPENSSL_DES_ENCRYPT = 1;
-
-  X509_V_OK =	0;
-  X509_V_ILLEGAL = 1;
-  X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT = 2;
-  X509_V_ERR_UNABLE_TO_GET_CRL = 3;
-  X509_V_ERR_UNABLE_TO_DECRYPT_CERT_SIGNATURE = 4;
-  X509_V_ERR_UNABLE_TO_DECRYPT_CRL_SIGNATURE = 5;
-  X509_V_ERR_UNABLE_TO_DECODE_ISSUER_PUBLIC_KEY = 6;
-  X509_V_ERR_CERT_SIGNATURE_FAILURE = 7;
-  X509_V_ERR_CRL_SIGNATURE_FAILURE = 8;
-  X509_V_ERR_CERT_NOT_YET_VALID = 9;
-  X509_V_ERR_CERT_HAS_EXPIRED = 10;
-  X509_V_ERR_CRL_NOT_YET_VALID = 11;
-  X509_V_ERR_CRL_HAS_EXPIRED = 12;
-  X509_V_ERR_ERROR_IN_CERT_NOT_BEFORE_FIELD = 13;
-  X509_V_ERR_ERROR_IN_CERT_NOT_AFTER_FIELD = 14;
-  X509_V_ERR_ERROR_IN_CRL_LAST_UPDATE_FIELD = 15;
-  X509_V_ERR_ERROR_IN_CRL_NEXT_UPDATE_FIELD = 16;
-  X509_V_ERR_OUT_OF_MEM = 17;
-  X509_V_ERR_DEPTH_ZERO_SELF_SIGNED_CERT = 18;
-  X509_V_ERR_SELF_SIGNED_CERT_IN_CHAIN = 19;
-  X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT_LOCALLY = 20;
-  X509_V_ERR_UNABLE_TO_VERIFY_LEAF_SIGNATURE = 21;
-  X509_V_ERR_CERT_CHAIN_TOO_LONG = 22;
-  X509_V_ERR_CERT_REVOKED = 23;
-  X509_V_ERR_INVALID_CA = 24;
-  X509_V_ERR_PATH_LENGTH_EXCEEDED = 25;
-  X509_V_ERR_INVALID_PURPOSE = 26;
-  X509_V_ERR_CERT_UNTRUSTED = 27;
-  X509_V_ERR_CERT_REJECTED = 28;
-  //These are 'informational' when looking for issuer cert
-  X509_V_ERR_SUBJECT_ISSUER_MISMATCH = 29;
-  X509_V_ERR_AKID_SKID_MISMATCH = 30;
-  X509_V_ERR_AKID_ISSUER_SERIAL_MISMATCH = 31;
-  X509_V_ERR_KEYUSAGE_NO_CERTSIGN = 32;
-  X509_V_ERR_UNABLE_TO_GET_CRL_ISSUER = 33;
-  X509_V_ERR_UNHANDLED_CRITICAL_EXTENSION = 34;
-  //The application is not happy
-  X509_V_ERR_APPLICATION_VERIFICATION = 50;
-
-  SSL_FILETYPE_ASN1	= 2;
-  SSL_FILETYPE_PEM = 1;
-  EVP_PKEY_RSA = 6;
-
-var
-  SSLLibHandle: TLibHandle = 0;
-  SSLUtilHandle: TLibHandle = 0;
-  SSLLibFile: string = '';
-  SSLUtilFile: string = '';
-
-{$IFDEF CIL}
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_get_error')]
-    function SslGetError(s: PSSL; ret_code: Integer): Integer; external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_library_init')]
-    function SslLibraryInit: Integer; external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_load_error_strings')]
-    procedure SslLoadErrorStrings; external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_CTX_set_cipher_list')]
-    function SslCtxSetCipherList(arg0: PSSL_CTX; var str: String): Integer; external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_CTX_new')]
-    function SslCtxNew(meth: PSSL_METHOD):PSSL_CTX;  external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_CTX_free')]
-    procedure SslCtxFree (arg0: PSSL_CTX);   external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_set_fd')]
-    function SslSetFd(s: PSSL; fd: Integer):Integer;    external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSLv2_method')]
-    function SslMethodV2 : PSSL_METHOD; external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSLv3_method')]
-    function SslMethodV3 : PSSL_METHOD;  external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'TLSv1_method')]
-    function SslMethodTLSV1:PSSL_METHOD;  external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSLv23_method')]
-    function SslMethodV23 : PSSL_METHOD; external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_CTX_use_PrivateKey')]
-    function SslCtxUsePrivateKey(ctx: PSSL_CTX; pkey: SslPtr):Integer;  external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_CTX_use_PrivateKey_ASN1')]
-    function SslCtxUsePrivateKeyASN1(pk: integer; ctx: PSSL_CTX; d: String; len: integer):Integer;  external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_CTX_use_RSAPrivateKey_file')]
-    function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: String; _type: Integer):Integer;  external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_CTX_use_certificate')]
-    function SslCtxUseCertificate(ctx: PSSL_CTX; x: SslPtr):Integer; external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_CTX_use_certificate_ASN1')]
-    function SslCtxUseCertificateASN1(ctx: PSSL_CTX; len: integer; d: String):Integer; external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_CTX_use_certificate_file')]
-    function SslCtxUseCertificateFile(ctx: PSSL_CTX; const _file: String; _type: Integer):Integer;external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_CTX_use_certificate_chain_file')]
-    function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: String):Integer;external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_CTX_check_private_key')]
-    function SslCtxCheckPrivateKeyFile(ctx: PSSL_CTX):Integer; external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_CTX_set_default_passwd_cb')]
-    procedure SslCtxSetDefaultPasswdCb(ctx: PSSL_CTX; cb: PPasswdCb); external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_CTX_set_default_passwd_cb_userdata')]
-    procedure SslCtxSetDefaultPasswdCbUserdata(ctx: PSSL_CTX; u: IntPtr); external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_CTX_load_verify_locations')]
-    function SslCtxLoadVerifyLocations(ctx: PSSL_CTX; CAfile: string; CApath: String):Integer; external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_CTX_ctrl')]
-    function SslCtxCtrl(ctx: PSSL_CTX; cmd: integer; larg: integer; parg: IntPtr): integer; external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_new')]
-    function SslNew(ctx: PSSL_CTX):PSSL;  external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_free')]
-    procedure SslFree(ssl: PSSL); external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_accept')]
-    function SslAccept(ssl: PSSL):Integer; external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_connect')]
-    function SslConnect(ssl: PSSL):Integer; external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_shutdown')]
-    function SslShutdown(s: PSSL):Integer;  external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_read')]
-    function SslRead(ssl: PSSL; buf: StringBuilder; num: Integer):Integer; external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_peek')]
-    function SslPeek(ssl: PSSL; buf: StringBuilder; num: Integer):Integer; external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_write')]
-    function SslWrite(ssl: PSSL; buf: String; num: Integer):Integer; external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_pending')]
-    function SslPending(ssl: PSSL):Integer; external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_get_version')]
-    function SslGetVersion(ssl: PSSL):String; external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_get_peer_certificate')]
-    function SslGetPeerCertificate(s: PSSL):PX509; external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_CTX_set_verify')]
-    procedure SslCtxSetVerify(ctx: PSSL_CTX; mode: Integer; arg2: PFunction); external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_get_current_cipher')]
-    function SSLGetCurrentCipher(s: PSSL): SslPtr;  external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_CIPHER_get_name')]
-    function SSLCipherGetName(c: SslPtr):String; external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_CIPHER_get_bits')]
-    function SSLCipherGetBits(c: SslPtr; var alg_bits: Integer):Integer;  external;
-
-  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'SSL_get_verify_result')]
-    function SSLGetVerifyResult(ssl: PSSL):Integer;external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'X509_new')]
-    function X509New: PX509; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'X509_free')]
-    procedure X509Free(x: PX509); external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'X509_NAME_oneline')]
-    function X509NameOneline(a: PX509_NAME; buf: StringBuilder; size: Integer): String; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'X509_get_subject_name')]
-    function X509GetSubjectName(a: PX509):PX509_NAME; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'X509_get_issuer_name')]
-    function X509GetIssuerName(a: PX509):PX509_NAME;  external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'X509_NAME_hash')]
-    function X509NameHash(x: PX509_NAME):Cardinal;   external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'X509_digest')]
-    function X509Digest (data: PX509; _type: PEVP_MD; md: StringBuilder; var len: Integer):Integer; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'X509_set_version')]
-    function X509SetVersion(x: PX509; version: integer): integer; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'X509_set_pubkey')]
-    function X509SetPubkey(x: PX509; pkey: EVP_PKEY): integer; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'X509_set_issuer_name')]
-    function X509SetIssuerName(x: PX509; name: PX509_NAME): integer; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'X509_NAME_add_entry_by_txt')]
-    function X509NameAddEntryByTxt(name: PX509_NAME; field: string; _type: integer;
-      bytes: string; len, loc, _set: integer): integer; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'X509_sign')]
-    function X509Sign(x: PX509; pkey: EVP_PKEY; const md: PEVP_MD): integer; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'X509_print')]
-    function X509print(b: PBIO; a: PX509): integer; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'X509_gmtime_adj')]
-    function X509GmtimeAdj(s: PASN1_UTCTIME; adj: integer): PASN1_UTCTIME; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'X509_set_notBefore')]
-    function X509SetNotBefore(x: PX509; tm: PASN1_UTCTIME): integer; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'X509_set_notAfter')]
-    function X509SetNotAfter(x: PX509; tm: PASN1_UTCTIME): integer; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'X509_get_serialNumber')]
-    function X509GetSerialNumber(x: PX509): PASN1_INTEGER; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'EVP_PKEY_new')]
-    function EvpPkeyNew: EVP_PKEY; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'EVP_PKEY_free')]
-    procedure EvpPkeyFree(pk: EVP_PKEY); external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'EVP_PKEY_assign')]
-    function EvpPkeyAssign(pkey: EVP_PKEY; _type: integer; key: Prsa): integer; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'EVP_get_digestbyname')]
-    function EvpGetDigestByName(Name: String): PEVP_MD; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'EVP_cleanup')]
-    procedure EVPcleanup; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'SSLeay_version')]
-    function SSLeayversion(t: integer): String; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'ERR_error_string_n')]
-    procedure ErrErrorString(e: integer; buf: StringBuilder; len: integer); external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'ERR_get_error')]
-    function ErrGetError: integer; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'ERR_clear_error')]
-    procedure ErrClearError; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'ERR_free_strings')]
-    procedure ErrFreeStrings; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'ERR_remove_state')]
-    procedure ErrRemoveState(pid: integer); external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'OPENSSL_add_all_algorithms_noconf')]
-    procedure OPENSSLaddallalgorithms; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'CRYPTO_cleanup_all_ex_data')]
-    procedure CRYPTOcleanupAllExData; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'RAND_screen')]
-    procedure RandScreen; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'BIO_new')]
-    function BioNew(b: PBIO_METHOD): PBIO; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'BIO_free_all')]
-    procedure BioFreeAll(b: PBIO); external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'BIO_s_mem')]
-    function BioSMem: PBIO_METHOD; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'BIO_ctrl_pending')]
-    function BioCtrlPending(b: PBIO): integer; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'BIO_read')]
-    function BioRead(b: PBIO; Buf: StringBuilder; Len: integer): integer; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'BIO_write')]
-    function BioWrite(b: PBIO; var Buf: String; Len: integer): integer; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'd2i_PKCS12_bio')]
-    function d2iPKCS12bio(b:PBIO; Pkcs12: SslPtr): SslPtr; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'PKCS12_parse')]
-    function PKCS12parse(p12: SslPtr; pass: string; var pkey, cert, ca: SslPtr): integer; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'PKCS12_free')]
-    procedure PKCS12free(p12: SslPtr); external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'RSA_generate_key')]
-    function RsaGenerateKey(bits, e: integer; callback: PFunction; cb_arg: SslPtr): PRSA; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'ASN1_UTCTIME_new')]
-    function Asn1UtctimeNew: PASN1_UTCTIME; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'ASN1_UTCTIME_free')]
-    procedure Asn1UtctimeFree(a: PASN1_UTCTIME); external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'ASN1_INTEGER_set')]
-    function Asn1IntegerSet(a: PASN1_INTEGER; v: integer): integer; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'i2d_X509_bio')]
-    function i2dX509bio(b: PBIO; x: PX509): integer; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint =  'i2d_PrivateKey_bio')]
-    function i2dPrivateKeyBio(b: PBIO; pkey: EVP_PKEY): integer; external;
-
-  // 3DES functions
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'DES_set_odd_parity')]
-    procedure DESsetoddparity(Key: des_cblock); external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'DES_set_key_checked')]
-    function DESsetkeychecked(key: des_cblock; schedule: des_key_schedule): Integer; external;
-
-  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'DES_ecb_encrypt')]
-    procedure DESecbencrypt(Input: des_cblock; output: des_cblock; ks: des_key_schedule; enc: Integer); external;
-
-{$ELSE}
-// libssl.dll
-  function SslGetError(s: PSSL; ret_code: Integer):Integer;
-  function SslLibraryInit:Integer;
-  procedure SslLoadErrorStrings;
-//  function SslCtxSetCipherList(arg0: PSSL_CTX; str: PChar):Integer;
-  function SslCtxSetCipherList(arg0: PSSL_CTX; var str: AnsiString):Integer;
-  function SslCtxNew(meth: PSSL_METHOD):PSSL_CTX;
-  procedure SslCtxFree(arg0: PSSL_CTX);
-  function SslSetFd(s: PSSL; fd: Integer):Integer;
-  function SslMethodV2:PSSL_METHOD;
-  function SslMethodV3:PSSL_METHOD;
-  function SslMethodTLSV1:PSSL_METHOD;
-  function SslMethodV23:PSSL_METHOD;
-  function SslCtxUsePrivateKey(ctx: PSSL_CTX; pkey: SslPtr):Integer;
-  function SslCtxUsePrivateKeyASN1(pk: integer; ctx: PSSL_CTX; d: AnsiString; len: integer):Integer;
-//  function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: PChar; _type: Integer):Integer;
-  function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: AnsiString; _type: Integer):Integer;
-  function SslCtxUseCertificate(ctx: PSSL_CTX; x: SslPtr):Integer;
-  function SslCtxUseCertificateASN1(ctx: PSSL_CTX; len: integer; d: AnsiString):Integer;
-  function SslCtxUseCertificateFile(ctx: PSSL_CTX; const _file: AnsiString; _type: Integer):Integer;
-//  function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: PChar):Integer;
-  function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: AnsiString):Integer;
-  function SslCtxCheckPrivateKeyFile(ctx: PSSL_CTX):Integer;
-  procedure SslCtxSetDefaultPasswdCb(ctx: PSSL_CTX; cb: PPasswdCb);
-  procedure SslCtxSetDefaultPasswdCbUserdata(ctx: PSSL_CTX; u: SslPtr);
-//  function SslCtxLoadVerifyLocations(ctx: PSSL_CTX; const CAfile: PChar; const CApath: PChar):Integer;
-  function SslCtxLoadVerifyLocations(ctx: PSSL_CTX; const CAfile: AnsiString; const CApath: AnsiString):Integer;
-  function SslCtxCtrl(ctx: PSSL_CTX; cmd: integer; larg: integer; parg: SslPtr): integer;
-  function SslNew(ctx: PSSL_CTX):PSSL;
-  procedure SslFree(ssl: PSSL);
-  function SslAccept(ssl: PSSL):Integer;
-  function SslConnect(ssl: PSSL):Integer;
-  function SslShutdown(ssl: PSSL):Integer;
-  function SslRead(ssl: PSSL; buf: SslPtr; num: Integer):Integer;
-  function SslPeek(ssl: PSSL; buf: SslPtr; num: Integer):Integer;
-  function SslWrite(ssl: PSSL; buf: SslPtr; num: Integer):Integer;
-  function SslPending(ssl: PSSL):Integer;
-  function SslGetVersion(ssl: PSSL):AnsiString;
-  function SslGetPeerCertificate(ssl: PSSL):PX509;
-  procedure SslCtxSetVerify(ctx: PSSL_CTX; mode: Integer; arg2: PFunction);
-  function SSLGetCurrentCipher(s: PSSL):SslPtr;
-  function SSLCipherGetName(c: SslPtr): AnsiString;
-  function SSLCipherGetBits(c: SslPtr; var alg_bits: Integer):Integer;
-  function SSLGetVerifyResult(ssl: PSSL):Integer;
-
-// libeay.dll
-  function X509New: PX509;
-  procedure X509Free(x: PX509);
-  function X509NameOneline(a: PX509_NAME; var buf: AnsiString; size: Integer):AnsiString;
-  function X509GetSubjectName(a: PX509):PX509_NAME;
-  function X509GetIssuerName(a: PX509):PX509_NAME;
-  function X509NameHash(x: PX509_NAME):Cardinal;
-//  function SslX509Digest(data: PX509; _type: PEVP_MD; md: PChar; len: PInteger):Integer;
-  function X509Digest(data: PX509; _type: PEVP_MD; md: AnsiString; var len: Integer):Integer;
-  function X509print(b: PBIO; a: PX509): integer;
-  function X509SetVersion(x: PX509; version: integer): integer;
-  function X509SetPubkey(x: PX509; pkey: EVP_PKEY): integer;
-  function X509SetIssuerName(x: PX509; name: PX509_NAME): integer;
-  function X509NameAddEntryByTxt(name: PX509_NAME; field: Ansistring; _type: integer;
-    bytes: Ansistring; len, loc, _set: integer): integer;
-  function X509Sign(x: PX509; pkey: EVP_PKEY; const md: PEVP_MD): integer;
-  function X509GmtimeAdj(s: PASN1_UTCTIME; adj: integer): PASN1_UTCTIME;
-  function X509SetNotBefore(x: PX509; tm: PASN1_UTCTIME): integer;
-  function X509SetNotAfter(x: PX509; tm: PASN1_UTCTIME): integer;
-  function X509GetSerialNumber(x: PX509): PASN1_INTEGER;
-  function EvpPkeyNew: EVP_PKEY;
-  procedure EvpPkeyFree(pk: EVP_PKEY);
-  function EvpPkeyAssign(pkey: EVP_PKEY; _type: integer; key: Prsa): integer;
-  function EvpGetDigestByName(Name: AnsiString): PEVP_MD;
-  procedure EVPcleanup;
-//  function ErrErrorString(e: integer; buf: PChar): PChar;
-  function SSLeayversion(t: integer): Ansistring;
-  procedure ErrErrorString(e: integer; var buf: Ansistring; len: integer);
-  function ErrGetError: integer;
-  procedure ErrClearError;
-  procedure ErrFreeStrings;
-  procedure ErrRemoveState(pid: integer);
-  procedure OPENSSLaddallalgorithms;
-  procedure CRYPTOcleanupAllExData;
-  procedure RandScreen;
-  function BioNew(b: PBIO_METHOD): PBIO;
-  procedure BioFreeAll(b: PBIO);
-  function BioSMem: PBIO_METHOD;
-  function BioCtrlPending(b: PBIO): integer;
-  function BioRead(b: PBIO; var Buf: AnsiString; Len: integer): integer;
-  function BioWrite(b: PBIO; Buf: AnsiString; Len: integer): integer;
-  function d2iPKCS12bio(b:PBIO; Pkcs12: SslPtr): SslPtr;
-  function PKCS12parse(p12: SslPtr; pass: Ansistring; var pkey, cert, ca: SslPtr): integer;
-  procedure PKCS12free(p12: SslPtr);
-  function RsaGenerateKey(bits, e: integer; callback: PFunction; cb_arg: SslPtr): PRSA;
-  function Asn1UtctimeNew: PASN1_UTCTIME;
-  procedure Asn1UtctimeFree(a: PASN1_UTCTIME);
-  function Asn1IntegerSet(a: PASN1_INTEGER; v: integer): integer;
-  function i2dX509bio(b: PBIO; x: PX509): integer;
-  function i2dPrivateKeyBio(b: PBIO; pkey: EVP_PKEY): integer;
-
-  // 3DES functions
-  procedure DESsetoddparity(Key: des_cblock);
-  function DESsetkeychecked(key: des_cblock; schedule: des_key_schedule): Integer;
-  procedure DESecbencrypt(Input: des_cblock; output: des_cblock; ks: des_key_schedule; enc: Integer);
-
-{$ENDIF}
-
-function IsSSLloaded: Boolean;
-function InitSSLInterface: Boolean;
-function DestroySSLInterface: Boolean;
-
-implementation
-
-uses SyncObjs;
-
-{$IFNDEF CIL}
-type
-// libssl.dll
-  TSslGetError = function(s: PSSL; ret_code: Integer):Integer; cdecl;
-  TSslLibraryInit = function:Integer; cdecl;
-  TSslLoadErrorStrings = procedure; cdecl;
-  TSslCtxSetCipherList = function(arg0: PSSL_CTX; str: PAnsiChar):Integer; cdecl;
-  TSslCtxNew = function(meth: PSSL_METHOD):PSSL_CTX; cdecl;
-  TSslCtxFree = procedure(arg0: PSSL_CTX); cdecl;
-  TSslSetFd = function(s: PSSL; fd: Integer):Integer; cdecl;
-  TSslMethodV2 = function:PSSL_METHOD; cdecl;
-  TSslMethodV3 = function:PSSL_METHOD; cdecl;
-  TSslMethodTLSV1 = function:PSSL_METHOD; cdecl;
-  TSslMethodV23 = function:PSSL_METHOD; cdecl;
-  TSslCtxUsePrivateKey = function(ctx: PSSL_CTX; pkey: sslptr):Integer; cdecl;
-  TSslCtxUsePrivateKeyASN1 = function(pk: integer; ctx: PSSL_CTX; d: sslptr; len: integer):Integer; cdecl;
-  TSslCtxUsePrivateKeyFile = function(ctx: PSSL_CTX; const _file: PAnsiChar; _type: Integer):Integer; cdecl;
-  TSslCtxUseCertificate = function(ctx: PSSL_CTX; x: SslPtr):Integer; cdecl;
-  TSslCtxUseCertificateASN1 = function(ctx: PSSL_CTX; len: Integer; d: SslPtr):Integer; cdecl;
-  TSslCtxUseCertificateFile = function(ctx: PSSL_CTX; const _file: PAnsiChar; _type: Integer):Integer; cdecl;
-  TSslCtxUseCertificateChainFile = function(ctx: PSSL_CTX; const _file: PAnsiChar):Integer; cdecl;
-  TSslCtxCheckPrivateKeyFile = function(ctx: PSSL_CTX):Integer; cdecl;
-  TSslCtxSetDefaultPasswdCb = procedure(ctx: PSSL_CTX; cb: SslPtr); cdecl;
-  TSslCtxSetDefaultPasswdCbUserdata = procedure(ctx: PSSL_CTX; u: SslPtr); cdecl;
-  TSslCtxLoadVerifyLocations = function(ctx: PSSL_CTX; const CAfile: PAnsiChar; const CApath: PAnsiChar):Integer; cdecl;
-  TSslCtxCtrl = function(ctx: PSSL_CTX; cmd: integer; larg: integer; parg: SslPtr): integer; cdecl;
-  TSslNew = function(ctx: PSSL_CTX):PSSL; cdecl;
-  TSslFree = procedure(ssl: PSSL); cdecl;
-  TSslAccept = function(ssl: PSSL):Integer; cdecl;
-  TSslConnect = function(ssl: PSSL):Integer; cdecl;
-  TSslShutdown = function(ssl: PSSL):Integer; cdecl;
-  TSslRead = function(ssl: PSSL; buf: PAnsiChar; num: Integer):Integer; cdecl;
-  TSslPeek = function(ssl: PSSL; buf: PAnsiChar; num: Integer):Integer; cdecl;
-  TSslWrite = function(ssl: PSSL; const buf: PAnsiChar; num: Integer):Integer; cdecl;
-  TSslPending = function(ssl: PSSL):Integer; cdecl;
-  TSslGetVersion = function(ssl: PSSL):PAnsiChar; cdecl;
-  TSslGetPeerCertificate = function(ssl: PSSL):PX509; cdecl;
-  TSslCtxSetVerify = procedure(ctx: PSSL_CTX; mode: Integer; arg2: SslPtr); cdecl;
-  TSSLGetCurrentCipher = function(s: PSSL):SslPtr; cdecl;
-  TSSLCipherGetName = function(c: Sslptr):PAnsiChar; cdecl;
-  TSSLCipherGetBits = function(c: SslPtr; alg_bits: PInteger):Integer; cdecl;
-  TSSLGetVerifyResult = function(ssl: PSSL):Integer; cdecl;
-
-// libeay.dll
-  TX509New = function: PX509; cdecl;
-  TX509Free = procedure(x: PX509); cdecl;
-  TX509NameOneline = function(a: PX509_NAME; buf: PAnsiChar; size: Integer):PAnsiChar; cdecl;
-  TX509GetSubjectName = function(a: PX509):PX509_NAME; cdecl;
-  TX509GetIssuerName = function(a: PX509):PX509_NAME; cdecl;
-  TX509NameHash = function(x: PX509_NAME):Cardinal; cdecl;
-  TX509Digest = function(data: PX509; _type: PEVP_MD; md: PAnsiChar; len: PInteger):Integer; cdecl;
-  TX509print = function(b: PBIO; a: PX509): integer; cdecl;
-  TX509SetVersion = function(x: PX509; version: integer): integer; cdecl;
-  TX509SetPubkey = function(x: PX509; pkey: EVP_PKEY): integer; cdecl;
-  TX509SetIssuerName = function(x: PX509; name: PX509_NAME): integer; cdecl;
-  TX509NameAddEntryByTxt = function(name: PX509_NAME; field: PAnsiChar; _type: integer;
-    bytes: PAnsiChar; len, loc, _set: integer): integer; cdecl;
-  TX509Sign = function(x: PX509; pkey: EVP_PKEY; const md: PEVP_MD): integer; cdecl;
-  TX509GmtimeAdj = function(s: PASN1_UTCTIME; adj: integer): PASN1_UTCTIME; cdecl;
-  TX509SetNotBefore = function(x: PX509; tm: PASN1_UTCTIME): integer; cdecl;
-  TX509SetNotAfter = function(x: PX509; tm: PASN1_UTCTIME): integer; cdecl;
-  TX509GetSerialNumber = function(x: PX509): PASN1_INTEGER; cdecl;
-  TEvpPkeyNew = function: EVP_PKEY; cdecl;
-  TEvpPkeyFree = procedure(pk: EVP_PKEY); cdecl;
-  TEvpPkeyAssign = function(pkey: EVP_PKEY; _type: integer; key: Prsa): integer; cdecl;
-  TEvpGetDigestByName = function(Name: PAnsiChar): PEVP_MD; cdecl;
-  TEVPcleanup = procedure; cdecl;
-  TSSLeayversion = function(t: integer): PAnsiChar; cdecl;
-  TErrErrorString = procedure(e: integer; buf: PAnsiChar; len: integer); cdecl;
-  TErrGetError = function: integer; cdecl;
-  TErrClearError = procedure; cdecl;
-  TErrFreeStrings = procedure; cdecl;
-  TErrRemoveState = procedure(pid: integer); cdecl;
-  TOPENSSLaddallalgorithms = procedure; cdecl;
-  TCRYPTOcleanupAllExData = procedure; cdecl;
-  TRandScreen = procedure; cdecl;
-  TBioNew = function(b: PBIO_METHOD): PBIO; cdecl;
-  TBioFreeAll = procedure(b: PBIO); cdecl;
-  TBioSMem = function: PBIO_METHOD; cdecl;
-  TBioCtrlPending = function(b: PBIO): integer; cdecl;
-  TBioRead = function(b: PBIO; Buf: PAnsiChar; Len: integer): integer; cdecl;
-  TBioWrite = function(b: PBIO; Buf: PAnsiChar; Len: integer): integer; cdecl;
-  Td2iPKCS12bio = function(b:PBIO; Pkcs12: SslPtr): SslPtr; cdecl;
-  TPKCS12parse = function(p12: SslPtr; pass: PAnsiChar; var pkey, cert, ca: SslPtr): integer; cdecl;
-  TPKCS12free = procedure(p12: SslPtr); cdecl;
-  TRsaGenerateKey = function(bits, e: integer; callback: PFunction; cb_arg: SslPtr): PRSA; cdecl;
-  TAsn1UtctimeNew = function: PASN1_UTCTIME; cdecl;
-  TAsn1UtctimeFree = procedure(a: PASN1_UTCTIME); cdecl;
-  TAsn1IntegerSet = function(a: PASN1_INTEGER; v: integer): integer; cdecl;
-  Ti2dX509bio = function(b: PBIO; x: PX509): integer; cdecl;
-  Ti2dPrivateKeyBio= function(b: PBIO; pkey: EVP_PKEY): integer; cdecl;
-
-  // 3DES functions
-  TDESsetoddparity = procedure(Key: des_cblock); cdecl;
-  TDESsetkeychecked = function(key: des_cblock; schedule: des_key_schedule): Integer; cdecl;
-  TDESecbencrypt = procedure(Input: des_cblock; output: des_cblock; ks: des_key_schedule; enc: Integer); cdecl;
-  //thread lock functions
-  TCRYPTOnumlocks = function: integer; cdecl;
-  TCRYPTOSetLockingCallback = procedure(cb: Sslptr); cdecl;
-
-var
-// libssl.dll
-  _SslGetError: TSslGetError = nil;
-  _SslLibraryInit: TSslLibraryInit = nil;
-  _SslLoadErrorStrings: TSslLoadErrorStrings = nil;
-  _SslCtxSetCipherList: TSslCtxSetCipherList = nil;
-  _SslCtxNew: TSslCtxNew = nil;
-  _SslCtxFree: TSslCtxFree = nil;
-  _SslSetFd: TSslSetFd = nil;
-  _SslMethodV2: TSslMethodV2 = nil;
-  _SslMethodV3: TSslMethodV3 = nil;
-  _SslMethodTLSV1: TSslMethodTLSV1 = nil;
-  _SslMethodV23: TSslMethodV23 = nil;
-  _SslCtxUsePrivateKey: TSslCtxUsePrivateKey = nil;
-  _SslCtxUsePrivateKeyASN1: TSslCtxUsePrivateKeyASN1 = nil;
-  _SslCtxUsePrivateKeyFile: TSslCtxUsePrivateKeyFile = nil;
-  _SslCtxUseCertificate: TSslCtxUseCertificate = nil;
-  _SslCtxUseCertificateASN1: TSslCtxUseCertificateASN1 = nil;
-  _SslCtxUseCertificateFile: TSslCtxUseCertificateFile = nil;
-  _SslCtxUseCertificateChainFile: TSslCtxUseCertificateChainFile = nil;
-  _SslCtxCheckPrivateKeyFile: TSslCtxCheckPrivateKeyFile = nil;
-  _SslCtxSetDefaultPasswdCb: TSslCtxSetDefaultPasswdCb = nil;
-  _SslCtxSetDefaultPasswdCbUserdata: TSslCtxSetDefaultPasswdCbUserdata = nil;
-  _SslCtxLoadVerifyLocations: TSslCtxLoadVerifyLocations = nil;
-  _SslCtxCtrl: TSslCtxCtrl = nil;
-  _SslNew: TSslNew = nil;
-  _SslFree: TSslFree = nil;
-  _SslAccept: TSslAccept = nil;
-  _SslConnect: TSslConnect = nil;
-  _SslShutdown: TSslShutdown = nil;
-  _SslRead: TSslRead = nil;
-  _SslPeek: TSslPeek = nil;
-  _SslWrite: TSslWrite = nil;
-  _SslPending: TSslPending = nil;
-  _SslGetVersion: TSslGetVersion = nil;
-  _SslGetPeerCertificate: TSslGetPeerCertificate = nil;
-  _SslCtxSetVerify: TSslCtxSetVerify = nil;
-  _SSLGetCurrentCipher: TSSLGetCurrentCipher = nil;
-  _SSLCipherGetName: TSSLCipherGetName = nil;
-  _SSLCipherGetBits: TSSLCipherGetBits = nil;
-  _SSLGetVerifyResult: TSSLGetVerifyResult = nil;
-
-// libeay.dll
-  _X509New: TX509New = nil;
-  _X509Free: TX509Free = nil;
-  _X509NameOneline: TX509NameOneline = nil;
-  _X509GetSubjectName: TX509GetSubjectName = nil;
-  _X509GetIssuerName: TX509GetIssuerName = nil;
-  _X509NameHash: TX509NameHash = nil;
-  _X509Digest: TX509Digest = nil;
-  _X509print: TX509print = nil;
-  _X509SetVersion: TX509SetVersion = nil;
-  _X509SetPubkey: TX509SetPubkey = nil;
-  _X509SetIssuerName: TX509SetIssuerName = nil;
-  _X509NameAddEntryByTxt: TX509NameAddEntryByTxt = nil;
-  _X509Sign: TX509Sign = nil;
-  _X509GmtimeAdj: TX509GmtimeAdj = nil;
-  _X509SetNotBefore: TX509SetNotBefore = nil;
-  _X509SetNotAfter: TX509SetNotAfter = nil;
-  _X509GetSerialNumber: TX509GetSerialNumber = nil;
-  _EvpPkeyNew: TEvpPkeyNew = nil;
-  _EvpPkeyFree: TEvpPkeyFree = nil;
-  _EvpPkeyAssign: TEvpPkeyAssign = nil;
-  _EvpGetDigestByName: TEvpGetDigestByName = nil;
-  _EVPcleanup: TEVPcleanup = nil;
-  _SSLeayversion: TSSLeayversion = nil;
-  _ErrErrorString: TErrErrorString = nil;
-  _ErrGetError: TErrGetError = nil;
-  _ErrClearError: TErrClearError = nil;
-  _ErrFreeStrings: TErrFreeStrings = nil;
-  _ErrRemoveState: TErrRemoveState = nil;
-  _OPENSSLaddallalgorithms: TOPENSSLaddallalgorithms = nil;
-  _CRYPTOcleanupAllExData: TCRYPTOcleanupAllExData = nil;
-  _RandScreen: TRandScreen = nil;
-  _BioNew: TBioNew = nil;
-  _BioFreeAll: TBioFreeAll = nil;
-  _BioSMem: TBioSMem = nil;
-  _BioCtrlPending: TBioCtrlPending = nil;
-  _BioRead: TBioRead = nil;
-  _BioWrite: TBioWrite = nil;
-  _d2iPKCS12bio: Td2iPKCS12bio = nil;
-  _PKCS12parse: TPKCS12parse = nil;
-  _PKCS12free: TPKCS12free = nil;
-  _RsaGenerateKey: TRsaGenerateKey = nil;
-  _Asn1UtctimeNew: TAsn1UtctimeNew = nil;
-  _Asn1UtctimeFree: TAsn1UtctimeFree = nil;
-  _Asn1IntegerSet: TAsn1IntegerSet = nil;
-  _i2dX509bio: Ti2dX509bio = nil;
-  _i2dPrivateKeyBio: Ti2dPrivateKeyBio = nil;
-
-  // 3DES functions
-  _DESsetoddparity: TDESsetoddparity = nil;
-  _DESsetkeychecked: TDESsetkeychecked = nil;
-  _DESecbencrypt: TDESecbencrypt = nil;
-  //thread lock functions
-  _CRYPTOnumlocks: TCRYPTOnumlocks = nil;
-  _CRYPTOSetLockingCallback: TCRYPTOSetLockingCallback = nil;
-{$ENDIF}
-
-var
-  SSLCS: TCriticalSection;
-  SSLloaded: boolean = false;
-{$IFNDEF CIL}
-  Locks: TList;
-{$ENDIF}
-
-{$IFNDEF CIL}
-// libssl.dll
-function SslGetError(s: PSSL; ret_code: Integer):Integer;
-begin
-  if InitSSLInterface and Assigned(_SslGetError) then
-    Result := _SslGetError(s, ret_code)
-  else
-    Result := SSL_ERROR_SSL;
-end;
-
-function SslLibraryInit:Integer;
-begin
-  if InitSSLInterface and Assigned(_SslLibraryInit) then
-    Result := _SslLibraryInit
-  else
-    Result := 1;
-end;
-
-procedure SslLoadErrorStrings;
-begin
-  if InitSSLInterface and Assigned(_SslLoadErrorStrings) then
-    _SslLoadErrorStrings;
-end;
-
-//function SslCtxSetCipherList(arg0: PSSL_CTX; str: PChar):Integer;
-function SslCtxSetCipherList(arg0: PSSL_CTX; var str: AnsiString):Integer;
-begin
-  if InitSSLInterface and Assigned(_SslCtxSetCipherList) then
-    Result := _SslCtxSetCipherList(arg0, PAnsiChar(str))
-  else
-    Result := 0;
-end;
-
-function SslCtxNew(meth: PSSL_METHOD):PSSL_CTX;
-begin
-  if InitSSLInterface and Assigned(_SslCtxNew) then
-    Result := _SslCtxNew(meth)
-  else
-    Result := nil;
-end;
-
-procedure SslCtxFree(arg0: PSSL_CTX);
-begin
-  if InitSSLInterface and Assigned(_SslCtxFree) then
-    _SslCtxFree(arg0);
-end;
-
-function SslSetFd(s: PSSL; fd: Integer):Integer;
-begin
-  if InitSSLInterface and Assigned(_SslSetFd) then
-    Result := _SslSetFd(s, fd)
-  else
-    Result := 0;
-end;
-
-function SslMethodV2:PSSL_METHOD;
-begin
-  if InitSSLInterface and Assigned(_SslMethodV2) then
-    Result := _SslMethodV2
-  else
-    Result := nil;
-end;
-
-function SslMethodV3:PSSL_METHOD;
-begin
-  if InitSSLInterface and Assigned(_SslMethodV3) then
-    Result := _SslMethodV3
-  else
-    Result := nil;
-end;
-
-function SslMethodTLSV1:PSSL_METHOD;
-begin
-  if InitSSLInterface and Assigned(_SslMethodTLSV1) then
-    Result := _SslMethodTLSV1
-  else
-    Result := nil;
-end;
-
-function SslMethodV23:PSSL_METHOD;
-begin
-  if InitSSLInterface and Assigned(_SslMethodV23) then
-    Result := _SslMethodV23
-  else
-    Result := nil;
-end;
-
-function SslCtxUsePrivateKey(ctx: PSSL_CTX; pkey: SslPtr):Integer;
-begin
-  if InitSSLInterface and Assigned(_SslCtxUsePrivateKey) then
-    Result := _SslCtxUsePrivateKey(ctx, pkey)
-  else
-    Result := 0;
-end;
-
-function SslCtxUsePrivateKeyASN1(pk: integer; ctx: PSSL_CTX; d: AnsiString; len: integer):Integer;
-begin
-  if InitSSLInterface and Assigned(_SslCtxUsePrivateKeyASN1) then
-    Result := _SslCtxUsePrivateKeyASN1(pk, ctx, Sslptr(d), len)
-  else
-    Result := 0;
-end;
-
-//function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: PChar; _type: Integer):Integer;
-function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: AnsiString; _type: Integer):Integer;
-begin
-  if InitSSLInterface and Assigned(_SslCtxUsePrivateKeyFile) then
-    Result := _SslCtxUsePrivateKeyFile(ctx, PAnsiChar(_file), _type)
-  else
-    Result := 0;
-end;
-
-function SslCtxUseCertificate(ctx: PSSL_CTX; x: SslPtr):Integer;
-begin
-  if InitSSLInterface and Assigned(_SslCtxUseCertificate) then
-    Result := _SslCtxUseCertificate(ctx, x)
-  else
-    Result := 0;
-end;
-
-function SslCtxUseCertificateASN1(ctx: PSSL_CTX; len: integer; d: AnsiString):Integer;
-begin
-  if InitSSLInterface and Assigned(_SslCtxUseCertificateASN1) then
-    Result := _SslCtxUseCertificateASN1(ctx, len, SslPtr(d))
-  else
-    Result := 0;
-end;
-
-function SslCtxUseCertificateFile(ctx: PSSL_CTX; const _file: AnsiString; _type: Integer):Integer;
-begin
-  if InitSSLInterface and Assigned(_SslCtxUseCertificateFile) then
-    Result := _SslCtxUseCertificateFile(ctx, PAnsiChar(_file), _type)
-  else
-    Result := 0;
-end;
-
-//function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: PChar):Integer;
-function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: AnsiString):Integer;
-begin
-  if InitSSLInterface and Assigned(_SslCtxUseCertificateChainFile) then
-    Result := _SslCtxUseCertificateChainFile(ctx, PAnsiChar(_file))
-  else
-    Result := 0;
-end;
-
-function SslCtxCheckPrivateKeyFile(ctx: PSSL_CTX):Integer;
-begin
-  if InitSSLInterface and Assigned(_SslCtxCheckPrivateKeyFile) then
-    Result := _SslCtxCheckPrivateKeyFile(ctx)
-  else
-    Result := 0;
-end;
-
-procedure SslCtxSetDefaultPasswdCb(ctx: PSSL_CTX; cb: PPasswdCb);
-begin
-  if InitSSLInterface and Assigned(_SslCtxSetDefaultPasswdCb) then
-    _SslCtxSetDefaultPasswdCb(ctx, cb);
-end;
-
-procedure SslCtxSetDefaultPasswdCbUserdata(ctx: PSSL_CTX; u: SslPtr);
-begin
-  if InitSSLInterface and Assigned(_SslCtxSetDefaultPasswdCbUserdata) then
-    _SslCtxSetDefaultPasswdCbUserdata(ctx, u);
-end;
-
-//function SslCtxLoadVerifyLocations(ctx: PSSL_CTX; const CAfile: PChar; const CApath: PChar):Integer;
-function SslCtxLoadVerifyLocations(ctx: PSSL_CTX; const CAfile: AnsiString; const CApath: AnsiString):Integer;
-begin
-  if InitSSLInterface and Assigned(_SslCtxLoadVerifyLocations) then
-    Result := _SslCtxLoadVerifyLocations(ctx, SslPtr(CAfile), SslPtr(CApath))
-  else
-    Result := 0;
-end;
-
-function SslCtxCtrl(ctx: PSSL_CTX; cmd: integer; larg: integer; parg: SslPtr): integer;
-begin
-  if InitSSLInterface and Assigned(_SslCtxCtrl) then
-    Result := _SslCtxCtrl(ctx, cmd, larg, parg)
-  else
-    Result := 0;
-end;
-
-function SslNew(ctx: PSSL_CTX):PSSL;
-begin
-  if InitSSLInterface and Assigned(_SslNew) then
-    Result := _SslNew(ctx)
-  else
-    Result := nil;
-end;
-
-procedure SslFree(ssl: PSSL);
-begin
-  if InitSSLInterface and Assigned(_SslFree) then
-    _SslFree(ssl);
-end;
-
-function SslAccept(ssl: PSSL):Integer;
-begin
-  if InitSSLInterface and Assigned(_SslAccept) then
-    Result := _SslAccept(ssl)
-  else
-    Result := -1;
-end;
-
-function SslConnect(ssl: PSSL):Integer;
-begin
-  if InitSSLInterface and Assigned(_SslConnect) then
-    Result := _SslConnect(ssl)
-  else
-    Result := -1;
-end;
-
-function SslShutdown(ssl: PSSL):Integer;
-begin
-  if InitSSLInterface and Assigned(_SslShutdown) then
-    Result := _SslShutdown(ssl)
-  else
-    Result := -1;
-end;
-
-//function SslRead(ssl: PSSL; buf: PChar; num: Integer):Integer;
-function SslRead(ssl: PSSL; buf: SslPtr; num: Integer):Integer;
-begin
-  if InitSSLInterface and Assigned(_SslRead) then
-    Result := _SslRead(ssl, PAnsiChar(buf), num)
-  else
-    Result := -1;
-end;
-
-//function SslPeek(ssl: PSSL; buf: PChar; num: Integer):Integer;
-function SslPeek(ssl: PSSL; buf: SslPtr; num: Integer):Integer;
-begin
-  if InitSSLInterface and Assigned(_SslPeek) then
-    Result := _SslPeek(ssl, PAnsiChar(buf), num)
-  else
-    Result := -1;
-end;
-
-//function SslWrite(ssl: PSSL; const buf: PChar; num: Integer):Integer;
-function SslWrite(ssl: PSSL; buf: SslPtr; num: Integer):Integer;
-begin
-  if InitSSLInterface and Assigned(_SslWrite) then
-    Result := _SslWrite(ssl, PAnsiChar(buf), num)
-  else
-    Result := -1;
-end;
-
-function SslPending(ssl: PSSL):Integer;
-begin
-  if InitSSLInterface and Assigned(_SslPending) then
-    Result := _SslPending(ssl)
-  else
-    Result := 0;
-end;
-
-//function SslGetVersion(ssl: PSSL):PChar;
-function SslGetVersion(ssl: PSSL):AnsiString;
-begin
-  if InitSSLInterface and Assigned(_SslGetVersion) then
-    Result := _SslGetVersion(ssl)
-  else
-    Result := '';
-end;
-
-function SslGetPeerCertificate(ssl: PSSL):PX509;
-begin
-  if InitSSLInterface and Assigned(_SslGetPeerCertificate) then
-    Result := _SslGetPeerCertificate(ssl)
-  else
-    Result := nil;
-end;
-
-//procedure SslCtxSetVerify(ctx: PSSL_CTX; mode: Integer; arg2: SslPtr);
-procedure SslCtxSetVerify(ctx: PSSL_CTX; mode: Integer; arg2: PFunction);
-begin
-  if InitSSLInterface and Assigned(_SslCtxSetVerify) then
-    _SslCtxSetVerify(ctx, mode, @arg2);
-end;
-
-function SSLGetCurrentCipher(s: PSSL):SslPtr;
-begin
-  if InitSSLInterface and Assigned(_SSLGetCurrentCipher) then
-{$IFDEF CIL}
-{$ELSE}
-    Result := _SSLGetCurrentCipher(s)
-{$ENDIF}
-  else
-    Result := nil;
-end;
-
-//function SSLCipherGetName(c: SslPtr):PChar;
-function SSLCipherGetName(c: SslPtr):AnsiString;
-begin
-  if InitSSLInterface and Assigned(_SSLCipherGetName) then
-    Result := _SSLCipherGetName(c)
-  else
-    Result := '';
-end;
-
-//function SSLCipherGetBits(c: SslPtr; alg_bits: PInteger):Integer;
-function SSLCipherGetBits(c: SslPtr; var alg_bits: Integer):Integer;
-begin
-  if InitSSLInterface and Assigned(_SSLCipherGetBits) then
-    Result := _SSLCipherGetBits(c, @alg_bits)
-  else
-    Result := 0;
-end;
-
-function SSLGetVerifyResult(ssl: PSSL):Integer;
-begin
-  if InitSSLInterface and Assigned(_SSLGetVerifyResult) then
-    Result := _SSLGetVerifyResult(ssl)
-  else
-    Result := X509_V_ERR_APPLICATION_VERIFICATION;
-end;
-
-// libeay.dll
-function X509New: PX509;
-begin
-  if InitSSLInterface and Assigned(_X509New) then
-    Result := _X509New
-  else
-    Result := nil;
-end;
-
-procedure X509Free(x: PX509);
-begin
-  if InitSSLInterface and Assigned(_X509Free) then
-    _X509Free(x);
-end;
-
-//function SslX509NameOneline(a: PX509_NAME; buf: PChar; size: Integer):PChar;
-function X509NameOneline(a: PX509_NAME; var buf: AnsiString; size: Integer):AnsiString;
-begin
-  if InitSSLInterface and Assigned(_X509NameOneline) then
-    Result := _X509NameOneline(a, PAnsiChar(buf),size)
-  else
-    Result := '';
-end;
-
-function X509GetSubjectName(a: PX509):PX509_NAME;
-begin
-  if InitSSLInterface and Assigned(_X509GetSubjectName) then
-    Result := _X509GetSubjectName(a)
-  else
-    Result := nil;
-end;
-
-function X509GetIssuerName(a: PX509):PX509_NAME;
-begin
-  if InitSSLInterface and Assigned(_X509GetIssuerName) then
-    Result := _X509GetIssuerName(a)
-  else
-    Result := nil;
-end;
-
-function X509NameHash(x: PX509_NAME):Cardinal;
-begin
-  if InitSSLInterface and Assigned(_X509NameHash) then
-    Result := _X509NameHash(x)
-  else
-    Result := 0;
-end;
-
-//function SslX509Digest(data: PX509; _type: PEVP_MD; md: PChar; len: PInteger):Integer;
-function X509Digest(data: PX509; _type: PEVP_MD; md: AnsiString; var len: Integer):Integer;
-begin
-  if InitSSLInterface and Assigned(_X509Digest) then
-    Result := _X509Digest(data, _type, PAnsiChar(md), @len)
-  else
-    Result := 0;
-end;
-
-function EvpPkeyNew: EVP_PKEY;
-begin
-  if InitSSLInterface and Assigned(_EvpPkeyNew) then
-    Result := _EvpPkeyNew
-  else
-    Result := nil;
-end;
-
-procedure EvpPkeyFree(pk: EVP_PKEY);
-begin
-  if InitSSLInterface and Assigned(_EvpPkeyFree) then
-    _EvpPkeyFree(pk);
-end;
-
-function SSLeayversion(t: integer): Ansistring;
-begin
-  if InitSSLInterface and Assigned(_SSLeayversion) then
-    Result := PAnsiChar(_SSLeayversion(t))
-  else
-    Result := '';
-end;
-
-procedure ErrErrorString(e: integer; var buf: Ansistring; len: integer);
-begin
-  if InitSSLInterface and Assigned(_ErrErrorString) then
-    _ErrErrorString(e, Pointer(buf), len);
-  buf := PAnsiChar(Buf);
-end;
-
-function ErrGetError: integer;
-begin
-  if InitSSLInterface and Assigned(_ErrGetError) then
-    Result := _ErrGetError
-  else
-    Result := SSL_ERROR_SSL;
-end;
-
-procedure ErrClearError;
-begin
-  if InitSSLInterface and Assigned(_ErrClearError) then
-    _ErrClearError;
-end;
-
-procedure ErrFreeStrings;
-begin
-  if InitSSLInterface and Assigned(_ErrFreeStrings) then
-    _ErrFreeStrings;
-end;
-
-procedure ErrRemoveState(pid: integer);
-begin
-  if InitSSLInterface and Assigned(_ErrRemoveState) then
-    _ErrRemoveState(pid);
-end;
-
-procedure OPENSSLaddallalgorithms;
-begin
-  if InitSSLInterface and Assigned(_OPENSSLaddallalgorithms) then
-    _OPENSSLaddallalgorithms;
-end;
-
-procedure EVPcleanup;
-begin
-  if InitSSLInterface and Assigned(_EVPcleanup) then
-    _EVPcleanup;
-end;
-
-procedure CRYPTOcleanupAllExData;
-begin
-  if InitSSLInterface and Assigned(_CRYPTOcleanupAllExData) then
-    _CRYPTOcleanupAllExData;
-end;
-
-procedure RandScreen;
-begin
-  if InitSSLInterface and Assigned(_RandScreen) then
-    _RandScreen;
-end;
-
-function BioNew(b: PBIO_METHOD): PBIO;
-begin
-  if InitSSLInterface and Assigned(_BioNew) then
-    Result := _BioNew(b)
-  else
-    Result := nil;
-end;
-
-procedure BioFreeAll(b: PBIO);
-begin
-  if InitSSLInterface and Assigned(_BioFreeAll) then
-    _BioFreeAll(b);
-end;
-
-function BioSMem: PBIO_METHOD;
-begin
-  if InitSSLInterface and Assigned(_BioSMem) then
-    Result := _BioSMem
-  else
-    Result := nil;
-end;
-
-function BioCtrlPending(b: PBIO): integer;
-begin
-  if InitSSLInterface and Assigned(_BioCtrlPending) then
-    Result := _BioCtrlPending(b)
-  else
-    Result := 0;
-end;
-
-//function BioRead(b: PBIO; Buf: PChar; Len: integer): integer;
-function BioRead(b: PBIO; var Buf: AnsiString; Len: integer): integer;
-begin
-  if InitSSLInterface and Assigned(_BioRead) then
-    Result := _BioRead(b, PAnsiChar(Buf), Len)
-  else
-    Result := -2;
-end;
-
-//function BioWrite(b: PBIO; Buf: PChar; Len: integer): integer;
-function BioWrite(b: PBIO; Buf: AnsiString; Len: integer): integer;
-begin
-  if InitSSLInterface and Assigned(_BioWrite) then
-    Result := _BioWrite(b, PAnsiChar(Buf), Len)
-  else
-    Result := -2;
-end;
-
-function X509print(b: PBIO; a: PX509): integer;
-begin
-  if InitSSLInterface and Assigned(_X509print) then
-    Result := _X509print(b, a)
-  else
-    Result := 0;
-end;
-
-function d2iPKCS12bio(b:PBIO; Pkcs12: SslPtr): SslPtr;
-begin
-  if InitSSLInterface and Assigned(_d2iPKCS12bio) then
-    Result := _d2iPKCS12bio(b, Pkcs12)
-  else
-    Result := nil;
-end;
-
-function PKCS12parse(p12: SslPtr; pass: Ansistring; var pkey, cert, ca: SslPtr): integer;
-begin
-  if InitSSLInterface and Assigned(_PKCS12parse) then
-    Result := _PKCS12parse(p12, SslPtr(pass), pkey, cert, ca)
-  else
-    Result := 0;
-end;
-
-procedure PKCS12free(p12: SslPtr);
-begin
-  if InitSSLInterface and Assigned(_PKCS12free) then
-    _PKCS12free(p12);
-end;
-
-function RsaGenerateKey(bits, e: integer; callback: PFunction; cb_arg: SslPtr): PRSA;
-begin
-  if InitSSLInterface and Assigned(_RsaGenerateKey) then
-    Result := _RsaGenerateKey(bits, e, callback, cb_arg)
-  else
-    Result := nil;
-end;
-
-function EvpPkeyAssign(pkey: EVP_PKEY; _type: integer; key: Prsa): integer;
-begin
-  if InitSSLInterface and Assigned(_EvpPkeyAssign) then
-    Result := _EvpPkeyAssign(pkey, _type, key)
-  else
-    Result := 0;
-end;
-
-function X509SetVersion(x: PX509; version: integer): integer;
-begin
-  if InitSSLInterface and Assigned(_X509SetVersion) then
-    Result := _X509SetVersion(x, version)
-  else
-    Result := 0;
-end;
-
-function X509SetPubkey(x: PX509; pkey: EVP_PKEY): integer;
-begin
-  if InitSSLInterface and Assigned(_X509SetPubkey) then
-    Result := _X509SetPubkey(x, pkey)
-  else
-    Result := 0;
-end;
-
-function X509SetIssuerName(x: PX509; name: PX509_NAME): integer;
-begin
-  if InitSSLInterface and Assigned(_X509SetIssuerName) then
-    Result := _X509SetIssuerName(x, name)
-  else
-    Result := 0;
-end;
-
-function X509NameAddEntryByTxt(name: PX509_NAME; field: Ansistring; _type: integer;
-  bytes: Ansistring; len, loc, _set: integer): integer;
-begin
-  if InitSSLInterface and Assigned(_X509NameAddEntryByTxt) then
-    Result := _X509NameAddEntryByTxt(name, PAnsiChar(field), _type, PAnsiChar(Bytes), len, loc, _set)
-  else
-    Result := 0;
-end;
-
-function X509Sign(x: PX509; pkey: EVP_PKEY; const md: PEVP_MD): integer;
-begin
-  if InitSSLInterface and Assigned(_X509Sign) then
-    Result := _X509Sign(x, pkey, md)
-  else
-    Result := 0;
-end;
-
-function Asn1UtctimeNew: PASN1_UTCTIME;
-begin
-  if InitSSLInterface and Assigned(_Asn1UtctimeNew) then
-    Result := _Asn1UtctimeNew
-  else
-    Result := nil;
-end;
-
-procedure Asn1UtctimeFree(a: PASN1_UTCTIME);
-begin
-  if InitSSLInterface and Assigned(_Asn1UtctimeFree) then
-    _Asn1UtctimeFree(a);
-end;
-
-function X509GmtimeAdj(s: PASN1_UTCTIME; adj: integer): PASN1_UTCTIME;
-begin
-  if InitSSLInterface and Assigned(_X509GmtimeAdj) then
-    Result := _X509GmtimeAdj(s, adj)
-  else
-    Result := nil;
-end;
-
-function X509SetNotBefore(x: PX509; tm: PASN1_UTCTIME): integer;
-begin
-  if InitSSLInterface and Assigned(_X509SetNotBefore) then
-    Result := _X509SetNotBefore(x, tm)
-  else
-    Result := 0;
-end;
-
-function X509SetNotAfter(x: PX509; tm: PASN1_UTCTIME): integer;
-begin
-  if InitSSLInterface and Assigned(_X509SetNotAfter) then
-    Result := _X509SetNotAfter(x, tm)
-  else
-    Result := 0;
-end;
-
-function i2dX509bio(b: PBIO; x: PX509): integer;
-begin
-  if InitSSLInterface and Assigned(_i2dX509bio) then
-    Result := _i2dX509bio(b, x)
-  else
-    Result := 0;
-end;
-
-function i2dPrivateKeyBio(b: PBIO; pkey: EVP_PKEY): integer;
-begin
-  if InitSSLInterface and Assigned(_i2dPrivateKeyBio) then
-    Result := _i2dPrivateKeyBio(b, pkey)
-  else
-    Result := 0;
-end;
-
-function EvpGetDigestByName(Name: AnsiString): PEVP_MD;
-begin
-  if InitSSLInterface and Assigned(_EvpGetDigestByName) then
-    Result := _EvpGetDigestByName(PAnsiChar(Name))
-  else
-    Result := nil;
-end;
-
-function Asn1IntegerSet(a: PASN1_INTEGER; v: integer): integer;
-begin
-  if InitSSLInterface and Assigned(_Asn1IntegerSet) then
-    Result := _Asn1IntegerSet(a, v)
-  else
-    Result := 0;
-end;
-
-function X509GetSerialNumber(x: PX509): PASN1_INTEGER;
-begin
-  if InitSSLInterface and Assigned(_X509GetSerialNumber) then
-    Result := _X509GetSerialNumber(x)
-  else
-    Result := nil;
-end;
-
-// 3DES functions
-procedure DESsetoddparity(Key: des_cblock);
-begin
-  if InitSSLInterface and Assigned(_DESsetoddparity) then
-    _DESsetoddparity(Key);
-end;
-
-function DESsetkeychecked(key: des_cblock; schedule: des_key_schedule): Integer;
-begin
-  if InitSSLInterface and Assigned(_DESsetkeychecked) then
-    Result := _DESsetkeychecked(key, schedule)
-  else
-    Result := -1;
-end;
-
-procedure DESecbencrypt(Input: des_cblock; output: des_cblock; ks: des_key_schedule; enc: Integer);
-begin
-  if InitSSLInterface and Assigned(_DESecbencrypt) then
-    _DESecbencrypt(Input, output, ks, enc);
-end;
-
-procedure locking_callback(mode, ltype: integer; lfile: PChar; line: integer); cdecl;
-begin
-  if (mode and 1) > 0 then
-    TCriticalSection(Locks[ltype]).Enter
-  else
-    TCriticalSection(Locks[ltype]).Leave;
-end;
-
-procedure InitLocks;
-var
-  n: integer;
-  max: integer;
-begin
-  Locks := TList.Create;
-  max := _CRYPTOnumlocks;
-  for n := 1 to max do
-    Locks.Add(TCriticalSection.Create);
-  _CRYPTOsetlockingcallback(@locking_callback);
-end;
-
-procedure FreeLocks;
-var
-  n: integer;
-begin
-  _CRYPTOsetlockingcallback(nil);
-  for n := 0 to Locks.Count - 1 do
-    TCriticalSection(Locks[n]).Free;
-  Locks.Free;
-end;
-
-{$ENDIF}
-
-function LoadLib(const Value: String): HModule;
-begin
-{$IFDEF CIL}
-  Result := LoadLibrary(Value);
-{$ELSE}
-  Result := LoadLibrary(PChar(Value));
-{$ENDIF}
-end;
-
-function GetProcAddr(module: HModule; const ProcName: string): SslPtr;
-begin
-{$IFDEF CIL}
-  Result := GetProcAddress(module, ProcName);
-{$ELSE}
-  Result := GetProcAddress(module, PChar(ProcName));
-{$ENDIF}
-end;
-
-function InitSSLInterface: Boolean;
-var
-  s: string;
-  x: integer;
-begin
-  SSLCS.Enter;
-  try
-    if not IsSSLloaded then
-    begin
-{$IFDEF CIL}
-      SSLLibHandle := 1;
-      SSLUtilHandle := 1;
-{$ELSE}
-      SSLLibHandle := LoadLib(DLLSSLName);
-      SSLUtilHandle := LoadLib(DLLUtilName);
-  {$IFNDEF LINUX}
-      if (SSLLibHandle = 0) then
-        SSLLibHandle := LoadLib(DLLSSLName2);
-  {$ENDIF}
-{$ENDIF}
-      if (SSLLibHandle <> 0) and (SSLUtilHandle <> 0) then
-      begin
-{$IFNDEF CIL}
-        _SslGetError := GetProcAddr(SSLLibHandle, 'SSL_get_error');
-        _SslLibraryInit := GetProcAddr(SSLLibHandle, 'SSL_library_init');
-        _SslLoadErrorStrings := GetProcAddr(SSLLibHandle, 'SSL_load_error_strings');
-        _SslCtxSetCipherList := GetProcAddr(SSLLibHandle, 'SSL_CTX_set_cipher_list');
-        _SslCtxNew := GetProcAddr(SSLLibHandle, 'SSL_CTX_new');
-        _SslCtxFree := GetProcAddr(SSLLibHandle, 'SSL_CTX_free');
-        _SslSetFd := GetProcAddr(SSLLibHandle, 'SSL_set_fd');
-        _SslMethodV2 := GetProcAddr(SSLLibHandle, 'SSLv2_method');
-        _SslMethodV3 := GetProcAddr(SSLLibHandle, 'SSLv3_method');
-        _SslMethodTLSV1 := GetProcAddr(SSLLibHandle, 'TLSv1_method');
-        _SslMethodV23 := GetProcAddr(SSLLibHandle, 'SSLv23_method');
-        _SslCtxUsePrivateKey := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_PrivateKey');
-        _SslCtxUsePrivateKeyASN1 := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_PrivateKey_ASN1');
-        //use SSL_CTX_use_RSAPrivateKey_file instead SSL_CTX_use_PrivateKey_file,
-        //because SSL_CTX_use_PrivateKey_file not support DER format. :-O
-        _SslCtxUsePrivateKeyFile := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_RSAPrivateKey_file');
-        _SslCtxUseCertificate := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_certificate');
-        _SslCtxUseCertificateASN1 := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_certificate_ASN1');
-        _SslCtxUseCertificateFile := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_certificate_file');
-        _SslCtxUseCertificateChainFile := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_certificate_chain_file');
-        _SslCtxCheckPrivateKeyFile := GetProcAddr(SSLLibHandle, 'SSL_CTX_check_private_key');
-        _SslCtxSetDefaultPasswdCb := GetProcAddr(SSLLibHandle, 'SSL_CTX_set_default_passwd_cb');
-        _SslCtxSetDefaultPasswdCbUserdata := GetProcAddr(SSLLibHandle, 'SSL_CTX_set_default_passwd_cb_userdata');
-        _SslCtxLoadVerifyLocations := GetProcAddr(SSLLibHandle, 'SSL_CTX_load_verify_locations');
-        _SslCtxCtrl := GetProcAddr(SSLLibHandle, 'SSL_CTX_ctrl');
-        _SslNew := GetProcAddr(SSLLibHandle, 'SSL_new');
-        _SslFree := GetProcAddr(SSLLibHandle, 'SSL_free');
-        _SslAccept := GetProcAddr(SSLLibHandle, 'SSL_accept');
-        _SslConnect := GetProcAddr(SSLLibHandle, 'SSL_connect');
-        _SslShutdown := GetProcAddr(SSLLibHandle, 'SSL_shutdown');
-        _SslRead := GetProcAddr(SSLLibHandle, 'SSL_read');
-        _SslPeek := GetProcAddr(SSLLibHandle, 'SSL_peek');
-        _SslWrite := GetProcAddr(SSLLibHandle, 'SSL_write');
-        _SslPending := GetProcAddr(SSLLibHandle, 'SSL_pending');
-        _SslGetPeerCertificate := GetProcAddr(SSLLibHandle, 'SSL_get_peer_certificate');
-        _SslGetVersion := GetProcAddr(SSLLibHandle, 'SSL_get_version');
-        _SslCtxSetVerify := GetProcAddr(SSLLibHandle, 'SSL_CTX_set_verify');
-        _SslGetCurrentCipher := GetProcAddr(SSLLibHandle, 'SSL_get_current_cipher');
-        _SslCipherGetName := GetProcAddr(SSLLibHandle, 'SSL_CIPHER_get_name');
-        _SslCipherGetBits := GetProcAddr(SSLLibHandle, 'SSL_CIPHER_get_bits');
-        _SslGetVerifyResult := GetProcAddr(SSLLibHandle, 'SSL_get_verify_result');
-
-        _X509New := GetProcAddr(SSLUtilHandle, 'X509_new');
-        _X509Free := GetProcAddr(SSLUtilHandle, 'X509_free');
-        _X509NameOneline := GetProcAddr(SSLUtilHandle, 'X509_NAME_oneline');
-        _X509GetSubjectName := GetProcAddr(SSLUtilHandle, 'X509_get_subject_name');
-        _X509GetIssuerName := GetProcAddr(SSLUtilHandle, 'X509_get_issuer_name');
-        _X509NameHash := GetProcAddr(SSLUtilHandle, 'X509_NAME_hash');
-        _X509Digest := GetProcAddr(SSLUtilHandle, 'X509_digest');
-        _X509print := GetProcAddr(SSLUtilHandle, 'X509_print');
-        _X509SetVersion := GetProcAddr(SSLUtilHandle, 'X509_set_version');
-        _X509SetPubkey := GetProcAddr(SSLUtilHandle, 'X509_set_pubkey');
-        _X509SetIssuerName := GetProcAddr(SSLUtilHandle, 'X509_set_issuer_name');
-        _X509NameAddEntryByTxt := GetProcAddr(SSLUtilHandle, 'X509_NAME_add_entry_by_txt');
-        _X509Sign := GetProcAddr(SSLUtilHandle, 'X509_sign');
-        _X509GmtimeAdj := GetProcAddr(SSLUtilHandle, 'X509_gmtime_adj');
-        _X509SetNotBefore := GetProcAddr(SSLUtilHandle, 'X509_set_notBefore');
-        _X509SetNotAfter := GetProcAddr(SSLUtilHandle, 'X509_set_notAfter');
-        _X509GetSerialNumber := GetProcAddr(SSLUtilHandle, 'X509_get_serialNumber');
-        _EvpPkeyNew := GetProcAddr(SSLUtilHandle, 'EVP_PKEY_new');
-        _EvpPkeyFree := GetProcAddr(SSLUtilHandle, 'EVP_PKEY_free');
-        _EvpPkeyAssign := GetProcAddr(SSLUtilHandle, 'EVP_PKEY_assign');
-        _EVPCleanup := GetProcAddr(SSLUtilHandle, 'EVP_cleanup');
-        _EvpGetDigestByName := GetProcAddr(SSLUtilHandle, 'EVP_get_digestbyname');
-        _SSLeayversion := GetProcAddr(SSLUtilHandle, 'SSLeay_version');
-        _ErrErrorString := GetProcAddr(SSLUtilHandle, 'ERR_error_string_n');
-        _ErrGetError := GetProcAddr(SSLUtilHandle, 'ERR_get_error');
-        _ErrClearError := GetProcAddr(SSLUtilHandle, 'ERR_clear_error');
-        _ErrFreeStrings := GetProcAddr(SSLUtilHandle, 'ERR_free_strings');
-        _ErrRemoveState := GetProcAddr(SSLUtilHandle, 'ERR_remove_state');
-        _OPENSSLaddallalgorithms := GetProcAddr(SSLUtilHandle, 'OPENSSL_add_all_algorithms_noconf');
-        _CRYPTOcleanupAllExData := GetProcAddr(SSLUtilHandle, 'CRYPTO_cleanup_all_ex_data');
-        _RandScreen := GetProcAddr(SSLUtilHandle, 'RAND_screen');
-        _BioNew := GetProcAddr(SSLUtilHandle, 'BIO_new');
-        _BioFreeAll := GetProcAddr(SSLUtilHandle, 'BIO_free_all');
-        _BioSMem := GetProcAddr(SSLUtilHandle, 'BIO_s_mem');
-        _BioCtrlPending := GetProcAddr(SSLUtilHandle, 'BIO_ctrl_pending');
-        _BioRead := GetProcAddr(SSLUtilHandle, 'BIO_read');
-        _BioWrite := GetProcAddr(SSLUtilHandle, 'BIO_write');
-        _d2iPKCS12bio := GetProcAddr(SSLUtilHandle, 'd2i_PKCS12_bio');
-        _PKCS12parse := GetProcAddr(SSLUtilHandle, 'PKCS12_parse');
-        _PKCS12free := GetProcAddr(SSLUtilHandle, 'PKCS12_free');
-        _RsaGenerateKey := GetProcAddr(SSLUtilHandle, 'RSA_generate_key');
-        _Asn1UtctimeNew := GetProcAddr(SSLUtilHandle, 'ASN1_UTCTIME_new');
-        _Asn1UtctimeFree := GetProcAddr(SSLUtilHandle, 'ASN1_UTCTIME_free');
-        _Asn1IntegerSet := GetProcAddr(SSLUtilHandle, 'ASN1_INTEGER_set');
-        _i2dX509bio := GetProcAddr(SSLUtilHandle, 'i2d_X509_bio');
-        _i2dPrivateKeyBio := GetProcAddr(SSLUtilHandle, 'i2d_PrivateKey_bio');
-
-        // 3DES functions
-        _DESsetoddparity := GetProcAddr(SSLUtilHandle, 'DES_set_odd_parity');
-        _DESsetkeychecked := GetProcAddr(SSLUtilHandle, 'DES_set_key_checked');
-        _DESecbencrypt := GetProcAddr(SSLUtilHandle, 'DES_ecb_encrypt');
-        //
-        _CRYPTOnumlocks := GetProcAddr(SSLUtilHandle, 'CRYPTO_num_locks');
-        _CRYPTOsetlockingcallback := GetProcAddr(SSLUtilHandle, 'CRYPTO_set_locking_callback');
-{$ENDIF}
-{$IFDEF CIL}
-        SslLibraryInit;
-        SslLoadErrorStrings;
-        OPENSSLaddallalgorithms;
-        RandScreen;
-{$ELSE}
-        SetLength(s, 1024);
-        x := GetModuleFilename(SSLLibHandle,PChar(s),Length(s));
-        SetLength(s, x);
-        SSLLibFile := s;
-        SetLength(s, 1024);
-        x := GetModuleFilename(SSLUtilHandle,PChar(s),Length(s));
-        SetLength(s, x);
-        SSLUtilFile := s;
-        //init library
-        if assigned(_SslLibraryInit) then
-          _SslLibraryInit;
-        if assigned(_SslLoadErrorStrings) then
-          _SslLoadErrorStrings;
-        if assigned(_OPENSSLaddallalgorithms) then
-          _OPENSSLaddallalgorithms;
-        if assigned(_RandScreen) then
-          _RandScreen;
-        if assigned(_CRYPTOnumlocks) and assigned(_CRYPTOsetlockingcallback) then
-          InitLocks;
-{$ENDIF}
-        Result := True;
-        SSLloaded := True;
-      end
-      else
-      begin
-        //load failed!
-        if SSLLibHandle <> 0 then
-        begin
-{$IFNDEF CIL}
-          FreeLibrary(SSLLibHandle);
-{$ENDIF}
-          SSLLibHandle := 0;
-        end;
-        if SSLUtilHandle <> 0 then
-        begin
-{$IFNDEF CIL}
-          FreeLibrary(SSLUtilHandle);
-{$ENDIF}
-          SSLLibHandle := 0;
-        end;
-        Result := False;
-      end;
-    end
-    else
-      //loaded before...
-      Result := true;
-  finally
-    SSLCS.Leave;
-  end;
-end;
-
-function DestroySSLInterface: Boolean;
-begin
-  SSLCS.Enter;
-  try
-    if IsSSLLoaded then
-    begin
-      //deinit library
-{$IFNDEF CIL}
-      if assigned(_CRYPTOnumlocks) and assigned(_CRYPTOsetlockingcallback) then
-        FreeLocks;
-{$ENDIF}
-      EVPCleanup;
-      CRYPTOcleanupAllExData;
-      ErrRemoveState(0);
-    end;
-    SSLloaded := false;
-    if SSLLibHandle <> 0 then
-    begin
-{$IFNDEF CIL}
-      FreeLibrary(SSLLibHandle);
-{$ENDIF}
-      SSLLibHandle := 0;
-    end;
-    if SSLUtilHandle <> 0 then
-    begin
-{$IFNDEF CIL}
-      FreeLibrary(SSLUtilHandle);
-{$ENDIF}
-      SSLLibHandle := 0;
-    end;
-
-{$IFNDEF CIL}
-    _SslGetError := nil;
-    _SslLibraryInit := nil;
-    _SslLoadErrorStrings := nil;
-    _SslCtxSetCipherList := nil;
-    _SslCtxNew := nil;
-    _SslCtxFree := nil;
-    _SslSetFd := nil;
-    _SslMethodV2 := nil;
-    _SslMethodV3 := nil;
-    _SslMethodTLSV1 := nil;
-    _SslMethodV23 := nil;
-    _SslCtxUsePrivateKey := nil;
-    _SslCtxUsePrivateKeyASN1 := nil;
-    _SslCtxUsePrivateKeyFile := nil;
-    _SslCtxUseCertificate := nil;
-    _SslCtxUseCertificateASN1 := nil;
-    _SslCtxUseCertificateFile := nil;
-    _SslCtxUseCertificateChainFile := nil;
-    _SslCtxCheckPrivateKeyFile := nil;
-    _SslCtxSetDefaultPasswdCb := nil;
-    _SslCtxSetDefaultPasswdCbUserdata := nil;
-    _SslCtxLoadVerifyLocations := nil;
-    _SslCtxCtrl := nil;
-    _SslNew := nil;
-    _SslFree := nil;
-    _SslAccept := nil;
-    _SslConnect := nil;
-    _SslShutdown := nil;
-    _SslRead := nil;
-    _SslPeek := nil;
-    _SslWrite := nil;
-    _SslPending := nil;
-    _SslGetPeerCertificate := nil;
-    _SslGetVersion := nil;
-    _SslCtxSetVerify := nil;
-    _SslGetCurrentCipher := nil;
-    _SslCipherGetName := nil;
-    _SslCipherGetBits := nil;
-    _SslGetVerifyResult := nil;
-
-    _X509New := nil;
-    _X509Free := nil;
-    _X509NameOneline := nil;
-    _X509GetSubjectName := nil;
-    _X509GetIssuerName := nil;
-    _X509NameHash := nil;
-    _X509Digest := nil;
-    _X509print := nil;
-    _X509SetVersion := nil;
-    _X509SetPubkey := nil;
-    _X509SetIssuerName := nil;
-    _X509NameAddEntryByTxt := nil;
-    _X509Sign := nil;
-    _X509GmtimeAdj := nil;
-    _X509SetNotBefore := nil;
-    _X509SetNotAfter := nil;
-    _X509GetSerialNumber := nil;
-    _EvpPkeyNew := nil;
-    _EvpPkeyFree := nil;
-    _EvpPkeyAssign := nil;
-    _EVPCleanup := nil;
-    _EvpGetDigestByName := nil;
-    _SSLeayversion := nil;
-    _ErrErrorString := nil;
-    _ErrGetError := nil;
-    _ErrClearError := nil;
-    _ErrFreeStrings := nil;
-    _ErrRemoveState := nil;
-    _OPENSSLaddallalgorithms := nil;
-    _CRYPTOcleanupAllExData := nil;
-    _RandScreen := nil;
-    _BioNew := nil;
-    _BioFreeAll := nil;
-    _BioSMem := nil;
-    _BioCtrlPending := nil;
-    _BioRead := nil;
-    _BioWrite := nil;
-    _d2iPKCS12bio := nil;
-    _PKCS12parse := nil;
-    _PKCS12free := nil;
-    _RsaGenerateKey := nil;
-    _Asn1UtctimeNew := nil;
-    _Asn1UtctimeFree := nil;
-    _Asn1IntegerSet := nil;
-    _i2dX509bio := nil;
-    _i2dPrivateKeyBio := nil;
-
-    // 3DES functions
-    _DESsetoddparity := nil;
-    _DESsetkeychecked := nil;
-    _DESecbencrypt := nil;
-    //
-    _CRYPTOnumlocks := nil;
-    _CRYPTOsetlockingcallback := nil;
-{$ENDIF}
-  finally
-    SSLCS.Leave;
-  end;
-  Result := True;
-end;
-
-function IsSSLloaded: Boolean;
-begin
-  Result := SSLLoaded;
-end;
-
-initialization
-begin
-  SSLCS:= TCriticalSection.Create;
-end;
-
-finalization
-begin
-{$IFNDEF CIL}
-  DestroySSLInterface;
-{$ENDIF}
-  SSLCS.Free;
-end;
-
-end.
+{==============================================================================|
+| Project : Ararat Synapse                                       | 003.006.001 |
+|==============================================================================|
+| Content: SSL support by OpenSSL                                              |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2002-2010.                |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{
+Special thanks to Gregor Ibic <gregor.ibic@intelicom.si>
+ (Intelicom d.o.o., http://www.intelicom.si)
+ for good inspiration about begin with SSL programming.
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+{$IFDEF VER125}
+  {$DEFINE BCB}
+{$ENDIF}
+{$IFDEF BCB}
+  {$ObjExportAll On}
+  (*$HPPEMIT 'namespace ssl_openssl_lib { using System::Shortint; }' *)
+{$ENDIF}
+
+//old Delphi does not have MSWINDOWS define.
+{$IFDEF WIN32}
+  {$IFNDEF MSWINDOWS}
+    {$DEFINE MSWINDOWS}
+  {$ENDIF}
+{$ENDIF}
+
+{:@abstract(OpenSSL support)
+
+This unit is Pascal interface to OpenSSL library (used by @link(ssl_openssl) unit).
+OpenSSL is loaded dynamicly on-demand. If this library is not found in system,
+requested OpenSSL function just return errorcode.
+}
+unit ssl_openssl_lib;
+
+interface
+
+uses
+{$IFDEF CIL}
+  System.Runtime.InteropServices,
+  System.Text,
+{$ENDIF}
+  Classes,
+  synafpc,
+{$IFNDEF MSWINDOWS}
+  Libc, SysUtils;
+{$ELSE}
+  Windows;
+{$ENDIF}
+
+
+{$IFDEF CIL}
+const
+  {$IFDEF LINUX}
+  DLLSSLName = 'libssl.so';
+  DLLUtilName = 'libcrypto.so';
+  {$ELSE}
+  DLLSSLName = 'ssleay32.dll';
+  DLLUtilName = 'libeay32.dll';
+  {$ENDIF}
+{$ELSE}
+var
+  {$IFNDEF MSWINDOWS}
+  DLLSSLName: string = 'libssl.so';
+  DLLUtilName: string = 'libcrypto.so';
+  {$ELSE}
+  DLLSSLName: string = 'ssleay32.dll';
+  DLLSSLName2: string = 'libssl32.dll';
+  DLLUtilName: string = 'libeay32.dll';
+  {$ENDIF}
+{$ENDIF}
+
+type
+{$IFDEF CIL}
+  SslPtr = IntPtr;
+{$ELSE}
+  SslPtr = Pointer;
+{$ENDIF}
+  PSslPtr = ^SslPtr;
+  PSSL_CTX = SslPtr;
+  PSSL = SslPtr;
+  PSSL_METHOD = SslPtr;
+  PX509 = SslPtr;
+  PX509_NAME = SslPtr;
+  PEVP_MD	= SslPtr;
+  PInteger = ^Integer;
+  PBIO_METHOD = SslPtr;
+  PBIO = SslPtr;
+  EVP_PKEY = SslPtr;
+  PRSA = SslPtr;
+  PASN1_UTCTIME = SslPtr;
+  PASN1_INTEGER = SslPtr;
+  PPasswdCb = SslPtr;
+  PFunction = procedure;
+
+  DES_cblock = array[0..7] of Byte;
+  PDES_cblock = ^DES_cblock;
+  des_ks_struct = packed record
+    ks: DES_cblock;
+    weak_key: Integer;
+  end;
+  des_key_schedule = array[1..16] of des_ks_struct;
+
+const
+  EVP_MAX_MD_SIZE = 16 + 20;
+
+  SSL_ERROR_NONE = 0;
+  SSL_ERROR_SSL = 1;
+  SSL_ERROR_WANT_READ = 2;
+  SSL_ERROR_WANT_WRITE = 3;
+  SSL_ERROR_WANT_X509_LOOKUP = 4;
+  SSL_ERROR_SYSCALL = 5; //look at error stack/return value/errno
+  SSL_ERROR_ZERO_RETURN = 6;
+  SSL_ERROR_WANT_CONNECT = 7;
+  SSL_ERROR_WANT_ACCEPT = 8;
+
+  SSL_OP_NO_SSLv2 = $01000000;
+  SSL_OP_NO_SSLv3 = $02000000;
+  SSL_OP_NO_TLSv1 = $04000000;
+  SSL_OP_ALL = $000FFFFF;
+  SSL_VERIFY_NONE = $00;
+  SSL_VERIFY_PEER = $01;
+
+  OPENSSL_DES_DECRYPT = 0;
+  OPENSSL_DES_ENCRYPT = 1;
+
+  X509_V_OK =	0;
+  X509_V_ILLEGAL = 1;
+  X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT = 2;
+  X509_V_ERR_UNABLE_TO_GET_CRL = 3;
+  X509_V_ERR_UNABLE_TO_DECRYPT_CERT_SIGNATURE = 4;
+  X509_V_ERR_UNABLE_TO_DECRYPT_CRL_SIGNATURE = 5;
+  X509_V_ERR_UNABLE_TO_DECODE_ISSUER_PUBLIC_KEY = 6;
+  X509_V_ERR_CERT_SIGNATURE_FAILURE = 7;
+  X509_V_ERR_CRL_SIGNATURE_FAILURE = 8;
+  X509_V_ERR_CERT_NOT_YET_VALID = 9;
+  X509_V_ERR_CERT_HAS_EXPIRED = 10;
+  X509_V_ERR_CRL_NOT_YET_VALID = 11;
+  X509_V_ERR_CRL_HAS_EXPIRED = 12;
+  X509_V_ERR_ERROR_IN_CERT_NOT_BEFORE_FIELD = 13;
+  X509_V_ERR_ERROR_IN_CERT_NOT_AFTER_FIELD = 14;
+  X509_V_ERR_ERROR_IN_CRL_LAST_UPDATE_FIELD = 15;
+  X509_V_ERR_ERROR_IN_CRL_NEXT_UPDATE_FIELD = 16;
+  X509_V_ERR_OUT_OF_MEM = 17;
+  X509_V_ERR_DEPTH_ZERO_SELF_SIGNED_CERT = 18;
+  X509_V_ERR_SELF_SIGNED_CERT_IN_CHAIN = 19;
+  X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT_LOCALLY = 20;
+  X509_V_ERR_UNABLE_TO_VERIFY_LEAF_SIGNATURE = 21;
+  X509_V_ERR_CERT_CHAIN_TOO_LONG = 22;
+  X509_V_ERR_CERT_REVOKED = 23;
+  X509_V_ERR_INVALID_CA = 24;
+  X509_V_ERR_PATH_LENGTH_EXCEEDED = 25;
+  X509_V_ERR_INVALID_PURPOSE = 26;
+  X509_V_ERR_CERT_UNTRUSTED = 27;
+  X509_V_ERR_CERT_REJECTED = 28;
+  //These are 'informational' when looking for issuer cert
+  X509_V_ERR_SUBJECT_ISSUER_MISMATCH = 29;
+  X509_V_ERR_AKID_SKID_MISMATCH = 30;
+  X509_V_ERR_AKID_ISSUER_SERIAL_MISMATCH = 31;
+  X509_V_ERR_KEYUSAGE_NO_CERTSIGN = 32;
+  X509_V_ERR_UNABLE_TO_GET_CRL_ISSUER = 33;
+  X509_V_ERR_UNHANDLED_CRITICAL_EXTENSION = 34;
+  //The application is not happy
+  X509_V_ERR_APPLICATION_VERIFICATION = 50;
+
+  SSL_FILETYPE_ASN1	= 2;
+  SSL_FILETYPE_PEM = 1;
+  EVP_PKEY_RSA = 6;
+
+var
+  SSLLibHandle: TLibHandle = 0;
+  SSLUtilHandle: TLibHandle = 0;
+  SSLLibFile: string = '';
+  SSLUtilFile: string = '';
+
+{$IFDEF CIL}
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_get_error')]
+    function SslGetError(s: PSSL; ret_code: Integer): Integer; external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_library_init')]
+    function SslLibraryInit: Integer; external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_load_error_strings')]
+    procedure SslLoadErrorStrings; external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_CTX_set_cipher_list')]
+    function SslCtxSetCipherList(arg0: PSSL_CTX; var str: String): Integer; external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_CTX_new')]
+    function SslCtxNew(meth: PSSL_METHOD):PSSL_CTX;  external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_CTX_free')]
+    procedure SslCtxFree (arg0: PSSL_CTX);   external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_set_fd')]
+    function SslSetFd(s: PSSL; fd: Integer):Integer;    external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSLv2_method')]
+    function SslMethodV2 : PSSL_METHOD; external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSLv3_method')]
+    function SslMethodV3 : PSSL_METHOD;  external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'TLSv1_method')]
+    function SslMethodTLSV1:PSSL_METHOD;  external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSLv23_method')]
+    function SslMethodV23 : PSSL_METHOD; external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_CTX_use_PrivateKey')]
+    function SslCtxUsePrivateKey(ctx: PSSL_CTX; pkey: SslPtr):Integer;  external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_CTX_use_PrivateKey_ASN1')]
+    function SslCtxUsePrivateKeyASN1(pk: integer; ctx: PSSL_CTX; d: String; len: integer):Integer;  external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_CTX_use_RSAPrivateKey_file')]
+    function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: String; _type: Integer):Integer;  external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_CTX_use_certificate')]
+    function SslCtxUseCertificate(ctx: PSSL_CTX; x: SslPtr):Integer; external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_CTX_use_certificate_ASN1')]
+    function SslCtxUseCertificateASN1(ctx: PSSL_CTX; len: integer; d: String):Integer; external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_CTX_use_certificate_file')]
+    function SslCtxUseCertificateFile(ctx: PSSL_CTX; const _file: String; _type: Integer):Integer;external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_CTX_use_certificate_chain_file')]
+    function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: String):Integer;external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_CTX_check_private_key')]
+    function SslCtxCheckPrivateKeyFile(ctx: PSSL_CTX):Integer; external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_CTX_set_default_passwd_cb')]
+    procedure SslCtxSetDefaultPasswdCb(ctx: PSSL_CTX; cb: PPasswdCb); external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_CTX_set_default_passwd_cb_userdata')]
+    procedure SslCtxSetDefaultPasswdCbUserdata(ctx: PSSL_CTX; u: IntPtr); external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_CTX_load_verify_locations')]
+    function SslCtxLoadVerifyLocations(ctx: PSSL_CTX; CAfile: string; CApath: String):Integer; external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_CTX_ctrl')]
+    function SslCtxCtrl(ctx: PSSL_CTX; cmd: integer; larg: integer; parg: IntPtr): integer; external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_new')]
+    function SslNew(ctx: PSSL_CTX):PSSL;  external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_free')]
+    procedure SslFree(ssl: PSSL); external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_accept')]
+    function SslAccept(ssl: PSSL):Integer; external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_connect')]
+    function SslConnect(ssl: PSSL):Integer; external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_shutdown')]
+    function SslShutdown(s: PSSL):Integer;  external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_read')]
+    function SslRead(ssl: PSSL; buf: StringBuilder; num: Integer):Integer; external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_peek')]
+    function SslPeek(ssl: PSSL; buf: StringBuilder; num: Integer):Integer; external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_write')]
+    function SslWrite(ssl: PSSL; buf: String; num: Integer):Integer; external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_pending')]
+    function SslPending(ssl: PSSL):Integer; external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_get_version')]
+    function SslGetVersion(ssl: PSSL):String; external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_get_peer_certificate')]
+    function SslGetPeerCertificate(s: PSSL):PX509; external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_CTX_set_verify')]
+    procedure SslCtxSetVerify(ctx: PSSL_CTX; mode: Integer; arg2: PFunction); external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_get_current_cipher')]
+    function SSLGetCurrentCipher(s: PSSL): SslPtr;  external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_CIPHER_get_name')]
+    function SSLCipherGetName(c: SslPtr):String; external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_CIPHER_get_bits')]
+    function SSLCipherGetBits(c: SslPtr; var alg_bits: Integer):Integer;  external;
+
+  [DllImport(DLLSSLName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'SSL_get_verify_result')]
+    function SSLGetVerifyResult(ssl: PSSL):Integer;external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'X509_new')]
+    function X509New: PX509; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'X509_free')]
+    procedure X509Free(x: PX509); external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'X509_NAME_oneline')]
+    function X509NameOneline(a: PX509_NAME; buf: StringBuilder; size: Integer): String; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'X509_get_subject_name')]
+    function X509GetSubjectName(a: PX509):PX509_NAME; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'X509_get_issuer_name')]
+    function X509GetIssuerName(a: PX509):PX509_NAME;  external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'X509_NAME_hash')]
+    function X509NameHash(x: PX509_NAME):Cardinal;   external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'X509_digest')]
+    function X509Digest (data: PX509; _type: PEVP_MD; md: StringBuilder; var len: Integer):Integer; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'X509_set_version')]
+    function X509SetVersion(x: PX509; version: integer): integer; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'X509_set_pubkey')]
+    function X509SetPubkey(x: PX509; pkey: EVP_PKEY): integer; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'X509_set_issuer_name')]
+    function X509SetIssuerName(x: PX509; name: PX509_NAME): integer; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'X509_NAME_add_entry_by_txt')]
+    function X509NameAddEntryByTxt(name: PX509_NAME; field: string; _type: integer;
+      bytes: string; len, loc, _set: integer): integer; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'X509_sign')]
+    function X509Sign(x: PX509; pkey: EVP_PKEY; const md: PEVP_MD): integer; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'X509_print')]
+    function X509print(b: PBIO; a: PX509): integer; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'X509_gmtime_adj')]
+    function X509GmtimeAdj(s: PASN1_UTCTIME; adj: integer): PASN1_UTCTIME; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'X509_set_notBefore')]
+    function X509SetNotBefore(x: PX509; tm: PASN1_UTCTIME): integer; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'X509_set_notAfter')]
+    function X509SetNotAfter(x: PX509; tm: PASN1_UTCTIME): integer; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'X509_get_serialNumber')]
+    function X509GetSerialNumber(x: PX509): PASN1_INTEGER; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'EVP_PKEY_new')]
+    function EvpPkeyNew: EVP_PKEY; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'EVP_PKEY_free')]
+    procedure EvpPkeyFree(pk: EVP_PKEY); external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'EVP_PKEY_assign')]
+    function EvpPkeyAssign(pkey: EVP_PKEY; _type: integer; key: Prsa): integer; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'EVP_get_digestbyname')]
+    function EvpGetDigestByName(Name: String): PEVP_MD; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'EVP_cleanup')]
+    procedure EVPcleanup; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'SSLeay_version')]
+    function SSLeayversion(t: integer): String; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'ERR_error_string_n')]
+    procedure ErrErrorString(e: integer; buf: StringBuilder; len: integer); external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'ERR_get_error')]
+    function ErrGetError: integer; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'ERR_clear_error')]
+    procedure ErrClearError; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'ERR_free_strings')]
+    procedure ErrFreeStrings; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'ERR_remove_state')]
+    procedure ErrRemoveState(pid: integer); external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'OPENSSL_add_all_algorithms_noconf')]
+    procedure OPENSSLaddallalgorithms; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'CRYPTO_cleanup_all_ex_data')]
+    procedure CRYPTOcleanupAllExData; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'RAND_screen')]
+    procedure RandScreen; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'BIO_new')]
+    function BioNew(b: PBIO_METHOD): PBIO; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'BIO_free_all')]
+    procedure BioFreeAll(b: PBIO); external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'BIO_s_mem')]
+    function BioSMem: PBIO_METHOD; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'BIO_ctrl_pending')]
+    function BioCtrlPending(b: PBIO): integer; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'BIO_read')]
+    function BioRead(b: PBIO; Buf: StringBuilder; Len: integer): integer; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'BIO_write')]
+    function BioWrite(b: PBIO; var Buf: String; Len: integer): integer; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'd2i_PKCS12_bio')]
+    function d2iPKCS12bio(b:PBIO; Pkcs12: SslPtr): SslPtr; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'PKCS12_parse')]
+    function PKCS12parse(p12: SslPtr; pass: string; var pkey, cert, ca: SslPtr): integer; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'PKCS12_free')]
+    procedure PKCS12free(p12: SslPtr); external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'RSA_generate_key')]
+    function RsaGenerateKey(bits, e: integer; callback: PFunction; cb_arg: SslPtr): PRSA; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'ASN1_UTCTIME_new')]
+    function Asn1UtctimeNew: PASN1_UTCTIME; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'ASN1_UTCTIME_free')]
+    procedure Asn1UtctimeFree(a: PASN1_UTCTIME); external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'ASN1_INTEGER_set')]
+    function Asn1IntegerSet(a: PASN1_INTEGER; v: integer): integer; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'i2d_X509_bio')]
+    function i2dX509bio(b: PBIO; x: PX509): integer; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint =  'i2d_PrivateKey_bio')]
+    function i2dPrivateKeyBio(b: PBIO; pkey: EVP_PKEY): integer; external;
+
+  // 3DES functions
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'DES_set_odd_parity')]
+    procedure DESsetoddparity(Key: des_cblock); external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'DES_set_key_checked')]
+    function DESsetkeychecked(key: des_cblock; schedule: des_key_schedule): Integer; external;
+
+  [DllImport(DLLUtilName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'DES_ecb_encrypt')]
+    procedure DESecbencrypt(Input: des_cblock; output: des_cblock; ks: des_key_schedule; enc: Integer); external;
+
+{$ELSE}
+// libssl.dll
+  function SslGetError(s: PSSL; ret_code: Integer):Integer;
+  function SslLibraryInit:Integer;
+  procedure SslLoadErrorStrings;
+//  function SslCtxSetCipherList(arg0: PSSL_CTX; str: PChar):Integer;
+  function SslCtxSetCipherList(arg0: PSSL_CTX; var str: AnsiString):Integer;
+  function SslCtxNew(meth: PSSL_METHOD):PSSL_CTX;
+  procedure SslCtxFree(arg0: PSSL_CTX);
+  function SslSetFd(s: PSSL; fd: Integer):Integer;
+  function SslMethodV2:PSSL_METHOD;
+  function SslMethodV3:PSSL_METHOD;
+  function SslMethodTLSV1:PSSL_METHOD;
+  function SslMethodV23:PSSL_METHOD;
+  function SslCtxUsePrivateKey(ctx: PSSL_CTX; pkey: SslPtr):Integer;
+  function SslCtxUsePrivateKeyASN1(pk: integer; ctx: PSSL_CTX; d: AnsiString; len: integer):Integer;
+//  function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: PChar; _type: Integer):Integer;
+  function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: AnsiString; _type: Integer):Integer;
+  function SslCtxUseCertificate(ctx: PSSL_CTX; x: SslPtr):Integer;
+  function SslCtxUseCertificateASN1(ctx: PSSL_CTX; len: integer; d: AnsiString):Integer;
+  function SslCtxUseCertificateFile(ctx: PSSL_CTX; const _file: AnsiString; _type: Integer):Integer;
+//  function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: PChar):Integer;
+  function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: AnsiString):Integer;
+  function SslCtxCheckPrivateKeyFile(ctx: PSSL_CTX):Integer;
+  procedure SslCtxSetDefaultPasswdCb(ctx: PSSL_CTX; cb: PPasswdCb);
+  procedure SslCtxSetDefaultPasswdCbUserdata(ctx: PSSL_CTX; u: SslPtr);
+//  function SslCtxLoadVerifyLocations(ctx: PSSL_CTX; const CAfile: PChar; const CApath: PChar):Integer;
+  function SslCtxLoadVerifyLocations(ctx: PSSL_CTX; const CAfile: AnsiString; const CApath: AnsiString):Integer;
+  function SslCtxCtrl(ctx: PSSL_CTX; cmd: integer; larg: integer; parg: SslPtr): integer;
+  function SslNew(ctx: PSSL_CTX):PSSL;
+  procedure SslFree(ssl: PSSL);
+  function SslAccept(ssl: PSSL):Integer;
+  function SslConnect(ssl: PSSL):Integer;
+  function SslShutdown(ssl: PSSL):Integer;
+  function SslRead(ssl: PSSL; buf: SslPtr; num: Integer):Integer;
+  function SslPeek(ssl: PSSL; buf: SslPtr; num: Integer):Integer;
+  function SslWrite(ssl: PSSL; buf: SslPtr; num: Integer):Integer;
+  function SslPending(ssl: PSSL):Integer;
+  function SslGetVersion(ssl: PSSL):AnsiString;
+  function SslGetPeerCertificate(ssl: PSSL):PX509;
+  procedure SslCtxSetVerify(ctx: PSSL_CTX; mode: Integer; arg2: PFunction);
+  function SSLGetCurrentCipher(s: PSSL):SslPtr;
+  function SSLCipherGetName(c: SslPtr): AnsiString;
+  function SSLCipherGetBits(c: SslPtr; var alg_bits: Integer):Integer;
+  function SSLGetVerifyResult(ssl: PSSL):Integer;
+
+// libeay.dll
+  function X509New: PX509;
+  procedure X509Free(x: PX509);
+  function X509NameOneline(a: PX509_NAME; var buf: AnsiString; size: Integer):AnsiString;
+  function X509GetSubjectName(a: PX509):PX509_NAME;
+  function X509GetIssuerName(a: PX509):PX509_NAME;
+  function X509NameHash(x: PX509_NAME):Cardinal;
+//  function SslX509Digest(data: PX509; _type: PEVP_MD; md: PChar; len: PInteger):Integer;
+  function X509Digest(data: PX509; _type: PEVP_MD; md: AnsiString; var len: Integer):Integer;
+  function X509print(b: PBIO; a: PX509): integer;
+  function X509SetVersion(x: PX509; version: integer): integer;
+  function X509SetPubkey(x: PX509; pkey: EVP_PKEY): integer;
+  function X509SetIssuerName(x: PX509; name: PX509_NAME): integer;
+  function X509NameAddEntryByTxt(name: PX509_NAME; field: Ansistring; _type: integer;
+    bytes: Ansistring; len, loc, _set: integer): integer;
+  function X509Sign(x: PX509; pkey: EVP_PKEY; const md: PEVP_MD): integer;
+  function X509GmtimeAdj(s: PASN1_UTCTIME; adj: integer): PASN1_UTCTIME;
+  function X509SetNotBefore(x: PX509; tm: PASN1_UTCTIME): integer;
+  function X509SetNotAfter(x: PX509; tm: PASN1_UTCTIME): integer;
+  function X509GetSerialNumber(x: PX509): PASN1_INTEGER;
+  function EvpPkeyNew: EVP_PKEY;
+  procedure EvpPkeyFree(pk: EVP_PKEY);
+  function EvpPkeyAssign(pkey: EVP_PKEY; _type: integer; key: Prsa): integer;
+  function EvpGetDigestByName(Name: AnsiString): PEVP_MD;
+  procedure EVPcleanup;
+//  function ErrErrorString(e: integer; buf: PChar): PChar;
+  function SSLeayversion(t: integer): Ansistring;
+  procedure ErrErrorString(e: integer; var buf: Ansistring; len: integer);
+  function ErrGetError: integer;
+  procedure ErrClearError;
+  procedure ErrFreeStrings;
+  procedure ErrRemoveState(pid: integer);
+  procedure OPENSSLaddallalgorithms;
+  procedure CRYPTOcleanupAllExData;
+  procedure RandScreen;
+  function BioNew(b: PBIO_METHOD): PBIO;
+  procedure BioFreeAll(b: PBIO);
+  function BioSMem: PBIO_METHOD;
+  function BioCtrlPending(b: PBIO): integer;
+  function BioRead(b: PBIO; var Buf: AnsiString; Len: integer): integer;
+  function BioWrite(b: PBIO; Buf: AnsiString; Len: integer): integer;
+  function d2iPKCS12bio(b:PBIO; Pkcs12: SslPtr): SslPtr;
+  function PKCS12parse(p12: SslPtr; pass: Ansistring; var pkey, cert, ca: SslPtr): integer;
+  procedure PKCS12free(p12: SslPtr);
+  function RsaGenerateKey(bits, e: integer; callback: PFunction; cb_arg: SslPtr): PRSA;
+  function Asn1UtctimeNew: PASN1_UTCTIME;
+  procedure Asn1UtctimeFree(a: PASN1_UTCTIME);
+  function Asn1IntegerSet(a: PASN1_INTEGER; v: integer): integer;
+  function i2dX509bio(b: PBIO; x: PX509): integer;
+  function i2dPrivateKeyBio(b: PBIO; pkey: EVP_PKEY): integer;
+
+  // 3DES functions
+  procedure DESsetoddparity(Key: des_cblock);
+  function DESsetkeychecked(key: des_cblock; schedule: des_key_schedule): Integer;
+  procedure DESecbencrypt(Input: des_cblock; output: des_cblock; ks: des_key_schedule; enc: Integer);
+
+{$ENDIF}
+
+function IsSSLloaded: Boolean;
+function InitSSLInterface: Boolean;
+function DestroySSLInterface: Boolean;
+
+implementation
+
+uses SyncObjs;
+
+{$IFNDEF CIL}
+type
+// libssl.dll
+  TSslGetError = function(s: PSSL; ret_code: Integer):Integer; cdecl;
+  TSslLibraryInit = function:Integer; cdecl;
+  TSslLoadErrorStrings = procedure; cdecl;
+  TSslCtxSetCipherList = function(arg0: PSSL_CTX; str: PAnsiChar):Integer; cdecl;
+  TSslCtxNew = function(meth: PSSL_METHOD):PSSL_CTX; cdecl;
+  TSslCtxFree = procedure(arg0: PSSL_CTX); cdecl;
+  TSslSetFd = function(s: PSSL; fd: Integer):Integer; cdecl;
+  TSslMethodV2 = function:PSSL_METHOD; cdecl;
+  TSslMethodV3 = function:PSSL_METHOD; cdecl;
+  TSslMethodTLSV1 = function:PSSL_METHOD; cdecl;
+  TSslMethodV23 = function:PSSL_METHOD; cdecl;
+  TSslCtxUsePrivateKey = function(ctx: PSSL_CTX; pkey: sslptr):Integer; cdecl;
+  TSslCtxUsePrivateKeyASN1 = function(pk: integer; ctx: PSSL_CTX; d: sslptr; len: integer):Integer; cdecl;
+  TSslCtxUsePrivateKeyFile = function(ctx: PSSL_CTX; const _file: PAnsiChar; _type: Integer):Integer; cdecl;
+  TSslCtxUseCertificate = function(ctx: PSSL_CTX; x: SslPtr):Integer; cdecl;
+  TSslCtxUseCertificateASN1 = function(ctx: PSSL_CTX; len: Integer; d: SslPtr):Integer; cdecl;
+  TSslCtxUseCertificateFile = function(ctx: PSSL_CTX; const _file: PAnsiChar; _type: Integer):Integer; cdecl;
+  TSslCtxUseCertificateChainFile = function(ctx: PSSL_CTX; const _file: PAnsiChar):Integer; cdecl;
+  TSslCtxCheckPrivateKeyFile = function(ctx: PSSL_CTX):Integer; cdecl;
+  TSslCtxSetDefaultPasswdCb = procedure(ctx: PSSL_CTX; cb: SslPtr); cdecl;
+  TSslCtxSetDefaultPasswdCbUserdata = procedure(ctx: PSSL_CTX; u: SslPtr); cdecl;
+  TSslCtxLoadVerifyLocations = function(ctx: PSSL_CTX; const CAfile: PAnsiChar; const CApath: PAnsiChar):Integer; cdecl;
+  TSslCtxCtrl = function(ctx: PSSL_CTX; cmd: integer; larg: integer; parg: SslPtr): integer; cdecl;
+  TSslNew = function(ctx: PSSL_CTX):PSSL; cdecl;
+  TSslFree = procedure(ssl: PSSL); cdecl;
+  TSslAccept = function(ssl: PSSL):Integer; cdecl;
+  TSslConnect = function(ssl: PSSL):Integer; cdecl;
+  TSslShutdown = function(ssl: PSSL):Integer; cdecl;
+  TSslRead = function(ssl: PSSL; buf: PAnsiChar; num: Integer):Integer; cdecl;
+  TSslPeek = function(ssl: PSSL; buf: PAnsiChar; num: Integer):Integer; cdecl;
+  TSslWrite = function(ssl: PSSL; const buf: PAnsiChar; num: Integer):Integer; cdecl;
+  TSslPending = function(ssl: PSSL):Integer; cdecl;
+  TSslGetVersion = function(ssl: PSSL):PAnsiChar; cdecl;
+  TSslGetPeerCertificate = function(ssl: PSSL):PX509; cdecl;
+  TSslCtxSetVerify = procedure(ctx: PSSL_CTX; mode: Integer; arg2: SslPtr); cdecl;
+  TSSLGetCurrentCipher = function(s: PSSL):SslPtr; cdecl;
+  TSSLCipherGetName = function(c: Sslptr):PAnsiChar; cdecl;
+  TSSLCipherGetBits = function(c: SslPtr; alg_bits: PInteger):Integer; cdecl;
+  TSSLGetVerifyResult = function(ssl: PSSL):Integer; cdecl;
+
+// libeay.dll
+  TX509New = function: PX509; cdecl;
+  TX509Free = procedure(x: PX509); cdecl;
+  TX509NameOneline = function(a: PX509_NAME; buf: PAnsiChar; size: Integer):PAnsiChar; cdecl;
+  TX509GetSubjectName = function(a: PX509):PX509_NAME; cdecl;
+  TX509GetIssuerName = function(a: PX509):PX509_NAME; cdecl;
+  TX509NameHash = function(x: PX509_NAME):Cardinal; cdecl;
+  TX509Digest = function(data: PX509; _type: PEVP_MD; md: PAnsiChar; len: PInteger):Integer; cdecl;
+  TX509print = function(b: PBIO; a: PX509): integer; cdecl;
+  TX509SetVersion = function(x: PX509; version: integer): integer; cdecl;
+  TX509SetPubkey = function(x: PX509; pkey: EVP_PKEY): integer; cdecl;
+  TX509SetIssuerName = function(x: PX509; name: PX509_NAME): integer; cdecl;
+  TX509NameAddEntryByTxt = function(name: PX509_NAME; field: PAnsiChar; _type: integer;
+    bytes: PAnsiChar; len, loc, _set: integer): integer; cdecl;
+  TX509Sign = function(x: PX509; pkey: EVP_PKEY; const md: PEVP_MD): integer; cdecl;
+  TX509GmtimeAdj = function(s: PASN1_UTCTIME; adj: integer): PASN1_UTCTIME; cdecl;
+  TX509SetNotBefore = function(x: PX509; tm: PASN1_UTCTIME): integer; cdecl;
+  TX509SetNotAfter = function(x: PX509; tm: PASN1_UTCTIME): integer; cdecl;
+  TX509GetSerialNumber = function(x: PX509): PASN1_INTEGER; cdecl;
+  TEvpPkeyNew = function: EVP_PKEY; cdecl;
+  TEvpPkeyFree = procedure(pk: EVP_PKEY); cdecl;
+  TEvpPkeyAssign = function(pkey: EVP_PKEY; _type: integer; key: Prsa): integer; cdecl;
+  TEvpGetDigestByName = function(Name: PAnsiChar): PEVP_MD; cdecl;
+  TEVPcleanup = procedure; cdecl;
+  TSSLeayversion = function(t: integer): PAnsiChar; cdecl;
+  TErrErrorString = procedure(e: integer; buf: PAnsiChar; len: integer); cdecl;
+  TErrGetError = function: integer; cdecl;
+  TErrClearError = procedure; cdecl;
+  TErrFreeStrings = procedure; cdecl;
+  TErrRemoveState = procedure(pid: integer); cdecl;
+  TOPENSSLaddallalgorithms = procedure; cdecl;
+  TCRYPTOcleanupAllExData = procedure; cdecl;
+  TRandScreen = procedure; cdecl;
+  TBioNew = function(b: PBIO_METHOD): PBIO; cdecl;
+  TBioFreeAll = procedure(b: PBIO); cdecl;
+  TBioSMem = function: PBIO_METHOD; cdecl;
+  TBioCtrlPending = function(b: PBIO): integer; cdecl;
+  TBioRead = function(b: PBIO; Buf: PAnsiChar; Len: integer): integer; cdecl;
+  TBioWrite = function(b: PBIO; Buf: PAnsiChar; Len: integer): integer; cdecl;
+  Td2iPKCS12bio = function(b:PBIO; Pkcs12: SslPtr): SslPtr; cdecl;
+  TPKCS12parse = function(p12: SslPtr; pass: PAnsiChar; var pkey, cert, ca: SslPtr): integer; cdecl;
+  TPKCS12free = procedure(p12: SslPtr); cdecl;
+  TRsaGenerateKey = function(bits, e: integer; callback: PFunction; cb_arg: SslPtr): PRSA; cdecl;
+  TAsn1UtctimeNew = function: PASN1_UTCTIME; cdecl;
+  TAsn1UtctimeFree = procedure(a: PASN1_UTCTIME); cdecl;
+  TAsn1IntegerSet = function(a: PASN1_INTEGER; v: integer): integer; cdecl;
+  Ti2dX509bio = function(b: PBIO; x: PX509): integer; cdecl;
+  Ti2dPrivateKeyBio= function(b: PBIO; pkey: EVP_PKEY): integer; cdecl;
+
+  // 3DES functions
+  TDESsetoddparity = procedure(Key: des_cblock); cdecl;
+  TDESsetkeychecked = function(key: des_cblock; schedule: des_key_schedule): Integer; cdecl;
+  TDESecbencrypt = procedure(Input: des_cblock; output: des_cblock; ks: des_key_schedule; enc: Integer); cdecl;
+  //thread lock functions
+  TCRYPTOnumlocks = function: integer; cdecl;
+  TCRYPTOSetLockingCallback = procedure(cb: Sslptr); cdecl;
+
+var
+// libssl.dll
+  _SslGetError: TSslGetError = nil;
+  _SslLibraryInit: TSslLibraryInit = nil;
+  _SslLoadErrorStrings: TSslLoadErrorStrings = nil;
+  _SslCtxSetCipherList: TSslCtxSetCipherList = nil;
+  _SslCtxNew: TSslCtxNew = nil;
+  _SslCtxFree: TSslCtxFree = nil;
+  _SslSetFd: TSslSetFd = nil;
+  _SslMethodV2: TSslMethodV2 = nil;
+  _SslMethodV3: TSslMethodV3 = nil;
+  _SslMethodTLSV1: TSslMethodTLSV1 = nil;
+  _SslMethodV23: TSslMethodV23 = nil;
+  _SslCtxUsePrivateKey: TSslCtxUsePrivateKey = nil;
+  _SslCtxUsePrivateKeyASN1: TSslCtxUsePrivateKeyASN1 = nil;
+  _SslCtxUsePrivateKeyFile: TSslCtxUsePrivateKeyFile = nil;
+  _SslCtxUseCertificate: TSslCtxUseCertificate = nil;
+  _SslCtxUseCertificateASN1: TSslCtxUseCertificateASN1 = nil;
+  _SslCtxUseCertificateFile: TSslCtxUseCertificateFile = nil;
+  _SslCtxUseCertificateChainFile: TSslCtxUseCertificateChainFile = nil;
+  _SslCtxCheckPrivateKeyFile: TSslCtxCheckPrivateKeyFile = nil;
+  _SslCtxSetDefaultPasswdCb: TSslCtxSetDefaultPasswdCb = nil;
+  _SslCtxSetDefaultPasswdCbUserdata: TSslCtxSetDefaultPasswdCbUserdata = nil;
+  _SslCtxLoadVerifyLocations: TSslCtxLoadVerifyLocations = nil;
+  _SslCtxCtrl: TSslCtxCtrl = nil;
+  _SslNew: TSslNew = nil;
+  _SslFree: TSslFree = nil;
+  _SslAccept: TSslAccept = nil;
+  _SslConnect: TSslConnect = nil;
+  _SslShutdown: TSslShutdown = nil;
+  _SslRead: TSslRead = nil;
+  _SslPeek: TSslPeek = nil;
+  _SslWrite: TSslWrite = nil;
+  _SslPending: TSslPending = nil;
+  _SslGetVersion: TSslGetVersion = nil;
+  _SslGetPeerCertificate: TSslGetPeerCertificate = nil;
+  _SslCtxSetVerify: TSslCtxSetVerify = nil;
+  _SSLGetCurrentCipher: TSSLGetCurrentCipher = nil;
+  _SSLCipherGetName: TSSLCipherGetName = nil;
+  _SSLCipherGetBits: TSSLCipherGetBits = nil;
+  _SSLGetVerifyResult: TSSLGetVerifyResult = nil;
+
+// libeay.dll
+  _X509New: TX509New = nil;
+  _X509Free: TX509Free = nil;
+  _X509NameOneline: TX509NameOneline = nil;
+  _X509GetSubjectName: TX509GetSubjectName = nil;
+  _X509GetIssuerName: TX509GetIssuerName = nil;
+  _X509NameHash: TX509NameHash = nil;
+  _X509Digest: TX509Digest = nil;
+  _X509print: TX509print = nil;
+  _X509SetVersion: TX509SetVersion = nil;
+  _X509SetPubkey: TX509SetPubkey = nil;
+  _X509SetIssuerName: TX509SetIssuerName = nil;
+  _X509NameAddEntryByTxt: TX509NameAddEntryByTxt = nil;
+  _X509Sign: TX509Sign = nil;
+  _X509GmtimeAdj: TX509GmtimeAdj = nil;
+  _X509SetNotBefore: TX509SetNotBefore = nil;
+  _X509SetNotAfter: TX509SetNotAfter = nil;
+  _X509GetSerialNumber: TX509GetSerialNumber = nil;
+  _EvpPkeyNew: TEvpPkeyNew = nil;
+  _EvpPkeyFree: TEvpPkeyFree = nil;
+  _EvpPkeyAssign: TEvpPkeyAssign = nil;
+  _EvpGetDigestByName: TEvpGetDigestByName = nil;
+  _EVPcleanup: TEVPcleanup = nil;
+  _SSLeayversion: TSSLeayversion = nil;
+  _ErrErrorString: TErrErrorString = nil;
+  _ErrGetError: TErrGetError = nil;
+  _ErrClearError: TErrClearError = nil;
+  _ErrFreeStrings: TErrFreeStrings = nil;
+  _ErrRemoveState: TErrRemoveState = nil;
+  _OPENSSLaddallalgorithms: TOPENSSLaddallalgorithms = nil;
+  _CRYPTOcleanupAllExData: TCRYPTOcleanupAllExData = nil;
+  _RandScreen: TRandScreen = nil;
+  _BioNew: TBioNew = nil;
+  _BioFreeAll: TBioFreeAll = nil;
+  _BioSMem: TBioSMem = nil;
+  _BioCtrlPending: TBioCtrlPending = nil;
+  _BioRead: TBioRead = nil;
+  _BioWrite: TBioWrite = nil;
+  _d2iPKCS12bio: Td2iPKCS12bio = nil;
+  _PKCS12parse: TPKCS12parse = nil;
+  _PKCS12free: TPKCS12free = nil;
+  _RsaGenerateKey: TRsaGenerateKey = nil;
+  _Asn1UtctimeNew: TAsn1UtctimeNew = nil;
+  _Asn1UtctimeFree: TAsn1UtctimeFree = nil;
+  _Asn1IntegerSet: TAsn1IntegerSet = nil;
+  _i2dX509bio: Ti2dX509bio = nil;
+  _i2dPrivateKeyBio: Ti2dPrivateKeyBio = nil;
+
+  // 3DES functions
+  _DESsetoddparity: TDESsetoddparity = nil;
+  _DESsetkeychecked: TDESsetkeychecked = nil;
+  _DESecbencrypt: TDESecbencrypt = nil;
+  //thread lock functions
+  _CRYPTOnumlocks: TCRYPTOnumlocks = nil;
+  _CRYPTOSetLockingCallback: TCRYPTOSetLockingCallback = nil;
+{$ENDIF}
+
+var
+  SSLCS: TCriticalSection;
+  SSLloaded: boolean = false;
+{$IFNDEF CIL}
+  Locks: TList;
+{$ENDIF}
+
+{$IFNDEF CIL}
+// libssl.dll
+function SslGetError(s: PSSL; ret_code: Integer):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslGetError) then
+    Result := _SslGetError(s, ret_code)
+  else
+    Result := SSL_ERROR_SSL;
+end;
+
+function SslLibraryInit:Integer;
+begin
+  if InitSSLInterface and Assigned(_SslLibraryInit) then
+    Result := _SslLibraryInit
+  else
+    Result := 1;
+end;
+
+procedure SslLoadErrorStrings;
+begin
+  if InitSSLInterface and Assigned(_SslLoadErrorStrings) then
+    _SslLoadErrorStrings;
+end;
+
+//function SslCtxSetCipherList(arg0: PSSL_CTX; str: PChar):Integer;
+function SslCtxSetCipherList(arg0: PSSL_CTX; var str: AnsiString):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslCtxSetCipherList) then
+    Result := _SslCtxSetCipherList(arg0, PAnsiChar(str))
+  else
+    Result := 0;
+end;
+
+function SslCtxNew(meth: PSSL_METHOD):PSSL_CTX;
+begin
+  if InitSSLInterface and Assigned(_SslCtxNew) then
+    Result := _SslCtxNew(meth)
+  else
+    Result := nil;
+end;
+
+procedure SslCtxFree(arg0: PSSL_CTX);
+begin
+  if InitSSLInterface and Assigned(_SslCtxFree) then
+    _SslCtxFree(arg0);
+end;
+
+function SslSetFd(s: PSSL; fd: Integer):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslSetFd) then
+    Result := _SslSetFd(s, fd)
+  else
+    Result := 0;
+end;
+
+function SslMethodV2:PSSL_METHOD;
+begin
+  if InitSSLInterface and Assigned(_SslMethodV2) then
+    Result := _SslMethodV2
+  else
+    Result := nil;
+end;
+
+function SslMethodV3:PSSL_METHOD;
+begin
+  if InitSSLInterface and Assigned(_SslMethodV3) then
+    Result := _SslMethodV3
+  else
+    Result := nil;
+end;
+
+function SslMethodTLSV1:PSSL_METHOD;
+begin
+  if InitSSLInterface and Assigned(_SslMethodTLSV1) then
+    Result := _SslMethodTLSV1
+  else
+    Result := nil;
+end;
+
+function SslMethodV23:PSSL_METHOD;
+begin
+  if InitSSLInterface and Assigned(_SslMethodV23) then
+    Result := _SslMethodV23
+  else
+    Result := nil;
+end;
+
+function SslCtxUsePrivateKey(ctx: PSSL_CTX; pkey: SslPtr):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslCtxUsePrivateKey) then
+    Result := _SslCtxUsePrivateKey(ctx, pkey)
+  else
+    Result := 0;
+end;
+
+function SslCtxUsePrivateKeyASN1(pk: integer; ctx: PSSL_CTX; d: AnsiString; len: integer):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslCtxUsePrivateKeyASN1) then
+    Result := _SslCtxUsePrivateKeyASN1(pk, ctx, Sslptr(d), len)
+  else
+    Result := 0;
+end;
+
+//function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: PChar; _type: Integer):Integer;
+function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: AnsiString; _type: Integer):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslCtxUsePrivateKeyFile) then
+    Result := _SslCtxUsePrivateKeyFile(ctx, PAnsiChar(_file), _type)
+  else
+    Result := 0;
+end;
+
+function SslCtxUseCertificate(ctx: PSSL_CTX; x: SslPtr):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslCtxUseCertificate) then
+    Result := _SslCtxUseCertificate(ctx, x)
+  else
+    Result := 0;
+end;
+
+function SslCtxUseCertificateASN1(ctx: PSSL_CTX; len: integer; d: AnsiString):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslCtxUseCertificateASN1) then
+    Result := _SslCtxUseCertificateASN1(ctx, len, SslPtr(d))
+  else
+    Result := 0;
+end;
+
+function SslCtxUseCertificateFile(ctx: PSSL_CTX; const _file: AnsiString; _type: Integer):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslCtxUseCertificateFile) then
+    Result := _SslCtxUseCertificateFile(ctx, PAnsiChar(_file), _type)
+  else
+    Result := 0;
+end;
+
+//function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: PChar):Integer;
+function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: AnsiString):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslCtxUseCertificateChainFile) then
+    Result := _SslCtxUseCertificateChainFile(ctx, PAnsiChar(_file))
+  else
+    Result := 0;
+end;
+
+function SslCtxCheckPrivateKeyFile(ctx: PSSL_CTX):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslCtxCheckPrivateKeyFile) then
+    Result := _SslCtxCheckPrivateKeyFile(ctx)
+  else
+    Result := 0;
+end;
+
+procedure SslCtxSetDefaultPasswdCb(ctx: PSSL_CTX; cb: PPasswdCb);
+begin
+  if InitSSLInterface and Assigned(_SslCtxSetDefaultPasswdCb) then
+    _SslCtxSetDefaultPasswdCb(ctx, cb);
+end;
+
+procedure SslCtxSetDefaultPasswdCbUserdata(ctx: PSSL_CTX; u: SslPtr);
+begin
+  if InitSSLInterface and Assigned(_SslCtxSetDefaultPasswdCbUserdata) then
+    _SslCtxSetDefaultPasswdCbUserdata(ctx, u);
+end;
+
+//function SslCtxLoadVerifyLocations(ctx: PSSL_CTX; const CAfile: PChar; const CApath: PChar):Integer;
+function SslCtxLoadVerifyLocations(ctx: PSSL_CTX; const CAfile: AnsiString; const CApath: AnsiString):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslCtxLoadVerifyLocations) then
+    Result := _SslCtxLoadVerifyLocations(ctx, SslPtr(CAfile), SslPtr(CApath))
+  else
+    Result := 0;
+end;
+
+function SslCtxCtrl(ctx: PSSL_CTX; cmd: integer; larg: integer; parg: SslPtr): integer;
+begin
+  if InitSSLInterface and Assigned(_SslCtxCtrl) then
+    Result := _SslCtxCtrl(ctx, cmd, larg, parg)
+  else
+    Result := 0;
+end;
+
+function SslNew(ctx: PSSL_CTX):PSSL;
+begin
+  if InitSSLInterface and Assigned(_SslNew) then
+    Result := _SslNew(ctx)
+  else
+    Result := nil;
+end;
+
+procedure SslFree(ssl: PSSL);
+begin
+  if InitSSLInterface and Assigned(_SslFree) then
+    _SslFree(ssl);
+end;
+
+function SslAccept(ssl: PSSL):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslAccept) then
+    Result := _SslAccept(ssl)
+  else
+    Result := -1;
+end;
+
+function SslConnect(ssl: PSSL):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslConnect) then
+    Result := _SslConnect(ssl)
+  else
+    Result := -1;
+end;
+
+function SslShutdown(ssl: PSSL):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslShutdown) then
+    Result := _SslShutdown(ssl)
+  else
+    Result := -1;
+end;
+
+//function SslRead(ssl: PSSL; buf: PChar; num: Integer):Integer;
+function SslRead(ssl: PSSL; buf: SslPtr; num: Integer):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslRead) then
+    Result := _SslRead(ssl, PAnsiChar(buf), num)
+  else
+    Result := -1;
+end;
+
+//function SslPeek(ssl: PSSL; buf: PChar; num: Integer):Integer;
+function SslPeek(ssl: PSSL; buf: SslPtr; num: Integer):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslPeek) then
+    Result := _SslPeek(ssl, PAnsiChar(buf), num)
+  else
+    Result := -1;
+end;
+
+//function SslWrite(ssl: PSSL; const buf: PChar; num: Integer):Integer;
+function SslWrite(ssl: PSSL; buf: SslPtr; num: Integer):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslWrite) then
+    Result := _SslWrite(ssl, PAnsiChar(buf), num)
+  else
+    Result := -1;
+end;
+
+function SslPending(ssl: PSSL):Integer;
+begin
+  if InitSSLInterface and Assigned(_SslPending) then
+    Result := _SslPending(ssl)
+  else
+    Result := 0;
+end;
+
+//function SslGetVersion(ssl: PSSL):PChar;
+function SslGetVersion(ssl: PSSL):AnsiString;
+begin
+  if InitSSLInterface and Assigned(_SslGetVersion) then
+    Result := _SslGetVersion(ssl)
+  else
+    Result := '';
+end;
+
+function SslGetPeerCertificate(ssl: PSSL):PX509;
+begin
+  if InitSSLInterface and Assigned(_SslGetPeerCertificate) then
+    Result := _SslGetPeerCertificate(ssl)
+  else
+    Result := nil;
+end;
+
+//procedure SslCtxSetVerify(ctx: PSSL_CTX; mode: Integer; arg2: SslPtr);
+procedure SslCtxSetVerify(ctx: PSSL_CTX; mode: Integer; arg2: PFunction);
+begin
+  if InitSSLInterface and Assigned(_SslCtxSetVerify) then
+    _SslCtxSetVerify(ctx, mode, @arg2);
+end;
+
+function SSLGetCurrentCipher(s: PSSL):SslPtr;
+begin
+  if InitSSLInterface and Assigned(_SSLGetCurrentCipher) then
+{$IFDEF CIL}
+{$ELSE}
+    Result := _SSLGetCurrentCipher(s)
+{$ENDIF}
+  else
+    Result := nil;
+end;
+
+//function SSLCipherGetName(c: SslPtr):PChar;
+function SSLCipherGetName(c: SslPtr):AnsiString;
+begin
+  if InitSSLInterface and Assigned(_SSLCipherGetName) then
+    Result := _SSLCipherGetName(c)
+  else
+    Result := '';
+end;
+
+//function SSLCipherGetBits(c: SslPtr; alg_bits: PInteger):Integer;
+function SSLCipherGetBits(c: SslPtr; var alg_bits: Integer):Integer;
+begin
+  if InitSSLInterface and Assigned(_SSLCipherGetBits) then
+    Result := _SSLCipherGetBits(c, @alg_bits)
+  else
+    Result := 0;
+end;
+
+function SSLGetVerifyResult(ssl: PSSL):Integer;
+begin
+  if InitSSLInterface and Assigned(_SSLGetVerifyResult) then
+    Result := _SSLGetVerifyResult(ssl)
+  else
+    Result := X509_V_ERR_APPLICATION_VERIFICATION;
+end;
+
+// libeay.dll
+function X509New: PX509;
+begin
+  if InitSSLInterface and Assigned(_X509New) then
+    Result := _X509New
+  else
+    Result := nil;
+end;
+
+procedure X509Free(x: PX509);
+begin
+  if InitSSLInterface and Assigned(_X509Free) then
+    _X509Free(x);
+end;
+
+//function SslX509NameOneline(a: PX509_NAME; buf: PChar; size: Integer):PChar;
+function X509NameOneline(a: PX509_NAME; var buf: AnsiString; size: Integer):AnsiString;
+begin
+  if InitSSLInterface and Assigned(_X509NameOneline) then
+    Result := _X509NameOneline(a, PAnsiChar(buf),size)
+  else
+    Result := '';
+end;
+
+function X509GetSubjectName(a: PX509):PX509_NAME;
+begin
+  if InitSSLInterface and Assigned(_X509GetSubjectName) then
+    Result := _X509GetSubjectName(a)
+  else
+    Result := nil;
+end;
+
+function X509GetIssuerName(a: PX509):PX509_NAME;
+begin
+  if InitSSLInterface and Assigned(_X509GetIssuerName) then
+    Result := _X509GetIssuerName(a)
+  else
+    Result := nil;
+end;
+
+function X509NameHash(x: PX509_NAME):Cardinal;
+begin
+  if InitSSLInterface and Assigned(_X509NameHash) then
+    Result := _X509NameHash(x)
+  else
+    Result := 0;
+end;
+
+//function SslX509Digest(data: PX509; _type: PEVP_MD; md: PChar; len: PInteger):Integer;
+function X509Digest(data: PX509; _type: PEVP_MD; md: AnsiString; var len: Integer):Integer;
+begin
+  if InitSSLInterface and Assigned(_X509Digest) then
+    Result := _X509Digest(data, _type, PAnsiChar(md), @len)
+  else
+    Result := 0;
+end;
+
+function EvpPkeyNew: EVP_PKEY;
+begin
+  if InitSSLInterface and Assigned(_EvpPkeyNew) then
+    Result := _EvpPkeyNew
+  else
+    Result := nil;
+end;
+
+procedure EvpPkeyFree(pk: EVP_PKEY);
+begin
+  if InitSSLInterface and Assigned(_EvpPkeyFree) then
+    _EvpPkeyFree(pk);
+end;
+
+function SSLeayversion(t: integer): Ansistring;
+begin
+  if InitSSLInterface and Assigned(_SSLeayversion) then
+    Result := PAnsiChar(_SSLeayversion(t))
+  else
+    Result := '';
+end;
+
+procedure ErrErrorString(e: integer; var buf: Ansistring; len: integer);
+begin
+  if InitSSLInterface and Assigned(_ErrErrorString) then
+    _ErrErrorString(e, Pointer(buf), len);
+  buf := PAnsiChar(Buf);
+end;
+
+function ErrGetError: integer;
+begin
+  if InitSSLInterface and Assigned(_ErrGetError) then
+    Result := _ErrGetError
+  else
+    Result := SSL_ERROR_SSL;
+end;
+
+procedure ErrClearError;
+begin
+  if InitSSLInterface and Assigned(_ErrClearError) then
+    _ErrClearError;
+end;
+
+procedure ErrFreeStrings;
+begin
+  if InitSSLInterface and Assigned(_ErrFreeStrings) then
+    _ErrFreeStrings;
+end;
+
+procedure ErrRemoveState(pid: integer);
+begin
+  if InitSSLInterface and Assigned(_ErrRemoveState) then
+    _ErrRemoveState(pid);
+end;
+
+procedure OPENSSLaddallalgorithms;
+begin
+  if InitSSLInterface and Assigned(_OPENSSLaddallalgorithms) then
+    _OPENSSLaddallalgorithms;
+end;
+
+procedure EVPcleanup;
+begin
+  if InitSSLInterface and Assigned(_EVPcleanup) then
+    _EVPcleanup;
+end;
+
+procedure CRYPTOcleanupAllExData;
+begin
+  if InitSSLInterface and Assigned(_CRYPTOcleanupAllExData) then
+    _CRYPTOcleanupAllExData;
+end;
+
+procedure RandScreen;
+begin
+  if InitSSLInterface and Assigned(_RandScreen) then
+    _RandScreen;
+end;
+
+function BioNew(b: PBIO_METHOD): PBIO;
+begin
+  if InitSSLInterface and Assigned(_BioNew) then
+    Result := _BioNew(b)
+  else
+    Result := nil;
+end;
+
+procedure BioFreeAll(b: PBIO);
+begin
+  if InitSSLInterface and Assigned(_BioFreeAll) then
+    _BioFreeAll(b);
+end;
+
+function BioSMem: PBIO_METHOD;
+begin
+  if InitSSLInterface and Assigned(_BioSMem) then
+    Result := _BioSMem
+  else
+    Result := nil;
+end;
+
+function BioCtrlPending(b: PBIO): integer;
+begin
+  if InitSSLInterface and Assigned(_BioCtrlPending) then
+    Result := _BioCtrlPending(b)
+  else
+    Result := 0;
+end;
+
+//function BioRead(b: PBIO; Buf: PChar; Len: integer): integer;
+function BioRead(b: PBIO; var Buf: AnsiString; Len: integer): integer;
+begin
+  if InitSSLInterface and Assigned(_BioRead) then
+    Result := _BioRead(b, PAnsiChar(Buf), Len)
+  else
+    Result := -2;
+end;
+
+//function BioWrite(b: PBIO; Buf: PChar; Len: integer): integer;
+function BioWrite(b: PBIO; Buf: AnsiString; Len: integer): integer;
+begin
+  if InitSSLInterface and Assigned(_BioWrite) then
+    Result := _BioWrite(b, PAnsiChar(Buf), Len)
+  else
+    Result := -2;
+end;
+
+function X509print(b: PBIO; a: PX509): integer;
+begin
+  if InitSSLInterface and Assigned(_X509print) then
+    Result := _X509print(b, a)
+  else
+    Result := 0;
+end;
+
+function d2iPKCS12bio(b:PBIO; Pkcs12: SslPtr): SslPtr;
+begin
+  if InitSSLInterface and Assigned(_d2iPKCS12bio) then
+    Result := _d2iPKCS12bio(b, Pkcs12)
+  else
+    Result := nil;
+end;
+
+function PKCS12parse(p12: SslPtr; pass: Ansistring; var pkey, cert, ca: SslPtr): integer;
+begin
+  if InitSSLInterface and Assigned(_PKCS12parse) then
+    Result := _PKCS12parse(p12, SslPtr(pass), pkey, cert, ca)
+  else
+    Result := 0;
+end;
+
+procedure PKCS12free(p12: SslPtr);
+begin
+  if InitSSLInterface and Assigned(_PKCS12free) then
+    _PKCS12free(p12);
+end;
+
+function RsaGenerateKey(bits, e: integer; callback: PFunction; cb_arg: SslPtr): PRSA;
+begin
+  if InitSSLInterface and Assigned(_RsaGenerateKey) then
+    Result := _RsaGenerateKey(bits, e, callback, cb_arg)
+  else
+    Result := nil;
+end;
+
+function EvpPkeyAssign(pkey: EVP_PKEY; _type: integer; key: Prsa): integer;
+begin
+  if InitSSLInterface and Assigned(_EvpPkeyAssign) then
+    Result := _EvpPkeyAssign(pkey, _type, key)
+  else
+    Result := 0;
+end;
+
+function X509SetVersion(x: PX509; version: integer): integer;
+begin
+  if InitSSLInterface and Assigned(_X509SetVersion) then
+    Result := _X509SetVersion(x, version)
+  else
+    Result := 0;
+end;
+
+function X509SetPubkey(x: PX509; pkey: EVP_PKEY): integer;
+begin
+  if InitSSLInterface and Assigned(_X509SetPubkey) then
+    Result := _X509SetPubkey(x, pkey)
+  else
+    Result := 0;
+end;
+
+function X509SetIssuerName(x: PX509; name: PX509_NAME): integer;
+begin
+  if InitSSLInterface and Assigned(_X509SetIssuerName) then
+    Result := _X509SetIssuerName(x, name)
+  else
+    Result := 0;
+end;
+
+function X509NameAddEntryByTxt(name: PX509_NAME; field: Ansistring; _type: integer;
+  bytes: Ansistring; len, loc, _set: integer): integer;
+begin
+  if InitSSLInterface and Assigned(_X509NameAddEntryByTxt) then
+    Result := _X509NameAddEntryByTxt(name, PAnsiChar(field), _type, PAnsiChar(Bytes), len, loc, _set)
+  else
+    Result := 0;
+end;
+
+function X509Sign(x: PX509; pkey: EVP_PKEY; const md: PEVP_MD): integer;
+begin
+  if InitSSLInterface and Assigned(_X509Sign) then
+    Result := _X509Sign(x, pkey, md)
+  else
+    Result := 0;
+end;
+
+function Asn1UtctimeNew: PASN1_UTCTIME;
+begin
+  if InitSSLInterface and Assigned(_Asn1UtctimeNew) then
+    Result := _Asn1UtctimeNew
+  else
+    Result := nil;
+end;
+
+procedure Asn1UtctimeFree(a: PASN1_UTCTIME);
+begin
+  if InitSSLInterface and Assigned(_Asn1UtctimeFree) then
+    _Asn1UtctimeFree(a);
+end;
+
+function X509GmtimeAdj(s: PASN1_UTCTIME; adj: integer): PASN1_UTCTIME;
+begin
+  if InitSSLInterface and Assigned(_X509GmtimeAdj) then
+    Result := _X509GmtimeAdj(s, adj)
+  else
+    Result := nil;
+end;
+
+function X509SetNotBefore(x: PX509; tm: PASN1_UTCTIME): integer;
+begin
+  if InitSSLInterface and Assigned(_X509SetNotBefore) then
+    Result := _X509SetNotBefore(x, tm)
+  else
+    Result := 0;
+end;
+
+function X509SetNotAfter(x: PX509; tm: PASN1_UTCTIME): integer;
+begin
+  if InitSSLInterface and Assigned(_X509SetNotAfter) then
+    Result := _X509SetNotAfter(x, tm)
+  else
+    Result := 0;
+end;
+
+function i2dX509bio(b: PBIO; x: PX509): integer;
+begin
+  if InitSSLInterface and Assigned(_i2dX509bio) then
+    Result := _i2dX509bio(b, x)
+  else
+    Result := 0;
+end;
+
+function i2dPrivateKeyBio(b: PBIO; pkey: EVP_PKEY): integer;
+begin
+  if InitSSLInterface and Assigned(_i2dPrivateKeyBio) then
+    Result := _i2dPrivateKeyBio(b, pkey)
+  else
+    Result := 0;
+end;
+
+function EvpGetDigestByName(Name: AnsiString): PEVP_MD;
+begin
+  if InitSSLInterface and Assigned(_EvpGetDigestByName) then
+    Result := _EvpGetDigestByName(PAnsiChar(Name))
+  else
+    Result := nil;
+end;
+
+function Asn1IntegerSet(a: PASN1_INTEGER; v: integer): integer;
+begin
+  if InitSSLInterface and Assigned(_Asn1IntegerSet) then
+    Result := _Asn1IntegerSet(a, v)
+  else
+    Result := 0;
+end;
+
+function X509GetSerialNumber(x: PX509): PASN1_INTEGER;
+begin
+  if InitSSLInterface and Assigned(_X509GetSerialNumber) then
+    Result := _X509GetSerialNumber(x)
+  else
+    Result := nil;
+end;
+
+// 3DES functions
+procedure DESsetoddparity(Key: des_cblock);
+begin
+  if InitSSLInterface and Assigned(_DESsetoddparity) then
+    _DESsetoddparity(Key);
+end;
+
+function DESsetkeychecked(key: des_cblock; schedule: des_key_schedule): Integer;
+begin
+  if InitSSLInterface and Assigned(_DESsetkeychecked) then
+    Result := _DESsetkeychecked(key, schedule)
+  else
+    Result := -1;
+end;
+
+procedure DESecbencrypt(Input: des_cblock; output: des_cblock; ks: des_key_schedule; enc: Integer);
+begin
+  if InitSSLInterface and Assigned(_DESecbencrypt) then
+    _DESecbencrypt(Input, output, ks, enc);
+end;
+
+procedure locking_callback(mode, ltype: integer; lfile: PChar; line: integer); cdecl;
+begin
+  if (mode and 1) > 0 then
+    TCriticalSection(Locks[ltype]).Enter
+  else
+    TCriticalSection(Locks[ltype]).Leave;
+end;
+
+procedure InitLocks;
+var
+  n: integer;
+  max: integer;
+begin
+  Locks := TList.Create;
+  max := _CRYPTOnumlocks;
+  for n := 1 to max do
+    Locks.Add(TCriticalSection.Create);
+  _CRYPTOsetlockingcallback(@locking_callback);
+end;
+
+procedure FreeLocks;
+var
+  n: integer;
+begin
+  _CRYPTOsetlockingcallback(nil);
+  for n := 0 to Locks.Count - 1 do
+    TCriticalSection(Locks[n]).Free;
+  Locks.Free;
+end;
+
+{$ENDIF}
+
+function LoadLib(const Value: String): HModule;
+begin
+{$IFDEF CIL}
+  Result := LoadLibrary(Value);
+{$ELSE}
+  Result := LoadLibrary(PChar(Value));
+{$ENDIF}
+end;
+
+function GetProcAddr(module: HModule; const ProcName: string): SslPtr;
+begin
+{$IFDEF CIL}
+  Result := GetProcAddress(module, ProcName);
+{$ELSE}
+  Result := GetProcAddress(module, PChar(ProcName));
+{$ENDIF}
+end;
+
+function InitSSLInterface: Boolean;
+var
+  s: string;
+  x: integer;
+begin
+  SSLCS.Enter;
+  try
+    if not IsSSLloaded then
+    begin
+{$IFDEF CIL}
+      SSLLibHandle := 1;
+      SSLUtilHandle := 1;
+{$ELSE}
+      SSLLibHandle := LoadLib(DLLSSLName);
+      SSLUtilHandle := LoadLib(DLLUtilName);
+  {$IFNDEF LINUX}
+      if (SSLLibHandle = 0) then
+        SSLLibHandle := LoadLib(DLLSSLName2);
+  {$ENDIF}
+{$ENDIF}
+      if (SSLLibHandle <> 0) and (SSLUtilHandle <> 0) then
+      begin
+{$IFNDEF CIL}
+        _SslGetError := GetProcAddr(SSLLibHandle, 'SSL_get_error');
+        _SslLibraryInit := GetProcAddr(SSLLibHandle, 'SSL_library_init');
+        _SslLoadErrorStrings := GetProcAddr(SSLLibHandle, 'SSL_load_error_strings');
+        _SslCtxSetCipherList := GetProcAddr(SSLLibHandle, 'SSL_CTX_set_cipher_list');
+        _SslCtxNew := GetProcAddr(SSLLibHandle, 'SSL_CTX_new');
+        _SslCtxFree := GetProcAddr(SSLLibHandle, 'SSL_CTX_free');
+        _SslSetFd := GetProcAddr(SSLLibHandle, 'SSL_set_fd');
+        _SslMethodV2 := GetProcAddr(SSLLibHandle, 'SSLv2_method');
+        _SslMethodV3 := GetProcAddr(SSLLibHandle, 'SSLv3_method');
+        _SslMethodTLSV1 := GetProcAddr(SSLLibHandle, 'TLSv1_method');
+        _SslMethodV23 := GetProcAddr(SSLLibHandle, 'SSLv23_method');
+        _SslCtxUsePrivateKey := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_PrivateKey');
+        _SslCtxUsePrivateKeyASN1 := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_PrivateKey_ASN1');
+        //use SSL_CTX_use_RSAPrivateKey_file instead SSL_CTX_use_PrivateKey_file,
+        //because SSL_CTX_use_PrivateKey_file not support DER format. :-O
+        _SslCtxUsePrivateKeyFile := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_RSAPrivateKey_file');
+        _SslCtxUseCertificate := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_certificate');
+        _SslCtxUseCertificateASN1 := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_certificate_ASN1');
+        _SslCtxUseCertificateFile := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_certificate_file');
+        _SslCtxUseCertificateChainFile := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_certificate_chain_file');
+        _SslCtxCheckPrivateKeyFile := GetProcAddr(SSLLibHandle, 'SSL_CTX_check_private_key');
+        _SslCtxSetDefaultPasswdCb := GetProcAddr(SSLLibHandle, 'SSL_CTX_set_default_passwd_cb');
+        _SslCtxSetDefaultPasswdCbUserdata := GetProcAddr(SSLLibHandle, 'SSL_CTX_set_default_passwd_cb_userdata');
+        _SslCtxLoadVerifyLocations := GetProcAddr(SSLLibHandle, 'SSL_CTX_load_verify_locations');
+        _SslCtxCtrl := GetProcAddr(SSLLibHandle, 'SSL_CTX_ctrl');
+        _SslNew := GetProcAddr(SSLLibHandle, 'SSL_new');
+        _SslFree := GetProcAddr(SSLLibHandle, 'SSL_free');
+        _SslAccept := GetProcAddr(SSLLibHandle, 'SSL_accept');
+        _SslConnect := GetProcAddr(SSLLibHandle, 'SSL_connect');
+        _SslShutdown := GetProcAddr(SSLLibHandle, 'SSL_shutdown');
+        _SslRead := GetProcAddr(SSLLibHandle, 'SSL_read');
+        _SslPeek := GetProcAddr(SSLLibHandle, 'SSL_peek');
+        _SslWrite := GetProcAddr(SSLLibHandle, 'SSL_write');
+        _SslPending := GetProcAddr(SSLLibHandle, 'SSL_pending');
+        _SslGetPeerCertificate := GetProcAddr(SSLLibHandle, 'SSL_get_peer_certificate');
+        _SslGetVersion := GetProcAddr(SSLLibHandle, 'SSL_get_version');
+        _SslCtxSetVerify := GetProcAddr(SSLLibHandle, 'SSL_CTX_set_verify');
+        _SslGetCurrentCipher := GetProcAddr(SSLLibHandle, 'SSL_get_current_cipher');
+        _SslCipherGetName := GetProcAddr(SSLLibHandle, 'SSL_CIPHER_get_name');
+        _SslCipherGetBits := GetProcAddr(SSLLibHandle, 'SSL_CIPHER_get_bits');
+        _SslGetVerifyResult := GetProcAddr(SSLLibHandle, 'SSL_get_verify_result');
+
+        _X509New := GetProcAddr(SSLUtilHandle, 'X509_new');
+        _X509Free := GetProcAddr(SSLUtilHandle, 'X509_free');
+        _X509NameOneline := GetProcAddr(SSLUtilHandle, 'X509_NAME_oneline');
+        _X509GetSubjectName := GetProcAddr(SSLUtilHandle, 'X509_get_subject_name');
+        _X509GetIssuerName := GetProcAddr(SSLUtilHandle, 'X509_get_issuer_name');
+        _X509NameHash := GetProcAddr(SSLUtilHandle, 'X509_NAME_hash');
+        _X509Digest := GetProcAddr(SSLUtilHandle, 'X509_digest');
+        _X509print := GetProcAddr(SSLUtilHandle, 'X509_print');
+        _X509SetVersion := GetProcAddr(SSLUtilHandle, 'X509_set_version');
+        _X509SetPubkey := GetProcAddr(SSLUtilHandle, 'X509_set_pubkey');
+        _X509SetIssuerName := GetProcAddr(SSLUtilHandle, 'X509_set_issuer_name');
+        _X509NameAddEntryByTxt := GetProcAddr(SSLUtilHandle, 'X509_NAME_add_entry_by_txt');
+        _X509Sign := GetProcAddr(SSLUtilHandle, 'X509_sign');
+        _X509GmtimeAdj := GetProcAddr(SSLUtilHandle, 'X509_gmtime_adj');
+        _X509SetNotBefore := GetProcAddr(SSLUtilHandle, 'X509_set_notBefore');
+        _X509SetNotAfter := GetProcAddr(SSLUtilHandle, 'X509_set_notAfter');
+        _X509GetSerialNumber := GetProcAddr(SSLUtilHandle, 'X509_get_serialNumber');
+        _EvpPkeyNew := GetProcAddr(SSLUtilHandle, 'EVP_PKEY_new');
+        _EvpPkeyFree := GetProcAddr(SSLUtilHandle, 'EVP_PKEY_free');
+        _EvpPkeyAssign := GetProcAddr(SSLUtilHandle, 'EVP_PKEY_assign');
+        _EVPCleanup := GetProcAddr(SSLUtilHandle, 'EVP_cleanup');
+        _EvpGetDigestByName := GetProcAddr(SSLUtilHandle, 'EVP_get_digestbyname');
+        _SSLeayversion := GetProcAddr(SSLUtilHandle, 'SSLeay_version');
+        _ErrErrorString := GetProcAddr(SSLUtilHandle, 'ERR_error_string_n');
+        _ErrGetError := GetProcAddr(SSLUtilHandle, 'ERR_get_error');
+        _ErrClearError := GetProcAddr(SSLUtilHandle, 'ERR_clear_error');
+        _ErrFreeStrings := GetProcAddr(SSLUtilHandle, 'ERR_free_strings');
+        _ErrRemoveState := GetProcAddr(SSLUtilHandle, 'ERR_remove_state');
+        _OPENSSLaddallalgorithms := GetProcAddr(SSLUtilHandle, 'OPENSSL_add_all_algorithms_noconf');
+        _CRYPTOcleanupAllExData := GetProcAddr(SSLUtilHandle, 'CRYPTO_cleanup_all_ex_data');
+        _RandScreen := GetProcAddr(SSLUtilHandle, 'RAND_screen');
+        _BioNew := GetProcAddr(SSLUtilHandle, 'BIO_new');
+        _BioFreeAll := GetProcAddr(SSLUtilHandle, 'BIO_free_all');
+        _BioSMem := GetProcAddr(SSLUtilHandle, 'BIO_s_mem');
+        _BioCtrlPending := GetProcAddr(SSLUtilHandle, 'BIO_ctrl_pending');
+        _BioRead := GetProcAddr(SSLUtilHandle, 'BIO_read');
+        _BioWrite := GetProcAddr(SSLUtilHandle, 'BIO_write');
+        _d2iPKCS12bio := GetProcAddr(SSLUtilHandle, 'd2i_PKCS12_bio');
+        _PKCS12parse := GetProcAddr(SSLUtilHandle, 'PKCS12_parse');
+        _PKCS12free := GetProcAddr(SSLUtilHandle, 'PKCS12_free');
+        _RsaGenerateKey := GetProcAddr(SSLUtilHandle, 'RSA_generate_key');
+        _Asn1UtctimeNew := GetProcAddr(SSLUtilHandle, 'ASN1_UTCTIME_new');
+        _Asn1UtctimeFree := GetProcAddr(SSLUtilHandle, 'ASN1_UTCTIME_free');
+        _Asn1IntegerSet := GetProcAddr(SSLUtilHandle, 'ASN1_INTEGER_set');
+        _i2dX509bio := GetProcAddr(SSLUtilHandle, 'i2d_X509_bio');
+        _i2dPrivateKeyBio := GetProcAddr(SSLUtilHandle, 'i2d_PrivateKey_bio');
+
+        // 3DES functions
+        _DESsetoddparity := GetProcAddr(SSLUtilHandle, 'DES_set_odd_parity');
+        _DESsetkeychecked := GetProcAddr(SSLUtilHandle, 'DES_set_key_checked');
+        _DESecbencrypt := GetProcAddr(SSLUtilHandle, 'DES_ecb_encrypt');
+        //
+        _CRYPTOnumlocks := GetProcAddr(SSLUtilHandle, 'CRYPTO_num_locks');
+        _CRYPTOsetlockingcallback := GetProcAddr(SSLUtilHandle, 'CRYPTO_set_locking_callback');
+{$ENDIF}
+{$IFDEF CIL}
+        SslLibraryInit;
+        SslLoadErrorStrings;
+        OPENSSLaddallalgorithms;
+        RandScreen;
+{$ELSE}
+        SetLength(s, 1024);
+        x := GetModuleFilename(SSLLibHandle,PChar(s),Length(s));
+        SetLength(s, x);
+        SSLLibFile := s;
+        SetLength(s, 1024);
+        x := GetModuleFilename(SSLUtilHandle,PChar(s),Length(s));
+        SetLength(s, x);
+        SSLUtilFile := s;
+        //init library
+        if assigned(_SslLibraryInit) then
+          _SslLibraryInit;
+        if assigned(_SslLoadErrorStrings) then
+          _SslLoadErrorStrings;
+        if assigned(_OPENSSLaddallalgorithms) then
+          _OPENSSLaddallalgorithms;
+        if assigned(_RandScreen) then
+          _RandScreen;
+        if assigned(_CRYPTOnumlocks) and assigned(_CRYPTOsetlockingcallback) then
+          InitLocks;
+{$ENDIF}
+        Result := True;
+        SSLloaded := True;
+      end
+      else
+      begin
+        //load failed!
+        if SSLLibHandle <> 0 then
+        begin
+{$IFNDEF CIL}
+          FreeLibrary(SSLLibHandle);
+{$ENDIF}
+          SSLLibHandle := 0;
+        end;
+        if SSLUtilHandle <> 0 then
+        begin
+{$IFNDEF CIL}
+          FreeLibrary(SSLUtilHandle);
+{$ENDIF}
+          SSLLibHandle := 0;
+        end;
+        Result := False;
+      end;
+    end
+    else
+      //loaded before...
+      Result := true;
+  finally
+    SSLCS.Leave;
+  end;
+end;
+
+function DestroySSLInterface: Boolean;
+begin
+  SSLCS.Enter;
+  try
+    if IsSSLLoaded then
+    begin
+      //deinit library
+{$IFNDEF CIL}
+      if assigned(_CRYPTOnumlocks) and assigned(_CRYPTOsetlockingcallback) then
+        FreeLocks;
+{$ENDIF}
+      EVPCleanup;
+      CRYPTOcleanupAllExData;
+      ErrRemoveState(0);
+    end;
+    SSLloaded := false;
+    if SSLLibHandle <> 0 then
+    begin
+{$IFNDEF CIL}
+      FreeLibrary(SSLLibHandle);
+{$ENDIF}
+      SSLLibHandle := 0;
+    end;
+    if SSLUtilHandle <> 0 then
+    begin
+{$IFNDEF CIL}
+      FreeLibrary(SSLUtilHandle);
+{$ENDIF}
+      SSLLibHandle := 0;
+    end;
+
+{$IFNDEF CIL}
+    _SslGetError := nil;
+    _SslLibraryInit := nil;
+    _SslLoadErrorStrings := nil;
+    _SslCtxSetCipherList := nil;
+    _SslCtxNew := nil;
+    _SslCtxFree := nil;
+    _SslSetFd := nil;
+    _SslMethodV2 := nil;
+    _SslMethodV3 := nil;
+    _SslMethodTLSV1 := nil;
+    _SslMethodV23 := nil;
+    _SslCtxUsePrivateKey := nil;
+    _SslCtxUsePrivateKeyASN1 := nil;
+    _SslCtxUsePrivateKeyFile := nil;
+    _SslCtxUseCertificate := nil;
+    _SslCtxUseCertificateASN1 := nil;
+    _SslCtxUseCertificateFile := nil;
+    _SslCtxUseCertificateChainFile := nil;
+    _SslCtxCheckPrivateKeyFile := nil;
+    _SslCtxSetDefaultPasswdCb := nil;
+    _SslCtxSetDefaultPasswdCbUserdata := nil;
+    _SslCtxLoadVerifyLocations := nil;
+    _SslCtxCtrl := nil;
+    _SslNew := nil;
+    _SslFree := nil;
+    _SslAccept := nil;
+    _SslConnect := nil;
+    _SslShutdown := nil;
+    _SslRead := nil;
+    _SslPeek := nil;
+    _SslWrite := nil;
+    _SslPending := nil;
+    _SslGetPeerCertificate := nil;
+    _SslGetVersion := nil;
+    _SslCtxSetVerify := nil;
+    _SslGetCurrentCipher := nil;
+    _SslCipherGetName := nil;
+    _SslCipherGetBits := nil;
+    _SslGetVerifyResult := nil;
+
+    _X509New := nil;
+    _X509Free := nil;
+    _X509NameOneline := nil;
+    _X509GetSubjectName := nil;
+    _X509GetIssuerName := nil;
+    _X509NameHash := nil;
+    _X509Digest := nil;
+    _X509print := nil;
+    _X509SetVersion := nil;
+    _X509SetPubkey := nil;
+    _X509SetIssuerName := nil;
+    _X509NameAddEntryByTxt := nil;
+    _X509Sign := nil;
+    _X509GmtimeAdj := nil;
+    _X509SetNotBefore := nil;
+    _X509SetNotAfter := nil;
+    _X509GetSerialNumber := nil;
+    _EvpPkeyNew := nil;
+    _EvpPkeyFree := nil;
+    _EvpPkeyAssign := nil;
+    _EVPCleanup := nil;
+    _EvpGetDigestByName := nil;
+    _SSLeayversion := nil;
+    _ErrErrorString := nil;
+    _ErrGetError := nil;
+    _ErrClearError := nil;
+    _ErrFreeStrings := nil;
+    _ErrRemoveState := nil;
+    _OPENSSLaddallalgorithms := nil;
+    _CRYPTOcleanupAllExData := nil;
+    _RandScreen := nil;
+    _BioNew := nil;
+    _BioFreeAll := nil;
+    _BioSMem := nil;
+    _BioCtrlPending := nil;
+    _BioRead := nil;
+    _BioWrite := nil;
+    _d2iPKCS12bio := nil;
+    _PKCS12parse := nil;
+    _PKCS12free := nil;
+    _RsaGenerateKey := nil;
+    _Asn1UtctimeNew := nil;
+    _Asn1UtctimeFree := nil;
+    _Asn1IntegerSet := nil;
+    _i2dX509bio := nil;
+    _i2dPrivateKeyBio := nil;
+
+    // 3DES functions
+    _DESsetoddparity := nil;
+    _DESsetkeychecked := nil;
+    _DESecbencrypt := nil;
+    //
+    _CRYPTOnumlocks := nil;
+    _CRYPTOsetlockingcallback := nil;
+{$ENDIF}
+  finally
+    SSLCS.Leave;
+  end;
+  Result := True;
+end;
+
+function IsSSLloaded: Boolean;
+begin
+  Result := SSLLoaded;
+end;
+
+initialization
+begin
+  SSLCS:= TCriticalSection.Create;
+end;
+
+finalization
+begin
+{$IFNDEF CIL}
+  DestroySSLInterface;
+{$ENDIF}
+  SSLCS.Free;
+end;
+
+end.
diff --git a/Units/Synapse/ssl_streamsec.pas b/Units/Synapse/ssl_streamsec.pas
index 8c36ac8..1dc67f9 100644
--- a/Units/Synapse/ssl_streamsec.pas
+++ b/Units/Synapse/ssl_streamsec.pas
@@ -1,539 +1,539 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 001.000.006 |
-|==============================================================================|
-| Content: SSL support by StreamSecII                                          |
-|==============================================================================|
-| Copyright (c)1999-2005, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2005.                     |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|   Henrick Hellström <henrick@streamsec.se>                                   |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{:@abstract(SSL plugin for StreamSecII or OpenStreamSecII)
-
-StreamSecII is native pascal library, you not need any external libraries!
-
-You can tune lot of StreamSecII properties by using your GlobalServer. If you not
-using your GlobalServer, then this plugin create own TSimpleTLSInternalServer
-instance for each TCP connection. Formore information about GlobalServer usage
-refer StreamSecII documentation.
-
-If you are not using key and certificate by GlobalServer, then you can use
-properties of this plugin instead, but this have limited features and
-@link(TCustomSSL.KeyPassword) not working properly yet!
-
-For handling keys and certificates you can use this properties:
-@link(TCustomSSL.CertCAFile), @link(TCustomSSL.CertCA),
-@link(TCustomSSL.TrustCertificateFile), @link(TCustomSSL.TrustCertificate),
-@link(TCustomSSL.PrivateKeyFile), @link(TCustomSSL.PrivateKey),
-@link(TCustomSSL.CertificateFile), @link(TCustomSSL.Certificate),
-@link(TCustomSSL.PFXFile). For usage of this properties and for possible formats
-of keys and certificates refer to StreamSecII documentation.
-}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$H+}
-
-unit ssl_streamsec;
-
-interface
-
-uses
-  SysUtils, Classes,
-  blcksock, synsock, synautil, synacode,
-  TlsInternalServer, TlsSynaSock, TlsConst, StreamSecII, Asn1, X509Base,
-  SecUtils;
-
-type
-  {:@exclude}
-  TMyTLSSynSockSlave = class(TTLSSynSockSlave)
-  protected
-    procedure SetMyTLSServer(const Value: TCustomTLSInternalServer);
-    function GetMyTLSServer: TCustomTLSInternalServer;
-  published
-    property MyTLSServer: TCustomTLSInternalServer read GetMyTLSServer write SetMyTLSServer;
-  end;
-
-  {:@abstract(class implementing StreamSecII SSL plugin.)
-   Instance of this class will be created for each @link(TTCPBlockSocket).
-   You not need to create instance of this class, all is done by Synapse itself!}
-  TSSLStreamSec = class(TCustomSSL)
-  protected
-    FSlave: TMyTLSSynSockSlave;
-    FIsServer: Boolean;
-    FTLSServer: TCustomTLSInternalServer;
-    FServerCreated: Boolean;
-    function SSLCheck: Boolean;
-    function Init(server:Boolean): Boolean;
-    function DeInit: Boolean;
-    function Prepare(server:Boolean): Boolean;
-    procedure NotTrustEvent(Sender: TObject; Cert: TASN1Struct; var ExplicitTrust: Boolean);
-    function X500StrToStr(const Prefix: string; const Value: TX500String): string;
-    function X501NameToStr(const Value: TX501Name): string;
-    function GetCert: PASN1Struct;
-  public
-    constructor Create(const Value: TTCPBlockSocket); override;
-    destructor Destroy; override;
-    {:See @inherited}
-    function LibVersion: String; override;
-    {:See @inherited}
-    function LibName: String; override;
-    {:See @inherited and @link(ssl_streamsec) for more details.}
-    function Connect: boolean; override;
-    {:See @inherited and @link(ssl_streamsec) for more details.}
-    function Accept: boolean; override;
-    {:See @inherited}
-    function Shutdown: boolean; override;
-    {:See @inherited}
-    function BiShutdown: boolean; override;
-    {:See @inherited}
-    function SendBuffer(Buffer: TMemory; Len: Integer): Integer; override;
-    {:See @inherited}
-    function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; override;
-    {:See @inherited}
-    function WaitingData: Integer; override;
-    {:See @inherited}
-    function GetSSLVersion: string; override;
-    {:See @inherited}
-    function GetPeerSubject: string; override;
-    {:See @inherited}
-    function GetPeerIssuer: string; override;
-    {:See @inherited}
-    function GetPeerName: string; override;
-    {:See @inherited}
-    function GetPeerFingerprint: string; override;
-    {:See @inherited}
-    function GetCertInfo: string; override;
-  published
-    {:TLS server for tuning of StreamSecII.}
-    property TLSServer: TCustomTLSInternalServer read FTLSServer write FTLSServer;
-  end;
-
-implementation
-
-{==============================================================================}
-procedure TMyTLSSynSockSlave.SetMyTLSServer(const Value: TCustomTLSInternalServer);
-begin
-  TLSServer := Value;
-end;
-
-function TMyTLSSynSockSlave.GetMyTLSServer: TCustomTLSInternalServer;
-begin
-  Result := TLSServer;
-end;
-
-{==============================================================================}
-
-constructor TSSLStreamSec.Create(const Value: TTCPBlockSocket);
-begin
-  inherited Create(Value);
-  FSlave := nil;
-  FIsServer := False;
-  FTLSServer := nil;
-end;
-
-destructor TSSLStreamSec.Destroy;
-begin
-  DeInit;
-  inherited Destroy;
-end;
-
-function TSSLStreamSec.LibVersion: String;
-begin
-  Result := 'StreamSecII';
-end;
-
-function TSSLStreamSec.LibName: String;
-begin
-  Result := 'ssl_streamsec';
-end;
-
-function TSSLStreamSec.SSLCheck: Boolean;
-begin
-  Result := true;
-  FLastErrorDesc := '';
-  if not Assigned(FSlave) then
-    Exit;
-  FLastError := FSlave.ErrorCode;
-  if FLastError <> 0 then
-  begin
-    FLastErrorDesc := TlsConst.AlertMsg(FLastError);
-  end;
-end;
-
-procedure TSSLStreamSec.NotTrustEvent(Sender: TObject; Cert: TASN1Struct; var ExplicitTrust: Boolean);
-begin
-  ExplicitTrust := true;
-end;
-
-function TSSLStreamSec.Init(server:Boolean): Boolean;
-var
-  st: TMemoryStream;
-  pass: ISecretKey;
-  ws: WideString;
-begin
-  Result := False;
-  ws := FKeyPassword;
-  pass := TSecretKey.CreateBmpStr(PWideChar(ws), length(ws));
-  try
-    FIsServer := Server;
-    FSlave := TMyTLSSynSockSlave.CreateSocket(FSocket.Socket);
-    if Assigned(FTLSServer) then
-      FSlave.MyTLSServer := FTLSServer
-    else
-      if Assigned(TLSInternalServer.GlobalServer) then
-        FSlave.MyTLSServer := TLSInternalServer.GlobalServer
-      else begin
-        FSlave.MyTLSServer := TSimpleTLSInternalServer.Create(nil);
-        FServerCreated := True;
-      end;
-    if server then
-      FSlave.MyTLSServer.ClientOrServer := cosServerSide
-    else
-      FSlave.MyTLSServer.ClientOrServer := cosClientSide;
-    if not FVerifyCert then
-    begin
-      FSlave.MyTLSServer.OnCertNotTrusted := NotTrustEvent;
-    end;
-    FSlave.MyTLSServer.Options.VerifyServerName := [];
-    FSlave.MyTLSServer.Options.Export40Bit := prAllowed;
-    FSlave.MyTLSServer.Options.Export56Bit := prAllowed;
-    FSlave.MyTLSServer.Options.RequestClientCertificate := False;
-    FSlave.MyTLSServer.Options.RequireClientCertificate := False;
-    if server and FVerifyCert then
-    begin
-      FSlave.MyTLSServer.Options.RequestClientCertificate := True;
-      FSlave.MyTLSServer.Options.RequireClientCertificate := True;
-    end;
-    if FCertCAFile <> '' then
-      FSlave.MyTLSServer.LoadRootCertsFromFile(CertCAFile);
-    if FCertCA <> '' then
-    begin
-      st := TMemoryStream.Create;
-      try
-        WriteStrToStream(st, FCertCA);
-        st.Seek(0, soFromBeginning);
-        FSlave.MyTLSServer.LoadRootCertsFromStream(st);
-      finally
-        st.free;
-      end;
-    end;
-    if FTrustCertificateFile <> '' then
-      FSlave.MyTLSServer.LoadTrustedCertsFromFile(FTrustCertificateFile);
-    if FTrustCertificate <> '' then
-    begin
-      st := TMemoryStream.Create;
-      try
-        WriteStrToStream(st, FTrustCertificate);
-        st.Seek(0, soFromBeginning);
-        FSlave.MyTLSServer.LoadTrustedCertsFromStream(st);
-      finally
-        st.free;
-      end;
-    end;
-    if FPrivateKeyFile <> '' then
-      FSlave.MyTLSServer.LoadPrivateKeyRingFromFile(FPrivateKeyFile, pass);
-//      FSlave.MyTLSServer.PrivateKeyRing.LoadPrivateKeyFromFile(FPrivateKeyFile, pass);
-    if FPrivateKey <> '' then
-    begin
-      st := TMemoryStream.Create;
-      try
-        WriteStrToStream(st, FPrivateKey);
-        st.Seek(0, soFromBeginning);
-        FSlave.MyTLSServer.LoadPrivateKeyRingFromStream(st, pass);
-      finally
-        st.free;
-      end;
-    end;
-    if FCertificateFile <> '' then
-      FSlave.MyTLSServer.LoadMyCertsFromFile(FCertificateFile);
-    if FCertificate <> '' then
-    begin
-      st := TMemoryStream.Create;
-      try
-        WriteStrToStream(st, FCertificate);
-        st.Seek(0, soFromBeginning);
-        FSlave.MyTLSServer.LoadMyCertsFromStream(st);
-      finally
-        st.free;
-      end;
-    end;
-    if FPFXfile <> '' then
-      FSlave.MyTLSServer.ImportFromPFX(FPFXfile, pass);
-    if server and FServerCreated then
-    begin
-      FSlave.MyTLSServer.Options.BulkCipherAES128 := prPrefer;
-      FSlave.MyTLSServer.Options.BulkCipherAES256 := prAllowed;
-      FSlave.MyTLSServer.Options.EphemeralECDHKeySize := ecs256;
-      FSlave.MyTLSServer.Options.SignatureRSA := prPrefer;
-      FSlave.MyTLSServer.Options.KeyAgreementRSA := prAllowed;
-      FSlave.MyTLSServer.Options.KeyAgreementECDHE := prAllowed;
-      FSlave.MyTLSServer.Options.KeyAgreementDHE := prPrefer;
-      FSlave.MyTLSServer.TLSSetupServer;
-    end;
-    Result := true;
-  finally
-    pass := nil;
-  end;
-end;
-
-function TSSLStreamSec.DeInit: Boolean;
-var
-  obj: TObject;
-begin
-  Result := True;
-  if assigned(FSlave) then
-  begin
-    FSlave.Close;
-    if FServerCreated then
-      obj := FSlave.TLSServer
-    else
-      obj := nil;
-    FSlave.Free;
-    obj.Free;
-    FSlave := nil;
-  end;
-  FSSLEnabled := false;
-end;
-
-function TSSLStreamSec.Prepare(server:Boolean): Boolean;
-begin
-  Result := false;
-  DeInit;
-  if Init(server) then
-    Result := true
-  else
-    DeInit;
-end;
-
-function TSSLStreamSec.Connect: boolean;
-begin
-  Result := False;
-  if FSocket.Socket = INVALID_SOCKET then
-    Exit;
-  if Prepare(false) then
-  begin
-    FSlave.Open;
-    SSLCheck;
-    if FLastError <> 0 then
-      Exit;
-    FSSLEnabled := True;
-    Result := True;
-  end;
-end;
-
-function TSSLStreamSec.Accept: boolean;
-begin
-  Result := False;
-  if FSocket.Socket = INVALID_SOCKET then
-    Exit;
-  if Prepare(true) then
-  begin
-    FSlave.DoConnect;
-    SSLCheck;
-    if FLastError <> 0 then
-      Exit;
-    FSSLEnabled := True;
-    Result := True;
-  end;
-end;
-
-function TSSLStreamSec.Shutdown: boolean;
-begin
-  Result := BiShutdown;
-end;
-
-function TSSLStreamSec.BiShutdown: boolean;
-begin
-  DeInit;
-  Result := True;
-end;
-
-function TSSLStreamSec.SendBuffer(Buffer: TMemory; Len: Integer): Integer;
-var
-  l: integer;
-begin
-  l := len;
-  FSlave.SendBuf(Buffer^, l, true);
-  Result := l;
-  SSLCheck;
-end;
-
-function TSSLStreamSec.RecvBuffer(Buffer: TMemory; Len: Integer): Integer;
-var
-  l: integer;
-begin
-  l := Len;
-  Result := FSlave.ReceiveBuf(Buffer^, l);
-  SSLCheck;
-end;
-
-function TSSLStreamSec.WaitingData: Integer;
-begin
-  Result := 0;
-  while FSlave.Connected do begin
-    Result := FSlave.ReceiveLength;
-    if Result > 0 then
-      Break;
-    Sleep(1);
-  end;
-end;
-
-function TSSLStreamSec.GetSSLVersion: string;
-begin
-  Result := 'SSLv3 or TLSv1';
-end;
-
-function TSSLStreamSec.GetCert: PASN1Struct;
-begin
-  if FIsServer then
-    Result := FSlave.GetClientCert
-  else
-    Result := FSlave.GetServerCert;
-end;
-
-function TSSLStreamSec.GetPeerSubject: string;
-var
-  XName: TX501Name;
-  Cert: PASN1Struct;
-begin
-  Result := '';
-  Cert := GetCert;
-  if Assigned(cert) then
-  begin
-    ExtractSubject(Cert^,XName, false);
-    Result := X501NameToStr(XName);
-  end;
-end;
-
-function TSSLStreamSec.GetPeerName: string;
-var
-  XName: TX501Name;
-  Cert: PASN1Struct;
-begin
-  Result := '';
-  Cert := GetCert;
-  if Assigned(cert) then
-  begin
-    ExtractSubject(Cert^,XName, false);
-    Result := XName.commonName.Str;
-  end;
-end;
-
-function TSSLStreamSec.GetPeerIssuer: string;
-var
-  XName: TX501Name;
-  Cert: PASN1Struct;
-begin
-  Result := '';
-  Cert := GetCert;
-  if Assigned(cert) then
-  begin
-    ExtractIssuer(Cert^, XName, false);
-    Result := X501NameToStr(XName);
-  end;
-end;
-
-function TSSLStreamSec.GetPeerFingerprint: string;
-var
-  Cert: PASN1Struct;
-begin
-  Result := '';
-  Cert := GetCert;
-  if Assigned(cert) then
-    Result := MD5(Cert.ContentAsOctetString);
-end;
-
-function TSSLStreamSec.GetCertInfo: string;
-var
-  Cert: PASN1Struct;
-  l: Tstringlist;
-begin
-  Result := '';
-  Cert := GetCert;
-  if Assigned(cert) then
-  begin
-    l := TStringList.Create;
-    try
-      Asn1.RenderAsText(cert^, l, true, true, true, 2);
-      Result := l.Text;
-    finally
-      l.free;
-    end;
-  end;
-end;
-
-function TSSLStreamSec.X500StrToStr(const Prefix: string;
-  const Value: TX500String): string;
-begin
-  if Value.Str = '' then
-    Result := ''
-  else
-    Result := '/' + Prefix + '=' + Value.Str;
-end;
-
-function TSSLStreamSec.X501NameToStr(const Value: TX501Name): string;
-begin
-  Result := X500StrToStr('CN',Value.commonName) +
-           X500StrToStr('C',Value.countryName) +
-           X500StrToStr('L',Value.localityName) +
-           X500StrToStr('ST',Value.stateOrProvinceName) +
-           X500StrToStr('O',Value.organizationName) +
-           X500StrToStr('OU',Value.organizationalUnitName) +
-           X500StrToStr('T',Value.title) +
-           X500StrToStr('N',Value.name) +
-           X500StrToStr('G',Value.givenName) +
-           X500StrToStr('I',Value.initials) +
-           X500StrToStr('SN',Value.surname) +
-           X500StrToStr('GQ',Value.generationQualifier) +
-           X500StrToStr('DNQ',Value.dnQualifier) +
-           X500StrToStr('E',Value.emailAddress);
-end;
-
-
-{==============================================================================}
-
-initialization
-  SSLImplementation := TSSLStreamSec;
-
-finalization
-
-end.
-
-
+{==============================================================================|
+| Project : Ararat Synapse                                       | 001.000.006 |
+|==============================================================================|
+| Content: SSL support by StreamSecII                                          |
+|==============================================================================|
+| Copyright (c)1999-2005, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2005.                     |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|   Henrick Hellström <henrick@streamsec.se>                                   |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@abstract(SSL plugin for StreamSecII or OpenStreamSecII)
+
+StreamSecII is native pascal library, you not need any external libraries!
+
+You can tune lot of StreamSecII properties by using your GlobalServer. If you not
+using your GlobalServer, then this plugin create own TSimpleTLSInternalServer
+instance for each TCP connection. Formore information about GlobalServer usage
+refer StreamSecII documentation.
+
+If you are not using key and certificate by GlobalServer, then you can use
+properties of this plugin instead, but this have limited features and
+@link(TCustomSSL.KeyPassword) not working properly yet!
+
+For handling keys and certificates you can use this properties:
+@link(TCustomSSL.CertCAFile), @link(TCustomSSL.CertCA),
+@link(TCustomSSL.TrustCertificateFile), @link(TCustomSSL.TrustCertificate),
+@link(TCustomSSL.PrivateKeyFile), @link(TCustomSSL.PrivateKey),
+@link(TCustomSSL.CertificateFile), @link(TCustomSSL.Certificate),
+@link(TCustomSSL.PFXFile). For usage of this properties and for possible formats
+of keys and certificates refer to StreamSecII documentation.
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+unit ssl_streamsec;
+
+interface
+
+uses
+  SysUtils, Classes,
+  blcksock, synsock, synautil, synacode,
+  TlsInternalServer, TlsSynaSock, TlsConst, StreamSecII, Asn1, X509Base,
+  SecUtils;
+
+type
+  {:@exclude}
+  TMyTLSSynSockSlave = class(TTLSSynSockSlave)
+  protected
+    procedure SetMyTLSServer(const Value: TCustomTLSInternalServer);
+    function GetMyTLSServer: TCustomTLSInternalServer;
+  published
+    property MyTLSServer: TCustomTLSInternalServer read GetMyTLSServer write SetMyTLSServer;
+  end;
+
+  {:@abstract(class implementing StreamSecII SSL plugin.)
+   Instance of this class will be created for each @link(TTCPBlockSocket).
+   You not need to create instance of this class, all is done by Synapse itself!}
+  TSSLStreamSec = class(TCustomSSL)
+  protected
+    FSlave: TMyTLSSynSockSlave;
+    FIsServer: Boolean;
+    FTLSServer: TCustomTLSInternalServer;
+    FServerCreated: Boolean;
+    function SSLCheck: Boolean;
+    function Init(server:Boolean): Boolean;
+    function DeInit: Boolean;
+    function Prepare(server:Boolean): Boolean;
+    procedure NotTrustEvent(Sender: TObject; Cert: TASN1Struct; var ExplicitTrust: Boolean);
+    function X500StrToStr(const Prefix: string; const Value: TX500String): string;
+    function X501NameToStr(const Value: TX501Name): string;
+    function GetCert: PASN1Struct;
+  public
+    constructor Create(const Value: TTCPBlockSocket); override;
+    destructor Destroy; override;
+    {:See @inherited}
+    function LibVersion: String; override;
+    {:See @inherited}
+    function LibName: String; override;
+    {:See @inherited and @link(ssl_streamsec) for more details.}
+    function Connect: boolean; override;
+    {:See @inherited and @link(ssl_streamsec) for more details.}
+    function Accept: boolean; override;
+    {:See @inherited}
+    function Shutdown: boolean; override;
+    {:See @inherited}
+    function BiShutdown: boolean; override;
+    {:See @inherited}
+    function SendBuffer(Buffer: TMemory; Len: Integer): Integer; override;
+    {:See @inherited}
+    function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; override;
+    {:See @inherited}
+    function WaitingData: Integer; override;
+    {:See @inherited}
+    function GetSSLVersion: string; override;
+    {:See @inherited}
+    function GetPeerSubject: string; override;
+    {:See @inherited}
+    function GetPeerIssuer: string; override;
+    {:See @inherited}
+    function GetPeerName: string; override;
+    {:See @inherited}
+    function GetPeerFingerprint: string; override;
+    {:See @inherited}
+    function GetCertInfo: string; override;
+  published
+    {:TLS server for tuning of StreamSecII.}
+    property TLSServer: TCustomTLSInternalServer read FTLSServer write FTLSServer;
+  end;
+
+implementation
+
+{==============================================================================}
+procedure TMyTLSSynSockSlave.SetMyTLSServer(const Value: TCustomTLSInternalServer);
+begin
+  TLSServer := Value;
+end;
+
+function TMyTLSSynSockSlave.GetMyTLSServer: TCustomTLSInternalServer;
+begin
+  Result := TLSServer;
+end;
+
+{==============================================================================}
+
+constructor TSSLStreamSec.Create(const Value: TTCPBlockSocket);
+begin
+  inherited Create(Value);
+  FSlave := nil;
+  FIsServer := False;
+  FTLSServer := nil;
+end;
+
+destructor TSSLStreamSec.Destroy;
+begin
+  DeInit;
+  inherited Destroy;
+end;
+
+function TSSLStreamSec.LibVersion: String;
+begin
+  Result := 'StreamSecII';
+end;
+
+function TSSLStreamSec.LibName: String;
+begin
+  Result := 'ssl_streamsec';
+end;
+
+function TSSLStreamSec.SSLCheck: Boolean;
+begin
+  Result := true;
+  FLastErrorDesc := '';
+  if not Assigned(FSlave) then
+    Exit;
+  FLastError := FSlave.ErrorCode;
+  if FLastError <> 0 then
+  begin
+    FLastErrorDesc := TlsConst.AlertMsg(FLastError);
+  end;
+end;
+
+procedure TSSLStreamSec.NotTrustEvent(Sender: TObject; Cert: TASN1Struct; var ExplicitTrust: Boolean);
+begin
+  ExplicitTrust := true;
+end;
+
+function TSSLStreamSec.Init(server:Boolean): Boolean;
+var
+  st: TMemoryStream;
+  pass: ISecretKey;
+  ws: WideString;
+begin
+  Result := False;
+  ws := FKeyPassword;
+  pass := TSecretKey.CreateBmpStr(PWideChar(ws), length(ws));
+  try
+    FIsServer := Server;
+    FSlave := TMyTLSSynSockSlave.CreateSocket(FSocket.Socket);
+    if Assigned(FTLSServer) then
+      FSlave.MyTLSServer := FTLSServer
+    else
+      if Assigned(TLSInternalServer.GlobalServer) then
+        FSlave.MyTLSServer := TLSInternalServer.GlobalServer
+      else begin
+        FSlave.MyTLSServer := TSimpleTLSInternalServer.Create(nil);
+        FServerCreated := True;
+      end;
+    if server then
+      FSlave.MyTLSServer.ClientOrServer := cosServerSide
+    else
+      FSlave.MyTLSServer.ClientOrServer := cosClientSide;
+    if not FVerifyCert then
+    begin
+      FSlave.MyTLSServer.OnCertNotTrusted := NotTrustEvent;
+    end;
+    FSlave.MyTLSServer.Options.VerifyServerName := [];
+    FSlave.MyTLSServer.Options.Export40Bit := prAllowed;
+    FSlave.MyTLSServer.Options.Export56Bit := prAllowed;
+    FSlave.MyTLSServer.Options.RequestClientCertificate := False;
+    FSlave.MyTLSServer.Options.RequireClientCertificate := False;
+    if server and FVerifyCert then
+    begin
+      FSlave.MyTLSServer.Options.RequestClientCertificate := True;
+      FSlave.MyTLSServer.Options.RequireClientCertificate := True;
+    end;
+    if FCertCAFile <> '' then
+      FSlave.MyTLSServer.LoadRootCertsFromFile(CertCAFile);
+    if FCertCA <> '' then
+    begin
+      st := TMemoryStream.Create;
+      try
+        WriteStrToStream(st, FCertCA);
+        st.Seek(0, soFromBeginning);
+        FSlave.MyTLSServer.LoadRootCertsFromStream(st);
+      finally
+        st.free;
+      end;
+    end;
+    if FTrustCertificateFile <> '' then
+      FSlave.MyTLSServer.LoadTrustedCertsFromFile(FTrustCertificateFile);
+    if FTrustCertificate <> '' then
+    begin
+      st := TMemoryStream.Create;
+      try
+        WriteStrToStream(st, FTrustCertificate);
+        st.Seek(0, soFromBeginning);
+        FSlave.MyTLSServer.LoadTrustedCertsFromStream(st);
+      finally
+        st.free;
+      end;
+    end;
+    if FPrivateKeyFile <> '' then
+      FSlave.MyTLSServer.LoadPrivateKeyRingFromFile(FPrivateKeyFile, pass);
+//      FSlave.MyTLSServer.PrivateKeyRing.LoadPrivateKeyFromFile(FPrivateKeyFile, pass);
+    if FPrivateKey <> '' then
+    begin
+      st := TMemoryStream.Create;
+      try
+        WriteStrToStream(st, FPrivateKey);
+        st.Seek(0, soFromBeginning);
+        FSlave.MyTLSServer.LoadPrivateKeyRingFromStream(st, pass);
+      finally
+        st.free;
+      end;
+    end;
+    if FCertificateFile <> '' then
+      FSlave.MyTLSServer.LoadMyCertsFromFile(FCertificateFile);
+    if FCertificate <> '' then
+    begin
+      st := TMemoryStream.Create;
+      try
+        WriteStrToStream(st, FCertificate);
+        st.Seek(0, soFromBeginning);
+        FSlave.MyTLSServer.LoadMyCertsFromStream(st);
+      finally
+        st.free;
+      end;
+    end;
+    if FPFXfile <> '' then
+      FSlave.MyTLSServer.ImportFromPFX(FPFXfile, pass);
+    if server and FServerCreated then
+    begin
+      FSlave.MyTLSServer.Options.BulkCipherAES128 := prPrefer;
+      FSlave.MyTLSServer.Options.BulkCipherAES256 := prAllowed;
+      FSlave.MyTLSServer.Options.EphemeralECDHKeySize := ecs256;
+      FSlave.MyTLSServer.Options.SignatureRSA := prPrefer;
+      FSlave.MyTLSServer.Options.KeyAgreementRSA := prAllowed;
+      FSlave.MyTLSServer.Options.KeyAgreementECDHE := prAllowed;
+      FSlave.MyTLSServer.Options.KeyAgreementDHE := prPrefer;
+      FSlave.MyTLSServer.TLSSetupServer;
+    end;
+    Result := true;
+  finally
+    pass := nil;
+  end;
+end;
+
+function TSSLStreamSec.DeInit: Boolean;
+var
+  obj: TObject;
+begin
+  Result := True;
+  if assigned(FSlave) then
+  begin
+    FSlave.Close;
+    if FServerCreated then
+      obj := FSlave.TLSServer
+    else
+      obj := nil;
+    FSlave.Free;
+    obj.Free;
+    FSlave := nil;
+  end;
+  FSSLEnabled := false;
+end;
+
+function TSSLStreamSec.Prepare(server:Boolean): Boolean;
+begin
+  Result := false;
+  DeInit;
+  if Init(server) then
+    Result := true
+  else
+    DeInit;
+end;
+
+function TSSLStreamSec.Connect: boolean;
+begin
+  Result := False;
+  if FSocket.Socket = INVALID_SOCKET then
+    Exit;
+  if Prepare(false) then
+  begin
+    FSlave.Open;
+    SSLCheck;
+    if FLastError <> 0 then
+      Exit;
+    FSSLEnabled := True;
+    Result := True;
+  end;
+end;
+
+function TSSLStreamSec.Accept: boolean;
+begin
+  Result := False;
+  if FSocket.Socket = INVALID_SOCKET then
+    Exit;
+  if Prepare(true) then
+  begin
+    FSlave.DoConnect;
+    SSLCheck;
+    if FLastError <> 0 then
+      Exit;
+    FSSLEnabled := True;
+    Result := True;
+  end;
+end;
+
+function TSSLStreamSec.Shutdown: boolean;
+begin
+  Result := BiShutdown;
+end;
+
+function TSSLStreamSec.BiShutdown: boolean;
+begin
+  DeInit;
+  Result := True;
+end;
+
+function TSSLStreamSec.SendBuffer(Buffer: TMemory; Len: Integer): Integer;
+var
+  l: integer;
+begin
+  l := len;
+  FSlave.SendBuf(Buffer^, l, true);
+  Result := l;
+  SSLCheck;
+end;
+
+function TSSLStreamSec.RecvBuffer(Buffer: TMemory; Len: Integer): Integer;
+var
+  l: integer;
+begin
+  l := Len;
+  Result := FSlave.ReceiveBuf(Buffer^, l);
+  SSLCheck;
+end;
+
+function TSSLStreamSec.WaitingData: Integer;
+begin
+  Result := 0;
+  while FSlave.Connected do begin
+    Result := FSlave.ReceiveLength;
+    if Result > 0 then
+      Break;
+    Sleep(1);
+  end;
+end;
+
+function TSSLStreamSec.GetSSLVersion: string;
+begin
+  Result := 'SSLv3 or TLSv1';
+end;
+
+function TSSLStreamSec.GetCert: PASN1Struct;
+begin
+  if FIsServer then
+    Result := FSlave.GetClientCert
+  else
+    Result := FSlave.GetServerCert;
+end;
+
+function TSSLStreamSec.GetPeerSubject: string;
+var
+  XName: TX501Name;
+  Cert: PASN1Struct;
+begin
+  Result := '';
+  Cert := GetCert;
+  if Assigned(cert) then
+  begin
+    ExtractSubject(Cert^,XName, false);
+    Result := X501NameToStr(XName);
+  end;
+end;
+
+function TSSLStreamSec.GetPeerName: string;
+var
+  XName: TX501Name;
+  Cert: PASN1Struct;
+begin
+  Result := '';
+  Cert := GetCert;
+  if Assigned(cert) then
+  begin
+    ExtractSubject(Cert^,XName, false);
+    Result := XName.commonName.Str;
+  end;
+end;
+
+function TSSLStreamSec.GetPeerIssuer: string;
+var
+  XName: TX501Name;
+  Cert: PASN1Struct;
+begin
+  Result := '';
+  Cert := GetCert;
+  if Assigned(cert) then
+  begin
+    ExtractIssuer(Cert^, XName, false);
+    Result := X501NameToStr(XName);
+  end;
+end;
+
+function TSSLStreamSec.GetPeerFingerprint: string;
+var
+  Cert: PASN1Struct;
+begin
+  Result := '';
+  Cert := GetCert;
+  if Assigned(cert) then
+    Result := MD5(Cert.ContentAsOctetString);
+end;
+
+function TSSLStreamSec.GetCertInfo: string;
+var
+  Cert: PASN1Struct;
+  l: Tstringlist;
+begin
+  Result := '';
+  Cert := GetCert;
+  if Assigned(cert) then
+  begin
+    l := TStringList.Create;
+    try
+      Asn1.RenderAsText(cert^, l, true, true, true, 2);
+      Result := l.Text;
+    finally
+      l.free;
+    end;
+  end;
+end;
+
+function TSSLStreamSec.X500StrToStr(const Prefix: string;
+  const Value: TX500String): string;
+begin
+  if Value.Str = '' then
+    Result := ''
+  else
+    Result := '/' + Prefix + '=' + Value.Str;
+end;
+
+function TSSLStreamSec.X501NameToStr(const Value: TX501Name): string;
+begin
+  Result := X500StrToStr('CN',Value.commonName) +
+           X500StrToStr('C',Value.countryName) +
+           X500StrToStr('L',Value.localityName) +
+           X500StrToStr('ST',Value.stateOrProvinceName) +
+           X500StrToStr('O',Value.organizationName) +
+           X500StrToStr('OU',Value.organizationalUnitName) +
+           X500StrToStr('T',Value.title) +
+           X500StrToStr('N',Value.name) +
+           X500StrToStr('G',Value.givenName) +
+           X500StrToStr('I',Value.initials) +
+           X500StrToStr('SN',Value.surname) +
+           X500StrToStr('GQ',Value.generationQualifier) +
+           X500StrToStr('DNQ',Value.dnQualifier) +
+           X500StrToStr('E',Value.emailAddress);
+end;
+
+
+{==============================================================================}
+
+initialization
+  SSLImplementation := TSSLStreamSec;
+
+finalization
+
+end.
+
+
diff --git a/Units/Synapse/sslinux.pas b/Units/Synapse/sslinux.pas
index 2a23146..f3dd5ca 100644
--- a/Units/Synapse/sslinux.pas
+++ b/Units/Synapse/sslinux.pas
@@ -1,1314 +1,1314 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 002.000.009 |
-|==============================================================================|
-| Content: Socket Independent Platform Layer - Linux definition include        |
-|==============================================================================|
-| Copyright (c)1999-2010, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2003-2010.                |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{:@exclude}
-
-{$IFDEF LINUX}
-
-//{$DEFINE FORCEOLDAPI}
-{Note about define FORCEOLDAPI:
-If you activate this compiler directive, then is allways used old socket API
-for name resolution. If you leave this directive inactive, then the new API
-is used, when running system allows it.
-
-For IPv6 support you must have new API!
-}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$H+}
-interface
-
-uses
-  SyncObjs, SysUtils, Classes,
-  synafpc,
-  Libc;
-
-function InitSocketInterface(stack: string): Boolean;
-function DestroySocketInterface: Boolean;
-
-const
-  WinsockLevel = $0202;
-
-type
-  u_char = Char;
-  u_short = Word;
-  u_int = Integer;
-  u_long = Longint;
-  pu_long = ^u_long;
-  pu_short = ^u_short;
-  TSocket = u_int;
-  TAddrFamily = integer;
-
-  TMemory = pointer;
-
-
-const
-  DLLStackName = 'libc.so.6';
-
-  cLocalhost = '127.0.0.1';
-  cAnyHost = '0.0.0.0';
-  cBroadcast = '255.255.255.255';
-  c6Localhost = '::1';
-  c6AnyHost = '::0';
-  c6Broadcast = 'ffff::1';
-  cAnyPort = '0';
-
-type
-  DWORD = Integer;
-  __fd_mask = LongWord;
-const
-  __FD_SETSIZE    = 1024;
-  __NFDBITS       = 8 * sizeof(__fd_mask);
-type
-  __fd_set = {packed} record
-    fds_bits: packed array[0..(__FD_SETSIZE div __NFDBITS)-1] of __fd_mask;
-  end;
-  TFDSet = __fd_set;
-  PFDSet = ^TFDSet;
-
-const
-  FIONREAD        = $541B;
-  FIONBIO         = $5421;
-  FIOASYNC        = $5452;
-
-type
-  PTimeVal = ^TTimeVal;
-  TTimeVal = packed record
-    tv_sec: Longint;
-    tv_usec: Longint;
-  end;
-
-const
-  IPPROTO_IP     =   0;		{ Dummy					}
-  IPPROTO_ICMP   =   1;		{ Internet Control Message Protocol }
-  IPPROTO_IGMP   =   2;		{ Internet Group Management Protocol}
-  IPPROTO_TCP    =   6;		{ TCP           			}
-  IPPROTO_UDP    =   17;	{ User Datagram Protocol		}
-  IPPROTO_IPV6   =   41;
-  IPPROTO_ICMPV6 =   58;
-  IPPROTO_RM     =  113;
-
-  IPPROTO_RAW    =   255;
-  IPPROTO_MAX    =   256;
-
-type
-  PInAddr = ^TInAddr;
-  TInAddr = packed record
-    case integer of
-      0: (S_bytes: packed array [0..3] of byte);
-      1: (S_addr: u_long);
-  end;
-
-  PSockAddrIn = ^TSockAddrIn;
-  TSockAddrIn = packed record
-    case Integer of
-      0: (sin_family: u_short;
-          sin_port: u_short;
-          sin_addr: TInAddr;
-          sin_zero: array[0..7] of Char);
-      1: (sa_family: u_short;
-          sa_data: array[0..13] of Char)
-  end;
-
-  TIP_mreq =  record
-    imr_multiaddr: TInAddr;     { IP multicast address of group }
-    imr_interface: TInAddr;     { local IP address of interface }
-  end;
-
-  PInAddr6 = ^TInAddr6;
-  TInAddr6 = packed record
-    case integer of
-      0: (S6_addr: packed array [0..15] of byte);
-      1: (u6_addr8: packed array [0..15] of byte);
-      2: (u6_addr16: packed array [0..7] of word);
-      3: (u6_addr32: packed array [0..3] of integer);
-  end;
-
-  PSockAddrIn6 = ^TSockAddrIn6;
-  TSockAddrIn6 = packed record
-		sin6_family:   u_short;     // AF_INET6
-		sin6_port:     u_short;     // Transport level port number
-		sin6_flowinfo: u_long;	    // IPv6 flow information
-		sin6_addr:     TInAddr6;    // IPv6 address
-		sin6_scope_id: u_long;      // Scope Id: IF number for link-local
-                                //           SITE id for site-local
-  end;
-
-  TIPv6_mreq = record
-    ipv6mr_multiaddr: TInAddr6; // IPv6 multicast address.
-    ipv6mr_interface: integer;   // Interface index.
-    padding: u_long;
-  end;
-
-  PHostEnt = ^THostEnt;
-  THostent = record
-    h_name: PChar;
-    h_aliases: PPChar;
-    h_addrtype: Integer;
-    h_length: Cardinal;
-    case Byte of
-      0: (h_addr_list: PPChar);
-      1: (h_addr: PPChar);
-  end;
-
-  PNetEnt = ^TNetEnt;
-  TNetEnt = record
-    n_name: PChar;
-    n_aliases: PPChar;
-    n_addrtype: Integer;
-    n_net: uint32_t;
-  end;
-
-  PServEnt = ^TServEnt;
-  TServEnt = record
-    s_name: PChar;
-    s_aliases: PPChar;
-    s_port: Integer;
-    s_proto: PChar;
-  end;
-
-  PProtoEnt = ^TProtoEnt;
-  TProtoEnt = record
-    p_name: PChar;
-    p_aliases: ^PChar;
-    p_proto: u_short;
-  end;
-
-const
-  INADDR_ANY       = $00000000;
-  INADDR_LOOPBACK  = $7F000001;
-  INADDR_BROADCAST = $FFFFFFFF;
-  INADDR_NONE      = $FFFFFFFF;
-  ADDR_ANY		 = INADDR_ANY;
-  INVALID_SOCKET		= TSocket(NOT(0));
-  SOCKET_ERROR			= -1;
-
-Const
-  IP_TOS             = 1;  { int; IP type of service and precedence.  }
-  IP_TTL             = 2;  { int; IP time to live.  }
-  IP_HDRINCL         = 3;  { int; Header is included with data.  }
-  IP_OPTIONS         = 4;  { ip_opts; IP per-packet options.  }
-  IP_ROUTER_ALERT    = 5;  { bool }
-  IP_RECVOPTS        = 6;  { bool }
-  IP_RETOPTS         = 7;  { bool }
-  IP_PKTINFO         = 8;  { bool }
-  IP_PKTOPTIONS      = 9;
-  IP_PMTUDISC        = 10; { obsolete name? }
-  IP_MTU_DISCOVER    = 10; { int; see below }
-  IP_RECVERR         = 11; { bool }
-  IP_RECVTTL         = 12; { bool }
-  IP_RECVTOS         = 13; { bool }
-  IP_MULTICAST_IF    = 32; { in_addr; set/get IP multicast i/f }
-  IP_MULTICAST_TTL   = 33; { u_char; set/get IP multicast ttl }
-  IP_MULTICAST_LOOP  = 34; { i_char; set/get IP multicast loopback }
-  IP_ADD_MEMBERSHIP  = 35; { ip_mreq; add an IP group membership }
-  IP_DROP_MEMBERSHIP = 36; { ip_mreq; drop an IP group membership }
-
-  SOL_SOCKET    = 1;
-
-  SO_DEBUG      = 1;
-  SO_REUSEADDR  = 2;
-  SO_TYPE       = 3;
-  SO_ERROR      = 4;
-  SO_DONTROUTE  = 5;
-  SO_BROADCAST  = 6;
-  SO_SNDBUF     = 7;
-  SO_RCVBUF     = 8;
-  SO_KEEPALIVE  = 9;
-  SO_OOBINLINE  = 10;
-  SO_NO_CHECK   = 11;
-  SO_PRIORITY   = 12;
-  SO_LINGER     = 13;
-  SO_BSDCOMPAT  = 14;
-  SO_REUSEPORT  = 15;
-  SO_PASSCRED   = 16;
-  SO_PEERCRED   = 17;
-  SO_RCVLOWAT   = 18;
-  SO_SNDLOWAT   = 19;
-  SO_RCVTIMEO   = 20;
-  SO_SNDTIMEO   = 21;
-{ Security levels - as per NRL IPv6 - don't actually do anything }
-  SO_SECURITY_AUTHENTICATION       = 22;
-  SO_SECURITY_ENCRYPTION_TRANSPORT = 23;
-  SO_SECURITY_ENCRYPTION_NETWORK   = 24;
-  SO_BINDTODEVICE                  = 25;
-{ Socket filtering }
-  SO_ATTACH_FILTER = 26;
-  SO_DETACH_FILTER = 27;
-
-  SOMAXCONN       = 128;
-
-  IPV6_UNICAST_HOPS     = 16;
-  IPV6_MULTICAST_IF     = 17;
-  IPV6_MULTICAST_HOPS   = 18;
-  IPV6_MULTICAST_LOOP   = 19;
-  IPV6_JOIN_GROUP       = 20;
-  IPV6_LEAVE_GROUP      = 21;
-
-  MSG_NOSIGNAL  = $4000;                // Do not generate SIGPIPE.
-
-  // getnameinfo constants
-  NI_MAXHOST	   = 1025;
-  NI_MAXSERV	   = 32;
-  NI_NOFQDN 	   = $4;
-  NI_NUMERICHOST = $1;
-  NI_NAMEREQD	   = $8;
-  NI_NUMERICSERV = $2;
-  NI_DGRAM       = $10;
-
-const
-  SOCK_STREAM     = 1;               { stream socket }
-  SOCK_DGRAM      = 2;               { datagram socket }
-  SOCK_RAW        = 3;               { raw-protocol interface }
-  SOCK_RDM        = 4;               { reliably-delivered message }
-  SOCK_SEQPACKET  = 5;               { sequenced packet stream }
-
-{ TCP options. }
-  TCP_NODELAY     = $0001;
-
-{ Address families. }
-
-  AF_UNSPEC       = 0;               { unspecified }
-  AF_INET         = 2;               { internetwork: UDP, TCP, etc. }
-  AF_INET6        = 10;              { Internetwork Version 6 }
-  AF_MAX          = 24;
-
-{ Protocol families, same as address families for now. }
-  PF_UNSPEC       = AF_UNSPEC;
-  PF_INET         = AF_INET;
-  PF_INET6        = AF_INET6;
-  PF_MAX          = AF_MAX;
-
-type
-  { Structure used by kernel to store most addresses. }
-  PSockAddr = ^TSockAddr;
-  TSockAddr = TSockAddrIn;
-
-  { Structure used by kernel to pass protocol information in raw sockets. }
-  PSockProto = ^TSockProto;
-  TSockProto = packed record
-    sp_family: u_short;
-    sp_protocol: u_short;
-  end;
-
-type
-  PAddrInfo = ^TAddrInfo;
-  TAddrInfo = record
-                ai_flags: integer;    // AI_PASSIVE, AI_CANONNAME, AI_NUMERICHOST.
-                ai_family: integer;   // PF_xxx.
-                ai_socktype: integer; // SOCK_xxx.
-                ai_protocol: integer; // 0 or IPPROTO_xxx for IPv4 and IPv6.
-                ai_addrlen: u_int;    // Length of ai_addr.
-                ai_addr: PSockAddr;   // Binary address.
-                ai_canonname: PChar;  // Canonical name for nodename.
-                ai_next: PAddrInfo;     // Next structure in linked list.
-              end;
-
-const
-  // Flags used in "hints" argument to getaddrinfo().
-  AI_PASSIVE     = $1;  // Socket address will be used in bind() call.
-  AI_CANONNAME   = $2;  // Return canonical name in first ai_canonname.
-  AI_NUMERICHOST = $4;  // Nodename must be a numeric address string.
-
-type
-{ Structure used for manipulating linger option. }
-  PLinger = ^TLinger;
-  TLinger = packed record
-    l_onoff: integer;
-    l_linger: integer;
-  end;
-
-const
-
-  MSG_OOB       = $01;                  // Process out-of-band data.
-  MSG_PEEK      = $02;                  // Peek at incoming messages.
-
-const
-  WSAEINTR = EINTR;
-  WSAEBADF = EBADF;
-  WSAEACCES = EACCES;
-  WSAEFAULT = EFAULT;
-  WSAEINVAL = EINVAL;
-  WSAEMFILE = EMFILE;
-  WSAEWOULDBLOCK = EWOULDBLOCK;
-  WSAEINPROGRESS = EINPROGRESS;
-  WSAEALREADY = EALREADY;
-  WSAENOTSOCK = ENOTSOCK;
-  WSAEDESTADDRREQ = EDESTADDRREQ;
-  WSAEMSGSIZE = EMSGSIZE;
-  WSAEPROTOTYPE = EPROTOTYPE;
-  WSAENOPROTOOPT = ENOPROTOOPT;
-  WSAEPROTONOSUPPORT = EPROTONOSUPPORT;
-  WSAESOCKTNOSUPPORT = ESOCKTNOSUPPORT;
-  WSAEOPNOTSUPP = EOPNOTSUPP;
-  WSAEPFNOSUPPORT = EPFNOSUPPORT;
-  WSAEAFNOSUPPORT = EAFNOSUPPORT;
-  WSAEADDRINUSE = EADDRINUSE;
-  WSAEADDRNOTAVAIL = EADDRNOTAVAIL;
-  WSAENETDOWN = ENETDOWN;
-  WSAENETUNREACH = ENETUNREACH;
-  WSAENETRESET = ENETRESET;
-  WSAECONNABORTED = ECONNABORTED;
-  WSAECONNRESET = ECONNRESET;
-  WSAENOBUFS = ENOBUFS;
-  WSAEISCONN = EISCONN;
-  WSAENOTCONN = ENOTCONN;
-  WSAESHUTDOWN = ESHUTDOWN;
-  WSAETOOMANYREFS = ETOOMANYREFS;
-  WSAETIMEDOUT = ETIMEDOUT;
-  WSAECONNREFUSED = ECONNREFUSED;
-  WSAELOOP = ELOOP;
-  WSAENAMETOOLONG = ENAMETOOLONG;
-  WSAEHOSTDOWN = EHOSTDOWN;
-  WSAEHOSTUNREACH = EHOSTUNREACH;
-  WSAENOTEMPTY = ENOTEMPTY;
-  WSAEPROCLIM = -1;
-  WSAEUSERS = EUSERS;
-  WSAEDQUOT = EDQUOT;
-  WSAESTALE = ESTALE;
-  WSAEREMOTE = EREMOTE;
-  WSASYSNOTREADY = -2;
-  WSAVERNOTSUPPORTED = -3;
-  WSANOTINITIALISED = -4;
-  WSAEDISCON = -5;
-  WSAHOST_NOT_FOUND = HOST_NOT_FOUND;
-  WSATRY_AGAIN = TRY_AGAIN;
-  WSANO_RECOVERY = NO_RECOVERY;
-  WSANO_DATA = -6;
-
-  EAI_BADFLAGS    = -1;   { Invalid value for `ai_flags' field.  }
-  EAI_NONAME      = -2;   { NAME or SERVICE is unknown.  }
-  EAI_AGAIN       = -3;   { Temporary failure in name resolution.  }
-  EAI_FAIL        = -4;   { Non-recoverable failure in name res.  }
-  EAI_NODATA      = -5;   { No address associated with NAME.  }
-  EAI_FAMILY      = -6;   { `ai_family' not supported.  }
-  EAI_SOCKTYPE    = -7;   { `ai_socktype' not supported.  }
-  EAI_SERVICE     = -8;   { SERVICE not supported for `ai_socktype'.  }
-  EAI_ADDRFAMILY  = -9;   { Address family for NAME not supported.  }
-  EAI_MEMORY      = -10;  { Memory allocation failure.  }
-  EAI_SYSTEM      = -11;  { System error returned in `errno'.  }
-
-const
-  WSADESCRIPTION_LEN     =   256;
-  WSASYS_STATUS_LEN      =   128;
-type
-  PWSAData = ^TWSAData;
-  TWSAData = packed record
-    wVersion: Word;
-    wHighVersion: Word;
-    szDescription: array[0..WSADESCRIPTION_LEN] of Char;
-    szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char;
-    iMaxSockets: Word;
-    iMaxUdpDg: Word;
-    lpVendorInfo: PChar;
-  end;
-
-  function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
-  function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
-  function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
-  function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
-  function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
-  function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6):boolean;
-  procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
-  procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
-var
-  in6addr_any, in6addr_loopback : TInAddr6;
-
-procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet);
-function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean;
-procedure FD_SET(Socket: TSocket; var FDSet: TFDSet);
-procedure FD_ZERO(var FDSet: TFDSet);
-
-{=============================================================================}
-
-type
-  TWSAStartup = function(wVersionRequired: Word; var WSData: TWSAData): Integer;
-    cdecl;
-  TWSACleanup = function: Integer;
-    cdecl;
-  TWSAGetLastError = function: Integer;
-    cdecl;
-  TGetServByName = function(name, proto: PChar): PServEnt;
-    cdecl;
-  TGetServByPort = function(port: Integer; proto: PChar): PServEnt;
-    cdecl;
-  TGetProtoByName = function(name: PChar): PProtoEnt;
-    cdecl;
-  TGetProtoByNumber = function(proto: Integer): PProtoEnt;
-    cdecl;
-  TGetHostByName = function(name: PChar): PHostEnt;
-    cdecl;
-  TGetHostByAddr = function(addr: Pointer; len, Struc: Integer): PHostEnt;
-    cdecl;
-  TGetHostName = function(name: PChar; len: Integer): Integer;
-    cdecl;
-  TShutdown = function(s: TSocket; how: Integer): Integer;
-    cdecl;
-  TSetSockOpt = function(s: TSocket; level, optname: Integer; optval: PChar;
-    optlen: Integer): Integer;
-    cdecl;
-  TGetSockOpt = function(s: TSocket; level, optname: Integer; optval: PChar;
-    var optlen: Integer): Integer;
-    cdecl;
-  TSendTo = function(s: TSocket; const Buf; len, flags: Integer; addrto: PSockAddr;
-    tolen: Integer): Integer;
-    cdecl;
-  TSend = function(s: TSocket; const Buf; len, flags: Integer): Integer;
-    cdecl;
-  TRecv = function(s: TSocket; var Buf; len, flags: Integer): Integer;
-    cdecl;
-  TRecvFrom = function(s: TSocket; var Buf; len, flags: Integer; from: PSockAddr;
-    var fromlen: Integer): Integer;
-    cdecl;
-  Tntohs = function(netshort: u_short): u_short;
-    cdecl;
-  Tntohl = function(netlong: u_long): u_long;
-    cdecl;
-  TListen = function(s: TSocket; backlog: Integer): Integer;
-    cdecl;
-  TIoctlSocket = function(s: TSocket; cmd: DWORD; var arg: integer): Integer;
-    cdecl;
-  TInet_ntoa = function(inaddr: TInAddr): PChar;
-    cdecl;
-  TInet_addr = function(cp: PChar): u_long;
-    cdecl;
-  Thtons = function(hostshort: u_short): u_short;
-    cdecl;
-  Thtonl = function(hostlong: u_long): u_long;
-    cdecl;
-  TGetSockName = function(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
-    cdecl;
-  TGetPeerName = function(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
-    cdecl;
-  TConnect = function(s: TSocket; name: PSockAddr; namelen: Integer): Integer;
-    cdecl;
-  TCloseSocket = function(s: TSocket): Integer;
-    cdecl;
-  TBind = function(s: TSocket; addr: PSockAddr; namelen: Integer): Integer;
-    cdecl;
-  TAccept = function(s: TSocket; addr: PSockAddr; var addrlen: Integer): TSocket;
-    cdecl;
-  TTSocket = function(af, Struc, Protocol: Integer): TSocket;
-    cdecl;
-  TSelect = function(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
-    timeout: PTimeVal): Longint;
-    cdecl;
-
-  TGetAddrInfo = function(NodeName: PChar; ServName: PChar; Hints: PAddrInfo;
-    var Addrinfo: PAddrInfo): integer;
-    cdecl;
-  TFreeAddrInfo = procedure(ai: PAddrInfo);
-    cdecl;
-  TGetNameInfo = function( addr: PSockAddr; namelen: Integer; host: PChar;
-    hostlen: DWORD; serv: PChar; servlen: DWORD; flags: integer): integer;
-    cdecl;
-
-var
-  WSAStartup: TWSAStartup = nil;
-  WSACleanup: TWSACleanup = nil;
-  WSAGetLastError: TWSAGetLastError = nil;
-  GetServByName: TGetServByName = nil;
-  GetServByPort: TGetServByPort = nil;
-  GetProtoByName: TGetProtoByName = nil;
-  GetProtoByNumber: TGetProtoByNumber = nil;
-  GetHostByName: TGetHostByName = nil;
-  GetHostByAddr: TGetHostByAddr = nil;
-  ssGetHostName: TGetHostName = nil;
-  Shutdown: TShutdown = nil;
-  SetSockOpt: TSetSockOpt = nil;
-  GetSockOpt: TGetSockOpt = nil;
-  ssSendTo: TSendTo = nil;
-  ssSend: TSend = nil;
-  ssRecv: TRecv = nil;
-  ssRecvFrom: TRecvFrom = nil;
-  ntohs: Tntohs = nil;
-  ntohl: Tntohl = nil;
-  Listen: TListen = nil;
-  IoctlSocket: TIoctlSocket = nil;
-  Inet_ntoa: TInet_ntoa = nil;
-  Inet_addr: TInet_addr = nil;
-  htons: Thtons = nil;
-  htonl: Thtonl = nil;
-  ssGetSockName: TGetSockName = nil;
-  ssGetPeerName: TGetPeerName = nil;
-  ssConnect: TConnect = nil;
-  CloseSocket: TCloseSocket = nil;
-  ssBind: TBind = nil;
-  ssAccept: TAccept = nil;
-  Socket: TTSocket = nil;
-  Select: TSelect = nil;
-
-  GetAddrInfo: TGetAddrInfo = nil;
-  FreeAddrInfo: TFreeAddrInfo = nil;
-  GetNameInfo: TGetNameInfo = nil;
-
-function LSWSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer; cdecl;
-function LSWSACleanup: Integer; cdecl;
-function LSWSAGetLastError: Integer; cdecl;
-
-var
-  SynSockCS: SyncObjs.TCriticalSection;
-  SockEnhancedApi: Boolean;
-  SockWship6Api: Boolean;
-
-type
-  TVarSin = packed record
-    case integer of
-      0: (AddressFamily: u_short);
-      1: (
-        case sin_family: u_short of
-          AF_INET: (sin_port: u_short;
-                    sin_addr: TInAddr;
-                    sin_zero: array[0..7] of Char);
-          AF_INET6: (sin6_port:     u_short;
-                		sin6_flowinfo: u_long;
-      	    	      sin6_addr:     TInAddr6;
-      		          sin6_scope_id: u_long);
-          );
-  end;
-
-function SizeOfVarSin(sin: TVarSin): integer;
-
-function Bind(s: TSocket; const addr: TVarSin): Integer;
-function Connect(s: TSocket; const name: TVarSin): Integer;
-function GetSockName(s: TSocket; var name: TVarSin): Integer;
-function GetPeerName(s: TSocket; var name: TVarSin): Integer;
-function GetHostName: string;
-function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
-function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
-function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
-function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
-function Accept(s: TSocket; var addr: TVarSin): TSocket;
-
-function IsNewApi(Family: integer): Boolean;
-function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
-function GetSinIP(Sin: TVarSin): string;
-function GetSinPort(Sin: TVarSin): Integer;
-procedure ResolveNameToIP(Name: string;  Family, SockProtocol, SockType: integer; const IPList: TStrings);
-function ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): string;
-function ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word;
-
-{==============================================================================}
-implementation
-
-var
-  SynSockCount: Integer = 0;
-  LibHandle: TLibHandle = 0;
-  Libwship6Handle: TLibHandle = 0;
-
-function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
-begin
-  Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
-             (a^.u6_addr32[2] = 0) and (a^.u6_addr32[3] = 0));
-end;
-
-function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
-begin
-  Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
-             (a^.u6_addr32[2] = 0) and
-             (a^.u6_addr8[12] = 0) and (a^.u6_addr8[13] = 0) and
-             (a^.u6_addr8[14] = 0) and (a^.u6_addr8[15] = 1));
-end;
-
-function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
-begin
-  Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $80));
-end;
-
-function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
-begin
-  Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $C0));
-end;
-
-function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
-begin
-  Result := (a^.u6_addr8[0] = $FF);
-end;
-
-function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6): boolean;
-begin
-  Result := (CompareMem( a, b, sizeof(TInAddr6)));
-end;
-
-procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
-begin
-  FillChar(a^, sizeof(TInAddr6), 0);
-end;
-
-procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
-begin
-  FillChar(a^, sizeof(TInAddr6), 0);
-  a^.u6_addr8[15] := 1;
-end;
-
-{=============================================================================}
-var
-{$IFNDEF VER1_0}  //FTP version 1.0.x
-  errno_loc: function: PInteger cdecl = nil;
-{$ELSE}
-  errno_loc: function: PInteger = nil; cdecl;
-{$ENDIF}
-
-function LSWSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer;
-begin
-  with WSData do
-  begin
-    wVersion := wVersionRequired;
-    wHighVersion := $202;
-    szDescription := 'Synsock - Synapse Platform Independent Socket Layer';
-    szSystemStatus := 'Running on Linux';
-    iMaxSockets := 32768;
-    iMaxUdpDg := 8192;
-  end;
-  Result := 0;
-end;
-
-function LSWSACleanup: Integer;
-begin
-  Result := 0;
-end;
-
-function LSWSAGetLastError: Integer;
-var
-  p: PInteger;
-begin
-  p := errno_loc;
-  Result := p^;
-end;
-
-function __FDELT(Socket: TSocket): Integer;
-begin
-  Result := Socket div __NFDBITS;
-end;
-
-function __FDMASK(Socket: TSocket): __fd_mask;
-begin
-  Result := LongWord(1) shl (Socket mod __NFDBITS);
-end;
-
-function FD_ISSET(Socket: TSocket; var fdset: TFDSet): Boolean;
-begin
-  Result := (fdset.fds_bits[__FDELT(Socket)] and __FDMASK(Socket)) <> 0;
-end;
-
-procedure FD_SET(Socket: TSocket; var fdset: TFDSet);
-begin
-  fdset.fds_bits[__FDELT(Socket)] := fdset.fds_bits[__FDELT(Socket)] or __FDMASK(Socket);
-end;
-
-procedure FD_CLR(Socket: TSocket; var fdset: TFDSet);
-begin
-  fdset.fds_bits[__FDELT(Socket)] := fdset.fds_bits[__FDELT(Socket)] and (not __FDMASK(Socket));
-end;
-
-procedure FD_ZERO(var fdset: TFDSet);
-var
-  I: Integer;
-begin
-  with fdset do
-    for I := Low(fds_bits) to High(fds_bits) do
-      fds_bits[I] := 0;
-end;
-
-{=============================================================================}
-
-function SizeOfVarSin(sin: TVarSin): integer;
-begin
-  case sin.sin_family of
-    AF_INET:
-            Result := SizeOf(TSockAddrIn);
-    AF_INET6:
-            Result := SizeOf(TSockAddrIn6);
-  else
-    Result := 0;
-  end;
-end;
-
-{=============================================================================}
-
-function Bind(s: TSocket; const addr: TVarSin): Integer;
-begin
-  Result := ssBind(s, @addr, SizeOfVarSin(addr));
-end;
-
-function Connect(s: TSocket; const name: TVarSin): Integer;
-begin
-  Result := ssConnect(s, @name, SizeOfVarSin(name));
-end;
-
-function GetSockName(s: TSocket; var name: TVarSin): Integer;
-var
-  len: integer;
-begin
-  len := SizeOf(name);
-  FillChar(name, len, 0);
-  Result := ssGetSockName(s, @name, Len);
-end;
-
-function GetPeerName(s: TSocket; var name: TVarSin): Integer;
-var
-  len: integer;
-begin
-  len := SizeOf(name);
-  FillChar(name, len, 0);
-  Result := ssGetPeerName(s, @name, Len);
-end;
-
-function GetHostName: string;
-var
-  s: string;
-begin
-  Result := '';
-  setlength(s, 255);
-  ssGetHostName(pchar(s), Length(s) - 1);
-  Result := Pchar(s);
-end;
-
-function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
-begin
-  Result := ssSend(s, Buf^, len, flags);
-end;
-
-function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
-begin
-  Result := ssRecv(s, Buf^, len, flags);
-end;
-
-function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
-begin
-  Result := ssSendTo(s, Buf^, len, flags, @addrto, SizeOfVarSin(addrto));
-end;
-
-function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
-var
-  x: integer;
-begin
-  x := SizeOf(from);
-  Result := ssRecvFrom(s, Buf^, len, flags, @from, x);
-end;
-
-function Accept(s: TSocket; var addr: TVarSin): TSocket;
-var
-  x: integer;
-begin
-  x := SizeOf(addr);
-  Result := ssAccept(s, @addr, x);
-end;
-
-{=============================================================================}
-function IsNewApi(Family: integer): Boolean;
-begin
-  Result := SockEnhancedApi;
-  if not Result then
-    Result := (Family = AF_INET6) and SockWship6Api;
-end;
-
-function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
-type
-  pu_long = ^u_long;
-var
-  ProtoEnt: PProtoEnt;
-  ServEnt: PServEnt;
-  HostEnt: PHostEnt;
-  r: integer;
-  Hints1, Hints2: TAddrInfo;
-  Sin1, Sin2: TVarSin;
-  TwoPass: boolean;
-
-  function GetAddr(const IP, port: string; Hints: TAddrInfo; var Sin: TVarSin): integer;
-  var
-    Addr: PAddrInfo;
-  begin
-    Addr := nil;
-    try
-      FillChar(Sin, Sizeof(Sin), 0);
-      if Hints.ai_socktype = SOCK_RAW then
-      begin
-        Hints.ai_socktype := 0;
-        Hints.ai_protocol := 0;
-        Result := synsock.GetAddrInfo(PChar(IP), nil, @Hints, Addr);
-      end
-      else
-      begin
-        if (IP = cAnyHost) or (IP = c6AnyHost) then
-        begin
-          Hints.ai_flags := AI_PASSIVE;
-          Result := synsock.GetAddrInfo(nil, PChar(Port), @Hints, Addr);
-        end
-        else
-          if (IP = cLocalhost) or (IP = c6Localhost) then
-          begin
-            Result := synsock.GetAddrInfo(nil, PChar(Port), @Hints, Addr);
-          end
-          else
-          begin
-            Result := synsock.GetAddrInfo(PChar(IP), PChar(Port), @Hints, Addr);
-          end;
-      end;
-      if Result = 0 then
-        if (Addr <> nil) then
-          Move(Addr^.ai_addr^, Sin, Addr^.ai_addrlen);
-    finally
-      if Assigned(Addr) then
-        synsock.FreeAddrInfo(Addr);
-    end;
-  end;
-
-begin
-  Result := 0;
-  FillChar(Sin, Sizeof(Sin), 0);
-  if not IsNewApi(family) then
-  begin
-    SynSockCS.Enter;
-    try
-      Sin.sin_family := AF_INET;
-      ProtoEnt := synsock.GetProtoByNumber(SockProtocol);
-      ServEnt := nil;
-      if ProtoEnt <> nil then
-        ServEnt := synsock.GetServByName(PChar(Port), ProtoEnt^.p_name);
-      if ServEnt = nil then
-        Sin.sin_port := synsock.htons(StrToIntDef(Port, 0))
-      else
-        Sin.sin_port := ServEnt^.s_port;
-      if IP = cBroadcast then
-        Sin.sin_addr.s_addr := u_long(INADDR_BROADCAST)
-      else
-      begin
-        Sin.sin_addr.s_addr := synsock.inet_addr(PChar(IP));
-        if Sin.sin_addr.s_addr = u_long(INADDR_NONE) then
-        begin
-          HostEnt := synsock.GetHostByName(PChar(IP));
-          Result := synsock.WSAGetLastError;
-          if HostEnt <> nil then
-            Sin.sin_addr.S_addr := u_long(Pu_long(HostEnt^.h_addr_list^)^);
-        end;
-      end;
-    finally
-      SynSockCS.Leave;
-    end;
-  end
-  else
-  begin
-    FillChar(Hints1, Sizeof(Hints1), 0);
-    FillChar(Hints2, Sizeof(Hints2), 0);
-    TwoPass := False;
-    if Family = AF_UNSPEC then
-    begin
-      if PreferIP4 then
-      begin
-        Hints1.ai_family := AF_INET;
-        Hints2.ai_family := AF_INET6;
-        TwoPass := True;
-      end
-      else
-      begin
-        Hints2.ai_family := AF_INET;
-        Hints1.ai_family := AF_INET6;
-        TwoPass := True;
-      end;
-    end
-    else
-      Hints1.ai_family := Family;
-
-    Hints1.ai_socktype := SockType;
-    Hints1.ai_protocol := SockProtocol;
-    Hints2.ai_socktype := Hints1.ai_socktype;
-    Hints2.ai_protocol := Hints1.ai_protocol;
-
-    r := GetAddr(IP, Port, Hints1, Sin1);
-    Result := r;
-    sin := sin1;
-    if r <> 0 then
-      if TwoPass then
-      begin
-        r := GetAddr(IP, Port, Hints2, Sin2);
-        Result := r;
-        if r = 0 then
-          sin := sin2;
-      end;
-  end;
-end;
-
-function GetSinIP(Sin: TVarSin): string;
-var
-  p: PChar;
-  host, serv: string;
-  hostlen, servlen: integer;
-  r: integer;
-begin
-  Result := '';
-  if not IsNewApi(Sin.AddressFamily) then
-  begin
-    p := synsock.inet_ntoa(Sin.sin_addr);
-    if p <> nil then
-      Result := p;
-  end
-  else
-  begin
-    hostlen := NI_MAXHOST;
-    servlen := NI_MAXSERV;
-    setlength(host, hostlen);
-    setlength(serv, servlen);
-    r := getnameinfo(@sin, SizeOfVarSin(sin), PChar(host), hostlen,
-      PChar(serv), servlen, NI_NUMERICHOST + NI_NUMERICSERV);
-    if r = 0 then
-      Result := PChar(host);
-  end;
-end;
-
-function GetSinPort(Sin: TVarSin): Integer;
-begin
-  if (Sin.sin_family = AF_INET6) then
-    Result := synsock.ntohs(Sin.sin6_port)
-  else
-    Result := synsock.ntohs(Sin.sin_port);
-end;
-
-procedure ResolveNameToIP(Name: string; Family, SockProtocol, SockType: integer; const IPList: TStrings);
-type
-  TaPInAddr = array[0..250] of PInAddr;
-  PaPInAddr = ^TaPInAddr;
-var
-  Hints: TAddrInfo;
-  Addr: PAddrInfo;
-  AddrNext: PAddrInfo;
-  r: integer;
-  host, serv: string;
-  hostlen, servlen: integer;
-  RemoteHost: PHostEnt;
-  IP: u_long;
-  PAdrPtr: PaPInAddr;
-  i: Integer;
-  s: string;
-  InAddr: TInAddr;
-begin
-  IPList.Clear;
-  if not IsNewApi(Family) then
-  begin
-    IP := synsock.inet_addr(PChar(Name));
-    if IP = u_long(INADDR_NONE) then
-    begin
-      SynSockCS.Enter;
-      try
-        RemoteHost := synsock.GetHostByName(PChar(Name));
-        if RemoteHost <> nil then
-        begin
-          PAdrPtr := PAPInAddr(RemoteHost^.h_addr_list);
-          i := 0;
-          while PAdrPtr^[i] <> nil do
-          begin
-            InAddr := PAdrPtr^[i]^;
-            s := Format('%d.%d.%d.%d', [InAddr.S_bytes[0], InAddr.S_bytes[1],
-              InAddr.S_bytes[2], InAddr.S_bytes[3]]);
-            IPList.Add(s);
-            Inc(i);
-          end;
-        end;
-      finally
-        SynSockCS.Leave;
-      end;
-    end
-    else
-      IPList.Add(Name);
-  end
-  else
-  begin
-    Addr := nil;
-    try
-      FillChar(Hints, Sizeof(Hints), 0);
-      Hints.ai_family := AF_UNSPEC;
-      Hints.ai_socktype := SockType;
-      Hints.ai_protocol := SockProtocol;
-      Hints.ai_flags := 0;
-      r := synsock.GetAddrInfo(PChar(Name), nil, @Hints, Addr);
-      if r = 0 then
-      begin
-        AddrNext := Addr;
-        while not(AddrNext = nil) do
-        begin
-          if not(((Family = AF_INET6) and (AddrNext^.ai_family = AF_INET))
-            or ((Family = AF_INET) and (AddrNext^.ai_family = AF_INET6))) then
-          begin
-            hostlen := NI_MAXHOST;
-            servlen := NI_MAXSERV;
-            setlength(host, hostlen);
-            setlength(serv, servlen);
-            r := getnameinfo(AddrNext^.ai_addr, AddrNext^.ai_addrlen,
-              PChar(host), hostlen, PChar(serv), servlen,
-              NI_NUMERICHOST + NI_NUMERICSERV);
-            if r = 0 then
-            begin
-              host := PChar(host);
-              IPList.Add(host);
-            end;
-          end;
-          AddrNext := AddrNext^.ai_next;
-        end;
-      end;
-    finally
-      if Assigned(Addr) then
-        synsock.FreeAddrInfo(Addr);
-    end;
-  end;
-  if IPList.Count = 0 then
-    IPList.Add(cAnyHost);
-end;
-
-function ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word;
-var
-  ProtoEnt: PProtoEnt;
-  ServEnt: PServEnt;
-  Hints: TAddrInfo;
-  Addr: PAddrInfo;
-  r: integer;
-begin
-  Result := 0;
-  if not IsNewApi(Family) then
-  begin
-    SynSockCS.Enter;
-    try
-      ProtoEnt := synsock.GetProtoByNumber(SockProtocol);
-      ServEnt := nil;
-      if ProtoEnt <> nil then
-        ServEnt := synsock.GetServByName(PChar(Port), ProtoEnt^.p_name);
-      if ServEnt = nil then
-        Result := StrToIntDef(Port, 0)
-      else
-        Result := synsock.htons(ServEnt^.s_port);
-    finally
-      SynSockCS.Leave;
-    end;
-  end
-  else
-  begin
-    Addr := nil;
-    try
-      FillChar(Hints, Sizeof(Hints), 0);
-      Hints.ai_family := AF_UNSPEC;
-      Hints.ai_socktype := SockType;
-      Hints.ai_protocol := Sockprotocol;
-      Hints.ai_flags := AI_PASSIVE;
-      r := synsock.GetAddrInfo(nil, PChar(Port), @Hints, Addr);
-      if (r = 0) and Assigned(Addr) then
-      begin
-        if Addr^.ai_family = AF_INET then
-          Result := synsock.htons(Addr^.ai_addr^.sin_port);
-        if Addr^.ai_family = AF_INET6 then
-          Result := synsock.htons(PSockAddrIn6(Addr^.ai_addr)^.sin6_port);
-      end;
-    finally
-      if Assigned(Addr) then
-        synsock.FreeAddrInfo(Addr);
-    end;
-  end;
-end;
-
-function ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): string;
-var
-  Hints: TAddrInfo;
-  Addr: PAddrInfo;
-  r: integer;
-  host, serv: string;
-  hostlen, servlen: integer;
-  RemoteHost: PHostEnt;
-  IPn: u_long;
-begin
-  Result := IP;
-  if not IsNewApi(Family) then
-  begin
-    IPn := synsock.inet_addr(PChar(IP));
-    if IPn <> u_long(INADDR_NONE) then
-    begin
-      SynSockCS.Enter;
-      try
-        RemoteHost := GetHostByAddr(@IPn, SizeOf(IPn), AF_INET);
-        if RemoteHost <> nil then
-          Result := RemoteHost^.h_name;
-      finally
-        SynSockCS.Leave;
-      end;
-    end;
-  end
-  else
-  begin
-    Addr := nil;
-    try
-      FillChar(Hints, Sizeof(Hints), 0);
-      Hints.ai_family := AF_UNSPEC;
-      Hints.ai_socktype := SockType;
-      Hints.ai_protocol := SockProtocol;
-      Hints.ai_flags := 0;
-      r := synsock.GetAddrInfo(PChar(IP), nil, @Hints, Addr);
-      if (r = 0) and Assigned(Addr)then
-      begin
-        hostlen := NI_MAXHOST;
-        servlen := NI_MAXSERV;
-        setlength(host, hostlen);
-        setlength(serv, servlen);
-        r := getnameinfo(Addr^.ai_addr, Addr^.ai_addrlen,
-          PChar(host), hostlen, PChar(serv), servlen,
-          NI_NUMERICSERV);
-        if r = 0 then
-          Result := PChar(host);
-      end;
-    finally
-      if Assigned(Addr) then
-        synsock.FreeAddrInfo(Addr);
-    end;
-  end;
-end;
-
-{=============================================================================}
-
-function InitSocketInterface(stack: string): Boolean;
-begin
-  Result := False;
-  SockEnhancedApi := False;
-  if stack = '' then
-    stack := DLLStackName;
-  SynSockCS.Enter;
-  try
-    if SynSockCount = 0 then
-    begin
-      SockEnhancedApi := False;
-      SockWship6Api := False;
-      Libc.Signal(Libc.SIGPIPE, TSignalHandler(Libc.SIG_IGN));
-      LibHandle := LoadLibrary(PChar(Stack));
-      if LibHandle <> 0 then
-      begin
-        errno_loc := GetProcAddress(LibHandle, PChar('__errno_location'));
-        CloseSocket := GetProcAddress(LibHandle, PChar('close'));
-        IoctlSocket := GetProcAddress(LibHandle, PChar('ioctl'));
-        WSAGetLastError := LSWSAGetLastError;
-        WSAStartup := LSWSAStartup;
-        WSACleanup := LSWSACleanup;
-        ssAccept := GetProcAddress(LibHandle, PChar('accept'));
-        ssBind := GetProcAddress(LibHandle, PChar('bind'));
-        ssConnect := GetProcAddress(LibHandle, PChar('connect'));
-        ssGetPeerName := GetProcAddress(LibHandle, PChar('getpeername'));
-        ssGetSockName := GetProcAddress(LibHandle, PChar('getsockname'));
-        GetSockOpt := GetProcAddress(LibHandle, PChar('getsockopt'));
-        Htonl := GetProcAddress(LibHandle, PChar('htonl'));
-        Htons := GetProcAddress(LibHandle, PChar('htons'));
-        Inet_Addr := GetProcAddress(LibHandle, PChar('inet_addr'));
-        Inet_Ntoa := GetProcAddress(LibHandle, PChar('inet_ntoa'));
-        Listen := GetProcAddress(LibHandle, PChar('listen'));
-        Ntohl := GetProcAddress(LibHandle, PChar('ntohl'));
-        Ntohs := GetProcAddress(LibHandle, PChar('ntohs'));
-        ssRecv := GetProcAddress(LibHandle, PChar('recv'));
-        ssRecvFrom := GetProcAddress(LibHandle, PChar('recvfrom'));
-        Select := GetProcAddress(LibHandle, PChar('select'));
-        ssSend := GetProcAddress(LibHandle, PChar('send'));
-        ssSendTo := GetProcAddress(LibHandle, PChar('sendto'));
-        SetSockOpt := GetProcAddress(LibHandle, PChar('setsockopt'));
-        ShutDown := GetProcAddress(LibHandle, PChar('shutdown'));
-        Socket := GetProcAddress(LibHandle, PChar('socket'));
-        GetHostByAddr := GetProcAddress(LibHandle, PChar('gethostbyaddr'));
-        GetHostByName := GetProcAddress(LibHandle, PChar('gethostbyname'));
-        GetProtoByName := GetProcAddress(LibHandle, PChar('getprotobyname'));
-        GetProtoByNumber := GetProcAddress(LibHandle, PChar('getprotobynumber'));
-        GetServByName := GetProcAddress(LibHandle, PChar('getservbyname'));
-        GetServByPort := GetProcAddress(LibHandle, PChar('getservbyport'));
-        ssGetHostName := GetProcAddress(LibHandle, PChar('gethostname'));
-
-{$IFNDEF FORCEOLDAPI}
-        GetAddrInfo := GetProcAddress(LibHandle, PChar('getaddrinfo'));
-        FreeAddrInfo := GetProcAddress(LibHandle, PChar('freeaddrinfo'));
-        GetNameInfo := GetProcAddress(LibHandle, PChar('getnameinfo'));
-        SockEnhancedApi := Assigned(GetAddrInfo) and Assigned(FreeAddrInfo)
-          and Assigned(GetNameInfo);
-{$ENDIF}
-        Result := True;
-      end;
-    end
-    else Result := True;
-    if Result then
-      Inc(SynSockCount);
-  finally
-    SynSockCS.Leave;
-  end;
-end;
-
-function DestroySocketInterface: Boolean;
-begin
-  SynSockCS.Enter;
-  try
-    Dec(SynSockCount);
-    if SynSockCount < 0 then
-      SynSockCount := 0;
-    if SynSockCount = 0 then
-    begin
-      if LibHandle <> 0 then
-      begin
-        FreeLibrary(libHandle);
-        LibHandle := 0;
-      end;
-      if LibWship6Handle <> 0 then
-      begin
-        FreeLibrary(LibWship6Handle);
-        LibWship6Handle := 0;
-      end;
-    end;
-  finally
-    SynSockCS.Leave;
-  end;
-  Result := True;
-end;
-
-initialization
-begin
-  SynSockCS := SyncObjs.TCriticalSection.Create;
-  SET_IN6_IF_ADDR_ANY (@in6addr_any);
-  SET_LOOPBACK_ADDR6  (@in6addr_loopback);
-end;
-
-finalization
-begin
-  SynSockCS.Free;
-end;
-
-{$ENDIF}
-
+{==============================================================================|
+| Project : Ararat Synapse                                       | 002.000.009 |
+|==============================================================================|
+| Content: Socket Independent Platform Layer - Linux definition include        |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2003-2010.                |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@exclude}
+
+{$IFDEF LINUX}
+
+//{$DEFINE FORCEOLDAPI}
+{Note about define FORCEOLDAPI:
+If you activate this compiler directive, then is allways used old socket API
+for name resolution. If you leave this directive inactive, then the new API
+is used, when running system allows it.
+
+For IPv6 support you must have new API!
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+interface
+
+uses
+  SyncObjs, SysUtils, Classes,
+  synafpc,
+  Libc;
+
+function InitSocketInterface(stack: string): Boolean;
+function DestroySocketInterface: Boolean;
+
+const
+  WinsockLevel = $0202;
+
+type
+  u_char = Char;
+  u_short = Word;
+  u_int = Integer;
+  u_long = Longint;
+  pu_long = ^u_long;
+  pu_short = ^u_short;
+  TSocket = u_int;
+  TAddrFamily = integer;
+
+  TMemory = pointer;
+
+
+const
+  DLLStackName = 'libc.so.6';
+
+  cLocalhost = '127.0.0.1';
+  cAnyHost = '0.0.0.0';
+  cBroadcast = '255.255.255.255';
+  c6Localhost = '::1';
+  c6AnyHost = '::0';
+  c6Broadcast = 'ffff::1';
+  cAnyPort = '0';
+
+type
+  DWORD = Integer;
+  __fd_mask = LongWord;
+const
+  __FD_SETSIZE    = 1024;
+  __NFDBITS       = 8 * sizeof(__fd_mask);
+type
+  __fd_set = {packed} record
+    fds_bits: packed array[0..(__FD_SETSIZE div __NFDBITS)-1] of __fd_mask;
+  end;
+  TFDSet = __fd_set;
+  PFDSet = ^TFDSet;
+
+const
+  FIONREAD        = $541B;
+  FIONBIO         = $5421;
+  FIOASYNC        = $5452;
+
+type
+  PTimeVal = ^TTimeVal;
+  TTimeVal = packed record
+    tv_sec: Longint;
+    tv_usec: Longint;
+  end;
+
+const
+  IPPROTO_IP     =   0;		{ Dummy					}
+  IPPROTO_ICMP   =   1;		{ Internet Control Message Protocol }
+  IPPROTO_IGMP   =   2;		{ Internet Group Management Protocol}
+  IPPROTO_TCP    =   6;		{ TCP           			}
+  IPPROTO_UDP    =   17;	{ User Datagram Protocol		}
+  IPPROTO_IPV6   =   41;
+  IPPROTO_ICMPV6 =   58;
+  IPPROTO_RM     =  113;
+
+  IPPROTO_RAW    =   255;
+  IPPROTO_MAX    =   256;
+
+type
+  PInAddr = ^TInAddr;
+  TInAddr = packed record
+    case integer of
+      0: (S_bytes: packed array [0..3] of byte);
+      1: (S_addr: u_long);
+  end;
+
+  PSockAddrIn = ^TSockAddrIn;
+  TSockAddrIn = packed record
+    case Integer of
+      0: (sin_family: u_short;
+          sin_port: u_short;
+          sin_addr: TInAddr;
+          sin_zero: array[0..7] of Char);
+      1: (sa_family: u_short;
+          sa_data: array[0..13] of Char)
+  end;
+
+  TIP_mreq =  record
+    imr_multiaddr: TInAddr;     { IP multicast address of group }
+    imr_interface: TInAddr;     { local IP address of interface }
+  end;
+
+  PInAddr6 = ^TInAddr6;
+  TInAddr6 = packed record
+    case integer of
+      0: (S6_addr: packed array [0..15] of byte);
+      1: (u6_addr8: packed array [0..15] of byte);
+      2: (u6_addr16: packed array [0..7] of word);
+      3: (u6_addr32: packed array [0..3] of integer);
+  end;
+
+  PSockAddrIn6 = ^TSockAddrIn6;
+  TSockAddrIn6 = packed record
+		sin6_family:   u_short;     // AF_INET6
+		sin6_port:     u_short;     // Transport level port number
+		sin6_flowinfo: u_long;	    // IPv6 flow information
+		sin6_addr:     TInAddr6;    // IPv6 address
+		sin6_scope_id: u_long;      // Scope Id: IF number for link-local
+                                //           SITE id for site-local
+  end;
+
+  TIPv6_mreq = record
+    ipv6mr_multiaddr: TInAddr6; // IPv6 multicast address.
+    ipv6mr_interface: integer;   // Interface index.
+    padding: u_long;
+  end;
+
+  PHostEnt = ^THostEnt;
+  THostent = record
+    h_name: PChar;
+    h_aliases: PPChar;
+    h_addrtype: Integer;
+    h_length: Cardinal;
+    case Byte of
+      0: (h_addr_list: PPChar);
+      1: (h_addr: PPChar);
+  end;
+
+  PNetEnt = ^TNetEnt;
+  TNetEnt = record
+    n_name: PChar;
+    n_aliases: PPChar;
+    n_addrtype: Integer;
+    n_net: uint32_t;
+  end;
+
+  PServEnt = ^TServEnt;
+  TServEnt = record
+    s_name: PChar;
+    s_aliases: PPChar;
+    s_port: Integer;
+    s_proto: PChar;
+  end;
+
+  PProtoEnt = ^TProtoEnt;
+  TProtoEnt = record
+    p_name: PChar;
+    p_aliases: ^PChar;
+    p_proto: u_short;
+  end;
+
+const
+  INADDR_ANY       = $00000000;
+  INADDR_LOOPBACK  = $7F000001;
+  INADDR_BROADCAST = $FFFFFFFF;
+  INADDR_NONE      = $FFFFFFFF;
+  ADDR_ANY		 = INADDR_ANY;
+  INVALID_SOCKET		= TSocket(NOT(0));
+  SOCKET_ERROR			= -1;
+
+Const
+  IP_TOS             = 1;  { int; IP type of service and precedence.  }
+  IP_TTL             = 2;  { int; IP time to live.  }
+  IP_HDRINCL         = 3;  { int; Header is included with data.  }
+  IP_OPTIONS         = 4;  { ip_opts; IP per-packet options.  }
+  IP_ROUTER_ALERT    = 5;  { bool }
+  IP_RECVOPTS        = 6;  { bool }
+  IP_RETOPTS         = 7;  { bool }
+  IP_PKTINFO         = 8;  { bool }
+  IP_PKTOPTIONS      = 9;
+  IP_PMTUDISC        = 10; { obsolete name? }
+  IP_MTU_DISCOVER    = 10; { int; see below }
+  IP_RECVERR         = 11; { bool }
+  IP_RECVTTL         = 12; { bool }
+  IP_RECVTOS         = 13; { bool }
+  IP_MULTICAST_IF    = 32; { in_addr; set/get IP multicast i/f }
+  IP_MULTICAST_TTL   = 33; { u_char; set/get IP multicast ttl }
+  IP_MULTICAST_LOOP  = 34; { i_char; set/get IP multicast loopback }
+  IP_ADD_MEMBERSHIP  = 35; { ip_mreq; add an IP group membership }
+  IP_DROP_MEMBERSHIP = 36; { ip_mreq; drop an IP group membership }
+
+  SOL_SOCKET    = 1;
+
+  SO_DEBUG      = 1;
+  SO_REUSEADDR  = 2;
+  SO_TYPE       = 3;
+  SO_ERROR      = 4;
+  SO_DONTROUTE  = 5;
+  SO_BROADCAST  = 6;
+  SO_SNDBUF     = 7;
+  SO_RCVBUF     = 8;
+  SO_KEEPALIVE  = 9;
+  SO_OOBINLINE  = 10;
+  SO_NO_CHECK   = 11;
+  SO_PRIORITY   = 12;
+  SO_LINGER     = 13;
+  SO_BSDCOMPAT  = 14;
+  SO_REUSEPORT  = 15;
+  SO_PASSCRED   = 16;
+  SO_PEERCRED   = 17;
+  SO_RCVLOWAT   = 18;
+  SO_SNDLOWAT   = 19;
+  SO_RCVTIMEO   = 20;
+  SO_SNDTIMEO   = 21;
+{ Security levels - as per NRL IPv6 - don't actually do anything }
+  SO_SECURITY_AUTHENTICATION       = 22;
+  SO_SECURITY_ENCRYPTION_TRANSPORT = 23;
+  SO_SECURITY_ENCRYPTION_NETWORK   = 24;
+  SO_BINDTODEVICE                  = 25;
+{ Socket filtering }
+  SO_ATTACH_FILTER = 26;
+  SO_DETACH_FILTER = 27;
+
+  SOMAXCONN       = 128;
+
+  IPV6_UNICAST_HOPS     = 16;
+  IPV6_MULTICAST_IF     = 17;
+  IPV6_MULTICAST_HOPS   = 18;
+  IPV6_MULTICAST_LOOP   = 19;
+  IPV6_JOIN_GROUP       = 20;
+  IPV6_LEAVE_GROUP      = 21;
+
+  MSG_NOSIGNAL  = $4000;                // Do not generate SIGPIPE.
+
+  // getnameinfo constants
+  NI_MAXHOST	   = 1025;
+  NI_MAXSERV	   = 32;
+  NI_NOFQDN 	   = $4;
+  NI_NUMERICHOST = $1;
+  NI_NAMEREQD	   = $8;
+  NI_NUMERICSERV = $2;
+  NI_DGRAM       = $10;
+
+const
+  SOCK_STREAM     = 1;               { stream socket }
+  SOCK_DGRAM      = 2;               { datagram socket }
+  SOCK_RAW        = 3;               { raw-protocol interface }
+  SOCK_RDM        = 4;               { reliably-delivered message }
+  SOCK_SEQPACKET  = 5;               { sequenced packet stream }
+
+{ TCP options. }
+  TCP_NODELAY     = $0001;
+
+{ Address families. }
+
+  AF_UNSPEC       = 0;               { unspecified }
+  AF_INET         = 2;               { internetwork: UDP, TCP, etc. }
+  AF_INET6        = 10;              { Internetwork Version 6 }
+  AF_MAX          = 24;
+
+{ Protocol families, same as address families for now. }
+  PF_UNSPEC       = AF_UNSPEC;
+  PF_INET         = AF_INET;
+  PF_INET6        = AF_INET6;
+  PF_MAX          = AF_MAX;
+
+type
+  { Structure used by kernel to store most addresses. }
+  PSockAddr = ^TSockAddr;
+  TSockAddr = TSockAddrIn;
+
+  { Structure used by kernel to pass protocol information in raw sockets. }
+  PSockProto = ^TSockProto;
+  TSockProto = packed record
+    sp_family: u_short;
+    sp_protocol: u_short;
+  end;
+
+type
+  PAddrInfo = ^TAddrInfo;
+  TAddrInfo = record
+                ai_flags: integer;    // AI_PASSIVE, AI_CANONNAME, AI_NUMERICHOST.
+                ai_family: integer;   // PF_xxx.
+                ai_socktype: integer; // SOCK_xxx.
+                ai_protocol: integer; // 0 or IPPROTO_xxx for IPv4 and IPv6.
+                ai_addrlen: u_int;    // Length of ai_addr.
+                ai_addr: PSockAddr;   // Binary address.
+                ai_canonname: PChar;  // Canonical name for nodename.
+                ai_next: PAddrInfo;     // Next structure in linked list.
+              end;
+
+const
+  // Flags used in "hints" argument to getaddrinfo().
+  AI_PASSIVE     = $1;  // Socket address will be used in bind() call.
+  AI_CANONNAME   = $2;  // Return canonical name in first ai_canonname.
+  AI_NUMERICHOST = $4;  // Nodename must be a numeric address string.
+
+type
+{ Structure used for manipulating linger option. }
+  PLinger = ^TLinger;
+  TLinger = packed record
+    l_onoff: integer;
+    l_linger: integer;
+  end;
+
+const
+
+  MSG_OOB       = $01;                  // Process out-of-band data.
+  MSG_PEEK      = $02;                  // Peek at incoming messages.
+
+const
+  WSAEINTR = EINTR;
+  WSAEBADF = EBADF;
+  WSAEACCES = EACCES;
+  WSAEFAULT = EFAULT;
+  WSAEINVAL = EINVAL;
+  WSAEMFILE = EMFILE;
+  WSAEWOULDBLOCK = EWOULDBLOCK;
+  WSAEINPROGRESS = EINPROGRESS;
+  WSAEALREADY = EALREADY;
+  WSAENOTSOCK = ENOTSOCK;
+  WSAEDESTADDRREQ = EDESTADDRREQ;
+  WSAEMSGSIZE = EMSGSIZE;
+  WSAEPROTOTYPE = EPROTOTYPE;
+  WSAENOPROTOOPT = ENOPROTOOPT;
+  WSAEPROTONOSUPPORT = EPROTONOSUPPORT;
+  WSAESOCKTNOSUPPORT = ESOCKTNOSUPPORT;
+  WSAEOPNOTSUPP = EOPNOTSUPP;
+  WSAEPFNOSUPPORT = EPFNOSUPPORT;
+  WSAEAFNOSUPPORT = EAFNOSUPPORT;
+  WSAEADDRINUSE = EADDRINUSE;
+  WSAEADDRNOTAVAIL = EADDRNOTAVAIL;
+  WSAENETDOWN = ENETDOWN;
+  WSAENETUNREACH = ENETUNREACH;
+  WSAENETRESET = ENETRESET;
+  WSAECONNABORTED = ECONNABORTED;
+  WSAECONNRESET = ECONNRESET;
+  WSAENOBUFS = ENOBUFS;
+  WSAEISCONN = EISCONN;
+  WSAENOTCONN = ENOTCONN;
+  WSAESHUTDOWN = ESHUTDOWN;
+  WSAETOOMANYREFS = ETOOMANYREFS;
+  WSAETIMEDOUT = ETIMEDOUT;
+  WSAECONNREFUSED = ECONNREFUSED;
+  WSAELOOP = ELOOP;
+  WSAENAMETOOLONG = ENAMETOOLONG;
+  WSAEHOSTDOWN = EHOSTDOWN;
+  WSAEHOSTUNREACH = EHOSTUNREACH;
+  WSAENOTEMPTY = ENOTEMPTY;
+  WSAEPROCLIM = -1;
+  WSAEUSERS = EUSERS;
+  WSAEDQUOT = EDQUOT;
+  WSAESTALE = ESTALE;
+  WSAEREMOTE = EREMOTE;
+  WSASYSNOTREADY = -2;
+  WSAVERNOTSUPPORTED = -3;
+  WSANOTINITIALISED = -4;
+  WSAEDISCON = -5;
+  WSAHOST_NOT_FOUND = HOST_NOT_FOUND;
+  WSATRY_AGAIN = TRY_AGAIN;
+  WSANO_RECOVERY = NO_RECOVERY;
+  WSANO_DATA = -6;
+
+  EAI_BADFLAGS    = -1;   { Invalid value for `ai_flags' field.  }
+  EAI_NONAME      = -2;   { NAME or SERVICE is unknown.  }
+  EAI_AGAIN       = -3;   { Temporary failure in name resolution.  }
+  EAI_FAIL        = -4;   { Non-recoverable failure in name res.  }
+  EAI_NODATA      = -5;   { No address associated with NAME.  }
+  EAI_FAMILY      = -6;   { `ai_family' not supported.  }
+  EAI_SOCKTYPE    = -7;   { `ai_socktype' not supported.  }
+  EAI_SERVICE     = -8;   { SERVICE not supported for `ai_socktype'.  }
+  EAI_ADDRFAMILY  = -9;   { Address family for NAME not supported.  }
+  EAI_MEMORY      = -10;  { Memory allocation failure.  }
+  EAI_SYSTEM      = -11;  { System error returned in `errno'.  }
+
+const
+  WSADESCRIPTION_LEN     =   256;
+  WSASYS_STATUS_LEN      =   128;
+type
+  PWSAData = ^TWSAData;
+  TWSAData = packed record
+    wVersion: Word;
+    wHighVersion: Word;
+    szDescription: array[0..WSADESCRIPTION_LEN] of Char;
+    szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char;
+    iMaxSockets: Word;
+    iMaxUdpDg: Word;
+    lpVendorInfo: PChar;
+  end;
+
+  function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
+  function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
+  function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
+  function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
+  function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
+  function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6):boolean;
+  procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
+  procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
+var
+  in6addr_any, in6addr_loopback : TInAddr6;
+
+procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet);
+function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean;
+procedure FD_SET(Socket: TSocket; var FDSet: TFDSet);
+procedure FD_ZERO(var FDSet: TFDSet);
+
+{=============================================================================}
+
+type
+  TWSAStartup = function(wVersionRequired: Word; var WSData: TWSAData): Integer;
+    cdecl;
+  TWSACleanup = function: Integer;
+    cdecl;
+  TWSAGetLastError = function: Integer;
+    cdecl;
+  TGetServByName = function(name, proto: PChar): PServEnt;
+    cdecl;
+  TGetServByPort = function(port: Integer; proto: PChar): PServEnt;
+    cdecl;
+  TGetProtoByName = function(name: PChar): PProtoEnt;
+    cdecl;
+  TGetProtoByNumber = function(proto: Integer): PProtoEnt;
+    cdecl;
+  TGetHostByName = function(name: PChar): PHostEnt;
+    cdecl;
+  TGetHostByAddr = function(addr: Pointer; len, Struc: Integer): PHostEnt;
+    cdecl;
+  TGetHostName = function(name: PChar; len: Integer): Integer;
+    cdecl;
+  TShutdown = function(s: TSocket; how: Integer): Integer;
+    cdecl;
+  TSetSockOpt = function(s: TSocket; level, optname: Integer; optval: PChar;
+    optlen: Integer): Integer;
+    cdecl;
+  TGetSockOpt = function(s: TSocket; level, optname: Integer; optval: PChar;
+    var optlen: Integer): Integer;
+    cdecl;
+  TSendTo = function(s: TSocket; const Buf; len, flags: Integer; addrto: PSockAddr;
+    tolen: Integer): Integer;
+    cdecl;
+  TSend = function(s: TSocket; const Buf; len, flags: Integer): Integer;
+    cdecl;
+  TRecv = function(s: TSocket; var Buf; len, flags: Integer): Integer;
+    cdecl;
+  TRecvFrom = function(s: TSocket; var Buf; len, flags: Integer; from: PSockAddr;
+    var fromlen: Integer): Integer;
+    cdecl;
+  Tntohs = function(netshort: u_short): u_short;
+    cdecl;
+  Tntohl = function(netlong: u_long): u_long;
+    cdecl;
+  TListen = function(s: TSocket; backlog: Integer): Integer;
+    cdecl;
+  TIoctlSocket = function(s: TSocket; cmd: DWORD; var arg: integer): Integer;
+    cdecl;
+  TInet_ntoa = function(inaddr: TInAddr): PChar;
+    cdecl;
+  TInet_addr = function(cp: PChar): u_long;
+    cdecl;
+  Thtons = function(hostshort: u_short): u_short;
+    cdecl;
+  Thtonl = function(hostlong: u_long): u_long;
+    cdecl;
+  TGetSockName = function(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
+    cdecl;
+  TGetPeerName = function(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
+    cdecl;
+  TConnect = function(s: TSocket; name: PSockAddr; namelen: Integer): Integer;
+    cdecl;
+  TCloseSocket = function(s: TSocket): Integer;
+    cdecl;
+  TBind = function(s: TSocket; addr: PSockAddr; namelen: Integer): Integer;
+    cdecl;
+  TAccept = function(s: TSocket; addr: PSockAddr; var addrlen: Integer): TSocket;
+    cdecl;
+  TTSocket = function(af, Struc, Protocol: Integer): TSocket;
+    cdecl;
+  TSelect = function(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
+    timeout: PTimeVal): Longint;
+    cdecl;
+
+  TGetAddrInfo = function(NodeName: PChar; ServName: PChar; Hints: PAddrInfo;
+    var Addrinfo: PAddrInfo): integer;
+    cdecl;
+  TFreeAddrInfo = procedure(ai: PAddrInfo);
+    cdecl;
+  TGetNameInfo = function( addr: PSockAddr; namelen: Integer; host: PChar;
+    hostlen: DWORD; serv: PChar; servlen: DWORD; flags: integer): integer;
+    cdecl;
+
+var
+  WSAStartup: TWSAStartup = nil;
+  WSACleanup: TWSACleanup = nil;
+  WSAGetLastError: TWSAGetLastError = nil;
+  GetServByName: TGetServByName = nil;
+  GetServByPort: TGetServByPort = nil;
+  GetProtoByName: TGetProtoByName = nil;
+  GetProtoByNumber: TGetProtoByNumber = nil;
+  GetHostByName: TGetHostByName = nil;
+  GetHostByAddr: TGetHostByAddr = nil;
+  ssGetHostName: TGetHostName = nil;
+  Shutdown: TShutdown = nil;
+  SetSockOpt: TSetSockOpt = nil;
+  GetSockOpt: TGetSockOpt = nil;
+  ssSendTo: TSendTo = nil;
+  ssSend: TSend = nil;
+  ssRecv: TRecv = nil;
+  ssRecvFrom: TRecvFrom = nil;
+  ntohs: Tntohs = nil;
+  ntohl: Tntohl = nil;
+  Listen: TListen = nil;
+  IoctlSocket: TIoctlSocket = nil;
+  Inet_ntoa: TInet_ntoa = nil;
+  Inet_addr: TInet_addr = nil;
+  htons: Thtons = nil;
+  htonl: Thtonl = nil;
+  ssGetSockName: TGetSockName = nil;
+  ssGetPeerName: TGetPeerName = nil;
+  ssConnect: TConnect = nil;
+  CloseSocket: TCloseSocket = nil;
+  ssBind: TBind = nil;
+  ssAccept: TAccept = nil;
+  Socket: TTSocket = nil;
+  Select: TSelect = nil;
+
+  GetAddrInfo: TGetAddrInfo = nil;
+  FreeAddrInfo: TFreeAddrInfo = nil;
+  GetNameInfo: TGetNameInfo = nil;
+
+function LSWSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer; cdecl;
+function LSWSACleanup: Integer; cdecl;
+function LSWSAGetLastError: Integer; cdecl;
+
+var
+  SynSockCS: SyncObjs.TCriticalSection;
+  SockEnhancedApi: Boolean;
+  SockWship6Api: Boolean;
+
+type
+  TVarSin = packed record
+    case integer of
+      0: (AddressFamily: u_short);
+      1: (
+        case sin_family: u_short of
+          AF_INET: (sin_port: u_short;
+                    sin_addr: TInAddr;
+                    sin_zero: array[0..7] of Char);
+          AF_INET6: (sin6_port:     u_short;
+                		sin6_flowinfo: u_long;
+      	    	      sin6_addr:     TInAddr6;
+      		          sin6_scope_id: u_long);
+          );
+  end;
+
+function SizeOfVarSin(sin: TVarSin): integer;
+
+function Bind(s: TSocket; const addr: TVarSin): Integer;
+function Connect(s: TSocket; const name: TVarSin): Integer;
+function GetSockName(s: TSocket; var name: TVarSin): Integer;
+function GetPeerName(s: TSocket; var name: TVarSin): Integer;
+function GetHostName: string;
+function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
+function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
+function Accept(s: TSocket; var addr: TVarSin): TSocket;
+
+function IsNewApi(Family: integer): Boolean;
+function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+function GetSinIP(Sin: TVarSin): string;
+function GetSinPort(Sin: TVarSin): Integer;
+procedure ResolveNameToIP(Name: string;  Family, SockProtocol, SockType: integer; const IPList: TStrings);
+function ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): string;
+function ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word;
+
+{==============================================================================}
+implementation
+
+var
+  SynSockCount: Integer = 0;
+  LibHandle: TLibHandle = 0;
+  Libwship6Handle: TLibHandle = 0;
+
+function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
+begin
+  Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
+             (a^.u6_addr32[2] = 0) and (a^.u6_addr32[3] = 0));
+end;
+
+function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
+begin
+  Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
+             (a^.u6_addr32[2] = 0) and
+             (a^.u6_addr8[12] = 0) and (a^.u6_addr8[13] = 0) and
+             (a^.u6_addr8[14] = 0) and (a^.u6_addr8[15] = 1));
+end;
+
+function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
+begin
+  Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $80));
+end;
+
+function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
+begin
+  Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $C0));
+end;
+
+function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
+begin
+  Result := (a^.u6_addr8[0] = $FF);
+end;
+
+function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6): boolean;
+begin
+  Result := (CompareMem( a, b, sizeof(TInAddr6)));
+end;
+
+procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
+begin
+  FillChar(a^, sizeof(TInAddr6), 0);
+end;
+
+procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
+begin
+  FillChar(a^, sizeof(TInAddr6), 0);
+  a^.u6_addr8[15] := 1;
+end;
+
+{=============================================================================}
+var
+{$IFNDEF VER1_0}  //FTP version 1.0.x
+  errno_loc: function: PInteger cdecl = nil;
+{$ELSE}
+  errno_loc: function: PInteger = nil; cdecl;
+{$ENDIF}
+
+function LSWSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer;
+begin
+  with WSData do
+  begin
+    wVersion := wVersionRequired;
+    wHighVersion := $202;
+    szDescription := 'Synsock - Synapse Platform Independent Socket Layer';
+    szSystemStatus := 'Running on Linux';
+    iMaxSockets := 32768;
+    iMaxUdpDg := 8192;
+  end;
+  Result := 0;
+end;
+
+function LSWSACleanup: Integer;
+begin
+  Result := 0;
+end;
+
+function LSWSAGetLastError: Integer;
+var
+  p: PInteger;
+begin
+  p := errno_loc;
+  Result := p^;
+end;
+
+function __FDELT(Socket: TSocket): Integer;
+begin
+  Result := Socket div __NFDBITS;
+end;
+
+function __FDMASK(Socket: TSocket): __fd_mask;
+begin
+  Result := LongWord(1) shl (Socket mod __NFDBITS);
+end;
+
+function FD_ISSET(Socket: TSocket; var fdset: TFDSet): Boolean;
+begin
+  Result := (fdset.fds_bits[__FDELT(Socket)] and __FDMASK(Socket)) <> 0;
+end;
+
+procedure FD_SET(Socket: TSocket; var fdset: TFDSet);
+begin
+  fdset.fds_bits[__FDELT(Socket)] := fdset.fds_bits[__FDELT(Socket)] or __FDMASK(Socket);
+end;
+
+procedure FD_CLR(Socket: TSocket; var fdset: TFDSet);
+begin
+  fdset.fds_bits[__FDELT(Socket)] := fdset.fds_bits[__FDELT(Socket)] and (not __FDMASK(Socket));
+end;
+
+procedure FD_ZERO(var fdset: TFDSet);
+var
+  I: Integer;
+begin
+  with fdset do
+    for I := Low(fds_bits) to High(fds_bits) do
+      fds_bits[I] := 0;
+end;
+
+{=============================================================================}
+
+function SizeOfVarSin(sin: TVarSin): integer;
+begin
+  case sin.sin_family of
+    AF_INET:
+            Result := SizeOf(TSockAddrIn);
+    AF_INET6:
+            Result := SizeOf(TSockAddrIn6);
+  else
+    Result := 0;
+  end;
+end;
+
+{=============================================================================}
+
+function Bind(s: TSocket; const addr: TVarSin): Integer;
+begin
+  Result := ssBind(s, @addr, SizeOfVarSin(addr));
+end;
+
+function Connect(s: TSocket; const name: TVarSin): Integer;
+begin
+  Result := ssConnect(s, @name, SizeOfVarSin(name));
+end;
+
+function GetSockName(s: TSocket; var name: TVarSin): Integer;
+var
+  len: integer;
+begin
+  len := SizeOf(name);
+  FillChar(name, len, 0);
+  Result := ssGetSockName(s, @name, Len);
+end;
+
+function GetPeerName(s: TSocket; var name: TVarSin): Integer;
+var
+  len: integer;
+begin
+  len := SizeOf(name);
+  FillChar(name, len, 0);
+  Result := ssGetPeerName(s, @name, Len);
+end;
+
+function GetHostName: string;
+var
+  s: string;
+begin
+  Result := '';
+  setlength(s, 255);
+  ssGetHostName(pchar(s), Length(s) - 1);
+  Result := Pchar(s);
+end;
+
+function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+begin
+  Result := ssSend(s, Buf^, len, flags);
+end;
+
+function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+begin
+  Result := ssRecv(s, Buf^, len, flags);
+end;
+
+function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
+begin
+  Result := ssSendTo(s, Buf^, len, flags, @addrto, SizeOfVarSin(addrto));
+end;
+
+function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
+var
+  x: integer;
+begin
+  x := SizeOf(from);
+  Result := ssRecvFrom(s, Buf^, len, flags, @from, x);
+end;
+
+function Accept(s: TSocket; var addr: TVarSin): TSocket;
+var
+  x: integer;
+begin
+  x := SizeOf(addr);
+  Result := ssAccept(s, @addr, x);
+end;
+
+{=============================================================================}
+function IsNewApi(Family: integer): Boolean;
+begin
+  Result := SockEnhancedApi;
+  if not Result then
+    Result := (Family = AF_INET6) and SockWship6Api;
+end;
+
+function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+type
+  pu_long = ^u_long;
+var
+  ProtoEnt: PProtoEnt;
+  ServEnt: PServEnt;
+  HostEnt: PHostEnt;
+  r: integer;
+  Hints1, Hints2: TAddrInfo;
+  Sin1, Sin2: TVarSin;
+  TwoPass: boolean;
+
+  function GetAddr(const IP, port: string; Hints: TAddrInfo; var Sin: TVarSin): integer;
+  var
+    Addr: PAddrInfo;
+  begin
+    Addr := nil;
+    try
+      FillChar(Sin, Sizeof(Sin), 0);
+      if Hints.ai_socktype = SOCK_RAW then
+      begin
+        Hints.ai_socktype := 0;
+        Hints.ai_protocol := 0;
+        Result := synsock.GetAddrInfo(PChar(IP), nil, @Hints, Addr);
+      end
+      else
+      begin
+        if (IP = cAnyHost) or (IP = c6AnyHost) then
+        begin
+          Hints.ai_flags := AI_PASSIVE;
+          Result := synsock.GetAddrInfo(nil, PChar(Port), @Hints, Addr);
+        end
+        else
+          if (IP = cLocalhost) or (IP = c6Localhost) then
+          begin
+            Result := synsock.GetAddrInfo(nil, PChar(Port), @Hints, Addr);
+          end
+          else
+          begin
+            Result := synsock.GetAddrInfo(PChar(IP), PChar(Port), @Hints, Addr);
+          end;
+      end;
+      if Result = 0 then
+        if (Addr <> nil) then
+          Move(Addr^.ai_addr^, Sin, Addr^.ai_addrlen);
+    finally
+      if Assigned(Addr) then
+        synsock.FreeAddrInfo(Addr);
+    end;
+  end;
+
+begin
+  Result := 0;
+  FillChar(Sin, Sizeof(Sin), 0);
+  if not IsNewApi(family) then
+  begin
+    SynSockCS.Enter;
+    try
+      Sin.sin_family := AF_INET;
+      ProtoEnt := synsock.GetProtoByNumber(SockProtocol);
+      ServEnt := nil;
+      if ProtoEnt <> nil then
+        ServEnt := synsock.GetServByName(PChar(Port), ProtoEnt^.p_name);
+      if ServEnt = nil then
+        Sin.sin_port := synsock.htons(StrToIntDef(Port, 0))
+      else
+        Sin.sin_port := ServEnt^.s_port;
+      if IP = cBroadcast then
+        Sin.sin_addr.s_addr := u_long(INADDR_BROADCAST)
+      else
+      begin
+        Sin.sin_addr.s_addr := synsock.inet_addr(PChar(IP));
+        if Sin.sin_addr.s_addr = u_long(INADDR_NONE) then
+        begin
+          HostEnt := synsock.GetHostByName(PChar(IP));
+          Result := synsock.WSAGetLastError;
+          if HostEnt <> nil then
+            Sin.sin_addr.S_addr := u_long(Pu_long(HostEnt^.h_addr_list^)^);
+        end;
+      end;
+    finally
+      SynSockCS.Leave;
+    end;
+  end
+  else
+  begin
+    FillChar(Hints1, Sizeof(Hints1), 0);
+    FillChar(Hints2, Sizeof(Hints2), 0);
+    TwoPass := False;
+    if Family = AF_UNSPEC then
+    begin
+      if PreferIP4 then
+      begin
+        Hints1.ai_family := AF_INET;
+        Hints2.ai_family := AF_INET6;
+        TwoPass := True;
+      end
+      else
+      begin
+        Hints2.ai_family := AF_INET;
+        Hints1.ai_family := AF_INET6;
+        TwoPass := True;
+      end;
+    end
+    else
+      Hints1.ai_family := Family;
+
+    Hints1.ai_socktype := SockType;
+    Hints1.ai_protocol := SockProtocol;
+    Hints2.ai_socktype := Hints1.ai_socktype;
+    Hints2.ai_protocol := Hints1.ai_protocol;
+
+    r := GetAddr(IP, Port, Hints1, Sin1);
+    Result := r;
+    sin := sin1;
+    if r <> 0 then
+      if TwoPass then
+      begin
+        r := GetAddr(IP, Port, Hints2, Sin2);
+        Result := r;
+        if r = 0 then
+          sin := sin2;
+      end;
+  end;
+end;
+
+function GetSinIP(Sin: TVarSin): string;
+var
+  p: PChar;
+  host, serv: string;
+  hostlen, servlen: integer;
+  r: integer;
+begin
+  Result := '';
+  if not IsNewApi(Sin.AddressFamily) then
+  begin
+    p := synsock.inet_ntoa(Sin.sin_addr);
+    if p <> nil then
+      Result := p;
+  end
+  else
+  begin
+    hostlen := NI_MAXHOST;
+    servlen := NI_MAXSERV;
+    setlength(host, hostlen);
+    setlength(serv, servlen);
+    r := getnameinfo(@sin, SizeOfVarSin(sin), PChar(host), hostlen,
+      PChar(serv), servlen, NI_NUMERICHOST + NI_NUMERICSERV);
+    if r = 0 then
+      Result := PChar(host);
+  end;
+end;
+
+function GetSinPort(Sin: TVarSin): Integer;
+begin
+  if (Sin.sin_family = AF_INET6) then
+    Result := synsock.ntohs(Sin.sin6_port)
+  else
+    Result := synsock.ntohs(Sin.sin_port);
+end;
+
+procedure ResolveNameToIP(Name: string; Family, SockProtocol, SockType: integer; const IPList: TStrings);
+type
+  TaPInAddr = array[0..250] of PInAddr;
+  PaPInAddr = ^TaPInAddr;
+var
+  Hints: TAddrInfo;
+  Addr: PAddrInfo;
+  AddrNext: PAddrInfo;
+  r: integer;
+  host, serv: string;
+  hostlen, servlen: integer;
+  RemoteHost: PHostEnt;
+  IP: u_long;
+  PAdrPtr: PaPInAddr;
+  i: Integer;
+  s: string;
+  InAddr: TInAddr;
+begin
+  IPList.Clear;
+  if not IsNewApi(Family) then
+  begin
+    IP := synsock.inet_addr(PChar(Name));
+    if IP = u_long(INADDR_NONE) then
+    begin
+      SynSockCS.Enter;
+      try
+        RemoteHost := synsock.GetHostByName(PChar(Name));
+        if RemoteHost <> nil then
+        begin
+          PAdrPtr := PAPInAddr(RemoteHost^.h_addr_list);
+          i := 0;
+          while PAdrPtr^[i] <> nil do
+          begin
+            InAddr := PAdrPtr^[i]^;
+            s := Format('%d.%d.%d.%d', [InAddr.S_bytes[0], InAddr.S_bytes[1],
+              InAddr.S_bytes[2], InAddr.S_bytes[3]]);
+            IPList.Add(s);
+            Inc(i);
+          end;
+        end;
+      finally
+        SynSockCS.Leave;
+      end;
+    end
+    else
+      IPList.Add(Name);
+  end
+  else
+  begin
+    Addr := nil;
+    try
+      FillChar(Hints, Sizeof(Hints), 0);
+      Hints.ai_family := AF_UNSPEC;
+      Hints.ai_socktype := SockType;
+      Hints.ai_protocol := SockProtocol;
+      Hints.ai_flags := 0;
+      r := synsock.GetAddrInfo(PChar(Name), nil, @Hints, Addr);
+      if r = 0 then
+      begin
+        AddrNext := Addr;
+        while not(AddrNext = nil) do
+        begin
+          if not(((Family = AF_INET6) and (AddrNext^.ai_family = AF_INET))
+            or ((Family = AF_INET) and (AddrNext^.ai_family = AF_INET6))) then
+          begin
+            hostlen := NI_MAXHOST;
+            servlen := NI_MAXSERV;
+            setlength(host, hostlen);
+            setlength(serv, servlen);
+            r := getnameinfo(AddrNext^.ai_addr, AddrNext^.ai_addrlen,
+              PChar(host), hostlen, PChar(serv), servlen,
+              NI_NUMERICHOST + NI_NUMERICSERV);
+            if r = 0 then
+            begin
+              host := PChar(host);
+              IPList.Add(host);
+            end;
+          end;
+          AddrNext := AddrNext^.ai_next;
+        end;
+      end;
+    finally
+      if Assigned(Addr) then
+        synsock.FreeAddrInfo(Addr);
+    end;
+  end;
+  if IPList.Count = 0 then
+    IPList.Add(cAnyHost);
+end;
+
+function ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word;
+var
+  ProtoEnt: PProtoEnt;
+  ServEnt: PServEnt;
+  Hints: TAddrInfo;
+  Addr: PAddrInfo;
+  r: integer;
+begin
+  Result := 0;
+  if not IsNewApi(Family) then
+  begin
+    SynSockCS.Enter;
+    try
+      ProtoEnt := synsock.GetProtoByNumber(SockProtocol);
+      ServEnt := nil;
+      if ProtoEnt <> nil then
+        ServEnt := synsock.GetServByName(PChar(Port), ProtoEnt^.p_name);
+      if ServEnt = nil then
+        Result := StrToIntDef(Port, 0)
+      else
+        Result := synsock.htons(ServEnt^.s_port);
+    finally
+      SynSockCS.Leave;
+    end;
+  end
+  else
+  begin
+    Addr := nil;
+    try
+      FillChar(Hints, Sizeof(Hints), 0);
+      Hints.ai_family := AF_UNSPEC;
+      Hints.ai_socktype := SockType;
+      Hints.ai_protocol := Sockprotocol;
+      Hints.ai_flags := AI_PASSIVE;
+      r := synsock.GetAddrInfo(nil, PChar(Port), @Hints, Addr);
+      if (r = 0) and Assigned(Addr) then
+      begin
+        if Addr^.ai_family = AF_INET then
+          Result := synsock.htons(Addr^.ai_addr^.sin_port);
+        if Addr^.ai_family = AF_INET6 then
+          Result := synsock.htons(PSockAddrIn6(Addr^.ai_addr)^.sin6_port);
+      end;
+    finally
+      if Assigned(Addr) then
+        synsock.FreeAddrInfo(Addr);
+    end;
+  end;
+end;
+
+function ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): string;
+var
+  Hints: TAddrInfo;
+  Addr: PAddrInfo;
+  r: integer;
+  host, serv: string;
+  hostlen, servlen: integer;
+  RemoteHost: PHostEnt;
+  IPn: u_long;
+begin
+  Result := IP;
+  if not IsNewApi(Family) then
+  begin
+    IPn := synsock.inet_addr(PChar(IP));
+    if IPn <> u_long(INADDR_NONE) then
+    begin
+      SynSockCS.Enter;
+      try
+        RemoteHost := GetHostByAddr(@IPn, SizeOf(IPn), AF_INET);
+        if RemoteHost <> nil then
+          Result := RemoteHost^.h_name;
+      finally
+        SynSockCS.Leave;
+      end;
+    end;
+  end
+  else
+  begin
+    Addr := nil;
+    try
+      FillChar(Hints, Sizeof(Hints), 0);
+      Hints.ai_family := AF_UNSPEC;
+      Hints.ai_socktype := SockType;
+      Hints.ai_protocol := SockProtocol;
+      Hints.ai_flags := 0;
+      r := synsock.GetAddrInfo(PChar(IP), nil, @Hints, Addr);
+      if (r = 0) and Assigned(Addr)then
+      begin
+        hostlen := NI_MAXHOST;
+        servlen := NI_MAXSERV;
+        setlength(host, hostlen);
+        setlength(serv, servlen);
+        r := getnameinfo(Addr^.ai_addr, Addr^.ai_addrlen,
+          PChar(host), hostlen, PChar(serv), servlen,
+          NI_NUMERICSERV);
+        if r = 0 then
+          Result := PChar(host);
+      end;
+    finally
+      if Assigned(Addr) then
+        synsock.FreeAddrInfo(Addr);
+    end;
+  end;
+end;
+
+{=============================================================================}
+
+function InitSocketInterface(stack: string): Boolean;
+begin
+  Result := False;
+  SockEnhancedApi := False;
+  if stack = '' then
+    stack := DLLStackName;
+  SynSockCS.Enter;
+  try
+    if SynSockCount = 0 then
+    begin
+      SockEnhancedApi := False;
+      SockWship6Api := False;
+      Libc.Signal(Libc.SIGPIPE, TSignalHandler(Libc.SIG_IGN));
+      LibHandle := LoadLibrary(PChar(Stack));
+      if LibHandle <> 0 then
+      begin
+        errno_loc := GetProcAddress(LibHandle, PChar('__errno_location'));
+        CloseSocket := GetProcAddress(LibHandle, PChar('close'));
+        IoctlSocket := GetProcAddress(LibHandle, PChar('ioctl'));
+        WSAGetLastError := LSWSAGetLastError;
+        WSAStartup := LSWSAStartup;
+        WSACleanup := LSWSACleanup;
+        ssAccept := GetProcAddress(LibHandle, PChar('accept'));
+        ssBind := GetProcAddress(LibHandle, PChar('bind'));
+        ssConnect := GetProcAddress(LibHandle, PChar('connect'));
+        ssGetPeerName := GetProcAddress(LibHandle, PChar('getpeername'));
+        ssGetSockName := GetProcAddress(LibHandle, PChar('getsockname'));
+        GetSockOpt := GetProcAddress(LibHandle, PChar('getsockopt'));
+        Htonl := GetProcAddress(LibHandle, PChar('htonl'));
+        Htons := GetProcAddress(LibHandle, PChar('htons'));
+        Inet_Addr := GetProcAddress(LibHandle, PChar('inet_addr'));
+        Inet_Ntoa := GetProcAddress(LibHandle, PChar('inet_ntoa'));
+        Listen := GetProcAddress(LibHandle, PChar('listen'));
+        Ntohl := GetProcAddress(LibHandle, PChar('ntohl'));
+        Ntohs := GetProcAddress(LibHandle, PChar('ntohs'));
+        ssRecv := GetProcAddress(LibHandle, PChar('recv'));
+        ssRecvFrom := GetProcAddress(LibHandle, PChar('recvfrom'));
+        Select := GetProcAddress(LibHandle, PChar('select'));
+        ssSend := GetProcAddress(LibHandle, PChar('send'));
+        ssSendTo := GetProcAddress(LibHandle, PChar('sendto'));
+        SetSockOpt := GetProcAddress(LibHandle, PChar('setsockopt'));
+        ShutDown := GetProcAddress(LibHandle, PChar('shutdown'));
+        Socket := GetProcAddress(LibHandle, PChar('socket'));
+        GetHostByAddr := GetProcAddress(LibHandle, PChar('gethostbyaddr'));
+        GetHostByName := GetProcAddress(LibHandle, PChar('gethostbyname'));
+        GetProtoByName := GetProcAddress(LibHandle, PChar('getprotobyname'));
+        GetProtoByNumber := GetProcAddress(LibHandle, PChar('getprotobynumber'));
+        GetServByName := GetProcAddress(LibHandle, PChar('getservbyname'));
+        GetServByPort := GetProcAddress(LibHandle, PChar('getservbyport'));
+        ssGetHostName := GetProcAddress(LibHandle, PChar('gethostname'));
+
+{$IFNDEF FORCEOLDAPI}
+        GetAddrInfo := GetProcAddress(LibHandle, PChar('getaddrinfo'));
+        FreeAddrInfo := GetProcAddress(LibHandle, PChar('freeaddrinfo'));
+        GetNameInfo := GetProcAddress(LibHandle, PChar('getnameinfo'));
+        SockEnhancedApi := Assigned(GetAddrInfo) and Assigned(FreeAddrInfo)
+          and Assigned(GetNameInfo);
+{$ENDIF}
+        Result := True;
+      end;
+    end
+    else Result := True;
+    if Result then
+      Inc(SynSockCount);
+  finally
+    SynSockCS.Leave;
+  end;
+end;
+
+function DestroySocketInterface: Boolean;
+begin
+  SynSockCS.Enter;
+  try
+    Dec(SynSockCount);
+    if SynSockCount < 0 then
+      SynSockCount := 0;
+    if SynSockCount = 0 then
+    begin
+      if LibHandle <> 0 then
+      begin
+        FreeLibrary(libHandle);
+        LibHandle := 0;
+      end;
+      if LibWship6Handle <> 0 then
+      begin
+        FreeLibrary(LibWship6Handle);
+        LibWship6Handle := 0;
+      end;
+    end;
+  finally
+    SynSockCS.Leave;
+  end;
+  Result := True;
+end;
+
+initialization
+begin
+  SynSockCS := SyncObjs.TCriticalSection.Create;
+  SET_IN6_IF_ADDR_ANY (@in6addr_any);
+  SET_LOOPBACK_ADDR6  (@in6addr_loopback);
+end;
+
+finalization
+begin
+  SynSockCS.Free;
+end;
+
+{$ENDIF}
+
diff --git a/Units/Synapse/sswin32.pas b/Units/Synapse/sswin32.pas
index 30848d8..c9b496a 100644
--- a/Units/Synapse/sswin32.pas
+++ b/Units/Synapse/sswin32.pas
@@ -1,1599 +1,1599 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 002.002.003 |
-|==============================================================================|
-| Content: Socket Independent Platform Layer - Win32 definition include        |
-|==============================================================================|
-| Copyright (c)1999-2010, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2003-2010.                |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{:@exclude}
-
-//{$DEFINE WINSOCK1}
-{Note about define WINSOCK1:
-If you activate this compiler directive, then socket interface level 1.1 is
-used instead default level 2.2. Level 2.2 is not available on old W95, however
-you can install update.
-}
-
-//{$DEFINE FORCEOLDAPI}
-{Note about define FORCEOLDAPI:
-If you activate this compiler directive, then is allways used old socket API
-for name resolution. If you leave this directive inactive, then the new API
-is used, when running system allows it.
-
-For IPv6 support you must have new API!
-}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$H+}
-{$IFDEF VER125}
-  {$DEFINE BCB}
-{$ENDIF}
-{$IFDEF BCB}
-  {$ObjExportAll On}
-  (*$HPPEMIT '/* EDE 2003-02-19 */' *)
-  (*$HPPEMIT 'namespace Synsock { using System::Shortint; }' *)
-  (*$HPPEMIT '#undef h_addr' *)
-  (*$HPPEMIT '#undef IOCPARM_MASK' *)
-  (*$HPPEMIT '#undef FD_SETSIZE' *)
-  (*$HPPEMIT '#undef IOC_VOID' *)
-  (*$HPPEMIT '#undef IOC_OUT' *)
-  (*$HPPEMIT '#undef IOC_IN' *)
-  (*$HPPEMIT '#undef IOC_INOUT' *)
-  (*$HPPEMIT '#undef FIONREAD' *)
-  (*$HPPEMIT '#undef FIONBIO' *)
-  (*$HPPEMIT '#undef FIOASYNC' *)
-  (*$HPPEMIT '#undef IPPROTO_IP' *)
-  (*$HPPEMIT '#undef IPPROTO_ICMP' *)
-  (*$HPPEMIT '#undef IPPROTO_IGMP' *)
-  (*$HPPEMIT '#undef IPPROTO_TCP' *)
-  (*$HPPEMIT '#undef IPPROTO_UDP' *)
-  (*$HPPEMIT '#undef IPPROTO_RAW' *)
-  (*$HPPEMIT '#undef IPPROTO_MAX' *)
-  (*$HPPEMIT '#undef INADDR_ANY' *)
-  (*$HPPEMIT '#undef INADDR_LOOPBACK' *)
-  (*$HPPEMIT '#undef INADDR_BROADCAST' *)
-  (*$HPPEMIT '#undef INADDR_NONE' *)
-  (*$HPPEMIT '#undef INVALID_SOCKET' *)
-  (*$HPPEMIT '#undef SOCKET_ERROR' *)
-  (*$HPPEMIT '#undef WSADESCRIPTION_LEN' *)
-  (*$HPPEMIT '#undef WSASYS_STATUS_LEN' *)
-  (*$HPPEMIT '#undef IP_OPTIONS' *)
-  (*$HPPEMIT '#undef IP_TOS' *)
-  (*$HPPEMIT '#undef IP_TTL' *)
-  (*$HPPEMIT '#undef IP_MULTICAST_IF' *)
-  (*$HPPEMIT '#undef IP_MULTICAST_TTL' *)
-  (*$HPPEMIT '#undef IP_MULTICAST_LOOP' *)
-  (*$HPPEMIT '#undef IP_ADD_MEMBERSHIP' *)
-  (*$HPPEMIT '#undef IP_DROP_MEMBERSHIP' *)
-  (*$HPPEMIT '#undef IP_DONTFRAGMENT' *)
-  (*$HPPEMIT '#undef IP_DEFAULT_MULTICAST_TTL' *)
-  (*$HPPEMIT '#undef IP_DEFAULT_MULTICAST_LOOP' *)
-  (*$HPPEMIT '#undef IP_MAX_MEMBERSHIPS' *)
-  (*$HPPEMIT '#undef SOL_SOCKET' *)
-  (*$HPPEMIT '#undef SO_DEBUG' *)
-  (*$HPPEMIT '#undef SO_ACCEPTCONN' *)
-  (*$HPPEMIT '#undef SO_REUSEADDR' *)
-  (*$HPPEMIT '#undef SO_KEEPALIVE' *)
-  (*$HPPEMIT '#undef SO_DONTROUTE' *)
-  (*$HPPEMIT '#undef SO_BROADCAST' *)
-  (*$HPPEMIT '#undef SO_USELOOPBACK' *)
-  (*$HPPEMIT '#undef SO_LINGER' *)
-  (*$HPPEMIT '#undef SO_OOBINLINE' *)
-  (*$HPPEMIT '#undef SO_DONTLINGER' *)
-  (*$HPPEMIT '#undef SO_SNDBUF' *)
-  (*$HPPEMIT '#undef SO_RCVBUF' *)
-  (*$HPPEMIT '#undef SO_SNDLOWAT' *)
-  (*$HPPEMIT '#undef SO_RCVLOWAT' *)
-  (*$HPPEMIT '#undef SO_SNDTIMEO' *)
-  (*$HPPEMIT '#undef SO_RCVTIMEO' *)
-  (*$HPPEMIT '#undef SO_ERROR' *)
-  (*$HPPEMIT '#undef SO_OPENTYPE' *)
-  (*$HPPEMIT '#undef SO_SYNCHRONOUS_ALERT' *)
-  (*$HPPEMIT '#undef SO_SYNCHRONOUS_NONALERT' *)
-  (*$HPPEMIT '#undef SO_MAXDG' *)
-  (*$HPPEMIT '#undef SO_MAXPATHDG' *)
-  (*$HPPEMIT '#undef SO_UPDATE_ACCEPT_CONTEXT' *)
-  (*$HPPEMIT '#undef SO_CONNECT_TIME' *)
-  (*$HPPEMIT '#undef SO_TYPE' *)
-  (*$HPPEMIT '#undef SOCK_STREAM' *)
-  (*$HPPEMIT '#undef SOCK_DGRAM' *)
-  (*$HPPEMIT '#undef SOCK_RAW' *)
-  (*$HPPEMIT '#undef SOCK_RDM' *)
-  (*$HPPEMIT '#undef SOCK_SEQPACKET' *)
-  (*$HPPEMIT '#undef TCP_NODELAY' *)
-  (*$HPPEMIT '#undef AF_UNSPEC' *)
-  (*$HPPEMIT '#undef SOMAXCONN' *)
-  (*$HPPEMIT '#undef AF_INET' *)
-  (*$HPPEMIT '#undef AF_MAX' *)
-  (*$HPPEMIT '#undef PF_UNSPEC' *)
-  (*$HPPEMIT '#undef PF_INET' *)
-  (*$HPPEMIT '#undef PF_MAX' *)
-  (*$HPPEMIT '#undef MSG_OOB' *)
-  (*$HPPEMIT '#undef MSG_PEEK' *)
-  (*$HPPEMIT '#undef WSABASEERR' *)
-  (*$HPPEMIT '#undef WSAEINTR' *)
-  (*$HPPEMIT '#undef WSAEBADF' *)
-  (*$HPPEMIT '#undef WSAEACCES' *)
-  (*$HPPEMIT '#undef WSAEFAULT' *)
-  (*$HPPEMIT '#undef WSAEINVAL' *)
-  (*$HPPEMIT '#undef WSAEMFILE' *)
-  (*$HPPEMIT '#undef WSAEWOULDBLOCK' *)
-  (*$HPPEMIT '#undef WSAEINPROGRESS' *)
-  (*$HPPEMIT '#undef WSAEALREADY' *)
-  (*$HPPEMIT '#undef WSAENOTSOCK' *)
-  (*$HPPEMIT '#undef WSAEDESTADDRREQ' *)
-  (*$HPPEMIT '#undef WSAEMSGSIZE' *)
-  (*$HPPEMIT '#undef WSAEPROTOTYPE' *)
-  (*$HPPEMIT '#undef WSAENOPROTOOPT' *)
-  (*$HPPEMIT '#undef WSAEPROTONOSUPPORT' *)
-  (*$HPPEMIT '#undef WSAESOCKTNOSUPPORT' *)
-  (*$HPPEMIT '#undef WSAEOPNOTSUPP' *)
-  (*$HPPEMIT '#undef WSAEPFNOSUPPORT' *)
-  (*$HPPEMIT '#undef WSAEAFNOSUPPORT' *)
-  (*$HPPEMIT '#undef WSAEADDRINUSE' *)
-  (*$HPPEMIT '#undef WSAEADDRNOTAVAIL' *)
-  (*$HPPEMIT '#undef WSAENETDOWN' *)
-  (*$HPPEMIT '#undef WSAENETUNREACH' *)
-  (*$HPPEMIT '#undef WSAENETRESET' *)
-  (*$HPPEMIT '#undef WSAECONNABORTED' *)
-  (*$HPPEMIT '#undef WSAECONNRESET' *)
-  (*$HPPEMIT '#undef WSAENOBUFS' *)
-  (*$HPPEMIT '#undef WSAEISCONN' *)
-  (*$HPPEMIT '#undef WSAENOTCONN' *)
-  (*$HPPEMIT '#undef WSAESHUTDOWN' *)
-  (*$HPPEMIT '#undef WSAETOOMANYREFS' *)
-  (*$HPPEMIT '#undef WSAETIMEDOUT' *)
-  (*$HPPEMIT '#undef WSAECONNREFUSED' *)
-  (*$HPPEMIT '#undef WSAELOOP' *)
-  (*$HPPEMIT '#undef WSAENAMETOOLONG' *)
-  (*$HPPEMIT '#undef WSAEHOSTDOWN' *)
-  (*$HPPEMIT '#undef WSAEHOSTUNREACH' *)
-  (*$HPPEMIT '#undef WSAENOTEMPTY' *)
-  (*$HPPEMIT '#undef WSAEPROCLIM' *)
-  (*$HPPEMIT '#undef WSAEUSERS' *)
-  (*$HPPEMIT '#undef WSAEDQUOT' *)
-  (*$HPPEMIT '#undef WSAESTALE' *)
-  (*$HPPEMIT '#undef WSAEREMOTE' *)
-  (*$HPPEMIT '#undef WSASYSNOTREADY' *)
-  (*$HPPEMIT '#undef WSAVERNOTSUPPORTED' *)
-  (*$HPPEMIT '#undef WSANOTINITIALISED' *)
-  (*$HPPEMIT '#undef WSAEDISCON' *)
-  (*$HPPEMIT '#undef WSAENOMORE' *)
-  (*$HPPEMIT '#undef WSAECANCELLED' *)
-  (*$HPPEMIT '#undef WSAEEINVALIDPROCTABLE' *)
-  (*$HPPEMIT '#undef WSAEINVALIDPROVIDER' *)
-  (*$HPPEMIT '#undef WSAEPROVIDERFAILEDINIT' *)
-  (*$HPPEMIT '#undef WSASYSCALLFAILURE' *)
-  (*$HPPEMIT '#undef WSASERVICE_NOT_FOUND' *)
-  (*$HPPEMIT '#undef WSATYPE_NOT_FOUND' *)
-  (*$HPPEMIT '#undef WSA_E_NO_MORE' *)
-  (*$HPPEMIT '#undef WSA_E_CANCELLED' *)
-  (*$HPPEMIT '#undef WSAEREFUSED' *)
-  (*$HPPEMIT '#undef WSAHOST_NOT_FOUND' *)
-  (*$HPPEMIT '#undef HOST_NOT_FOUND' *)
-  (*$HPPEMIT '#undef WSATRY_AGAIN' *)
-  (*$HPPEMIT '#undef TRY_AGAIN' *)
-  (*$HPPEMIT '#undef WSANO_RECOVERY' *)
-  (*$HPPEMIT '#undef NO_RECOVERY' *)
-  (*$HPPEMIT '#undef WSANO_DATA' *)
-  (*$HPPEMIT '#undef NO_DATA' *)
-  (*$HPPEMIT '#undef WSANO_ADDRESS' *)
-  (*$HPPEMIT '#undef ENAMETOOLONG' *)
-  (*$HPPEMIT '#undef ENOTEMPTY' *)
-  (*$HPPEMIT '#undef FD_CLR' *)
-  (*$HPPEMIT '#undef FD_ISSET' *)
-  (*$HPPEMIT '#undef FD_SET' *)
-  (*$HPPEMIT '#undef FD_ZERO' *)
-  (*$HPPEMIT '#undef NO_ADDRESS' *)
-  (*$HPPEMIT '#undef ADDR_ANY' *)
-  (*$HPPEMIT '#undef SO_GROUP_ID' *)
-  (*$HPPEMIT '#undef SO_GROUP_PRIORITY' *)
-  (*$HPPEMIT '#undef SO_MAX_MSG_SIZE' *)
-  (*$HPPEMIT '#undef SO_PROTOCOL_INFOA' *)
-  (*$HPPEMIT '#undef SO_PROTOCOL_INFOW' *)
-  (*$HPPEMIT '#undef SO_PROTOCOL_INFO' *)
-  (*$HPPEMIT '#undef PVD_CONFIG' *)
-  (*$HPPEMIT '#undef AF_INET6' *)
-  (*$HPPEMIT '#undef PF_INET6' *)
-{$ENDIF}
-
-interface
-
-uses
-  SyncObjs, SysUtils, Classes,
-  Windows;
-
-function InitSocketInterface(stack: String): Boolean;
-function DestroySocketInterface: Boolean;
-
-const
-{$IFDEF WINSOCK1}
-  WinsockLevel = $0101;
-{$ELSE}
-  WinsockLevel = $0202;
-{$ENDIF}
-
-type
-  u_short = Word;
-  u_int = Integer;
-  u_long = Longint;
-  pu_long = ^u_long;
-  pu_short = ^u_short;
-{$IFDEF FPC}
-  TSocket = ptruint;
-{$ELSE}
-  TSocket = u_int;
-{$ENDIF}
-  TAddrFamily = integer;
-
-  TMemory = pointer;
-
-const
-  {$IFDEF WINSOCK1}
-    DLLStackName = 'wsock32.dll';
-  {$ELSE}
-    DLLStackName = 'ws2_32.dll';
-  {$ENDIF}
-  DLLwship6 = 'wship6.dll';
-
-  cLocalhost = '127.0.0.1';
-  cAnyHost = '0.0.0.0';
-  cBroadcast = '255.255.255.255';
-  c6Localhost = '::1';
-  c6AnyHost = '::0';
-  c6Broadcast = 'ffff::1';
-  cAnyPort = '0';
-  
-
-const
-  FD_SETSIZE     =   64;
-type
-  PFDSet = ^TFDSet;
-  TFDSet = record
-    fd_count: u_int;
-    fd_array: array[0..FD_SETSIZE-1] of TSocket;
-  end;
-
-const
-  FIONREAD     = $4004667f;
-  FIONBIO      = $8004667e;
-  FIOASYNC     = $8004667d;
-
-type
-  PTimeVal = ^TTimeVal;
-  TTimeVal = record
-    tv_sec: Longint;
-    tv_usec: Longint;
-  end;
-
-const
-  IPPROTO_IP     =   0;		{ Dummy					}
-  IPPROTO_ICMP   =   1;		{ Internet Control Message Protocol }
-  IPPROTO_IGMP   =   2;		{ Internet Group Management Protocol}
-  IPPROTO_TCP    =   6;		{ TCP           			}
-  IPPROTO_UDP    =   17;	{ User Datagram Protocol		}
-  IPPROTO_IPV6   =   41;
-  IPPROTO_ICMPV6 =   58;
-  IPPROTO_RM     =  113;
-
-  IPPROTO_RAW    =   255;
-  IPPROTO_MAX    =   256;
-
-type
-
-  PInAddr = ^TInAddr;
-  TInAddr = record
-    case integer of
-      0: (S_bytes: packed array [0..3] of byte);
-      1: (S_addr: u_long);
-  end;
-
-  PSockAddrIn = ^TSockAddrIn;
-  TSockAddrIn = record
-    case Integer of
-      0: (sin_family: u_short;
-          sin_port: u_short;
-          sin_addr: TInAddr;
-          sin_zero: array[0..7] of byte);
-      1: (sa_family: u_short;
-          sa_data: array[0..13] of byte)
-  end;
-
-  TIP_mreq =  record
-    imr_multiaddr: TInAddr;     { IP multicast address of group }
-    imr_interface: TInAddr;     { local IP address of interface }
-  end;
-
-  PInAddr6 = ^TInAddr6;
-  TInAddr6 = record
-    case integer of
-      0: (S6_addr: packed array [0..15] of byte);
-      1: (u6_addr8: packed array [0..15] of byte);
-      2: (u6_addr16: packed array [0..7] of word);
-      3: (u6_addr32: packed array [0..3] of integer);
-  end;
-
-  PSockAddrIn6 = ^TSockAddrIn6;
-  TSockAddrIn6 = record
-		sin6_family:   u_short;     // AF_INET6
-		sin6_port:     u_short;     // Transport level port number
-		sin6_flowinfo: u_long;	    // IPv6 flow information
-		sin6_addr:     TInAddr6;    // IPv6 address
-		sin6_scope_id: u_long;      // Scope Id: IF number for link-local
-                                //           SITE id for site-local
-  end;
-
-  TIPv6_mreq = record
-    ipv6mr_multiaddr: TInAddr6; // IPv6 multicast address.
-    ipv6mr_interface: integer;   // Interface index.
-    padding: integer;
-  end;
-
-  PHostEnt = ^THostEnt;
-  THostEnt = record
-    h_name: PAnsiChar;
-    h_aliases: ^PAnsiChar;
-    h_addrtype: Smallint;
-    h_length: Smallint;
-    case integer of
-     0: (h_addr_list: ^PAnsiChar);
-     1: (h_addr: ^PInAddr);
-  end;
-
-  PNetEnt = ^TNetEnt;
-  TNetEnt = record
-    n_name: PAnsiChar;
-    n_aliases: ^PAnsiChar;
-    n_addrtype: Smallint;
-    n_net: u_long;
-  end;
-
-  PServEnt = ^TServEnt;
-  TServEnt = record
-    s_name: PAnsiChar;
-    s_aliases: ^PAnsiChar;
-{$ifdef WIN64}
-    s_proto: PAnsiChar;
-    s_port: Smallint;
-{$else} 
-    s_port: Smallint;
-    s_proto: PAnsiChar;
-{$endif}
-  end;
-
-  PProtoEnt = ^TProtoEnt;
-  TProtoEnt = record
-    p_name: PAnsiChar;
-    p_aliases: ^PAnsichar;
-    p_proto: Smallint;
-  end;
-
-const
-  INADDR_ANY       = $00000000;
-  INADDR_LOOPBACK  = $7F000001;
-  INADDR_BROADCAST = $FFFFFFFF;
-  INADDR_NONE      = $FFFFFFFF;
-  ADDR_ANY		 = INADDR_ANY;
-  INVALID_SOCKET		= TSocket(NOT(0));
-  SOCKET_ERROR			= -1;
-
-Const
-  {$IFDEF WINSOCK1}
-    IP_OPTIONS          = 1;
-    IP_MULTICAST_IF     = 2;           { set/get IP multicast interface   }
-    IP_MULTICAST_TTL    = 3;           { set/get IP multicast timetolive  }
-    IP_MULTICAST_LOOP   = 4;           { set/get IP multicast loopback    }
-    IP_ADD_MEMBERSHIP   = 5;           { add  an IP group membership      }
-    IP_DROP_MEMBERSHIP  = 6;           { drop an IP group membership      }
-    IP_TTL              = 7;           { set/get IP Time To Live          }
-    IP_TOS              = 8;           { set/get IP Type Of Service       }
-    IP_DONTFRAGMENT     = 9;           { set/get IP Don't Fragment flag   }
-  {$ELSE}
-    IP_OPTIONS          = 1;
-    IP_HDRINCL          = 2;
-    IP_TOS              = 3;           { set/get IP Type Of Service       }
-    IP_TTL              = 4;           { set/get IP Time To Live          }
-    IP_MULTICAST_IF     = 9;           { set/get IP multicast interface   }
-    IP_MULTICAST_TTL    = 10;           { set/get IP multicast timetolive  }
-    IP_MULTICAST_LOOP   = 11;           { set/get IP multicast loopback    }
-    IP_ADD_MEMBERSHIP   = 12;           { add  an IP group membership      }
-    IP_DROP_MEMBERSHIP  = 13;           { drop an IP group membership      }
-    IP_DONTFRAGMENT     = 14;           { set/get IP Don't Fragment flag   }
-  {$ENDIF}
-
-  IP_DEFAULT_MULTICAST_TTL   = 1;    { normally limit m'casts to 1 hop  }
-  IP_DEFAULT_MULTICAST_LOOP  = 1;    { normally hear sends if a member  }
-  IP_MAX_MEMBERSHIPS         = 20;   { per socket; must fit in one mbuf }
-
-  SOL_SOCKET      = $ffff;          {options for socket level }
-{ Option flags per-socket. }
-  SO_DEBUG        = $0001;          { turn on debugging info recording }
-  SO_ACCEPTCONN   = $0002;          { socket has had listen() }
-  SO_REUSEADDR    = $0004;          { allow local address reuse }
-  SO_KEEPALIVE    = $0008;          { keep connections alive }
-  SO_DONTROUTE    = $0010;          { just use interface addresses }
-  SO_BROADCAST    = $0020;          { permit sending of broadcast msgs }
-  SO_USELOOPBACK  = $0040;          { bypass hardware when possible }
-  SO_LINGER       = $0080;          { linger on close if data present }
-  SO_OOBINLINE    = $0100;          { leave received OOB data in line }
-  SO_DONTLINGER  =   $ff7f;
-{ Additional options. }
-  SO_SNDBUF       = $1001;          { send buffer size }
-  SO_RCVBUF       = $1002;          { receive buffer size }
-  SO_SNDLOWAT     = $1003;          { send low-water mark }
-  SO_RCVLOWAT     = $1004;          { receive low-water mark }
-  SO_SNDTIMEO     = $1005;          { send timeout }
-  SO_RCVTIMEO     = $1006;          { receive timeout }
-  SO_ERROR        = $1007;          { get error status and clear }
-  SO_TYPE         = $1008;          { get socket type }
-{ WinSock 2 extension -- new options }
-  SO_GROUP_ID       = $2001; { ID of a socket group}
-  SO_GROUP_PRIORITY = $2002; { the relative priority within a group}
-  SO_MAX_MSG_SIZE   = $2003; { maximum message size }
-  SO_PROTOCOL_INFOA = $2004; { WSAPROTOCOL_INFOA structure }
-  SO_PROTOCOL_INFOW = $2005; { WSAPROTOCOL_INFOW structure }
-  SO_PROTOCOL_INFO  = SO_PROTOCOL_INFOA;
-  PVD_CONFIG        = $3001; {configuration info for service provider }
-{ Option for opening sockets for synchronous access. }
-  SO_OPENTYPE     = $7008;
-  SO_SYNCHRONOUS_ALERT    = $10;
-  SO_SYNCHRONOUS_NONALERT = $20;
-{ Other NT-specific options. }
-  SO_MAXDG        = $7009;
-  SO_MAXPATHDG    = $700A;
-  SO_UPDATE_ACCEPT_CONTEXT     = $700B;
-  SO_CONNECT_TIME = $700C;
-
-  SOMAXCONN       = $7fffffff;
-
-  IPV6_UNICAST_HOPS      = 8;  // ???
-  IPV6_MULTICAST_IF      = 9;  // set/get IP multicast i/f
-  IPV6_MULTICAST_HOPS    = 10; // set/get IP multicast ttl
-  IPV6_MULTICAST_LOOP    = 11; // set/get IP multicast loopback
-  IPV6_JOIN_GROUP        = 12; // add an IP group membership
-  IPV6_LEAVE_GROUP       = 13; // drop an IP group membership
-
-  MSG_NOSIGNAL  = 0;
-
-  // getnameinfo constants
-  NI_MAXHOST	   = 1025;
-  NI_MAXSERV	   = 32;
-  NI_NOFQDN 	   = $1;
-  NI_NUMERICHOST = $2;
-  NI_NAMEREQD	   = $4;
-  NI_NUMERICSERV = $8;
-  NI_DGRAM       = $10;
-
-
-const
-  SOCK_STREAM     = 1;               { stream socket }
-  SOCK_DGRAM      = 2;               { datagram socket }
-  SOCK_RAW        = 3;               { raw-protocol interface }
-  SOCK_RDM        = 4;               { reliably-delivered message }
-  SOCK_SEQPACKET  = 5;               { sequenced packet stream }
-
-{ TCP options. }
-  TCP_NODELAY     = $0001;
-
-{ Address families. }
-
-  AF_UNSPEC       = 0;               { unspecified }
-  AF_INET         = 2;               { internetwork: UDP, TCP, etc. }
-  AF_INET6        = 23;              { Internetwork Version 6 }
-  AF_MAX          = 24;
-
-{ Protocol families, same as address families for now. }
-  PF_UNSPEC       = AF_UNSPEC;
-  PF_INET         = AF_INET;
-  PF_INET6        = AF_INET6;
-  PF_MAX          = AF_MAX;
-
-type
-  { Structure used by kernel to store most addresses. }
-  PSockAddr = ^TSockAddr;
-  TSockAddr = TSockAddrIn;
-
-  { Structure used by kernel to pass protocol information in raw sockets. }
-  PSockProto = ^TSockProto;
-  TSockProto = record
-    sp_family: u_short;
-    sp_protocol: u_short;
-  end;
-
-type
-  PAddrInfo = ^TAddrInfo;
-  TAddrInfo = record
-                ai_flags: integer;    // AI_PASSIVE, AI_CANONNAME, AI_NUMERICHOST.
-                ai_family: integer;   // PF_xxx.
-                ai_socktype: integer; // SOCK_xxx.
-                ai_protocol: integer; // 0 or IPPROTO_xxx for IPv4 and IPv6.
-                ai_addrlen: u_int;    // Length of ai_addr.
-                ai_canonname: PAnsiChar;  // Canonical name for nodename.
-                ai_addr: PSockAddr;   // Binary address.
-                ai_next: PAddrInfo;     // Next structure in linked list.
-              end;
-
-const
-  // Flags used in "hints" argument to getaddrinfo().
-  AI_PASSIVE     = $1;  // Socket address will be used in bind() call.
-  AI_CANONNAME   = $2;  // Return canonical name in first ai_canonname.
-  AI_NUMERICHOST = $4;  // Nodename must be a numeric address string.
-
-type
-{ Structure used for manipulating linger option. }
-  PLinger = ^TLinger;
-  TLinger = record
-    l_onoff: u_short;
-    l_linger: u_short;
-  end;
-
-const
-
-  MSG_OOB       = $01;                  // Process out-of-band data.
-  MSG_PEEK      = $02;                  // Peek at incoming messages.
-
-const
-
-{ All Windows Sockets error constants are biased by WSABASEERR from the "normal" }
-  WSABASEERR              = 10000;
-
-{ Windows Sockets definitions of regular Microsoft C error constants }
-
-  WSAEINTR                = (WSABASEERR+4);
-  WSAEBADF                = (WSABASEERR+9);
-  WSAEACCES               = (WSABASEERR+13);
-  WSAEFAULT               = (WSABASEERR+14);
-  WSAEINVAL               = (WSABASEERR+22);
-  WSAEMFILE               = (WSABASEERR+24);
-
-{ Windows Sockets definitions of regular Berkeley error constants }
-
-  WSAEWOULDBLOCK          = (WSABASEERR+35);
-  WSAEINPROGRESS          = (WSABASEERR+36);
-  WSAEALREADY             = (WSABASEERR+37);
-  WSAENOTSOCK             = (WSABASEERR+38);
-  WSAEDESTADDRREQ         = (WSABASEERR+39);
-  WSAEMSGSIZE             = (WSABASEERR+40);
-  WSAEPROTOTYPE           = (WSABASEERR+41);
-  WSAENOPROTOOPT          = (WSABASEERR+42);
-  WSAEPROTONOSUPPORT      = (WSABASEERR+43);
-  WSAESOCKTNOSUPPORT      = (WSABASEERR+44);
-  WSAEOPNOTSUPP           = (WSABASEERR+45);
-  WSAEPFNOSUPPORT         = (WSABASEERR+46);
-  WSAEAFNOSUPPORT         = (WSABASEERR+47);
-  WSAEADDRINUSE           = (WSABASEERR+48);
-  WSAEADDRNOTAVAIL        = (WSABASEERR+49);
-  WSAENETDOWN             = (WSABASEERR+50);
-  WSAENETUNREACH          = (WSABASEERR+51);
-  WSAENETRESET            = (WSABASEERR+52);
-  WSAECONNABORTED         = (WSABASEERR+53);
-  WSAECONNRESET           = (WSABASEERR+54);
-  WSAENOBUFS              = (WSABASEERR+55);
-  WSAEISCONN              = (WSABASEERR+56);
-  WSAENOTCONN             = (WSABASEERR+57);
-  WSAESHUTDOWN            = (WSABASEERR+58);
-  WSAETOOMANYREFS         = (WSABASEERR+59);
-  WSAETIMEDOUT            = (WSABASEERR+60);
-  WSAECONNREFUSED         = (WSABASEERR+61);
-  WSAELOOP                = (WSABASEERR+62);
-  WSAENAMETOOLONG         = (WSABASEERR+63);
-  WSAEHOSTDOWN            = (WSABASEERR+64);
-  WSAEHOSTUNREACH         = (WSABASEERR+65);
-  WSAENOTEMPTY            = (WSABASEERR+66);
-  WSAEPROCLIM             = (WSABASEERR+67);
-  WSAEUSERS               = (WSABASEERR+68);
-  WSAEDQUOT               = (WSABASEERR+69);
-  WSAESTALE               = (WSABASEERR+70);
-  WSAEREMOTE              = (WSABASEERR+71);
-
-{ Extended Windows Sockets error constant definitions }
-
-  WSASYSNOTREADY          = (WSABASEERR+91);
-  WSAVERNOTSUPPORTED      = (WSABASEERR+92);
-  WSANOTINITIALISED       = (WSABASEERR+93);
-  WSAEDISCON              = (WSABASEERR+101);
-  WSAENOMORE              = (WSABASEERR+102);
-  WSAECANCELLED           = (WSABASEERR+103);
-  WSAEEINVALIDPROCTABLE   = (WSABASEERR+104);
-  WSAEINVALIDPROVIDER     = (WSABASEERR+105);
-  WSAEPROVIDERFAILEDINIT  = (WSABASEERR+106);
-  WSASYSCALLFAILURE       = (WSABASEERR+107);
-  WSASERVICE_NOT_FOUND    = (WSABASEERR+108);
-  WSATYPE_NOT_FOUND       = (WSABASEERR+109);
-  WSA_E_NO_MORE           = (WSABASEERR+110);
-  WSA_E_CANCELLED         = (WSABASEERR+111);
-  WSAEREFUSED             = (WSABASEERR+112);
-
-{ Error return codes from gethostbyname() and gethostbyaddr()
-  (when using the resolver). Note that these errors are
-  retrieved via WSAGetLastError() and must therefore follow
-  the rules for avoiding clashes with error numbers from
-  specific implementations or language run-time systems.
-  For this reason the codes are based at WSABASEERR+1001.
-  Note also that [WSA]NO_ADDRESS is defined only for
-  compatibility purposes. }
-
-{ Authoritative Answer: Host not found }
-  WSAHOST_NOT_FOUND       = (WSABASEERR+1001);
-  HOST_NOT_FOUND          = WSAHOST_NOT_FOUND;
-{ Non-Authoritative: Host not found, or SERVERFAIL }
-  WSATRY_AGAIN            = (WSABASEERR+1002);
-  TRY_AGAIN               = WSATRY_AGAIN;
-{ Non recoverable errors, FORMERR, REFUSED, NOTIMP }
-  WSANO_RECOVERY          = (WSABASEERR+1003);
-  NO_RECOVERY             = WSANO_RECOVERY;
-{ Valid name, no data record of requested type }
-  WSANO_DATA              = (WSABASEERR+1004);
-  NO_DATA                 = WSANO_DATA;
-{ no address, look for MX record }
-  WSANO_ADDRESS           = WSANO_DATA;
-  NO_ADDRESS              = WSANO_ADDRESS;
-
-  EWOULDBLOCK        =  WSAEWOULDBLOCK;
-  EINPROGRESS        =  WSAEINPROGRESS;
-  EALREADY           =  WSAEALREADY;
-  ENOTSOCK           =  WSAENOTSOCK;
-  EDESTADDRREQ       =  WSAEDESTADDRREQ;
-  EMSGSIZE           =  WSAEMSGSIZE;
-  EPROTOTYPE         =  WSAEPROTOTYPE;
-  ENOPROTOOPT        =  WSAENOPROTOOPT;
-  EPROTONOSUPPORT    =  WSAEPROTONOSUPPORT;
-  ESOCKTNOSUPPORT    =  WSAESOCKTNOSUPPORT;
-  EOPNOTSUPP         =  WSAEOPNOTSUPP;
-  EPFNOSUPPORT       =  WSAEPFNOSUPPORT;
-  EAFNOSUPPORT       =  WSAEAFNOSUPPORT;
-  EADDRINUSE         =  WSAEADDRINUSE;
-  EADDRNOTAVAIL      =  WSAEADDRNOTAVAIL;
-  ENETDOWN           =  WSAENETDOWN;
-  ENETUNREACH        =  WSAENETUNREACH;
-  ENETRESET          =  WSAENETRESET;
-  ECONNABORTED       =  WSAECONNABORTED;
-  ECONNRESET         =  WSAECONNRESET;
-  ENOBUFS            =  WSAENOBUFS;
-  EISCONN            =  WSAEISCONN;
-  ENOTCONN           =  WSAENOTCONN;
-  ESHUTDOWN          =  WSAESHUTDOWN;
-  ETOOMANYREFS       =  WSAETOOMANYREFS;
-  ETIMEDOUT          =  WSAETIMEDOUT;
-  ECONNREFUSED       =  WSAECONNREFUSED;
-  ELOOP              =  WSAELOOP;
-  ENAMETOOLONG       =  WSAENAMETOOLONG;
-  EHOSTDOWN          =  WSAEHOSTDOWN;
-  EHOSTUNREACH       =  WSAEHOSTUNREACH;
-  ENOTEMPTY          =  WSAENOTEMPTY;
-  EPROCLIM           =  WSAEPROCLIM;
-  EUSERS             =  WSAEUSERS;
-  EDQUOT             =  WSAEDQUOT;
-  ESTALE             =  WSAESTALE;
-  EREMOTE            =  WSAEREMOTE;
-
-  EAI_ADDRFAMILY  = 1;   // Address family for nodename not supported.
-  EAI_AGAIN       = 2;   // Temporary failure in name resolution.
-  EAI_BADFLAGS    = 3;   // Invalid value for ai_flags.
-  EAI_FAIL        = 4;   // Non-recoverable failure in name resolution.
-  EAI_FAMILY      = 5;   // Address family ai_family not supported.
-  EAI_MEMORY      = 6;   // Memory allocation failure.
-  EAI_NODATA      = 7;   // No address associated with nodename.
-  EAI_NONAME      = 8;   // Nodename nor servname provided, or not known.
-  EAI_SERVICE     = 9;   // Servname not supported for ai_socktype.
-  EAI_SOCKTYPE    = 10;  // Socket type ai_socktype not supported.
-  EAI_SYSTEM      = 11;  // System error returned in errno.
-
-const
-  WSADESCRIPTION_LEN     =   256;
-  WSASYS_STATUS_LEN      =   128;
-type
-  PWSAData = ^TWSAData;
-  TWSAData = record
-    wVersion: Word;
-    wHighVersion: Word;
-{$ifdef win64}
-    iMaxSockets : Word;
-    iMaxUdpDg : Word;
-    lpVendorInfo : PAnsiChar;
-    szDescription : array[0..WSADESCRIPTION_LEN] of AnsiChar;
-    szSystemStatus : array[0..WSASYS_STATUS_LEN] of AnsiChar;
-{$else}     
-    szDescription: array[0..WSADESCRIPTION_LEN] of AnsiChar;
-    szSystemStatus: array[0..WSASYS_STATUS_LEN] of AnsiChar;
-    iMaxSockets: Word;
-    iMaxUdpDg: Word;
-    lpVendorInfo: PAnsiChar;
-{$endif}
-  end;
-
-  function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
-  function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
-  function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
-  function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
-  function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
-  function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6):boolean;
-  procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
-  procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
-var
-  in6addr_any, in6addr_loopback : TInAddr6;
-
-procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet);
-function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean;
-procedure FD_SET(Socket: TSocket; var FDSet: TFDSet);
-procedure FD_ZERO(var FDSet: TFDSet);
-
-{=============================================================================}
-
-type
-  TWSAStartup = function(wVersionRequired: Word; var WSData: TWSAData): Integer;
-    stdcall;
-  TWSACleanup = function: Integer;
-    stdcall;
-  TWSAGetLastError = function: Integer;
-    stdcall;
-  TGetServByName = function(name, proto: PAnsiChar): PServEnt;
-    stdcall;
-  TGetServByPort = function(port: Integer; proto: PAnsiChar): PServEnt;
-    stdcall;
-  TGetProtoByName = function(name: PAnsiChar): PProtoEnt;
-    stdcall;
-  TGetProtoByNumber = function(proto: Integer): PProtoEnt;
-    stdcall;
-  TGetHostByName = function(name: PAnsiChar): PHostEnt;
-    stdcall;
-  TGetHostByAddr = function(addr: Pointer; len, Struc: Integer): PHostEnt;
-    stdcall;
-  TGetHostName = function(name: PAnsiChar; len: Integer): Integer;
-    stdcall;
-  TShutdown = function(s: TSocket; how: Integer): Integer;
-    stdcall;
-  TSetSockOpt = function(s: TSocket; level, optname: Integer; optval: PAnsiChar;
-    optlen: Integer): Integer;
-    stdcall;
-  TGetSockOpt = function(s: TSocket; level, optname: Integer; optval: PAnsiChar;
-    var optlen: Integer): Integer;
-    stdcall;
-  TSendTo = function(s: TSocket; const Buf; len, flags: Integer; addrto: PSockAddr;
-    tolen: Integer): Integer;
-    stdcall;
-  TSend = function(s: TSocket; const Buf; len, flags: Integer): Integer;
-    stdcall;
-  TRecv = function(s: TSocket; var Buf; len, flags: Integer): Integer;
-    stdcall;
-  TRecvFrom = function(s: TSocket; var Buf; len, flags: Integer; from: PSockAddr;
-    var fromlen: Integer): Integer;
-    stdcall;
-  Tntohs = function(netshort: u_short): u_short;
-    stdcall;
-  Tntohl = function(netlong: u_long): u_long;
-    stdcall;
-  TListen = function(s: TSocket; backlog: Integer): Integer;
-    stdcall;
-  TIoctlSocket = function(s: TSocket; cmd: DWORD; var arg: Integer): Integer;
-    stdcall;
-  TInet_ntoa = function(inaddr: TInAddr): PAnsiChar;
-    stdcall;
-  TInet_addr = function(cp: PAnsiChar): u_long;
-    stdcall;
-  Thtons = function(hostshort: u_short): u_short;
-    stdcall;
-  Thtonl = function(hostlong: u_long): u_long;
-    stdcall;
-  TGetSockName = function(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
-    stdcall;
-  TGetPeerName = function(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
-    stdcall;
-  TConnect = function(s: TSocket; name: PSockAddr; namelen: Integer): Integer;
-    stdcall;
-  TCloseSocket = function(s: TSocket): Integer;
-    stdcall;
-  TBind = function(s: TSocket; addr: PSockAddr; namelen: Integer): Integer;
-    stdcall;
-  TAccept = function(s: TSocket; addr: PSockAddr; var addrlen: Integer): TSocket;
-    stdcall;
-  TTSocket = function(af, Struc, Protocol: Integer): TSocket;
-    stdcall;
-  TSelect = function(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
-    timeout: PTimeVal): Longint;
-    stdcall;
-
-  TGetAddrInfo = function(NodeName: PAnsiChar; ServName: PAnsiChar; Hints: PAddrInfo;
-    var Addrinfo: PAddrInfo): integer;
-    stdcall;
-  TFreeAddrInfo = procedure(ai: PAddrInfo);
-    stdcall;
-  TGetNameInfo = function( addr: PSockAddr; namelen: Integer; host: PAnsiChar;
-    hostlen: DWORD; serv: PAnsiChar; servlen: DWORD; flags: integer): integer;
-    stdcall;
-
-  T__WSAFDIsSet = function (s: TSocket; var FDSet: TFDSet): Bool;
-    stdcall;
-
-  TWSAIoctl = function (s: TSocket; dwIoControlCode: DWORD; lpvInBuffer: Pointer;
-    cbInBuffer: DWORD; lpvOutBuffer: Pointer; cbOutBuffer: DWORD;
-    lpcbBytesReturned: PDWORD; lpOverlapped: Pointer;
-    lpCompletionRoutine: pointer): u_int;
-    stdcall;
-
-var
-  WSAStartup: TWSAStartup = nil;
-  WSACleanup: TWSACleanup = nil;
-  WSAGetLastError: TWSAGetLastError = nil;
-  GetServByName: TGetServByName = nil;
-  GetServByPort: TGetServByPort = nil;
-  GetProtoByName: TGetProtoByName = nil;
-  GetProtoByNumber: TGetProtoByNumber = nil;
-  GetHostByName: TGetHostByName = nil;
-  GetHostByAddr: TGetHostByAddr = nil;
-  ssGetHostName: TGetHostName = nil;
-  Shutdown: TShutdown = nil;
-  SetSockOpt: TSetSockOpt = nil;
-  GetSockOpt: TGetSockOpt = nil;
-  ssSendTo: TSendTo = nil;
-  ssSend: TSend = nil;
-  ssRecv: TRecv = nil;
-  ssRecvFrom: TRecvFrom = nil;
-  ntohs: Tntohs = nil;
-  ntohl: Tntohl = nil;
-  Listen: TListen = nil;
-  IoctlSocket: TIoctlSocket = nil;
-  Inet_ntoa: TInet_ntoa = nil;
-  Inet_addr: TInet_addr = nil;
-  htons: Thtons = nil;
-  htonl: Thtonl = nil;
-  ssGetSockName: TGetSockName = nil;
-  ssGetPeerName: TGetPeerName = nil;
-  ssConnect: TConnect = nil;
-  CloseSocket: TCloseSocket = nil;
-  ssBind: TBind = nil;
-  ssAccept: TAccept = nil;
-  Socket: TTSocket = nil;
-  Select: TSelect = nil;
-
-  GetAddrInfo: TGetAddrInfo = nil;
-  FreeAddrInfo: TFreeAddrInfo = nil;
-  GetNameInfo: TGetNameInfo = nil;
-
-  __WSAFDIsSet: T__WSAFDIsSet = nil;
-
-  WSAIoctl: TWSAIoctl = nil;
-
-var
-  SynSockCS: SyncObjs.TCriticalSection;
-  SockEnhancedApi: Boolean;
-  SockWship6Api: Boolean;
-
-type
-  TVarSin = packed record
-    case integer of
-      0: (AddressFamily: u_short);
-      1: (
-        case sin_family: u_short of
-          AF_INET: (sin_port: u_short;
-                    sin_addr: TInAddr;
-                    sin_zero: array[0..7] of byte);
-          AF_INET6: (sin6_port:     u_short;
-                		sin6_flowinfo: u_long;
-      	    	      sin6_addr:     TInAddr6;
-      		          sin6_scope_id: u_long);
-          );
-  end;
-
-function SizeOfVarSin(sin: TVarSin): integer;
-
-function Bind(s: TSocket; const addr: TVarSin): Integer;
-function Connect(s: TSocket; const name: TVarSin): Integer;
-function GetSockName(s: TSocket; var name: TVarSin): Integer;
-function GetPeerName(s: TSocket; var name: TVarSin): Integer;
-function GetHostName: AnsiString;
-function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
-function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
-function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
-function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
-function Accept(s: TSocket; var addr: TVarSin): TSocket;
-
-function IsNewApi(Family: integer): Boolean;
-function SetVarSin(var Sin: TVarSin; IP, Port: AnsiString; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
-function GetSinIP(Sin: TVarSin): AnsiString;
-function GetSinPort(Sin: TVarSin): Integer;
-procedure ResolveNameToIP(Name: AnsiString;  Family, SockProtocol, SockType: integer; const IPList: TStrings);
-function ResolveIPToName(IP: AnsiString; Family, SockProtocol, SockType: integer): AnsiString;
-function ResolvePort(Port: AnsiString; Family, SockProtocol, SockType: integer): Word;
-
-{==============================================================================}
-implementation
-
-var
-  SynSockCount: Integer = 0;
-  LibHandle: THandle = 0;
-  Libwship6Handle: THandle = 0;
-
-function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
-begin
-  Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
-             (a^.u6_addr32[2] = 0) and (a^.u6_addr32[3] = 0));
-end;
-
-function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
-begin
-  Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
-             (a^.u6_addr32[2] = 0) and
-             (a^.u6_addr8[12] = 0) and (a^.u6_addr8[13] = 0) and
-             (a^.u6_addr8[14] = 0) and (a^.u6_addr8[15] = 1));
-end;
-
-function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
-begin
-  Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $80));
-end;
-
-function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
-begin
-  Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $C0));
-end;
-
-function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
-begin
-  Result := (a^.u6_addr8[0] = $FF);
-end;
-
-function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6): boolean;
-begin
-  Result := (CompareMem( a, b, sizeof(TInAddr6)));
-end;
-
-procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
-begin
-  FillChar(a^, sizeof(TInAddr6), 0);
-end;
-
-procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
-begin
-  FillChar(a^, sizeof(TInAddr6), 0);
-  a^.u6_addr8[15] := 1;
-end;
-
-{=============================================================================}
-procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet);
-var
-  I: Integer;
-begin
-  I := 0;
-  while I < FDSet.fd_count do
-  begin
-    if FDSet.fd_array[I] = Socket then
-    begin
-      while I < FDSet.fd_count - 1 do
-      begin
-        FDSet.fd_array[I] := FDSet.fd_array[I + 1];
-        Inc(I);
-      end;
-      Dec(FDSet.fd_count);
-      Break;
-    end;
-    Inc(I);
-  end;
-end;
-
-function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean;
-begin
-  Result := __WSAFDIsSet(Socket, FDSet);
-end;
-
-procedure FD_SET(Socket: TSocket; var FDSet: TFDSet);
-begin
-  if FDSet.fd_count < FD_SETSIZE then
-  begin
-    FDSet.fd_array[FDSet.fd_count] := Socket;
-    Inc(FDSet.fd_count);
-  end;
-end;
-
-procedure FD_ZERO(var FDSet: TFDSet);
-begin
-  FDSet.fd_count := 0;
-end;
-
-{=============================================================================}
-
-function SizeOfVarSin(sin: TVarSin): integer;
-begin
-  case sin.sin_family of
-    AF_INET:
-            Result := SizeOf(TSockAddrIn);
-    AF_INET6:
-            Result := SizeOf(TSockAddrIn6);
-  else
-    Result := 0;
-  end;
-end;
-
-{=============================================================================}
-
-function Bind(s: TSocket; const addr: TVarSin): Integer;
-begin
-  Result := ssBind(s, @addr, SizeOfVarSin(addr));
-end;
-
-function Connect(s: TSocket; const name: TVarSin): Integer;
-begin
-  Result := ssConnect(s, @name, SizeOfVarSin(name));
-end;
-
-function GetSockName(s: TSocket; var name: TVarSin): Integer;
-var
-  len: integer;
-begin
-  len := SizeOf(name);
-  FillChar(name, len, 0);
-  Result := ssGetSockName(s, @name, Len);
-end;
-
-function GetPeerName(s: TSocket; var name: TVarSin): Integer;
-var
-  len: integer;
-begin
-  len := SizeOf(name);
-  FillChar(name, len, 0);
-  Result := ssGetPeerName(s, @name, Len);
-end;
-
-function GetHostName: AnsiString;
-var
-  s: AnsiString;
-begin
-  Result := '';
-  setlength(s, 255);
-  ssGetHostName(pAnsichar(s), Length(s) - 1);
-  Result := PAnsichar(s);
-end;
-
-function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
-begin
-  Result := ssSend(s, Buf^, len, flags);
-end;
-
-function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
-begin
-  Result := ssRecv(s, Buf^, len, flags);
-end;
-
-function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
-begin
-  Result := ssSendTo(s, Buf^, len, flags, @addrto, SizeOfVarSin(addrto));
-end;
-
-function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
-var
-  x: integer;
-begin
-  x := SizeOf(from);
-  Result := ssRecvFrom(s, Buf^, len, flags, @from, x);
-end;
-
-function Accept(s: TSocket; var addr: TVarSin): TSocket;
-var
-  x: integer;
-begin
-  x := SizeOf(addr);
-  Result := ssAccept(s, @addr, x);
-end;
-
-{=============================================================================}
-function IsNewApi(Family: integer): Boolean;
-begin
-  Result := SockEnhancedApi;
-  if not Result then
-    Result := (Family = AF_INET6) and SockWship6Api;
-end;
-
-function SetVarSin(var Sin: TVarSin; IP, Port: AnsiString; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
-type
-  pu_long = ^u_long;
-var
-  ProtoEnt: PProtoEnt;
-  ServEnt: PServEnt;
-  HostEnt: PHostEnt;
-  r: integer;
-  Hints1, Hints2: TAddrInfo;
-  Sin1, Sin2: TVarSin;
-  TwoPass: boolean;
-
-  function GetAddr(const IP, port: AnsiString; Hints: TAddrInfo; var Sin: TVarSin): integer;
-  var
-    Addr: PAddrInfo;
-  begin
-    Addr := nil;
-    try
-      FillChar(Sin, Sizeof(Sin), 0);
-      if Hints.ai_socktype = SOCK_RAW then
-      begin
-        Hints.ai_socktype := 0;
-        Hints.ai_protocol := 0;
-        Result := synsock.GetAddrInfo(PAnsiChar(IP), nil, @Hints, Addr);
-      end
-      else
-      begin
-        if (IP = cAnyHost) or (IP = c6AnyHost) then
-        begin
-          Hints.ai_flags := AI_PASSIVE;
-          Result := synsock.GetAddrInfo(nil, PAnsiChar(Port), @Hints, Addr);
-        end
-        else
-          if (IP = cLocalhost) or (IP = c6Localhost) then
-          begin
-            Result := synsock.GetAddrInfo(nil, PAnsiChar(Port), @Hints, Addr);
-          end
-          else
-          begin
-            Result := synsock.GetAddrInfo(PAnsiChar(IP), PAnsiChar(Port), @Hints, Addr);
-          end;
-      end;
-      if Result = 0 then
-        if (Addr <> nil) then
-          Move(Addr^.ai_addr^, Sin, Addr^.ai_addrlen);
-    finally
-      if Assigned(Addr) then
-        synsock.FreeAddrInfo(Addr);
-    end;
-  end;
-
-begin
-  Result := 0;
-  FillChar(Sin, Sizeof(Sin), 0);
-  if not IsNewApi(family) then
-  begin
-    SynSockCS.Enter;
-    try
-      Sin.sin_family := AF_INET;
-      ProtoEnt := synsock.GetProtoByNumber(SockProtocol);
-      ServEnt := nil;
-      if (ProtoEnt <> nil) and (StrToIntDef(string(Port),-1) =-1) then
-        ServEnt := synsock.GetServByName(PAnsiChar(Port), ProtoEnt^.p_name);
-      if ServEnt = nil then
-        Sin.sin_port := synsock.htons(StrToIntDef(string(Port), 0))
-      else
-        Sin.sin_port := ServEnt^.s_port;
-      if IP = cBroadcast then
-        Sin.sin_addr.s_addr := u_long(INADDR_BROADCAST)
-      else
-      begin
-        Sin.sin_addr.s_addr := synsock.inet_addr(PAnsiChar(IP));
-        if Sin.sin_addr.s_addr = u_long(INADDR_NONE) then
-        begin
-          HostEnt := synsock.GetHostByName(PAnsiChar(IP));
-          Result := synsock.WSAGetLastError;
-          if HostEnt <> nil then
-            Sin.sin_addr.S_addr := u_long(Pu_long(HostEnt^.h_addr_list^)^);
-        end;
-      end;
-    finally
-      SynSockCS.Leave;
-    end;
-  end
-  else
-  begin
-    FillChar(Hints1, Sizeof(Hints1), 0);
-    FillChar(Hints2, Sizeof(Hints2), 0);
-    TwoPass := False;
-    if Family = AF_UNSPEC then
-    begin
-      if PreferIP4 then
-      begin
-        Hints1.ai_family := AF_INET;
-        Hints2.ai_family := AF_INET6;
-        TwoPass := True;
-      end
-      else
-      begin
-        Hints2.ai_family := AF_INET;
-        Hints1.ai_family := AF_INET6;
-        TwoPass := True;
-      end;
-    end
-    else
-      Hints1.ai_family := Family;
-
-    Hints1.ai_socktype := SockType;
-    Hints1.ai_protocol := SockProtocol;
-    Hints2.ai_socktype := Hints1.ai_socktype;
-    Hints2.ai_protocol := Hints1.ai_protocol;
-
-    r := GetAddr(IP, Port, Hints1, Sin1);
-    Result := r;
-    sin := sin1;
-    if r <> 0 then
-      if TwoPass then
-      begin
-        r := GetAddr(IP, Port, Hints2, Sin2);
-        Result := r;
-        if r = 0 then
-          sin := sin2;
-      end;
-  end;
-end;
-
-function GetSinIP(Sin: TVarSin): AnsiString;
-var
-  p: PAnsiChar;
-  host, serv: AnsiString;
-  hostlen, servlen: integer;
-  r: integer;
-begin
-  Result := '';
-  if not IsNewApi(Sin.AddressFamily) then
-  begin
-    p := synsock.inet_ntoa(Sin.sin_addr);
-    if p <> nil then
-      Result := p;
-  end
-  else
-  begin
-    hostlen := NI_MAXHOST;
-    servlen := NI_MAXSERV;
-    setlength(host, hostlen);
-    setlength(serv, servlen);
-    r := getnameinfo(@sin, SizeOfVarSin(sin), PAnsiChar(host), hostlen,
-      PAnsiChar(serv), servlen, NI_NUMERICHOST + NI_NUMERICSERV);
-    if r = 0 then
-      Result := PAnsiChar(host);
-  end;
-end;
-
-function GetSinPort(Sin: TVarSin): Integer;
-begin
-  if (Sin.sin_family = AF_INET6) then
-    Result := synsock.ntohs(Sin.sin6_port)
-  else
-    Result := synsock.ntohs(Sin.sin_port);
-end;
-
-procedure ResolveNameToIP(Name: AnsiString; Family, SockProtocol, SockType: integer; const IPList: TStrings);
-type
-  TaPInAddr = array[0..250] of PInAddr;
-  PaPInAddr = ^TaPInAddr;
-var
-  Hints: TAddrInfo;
-  Addr: PAddrInfo;
-  AddrNext: PAddrInfo;
-  r: integer;
-  host, serv: AnsiString;
-  hostlen, servlen: integer;
-  RemoteHost: PHostEnt;
-  IP: u_long;
-  PAdrPtr: PaPInAddr;
-  i: Integer;
-  s: String;
-  InAddr: TInAddr;
-begin
-  IPList.Clear;
-  if not IsNewApi(Family) then
-  begin
-    IP := synsock.inet_addr(PAnsiChar(Name));
-    if IP = u_long(INADDR_NONE) then
-    begin
-      SynSockCS.Enter;
-      try
-        RemoteHost := synsock.GetHostByName(PAnsiChar(Name));
-        if RemoteHost <> nil then
-        begin
-          PAdrPtr := PAPInAddr(RemoteHost^.h_addr_list);
-          i := 0;
-          while PAdrPtr^[i] <> nil do
-          begin
-            InAddr := PAdrPtr^[i]^;
-            s := Format('%d.%d.%d.%d', [InAddr.S_bytes[0], InAddr.S_bytes[1],
-              InAddr.S_bytes[2], InAddr.S_bytes[3]]);
-            IPList.Add(s);
-            Inc(i);
-          end;
-        end;
-      finally
-        SynSockCS.Leave;
-      end;
-    end
-    else
-      IPList.Add(string(Name));
-  end
-  else
-  begin
-    Addr := nil;
-    try
-      FillChar(Hints, Sizeof(Hints), 0);
-      Hints.ai_family := AF_UNSPEC;
-      Hints.ai_socktype := SockType;
-      Hints.ai_protocol := SockProtocol;
-      Hints.ai_flags := 0;
-      r := synsock.GetAddrInfo(PAnsiChar(Name), nil, @Hints, Addr);
-      if r = 0 then
-      begin
-        AddrNext := Addr;
-        while not(AddrNext = nil) do
-        begin
-          if not(((Family = AF_INET6) and (AddrNext^.ai_family = AF_INET))
-            or ((Family = AF_INET) and (AddrNext^.ai_family = AF_INET6))) then
-          begin
-            hostlen := NI_MAXHOST;
-            servlen := NI_MAXSERV;
-            setlength(host, hostlen);
-            setlength(serv, servlen);
-            r := getnameinfo(AddrNext^.ai_addr, AddrNext^.ai_addrlen,
-              PAnsiChar(host), hostlen, PAnsiChar(serv), servlen,
-              NI_NUMERICHOST + NI_NUMERICSERV);
-            if r = 0 then
-            begin
-              host := PAnsiChar(host);
-              IPList.Add(string(host));
-            end;
-          end;
-          AddrNext := AddrNext^.ai_next;
-        end;
-      end;
-    finally
-      if Assigned(Addr) then
-        synsock.FreeAddrInfo(Addr);
-    end;
-  end;
-  if IPList.Count = 0 then
-    IPList.Add(cAnyHost);
-end;
-
-function ResolvePort(Port: AnsiString; Family, SockProtocol, SockType: integer): Word;
-var
-  ProtoEnt: PProtoEnt;
-  ServEnt: PServEnt;
-  Hints: TAddrInfo;
-  Addr: PAddrInfo;
-  r: integer;
-begin
-  Result := 0;
-  if not IsNewApi(Family) then
-  begin
-    SynSockCS.Enter;
-    try
-      ProtoEnt := synsock.GetProtoByNumber(SockProtocol);
-      ServEnt := nil;
-      if ProtoEnt <> nil then
-        ServEnt := synsock.GetServByName(PAnsiChar(Port), ProtoEnt^.p_name);
-      if ServEnt = nil then
-        Result := StrToIntDef(string(Port), 0)
-      else
-        Result := synsock.htons(ServEnt^.s_port);
-    finally
-      SynSockCS.Leave;
-    end;
-  end
-  else
-  begin
-    Addr := nil;
-    try
-      FillChar(Hints, Sizeof(Hints), 0);
-      Hints.ai_family := AF_UNSPEC;
-      Hints.ai_socktype := SockType;
-      Hints.ai_protocol := Sockprotocol;
-      Hints.ai_flags := AI_PASSIVE;
-      r := synsock.GetAddrInfo(nil, PAnsiChar(Port), @Hints, Addr);
-      if (r = 0) and Assigned(Addr) then
-      begin
-        if Addr^.ai_family = AF_INET then
-          Result := synsock.htons(Addr^.ai_addr^.sin_port);
-        if Addr^.ai_family = AF_INET6 then
-          Result := synsock.htons(PSockAddrIn6(Addr^.ai_addr)^.sin6_port);
-      end;
-    finally
-      if Assigned(Addr) then
-        synsock.FreeAddrInfo(Addr);
-    end;
-  end;
-end;
-
-function ResolveIPToName(IP: AnsiString; Family, SockProtocol, SockType: integer): AnsiString;
-var
-  Hints: TAddrInfo;
-  Addr: PAddrInfo;
-  r: integer;
-  host, serv: AnsiString;
-  hostlen, servlen: integer;
-  RemoteHost: PHostEnt;
-  IPn: u_long;
-begin
-  Result := IP;
-  if not IsNewApi(Family) then
-  begin
-    IPn := synsock.inet_addr(PAnsiChar(IP));
-    if IPn <> u_long(INADDR_NONE) then
-    begin
-      SynSockCS.Enter;
-      try
-        RemoteHost := GetHostByAddr(@IPn, SizeOf(IPn), AF_INET);
-        if RemoteHost <> nil then
-          Result := RemoteHost^.h_name;
-      finally
-        SynSockCS.Leave;
-      end;
-    end;
-  end
-  else
-  begin
-    Addr := nil;
-    try
-      FillChar(Hints, Sizeof(Hints), 0);
-      Hints.ai_family := AF_UNSPEC;
-      Hints.ai_socktype := SockType;
-      Hints.ai_protocol := SockProtocol;
-      Hints.ai_flags := 0;
-      r := synsock.GetAddrInfo(PAnsiChar(IP), nil, @Hints, Addr);
-      if (r = 0) and Assigned(Addr)then
-      begin
-        hostlen := NI_MAXHOST;
-        servlen := NI_MAXSERV;
-        setlength(host, hostlen);
-        setlength(serv, servlen);
-        r := getnameinfo(Addr^.ai_addr, Addr^.ai_addrlen,
-          PAnsiChar(host), hostlen, PAnsiChar(serv), servlen,
-          NI_NUMERICSERV);
-        if r = 0 then
-          Result := PAnsiChar(host);
-      end;
-    finally
-      if Assigned(Addr) then
-        synsock.FreeAddrInfo(Addr);
-    end;
-  end;
-end;
-
-{=============================================================================}
-
-function InitSocketInterface(stack: String): Boolean;
-begin
-  Result := False;
-  SockEnhancedApi := False;
-  if stack = '' then
-    stack := DLLStackName;
-  SynSockCS.Enter;
-  try
-    if SynSockCount = 0 then
-    begin
-      SockEnhancedApi := False;
-      SockWship6Api := False;
-      LibHandle := LoadLibrary(PChar(Stack));
-      if LibHandle <> 0 then
-      begin
-        WSAIoctl := GetProcAddress(LibHandle, PAnsiChar(AnsiString('WSAIoctl')));
-        __WSAFDIsSet := GetProcAddress(LibHandle, PAnsiChar(AnsiString('__WSAFDIsSet')));
-        CloseSocket := GetProcAddress(LibHandle, PAnsiChar(AnsiString('closesocket')));
-        IoctlSocket := GetProcAddress(LibHandle, PAnsiChar(AnsiString('ioctlsocket')));
-        WSAGetLastError := GetProcAddress(LibHandle, PAnsiChar(AnsiString('WSAGetLastError')));
-        WSAStartup := GetProcAddress(LibHandle, PAnsiChar(AnsiString('WSAStartup')));
-        WSACleanup := GetProcAddress(LibHandle, PAnsiChar(AnsiString('WSACleanup')));
-        ssAccept := GetProcAddress(LibHandle, PAnsiChar(AnsiString('accept')));
-        ssBind := GetProcAddress(LibHandle, PAnsiChar(AnsiString('bind')));
-        ssConnect := GetProcAddress(LibHandle, PAnsiChar(AnsiString('connect')));
-        ssGetPeerName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getpeername')));
-        ssGetSockName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getsockname')));
-        GetSockOpt := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getsockopt')));
-        Htonl := GetProcAddress(LibHandle, PAnsiChar(AnsiString('htonl')));
-        Htons := GetProcAddress(LibHandle, PAnsiChar(AnsiString('htons')));
-        Inet_Addr := GetProcAddress(LibHandle, PAnsiChar(AnsiString('inet_addr')));
-        Inet_Ntoa := GetProcAddress(LibHandle, PAnsiChar(AnsiString('inet_ntoa')));
-        Listen := GetProcAddress(LibHandle, PAnsiChar(AnsiString('listen')));
-        Ntohl := GetProcAddress(LibHandle, PAnsiChar(AnsiString('ntohl')));
-        Ntohs := GetProcAddress(LibHandle, PAnsiChar(AnsiString('ntohs')));
-        ssRecv := GetProcAddress(LibHandle, PAnsiChar(AnsiString('recv')));
-        ssRecvFrom := GetProcAddress(LibHandle, PAnsiChar(AnsiString('recvfrom')));
-        Select := GetProcAddress(LibHandle, PAnsiChar(AnsiString('select')));
-        ssSend := GetProcAddress(LibHandle, PAnsiChar(AnsiString('send')));
-        ssSendTo := GetProcAddress(LibHandle, PAnsiChar(AnsiString('sendto')));
-        SetSockOpt := GetProcAddress(LibHandle, PAnsiChar(AnsiString('setsockopt')));
-        ShutDown := GetProcAddress(LibHandle, PAnsiChar(AnsiString('shutdown')));
-        Socket := GetProcAddress(LibHandle, PAnsiChar(AnsiString('socket')));
-        GetHostByAddr := GetProcAddress(LibHandle, PAnsiChar(AnsiString('gethostbyaddr')));
-        GetHostByName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('gethostbyname')));
-        GetProtoByName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getprotobyname')));
-        GetProtoByNumber := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getprotobynumber')));
-        GetServByName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getservbyname')));
-        GetServByPort := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getservbyport')));
-        ssGetHostName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('gethostname')));
-
-{$IFNDEF FORCEOLDAPI}
-        GetAddrInfo := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getaddrinfo')));
-        FreeAddrInfo := GetProcAddress(LibHandle, PAnsiChar(AnsiString('freeaddrinfo')));
-        GetNameInfo := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getnameinfo')));
-        SockEnhancedApi := Assigned(GetAddrInfo) and Assigned(FreeAddrInfo)
-          and Assigned(GetNameInfo);
-        if not SockEnhancedApi then
-        begin
-          LibWship6Handle := LoadLibrary(PChar(DLLWship6));
-          if LibWship6Handle <> 0 then
-          begin
-            GetAddrInfo := GetProcAddress(LibWship6Handle, PAnsiChar(AnsiString('getaddrinfo')));
-            FreeAddrInfo := GetProcAddress(LibWship6Handle, PAnsiChar(AnsiString('freeaddrinfo')));
-            GetNameInfo := GetProcAddress(LibWship6Handle, PAnsiChar(AnsiString('getnameinfo')));
-            SockWship6Api := Assigned(GetAddrInfo) and Assigned(FreeAddrInfo)
-              and Assigned(GetNameInfo);
-          end;
-        end;
-{$ENDIF}
-        Result := True;
-      end;
-    end
-    else Result := True;
-    if Result then
-      Inc(SynSockCount);
-  finally
-    SynSockCS.Leave;
-  end;
-end;
-
-function DestroySocketInterface: Boolean;
-begin
-  SynSockCS.Enter;
-  try
-    Dec(SynSockCount);
-    if SynSockCount < 0 then
-      SynSockCount := 0;
-    if SynSockCount = 0 then
-    begin
-      if LibHandle <> 0 then
-      begin
-        FreeLibrary(libHandle);
-        LibHandle := 0;
-      end;
-      if LibWship6Handle <> 0 then
-      begin
-        FreeLibrary(LibWship6Handle);
-        LibWship6Handle := 0;
-      end;
-    end;
-  finally
-    SynSockCS.Leave;
-  end;
-  Result := True;
-end;
-
-initialization
-begin
-  SynSockCS := SyncObjs.TCriticalSection.Create;
-  SET_IN6_IF_ADDR_ANY (@in6addr_any);
-  SET_LOOPBACK_ADDR6  (@in6addr_loopback);
-end;
-
-finalization
-begin
-  SynSockCS.Free;
+{==============================================================================|
+| Project : Ararat Synapse                                       | 002.002.003 |
+|==============================================================================|
+| Content: Socket Independent Platform Layer - Win32 definition include        |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2003-2010.                |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@exclude}
+
+//{$DEFINE WINSOCK1}
+{Note about define WINSOCK1:
+If you activate this compiler directive, then socket interface level 1.1 is
+used instead default level 2.2. Level 2.2 is not available on old W95, however
+you can install update.
+}
+
+//{$DEFINE FORCEOLDAPI}
+{Note about define FORCEOLDAPI:
+If you activate this compiler directive, then is allways used old socket API
+for name resolution. If you leave this directive inactive, then the new API
+is used, when running system allows it.
+
+For IPv6 support you must have new API!
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+{$IFDEF VER125}
+  {$DEFINE BCB}
+{$ENDIF}
+{$IFDEF BCB}
+  {$ObjExportAll On}
+  (*$HPPEMIT '/* EDE 2003-02-19 */' *)
+  (*$HPPEMIT 'namespace Synsock { using System::Shortint; }' *)
+  (*$HPPEMIT '#undef h_addr' *)
+  (*$HPPEMIT '#undef IOCPARM_MASK' *)
+  (*$HPPEMIT '#undef FD_SETSIZE' *)
+  (*$HPPEMIT '#undef IOC_VOID' *)
+  (*$HPPEMIT '#undef IOC_OUT' *)
+  (*$HPPEMIT '#undef IOC_IN' *)
+  (*$HPPEMIT '#undef IOC_INOUT' *)
+  (*$HPPEMIT '#undef FIONREAD' *)
+  (*$HPPEMIT '#undef FIONBIO' *)
+  (*$HPPEMIT '#undef FIOASYNC' *)
+  (*$HPPEMIT '#undef IPPROTO_IP' *)
+  (*$HPPEMIT '#undef IPPROTO_ICMP' *)
+  (*$HPPEMIT '#undef IPPROTO_IGMP' *)
+  (*$HPPEMIT '#undef IPPROTO_TCP' *)
+  (*$HPPEMIT '#undef IPPROTO_UDP' *)
+  (*$HPPEMIT '#undef IPPROTO_RAW' *)
+  (*$HPPEMIT '#undef IPPROTO_MAX' *)
+  (*$HPPEMIT '#undef INADDR_ANY' *)
+  (*$HPPEMIT '#undef INADDR_LOOPBACK' *)
+  (*$HPPEMIT '#undef INADDR_BROADCAST' *)
+  (*$HPPEMIT '#undef INADDR_NONE' *)
+  (*$HPPEMIT '#undef INVALID_SOCKET' *)
+  (*$HPPEMIT '#undef SOCKET_ERROR' *)
+  (*$HPPEMIT '#undef WSADESCRIPTION_LEN' *)
+  (*$HPPEMIT '#undef WSASYS_STATUS_LEN' *)
+  (*$HPPEMIT '#undef IP_OPTIONS' *)
+  (*$HPPEMIT '#undef IP_TOS' *)
+  (*$HPPEMIT '#undef IP_TTL' *)
+  (*$HPPEMIT '#undef IP_MULTICAST_IF' *)
+  (*$HPPEMIT '#undef IP_MULTICAST_TTL' *)
+  (*$HPPEMIT '#undef IP_MULTICAST_LOOP' *)
+  (*$HPPEMIT '#undef IP_ADD_MEMBERSHIP' *)
+  (*$HPPEMIT '#undef IP_DROP_MEMBERSHIP' *)
+  (*$HPPEMIT '#undef IP_DONTFRAGMENT' *)
+  (*$HPPEMIT '#undef IP_DEFAULT_MULTICAST_TTL' *)
+  (*$HPPEMIT '#undef IP_DEFAULT_MULTICAST_LOOP' *)
+  (*$HPPEMIT '#undef IP_MAX_MEMBERSHIPS' *)
+  (*$HPPEMIT '#undef SOL_SOCKET' *)
+  (*$HPPEMIT '#undef SO_DEBUG' *)
+  (*$HPPEMIT '#undef SO_ACCEPTCONN' *)
+  (*$HPPEMIT '#undef SO_REUSEADDR' *)
+  (*$HPPEMIT '#undef SO_KEEPALIVE' *)
+  (*$HPPEMIT '#undef SO_DONTROUTE' *)
+  (*$HPPEMIT '#undef SO_BROADCAST' *)
+  (*$HPPEMIT '#undef SO_USELOOPBACK' *)
+  (*$HPPEMIT '#undef SO_LINGER' *)
+  (*$HPPEMIT '#undef SO_OOBINLINE' *)
+  (*$HPPEMIT '#undef SO_DONTLINGER' *)
+  (*$HPPEMIT '#undef SO_SNDBUF' *)
+  (*$HPPEMIT '#undef SO_RCVBUF' *)
+  (*$HPPEMIT '#undef SO_SNDLOWAT' *)
+  (*$HPPEMIT '#undef SO_RCVLOWAT' *)
+  (*$HPPEMIT '#undef SO_SNDTIMEO' *)
+  (*$HPPEMIT '#undef SO_RCVTIMEO' *)
+  (*$HPPEMIT '#undef SO_ERROR' *)
+  (*$HPPEMIT '#undef SO_OPENTYPE' *)
+  (*$HPPEMIT '#undef SO_SYNCHRONOUS_ALERT' *)
+  (*$HPPEMIT '#undef SO_SYNCHRONOUS_NONALERT' *)
+  (*$HPPEMIT '#undef SO_MAXDG' *)
+  (*$HPPEMIT '#undef SO_MAXPATHDG' *)
+  (*$HPPEMIT '#undef SO_UPDATE_ACCEPT_CONTEXT' *)
+  (*$HPPEMIT '#undef SO_CONNECT_TIME' *)
+  (*$HPPEMIT '#undef SO_TYPE' *)
+  (*$HPPEMIT '#undef SOCK_STREAM' *)
+  (*$HPPEMIT '#undef SOCK_DGRAM' *)
+  (*$HPPEMIT '#undef SOCK_RAW' *)
+  (*$HPPEMIT '#undef SOCK_RDM' *)
+  (*$HPPEMIT '#undef SOCK_SEQPACKET' *)
+  (*$HPPEMIT '#undef TCP_NODELAY' *)
+  (*$HPPEMIT '#undef AF_UNSPEC' *)
+  (*$HPPEMIT '#undef SOMAXCONN' *)
+  (*$HPPEMIT '#undef AF_INET' *)
+  (*$HPPEMIT '#undef AF_MAX' *)
+  (*$HPPEMIT '#undef PF_UNSPEC' *)
+  (*$HPPEMIT '#undef PF_INET' *)
+  (*$HPPEMIT '#undef PF_MAX' *)
+  (*$HPPEMIT '#undef MSG_OOB' *)
+  (*$HPPEMIT '#undef MSG_PEEK' *)
+  (*$HPPEMIT '#undef WSABASEERR' *)
+  (*$HPPEMIT '#undef WSAEINTR' *)
+  (*$HPPEMIT '#undef WSAEBADF' *)
+  (*$HPPEMIT '#undef WSAEACCES' *)
+  (*$HPPEMIT '#undef WSAEFAULT' *)
+  (*$HPPEMIT '#undef WSAEINVAL' *)
+  (*$HPPEMIT '#undef WSAEMFILE' *)
+  (*$HPPEMIT '#undef WSAEWOULDBLOCK' *)
+  (*$HPPEMIT '#undef WSAEINPROGRESS' *)
+  (*$HPPEMIT '#undef WSAEALREADY' *)
+  (*$HPPEMIT '#undef WSAENOTSOCK' *)
+  (*$HPPEMIT '#undef WSAEDESTADDRREQ' *)
+  (*$HPPEMIT '#undef WSAEMSGSIZE' *)
+  (*$HPPEMIT '#undef WSAEPROTOTYPE' *)
+  (*$HPPEMIT '#undef WSAENOPROTOOPT' *)
+  (*$HPPEMIT '#undef WSAEPROTONOSUPPORT' *)
+  (*$HPPEMIT '#undef WSAESOCKTNOSUPPORT' *)
+  (*$HPPEMIT '#undef WSAEOPNOTSUPP' *)
+  (*$HPPEMIT '#undef WSAEPFNOSUPPORT' *)
+  (*$HPPEMIT '#undef WSAEAFNOSUPPORT' *)
+  (*$HPPEMIT '#undef WSAEADDRINUSE' *)
+  (*$HPPEMIT '#undef WSAEADDRNOTAVAIL' *)
+  (*$HPPEMIT '#undef WSAENETDOWN' *)
+  (*$HPPEMIT '#undef WSAENETUNREACH' *)
+  (*$HPPEMIT '#undef WSAENETRESET' *)
+  (*$HPPEMIT '#undef WSAECONNABORTED' *)
+  (*$HPPEMIT '#undef WSAECONNRESET' *)
+  (*$HPPEMIT '#undef WSAENOBUFS' *)
+  (*$HPPEMIT '#undef WSAEISCONN' *)
+  (*$HPPEMIT '#undef WSAENOTCONN' *)
+  (*$HPPEMIT '#undef WSAESHUTDOWN' *)
+  (*$HPPEMIT '#undef WSAETOOMANYREFS' *)
+  (*$HPPEMIT '#undef WSAETIMEDOUT' *)
+  (*$HPPEMIT '#undef WSAECONNREFUSED' *)
+  (*$HPPEMIT '#undef WSAELOOP' *)
+  (*$HPPEMIT '#undef WSAENAMETOOLONG' *)
+  (*$HPPEMIT '#undef WSAEHOSTDOWN' *)
+  (*$HPPEMIT '#undef WSAEHOSTUNREACH' *)
+  (*$HPPEMIT '#undef WSAENOTEMPTY' *)
+  (*$HPPEMIT '#undef WSAEPROCLIM' *)
+  (*$HPPEMIT '#undef WSAEUSERS' *)
+  (*$HPPEMIT '#undef WSAEDQUOT' *)
+  (*$HPPEMIT '#undef WSAESTALE' *)
+  (*$HPPEMIT '#undef WSAEREMOTE' *)
+  (*$HPPEMIT '#undef WSASYSNOTREADY' *)
+  (*$HPPEMIT '#undef WSAVERNOTSUPPORTED' *)
+  (*$HPPEMIT '#undef WSANOTINITIALISED' *)
+  (*$HPPEMIT '#undef WSAEDISCON' *)
+  (*$HPPEMIT '#undef WSAENOMORE' *)
+  (*$HPPEMIT '#undef WSAECANCELLED' *)
+  (*$HPPEMIT '#undef WSAEEINVALIDPROCTABLE' *)
+  (*$HPPEMIT '#undef WSAEINVALIDPROVIDER' *)
+  (*$HPPEMIT '#undef WSAEPROVIDERFAILEDINIT' *)
+  (*$HPPEMIT '#undef WSASYSCALLFAILURE' *)
+  (*$HPPEMIT '#undef WSASERVICE_NOT_FOUND' *)
+  (*$HPPEMIT '#undef WSATYPE_NOT_FOUND' *)
+  (*$HPPEMIT '#undef WSA_E_NO_MORE' *)
+  (*$HPPEMIT '#undef WSA_E_CANCELLED' *)
+  (*$HPPEMIT '#undef WSAEREFUSED' *)
+  (*$HPPEMIT '#undef WSAHOST_NOT_FOUND' *)
+  (*$HPPEMIT '#undef HOST_NOT_FOUND' *)
+  (*$HPPEMIT '#undef WSATRY_AGAIN' *)
+  (*$HPPEMIT '#undef TRY_AGAIN' *)
+  (*$HPPEMIT '#undef WSANO_RECOVERY' *)
+  (*$HPPEMIT '#undef NO_RECOVERY' *)
+  (*$HPPEMIT '#undef WSANO_DATA' *)
+  (*$HPPEMIT '#undef NO_DATA' *)
+  (*$HPPEMIT '#undef WSANO_ADDRESS' *)
+  (*$HPPEMIT '#undef ENAMETOOLONG' *)
+  (*$HPPEMIT '#undef ENOTEMPTY' *)
+  (*$HPPEMIT '#undef FD_CLR' *)
+  (*$HPPEMIT '#undef FD_ISSET' *)
+  (*$HPPEMIT '#undef FD_SET' *)
+  (*$HPPEMIT '#undef FD_ZERO' *)
+  (*$HPPEMIT '#undef NO_ADDRESS' *)
+  (*$HPPEMIT '#undef ADDR_ANY' *)
+  (*$HPPEMIT '#undef SO_GROUP_ID' *)
+  (*$HPPEMIT '#undef SO_GROUP_PRIORITY' *)
+  (*$HPPEMIT '#undef SO_MAX_MSG_SIZE' *)
+  (*$HPPEMIT '#undef SO_PROTOCOL_INFOA' *)
+  (*$HPPEMIT '#undef SO_PROTOCOL_INFOW' *)
+  (*$HPPEMIT '#undef SO_PROTOCOL_INFO' *)
+  (*$HPPEMIT '#undef PVD_CONFIG' *)
+  (*$HPPEMIT '#undef AF_INET6' *)
+  (*$HPPEMIT '#undef PF_INET6' *)
+{$ENDIF}
+
+interface
+
+uses
+  SyncObjs, SysUtils, Classes,
+  Windows;
+
+function InitSocketInterface(stack: String): Boolean;
+function DestroySocketInterface: Boolean;
+
+const
+{$IFDEF WINSOCK1}
+  WinsockLevel = $0101;
+{$ELSE}
+  WinsockLevel = $0202;
+{$ENDIF}
+
+type
+  u_short = Word;
+  u_int = Integer;
+  u_long = Longint;
+  pu_long = ^u_long;
+  pu_short = ^u_short;
+{$IFDEF FPC}
+  TSocket = ptruint;
+{$ELSE}
+  TSocket = u_int;
+{$ENDIF}
+  TAddrFamily = integer;
+
+  TMemory = pointer;
+
+const
+  {$IFDEF WINSOCK1}
+    DLLStackName = 'wsock32.dll';
+  {$ELSE}
+    DLLStackName = 'ws2_32.dll';
+  {$ENDIF}
+  DLLwship6 = 'wship6.dll';
+
+  cLocalhost = '127.0.0.1';
+  cAnyHost = '0.0.0.0';
+  cBroadcast = '255.255.255.255';
+  c6Localhost = '::1';
+  c6AnyHost = '::0';
+  c6Broadcast = 'ffff::1';
+  cAnyPort = '0';
+  
+
+const
+  FD_SETSIZE     =   64;
+type
+  PFDSet = ^TFDSet;
+  TFDSet = record
+    fd_count: u_int;
+    fd_array: array[0..FD_SETSIZE-1] of TSocket;
+  end;
+
+const
+  FIONREAD     = $4004667f;
+  FIONBIO      = $8004667e;
+  FIOASYNC     = $8004667d;
+
+type
+  PTimeVal = ^TTimeVal;
+  TTimeVal = record
+    tv_sec: Longint;
+    tv_usec: Longint;
+  end;
+
+const
+  IPPROTO_IP     =   0;		{ Dummy					}
+  IPPROTO_ICMP   =   1;		{ Internet Control Message Protocol }
+  IPPROTO_IGMP   =   2;		{ Internet Group Management Protocol}
+  IPPROTO_TCP    =   6;		{ TCP           			}
+  IPPROTO_UDP    =   17;	{ User Datagram Protocol		}
+  IPPROTO_IPV6   =   41;
+  IPPROTO_ICMPV6 =   58;
+  IPPROTO_RM     =  113;
+
+  IPPROTO_RAW    =   255;
+  IPPROTO_MAX    =   256;
+
+type
+
+  PInAddr = ^TInAddr;
+  TInAddr = record
+    case integer of
+      0: (S_bytes: packed array [0..3] of byte);
+      1: (S_addr: u_long);
+  end;
+
+  PSockAddrIn = ^TSockAddrIn;
+  TSockAddrIn = record
+    case Integer of
+      0: (sin_family: u_short;
+          sin_port: u_short;
+          sin_addr: TInAddr;
+          sin_zero: array[0..7] of byte);
+      1: (sa_family: u_short;
+          sa_data: array[0..13] of byte)
+  end;
+
+  TIP_mreq =  record
+    imr_multiaddr: TInAddr;     { IP multicast address of group }
+    imr_interface: TInAddr;     { local IP address of interface }
+  end;
+
+  PInAddr6 = ^TInAddr6;
+  TInAddr6 = record
+    case integer of
+      0: (S6_addr: packed array [0..15] of byte);
+      1: (u6_addr8: packed array [0..15] of byte);
+      2: (u6_addr16: packed array [0..7] of word);
+      3: (u6_addr32: packed array [0..3] of integer);
+  end;
+
+  PSockAddrIn6 = ^TSockAddrIn6;
+  TSockAddrIn6 = record
+		sin6_family:   u_short;     // AF_INET6
+		sin6_port:     u_short;     // Transport level port number
+		sin6_flowinfo: u_long;	    // IPv6 flow information
+		sin6_addr:     TInAddr6;    // IPv6 address
+		sin6_scope_id: u_long;      // Scope Id: IF number for link-local
+                                //           SITE id for site-local
+  end;
+
+  TIPv6_mreq = record
+    ipv6mr_multiaddr: TInAddr6; // IPv6 multicast address.
+    ipv6mr_interface: integer;   // Interface index.
+    padding: integer;
+  end;
+
+  PHostEnt = ^THostEnt;
+  THostEnt = record
+    h_name: PAnsiChar;
+    h_aliases: ^PAnsiChar;
+    h_addrtype: Smallint;
+    h_length: Smallint;
+    case integer of
+     0: (h_addr_list: ^PAnsiChar);
+     1: (h_addr: ^PInAddr);
+  end;
+
+  PNetEnt = ^TNetEnt;
+  TNetEnt = record
+    n_name: PAnsiChar;
+    n_aliases: ^PAnsiChar;
+    n_addrtype: Smallint;
+    n_net: u_long;
+  end;
+
+  PServEnt = ^TServEnt;
+  TServEnt = record
+    s_name: PAnsiChar;
+    s_aliases: ^PAnsiChar;
+{$ifdef WIN64}
+    s_proto: PAnsiChar;
+    s_port: Smallint;
+{$else} 
+    s_port: Smallint;
+    s_proto: PAnsiChar;
+{$endif}
+  end;
+
+  PProtoEnt = ^TProtoEnt;
+  TProtoEnt = record
+    p_name: PAnsiChar;
+    p_aliases: ^PAnsichar;
+    p_proto: Smallint;
+  end;
+
+const
+  INADDR_ANY       = $00000000;
+  INADDR_LOOPBACK  = $7F000001;
+  INADDR_BROADCAST = $FFFFFFFF;
+  INADDR_NONE      = $FFFFFFFF;
+  ADDR_ANY		 = INADDR_ANY;
+  INVALID_SOCKET		= TSocket(NOT(0));
+  SOCKET_ERROR			= -1;
+
+Const
+  {$IFDEF WINSOCK1}
+    IP_OPTIONS          = 1;
+    IP_MULTICAST_IF     = 2;           { set/get IP multicast interface   }
+    IP_MULTICAST_TTL    = 3;           { set/get IP multicast timetolive  }
+    IP_MULTICAST_LOOP   = 4;           { set/get IP multicast loopback    }
+    IP_ADD_MEMBERSHIP   = 5;           { add  an IP group membership      }
+    IP_DROP_MEMBERSHIP  = 6;           { drop an IP group membership      }
+    IP_TTL              = 7;           { set/get IP Time To Live          }
+    IP_TOS              = 8;           { set/get IP Type Of Service       }
+    IP_DONTFRAGMENT     = 9;           { set/get IP Don't Fragment flag   }
+  {$ELSE}
+    IP_OPTIONS          = 1;
+    IP_HDRINCL          = 2;
+    IP_TOS              = 3;           { set/get IP Type Of Service       }
+    IP_TTL              = 4;           { set/get IP Time To Live          }
+    IP_MULTICAST_IF     = 9;           { set/get IP multicast interface   }
+    IP_MULTICAST_TTL    = 10;           { set/get IP multicast timetolive  }
+    IP_MULTICAST_LOOP   = 11;           { set/get IP multicast loopback    }
+    IP_ADD_MEMBERSHIP   = 12;           { add  an IP group membership      }
+    IP_DROP_MEMBERSHIP  = 13;           { drop an IP group membership      }
+    IP_DONTFRAGMENT     = 14;           { set/get IP Don't Fragment flag   }
+  {$ENDIF}
+
+  IP_DEFAULT_MULTICAST_TTL   = 1;    { normally limit m'casts to 1 hop  }
+  IP_DEFAULT_MULTICAST_LOOP  = 1;    { normally hear sends if a member  }
+  IP_MAX_MEMBERSHIPS         = 20;   { per socket; must fit in one mbuf }
+
+  SOL_SOCKET      = $ffff;          {options for socket level }
+{ Option flags per-socket. }
+  SO_DEBUG        = $0001;          { turn on debugging info recording }
+  SO_ACCEPTCONN   = $0002;          { socket has had listen() }
+  SO_REUSEADDR    = $0004;          { allow local address reuse }
+  SO_KEEPALIVE    = $0008;          { keep connections alive }
+  SO_DONTROUTE    = $0010;          { just use interface addresses }
+  SO_BROADCAST    = $0020;          { permit sending of broadcast msgs }
+  SO_USELOOPBACK  = $0040;          { bypass hardware when possible }
+  SO_LINGER       = $0080;          { linger on close if data present }
+  SO_OOBINLINE    = $0100;          { leave received OOB data in line }
+  SO_DONTLINGER  =   $ff7f;
+{ Additional options. }
+  SO_SNDBUF       = $1001;          { send buffer size }
+  SO_RCVBUF       = $1002;          { receive buffer size }
+  SO_SNDLOWAT     = $1003;          { send low-water mark }
+  SO_RCVLOWAT     = $1004;          { receive low-water mark }
+  SO_SNDTIMEO     = $1005;          { send timeout }
+  SO_RCVTIMEO     = $1006;          { receive timeout }
+  SO_ERROR        = $1007;          { get error status and clear }
+  SO_TYPE         = $1008;          { get socket type }
+{ WinSock 2 extension -- new options }
+  SO_GROUP_ID       = $2001; { ID of a socket group}
+  SO_GROUP_PRIORITY = $2002; { the relative priority within a group}
+  SO_MAX_MSG_SIZE   = $2003; { maximum message size }
+  SO_PROTOCOL_INFOA = $2004; { WSAPROTOCOL_INFOA structure }
+  SO_PROTOCOL_INFOW = $2005; { WSAPROTOCOL_INFOW structure }
+  SO_PROTOCOL_INFO  = SO_PROTOCOL_INFOA;
+  PVD_CONFIG        = $3001; {configuration info for service provider }
+{ Option for opening sockets for synchronous access. }
+  SO_OPENTYPE     = $7008;
+  SO_SYNCHRONOUS_ALERT    = $10;
+  SO_SYNCHRONOUS_NONALERT = $20;
+{ Other NT-specific options. }
+  SO_MAXDG        = $7009;
+  SO_MAXPATHDG    = $700A;
+  SO_UPDATE_ACCEPT_CONTEXT     = $700B;
+  SO_CONNECT_TIME = $700C;
+
+  SOMAXCONN       = $7fffffff;
+
+  IPV6_UNICAST_HOPS      = 8;  // ???
+  IPV6_MULTICAST_IF      = 9;  // set/get IP multicast i/f
+  IPV6_MULTICAST_HOPS    = 10; // set/get IP multicast ttl
+  IPV6_MULTICAST_LOOP    = 11; // set/get IP multicast loopback
+  IPV6_JOIN_GROUP        = 12; // add an IP group membership
+  IPV6_LEAVE_GROUP       = 13; // drop an IP group membership
+
+  MSG_NOSIGNAL  = 0;
+
+  // getnameinfo constants
+  NI_MAXHOST	   = 1025;
+  NI_MAXSERV	   = 32;
+  NI_NOFQDN 	   = $1;
+  NI_NUMERICHOST = $2;
+  NI_NAMEREQD	   = $4;
+  NI_NUMERICSERV = $8;
+  NI_DGRAM       = $10;
+
+
+const
+  SOCK_STREAM     = 1;               { stream socket }
+  SOCK_DGRAM      = 2;               { datagram socket }
+  SOCK_RAW        = 3;               { raw-protocol interface }
+  SOCK_RDM        = 4;               { reliably-delivered message }
+  SOCK_SEQPACKET  = 5;               { sequenced packet stream }
+
+{ TCP options. }
+  TCP_NODELAY     = $0001;
+
+{ Address families. }
+
+  AF_UNSPEC       = 0;               { unspecified }
+  AF_INET         = 2;               { internetwork: UDP, TCP, etc. }
+  AF_INET6        = 23;              { Internetwork Version 6 }
+  AF_MAX          = 24;
+
+{ Protocol families, same as address families for now. }
+  PF_UNSPEC       = AF_UNSPEC;
+  PF_INET         = AF_INET;
+  PF_INET6        = AF_INET6;
+  PF_MAX          = AF_MAX;
+
+type
+  { Structure used by kernel to store most addresses. }
+  PSockAddr = ^TSockAddr;
+  TSockAddr = TSockAddrIn;
+
+  { Structure used by kernel to pass protocol information in raw sockets. }
+  PSockProto = ^TSockProto;
+  TSockProto = record
+    sp_family: u_short;
+    sp_protocol: u_short;
+  end;
+
+type
+  PAddrInfo = ^TAddrInfo;
+  TAddrInfo = record
+                ai_flags: integer;    // AI_PASSIVE, AI_CANONNAME, AI_NUMERICHOST.
+                ai_family: integer;   // PF_xxx.
+                ai_socktype: integer; // SOCK_xxx.
+                ai_protocol: integer; // 0 or IPPROTO_xxx for IPv4 and IPv6.
+                ai_addrlen: u_int;    // Length of ai_addr.
+                ai_canonname: PAnsiChar;  // Canonical name for nodename.
+                ai_addr: PSockAddr;   // Binary address.
+                ai_next: PAddrInfo;     // Next structure in linked list.
+              end;
+
+const
+  // Flags used in "hints" argument to getaddrinfo().
+  AI_PASSIVE     = $1;  // Socket address will be used in bind() call.
+  AI_CANONNAME   = $2;  // Return canonical name in first ai_canonname.
+  AI_NUMERICHOST = $4;  // Nodename must be a numeric address string.
+
+type
+{ Structure used for manipulating linger option. }
+  PLinger = ^TLinger;
+  TLinger = record
+    l_onoff: u_short;
+    l_linger: u_short;
+  end;
+
+const
+
+  MSG_OOB       = $01;                  // Process out-of-band data.
+  MSG_PEEK      = $02;                  // Peek at incoming messages.
+
+const
+
+{ All Windows Sockets error constants are biased by WSABASEERR from the "normal" }
+  WSABASEERR              = 10000;
+
+{ Windows Sockets definitions of regular Microsoft C error constants }
+
+  WSAEINTR                = (WSABASEERR+4);
+  WSAEBADF                = (WSABASEERR+9);
+  WSAEACCES               = (WSABASEERR+13);
+  WSAEFAULT               = (WSABASEERR+14);
+  WSAEINVAL               = (WSABASEERR+22);
+  WSAEMFILE               = (WSABASEERR+24);
+
+{ Windows Sockets definitions of regular Berkeley error constants }
+
+  WSAEWOULDBLOCK          = (WSABASEERR+35);
+  WSAEINPROGRESS          = (WSABASEERR+36);
+  WSAEALREADY             = (WSABASEERR+37);
+  WSAENOTSOCK             = (WSABASEERR+38);
+  WSAEDESTADDRREQ         = (WSABASEERR+39);
+  WSAEMSGSIZE             = (WSABASEERR+40);
+  WSAEPROTOTYPE           = (WSABASEERR+41);
+  WSAENOPROTOOPT          = (WSABASEERR+42);
+  WSAEPROTONOSUPPORT      = (WSABASEERR+43);
+  WSAESOCKTNOSUPPORT      = (WSABASEERR+44);
+  WSAEOPNOTSUPP           = (WSABASEERR+45);
+  WSAEPFNOSUPPORT         = (WSABASEERR+46);
+  WSAEAFNOSUPPORT         = (WSABASEERR+47);
+  WSAEADDRINUSE           = (WSABASEERR+48);
+  WSAEADDRNOTAVAIL        = (WSABASEERR+49);
+  WSAENETDOWN             = (WSABASEERR+50);
+  WSAENETUNREACH          = (WSABASEERR+51);
+  WSAENETRESET            = (WSABASEERR+52);
+  WSAECONNABORTED         = (WSABASEERR+53);
+  WSAECONNRESET           = (WSABASEERR+54);
+  WSAENOBUFS              = (WSABASEERR+55);
+  WSAEISCONN              = (WSABASEERR+56);
+  WSAENOTCONN             = (WSABASEERR+57);
+  WSAESHUTDOWN            = (WSABASEERR+58);
+  WSAETOOMANYREFS         = (WSABASEERR+59);
+  WSAETIMEDOUT            = (WSABASEERR+60);
+  WSAECONNREFUSED         = (WSABASEERR+61);
+  WSAELOOP                = (WSABASEERR+62);
+  WSAENAMETOOLONG         = (WSABASEERR+63);
+  WSAEHOSTDOWN            = (WSABASEERR+64);
+  WSAEHOSTUNREACH         = (WSABASEERR+65);
+  WSAENOTEMPTY            = (WSABASEERR+66);
+  WSAEPROCLIM             = (WSABASEERR+67);
+  WSAEUSERS               = (WSABASEERR+68);
+  WSAEDQUOT               = (WSABASEERR+69);
+  WSAESTALE               = (WSABASEERR+70);
+  WSAEREMOTE              = (WSABASEERR+71);
+
+{ Extended Windows Sockets error constant definitions }
+
+  WSASYSNOTREADY          = (WSABASEERR+91);
+  WSAVERNOTSUPPORTED      = (WSABASEERR+92);
+  WSANOTINITIALISED       = (WSABASEERR+93);
+  WSAEDISCON              = (WSABASEERR+101);
+  WSAENOMORE              = (WSABASEERR+102);
+  WSAECANCELLED           = (WSABASEERR+103);
+  WSAEEINVALIDPROCTABLE   = (WSABASEERR+104);
+  WSAEINVALIDPROVIDER     = (WSABASEERR+105);
+  WSAEPROVIDERFAILEDINIT  = (WSABASEERR+106);
+  WSASYSCALLFAILURE       = (WSABASEERR+107);
+  WSASERVICE_NOT_FOUND    = (WSABASEERR+108);
+  WSATYPE_NOT_FOUND       = (WSABASEERR+109);
+  WSA_E_NO_MORE           = (WSABASEERR+110);
+  WSA_E_CANCELLED         = (WSABASEERR+111);
+  WSAEREFUSED             = (WSABASEERR+112);
+
+{ Error return codes from gethostbyname() and gethostbyaddr()
+  (when using the resolver). Note that these errors are
+  retrieved via WSAGetLastError() and must therefore follow
+  the rules for avoiding clashes with error numbers from
+  specific implementations or language run-time systems.
+  For this reason the codes are based at WSABASEERR+1001.
+  Note also that [WSA]NO_ADDRESS is defined only for
+  compatibility purposes. }
+
+{ Authoritative Answer: Host not found }
+  WSAHOST_NOT_FOUND       = (WSABASEERR+1001);
+  HOST_NOT_FOUND          = WSAHOST_NOT_FOUND;
+{ Non-Authoritative: Host not found, or SERVERFAIL }
+  WSATRY_AGAIN            = (WSABASEERR+1002);
+  TRY_AGAIN               = WSATRY_AGAIN;
+{ Non recoverable errors, FORMERR, REFUSED, NOTIMP }
+  WSANO_RECOVERY          = (WSABASEERR+1003);
+  NO_RECOVERY             = WSANO_RECOVERY;
+{ Valid name, no data record of requested type }
+  WSANO_DATA              = (WSABASEERR+1004);
+  NO_DATA                 = WSANO_DATA;
+{ no address, look for MX record }
+  WSANO_ADDRESS           = WSANO_DATA;
+  NO_ADDRESS              = WSANO_ADDRESS;
+
+  EWOULDBLOCK        =  WSAEWOULDBLOCK;
+  EINPROGRESS        =  WSAEINPROGRESS;
+  EALREADY           =  WSAEALREADY;
+  ENOTSOCK           =  WSAENOTSOCK;
+  EDESTADDRREQ       =  WSAEDESTADDRREQ;
+  EMSGSIZE           =  WSAEMSGSIZE;
+  EPROTOTYPE         =  WSAEPROTOTYPE;
+  ENOPROTOOPT        =  WSAENOPROTOOPT;
+  EPROTONOSUPPORT    =  WSAEPROTONOSUPPORT;
+  ESOCKTNOSUPPORT    =  WSAESOCKTNOSUPPORT;
+  EOPNOTSUPP         =  WSAEOPNOTSUPP;
+  EPFNOSUPPORT       =  WSAEPFNOSUPPORT;
+  EAFNOSUPPORT       =  WSAEAFNOSUPPORT;
+  EADDRINUSE         =  WSAEADDRINUSE;
+  EADDRNOTAVAIL      =  WSAEADDRNOTAVAIL;
+  ENETDOWN           =  WSAENETDOWN;
+  ENETUNREACH        =  WSAENETUNREACH;
+  ENETRESET          =  WSAENETRESET;
+  ECONNABORTED       =  WSAECONNABORTED;
+  ECONNRESET         =  WSAECONNRESET;
+  ENOBUFS            =  WSAENOBUFS;
+  EISCONN            =  WSAEISCONN;
+  ENOTCONN           =  WSAENOTCONN;
+  ESHUTDOWN          =  WSAESHUTDOWN;
+  ETOOMANYREFS       =  WSAETOOMANYREFS;
+  ETIMEDOUT          =  WSAETIMEDOUT;
+  ECONNREFUSED       =  WSAECONNREFUSED;
+  ELOOP              =  WSAELOOP;
+  ENAMETOOLONG       =  WSAENAMETOOLONG;
+  EHOSTDOWN          =  WSAEHOSTDOWN;
+  EHOSTUNREACH       =  WSAEHOSTUNREACH;
+  ENOTEMPTY          =  WSAENOTEMPTY;
+  EPROCLIM           =  WSAEPROCLIM;
+  EUSERS             =  WSAEUSERS;
+  EDQUOT             =  WSAEDQUOT;
+  ESTALE             =  WSAESTALE;
+  EREMOTE            =  WSAEREMOTE;
+
+  EAI_ADDRFAMILY  = 1;   // Address family for nodename not supported.
+  EAI_AGAIN       = 2;   // Temporary failure in name resolution.
+  EAI_BADFLAGS    = 3;   // Invalid value for ai_flags.
+  EAI_FAIL        = 4;   // Non-recoverable failure in name resolution.
+  EAI_FAMILY      = 5;   // Address family ai_family not supported.
+  EAI_MEMORY      = 6;   // Memory allocation failure.
+  EAI_NODATA      = 7;   // No address associated with nodename.
+  EAI_NONAME      = 8;   // Nodename nor servname provided, or not known.
+  EAI_SERVICE     = 9;   // Servname not supported for ai_socktype.
+  EAI_SOCKTYPE    = 10;  // Socket type ai_socktype not supported.
+  EAI_SYSTEM      = 11;  // System error returned in errno.
+
+const
+  WSADESCRIPTION_LEN     =   256;
+  WSASYS_STATUS_LEN      =   128;
+type
+  PWSAData = ^TWSAData;
+  TWSAData = record
+    wVersion: Word;
+    wHighVersion: Word;
+{$ifdef win64}
+    iMaxSockets : Word;
+    iMaxUdpDg : Word;
+    lpVendorInfo : PAnsiChar;
+    szDescription : array[0..WSADESCRIPTION_LEN] of AnsiChar;
+    szSystemStatus : array[0..WSASYS_STATUS_LEN] of AnsiChar;
+{$else}     
+    szDescription: array[0..WSADESCRIPTION_LEN] of AnsiChar;
+    szSystemStatus: array[0..WSASYS_STATUS_LEN] of AnsiChar;
+    iMaxSockets: Word;
+    iMaxUdpDg: Word;
+    lpVendorInfo: PAnsiChar;
+{$endif}
+  end;
+
+  function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
+  function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
+  function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
+  function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
+  function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
+  function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6):boolean;
+  procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
+  procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
+var
+  in6addr_any, in6addr_loopback : TInAddr6;
+
+procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet);
+function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean;
+procedure FD_SET(Socket: TSocket; var FDSet: TFDSet);
+procedure FD_ZERO(var FDSet: TFDSet);
+
+{=============================================================================}
+
+type
+  TWSAStartup = function(wVersionRequired: Word; var WSData: TWSAData): Integer;
+    stdcall;
+  TWSACleanup = function: Integer;
+    stdcall;
+  TWSAGetLastError = function: Integer;
+    stdcall;
+  TGetServByName = function(name, proto: PAnsiChar): PServEnt;
+    stdcall;
+  TGetServByPort = function(port: Integer; proto: PAnsiChar): PServEnt;
+    stdcall;
+  TGetProtoByName = function(name: PAnsiChar): PProtoEnt;
+    stdcall;
+  TGetProtoByNumber = function(proto: Integer): PProtoEnt;
+    stdcall;
+  TGetHostByName = function(name: PAnsiChar): PHostEnt;
+    stdcall;
+  TGetHostByAddr = function(addr: Pointer; len, Struc: Integer): PHostEnt;
+    stdcall;
+  TGetHostName = function(name: PAnsiChar; len: Integer): Integer;
+    stdcall;
+  TShutdown = function(s: TSocket; how: Integer): Integer;
+    stdcall;
+  TSetSockOpt = function(s: TSocket; level, optname: Integer; optval: PAnsiChar;
+    optlen: Integer): Integer;
+    stdcall;
+  TGetSockOpt = function(s: TSocket; level, optname: Integer; optval: PAnsiChar;
+    var optlen: Integer): Integer;
+    stdcall;
+  TSendTo = function(s: TSocket; const Buf; len, flags: Integer; addrto: PSockAddr;
+    tolen: Integer): Integer;
+    stdcall;
+  TSend = function(s: TSocket; const Buf; len, flags: Integer): Integer;
+    stdcall;
+  TRecv = function(s: TSocket; var Buf; len, flags: Integer): Integer;
+    stdcall;
+  TRecvFrom = function(s: TSocket; var Buf; len, flags: Integer; from: PSockAddr;
+    var fromlen: Integer): Integer;
+    stdcall;
+  Tntohs = function(netshort: u_short): u_short;
+    stdcall;
+  Tntohl = function(netlong: u_long): u_long;
+    stdcall;
+  TListen = function(s: TSocket; backlog: Integer): Integer;
+    stdcall;
+  TIoctlSocket = function(s: TSocket; cmd: DWORD; var arg: Integer): Integer;
+    stdcall;
+  TInet_ntoa = function(inaddr: TInAddr): PAnsiChar;
+    stdcall;
+  TInet_addr = function(cp: PAnsiChar): u_long;
+    stdcall;
+  Thtons = function(hostshort: u_short): u_short;
+    stdcall;
+  Thtonl = function(hostlong: u_long): u_long;
+    stdcall;
+  TGetSockName = function(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
+    stdcall;
+  TGetPeerName = function(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
+    stdcall;
+  TConnect = function(s: TSocket; name: PSockAddr; namelen: Integer): Integer;
+    stdcall;
+  TCloseSocket = function(s: TSocket): Integer;
+    stdcall;
+  TBind = function(s: TSocket; addr: PSockAddr; namelen: Integer): Integer;
+    stdcall;
+  TAccept = function(s: TSocket; addr: PSockAddr; var addrlen: Integer): TSocket;
+    stdcall;
+  TTSocket = function(af, Struc, Protocol: Integer): TSocket;
+    stdcall;
+  TSelect = function(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
+    timeout: PTimeVal): Longint;
+    stdcall;
+
+  TGetAddrInfo = function(NodeName: PAnsiChar; ServName: PAnsiChar; Hints: PAddrInfo;
+    var Addrinfo: PAddrInfo): integer;
+    stdcall;
+  TFreeAddrInfo = procedure(ai: PAddrInfo);
+    stdcall;
+  TGetNameInfo = function( addr: PSockAddr; namelen: Integer; host: PAnsiChar;
+    hostlen: DWORD; serv: PAnsiChar; servlen: DWORD; flags: integer): integer;
+    stdcall;
+
+  T__WSAFDIsSet = function (s: TSocket; var FDSet: TFDSet): Bool;
+    stdcall;
+
+  TWSAIoctl = function (s: TSocket; dwIoControlCode: DWORD; lpvInBuffer: Pointer;
+    cbInBuffer: DWORD; lpvOutBuffer: Pointer; cbOutBuffer: DWORD;
+    lpcbBytesReturned: PDWORD; lpOverlapped: Pointer;
+    lpCompletionRoutine: pointer): u_int;
+    stdcall;
+
+var
+  WSAStartup: TWSAStartup = nil;
+  WSACleanup: TWSACleanup = nil;
+  WSAGetLastError: TWSAGetLastError = nil;
+  GetServByName: TGetServByName = nil;
+  GetServByPort: TGetServByPort = nil;
+  GetProtoByName: TGetProtoByName = nil;
+  GetProtoByNumber: TGetProtoByNumber = nil;
+  GetHostByName: TGetHostByName = nil;
+  GetHostByAddr: TGetHostByAddr = nil;
+  ssGetHostName: TGetHostName = nil;
+  Shutdown: TShutdown = nil;
+  SetSockOpt: TSetSockOpt = nil;
+  GetSockOpt: TGetSockOpt = nil;
+  ssSendTo: TSendTo = nil;
+  ssSend: TSend = nil;
+  ssRecv: TRecv = nil;
+  ssRecvFrom: TRecvFrom = nil;
+  ntohs: Tntohs = nil;
+  ntohl: Tntohl = nil;
+  Listen: TListen = nil;
+  IoctlSocket: TIoctlSocket = nil;
+  Inet_ntoa: TInet_ntoa = nil;
+  Inet_addr: TInet_addr = nil;
+  htons: Thtons = nil;
+  htonl: Thtonl = nil;
+  ssGetSockName: TGetSockName = nil;
+  ssGetPeerName: TGetPeerName = nil;
+  ssConnect: TConnect = nil;
+  CloseSocket: TCloseSocket = nil;
+  ssBind: TBind = nil;
+  ssAccept: TAccept = nil;
+  Socket: TTSocket = nil;
+  Select: TSelect = nil;
+
+  GetAddrInfo: TGetAddrInfo = nil;
+  FreeAddrInfo: TFreeAddrInfo = nil;
+  GetNameInfo: TGetNameInfo = nil;
+
+  __WSAFDIsSet: T__WSAFDIsSet = nil;
+
+  WSAIoctl: TWSAIoctl = nil;
+
+var
+  SynSockCS: SyncObjs.TCriticalSection;
+  SockEnhancedApi: Boolean;
+  SockWship6Api: Boolean;
+
+type
+  TVarSin = packed record
+    case integer of
+      0: (AddressFamily: u_short);
+      1: (
+        case sin_family: u_short of
+          AF_INET: (sin_port: u_short;
+                    sin_addr: TInAddr;
+                    sin_zero: array[0..7] of byte);
+          AF_INET6: (sin6_port:     u_short;
+                		sin6_flowinfo: u_long;
+      	    	      sin6_addr:     TInAddr6;
+      		          sin6_scope_id: u_long);
+          );
+  end;
+
+function SizeOfVarSin(sin: TVarSin): integer;
+
+function Bind(s: TSocket; const addr: TVarSin): Integer;
+function Connect(s: TSocket; const name: TVarSin): Integer;
+function GetSockName(s: TSocket; var name: TVarSin): Integer;
+function GetPeerName(s: TSocket; var name: TVarSin): Integer;
+function GetHostName: AnsiString;
+function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
+function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
+function Accept(s: TSocket; var addr: TVarSin): TSocket;
+
+function IsNewApi(Family: integer): Boolean;
+function SetVarSin(var Sin: TVarSin; IP, Port: AnsiString; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+function GetSinIP(Sin: TVarSin): AnsiString;
+function GetSinPort(Sin: TVarSin): Integer;
+procedure ResolveNameToIP(Name: AnsiString;  Family, SockProtocol, SockType: integer; const IPList: TStrings);
+function ResolveIPToName(IP: AnsiString; Family, SockProtocol, SockType: integer): AnsiString;
+function ResolvePort(Port: AnsiString; Family, SockProtocol, SockType: integer): Word;
+
+{==============================================================================}
+implementation
+
+var
+  SynSockCount: Integer = 0;
+  LibHandle: THandle = 0;
+  Libwship6Handle: THandle = 0;
+
+function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
+begin
+  Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
+             (a^.u6_addr32[2] = 0) and (a^.u6_addr32[3] = 0));
+end;
+
+function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
+begin
+  Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
+             (a^.u6_addr32[2] = 0) and
+             (a^.u6_addr8[12] = 0) and (a^.u6_addr8[13] = 0) and
+             (a^.u6_addr8[14] = 0) and (a^.u6_addr8[15] = 1));
+end;
+
+function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
+begin
+  Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $80));
+end;
+
+function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
+begin
+  Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $C0));
+end;
+
+function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
+begin
+  Result := (a^.u6_addr8[0] = $FF);
+end;
+
+function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6): boolean;
+begin
+  Result := (CompareMem( a, b, sizeof(TInAddr6)));
+end;
+
+procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
+begin
+  FillChar(a^, sizeof(TInAddr6), 0);
+end;
+
+procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
+begin
+  FillChar(a^, sizeof(TInAddr6), 0);
+  a^.u6_addr8[15] := 1;
+end;
+
+{=============================================================================}
+procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet);
+var
+  I: Integer;
+begin
+  I := 0;
+  while I < FDSet.fd_count do
+  begin
+    if FDSet.fd_array[I] = Socket then
+    begin
+      while I < FDSet.fd_count - 1 do
+      begin
+        FDSet.fd_array[I] := FDSet.fd_array[I + 1];
+        Inc(I);
+      end;
+      Dec(FDSet.fd_count);
+      Break;
+    end;
+    Inc(I);
+  end;
+end;
+
+function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean;
+begin
+  Result := __WSAFDIsSet(Socket, FDSet);
+end;
+
+procedure FD_SET(Socket: TSocket; var FDSet: TFDSet);
+begin
+  if FDSet.fd_count < FD_SETSIZE then
+  begin
+    FDSet.fd_array[FDSet.fd_count] := Socket;
+    Inc(FDSet.fd_count);
+  end;
+end;
+
+procedure FD_ZERO(var FDSet: TFDSet);
+begin
+  FDSet.fd_count := 0;
+end;
+
+{=============================================================================}
+
+function SizeOfVarSin(sin: TVarSin): integer;
+begin
+  case sin.sin_family of
+    AF_INET:
+            Result := SizeOf(TSockAddrIn);
+    AF_INET6:
+            Result := SizeOf(TSockAddrIn6);
+  else
+    Result := 0;
+  end;
+end;
+
+{=============================================================================}
+
+function Bind(s: TSocket; const addr: TVarSin): Integer;
+begin
+  Result := ssBind(s, @addr, SizeOfVarSin(addr));
+end;
+
+function Connect(s: TSocket; const name: TVarSin): Integer;
+begin
+  Result := ssConnect(s, @name, SizeOfVarSin(name));
+end;
+
+function GetSockName(s: TSocket; var name: TVarSin): Integer;
+var
+  len: integer;
+begin
+  len := SizeOf(name);
+  FillChar(name, len, 0);
+  Result := ssGetSockName(s, @name, Len);
+end;
+
+function GetPeerName(s: TSocket; var name: TVarSin): Integer;
+var
+  len: integer;
+begin
+  len := SizeOf(name);
+  FillChar(name, len, 0);
+  Result := ssGetPeerName(s, @name, Len);
+end;
+
+function GetHostName: AnsiString;
+var
+  s: AnsiString;
+begin
+  Result := '';
+  setlength(s, 255);
+  ssGetHostName(pAnsichar(s), Length(s) - 1);
+  Result := PAnsichar(s);
+end;
+
+function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+begin
+  Result := ssSend(s, Buf^, len, flags);
+end;
+
+function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+begin
+  Result := ssRecv(s, Buf^, len, flags);
+end;
+
+function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
+begin
+  Result := ssSendTo(s, Buf^, len, flags, @addrto, SizeOfVarSin(addrto));
+end;
+
+function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
+var
+  x: integer;
+begin
+  x := SizeOf(from);
+  Result := ssRecvFrom(s, Buf^, len, flags, @from, x);
+end;
+
+function Accept(s: TSocket; var addr: TVarSin): TSocket;
+var
+  x: integer;
+begin
+  x := SizeOf(addr);
+  Result := ssAccept(s, @addr, x);
+end;
+
+{=============================================================================}
+function IsNewApi(Family: integer): Boolean;
+begin
+  Result := SockEnhancedApi;
+  if not Result then
+    Result := (Family = AF_INET6) and SockWship6Api;
+end;
+
+function SetVarSin(var Sin: TVarSin; IP, Port: AnsiString; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+type
+  pu_long = ^u_long;
+var
+  ProtoEnt: PProtoEnt;
+  ServEnt: PServEnt;
+  HostEnt: PHostEnt;
+  r: integer;
+  Hints1, Hints2: TAddrInfo;
+  Sin1, Sin2: TVarSin;
+  TwoPass: boolean;
+
+  function GetAddr(const IP, port: AnsiString; Hints: TAddrInfo; var Sin: TVarSin): integer;
+  var
+    Addr: PAddrInfo;
+  begin
+    Addr := nil;
+    try
+      FillChar(Sin, Sizeof(Sin), 0);
+      if Hints.ai_socktype = SOCK_RAW then
+      begin
+        Hints.ai_socktype := 0;
+        Hints.ai_protocol := 0;
+        Result := synsock.GetAddrInfo(PAnsiChar(IP), nil, @Hints, Addr);
+      end
+      else
+      begin
+        if (IP = cAnyHost) or (IP = c6AnyHost) then
+        begin
+          Hints.ai_flags := AI_PASSIVE;
+          Result := synsock.GetAddrInfo(nil, PAnsiChar(Port), @Hints, Addr);
+        end
+        else
+          if (IP = cLocalhost) or (IP = c6Localhost) then
+          begin
+            Result := synsock.GetAddrInfo(nil, PAnsiChar(Port), @Hints, Addr);
+          end
+          else
+          begin
+            Result := synsock.GetAddrInfo(PAnsiChar(IP), PAnsiChar(Port), @Hints, Addr);
+          end;
+      end;
+      if Result = 0 then
+        if (Addr <> nil) then
+          Move(Addr^.ai_addr^, Sin, Addr^.ai_addrlen);
+    finally
+      if Assigned(Addr) then
+        synsock.FreeAddrInfo(Addr);
+    end;
+  end;
+
+begin
+  Result := 0;
+  FillChar(Sin, Sizeof(Sin), 0);
+  if not IsNewApi(family) then
+  begin
+    SynSockCS.Enter;
+    try
+      Sin.sin_family := AF_INET;
+      ProtoEnt := synsock.GetProtoByNumber(SockProtocol);
+      ServEnt := nil;
+      if (ProtoEnt <> nil) and (StrToIntDef(string(Port),-1) =-1) then
+        ServEnt := synsock.GetServByName(PAnsiChar(Port), ProtoEnt^.p_name);
+      if ServEnt = nil then
+        Sin.sin_port := synsock.htons(StrToIntDef(string(Port), 0))
+      else
+        Sin.sin_port := ServEnt^.s_port;
+      if IP = cBroadcast then
+        Sin.sin_addr.s_addr := u_long(INADDR_BROADCAST)
+      else
+      begin
+        Sin.sin_addr.s_addr := synsock.inet_addr(PAnsiChar(IP));
+        if Sin.sin_addr.s_addr = u_long(INADDR_NONE) then
+        begin
+          HostEnt := synsock.GetHostByName(PAnsiChar(IP));
+          Result := synsock.WSAGetLastError;
+          if HostEnt <> nil then
+            Sin.sin_addr.S_addr := u_long(Pu_long(HostEnt^.h_addr_list^)^);
+        end;
+      end;
+    finally
+      SynSockCS.Leave;
+    end;
+  end
+  else
+  begin
+    FillChar(Hints1, Sizeof(Hints1), 0);
+    FillChar(Hints2, Sizeof(Hints2), 0);
+    TwoPass := False;
+    if Family = AF_UNSPEC then
+    begin
+      if PreferIP4 then
+      begin
+        Hints1.ai_family := AF_INET;
+        Hints2.ai_family := AF_INET6;
+        TwoPass := True;
+      end
+      else
+      begin
+        Hints2.ai_family := AF_INET;
+        Hints1.ai_family := AF_INET6;
+        TwoPass := True;
+      end;
+    end
+    else
+      Hints1.ai_family := Family;
+
+    Hints1.ai_socktype := SockType;
+    Hints1.ai_protocol := SockProtocol;
+    Hints2.ai_socktype := Hints1.ai_socktype;
+    Hints2.ai_protocol := Hints1.ai_protocol;
+
+    r := GetAddr(IP, Port, Hints1, Sin1);
+    Result := r;
+    sin := sin1;
+    if r <> 0 then
+      if TwoPass then
+      begin
+        r := GetAddr(IP, Port, Hints2, Sin2);
+        Result := r;
+        if r = 0 then
+          sin := sin2;
+      end;
+  end;
+end;
+
+function GetSinIP(Sin: TVarSin): AnsiString;
+var
+  p: PAnsiChar;
+  host, serv: AnsiString;
+  hostlen, servlen: integer;
+  r: integer;
+begin
+  Result := '';
+  if not IsNewApi(Sin.AddressFamily) then
+  begin
+    p := synsock.inet_ntoa(Sin.sin_addr);
+    if p <> nil then
+      Result := p;
+  end
+  else
+  begin
+    hostlen := NI_MAXHOST;
+    servlen := NI_MAXSERV;
+    setlength(host, hostlen);
+    setlength(serv, servlen);
+    r := getnameinfo(@sin, SizeOfVarSin(sin), PAnsiChar(host), hostlen,
+      PAnsiChar(serv), servlen, NI_NUMERICHOST + NI_NUMERICSERV);
+    if r = 0 then
+      Result := PAnsiChar(host);
+  end;
+end;
+
+function GetSinPort(Sin: TVarSin): Integer;
+begin
+  if (Sin.sin_family = AF_INET6) then
+    Result := synsock.ntohs(Sin.sin6_port)
+  else
+    Result := synsock.ntohs(Sin.sin_port);
+end;
+
+procedure ResolveNameToIP(Name: AnsiString; Family, SockProtocol, SockType: integer; const IPList: TStrings);
+type
+  TaPInAddr = array[0..250] of PInAddr;
+  PaPInAddr = ^TaPInAddr;
+var
+  Hints: TAddrInfo;
+  Addr: PAddrInfo;
+  AddrNext: PAddrInfo;
+  r: integer;
+  host, serv: AnsiString;
+  hostlen, servlen: integer;
+  RemoteHost: PHostEnt;
+  IP: u_long;
+  PAdrPtr: PaPInAddr;
+  i: Integer;
+  s: String;
+  InAddr: TInAddr;
+begin
+  IPList.Clear;
+  if not IsNewApi(Family) then
+  begin
+    IP := synsock.inet_addr(PAnsiChar(Name));
+    if IP = u_long(INADDR_NONE) then
+    begin
+      SynSockCS.Enter;
+      try
+        RemoteHost := synsock.GetHostByName(PAnsiChar(Name));
+        if RemoteHost <> nil then
+        begin
+          PAdrPtr := PAPInAddr(RemoteHost^.h_addr_list);
+          i := 0;
+          while PAdrPtr^[i] <> nil do
+          begin
+            InAddr := PAdrPtr^[i]^;
+            s := Format('%d.%d.%d.%d', [InAddr.S_bytes[0], InAddr.S_bytes[1],
+              InAddr.S_bytes[2], InAddr.S_bytes[3]]);
+            IPList.Add(s);
+            Inc(i);
+          end;
+        end;
+      finally
+        SynSockCS.Leave;
+      end;
+    end
+    else
+      IPList.Add(string(Name));
+  end
+  else
+  begin
+    Addr := nil;
+    try
+      FillChar(Hints, Sizeof(Hints), 0);
+      Hints.ai_family := AF_UNSPEC;
+      Hints.ai_socktype := SockType;
+      Hints.ai_protocol := SockProtocol;
+      Hints.ai_flags := 0;
+      r := synsock.GetAddrInfo(PAnsiChar(Name), nil, @Hints, Addr);
+      if r = 0 then
+      begin
+        AddrNext := Addr;
+        while not(AddrNext = nil) do
+        begin
+          if not(((Family = AF_INET6) and (AddrNext^.ai_family = AF_INET))
+            or ((Family = AF_INET) and (AddrNext^.ai_family = AF_INET6))) then
+          begin
+            hostlen := NI_MAXHOST;
+            servlen := NI_MAXSERV;
+            setlength(host, hostlen);
+            setlength(serv, servlen);
+            r := getnameinfo(AddrNext^.ai_addr, AddrNext^.ai_addrlen,
+              PAnsiChar(host), hostlen, PAnsiChar(serv), servlen,
+              NI_NUMERICHOST + NI_NUMERICSERV);
+            if r = 0 then
+            begin
+              host := PAnsiChar(host);
+              IPList.Add(string(host));
+            end;
+          end;
+          AddrNext := AddrNext^.ai_next;
+        end;
+      end;
+    finally
+      if Assigned(Addr) then
+        synsock.FreeAddrInfo(Addr);
+    end;
+  end;
+  if IPList.Count = 0 then
+    IPList.Add(cAnyHost);
+end;
+
+function ResolvePort(Port: AnsiString; Family, SockProtocol, SockType: integer): Word;
+var
+  ProtoEnt: PProtoEnt;
+  ServEnt: PServEnt;
+  Hints: TAddrInfo;
+  Addr: PAddrInfo;
+  r: integer;
+begin
+  Result := 0;
+  if not IsNewApi(Family) then
+  begin
+    SynSockCS.Enter;
+    try
+      ProtoEnt := synsock.GetProtoByNumber(SockProtocol);
+      ServEnt := nil;
+      if ProtoEnt <> nil then
+        ServEnt := synsock.GetServByName(PAnsiChar(Port), ProtoEnt^.p_name);
+      if ServEnt = nil then
+        Result := StrToIntDef(string(Port), 0)
+      else
+        Result := synsock.htons(ServEnt^.s_port);
+    finally
+      SynSockCS.Leave;
+    end;
+  end
+  else
+  begin
+    Addr := nil;
+    try
+      FillChar(Hints, Sizeof(Hints), 0);
+      Hints.ai_family := AF_UNSPEC;
+      Hints.ai_socktype := SockType;
+      Hints.ai_protocol := Sockprotocol;
+      Hints.ai_flags := AI_PASSIVE;
+      r := synsock.GetAddrInfo(nil, PAnsiChar(Port), @Hints, Addr);
+      if (r = 0) and Assigned(Addr) then
+      begin
+        if Addr^.ai_family = AF_INET then
+          Result := synsock.htons(Addr^.ai_addr^.sin_port);
+        if Addr^.ai_family = AF_INET6 then
+          Result := synsock.htons(PSockAddrIn6(Addr^.ai_addr)^.sin6_port);
+      end;
+    finally
+      if Assigned(Addr) then
+        synsock.FreeAddrInfo(Addr);
+    end;
+  end;
+end;
+
+function ResolveIPToName(IP: AnsiString; Family, SockProtocol, SockType: integer): AnsiString;
+var
+  Hints: TAddrInfo;
+  Addr: PAddrInfo;
+  r: integer;
+  host, serv: AnsiString;
+  hostlen, servlen: integer;
+  RemoteHost: PHostEnt;
+  IPn: u_long;
+begin
+  Result := IP;
+  if not IsNewApi(Family) then
+  begin
+    IPn := synsock.inet_addr(PAnsiChar(IP));
+    if IPn <> u_long(INADDR_NONE) then
+    begin
+      SynSockCS.Enter;
+      try
+        RemoteHost := GetHostByAddr(@IPn, SizeOf(IPn), AF_INET);
+        if RemoteHost <> nil then
+          Result := RemoteHost^.h_name;
+      finally
+        SynSockCS.Leave;
+      end;
+    end;
+  end
+  else
+  begin
+    Addr := nil;
+    try
+      FillChar(Hints, Sizeof(Hints), 0);
+      Hints.ai_family := AF_UNSPEC;
+      Hints.ai_socktype := SockType;
+      Hints.ai_protocol := SockProtocol;
+      Hints.ai_flags := 0;
+      r := synsock.GetAddrInfo(PAnsiChar(IP), nil, @Hints, Addr);
+      if (r = 0) and Assigned(Addr)then
+      begin
+        hostlen := NI_MAXHOST;
+        servlen := NI_MAXSERV;
+        setlength(host, hostlen);
+        setlength(serv, servlen);
+        r := getnameinfo(Addr^.ai_addr, Addr^.ai_addrlen,
+          PAnsiChar(host), hostlen, PAnsiChar(serv), servlen,
+          NI_NUMERICSERV);
+        if r = 0 then
+          Result := PAnsiChar(host);
+      end;
+    finally
+      if Assigned(Addr) then
+        synsock.FreeAddrInfo(Addr);
+    end;
+  end;
+end;
+
+{=============================================================================}
+
+function InitSocketInterface(stack: String): Boolean;
+begin
+  Result := False;
+  SockEnhancedApi := False;
+  if stack = '' then
+    stack := DLLStackName;
+  SynSockCS.Enter;
+  try
+    if SynSockCount = 0 then
+    begin
+      SockEnhancedApi := False;
+      SockWship6Api := False;
+      LibHandle := LoadLibrary(PChar(Stack));
+      if LibHandle <> 0 then
+      begin
+        WSAIoctl := GetProcAddress(LibHandle, PAnsiChar(AnsiString('WSAIoctl')));
+        __WSAFDIsSet := GetProcAddress(LibHandle, PAnsiChar(AnsiString('__WSAFDIsSet')));
+        CloseSocket := GetProcAddress(LibHandle, PAnsiChar(AnsiString('closesocket')));
+        IoctlSocket := GetProcAddress(LibHandle, PAnsiChar(AnsiString('ioctlsocket')));
+        WSAGetLastError := GetProcAddress(LibHandle, PAnsiChar(AnsiString('WSAGetLastError')));
+        WSAStartup := GetProcAddress(LibHandle, PAnsiChar(AnsiString('WSAStartup')));
+        WSACleanup := GetProcAddress(LibHandle, PAnsiChar(AnsiString('WSACleanup')));
+        ssAccept := GetProcAddress(LibHandle, PAnsiChar(AnsiString('accept')));
+        ssBind := GetProcAddress(LibHandle, PAnsiChar(AnsiString('bind')));
+        ssConnect := GetProcAddress(LibHandle, PAnsiChar(AnsiString('connect')));
+        ssGetPeerName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getpeername')));
+        ssGetSockName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getsockname')));
+        GetSockOpt := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getsockopt')));
+        Htonl := GetProcAddress(LibHandle, PAnsiChar(AnsiString('htonl')));
+        Htons := GetProcAddress(LibHandle, PAnsiChar(AnsiString('htons')));
+        Inet_Addr := GetProcAddress(LibHandle, PAnsiChar(AnsiString('inet_addr')));
+        Inet_Ntoa := GetProcAddress(LibHandle, PAnsiChar(AnsiString('inet_ntoa')));
+        Listen := GetProcAddress(LibHandle, PAnsiChar(AnsiString('listen')));
+        Ntohl := GetProcAddress(LibHandle, PAnsiChar(AnsiString('ntohl')));
+        Ntohs := GetProcAddress(LibHandle, PAnsiChar(AnsiString('ntohs')));
+        ssRecv := GetProcAddress(LibHandle, PAnsiChar(AnsiString('recv')));
+        ssRecvFrom := GetProcAddress(LibHandle, PAnsiChar(AnsiString('recvfrom')));
+        Select := GetProcAddress(LibHandle, PAnsiChar(AnsiString('select')));
+        ssSend := GetProcAddress(LibHandle, PAnsiChar(AnsiString('send')));
+        ssSendTo := GetProcAddress(LibHandle, PAnsiChar(AnsiString('sendto')));
+        SetSockOpt := GetProcAddress(LibHandle, PAnsiChar(AnsiString('setsockopt')));
+        ShutDown := GetProcAddress(LibHandle, PAnsiChar(AnsiString('shutdown')));
+        Socket := GetProcAddress(LibHandle, PAnsiChar(AnsiString('socket')));
+        GetHostByAddr := GetProcAddress(LibHandle, PAnsiChar(AnsiString('gethostbyaddr')));
+        GetHostByName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('gethostbyname')));
+        GetProtoByName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getprotobyname')));
+        GetProtoByNumber := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getprotobynumber')));
+        GetServByName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getservbyname')));
+        GetServByPort := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getservbyport')));
+        ssGetHostName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('gethostname')));
+
+{$IFNDEF FORCEOLDAPI}
+        GetAddrInfo := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getaddrinfo')));
+        FreeAddrInfo := GetProcAddress(LibHandle, PAnsiChar(AnsiString('freeaddrinfo')));
+        GetNameInfo := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getnameinfo')));
+        SockEnhancedApi := Assigned(GetAddrInfo) and Assigned(FreeAddrInfo)
+          and Assigned(GetNameInfo);
+        if not SockEnhancedApi then
+        begin
+          LibWship6Handle := LoadLibrary(PChar(DLLWship6));
+          if LibWship6Handle <> 0 then
+          begin
+            GetAddrInfo := GetProcAddress(LibWship6Handle, PAnsiChar(AnsiString('getaddrinfo')));
+            FreeAddrInfo := GetProcAddress(LibWship6Handle, PAnsiChar(AnsiString('freeaddrinfo')));
+            GetNameInfo := GetProcAddress(LibWship6Handle, PAnsiChar(AnsiString('getnameinfo')));
+            SockWship6Api := Assigned(GetAddrInfo) and Assigned(FreeAddrInfo)
+              and Assigned(GetNameInfo);
+          end;
+        end;
+{$ENDIF}
+        Result := True;
+      end;
+    end
+    else Result := True;
+    if Result then
+      Inc(SynSockCount);
+  finally
+    SynSockCS.Leave;
+  end;
+end;
+
+function DestroySocketInterface: Boolean;
+begin
+  SynSockCS.Enter;
+  try
+    Dec(SynSockCount);
+    if SynSockCount < 0 then
+      SynSockCount := 0;
+    if SynSockCount = 0 then
+    begin
+      if LibHandle <> 0 then
+      begin
+        FreeLibrary(libHandle);
+        LibHandle := 0;
+      end;
+      if LibWship6Handle <> 0 then
+      begin
+        FreeLibrary(LibWship6Handle);
+        LibWship6Handle := 0;
+      end;
+    end;
+  finally
+    SynSockCS.Leave;
+  end;
+  Result := True;
+end;
+
+initialization
+begin
+  SynSockCS := SyncObjs.TCriticalSection.Create;
+  SET_IN6_IF_ADDR_ANY (@in6addr_any);
+  SET_LOOPBACK_ADDR6  (@in6addr_loopback);
+end;
+
+finalization
+begin
+  SynSockCS.Free;
 end;
\ No newline at end of file
diff --git a/Units/Synapse/synachar.pas b/Units/Synapse/synachar.pas
index af889f0..ff2e8b8 100644
--- a/Units/Synapse/synachar.pas
+++ b/Units/Synapse/synachar.pas
@@ -1,2035 +1,2035 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 005.002.002 |
-|==============================================================================|
-| Content: Charset conversion support                                          |
-|==============================================================================|
-| Copyright (c)1999-2004, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2000-2004.                |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{: @abstract(Charset conversion support)
-This unit contains a routines for lot of charset conversions.
-
-It using built-in conversion tables or external Iconv library. Iconv is used
- when needed conversion is known by Iconv library. When Iconv library is not
- found or Iconv not know requested conversion, then are internal routines used
- for conversion. (You can disable Iconv support from your program too!)
-
-Internal routines knows all major charsets for Europe or America. For East-Asian
- charsets you must use Iconv library!
-}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$Q-}
-{$H+}
-
-{$IFDEF UNICODE}
-  {$WARN IMPLICIT_STRING_CAST OFF}
-  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
-{$ENDIF}
-
-unit synachar;
-
-interface
-
-uses
-{$IFNDEF WIN32}
-  {$IFNDEF FPC}
-  Libc,
-  {$ELSE}
-    {$IFDEF FPC_USE_LIBC}
-  Libc,
-    {$ENDIF}
-  {$ENDIF}
-{$ELSE}
-  Windows,
-{$ENDIF}
-  SysUtils,
-  synautil, synacode, synaicnv;
-
-type
-  {:Type with all supported charsets.}
-  TMimeChar = (ISO_8859_1, ISO_8859_2, ISO_8859_3, ISO_8859_4, ISO_8859_5,
-    ISO_8859_6, ISO_8859_7, ISO_8859_8, ISO_8859_9, ISO_8859_10, ISO_8859_13,
-    ISO_8859_14, ISO_8859_15, CP1250, CP1251, CP1252, CP1253, CP1254, CP1255,
-    CP1256, CP1257, CP1258, KOI8_R, CP895, CP852, UCS_2, UCS_4, UTF_8, UTF_7,
-    UTF_7mod, UCS_2LE, UCS_4LE,
-    //next is supported by Iconv only...
-    UTF_16, UTF_16LE, UTF_32, UTF_32LE, C99, JAVA, ISO_8859_16, KOI8_U, KOI8_RU,
-    CP862, CP866, MAC, MACCE, MACICE, MACCRO, MACRO, MACCYR, MACUK, MACGR, MACTU,
-    MACHEB, MACAR, MACTH, ROMAN8, NEXTSTEP, ARMASCII, GEORGIAN_AC, GEORGIAN_PS,
-    KOI8_T, MULELAO, CP1133, TIS620, CP874, VISCII, TCVN, ISO_IR_14, JIS_X0201,
-    JIS_X0208, JIS_X0212, GB1988_80, GB2312_80, ISO_IR_165, ISO_IR_149, EUC_JP,
-    SHIFT_JIS, CP932, ISO_2022_JP, ISO_2022_JP1, ISO_2022_JP2, GB2312, CP936,
-    GB18030, ISO_2022_CN, ISO_2022_CNE, HZ, EUC_TW, BIG5, CP950, BIG5_HKSCS,
-    EUC_KR, CP949, CP1361, ISO_2022_KR, CP737, CP775, CP853, CP855, CP857,
-    CP858, CP860, CP861, CP863, CP864, CP865, CP869, CP1125);
-
-  {:Set of any charsets.}
-  TMimeSetChar = set of TMimeChar;
-
-const
-  {:Set of charsets supported by Iconv library only.}
-  IconvOnlyChars: set of TMimeChar = [UTF_16, UTF_16LE, UTF_32, UTF_32LE,
-    C99, JAVA, ISO_8859_16, KOI8_U, KOI8_RU, CP862, CP866, MAC, MACCE, MACICE,
-    MACCRO, MACRO, MACCYR, MACUK, MACGR, MACTU, MACHEB, MACAR, MACTH, ROMAN8,
-    NEXTSTEP, ARMASCII, GEORGIAN_AC, GEORGIAN_PS, KOI8_T, MULELAO, CP1133,
-    TIS620, CP874, VISCII, TCVN, ISO_IR_14, JIS_X0201, JIS_X0208, JIS_X0212,
-    GB1988_80, GB2312_80, ISO_IR_165, ISO_IR_149, EUC_JP, SHIFT_JIS, CP932,
-    ISO_2022_JP, ISO_2022_JP1, ISO_2022_JP2, GB2312, CP936, GB18030,
-    ISO_2022_CN, ISO_2022_CNE, HZ, EUC_TW, BIG5, CP950, BIG5_HKSCS, EUC_KR,
-    CP949, CP1361, ISO_2022_KR, CP737, CP775, CP853, CP855, CP857, CP858,
-    CP860, CP861, CP863, CP864, CP865, CP869, CP1125];
-
-  {:Set of charsets supported by internal routines only.}
-  NoIconvChars: set of TMimeChar = [CP895, UTF_7mod];
-
-  {:null character replace table. (Usable for disable charater replacing.)}
-  Replace_None: array[0..0] of Word =
-    (0);
-
-  {:Character replace table for remove Czech diakritics.}
-  Replace_Czech: array[0..59] of Word =
-    (
-      $00E1, $0061,
-      $010D, $0063,
-      $010F, $0064,
-      $010E, $0044,
-      $00E9, $0065,
-      $011B, $0065,
-      $00ED, $0069,
-      $0148, $006E,
-      $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,
-      $0147, $004E,
-      $00D3, $004F,
-      $0158, $0052,
-      $0160, $0053,
-      $0164, $0054,
-      $00DA, $0055,
-      $016E, $0055,
-      $00DD, $0059,
-      $017D, $005A
-    );
-
-var
-  {:By this you can generally disable/enable Iconv support.}
-  DisableIconv: Boolean = False;
-
-  {:Default set of charsets for @link(IdealCharsetCoding) function.}
-  IdealCharsets: TMimeSetChar =
-    [ISO_8859_1, ISO_8859_2, ISO_8859_3, ISO_8859_4, ISO_8859_5,
-    ISO_8859_6, ISO_8859_7, ISO_8859_8, ISO_8859_9, ISO_8859_10,
-    KOI8_R, KOI8_U
-    {$IFNDEF CIL} //error URW778 ??? :-O
-    , GB2312, EUC_KR, ISO_2022_JP, EUC_TW
-    {$ENDIF}
-    ];
-
-{==============================================================================}
-{:Convert Value from one charset to another. See: @link(CharsetConversionEx)}
-function CharsetConversion(const Value: AnsiString; CharFrom: TMimeChar;
-  CharTo: TMimeChar): AnsiString;
-
-{:Convert Value from one charset to another with additional character conversion.
-see: @link(Replace_None) and @link(Replace_Czech)}
-function CharsetConversionEx(const Value: AnsiString; CharFrom: TMimeChar;
-  CharTo: TMimeChar; const TransformTable: array of Word): AnsiString;
-
-{:Convert Value from one charset to another with additional character conversion.
- This funtion is similar to @link(CharsetConversionEx), but you can disable
- transliteration of unconvertible characters.}
-function CharsetConversionTrans(Value: AnsiString; CharFrom: TMimeChar;
-  CharTo: TMimeChar; const TransformTable: array of Word; Translit: Boolean): AnsiString;
-
-{:Returns charset used by operating system.}
-function GetCurCP: TMimeChar;
-
-{:Returns charset used by operating system as OEM charset. (in Windows DOS box,
- for example)}
-function GetCurOEMCP: TMimeChar;
-
-{:Converting string with charset name to TMimeChar.}
-function GetCPFromID(Value: AnsiString): TMimeChar;
-
-{:Converting TMimeChar to string with name of charset.}
-function GetIDFromCP(Value: TMimeChar): AnsiString;
-
-{:return @true when value need to be converted. (It is not 7-bit ASCII)}
-function NeedCharsetConversion(const Value: AnsiString): Boolean;
-
-{:Finding best target charset from set of TMimeChars with minimal count of
- unconvertible characters.}
-function IdealCharsetCoding(const Value: AnsiString; CharFrom: TMimeChar;
-  CharTo: TMimeSetChar): TMimeChar;
-
-{:Return BOM (Byte Order Mark) for given unicode charset.}
-function GetBOM(Value: TMimeChar): AnsiString;
-
-{:Convert binary string with unicode content to WideString.}
-function StringToWide(const Value: AnsiString): WideString;
-
-{:Convert WideString to binary string with unicode content.}
-function WideToString(const Value: WideString): AnsiString;
-
-{==============================================================================}
-implementation
-
-//character transcoding tables X to UCS-2
-{
-//dummy table
-$0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
-$0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
-$0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
-$0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
-$00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7,
-$00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF,
-$00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7,
-$00B8, $00B9, $00BA, $00BB, $00BC, $00BD, $00BE, $00BF,
-$00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7,
-$00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
-$00D0, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7,
-$00D8, $00D9, $00DA, $00DB, $00DC, $00DD, $00DE, $00DF,
-$00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7,
-$00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
-$00F0, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7,
-$00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $00FE, $00FF
-}
-
-const
-
-{Latin-1
-  Danish, Dutch, English, Faeroese, Finnish, French, German, Icelandic,
-  Irish, Italian, Norwegian, Portuguese, Spanish and Swedish.
-}
-  CharISO_8859_1: array[128..255] of Word =
-  (
-    $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
-    $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
-    $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
-    $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
-    $00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7,
-    $00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF,
-    $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7,
-    $00B8, $00B9, $00BA, $00BB, $00BC, $00BD, $00BE, $00BF,
-    $00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7,
-    $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
-    $00D0, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7,
-    $00D8, $00D9, $00DA, $00DB, $00DC, $00DD, $00DE, $00DF,
-    $00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7,
-    $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
-    $00F0, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7,
-    $00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $00FE, $00FF
-    );
-
-{Latin-2
-  Albanian, Czech, English, German, Hungarian, Polish, Rumanian,
-  Serbo-Croatian, Slovak, Slovene and Swedish.
-}
-  CharISO_8859_2: array[128..255] of Word =
-  (
-    $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
-    $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
-    $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
-    $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
-    $00A0, $0104, $02D8, $0141, $00A4, $013D, $015A, $00A7,
-    $00A8, $0160, $015E, $0164, $0179, $00AD, $017D, $017B,
-    $00B0, $0105, $02DB, $0142, $00B4, $013E, $015B, $02C7,
-    $00B8, $0161, $015F, $0165, $017A, $02DD, $017E, $017C,
-    $0154, $00C1, $00C2, $0102, $00C4, $0139, $0106, $00C7,
-    $010C, $00C9, $0118, $00CB, $011A, $00CD, $00CE, $010E,
-    $0110, $0143, $0147, $00D3, $00D4, $0150, $00D6, $00D7,
-    $0158, $016E, $00DA, $0170, $00DC, $00DD, $0162, $00DF,
-    $0155, $00E1, $00E2, $0103, $00E4, $013A, $0107, $00E7,
-    $010D, $00E9, $0119, $00EB, $011B, $00ED, $00EE, $010F,
-    $0111, $0144, $0148, $00F3, $00F4, $0151, $00F6, $00F7,
-    $0159, $016F, $00FA, $0171, $00FC, $00FD, $0163, $02D9
-    );
-
-{Latin-3
-  Afrikaans, Catalan, English, Esperanto, French, Galician,
-  German, Italian, Maltese and Turkish.
-}
-  CharISO_8859_3: array[128..255] of Word =
-  (
-    $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
-    $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
-    $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
-    $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
-    $00A0, $0126, $02D8, $00A3, $00A4, $FFFD, $0124, $00A7,
-    $00A8, $0130, $015E, $011E, $0134, $00AD, $FFFD, $017B,
-    $00B0, $0127, $00B2, $00B3, $00B4, $00B5, $0125, $00B7,
-    $00B8, $0131, $015F, $011F, $0135, $00BD, $FFFD, $017C,
-    $00C0, $00C1, $00C2, $FFFD, $00C4, $010A, $0108, $00C7,
-    $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
-    $FFFD, $00D1, $00D2, $00D3, $00D4, $0120, $00D6, $00D7,
-    $011C, $00D9, $00DA, $00DB, $00DC, $016C, $015C, $00DF,
-    $00E0, $00E1, $00E2, $FFFD, $00E4, $010B, $0109, $00E7,
-    $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
-    $FFFD, $00F1, $00F2, $00F3, $00F4, $0121, $00F6, $00F7,
-    $011D, $00F9, $00FA, $00FB, $00FC, $016D, $015D, $02D9
-    );
-
-{Latin-4
-  Danish, English, Estonian, Finnish, German, Greenlandic,
-  Lappish, Latvian, Lithuanian, Norwegian and Swedish.
-}
-  CharISO_8859_4: array[128..255] of Word =
-  (
-    $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
-    $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
-    $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
-    $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
-    $00A0, $0104, $0138, $0156, $00A4, $0128, $013B, $00A7,
-    $00A8, $0160, $0112, $0122, $0166, $00AD, $017D, $00AF,
-    $00B0, $0105, $02DB, $0157, $00B4, $0129, $013C, $02C7,
-    $00B8, $0161, $0113, $0123, $0167, $014A, $017E, $014B,
-    $0100, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $012E,
-    $010C, $00C9, $0118, $00CB, $0116, $00CD, $00CE, $012A,
-    $0110, $0145, $014C, $0136, $00D4, $00D5, $00D6, $00D7,
-    $00D8, $0172, $00DA, $00DB, $00DC, $0168, $016A, $00DF,
-    $0101, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $012F,
-    $010D, $00E9, $0119, $00EB, $0117, $00ED, $00EE, $012B,
-    $0111, $0146, $014D, $0137, $00F4, $00F5, $00F6, $00F7,
-    $00F8, $0173, $00FA, $00FB, $00FC, $0169, $016B, $02D9
-    );
-
-{CYRILLIC
-  Bulgarian, Bielorussian, English, Macedonian, Russian,
-  Serbo-Croatian and Ukrainian.
-}
-  CharISO_8859_5: array[128..255] of Word =
-  (
-    $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
-    $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
-    $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
-    $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
-    $00A0, $0401, $0402, $0403, $0404, $0405, $0406, $0407,
-    $0408, $0409, $040A, $040B, $040C, $00AD, $040E, $040F,
-    $0410, $0411, $0412, $0413, $0414, $0415, $0416, $0417,
-    $0418, $0419, $041A, $041B, $041C, $041D, $041E, $041F,
-    $0420, $0421, $0422, $0423, $0424, $0425, $0426, $0427,
-    $0428, $0429, $042A, $042B, $042C, $042D, $042E, $042F,
-    $0430, $0431, $0432, $0433, $0434, $0435, $0436, $0437,
-    $0438, $0439, $043A, $043B, $043C, $043D, $043E, $043F,
-    $0440, $0441, $0442, $0443, $0444, $0445, $0446, $0447,
-    $0448, $0449, $044A, $044B, $044C, $044D, $044E, $044F,
-    $2116, $0451, $0452, $0453, $0454, $0455, $0456, $0457,
-    $0458, $0459, $045A, $045B, $045C, $00A7, $045E, $045F
-    );
-
-{ARABIC
-}
-  CharISO_8859_6: array[128..255] of Word =
-  (
-    $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
-    $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
-    $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
-    $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
-    $00A0, $FFFD, $FFFD, $FFFD, $00A4, $FFFD, $FFFD, $FFFD,
-    $FFFD, $FFFD, $FFFD, $FFFD, $060C, $00AD, $FFFD, $FFFD,
-    $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD,
-    $FFFD, $FFFD, $FFFD, $061B, $FFFD, $FFFD, $FFFD, $061F,
-    $FFFD, $0621, $0622, $0623, $0624, $0625, $0626, $0627,
-    $0628, $0629, $062A, $062B, $062C, $062D, $062E, $062F,
-    $0630, $0631, $0632, $0633, $0634, $0635, $0636, $0637,
-    $0638, $0639, $063A, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD,
-    $0640, $0641, $0642, $0643, $0644, $0645, $0646, $0647,
-    $0648, $0649, $064A, $064B, $064C, $064D, $064E, $064F,
-    $0650, $0651, $0652, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD,
-    $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD
-    );
-
-{GREEK
-}
-  CharISO_8859_7: array[128..255] of Word =
-  (
-    $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
-    $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
-    $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
-    $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
-    $00A0, $2018, $2019, $00A3, $FFFD, $FFFD, $00A6, $00A7,
-    $00A8, $00A9, $FFFD, $00AB, $00AC, $00AD, $FFFD, $2015,
-    $00B0, $00B1, $00B2, $00B3, $0384, $0385, $0386, $00B7,
-    $0388, $0389, $038A, $00BB, $038C, $00BD, $038E, $038F,
-    $0390, $0391, $0392, $0393, $0394, $0395, $0396, $0397,
-    $0398, $0399, $039A, $039B, $039C, $039D, $039E, $039F,
-    $03A0, $03A1, $FFFD, $03A3, $03A4, $03A5, $03A6, $03A7,
-    $03A8, $03A9, $03AA, $03AB, $03AC, $03AD, $03AE, $03AF,
-    $03B0, $03B1, $03B2, $03B3, $03B4, $03B5, $03B6, $03B7,
-    $03B8, $03B9, $03BA, $03BB, $03BC, $03BD, $03BE, $03BF,
-    $03C0, $03C1, $03C2, $03C3, $03C4, $03C5, $03C6, $03C7,
-    $03C8, $03C9, $03CA, $03CB, $03CC, $03CD, $03CE, $FFFD
-    );
-
-{HEBREW
-}
-  CharISO_8859_8: array[128..255] of Word =
-  (
-    $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
-    $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
-    $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
-    $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
-    $00A0, $FFFD, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7,
-    $00A8, $00A9, $00D7, $00AB, $00AC, $00AD, $00AE, $00AF,
-    $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7,
-    $00B8, $00B9, $00F7, $00BB, $00BC, $00BD, $00BE, $FFFD,
-    $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD,
-    $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD,
-    $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD,
-    $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $2017,
-    $05D0, $05D1, $05D2, $05D3, $05D4, $05D5, $05D6, $05D7,
-    $05D8, $05D9, $05DA, $05DB, $05DC, $05DD, $05DE, $05DF,
-    $05E0, $05E1, $05E2, $05E3, $05E4, $05E5, $05E6, $05E7,
-    $05E8, $05E9, $05EA, $FFFD, $FFFD, $200E, $200F, $FFFD
-    );
-
-{Latin-5
-  English, Finnish, French, German, Irish, Italian, Norwegian,
-  Portuguese, Spanish, Swedish and Turkish.
-}
-  CharISO_8859_9: array[128..255] of Word =
-  (
-    $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
-    $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
-    $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
-    $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
-    $00A0, $0104, $02D8, $0141, $00A4, $013D, $015A, $00A7,
-    $00A8, $0160, $015E, $0164, $0179, $00AD, $017D, $017B,
-    $00B0, $0105, $02DB, $0142, $00B4, $013E, $015B, $02C7,
-    $00B8, $0161, $015F, $0165, $017A, $02DD, $017E, $017C,
-    $0154, $00C1, $00C2, $0102, $00C4, $0139, $0106, $00C7,
-    $010C, $00C9, $0118, $00CB, $011A, $00CD, $00CE, $010E,
-    $011E, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7,
-    $00D8, $00D9, $00DA, $00DB, $00DC, $0130, $015E, $00DF,
-    $00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7,
-    $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
-    $011F, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7,
-    $00F8, $00F9, $00FA, $00FB, $00FC, $0131, $015F, $00FF
-    );
-
-{Latin-6
-  Danish, English, Estonian, Faeroese, Finnish, German, Greenlandic,
-  Icelandic, Lappish, Latvian, Lithuanian, Norwegian and Swedish.
-}
-  CharISO_8859_10: array[128..255] of Word =
-  (
-    $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
-    $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
-    $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
-    $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
-    $00A0, $0104, $0112, $0122, $012A, $0128, $0136, $00A7,
-    $013B, $0110, $0160, $0166, $017D, $00AD, $016A, $014A,
-    $00B0, $0105, $0113, $0123, $012B, $0129, $0137, $00B7,
-    $013C, $0111, $0161, $0167, $017E, $2015, $016B, $014B,
-    $0100, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $012E,
-    $010C, $00C9, $0118, $00CB, $0116, $00CD, $00CE, $00CF,
-    $00D0, $0145, $014C, $00D3, $00D4, $00D5, $00D6, $0168,
-    $00D8, $0172, $00DA, $00DB, $00DC, $00DD, $00DE, $00DF,
-    $0101, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $012F,
-    $010D, $00E9, $0119, $00EB, $0117, $00ED, $00EE, $00EF,
-    $00F0, $0146, $014D, $00F3, $00F4, $00F5, $00F6, $0169,
-    $00F8, $0173, $00FA, $00FB, $00FC, $00FD, $00FE, $0138
-    );
-
-  CharISO_8859_13: array[128..255] of Word =
-  (
-    $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
-    $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
-    $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
-    $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
-    $00A0, $201D, $00A2, $00A3, $00A4, $201E, $00A6, $00A7,
-    $00D8, $00A9, $0156, $00AB, $00AC, $00AD, $00AE, $00C6,
-    $00B0, $00B1, $00B2, $00B3, $201C, $00B5, $00B6, $00B7,
-    $00F8, $00B9, $0157, $00BB, $00BC, $00BD, $00BE, $00E6,
-    $0104, $012E, $0100, $0106, $00C4, $00C5, $0118, $0112,
-    $010C, $00C9, $0179, $0116, $0122, $0136, $012A, $013B,
-    $0160, $0143, $0145, $00D3, $014C, $00D5, $00D6, $00D7,
-    $0172, $0141, $015A, $016A, $00DC, $017B, $017D, $00DF,
-    $0105, $012F, $0101, $0107, $00E4, $00E5, $0119, $0113,
-    $010D, $00E9, $017A, $0117, $0123, $0137, $012B, $013C,
-    $0161, $0144, $0146, $00F3, $014D, $00F5, $00F6, $00F7,
-    $0173, $0142, $015B, $016B, $00FC, $017C, $017E, $2019
-    );
-
-  CharISO_8859_14: array[128..255] of Word =
-  (
-    $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
-    $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
-    $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
-    $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
-    $00A0, $1E02, $1E03, $00A3, $010A, $010B, $1E0A, $00A7,
-    $1E80, $00A9, $1E82, $1E0B, $1EF2, $00AD, $00AE, $0178,
-    $1E1E, $1E1F, $0120, $0121, $1E40, $1E41, $00B6, $1E56,
-    $1E81, $1E57, $1E83, $1E60, $1EF3, $1E84, $1E85, $1E61,
-    $00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7,
-    $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
-    $0174, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $1E6A,
-    $00D8, $00D9, $00DA, $00DB, $00DC, $00DD, $0176, $00DF,
-    $00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7,
-    $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
-    $0175, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $1E6B,
-    $00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $0177, $00FF
-    );
-
-  CharISO_8859_15: array[128..255] of Word =
-  (
-    $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
-    $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
-    $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
-    $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
-    $00A0, $00A1, $00A2, $00A3, $20AC, $00A5, $0160, $00A7,
-    $0161, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF,
-    $00B0, $00B1, $00B2, $00B3, $017D, $00B5, $00B6, $00B7,
-    $017E, $00B9, $00BA, $00BB, $0152, $0153, $0178, $00BF,
-    $00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7,
-    $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
-    $00D0, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7,
-    $00D8, $00D9, $00DA, $00DB, $00DC, $00DD, $00DE, $00DF,
-    $00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7,
-    $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
-    $00F0, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7,
-    $00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $00FE, $00FF
-    );
-
-{Eastern European
-}
-  CharCP_1250: array[128..255] of Word =
-  (
-    $20AC, $FFFD, $201A, $FFFD, $201E, $2026, $2020, $2021,
-    $FFFD, $2030, $0160, $2039, $015A, $0164, $017D, $0179,
-    $FFFD, $2018, $2019, $201C, $201D, $2022, $2013, $2014,
-    $FFFD, $2122, $0161, $203A, $015B, $0165, $017E, $017A,
-    $00A0, $02C7, $02D8, $0141, $00A4, $0104, $00A6, $00A7,
-    $00A8, $00A9, $015E, $00AB, $00AC, $00AD, $00AE, $017B,
-    $00B0, $00B1, $02DB, $0142, $00B4, $00B5, $00B6, $00B7,
-    $00B8, $0105, $015F, $00BB, $013D, $02DD, $013E, $017C,
-    $0154, $00C1, $00C2, $0102, $00C4, $0139, $0106, $00C7,
-    $010C, $00C9, $0118, $00CB, $011A, $00CD, $00CE, $010E,
-    $0110, $0143, $0147, $00D3, $00D4, $0150, $00D6, $00D7,
-    $0158, $016E, $00DA, $0170, $00DC, $00DD, $0162, $00DF,
-    $0155, $00E1, $00E2, $0103, $00E4, $013A, $0107, $00E7,
-    $010D, $00E9, $0119, $00EB, $011B, $00ED, $00EE, $010F,
-    $0111, $0144, $0148, $00F3, $00F4, $0151, $00F6, $00F7,
-    $0159, $016F, $00FA, $0171, $00FC, $00FD, $0163, $02D9
-    );
-
-{Cyrillic
-}
-  CharCP_1251: array[128..255] of Word =
-  (
-    $0402, $0403, $201A, $0453, $201E, $2026, $2020, $2021,
-    $20AC, $2030, $0409, $2039, $040A, $040C, $040B, $040F,
-    $0452, $2018, $2019, $201C, $201D, $2022, $2013, $2014,
-    $FFFD, $2122, $0459, $203A, $045A, $045C, $045B, $045F,
-    $00A0, $040E, $045E, $0408, $00A4, $0490, $00A6, $00A7,
-    $0401, $00A9, $0404, $00AB, $00AC, $00AD, $00AE, $0407,
-    $00B0, $00B1, $0406, $0456, $0491, $00B5, $00B6, $00B7,
-    $0451, $2116, $0454, $00BB, $0458, $0405, $0455, $0457,
-    $0410, $0411, $0412, $0413, $0414, $0415, $0416, $0417,
-    $0418, $0419, $041A, $041B, $041C, $041D, $041E, $041F,
-    $0420, $0421, $0422, $0423, $0424, $0425, $0426, $0427,
-    $0428, $0429, $042A, $042B, $042C, $042D, $042E, $042F,
-    $0430, $0431, $0432, $0433, $0434, $0435, $0436, $0437,
-    $0438, $0439, $043A, $043B, $043C, $043D, $043E, $043F,
-    $0440, $0441, $0442, $0443, $0444, $0445, $0446, $0447,
-    $0448, $0449, $044A, $044B, $044C, $044D, $044E, $044F
-    );
-
-{Latin-1 (US, Western Europe)
-}
-  CharCP_1252: array[128..255] of Word =
-  (
-    $20AC, $FFFD, $201A, $0192, $201E, $2026, $2020, $2021,
-    $02C6, $2030, $0160, $2039, $0152, $FFFD, $017D, $FFFD,
-    $FFFD, $2018, $2019, $201C, $201D, $2022, $2013, $2014,
-    $02DC, $2122, $0161, $203A, $0153, $FFFD, $017E, $0178,
-    $00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7,
-    $00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF,
-    $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7,
-    $00B8, $00B9, $00BA, $00BB, $00BC, $00BD, $00BE, $00BF,
-    $00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7,
-    $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
-    $00D0, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7,
-    $00D8, $00D9, $00DA, $00DB, $00DC, $00DD, $00DE, $00DF,
-    $00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7,
-    $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
-    $00F0, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7,
-    $00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $00FE, $00FF
-    );
-
-{Greek
-}
-  CharCP_1253: array[128..255] of Word =
-  (
-    $20AC, $FFFD, $201A, $0192, $201E, $2026, $2020, $2021,
-    $FFFD, $2030, $FFFD, $2039, $FFFD, $FFFD, $FFFD, $FFFD,
-    $FFFD, $2018, $2019, $201C, $201D, $2022, $2013, $2014,
-    $FFFD, $2122, $FFFD, $203A, $FFFD, $FFFD, $FFFD, $FFFD,
-    $00A0, $0385, $0386, $00A3, $00A4, $00A5, $00A6, $00A7,
-    $00A8, $00A9, $FFFD, $00AB, $00AC, $00AD, $00AE, $2015,
-    $00B0, $00B1, $00B2, $00B3, $0384, $00B5, $00B6, $00B7,
-    $0388, $0389, $038A, $00BB, $038C, $00BD, $038E, $038F,
-    $0390, $0391, $0392, $0393, $0394, $0395, $0396, $0397,
-    $0398, $0399, $039A, $039B, $039C, $039D, $039E, $039F,
-    $03A0, $03A1, $FFFD, $03A3, $03A4, $03A5, $03A6, $03A7,
-    $03A8, $03A9, $03AA, $03AB, $03AC, $03AD, $03AE, $03AF,
-    $03B0, $03B1, $03B2, $03B3, $03B4, $03B5, $03B6, $03B7,
-    $03B8, $03B9, $03BA, $03BB, $03BC, $03BD, $03BE, $03BF,
-    $03C0, $03C1, $03C2, $03C3, $03C4, $03C5, $03C6, $03C7,
-    $03C8, $03C9, $03CA, $03CB, $03CC, $03CD, $03CE, $FFFD
-    );
-
-{Turkish
-}
-  CharCP_1254: array[128..255] of Word =
-  (
-    $20AC, $FFFD, $201A, $0192, $201E, $2026, $2020, $2021,
-    $02C6, $2030, $0160, $2039, $0152, $FFFD, $FFFD, $FFFD,
-    $FFFD, $2018, $2019, $201C, $201D, $2022, $2013, $2014,
-    $02DC, $2122, $0161, $203A, $0153, $FFFD, $FFFD, $0178,
-    $00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7,
-    $00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF,
-    $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7,
-    $00B8, $00B9, $00BA, $00BB, $00BC, $00BD, $00BE, $00BF,
-    $00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7,
-    $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
-    $011E, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7,
-    $00D8, $00D9, $00DA, $00DB, $00DC, $0130, $015E, $00DF,
-    $00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7,
-    $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
-    $011F, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7,
-    $00F8, $00F9, $00FA, $00FB, $00FC, $0131, $015F, $00FF
-    );
-
-{Hebrew
-}
-  CharCP_1255: array[128..255] of Word =
-  (
-    $20AC, $FFFD, $201A, $0192, $201E, $2026, $2020, $2021,
-    $02C6, $2030, $FFFD, $2039, $FFFD, $FFFD, $FFFD, $FFFD,
-    $FFFD, $2018, $2019, $201C, $201D, $2022, $2013, $2014,
-    $02DC, $2122, $FFFD, $203A, $FFFD, $FFFD, $FFFD, $FFFD,
-    $00A0, $00A1, $00A2, $00A3, $20AA, $00A5, $00A6, $00A7,
-    $00A8, $00A9, $00D7, $00AB, $00AC, $00AD, $00AE, $00AF,
-    $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7,
-    $00B8, $00B9, $00F7, $00BB, $00BC, $00BD, $00BE, $00BF,
-    $05B0, $05B1, $05B2, $05B3, $05B4, $05B5, $05B6, $05B7,
-    $05B8, $05B9, $FFFD, $05BB, $05BC, $05BD, $05BE, $05BF,
-    $05C0, $05C1, $05C2, $05C3, $05F0, $05F1, $05F2, $05F3,
-    $05F4, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD,
-    $05D0, $05D1, $05D2, $05D3, $05D4, $05D5, $05D6, $05D7,
-    $05D8, $05D9, $05DA, $05DB, $05DC, $05DD, $05DE, $05DF,
-    $05E0, $05E1, $05E2, $05E3, $05E4, $05E5, $05E6, $05E7,
-    $05E8, $05E9, $05EA, $FFFD, $FFFD, $200E, $200F, $FFFD
-    );
-
-{Arabic
-}
-  CharCP_1256: array[128..255] of Word =
-  (
-    $20AC, $067E, $201A, $0192, $201E, $2026, $2020, $2021,
-    $02C6, $2030, $0679, $2039, $0152, $0686, $0698, $0688,
-    $06AF, $2018, $2019, $201C, $201D, $2022, $2013, $2014,
-    $06A9, $2122, $0691, $203A, $0153, $200C, $200D, $06BA,
-    $00A0, $060C, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7,
-    $00A8, $00A9, $06BE, $00AB, $00AC, $00AD, $00AE, $00AF,
-    $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7,
-    $00B8, $00B9, $061B, $00BB, $00BC, $00BD, $00BE, $061F,
-    $06C1, $0621, $0622, $0623, $0624, $0625, $0626, $0627,
-    $0628, $0629, $062A, $062B, $062C, $062D, $062E, $062F,
-    $0630, $0631, $0632, $0633, $0634, $0635, $0636, $00D7,
-    $0637, $0638, $0639, $063A, $0640, $0641, $0642, $0643,
-    $00E0, $0644, $00E2, $0645, $0646, $0647, $0648, $00E7,
-    $00E8, $00E9, $00EA, $00EB, $0649, $064A, $00EE, $00EF,
-    $064B, $064C, $064D, $064E, $00F4, $064F, $0650, $00F7,
-    $0651, $00F9, $0652, $00FB, $00FC, $200E, $200F, $06D2
-    );
-
-{Baltic
-}
-  CharCP_1257: array[128..255] of Word =
-  (
-    $20AC, $FFFD, $201A, $FFFD, $201E, $2026, $2020, $2021,
-    $FFFD, $2030, $FFFD, $2039, $FFFD, $00A8, $02C7, $00B8,
-    $FFFD, $2018, $2019, $201C, $201D, $2022, $2013, $2014,
-    $FFFD, $2122, $FFFD, $203A, $FFFD, $00AF, $02DB, $FFFD,
-    $00A0, $FFFD, $00A2, $00A3, $00A4, $FFFD, $00A6, $00A7,
-    $00D8, $00A9, $0156, $00AB, $00AC, $00AD, $00AE, $00C6,
-    $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7,
-    $00F8, $00B9, $0157, $00BB, $00BC, $00BD, $00BE, $00E6,
-    $0104, $012E, $0100, $0106, $00C4, $00C5, $0118, $0112,
-    $010C, $00C9, $0179, $0116, $0122, $0136, $012A, $013B,
-    $0160, $0143, $0145, $00D3, $014C, $00D5, $00D6, $00D7,
-    $0172, $0141, $015A, $016A, $00DC, $017B, $017D, $00DF,
-    $0105, $012F, $0101, $0107, $00E4, $00E5, $0119, $0113,
-    $010D, $00E9, $017A, $0117, $0123, $0137, $012B, $013C,
-    $0161, $0144, $0146, $00F3, $014D, $00F5, $00F6, $00F7,
-    $0173, $0142, $015B, $016B, $00FC, $017C, $017E, $02D9
-    );
-
-{Vietnamese
-}
-  CharCP_1258: array[128..255] of Word =
-  (
-    $20AC, $FFFD, $201A, $0192, $201E, $2026, $2020, $2021,
-    $02C6, $2030, $FFFD, $2039, $0152, $FFFD, $FFFD, $FFFD,
-    $FFFD, $2018, $2019, $201C, $201D, $2022, $2013, $2014,
-    $02DC, $2122, $FFFD, $203A, $0153, $FFFD, $FFFD, $0178,
-    $00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7,
-    $00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF,
-    $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7,
-    $00B8, $00B9, $00BA, $00BB, $00BC, $00BD, $00BE, $00BF,
-    $00C0, $00C1, $00C2, $0102, $00C4, $00C5, $00C6, $00C7,
-    $00C8, $00C9, $00CA, $00CB, $0300, $00CD, $00CE, $00CF,
-    $0110, $00D1, $0309, $00D3, $00D4, $01A0, $00D6, $00D7,
-    $00D8, $00D9, $00DA, $00DB, $00DC, $01AF, $0303, $00DF,
-    $00E0, $00E1, $00E2, $0103, $00E4, $00E5, $00E6, $00E7,
-    $00E8, $00E9, $00EA, $00EB, $0301, $00ED, $00EE, $00EF,
-    $0111, $00F1, $0323, $00F3, $00F4, $01A1, $00F6, $00F7,
-    $00F8, $00F9, $00FA, $00FB, $00FC, $01B0, $20AB, $00FF
-    );
-
-{Cyrillic
-}
-  CharKOI8_R: array[128..255] of Word =
-  (
-    $2500, $2502, $250C, $2510, $2514, $2518, $251C, $2524,
-    $252C, $2534, $253C, $2580, $2584, $2588, $258C, $2590,
-    $2591, $2592, $2593, $2320, $25A0, $2219, $221A, $2248,
-    $2264, $2265, $00A0, $2321, $00B0, $00B2, $00B7, $00F7,
-    $2550, $2551, $2552, $0451, $2553, $2554, $2555, $2556,
-    $2557, $2558, $2559, $255A, $255B, $255C, $255D, $255E,
-    $255F, $2560, $2561, $0401, $2562, $2563, $2564, $2565,
-    $2566, $2567, $2568, $2569, $256A, $256B, $256C, $00A9,
-    $044E, $0430, $0431, $0446, $0434, $0435, $0444, $0433,
-    $0445, $0438, $0439, $043A, $043B, $043C, $043D, $043E,
-    $043F, $044F, $0440, $0441, $0442, $0443, $0436, $0432,
-    $044C, $044B, $0437, $0448, $044D, $0449, $0447, $044A,
-    $042E, $0410, $0411, $0426, $0414, $0415, $0424, $0413,
-    $0425, $0418, $0419, $041A, $041B, $041C, $041D, $041E,
-    $041F, $042F, $0420, $0421, $0422, $0423, $0416, $0412,
-    $042C, $042B, $0417, $0428, $042D, $0429, $0427, $042A
-    );
-
-{Czech (Kamenicky)
-}
-  CharCP_895: array[128..255] of Word =
-  (
-    $010C, $00FC, $00E9, $010F, $00E4, $010E, $0164, $010D,
-    $011B, $011A, $0139, $00CD, $013E, $013A, $00C4, $00C1,
-    $00C9, $017E, $017D, $00F4, $00F6, $00D3, $016F, $00DA,
-    $00FD, $00D6, $00DC, $0160, $013D, $00DD, $0158, $0165,
-    $00E1, $00ED, $00F3, $00FA, $0148, $0147, $016E, $00D4,
-    $0161, $0159, $0155, $0154, $00BC, $00A7, $00AB, $00BB,
-    $2591, $2592, $2593, $2502, $2524, $2561, $2562, $2556,
-    $2555, $2563, $2551, $2557, $255D, $255C, $255B, $2510,
-    $2514, $2534, $252C, $251C, $2500, $253C, $255E, $255F,
-    $255A, $2554, $2569, $2566, $2560, $2550, $256C, $2567,
-    $2568, $2564, $2565, $2559, $2558, $2552, $2553, $256B,
-    $256A, $2518, $250C, $2588, $2584, $258C, $2590, $2580,
-    $03B1, $03B2, $0393, $03C0, $03A3, $03C3, $03BC, $03C4,
-    $03A6, $0398, $03A9, $03B4, $221E, $2205, $03B5, $2229,
-    $2261, $00B1, $2265, $2264, $2320, $2321, $00F7, $2248,
-    $2218, $00B7, $2219, $221A, $207F, $00B2, $25A0, $00A0
-    );
-
-{Eastern European
-}
-  CharCP_852: array[128..255] of Word =
-  (
-    $00C7, $00FC, $00E9, $00E2, $00E4, $016F, $0107, $00E7,
-    $0142, $00EB, $0150, $0151, $00EE, $0179, $00C4, $0106,
-    $00C9, $0139, $013A, $00F4, $00F6, $013D, $013E, $015A,
-    $015B, $00D6, $00DC, $0164, $0165, $0141, $00D7, $010D,
-    $00E1, $00ED, $00F3, $00FA, $0104, $0105, $017D, $017E,
-    $0118, $0119, $00AC, $017A, $010C, $015F, $00AB, $00BB,
-    $2591, $2592, $2593, $2502, $2524, $00C1, $00C2, $011A,
-    $015E, $2563, $2551, $2557, $255D, $017B, $017C, $2510,
-    $2514, $2534, $252C, $251C, $2500, $253C, $0102, $0103,
-    $255A, $2554, $2569, $2566, $2560, $2550, $256C, $00A4,
-    $0111, $0110, $010E, $00CB, $010F, $0147, $00CD, $00CE,
-    $011B, $2518, $250C, $2588, $2584, $0162, $016E, $2580,
-    $00D3, $00DF, $00D4, $0143, $0144, $0148, $0160, $0161,
-    $0154, $00DA, $0155, $0170, $00FD, $00DD, $0163, $00B4,
-    $00AD, $02DD, $02DB, $02C7, $02D8, $00A7, $00F7, $00B8,
-    $00B0, $00A8, $02D9, $0171, $0158, $0159, $25A0, $00A0
-    );
-
-{==============================================================================}
-type
-  TIconvChar = record
-    Charset: TMimeChar;
-    CharName: string;
-  end;
-  TIconvArr = array [0..112] of TIconvChar;
-
-const
-  NotFoundChar = '_';
-
-var
-  SetTwo: set of TMimeChar = [UCS_2, UCS_2LE, UTF_7, UTF_7mod];
-  SetFour: set of TMimeChar = [UCS_4, UCS_4LE, UTF_8];
-  SetLE: set of TMimeChar = [UCS_2LE, UCS_4LE];
-
-  IconvArr: TIconvArr;
-
-{==============================================================================}
-function FindIconvID(const Value, Charname: string): Boolean;
-var
-  s: string;
-begin
-  Result := True;
-  //exact match
-  if Value = Charname then
-    Exit;
-  //Value is on begin of charname
-  s := Value + ' ';
-  if s = Copy(Charname, 1, Length(s)) then
-    Exit;
-  //Value is on end of charname
-  s := ' ' + Value;
-  if s = Copy(Charname, Length(Charname) - Length(s) + 1, Length(s)) then
-    Exit;
-  //value is somewhere inside charname
-  if Pos( s + ' ', Charname) > 0 then
-    Exit;
-  Result := False;
-end;
-
-function GetCPFromIconvID(Value: AnsiString): TMimeChar;
-var
-  n: integer;
-begin
-  Result := ISO_8859_1;
-  Value := UpperCase(Value);
-  for n := 0 to High(IconvArr) do
-    if FindIconvID(Value, IconvArr[n].Charname) then
-    begin
-      Result := IconvArr[n].Charset;
-      Break;
-    end;
-end;
-
-{==============================================================================}
-function GetIconvIDFromCP(Value: TMimeChar): AnsiString;
-var
-  n: integer;
-begin
-  Result := 'ISO-8859-1';
-  for n := 0 to High(IconvArr) do
-    if IconvArr[n].Charset = Value then
-    begin
-      Result := Separateleft(IconvArr[n].Charname, ' ');
-      Break;
-    end;
-end;
-
-{==============================================================================}
-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
-  n: Integer;
-begin
-  for n := 0 to 127 do
-    TargetTable[n] := SourceTable[n];
-end;
-
-{==============================================================================}
-procedure GetArray(CharSet: TMimeChar; var Result: array of Word);
-begin
-  case CharSet of
-    ISO_8859_2:
-      CopyArray(CharISO_8859_2, Result);
-    ISO_8859_3:
-      CopyArray(CharISO_8859_3, Result);
-    ISO_8859_4:
-      CopyArray(CharISO_8859_4, Result);
-    ISO_8859_5:
-      CopyArray(CharISO_8859_5, Result);
-    ISO_8859_6:
-      CopyArray(CharISO_8859_6, Result);
-    ISO_8859_7:
-      CopyArray(CharISO_8859_7, Result);
-    ISO_8859_8:
-      CopyArray(CharISO_8859_8, Result);
-    ISO_8859_9:
-      CopyArray(CharISO_8859_9, Result);
-    ISO_8859_10:
-      CopyArray(CharISO_8859_10, Result);
-    ISO_8859_13:
-      CopyArray(CharISO_8859_13, Result);
-    ISO_8859_14:
-      CopyArray(CharISO_8859_14, Result);
-    ISO_8859_15:
-      CopyArray(CharISO_8859_15, Result);
-    CP1250:
-      CopyArray(CharCP_1250, Result);
-    CP1251:
-      CopyArray(CharCP_1251, Result);
-    CP1252:
-      CopyArray(CharCP_1252, Result);
-    CP1253:
-      CopyArray(CharCP_1253, Result);
-    CP1254:
-      CopyArray(CharCP_1254, Result);
-    CP1255:
-      CopyArray(CharCP_1255, Result);
-    CP1256:
-      CopyArray(CharCP_1256, Result);
-    CP1257:
-      CopyArray(CharCP_1257, Result);
-    CP1258:
-      CopyArray(CharCP_1258, Result);
-    KOI8_R:
-      CopyArray(CharKOI8_R, Result);
-    CP895:
-      CopyArray(CharCP_895, Result);
-    CP852:
-      CopyArray(CharCP_852, Result);
-  else
-      CopyArray(CharISO_8859_1, Result);
-  end;
-end;
-
-{==============================================================================}
-procedure ReadMulti(const Value: AnsiString; var Index: Integer; mb: Byte;
-  var b1, b2, b3, b4: Byte; le: boolean);
-Begin
-  b1 := 0;
-  b2 := 0;
-  b3 := 0;
-  b4 := 0;
-  if Index < 0 then
-    Index := 1;
-  if mb > 4 then
-    mb := 1;
-  if (Index + mb - 1) <= Length(Value) then
-  begin
-    if le then
-      Case mb Of
-        1:
-          b1 := Ord(Value[Index]);
-        2:
-          Begin
-            b1 := Ord(Value[Index]);
-            b2 := Ord(Value[Index + 1]);
-          End;
-        3:
-          Begin
-            b1 := Ord(Value[Index]);
-            b2 := Ord(Value[Index + 1]);
-            b3 := Ord(Value[Index + 2]);
-          End;
-        4:
-          Begin
-            b1 := Ord(Value[Index]);
-            b2 := Ord(Value[Index + 1]);
-            b3 := Ord(Value[Index + 2]);
-            b4 := Ord(Value[Index + 3]);
-          End;
-      end
-    else
-      Case mb Of
-        1:
-          b1 := Ord(Value[Index]);
-        2:
-          Begin
-            b2 := Ord(Value[Index]);
-            b1 := Ord(Value[Index + 1]);
-          End;
-        3:
-          Begin
-            b3 := Ord(Value[Index]);
-            b2 := Ord(Value[Index + 1]);
-            b1 := Ord(Value[Index + 2]);
-          End;
-        4:
-          Begin
-            b4 := Ord(Value[Index]);
-            b3 := Ord(Value[Index + 1]);
-            b2 := Ord(Value[Index + 2]);
-            b1 := Ord(Value[Index + 3]);
-          End;
-      end;
-  end;
-  Inc(Index, mb);
-end;
-
-{==============================================================================}
-function WriteMulti(b1, b2, b3, b4: Byte; mb: Byte; le: boolean): AnsiString;
-begin
-  if mb > 4 then
-    mb := 1;
-  SetLength(Result, mb);
-  if le then
-    case mb Of
-      1:
-        Result[1] := AnsiChar(b1);
-      2:
-        begin
-          Result[1] := AnsiChar(b1);
-          Result[2] := AnsiChar(b2);
-        end;
-      3:
-        begin
-          Result[1] := AnsiChar(b1);
-          Result[2] := AnsiChar(b2);
-          Result[3] := AnsiChar(b3);
-        end;
-      4:
-        begin
-          Result[1] := AnsiChar(b1);
-          Result[2] := AnsiChar(b2);
-          Result[3] := AnsiChar(b3);
-          Result[4] := AnsiChar(b4);
-        end;
-    end
-  else
-    case mb Of
-      1:
-        Result[1] := AnsiChar(b1);
-      2:
-        begin
-          Result[2] := AnsiChar(b1);
-          Result[1] := AnsiChar(b2);
-        end;
-      3:
-        begin
-          Result[3] := AnsiChar(b1);
-          Result[2] := AnsiChar(b2);
-          Result[1] := AnsiChar(b3);
-        end;
-      4:
-        begin
-          Result[4] := AnsiChar(b1);
-          Result[3] := AnsiChar(b2);
-          Result[2] := AnsiChar(b3);
-          Result[1] := AnsiChar(b4);
-        end;
-    end;
-end;
-
-{==============================================================================}
-function UTF8toUCS4(const Value: AnsiString): AnsiString;
-var
-  n, x, ul, m: Integer;
-  s: AnsiString;
-  w1, w2: Word;
-begin
-  Result := '';
-  n := 1;
-  while Length(Value) >= n do
-  begin
-    x := Ord(Value[n]);
-    Inc(n);
-    if x < 128 then
-      Result := Result + WriteMulti(x, 0, 0, 0, 4, false)
-    else
-    begin
-      m := 0;
-      if (x and $E0) = $C0 then
-        m := $1F;
-      if (x and $F0) = $E0 then
-        m := $0F;
-      if (x and $F8) = $F0 then
-        m := $07;
-      if (x and $FC) = $F8 then
-        m := $03;
-      if (x and $FE) = $FC then
-        m := $01;
-      ul := x and m;
-      s := IntToBin(ul, 0);
-      while Length(Value) >= n do
-      begin
-        x := Ord(Value[n]);
-        Inc(n);
-        if (x and $C0) = $80 then
-          s := s + IntToBin(x and $3F, 6)
-        else
-        begin
-          Dec(n);
-          Break;
-        end;
-      end;
-      ul := BinToInt(s);
-      w1 := ul div 65536;
-      w2 := ul mod 65536;
-      Result := Result + WriteMulti(Lo(w2), Hi(w2), Lo(w1), Hi(w1), 4, false);
-    end;
-  end;
-end;
-
-{==============================================================================}
-function UCS4toUTF8(const Value: AnsiString): AnsiString;
-var
-  s, l, k: AnsiString;
-  b1, b2, b3, b4: Byte;
-  n, m, x, y: Integer;
-  b: Byte;
-begin
-  Result := '';
-  n := 1;
-  while Length(Value) >= n do
-  begin
-    ReadMulti(Value, n, 4, b1, b2, b3, b4, false);
-    if (b2 = 0) and (b3 = 0) and (b4 = 0) and (b1 < 128) then
-      Result := Result + AnsiChar(b1)
-    else
-    begin
-      x := (b1 + 256 * b2) + (b3 + 256 * b4) * 65536;
-      l := IntToBin(x, 0);
-      y := Length(l) div 6;
-      s := '';
-      for m := 1 to y do
-      begin
-        k := Copy(l, Length(l) - 5, 6);
-        l := Copy(l, 1, Length(l) - 6);
-        b := BinToInt(k) or $80;
-        s := AnsiChar(b) + s;
-      end;
-      b := BinToInt(l);
-      case y of
-        5:
-          b := b or $FC;
-        4:
-          b := b or $F8;
-        3:
-          b := b or $F0;
-        2:
-          b := b or $E0;
-        1:
-          b := b or $C0;
-      end;
-      s := AnsiChar(b) + s;
-      Result := Result + s;
-    end;
-  end;
-end;
-
-{==============================================================================}
-function UTF7toUCS2(const Value: AnsiString; Modified: Boolean): AnsiString;
-var
-  n, i: Integer;
-  c: AnsiChar;
-  s, t: AnsiString;
-  shift: AnsiChar;
-  table: String;
-begin
-  Result := '';
-  n := 1;
-  if modified then
-  begin
-    shift := '&';
-    table := TableBase64mod;
-  end
-  else
-  begin
-    shift := '+';
-    table := TableBase64;
-  end;
-  while Length(Value) >= n do
-  begin
-    c := Value[n];
-    Inc(n);
-    if c <> shift then
-      Result := Result + WriteMulti(Ord(c), 0, 0, 0, 2, false)
-    else
-    begin
-      s := '';
-      while Length(Value) >= n do
-      begin
-        c := Value[n];
-        Inc(n);
-        if c = '-' then
-          Break;
-        if (c = '=') or (Pos(c, table) < 1) then
-        begin
-          Dec(n);
-          Break;
-        end;
-        s := s + c;
-      end;
-      if s = '' then
-        s := WriteMulti(Ord(shift), 0, 0, 0, 2, false)
-      else
-      begin
-        if modified then
-          t := DecodeBase64mod(s)
-        else
-          t := DecodeBase64(s);
-        if not odd(length(t)) then
-          s := t
-        else
-        begin //ill-formed sequence
-          t := s;
-          s := WriteMulti(Ord(shift), 0, 0, 0, 2, false);
-          for i := 1 to length(t) do
-            s := s + WriteMulti(Ord(t[i]), 0, 0, 0, 2, false);
-        end;
-      end;
-      Result := Result + s;
-    end;
-  end;
-end;
-
-{==============================================================================}
-function UCS2toUTF7(const Value: AnsiString; Modified: Boolean): AnsiString;
-var
-  s: AnsiString;
-  b1, b2, b3, b4: Byte;
-  n, m: Integer;
-  shift: AnsiChar;
-begin
-  Result := '';
-  n := 1;
-  if modified then
-    shift := '&'
-  else
-    shift := '+';
-  while Length(Value) >= n do
-  begin
-    ReadMulti(Value, n, 2, b1, b2, b3, b4, false);
-    if (b2 = 0) and (b1 < 128) then
-      if AnsiChar(b1) = shift then
-        Result := Result + shift + '-'
-      else
-        Result := Result + AnsiChar(b1)
-    else
-    begin
-      s := AnsiChar(b2) + AnsiChar(b1);
-      while Length(Value) >= n do
-      begin
-        ReadMulti(Value, n, 2, b1, b2, b3, b4, false);
-        if (b2 = 0) and (b1 < 128) then
-        begin
-          Dec(n, 2);
-          Break;
-        end;
-        s := s + AnsiChar(b2) + AnsiChar(b1);
-      end;
-      if modified then
-        s := EncodeBase64mod(s)
-      else
-        s := EncodeBase64(s);
-      m := Pos('=', s);
-      if m > 0 then
-        s := Copy(s, 1, m - 1);
-      Result := Result + shift + s + '-';
-    end;
-  end;
-end;
-
-{==============================================================================}
-function CharsetConversion(const Value: AnsiString; CharFrom: TMimeChar;
-  CharTo: TMimeChar): AnsiString;
-begin
-  Result := CharsetConversionEx(Value, CharFrom, CharTo, Replace_None);
-end;
-
-{==============================================================================}
-function CharsetConversionEx(const Value: AnsiString; CharFrom: TMimeChar;
-  CharTo: TMimeChar; const TransformTable: array of Word): AnsiString;
-begin
-  Result := CharsetConversionTrans(Value, CharFrom, CharTo, TransformTable, True);
-end;
-
-{==============================================================================}
-
-function InternalToUcs(const Value: AnsiString; Charfrom: TMimeChar): AnsiString;
-var
-  uni: Word;
-  n: Integer;
-  b1, b2, b3, b4: Byte;
-  SourceTable: array[128..255] of Word;
-  mbf: Byte;
-  lef: Boolean;
-  s: AnsiString;
-begin
-  if CharFrom = UTF_8 then
-    s := UTF8toUCS4(Value)
-  else
-    if CharFrom = UTF_7 then
-      s := UTF7toUCS2(Value, False)
-    else
-      if CharFrom = UTF_7mod then
-        s := UTF7toUCS2(Value, True)
-      else
-        s := Value;
-  GetArray(CharFrom, SourceTable);
-  mbf := 1;
-  if CharFrom in SetTwo then
-    mbf := 2;
-  if CharFrom in SetFour then
-    mbf := 4;
-  lef := CharFrom in SetLe;
-  Result := '';
-  n := 1;
-  while Length(s) >= n do
-  begin
-    ReadMulti(s, n, mbf, b1, b2, b3, b4, lef);
-    //handle BOM
-    if (b3 = 0) and (b4 = 0) then
-    begin
-      if (b1 = $FE) and (b2 = $FF) then
-      begin
-        lef := not lef;
-        continue;
-      end;
-      if (b1 = $FF) and (b2 = $FE) then
-        continue;
-    end;
-    if mbf = 1 then
-      if b1 > 127 then
-      begin
-        uni := SourceTable[b1];
-        b1 := Lo(uni);
-        b2 := Hi(uni);
-      end;
-    Result := Result + WriteMulti(b1, b2, b3, b4, 2, False);
-  end;
-end;
-
-function CharsetConversionTrans(Value: AnsiString; CharFrom: TMimeChar;
-  CharTo: TMimeChar; const TransformTable: array of Word; Translit: Boolean): AnsiString;
-var
-  uni: Word;
-  n, m: Integer;
-  b: Byte;
-  b1, b2, b3, b4: Byte;
-  TargetTable: array[128..255] of Word;
-  mbt: Byte;
-  let: Boolean;
-  ucsstring, s, t: AnsiString;
-  cd: iconv_t;
-  f: Boolean;
-  NotNeedTransform: Boolean;
-  FromID, ToID: string;
-begin
-  NotNeedTransform := (High(TransformTable) = 0);
-  if (CharFrom = CharTo) and NotNeedTransform then
-  begin
-    Result := Value;
-    Exit;
-  end;
-  FromID := GetIDFromCP(CharFrom);
-  ToID := GetIDFromCP(CharTo);
-  cd := Iconv_t(-1);
-  //do two-pass conversion. Transform to UCS-2 first.
-  if not DisableIconv then
-    cd := SynaIconvOpenIgnore('UCS-2BE', FromID);
-  try
-    if cd <> iconv_t(-1) then
-      SynaIconv(cd, Value, ucsstring)
-    else
-      ucsstring := InternalToUcs(Value, CharFrom);
-  finally
-    SynaIconvClose(cd);
-  end;
-  //here we allways have ucstring with UCS-2 encoding
-  //second pass... from UCS-2 to target encoding.
-    if not DisableIconv then
-      if translit then
-        cd := SynaIconvOpenTranslit(ToID, 'UCS-2BE')
-      else
-        cd := SynaIconvOpenIgnore(ToID, 'UCS-2BE');
-  try
-    if (cd <> iconv_t(-1)) and NotNeedTransform then
-    begin
-      if CharTo = UTF_7 then
-        ucsstring := ucsstring + #0 + '-';
-      //when transformtable is not needed and Iconv know target charset,
-      //do it fast by one call.
-      SynaIconv(cd, ucsstring, Result);
-      if CharTo = UTF_7 then
-        Delete(Result, Length(Result), 1);
-    end
-    else
-    begin
-      GetArray(CharTo, TargetTable);
-      mbt := 1;
-      if CharTo in SetTwo then
-        mbt := 2;
-      if CharTo in SetFour then
-        mbt := 4;
-      let := CharTo in SetLe;
-      b3 := 0;
-      b4 := 0;
-      Result := '';
-      for n:= 0 to (Length(ucsstring) div 2) - 1 do
-      begin
-        s := Copy(ucsstring, n * 2 + 1, 2);
-        b2 := Ord(s[1]);
-        b1 := Ord(s[2]);
-        uni := b2 * 256 + b1;
-        if not NotNeedTransform then
-        begin
-          uni := ReplaceUnicode(uni, TransformTable);
-          b1 := Lo(uni);
-          b2 := Hi(uni);
-          s[1] := AnsiChar(b2);
-          s[2] := AnsiChar(b1);
-        end;
-        if cd <> iconv_t(-1) then
-        begin
-          if CharTo = UTF_7 then
-            s := s + #0 + '-';
-          SynaIconv(cd, s, t);
-          if CharTo = UTF_7 then
-            Delete(t, Length(t), 1);
-          Result := Result + t;
-        end
-        else
-        begin
-          f := True;
-          if mbt = 1 then
-            if uni > 127 then
-            begin
-              f := False;
-              b := 0;
-              for m := 128 to 255 do
-                if TargetTable[m] = uni then
-                begin
-                  b := m;
-                  f := True;
-                  Break;
-                end;
-              b1 := b;
-              b2 := 0;
-            end
-            else
-              b1 := Lo(uni);
-          if not f then
-            if translit then
-            begin
-              b1 := Ord(NotFoundChar);
-              b2 := 0;
-              f := True;
-            end;
-          if f then
-            Result := Result + WriteMulti(b1, b2, b3, b4, mbt, let)
-        end;
-      end;
-      if cd = iconv_t(-1) then
-      begin
-        if CharTo = UTF_7 then
-          Result := UCS2toUTF7(Result, false);
-        if CharTo = UTF_7mod then
-          Result := UCS2toUTF7(Result, true);
-        if CharTo = UTF_8 then
-          Result := UCS4toUTF8(Result);
-      end;
-    end;
-  finally
-    SynaIconvClose(cd);
-  end;
-end;
-
-{==============================================================================}
-{$IFNDEF WIN32}
-
-function GetCurCP: TMimeChar;
-begin
-  {$IFNDEF FPC}
-  Result := GetCPFromID(nl_langinfo(_NL_CTYPE_CODESET_NAME));
-  {$ELSE}
-    {$IFDEF FPC_USE_LIBC}
-  Result := GetCPFromID(nl_langinfo(_NL_CTYPE_CODESET_NAME));
-    {$ELSE}
-  //How to get system codepage without LIBC?
-  Result := UTF_8;
-    {$ENDIF}
-  {$ENDIF}
-end;
-
-function GetCurOEMCP: TMimeChar;
-begin
-  Result := GetCurCP;
-end;
-
-{$ELSE}
-
-function CPToMimeChar(Value: Integer): TMimeChar;
-begin
-  case Value of
-    437, 850, 20127:
-      Result := ISO_8859_1; //I know, it is not ideal!
-    737:
-      Result := CP737;
-    775:
-      Result := CP775;
-    852:
-      Result := CP852;
-    855:
-      Result := CP855;
-    857:
-      Result := CP857;
-    858:
-      Result := CP858;
-    860:
-      Result := CP860;
-    861:
-      Result := CP861;
-    862:
-      Result := CP862;
-    863:
-      Result := CP863;
-    864:
-      Result := CP864;
-    865:
-      Result := CP865;
-    866:
-      Result := CP866;
-    869:
-      Result := CP869;
-    874:
-      Result := ISO_8859_15;
-    895:
-      Result := CP895;
-    932:
-      Result := CP932;
-    936:
-      Result := CP936;
-    949:
-      Result := CP949;
-    950:
-      Result := CP950;
-    1200:
-      Result := UCS_2LE;
-    1201:
-      Result := UCS_2;
-    1250:
-      Result := CP1250;
-    1251:
-      Result := CP1251;
-    1253:
-      Result := CP1253;
-    1254:
-      Result := CP1254;
-    1255:
-      Result := CP1255;
-    1256:
-      Result := CP1256;
-    1257:
-      Result := CP1257;
-    1258:
-      Result := CP1258;
-    1361:
-      Result := CP1361;
-    10000:
-      Result := MAC;
-    10004:
-      Result := MACAR;
-    10005:
-      Result := MACHEB;
-    10006:
-      Result := MACGR;
-    10007:
-      Result := MACCYR;
-    10010:
-      Result := MACRO;
-    10017:
-      Result := MACUK;
-    10021:
-      Result := MACTH;
-    10029:
-      Result := MACCE;
-    10079:
-      Result := MACICE;
-    10081:
-      Result := MACTU;
-    10082:
-      Result := MACCRO;
-    12000:
-      Result := UCS_4LE;
-    12001:
-      Result := UCS_4;
-    20866:
-      Result := KOI8_R;
-    20932:
-      Result := JIS_X0208;
-    20936:
-      Result := GB2312;
-    21866:
-      Result := KOI8_U;
-    28591:
-      Result := ISO_8859_1;
-    28592:
-      Result := ISO_8859_2;
-    28593:
-      Result := ISO_8859_3;
-    28594:
-      Result := ISO_8859_4;
-    28595:
-      Result := ISO_8859_5;
-    28596, 708:
-      Result := ISO_8859_6;
-    28597:
-      Result := ISO_8859_7;
-    28598, 38598:
-      Result := ISO_8859_8;
-    28599:
-      Result := ISO_8859_9;
-    28605:
-      Result := ISO_8859_15;
-    50220:
-      Result := ISO_2022_JP; //? ISO 2022 Japanese with no halfwidth Katakana
-    50221:
-      Result := ISO_2022_JP1;//? Japanese with halfwidth Katakana
-    50222:
-      Result := ISO_2022_JP2;//? Japanese JIS X 0201-1989
-    50225:
-      Result := ISO_2022_KR;
-    50227:
-      Result := ISO_2022_CN;//? ISO 2022 Simplified Chinese
-    50229:
-      Result := ISO_2022_CNE;//? ISO 2022 Traditional Chinese
-    51932:
-      Result := EUC_JP;
-    51936:
-      Result := GB2312;
-    51949:
-      Result := EUC_KR;
-    52936:
-      Result := HZ;
-    54936:
-      Result := GB18030;
-    65000:
-      Result := UTF_7;
-    65001:
-      Result := UTF_8;
-    0:
-      Result := UCS_2LE;
-  else
-    Result := CP1252;
-  end;
-end;
-
-function GetCurCP: TMimeChar;
-begin
-  Result := CPToMimeChar(GetACP);
-end;
-
-function GetCurOEMCP: TMimeChar;
-begin
-  Result := CPToMimeChar(GetOEMCP);
-end;
-{$ENDIF}
-
-{==============================================================================}
-function NeedCharsetConversion(const Value: AnsiString): Boolean;
-var
-  n: Integer;
-begin
-  Result := False;
-  for n := 1 to Length(Value) do
-    if (Ord(Value[n]) > 127) or (Ord(Value[n]) = 0) then
-    begin
-      Result := True;
-      Break;
-    end;
-end;
-
-{==============================================================================}
-function IdealCharsetCoding(const Value: AnsiString; CharFrom: TMimeChar;
-  CharTo: TMimeSetChar): TMimeChar;
-var
-  n: Integer;
-  max: Integer;
-  s, t, u: AnsiString;
-  CharSet: TMimeChar;
-begin
-  Result := ISO_8859_1;
-  s := Copy(Value, 1, 1024);  //max first 1KB for next procedure
-  max := 0;
-  for n := Ord(Low(TMimeChar)) to Ord(High(TMimeChar)) do
-  begin
-    CharSet := TMimeChar(n);
-    if CharSet in CharTo then
-    begin
-      t := CharsetConversionTrans(s, CharFrom, CharSet, Replace_None, False);
-      u := CharsetConversionTrans(t, CharSet, CharFrom, Replace_None, False);
-      if s = u then
-      begin
-        Result := CharSet;
-        Exit;
-      end;
-      if Length(u) > max then
-      begin
-        Result := CharSet;
-        max := Length(u);
-      end;
-    end;
-  end;
-end;
-
-{==============================================================================}
-function GetBOM(Value: TMimeChar): AnsiString;
-begin
-  Result := '';
-  case Value of
-    UCS_2:
-      Result := #$fe + #$ff;
-    UCS_4:
-      Result := #$00 + #$00 + #$fe + #$ff;
-    UCS_2LE:
-      Result := #$ff + #$fe;
-    UCS_4LE:
-      Result := #$ff + #$fe + #$00 + #$00;
-    UTF_8:
-      Result := #$ef + #$bb + #$bf;
-  end;
-end;
-
-{==============================================================================}
-function GetCPFromID(Value: AnsiString): TMimeChar;
-begin
-  Value := UpperCase(Value);
-  if (Pos('KAMENICKY', Value) > 0) or (Pos('895', Value) > 0) then
-    Result := CP895
-  else
-  if Pos('MUTF-7', Value) > 0 then
-    Result := UTF_7mod
-  else
-    Result := GetCPFromIconvID(Value);
-end;
-
-{==============================================================================}
-function GetIDFromCP(Value: TMimeChar): AnsiString;
-begin
-  case Value of
-    CP895:
-      Result := 'CP-895';
-    UTF_7mod:
-      Result := 'mUTF-7';
-  else
-    Result := GetIconvIDFromCP(Value);
-  end;
-end;
-
-{==============================================================================}
-function StringToWide(const Value: AnsiString): WideString;
-var
-  n: integer;
-  x, y: integer;
-begin
-  SetLength(Result, Length(Value) div 2);
-  for n := 1 to Length(Value) div 2 do
-  begin
-    x := Ord(Value[((n-1) * 2) + 1]);
-    y := Ord(Value[((n-1) * 2) + 2]);
-    Result[n] := WideChar(x * 256 + y);
-  end;
-end;
-
-{==============================================================================}
-function WideToString(const Value: WideString): AnsiString;
-var
-  n: integer;
-  x: integer;
-begin
-  SetLength(Result, Length(Value) * 2);
-  for n := 1 to Length(Value) do
-  begin
-    x := Ord(Value[n]);
-    Result[((n-1) * 2) + 1] := AnsiChar(x div 256);
-    Result[((n-1) * 2) + 2] := AnsiChar(x mod 256);
-  end;
-end;
-
-{==============================================================================}
-initialization
-begin
-  IconvArr[0].Charset := ISO_8859_1;
-  IconvArr[0].Charname := 'ISO-8859-1 CP819 IBM819 ISO-IR-100 ISO8859-1 ISO_8859-1 ISO_8859-1:1987 L1 LATIN1 CSISOLATIN1';
-  IconvArr[1].Charset := UTF_8;
-  IconvArr[1].Charname := 'UTF-8';
-  IconvArr[2].Charset := UCS_2;
-  IconvArr[2].Charname := 'ISO-10646-UCS-2 UCS-2 CSUNICODE';
-  IconvArr[3].Charset := UCS_2;
-  IconvArr[3].Charname := 'UCS-2BE UNICODE-1-1 UNICODEBIG CSUNICODE11';
-  IconvArr[4].Charset := UCS_2LE;
-  IconvArr[4].Charname := 'UCS-2LE UNICODELITTLE';
-  IconvArr[5].Charset := UCS_4;
-  IconvArr[5].Charname := 'ISO-10646-UCS-4 UCS-4 CSUCS4';
-  IconvArr[6].Charset := UCS_4;
-  IconvArr[6].Charname := 'UCS-4BE';
-  IconvArr[7].Charset := UCS_2LE;
-  IconvArr[7].Charname := 'UCS-4LE';
-  IconvArr[8].Charset := UTF_16;
-  IconvArr[8].Charname := 'UTF-16';
-  IconvArr[9].Charset := UTF_16;
-  IconvArr[9].Charname := 'UTF-16BE';
-  IconvArr[10].Charset := UTF_16LE;
-  IconvArr[10].Charname := 'UTF-16LE';
-  IconvArr[11].Charset := UTF_32;
-  IconvArr[11].Charname := 'UTF-32';
-  IconvArr[12].Charset := UTF_32;
-  IconvArr[12].Charname := 'UTF-32BE';
-  IconvArr[13].Charset := UTF_32;
-  IconvArr[13].Charname := 'UTF-32LE';
-  IconvArr[14].Charset := UTF_7;
-  IconvArr[14].Charname := 'UNICODE-1-1-UTF-7 UTF-7 CSUNICODE11UTF7';
-  IconvArr[15].Charset := C99;
-  IconvArr[15].Charname := 'C99';
-  IconvArr[16].Charset := JAVA;
-  IconvArr[16].Charname := 'JAVA';
-  IconvArr[17].Charset := ISO_8859_1;
-  IconvArr[17].Charname := 'US-ASCII ANSI_X3.4-1968 ANSI_X3.4-1986 ASCII CP367 IBM367 ISO-IR-6 ISO646-US ISO_646.IRV:1991 US CSASCII';
-  IconvArr[18].Charset := ISO_8859_2;
-  IconvArr[18].Charname := 'ISO-8859-2 ISO-IR-101 ISO8859-2 ISO_8859-2 ISO_8859-2:1987 L2 LATIN2 CSISOLATIN2';
-  IconvArr[19].Charset := ISO_8859_3;
-  IconvArr[19].Charname := 'ISO-8859-3 ISO-IR-109 ISO8859-3 ISO_8859-3 ISO_8859-3:1988 L3 LATIN3 CSISOLATIN3';
-  IconvArr[20].Charset := ISO_8859_4;
-  IconvArr[20].Charname := 'ISO-8859-4 ISO-IR-110 ISO8859-4 ISO_8859-4 ISO_8859-4:1988 L4 LATIN4 CSISOLATIN4';
-  IconvArr[21].Charset := ISO_8859_5;
-  IconvArr[21].Charname := 'ISO-8859-5 CYRILLIC ISO-IR-144 ISO8859-5 ISO_8859-5 ISO_8859-5:1988 CSISOLATINCYRILLIC';
-  IconvArr[22].Charset := ISO_8859_6;
-  IconvArr[22].Charname := 'ISO-8859-6 ARABIC ASMO-708 ECMA-114 ISO-IR-127 ISO8859-6 ISO_8859-6 ISO_8859-6:1987 CSISOLATINARABIC';
-  IconvArr[23].Charset := ISO_8859_7;
-  IconvArr[23].Charname := 'ISO-8859-7 ECMA-118 ELOT_928 GREEK GREEK8 ISO-IR-126 ISO8859-7 ISO_8859-7 ISO_8859-7:1987 CSISOLATINGREEK';
-  IconvArr[24].Charset := ISO_8859_8;
-  IconvArr[24].Charname := 'ISO-8859-8 HEBREW ISO_8859-8 ISO-IR-138 ISO8859-8 ISO_8859-8:1988 CSISOLATINHEBREW ISO-8859-8-I';
-  IconvArr[25].Charset := ISO_8859_9;
-  IconvArr[25].Charname := 'ISO-8859-9 ISO-IR-148 ISO8859-9 ISO_8859-9 ISO_8859-9:1989 L5 LATIN5 CSISOLATIN5';
-  IconvArr[26].Charset := ISO_8859_10;
-  IconvArr[26].Charname := 'ISO-8859-10 ISO-IR-157 ISO8859-10 ISO_8859-10 ISO_8859-10:1992 L6 LATIN6 CSISOLATIN6';
-  IconvArr[27].Charset := ISO_8859_13;
-  IconvArr[27].Charname := 'ISO-8859-13 ISO-IR-179 ISO8859-13 ISO_8859-13 L7 LATIN7';
-  IconvArr[28].Charset := ISO_8859_14;
-  IconvArr[28].Charname := 'ISO-8859-14 ISO-CELTIC ISO-IR-199 ISO8859-14 ISO_8859-14 ISO_8859-14:1998 L8 LATIN8';
-  IconvArr[29].Charset := ISO_8859_15;
-  IconvArr[29].Charname := 'ISO-8859-15 ISO-IR-203 ISO8859-15 ISO_8859-15 ISO_8859-15:1998';
-  IconvArr[30].Charset := ISO_8859_16;
-  IconvArr[30].Charname := 'ISO-8859-16 ISO-IR-226 ISO8859-16 ISO_8859-16 ISO_8859-16:2000';
-  IconvArr[31].Charset := KOI8_R;
-  IconvArr[31].Charname := 'KOI8-R CSKOI8R';
-  IconvArr[32].Charset := KOI8_U;
-  IconvArr[32].Charname := 'KOI8-U';
-  IconvArr[33].Charset := KOI8_RU;
-  IconvArr[33].Charname := 'KOI8-RU';
-  IconvArr[34].Charset := CP1250;
-  IconvArr[34].Charname := 'WINDOWS-1250 CP1250 MS-EE';
-  IconvArr[35].Charset := CP1251;
-  IconvArr[35].Charname := 'WINDOWS-1251 CP1251 MS-CYRL';
-  IconvArr[36].Charset := CP1252;
-  IconvArr[36].Charname := 'WINDOWS-1252 CP1252 MS-ANSI';
-  IconvArr[37].Charset := CP1253;
-  IconvArr[37].Charname := 'WINDOWS-1253 CP1253 MS-GREEK';
-  IconvArr[38].Charset := CP1254;
-  IconvArr[38].Charname := 'WINDOWS-1254 CP1254 MS-TURK';
-  IconvArr[39].Charset := CP1255;
-  IconvArr[39].Charname := 'WINDOWS-1255 CP1255 MS-HEBR';
-  IconvArr[40].Charset := CP1256;
-  IconvArr[40].Charname := 'WINDOWS-1256 CP1256 MS-ARAB';
-  IconvArr[41].Charset := CP1257;
-  IconvArr[41].Charname := 'WINDOWS-1257 CP1257 WINBALTRIM';
-  IconvArr[42].Charset := CP1258;
-  IconvArr[42].Charname := 'WINDOWS-1258 CP1258';
-  IconvArr[43].Charset := ISO_8859_1;
-  IconvArr[43].Charname := '850 CP850 IBM850 CSPC850MULTILINGUAL';
-  IconvArr[44].Charset := CP862;
-  IconvArr[44].Charname := '862 CP862 IBM862 CSPC862LATINHEBREW';
-  IconvArr[45].Charset := CP866;
-  IconvArr[45].Charname := '866 CP866 IBM866 CSIBM866';
-  IconvArr[46].Charset := MAC;
-  IconvArr[46].Charname := 'MAC MACINTOSH MACROMAN CSMACINTOSH';
-  IconvArr[47].Charset := MACCE;
-  IconvArr[47].Charname := 'MACCENTRALEUROPE';
-  IconvArr[48].Charset := MACICE;
-  IconvArr[48].Charname := 'MACICELAND';
-  IconvArr[49].Charset := MACCRO;
-  IconvArr[49].Charname := 'MACCROATIAN';
-  IconvArr[50].Charset := MACRO;
-  IconvArr[50].Charname := 'MACROMANIA';
-  IconvArr[51].Charset := MACCYR;
-  IconvArr[51].Charname := 'MACCYRILLIC';
-  IconvArr[52].Charset := MACUK;
-  IconvArr[52].Charname := 'MACUKRAINE';
-  IconvArr[53].Charset := MACGR;
-  IconvArr[53].Charname := 'MACGREEK';
-  IconvArr[54].Charset := MACTU;
-  IconvArr[54].Charname := 'MACTURKISH';
-  IconvArr[55].Charset := MACHEB;
-  IconvArr[55].Charname := 'MACHEBREW';
-  IconvArr[56].Charset := MACAR;
-  IconvArr[56].Charname := 'MACARABIC';
-  IconvArr[57].Charset := MACTH;
-  IconvArr[57].Charname := 'MACTHAI';
-  IconvArr[58].Charset := ROMAN8;
-  IconvArr[58].Charname := 'HP-ROMAN8 R8 ROMAN8 CSHPROMAN8';
-  IconvArr[59].Charset := NEXTSTEP;
-  IconvArr[59].Charname := 'NEXTSTEP';
-  IconvArr[60].Charset := ARMASCII;
-  IconvArr[60].Charname := 'ARMSCII-8';
-  IconvArr[61].Charset := GEORGIAN_AC;
-  IconvArr[61].Charname := 'GEORGIAN-ACADEMY';
-  IconvArr[62].Charset := GEORGIAN_PS;
-  IconvArr[62].Charname := 'GEORGIAN-PS';
-  IconvArr[63].Charset := KOI8_T;
-  IconvArr[63].Charname := 'KOI8-T';
-  IconvArr[64].Charset := MULELAO;
-  IconvArr[64].Charname := 'MULELAO-1';
-  IconvArr[65].Charset := CP1133;
-  IconvArr[65].Charname := 'CP1133 IBM-CP1133';
-  IconvArr[66].Charset := TIS620;
-  IconvArr[66].Charname := 'TIS-620 ISO-IR-166 TIS620 TIS620-0 TIS620.2529-1 TIS620.2533-0 TIS620.2533-1';
-  IconvArr[67].Charset := CP874;
-  IconvArr[67].Charname := 'CP874 WINDOWS-874';
-  IconvArr[68].Charset := VISCII;
-  IconvArr[68].Charname := 'VISCII VISCII1.1-1 CSVISCII';
-  IconvArr[69].Charset := TCVN;
-  IconvArr[69].Charname := 'TCVN TCVN-5712 TCVN5712-1 TCVN5712-1:1993';
-  IconvArr[70].Charset := ISO_IR_14;
-  IconvArr[70].Charname := 'ISO-IR-14 ISO646-JP JIS_C6220-1969-RO JP CSISO14JISC6220RO';
-  IconvArr[71].Charset := JIS_X0201;
-  IconvArr[71].Charname := 'JISX0201-1976 JIS_X0201 X0201 CSHALFWIDTHKATAKANA';
-  IconvArr[72].Charset := JIS_X0208;
-  IconvArr[72].Charname := 'ISO-IR-87 JIS0208 JIS_C6226-1983 JIS_X0208 JIS_X0208-1983 JIS_X0208-1990 X0208 CSISO87JISX0208';
-  IconvArr[73].Charset := JIS_X0212;
-  IconvArr[73].Charname := 'ISO-IR-159 JIS_X0212 JIS_X0212-1990 JIS_X0212.1990-0 X0212 CSISO159JISX02121990';
-  IconvArr[74].Charset := GB1988_80;
-  IconvArr[74].Charname := 'CN GB_1988-80 ISO-IR-57 ISO646-CN CSISO57GB1988';
-  IconvArr[75].Charset := GB2312_80;
-  IconvArr[75].Charname := 'CHINESE GB_2312-80 ISO-IR-58 CSISO58GB231280';
-  IconvArr[76].Charset := ISO_IR_165;
-  IconvArr[76].Charname := 'CN-GB-ISOIR165 ISO-IR-165';
-  IconvArr[77].Charset := ISO_IR_149;
-  IconvArr[77].Charname := 'ISO-IR-149 KOREAN KSC_5601 KS_C_5601-1987 KS_C_5601-1989 CSKSC56011987';
-  IconvArr[78].Charset := EUC_JP;
-  IconvArr[78].Charname := 'EUC-JP EUCJP EXTENDED_UNIX_CODE_PACKED_FORMAT_FOR_JAPANESE CSEUCPKDFMTJAPANESE';
-  IconvArr[79].Charset := SHIFT_JIS;
-  IconvArr[79].Charname := 'SHIFT-JIS MS_KANJI SHIFT_JIS SJIS CSSHIFTJIS';
-  IconvArr[80].Charset := CP932;
-  IconvArr[80].Charname := 'CP932';
-  IconvArr[81].Charset := ISO_2022_JP;
-  IconvArr[81].Charname := 'ISO-2022-JP CSISO2022JP';
-  IconvArr[82].Charset := ISO_2022_JP1;
-  IconvArr[82].Charname := 'ISO-2022-JP-1';
-  IconvArr[83].Charset := ISO_2022_JP2;
-  IconvArr[83].Charname := 'ISO-2022-JP-2 CSISO2022JP2';
-  IconvArr[84].Charset := GB2312;
-  IconvArr[84].Charname := 'CN-GB EUC-CN EUCCN GB2312 CSGB2312';
-  IconvArr[85].Charset := CP936;
-  IconvArr[85].Charname := 'CP936 GBK';
-  IconvArr[86].Charset := GB18030;
-  IconvArr[86].Charname := 'GB18030';
-  IconvArr[87].Charset := ISO_2022_CN;
-  IconvArr[87].Charname := 'ISO-2022-CN CSISO2022CN';
-  IconvArr[88].Charset := ISO_2022_CNE;
-  IconvArr[88].Charname := 'ISO-2022-CN-EXT';
-  IconvArr[89].Charset := HZ;
-  IconvArr[89].Charname := 'HZ HZ-GB-2312';
-  IconvArr[90].Charset := EUC_TW;
-  IconvArr[90].Charname := 'EUC-TW EUCTW CSEUCTW';
-  IconvArr[91].Charset := BIG5;
-  IconvArr[91].Charname := 'BIG5 BIG-5 BIG-FIVE BIGFIVE CN-BIG5 CSBIG5';
-  IconvArr[92].Charset := CP950;
-  IconvArr[92].Charname := 'CP950';
-  IconvArr[93].Charset := BIG5_HKSCS;
-  IconvArr[93].Charname := 'BIG5-HKSCS BIG5HKSCS';
-  IconvArr[94].Charset := EUC_KR;
-  IconvArr[94].Charname := 'EUC-KR EUCKR CSEUCKR';
-  IconvArr[95].Charset := CP949;
-  IconvArr[95].Charname := 'CP949 UHC';
-  IconvArr[96].Charset := CP1361;
-  IconvArr[96].Charname := 'CP1361 JOHAB';
-  IconvArr[97].Charset := ISO_2022_KR;
-  IconvArr[97].Charname := 'ISO-2022-KR CSISO2022KR';
-  IconvArr[98].Charset := ISO_8859_1;
-  IconvArr[98].Charname := '437 CP437 IBM437 CSPC8CODEPAGE437';
-  IconvArr[99].Charset := CP737;
-  IconvArr[99].Charname := 'CP737';
-  IconvArr[100].Charset := CP775;
-  IconvArr[100].Charname := 'CP775 IBM775 CSPC775BALTIC';
-  IconvArr[101].Charset := CP852;
-  IconvArr[101].Charname := '852 CP852 IBM852 CSPCP852';
-  IconvArr[102].Charset := CP853;
-  IconvArr[102].Charname := 'CP853';
-  IconvArr[103].Charset := CP855;
-  IconvArr[103].Charname := '855 CP855 IBM855 CSIBM855';
-  IconvArr[104].Charset := CP857;
-  IconvArr[104].Charname := '857 CP857 IBM857 CSIBM857';
-  IconvArr[105].Charset := CP858;
-  IconvArr[105].Charname := 'CP858';
-  IconvArr[106].Charset := CP860;
-  IconvArr[106].Charname := '860 CP860 IBM860 CSIBM860';
-  IconvArr[107].Charset := CP861;
-  IconvArr[107].Charname := '861 CP-IS CP861 IBM861 CSIBM861';
-  IconvArr[108].Charset := CP863;
-  IconvArr[108].Charname := '863 CP863 IBM863 CSIBM863';
-  IconvArr[109].Charset := CP864;
-  IconvArr[109].Charname := 'CP864 IBM864 CSIBM864';
-  IconvArr[110].Charset := CP865;
-  IconvArr[110].Charname := '865 CP865 IBM865 CSIBM865';
-  IconvArr[111].Charset := CP869;
-  IconvArr[111].Charname := '869 CP-GR CP869 IBM869 CSIBM869';
-  IconvArr[112].Charset := CP1125;
-  IconvArr[112].Charname := 'CP1125';
-end;
-
-end.
+{==============================================================================|
+| Project : Ararat Synapse                                       | 005.002.002 |
+|==============================================================================|
+| Content: Charset conversion support                                          |
+|==============================================================================|
+| Copyright (c)1999-2004, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2000-2004.                |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{: @abstract(Charset conversion support)
+This unit contains a routines for lot of charset conversions.
+
+It using built-in conversion tables or external Iconv library. Iconv is used
+ when needed conversion is known by Iconv library. When Iconv library is not
+ found or Iconv not know requested conversion, then are internal routines used
+ for conversion. (You can disable Iconv support from your program too!)
+
+Internal routines knows all major charsets for Europe or America. For East-Asian
+ charsets you must use Iconv library!
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$Q-}
+{$H+}
+
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit synachar;
+
+interface
+
+uses
+{$IFNDEF WIN32}
+  {$IFNDEF FPC}
+  Libc,
+  {$ELSE}
+    {$IFDEF FPC_USE_LIBC}
+  Libc,
+    {$ENDIF}
+  {$ENDIF}
+{$ELSE}
+  Windows,
+{$ENDIF}
+  SysUtils,
+  synautil, synacode, synaicnv;
+
+type
+  {:Type with all supported charsets.}
+  TMimeChar = (ISO_8859_1, ISO_8859_2, ISO_8859_3, ISO_8859_4, ISO_8859_5,
+    ISO_8859_6, ISO_8859_7, ISO_8859_8, ISO_8859_9, ISO_8859_10, ISO_8859_13,
+    ISO_8859_14, ISO_8859_15, CP1250, CP1251, CP1252, CP1253, CP1254, CP1255,
+    CP1256, CP1257, CP1258, KOI8_R, CP895, CP852, UCS_2, UCS_4, UTF_8, UTF_7,
+    UTF_7mod, UCS_2LE, UCS_4LE,
+    //next is supported by Iconv only...
+    UTF_16, UTF_16LE, UTF_32, UTF_32LE, C99, JAVA, ISO_8859_16, KOI8_U, KOI8_RU,
+    CP862, CP866, MAC, MACCE, MACICE, MACCRO, MACRO, MACCYR, MACUK, MACGR, MACTU,
+    MACHEB, MACAR, MACTH, ROMAN8, NEXTSTEP, ARMASCII, GEORGIAN_AC, GEORGIAN_PS,
+    KOI8_T, MULELAO, CP1133, TIS620, CP874, VISCII, TCVN, ISO_IR_14, JIS_X0201,
+    JIS_X0208, JIS_X0212, GB1988_80, GB2312_80, ISO_IR_165, ISO_IR_149, EUC_JP,
+    SHIFT_JIS, CP932, ISO_2022_JP, ISO_2022_JP1, ISO_2022_JP2, GB2312, CP936,
+    GB18030, ISO_2022_CN, ISO_2022_CNE, HZ, EUC_TW, BIG5, CP950, BIG5_HKSCS,
+    EUC_KR, CP949, CP1361, ISO_2022_KR, CP737, CP775, CP853, CP855, CP857,
+    CP858, CP860, CP861, CP863, CP864, CP865, CP869, CP1125);
+
+  {:Set of any charsets.}
+  TMimeSetChar = set of TMimeChar;
+
+const
+  {:Set of charsets supported by Iconv library only.}
+  IconvOnlyChars: set of TMimeChar = [UTF_16, UTF_16LE, UTF_32, UTF_32LE,
+    C99, JAVA, ISO_8859_16, KOI8_U, KOI8_RU, CP862, CP866, MAC, MACCE, MACICE,
+    MACCRO, MACRO, MACCYR, MACUK, MACGR, MACTU, MACHEB, MACAR, MACTH, ROMAN8,
+    NEXTSTEP, ARMASCII, GEORGIAN_AC, GEORGIAN_PS, KOI8_T, MULELAO, CP1133,
+    TIS620, CP874, VISCII, TCVN, ISO_IR_14, JIS_X0201, JIS_X0208, JIS_X0212,
+    GB1988_80, GB2312_80, ISO_IR_165, ISO_IR_149, EUC_JP, SHIFT_JIS, CP932,
+    ISO_2022_JP, ISO_2022_JP1, ISO_2022_JP2, GB2312, CP936, GB18030,
+    ISO_2022_CN, ISO_2022_CNE, HZ, EUC_TW, BIG5, CP950, BIG5_HKSCS, EUC_KR,
+    CP949, CP1361, ISO_2022_KR, CP737, CP775, CP853, CP855, CP857, CP858,
+    CP860, CP861, CP863, CP864, CP865, CP869, CP1125];
+
+  {:Set of charsets supported by internal routines only.}
+  NoIconvChars: set of TMimeChar = [CP895, UTF_7mod];
+
+  {:null character replace table. (Usable for disable charater replacing.)}
+  Replace_None: array[0..0] of Word =
+    (0);
+
+  {:Character replace table for remove Czech diakritics.}
+  Replace_Czech: array[0..59] of Word =
+    (
+      $00E1, $0061,
+      $010D, $0063,
+      $010F, $0064,
+      $010E, $0044,
+      $00E9, $0065,
+      $011B, $0065,
+      $00ED, $0069,
+      $0148, $006E,
+      $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,
+      $0147, $004E,
+      $00D3, $004F,
+      $0158, $0052,
+      $0160, $0053,
+      $0164, $0054,
+      $00DA, $0055,
+      $016E, $0055,
+      $00DD, $0059,
+      $017D, $005A
+    );
+
+var
+  {:By this you can generally disable/enable Iconv support.}
+  DisableIconv: Boolean = False;
+
+  {:Default set of charsets for @link(IdealCharsetCoding) function.}
+  IdealCharsets: TMimeSetChar =
+    [ISO_8859_1, ISO_8859_2, ISO_8859_3, ISO_8859_4, ISO_8859_5,
+    ISO_8859_6, ISO_8859_7, ISO_8859_8, ISO_8859_9, ISO_8859_10,
+    KOI8_R, KOI8_U
+    {$IFNDEF CIL} //error URW778 ??? :-O
+    , GB2312, EUC_KR, ISO_2022_JP, EUC_TW
+    {$ENDIF}
+    ];
+
+{==============================================================================}
+{:Convert Value from one charset to another. See: @link(CharsetConversionEx)}
+function CharsetConversion(const Value: AnsiString; CharFrom: TMimeChar;
+  CharTo: TMimeChar): AnsiString;
+
+{:Convert Value from one charset to another with additional character conversion.
+see: @link(Replace_None) and @link(Replace_Czech)}
+function CharsetConversionEx(const Value: AnsiString; CharFrom: TMimeChar;
+  CharTo: TMimeChar; const TransformTable: array of Word): AnsiString;
+
+{:Convert Value from one charset to another with additional character conversion.
+ This funtion is similar to @link(CharsetConversionEx), but you can disable
+ transliteration of unconvertible characters.}
+function CharsetConversionTrans(Value: AnsiString; CharFrom: TMimeChar;
+  CharTo: TMimeChar; const TransformTable: array of Word; Translit: Boolean): AnsiString;
+
+{:Returns charset used by operating system.}
+function GetCurCP: TMimeChar;
+
+{:Returns charset used by operating system as OEM charset. (in Windows DOS box,
+ for example)}
+function GetCurOEMCP: TMimeChar;
+
+{:Converting string with charset name to TMimeChar.}
+function GetCPFromID(Value: AnsiString): TMimeChar;
+
+{:Converting TMimeChar to string with name of charset.}
+function GetIDFromCP(Value: TMimeChar): AnsiString;
+
+{:return @true when value need to be converted. (It is not 7-bit ASCII)}
+function NeedCharsetConversion(const Value: AnsiString): Boolean;
+
+{:Finding best target charset from set of TMimeChars with minimal count of
+ unconvertible characters.}
+function IdealCharsetCoding(const Value: AnsiString; CharFrom: TMimeChar;
+  CharTo: TMimeSetChar): TMimeChar;
+
+{:Return BOM (Byte Order Mark) for given unicode charset.}
+function GetBOM(Value: TMimeChar): AnsiString;
+
+{:Convert binary string with unicode content to WideString.}
+function StringToWide(const Value: AnsiString): WideString;
+
+{:Convert WideString to binary string with unicode content.}
+function WideToString(const Value: WideString): AnsiString;
+
+{==============================================================================}
+implementation
+
+//character transcoding tables X to UCS-2
+{
+//dummy table
+$0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
+$0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
+$0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
+$0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
+$00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7,
+$00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF,
+$00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7,
+$00B8, $00B9, $00BA, $00BB, $00BC, $00BD, $00BE, $00BF,
+$00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7,
+$00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
+$00D0, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7,
+$00D8, $00D9, $00DA, $00DB, $00DC, $00DD, $00DE, $00DF,
+$00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7,
+$00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
+$00F0, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7,
+$00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $00FE, $00FF
+}
+
+const
+
+{Latin-1
+  Danish, Dutch, English, Faeroese, Finnish, French, German, Icelandic,
+  Irish, Italian, Norwegian, Portuguese, Spanish and Swedish.
+}
+  CharISO_8859_1: array[128..255] of Word =
+  (
+    $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
+    $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
+    $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
+    $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
+    $00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7,
+    $00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF,
+    $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7,
+    $00B8, $00B9, $00BA, $00BB, $00BC, $00BD, $00BE, $00BF,
+    $00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7,
+    $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
+    $00D0, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7,
+    $00D8, $00D9, $00DA, $00DB, $00DC, $00DD, $00DE, $00DF,
+    $00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7,
+    $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
+    $00F0, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7,
+    $00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $00FE, $00FF
+    );
+
+{Latin-2
+  Albanian, Czech, English, German, Hungarian, Polish, Rumanian,
+  Serbo-Croatian, Slovak, Slovene and Swedish.
+}
+  CharISO_8859_2: array[128..255] of Word =
+  (
+    $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
+    $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
+    $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
+    $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
+    $00A0, $0104, $02D8, $0141, $00A4, $013D, $015A, $00A7,
+    $00A8, $0160, $015E, $0164, $0179, $00AD, $017D, $017B,
+    $00B0, $0105, $02DB, $0142, $00B4, $013E, $015B, $02C7,
+    $00B8, $0161, $015F, $0165, $017A, $02DD, $017E, $017C,
+    $0154, $00C1, $00C2, $0102, $00C4, $0139, $0106, $00C7,
+    $010C, $00C9, $0118, $00CB, $011A, $00CD, $00CE, $010E,
+    $0110, $0143, $0147, $00D3, $00D4, $0150, $00D6, $00D7,
+    $0158, $016E, $00DA, $0170, $00DC, $00DD, $0162, $00DF,
+    $0155, $00E1, $00E2, $0103, $00E4, $013A, $0107, $00E7,
+    $010D, $00E9, $0119, $00EB, $011B, $00ED, $00EE, $010F,
+    $0111, $0144, $0148, $00F3, $00F4, $0151, $00F6, $00F7,
+    $0159, $016F, $00FA, $0171, $00FC, $00FD, $0163, $02D9
+    );
+
+{Latin-3
+  Afrikaans, Catalan, English, Esperanto, French, Galician,
+  German, Italian, Maltese and Turkish.
+}
+  CharISO_8859_3: array[128..255] of Word =
+  (
+    $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
+    $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
+    $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
+    $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
+    $00A0, $0126, $02D8, $00A3, $00A4, $FFFD, $0124, $00A7,
+    $00A8, $0130, $015E, $011E, $0134, $00AD, $FFFD, $017B,
+    $00B0, $0127, $00B2, $00B3, $00B4, $00B5, $0125, $00B7,
+    $00B8, $0131, $015F, $011F, $0135, $00BD, $FFFD, $017C,
+    $00C0, $00C1, $00C2, $FFFD, $00C4, $010A, $0108, $00C7,
+    $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
+    $FFFD, $00D1, $00D2, $00D3, $00D4, $0120, $00D6, $00D7,
+    $011C, $00D9, $00DA, $00DB, $00DC, $016C, $015C, $00DF,
+    $00E0, $00E1, $00E2, $FFFD, $00E4, $010B, $0109, $00E7,
+    $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
+    $FFFD, $00F1, $00F2, $00F3, $00F4, $0121, $00F6, $00F7,
+    $011D, $00F9, $00FA, $00FB, $00FC, $016D, $015D, $02D9
+    );
+
+{Latin-4
+  Danish, English, Estonian, Finnish, German, Greenlandic,
+  Lappish, Latvian, Lithuanian, Norwegian and Swedish.
+}
+  CharISO_8859_4: array[128..255] of Word =
+  (
+    $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
+    $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
+    $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
+    $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
+    $00A0, $0104, $0138, $0156, $00A4, $0128, $013B, $00A7,
+    $00A8, $0160, $0112, $0122, $0166, $00AD, $017D, $00AF,
+    $00B0, $0105, $02DB, $0157, $00B4, $0129, $013C, $02C7,
+    $00B8, $0161, $0113, $0123, $0167, $014A, $017E, $014B,
+    $0100, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $012E,
+    $010C, $00C9, $0118, $00CB, $0116, $00CD, $00CE, $012A,
+    $0110, $0145, $014C, $0136, $00D4, $00D5, $00D6, $00D7,
+    $00D8, $0172, $00DA, $00DB, $00DC, $0168, $016A, $00DF,
+    $0101, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $012F,
+    $010D, $00E9, $0119, $00EB, $0117, $00ED, $00EE, $012B,
+    $0111, $0146, $014D, $0137, $00F4, $00F5, $00F6, $00F7,
+    $00F8, $0173, $00FA, $00FB, $00FC, $0169, $016B, $02D9
+    );
+
+{CYRILLIC
+  Bulgarian, Bielorussian, English, Macedonian, Russian,
+  Serbo-Croatian and Ukrainian.
+}
+  CharISO_8859_5: array[128..255] of Word =
+  (
+    $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
+    $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
+    $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
+    $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
+    $00A0, $0401, $0402, $0403, $0404, $0405, $0406, $0407,
+    $0408, $0409, $040A, $040B, $040C, $00AD, $040E, $040F,
+    $0410, $0411, $0412, $0413, $0414, $0415, $0416, $0417,
+    $0418, $0419, $041A, $041B, $041C, $041D, $041E, $041F,
+    $0420, $0421, $0422, $0423, $0424, $0425, $0426, $0427,
+    $0428, $0429, $042A, $042B, $042C, $042D, $042E, $042F,
+    $0430, $0431, $0432, $0433, $0434, $0435, $0436, $0437,
+    $0438, $0439, $043A, $043B, $043C, $043D, $043E, $043F,
+    $0440, $0441, $0442, $0443, $0444, $0445, $0446, $0447,
+    $0448, $0449, $044A, $044B, $044C, $044D, $044E, $044F,
+    $2116, $0451, $0452, $0453, $0454, $0455, $0456, $0457,
+    $0458, $0459, $045A, $045B, $045C, $00A7, $045E, $045F
+    );
+
+{ARABIC
+}
+  CharISO_8859_6: array[128..255] of Word =
+  (
+    $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
+    $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
+    $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
+    $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
+    $00A0, $FFFD, $FFFD, $FFFD, $00A4, $FFFD, $FFFD, $FFFD,
+    $FFFD, $FFFD, $FFFD, $FFFD, $060C, $00AD, $FFFD, $FFFD,
+    $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD,
+    $FFFD, $FFFD, $FFFD, $061B, $FFFD, $FFFD, $FFFD, $061F,
+    $FFFD, $0621, $0622, $0623, $0624, $0625, $0626, $0627,
+    $0628, $0629, $062A, $062B, $062C, $062D, $062E, $062F,
+    $0630, $0631, $0632, $0633, $0634, $0635, $0636, $0637,
+    $0638, $0639, $063A, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD,
+    $0640, $0641, $0642, $0643, $0644, $0645, $0646, $0647,
+    $0648, $0649, $064A, $064B, $064C, $064D, $064E, $064F,
+    $0650, $0651, $0652, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD,
+    $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD
+    );
+
+{GREEK
+}
+  CharISO_8859_7: array[128..255] of Word =
+  (
+    $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
+    $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
+    $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
+    $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
+    $00A0, $2018, $2019, $00A3, $FFFD, $FFFD, $00A6, $00A7,
+    $00A8, $00A9, $FFFD, $00AB, $00AC, $00AD, $FFFD, $2015,
+    $00B0, $00B1, $00B2, $00B3, $0384, $0385, $0386, $00B7,
+    $0388, $0389, $038A, $00BB, $038C, $00BD, $038E, $038F,
+    $0390, $0391, $0392, $0393, $0394, $0395, $0396, $0397,
+    $0398, $0399, $039A, $039B, $039C, $039D, $039E, $039F,
+    $03A0, $03A1, $FFFD, $03A3, $03A4, $03A5, $03A6, $03A7,
+    $03A8, $03A9, $03AA, $03AB, $03AC, $03AD, $03AE, $03AF,
+    $03B0, $03B1, $03B2, $03B3, $03B4, $03B5, $03B6, $03B7,
+    $03B8, $03B9, $03BA, $03BB, $03BC, $03BD, $03BE, $03BF,
+    $03C0, $03C1, $03C2, $03C3, $03C4, $03C5, $03C6, $03C7,
+    $03C8, $03C9, $03CA, $03CB, $03CC, $03CD, $03CE, $FFFD
+    );
+
+{HEBREW
+}
+  CharISO_8859_8: array[128..255] of Word =
+  (
+    $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
+    $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
+    $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
+    $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
+    $00A0, $FFFD, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7,
+    $00A8, $00A9, $00D7, $00AB, $00AC, $00AD, $00AE, $00AF,
+    $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7,
+    $00B8, $00B9, $00F7, $00BB, $00BC, $00BD, $00BE, $FFFD,
+    $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD,
+    $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD,
+    $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD,
+    $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $2017,
+    $05D0, $05D1, $05D2, $05D3, $05D4, $05D5, $05D6, $05D7,
+    $05D8, $05D9, $05DA, $05DB, $05DC, $05DD, $05DE, $05DF,
+    $05E0, $05E1, $05E2, $05E3, $05E4, $05E5, $05E6, $05E7,
+    $05E8, $05E9, $05EA, $FFFD, $FFFD, $200E, $200F, $FFFD
+    );
+
+{Latin-5
+  English, Finnish, French, German, Irish, Italian, Norwegian,
+  Portuguese, Spanish, Swedish and Turkish.
+}
+  CharISO_8859_9: array[128..255] of Word =
+  (
+    $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
+    $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
+    $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
+    $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
+    $00A0, $0104, $02D8, $0141, $00A4, $013D, $015A, $00A7,
+    $00A8, $0160, $015E, $0164, $0179, $00AD, $017D, $017B,
+    $00B0, $0105, $02DB, $0142, $00B4, $013E, $015B, $02C7,
+    $00B8, $0161, $015F, $0165, $017A, $02DD, $017E, $017C,
+    $0154, $00C1, $00C2, $0102, $00C4, $0139, $0106, $00C7,
+    $010C, $00C9, $0118, $00CB, $011A, $00CD, $00CE, $010E,
+    $011E, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7,
+    $00D8, $00D9, $00DA, $00DB, $00DC, $0130, $015E, $00DF,
+    $00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7,
+    $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
+    $011F, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7,
+    $00F8, $00F9, $00FA, $00FB, $00FC, $0131, $015F, $00FF
+    );
+
+{Latin-6
+  Danish, English, Estonian, Faeroese, Finnish, German, Greenlandic,
+  Icelandic, Lappish, Latvian, Lithuanian, Norwegian and Swedish.
+}
+  CharISO_8859_10: array[128..255] of Word =
+  (
+    $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
+    $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
+    $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
+    $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
+    $00A0, $0104, $0112, $0122, $012A, $0128, $0136, $00A7,
+    $013B, $0110, $0160, $0166, $017D, $00AD, $016A, $014A,
+    $00B0, $0105, $0113, $0123, $012B, $0129, $0137, $00B7,
+    $013C, $0111, $0161, $0167, $017E, $2015, $016B, $014B,
+    $0100, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $012E,
+    $010C, $00C9, $0118, $00CB, $0116, $00CD, $00CE, $00CF,
+    $00D0, $0145, $014C, $00D3, $00D4, $00D5, $00D6, $0168,
+    $00D8, $0172, $00DA, $00DB, $00DC, $00DD, $00DE, $00DF,
+    $0101, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $012F,
+    $010D, $00E9, $0119, $00EB, $0117, $00ED, $00EE, $00EF,
+    $00F0, $0146, $014D, $00F3, $00F4, $00F5, $00F6, $0169,
+    $00F8, $0173, $00FA, $00FB, $00FC, $00FD, $00FE, $0138
+    );
+
+  CharISO_8859_13: array[128..255] of Word =
+  (
+    $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
+    $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
+    $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
+    $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
+    $00A0, $201D, $00A2, $00A3, $00A4, $201E, $00A6, $00A7,
+    $00D8, $00A9, $0156, $00AB, $00AC, $00AD, $00AE, $00C6,
+    $00B0, $00B1, $00B2, $00B3, $201C, $00B5, $00B6, $00B7,
+    $00F8, $00B9, $0157, $00BB, $00BC, $00BD, $00BE, $00E6,
+    $0104, $012E, $0100, $0106, $00C4, $00C5, $0118, $0112,
+    $010C, $00C9, $0179, $0116, $0122, $0136, $012A, $013B,
+    $0160, $0143, $0145, $00D3, $014C, $00D5, $00D6, $00D7,
+    $0172, $0141, $015A, $016A, $00DC, $017B, $017D, $00DF,
+    $0105, $012F, $0101, $0107, $00E4, $00E5, $0119, $0113,
+    $010D, $00E9, $017A, $0117, $0123, $0137, $012B, $013C,
+    $0161, $0144, $0146, $00F3, $014D, $00F5, $00F6, $00F7,
+    $0173, $0142, $015B, $016B, $00FC, $017C, $017E, $2019
+    );
+
+  CharISO_8859_14: array[128..255] of Word =
+  (
+    $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
+    $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
+    $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
+    $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
+    $00A0, $1E02, $1E03, $00A3, $010A, $010B, $1E0A, $00A7,
+    $1E80, $00A9, $1E82, $1E0B, $1EF2, $00AD, $00AE, $0178,
+    $1E1E, $1E1F, $0120, $0121, $1E40, $1E41, $00B6, $1E56,
+    $1E81, $1E57, $1E83, $1E60, $1EF3, $1E84, $1E85, $1E61,
+    $00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7,
+    $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
+    $0174, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $1E6A,
+    $00D8, $00D9, $00DA, $00DB, $00DC, $00DD, $0176, $00DF,
+    $00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7,
+    $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
+    $0175, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $1E6B,
+    $00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $0177, $00FF
+    );
+
+  CharISO_8859_15: array[128..255] of Word =
+  (
+    $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087,
+    $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
+    $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097,
+    $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
+    $00A0, $00A1, $00A2, $00A3, $20AC, $00A5, $0160, $00A7,
+    $0161, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF,
+    $00B0, $00B1, $00B2, $00B3, $017D, $00B5, $00B6, $00B7,
+    $017E, $00B9, $00BA, $00BB, $0152, $0153, $0178, $00BF,
+    $00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7,
+    $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
+    $00D0, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7,
+    $00D8, $00D9, $00DA, $00DB, $00DC, $00DD, $00DE, $00DF,
+    $00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7,
+    $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
+    $00F0, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7,
+    $00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $00FE, $00FF
+    );
+
+{Eastern European
+}
+  CharCP_1250: array[128..255] of Word =
+  (
+    $20AC, $FFFD, $201A, $FFFD, $201E, $2026, $2020, $2021,
+    $FFFD, $2030, $0160, $2039, $015A, $0164, $017D, $0179,
+    $FFFD, $2018, $2019, $201C, $201D, $2022, $2013, $2014,
+    $FFFD, $2122, $0161, $203A, $015B, $0165, $017E, $017A,
+    $00A0, $02C7, $02D8, $0141, $00A4, $0104, $00A6, $00A7,
+    $00A8, $00A9, $015E, $00AB, $00AC, $00AD, $00AE, $017B,
+    $00B0, $00B1, $02DB, $0142, $00B4, $00B5, $00B6, $00B7,
+    $00B8, $0105, $015F, $00BB, $013D, $02DD, $013E, $017C,
+    $0154, $00C1, $00C2, $0102, $00C4, $0139, $0106, $00C7,
+    $010C, $00C9, $0118, $00CB, $011A, $00CD, $00CE, $010E,
+    $0110, $0143, $0147, $00D3, $00D4, $0150, $00D6, $00D7,
+    $0158, $016E, $00DA, $0170, $00DC, $00DD, $0162, $00DF,
+    $0155, $00E1, $00E2, $0103, $00E4, $013A, $0107, $00E7,
+    $010D, $00E9, $0119, $00EB, $011B, $00ED, $00EE, $010F,
+    $0111, $0144, $0148, $00F3, $00F4, $0151, $00F6, $00F7,
+    $0159, $016F, $00FA, $0171, $00FC, $00FD, $0163, $02D9
+    );
+
+{Cyrillic
+}
+  CharCP_1251: array[128..255] of Word =
+  (
+    $0402, $0403, $201A, $0453, $201E, $2026, $2020, $2021,
+    $20AC, $2030, $0409, $2039, $040A, $040C, $040B, $040F,
+    $0452, $2018, $2019, $201C, $201D, $2022, $2013, $2014,
+    $FFFD, $2122, $0459, $203A, $045A, $045C, $045B, $045F,
+    $00A0, $040E, $045E, $0408, $00A4, $0490, $00A6, $00A7,
+    $0401, $00A9, $0404, $00AB, $00AC, $00AD, $00AE, $0407,
+    $00B0, $00B1, $0406, $0456, $0491, $00B5, $00B6, $00B7,
+    $0451, $2116, $0454, $00BB, $0458, $0405, $0455, $0457,
+    $0410, $0411, $0412, $0413, $0414, $0415, $0416, $0417,
+    $0418, $0419, $041A, $041B, $041C, $041D, $041E, $041F,
+    $0420, $0421, $0422, $0423, $0424, $0425, $0426, $0427,
+    $0428, $0429, $042A, $042B, $042C, $042D, $042E, $042F,
+    $0430, $0431, $0432, $0433, $0434, $0435, $0436, $0437,
+    $0438, $0439, $043A, $043B, $043C, $043D, $043E, $043F,
+    $0440, $0441, $0442, $0443, $0444, $0445, $0446, $0447,
+    $0448, $0449, $044A, $044B, $044C, $044D, $044E, $044F
+    );
+
+{Latin-1 (US, Western Europe)
+}
+  CharCP_1252: array[128..255] of Word =
+  (
+    $20AC, $FFFD, $201A, $0192, $201E, $2026, $2020, $2021,
+    $02C6, $2030, $0160, $2039, $0152, $FFFD, $017D, $FFFD,
+    $FFFD, $2018, $2019, $201C, $201D, $2022, $2013, $2014,
+    $02DC, $2122, $0161, $203A, $0153, $FFFD, $017E, $0178,
+    $00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7,
+    $00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF,
+    $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7,
+    $00B8, $00B9, $00BA, $00BB, $00BC, $00BD, $00BE, $00BF,
+    $00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7,
+    $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
+    $00D0, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7,
+    $00D8, $00D9, $00DA, $00DB, $00DC, $00DD, $00DE, $00DF,
+    $00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7,
+    $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
+    $00F0, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7,
+    $00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $00FE, $00FF
+    );
+
+{Greek
+}
+  CharCP_1253: array[128..255] of Word =
+  (
+    $20AC, $FFFD, $201A, $0192, $201E, $2026, $2020, $2021,
+    $FFFD, $2030, $FFFD, $2039, $FFFD, $FFFD, $FFFD, $FFFD,
+    $FFFD, $2018, $2019, $201C, $201D, $2022, $2013, $2014,
+    $FFFD, $2122, $FFFD, $203A, $FFFD, $FFFD, $FFFD, $FFFD,
+    $00A0, $0385, $0386, $00A3, $00A4, $00A5, $00A6, $00A7,
+    $00A8, $00A9, $FFFD, $00AB, $00AC, $00AD, $00AE, $2015,
+    $00B0, $00B1, $00B2, $00B3, $0384, $00B5, $00B6, $00B7,
+    $0388, $0389, $038A, $00BB, $038C, $00BD, $038E, $038F,
+    $0390, $0391, $0392, $0393, $0394, $0395, $0396, $0397,
+    $0398, $0399, $039A, $039B, $039C, $039D, $039E, $039F,
+    $03A0, $03A1, $FFFD, $03A3, $03A4, $03A5, $03A6, $03A7,
+    $03A8, $03A9, $03AA, $03AB, $03AC, $03AD, $03AE, $03AF,
+    $03B0, $03B1, $03B2, $03B3, $03B4, $03B5, $03B6, $03B7,
+    $03B8, $03B9, $03BA, $03BB, $03BC, $03BD, $03BE, $03BF,
+    $03C0, $03C1, $03C2, $03C3, $03C4, $03C5, $03C6, $03C7,
+    $03C8, $03C9, $03CA, $03CB, $03CC, $03CD, $03CE, $FFFD
+    );
+
+{Turkish
+}
+  CharCP_1254: array[128..255] of Word =
+  (
+    $20AC, $FFFD, $201A, $0192, $201E, $2026, $2020, $2021,
+    $02C6, $2030, $0160, $2039, $0152, $FFFD, $FFFD, $FFFD,
+    $FFFD, $2018, $2019, $201C, $201D, $2022, $2013, $2014,
+    $02DC, $2122, $0161, $203A, $0153, $FFFD, $FFFD, $0178,
+    $00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7,
+    $00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF,
+    $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7,
+    $00B8, $00B9, $00BA, $00BB, $00BC, $00BD, $00BE, $00BF,
+    $00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7,
+    $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
+    $011E, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7,
+    $00D8, $00D9, $00DA, $00DB, $00DC, $0130, $015E, $00DF,
+    $00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7,
+    $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
+    $011F, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7,
+    $00F8, $00F9, $00FA, $00FB, $00FC, $0131, $015F, $00FF
+    );
+
+{Hebrew
+}
+  CharCP_1255: array[128..255] of Word =
+  (
+    $20AC, $FFFD, $201A, $0192, $201E, $2026, $2020, $2021,
+    $02C6, $2030, $FFFD, $2039, $FFFD, $FFFD, $FFFD, $FFFD,
+    $FFFD, $2018, $2019, $201C, $201D, $2022, $2013, $2014,
+    $02DC, $2122, $FFFD, $203A, $FFFD, $FFFD, $FFFD, $FFFD,
+    $00A0, $00A1, $00A2, $00A3, $20AA, $00A5, $00A6, $00A7,
+    $00A8, $00A9, $00D7, $00AB, $00AC, $00AD, $00AE, $00AF,
+    $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7,
+    $00B8, $00B9, $00F7, $00BB, $00BC, $00BD, $00BE, $00BF,
+    $05B0, $05B1, $05B2, $05B3, $05B4, $05B5, $05B6, $05B7,
+    $05B8, $05B9, $FFFD, $05BB, $05BC, $05BD, $05BE, $05BF,
+    $05C0, $05C1, $05C2, $05C3, $05F0, $05F1, $05F2, $05F3,
+    $05F4, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD,
+    $05D0, $05D1, $05D2, $05D3, $05D4, $05D5, $05D6, $05D7,
+    $05D8, $05D9, $05DA, $05DB, $05DC, $05DD, $05DE, $05DF,
+    $05E0, $05E1, $05E2, $05E3, $05E4, $05E5, $05E6, $05E7,
+    $05E8, $05E9, $05EA, $FFFD, $FFFD, $200E, $200F, $FFFD
+    );
+
+{Arabic
+}
+  CharCP_1256: array[128..255] of Word =
+  (
+    $20AC, $067E, $201A, $0192, $201E, $2026, $2020, $2021,
+    $02C6, $2030, $0679, $2039, $0152, $0686, $0698, $0688,
+    $06AF, $2018, $2019, $201C, $201D, $2022, $2013, $2014,
+    $06A9, $2122, $0691, $203A, $0153, $200C, $200D, $06BA,
+    $00A0, $060C, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7,
+    $00A8, $00A9, $06BE, $00AB, $00AC, $00AD, $00AE, $00AF,
+    $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7,
+    $00B8, $00B9, $061B, $00BB, $00BC, $00BD, $00BE, $061F,
+    $06C1, $0621, $0622, $0623, $0624, $0625, $0626, $0627,
+    $0628, $0629, $062A, $062B, $062C, $062D, $062E, $062F,
+    $0630, $0631, $0632, $0633, $0634, $0635, $0636, $00D7,
+    $0637, $0638, $0639, $063A, $0640, $0641, $0642, $0643,
+    $00E0, $0644, $00E2, $0645, $0646, $0647, $0648, $00E7,
+    $00E8, $00E9, $00EA, $00EB, $0649, $064A, $00EE, $00EF,
+    $064B, $064C, $064D, $064E, $00F4, $064F, $0650, $00F7,
+    $0651, $00F9, $0652, $00FB, $00FC, $200E, $200F, $06D2
+    );
+
+{Baltic
+}
+  CharCP_1257: array[128..255] of Word =
+  (
+    $20AC, $FFFD, $201A, $FFFD, $201E, $2026, $2020, $2021,
+    $FFFD, $2030, $FFFD, $2039, $FFFD, $00A8, $02C7, $00B8,
+    $FFFD, $2018, $2019, $201C, $201D, $2022, $2013, $2014,
+    $FFFD, $2122, $FFFD, $203A, $FFFD, $00AF, $02DB, $FFFD,
+    $00A0, $FFFD, $00A2, $00A3, $00A4, $FFFD, $00A6, $00A7,
+    $00D8, $00A9, $0156, $00AB, $00AC, $00AD, $00AE, $00C6,
+    $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7,
+    $00F8, $00B9, $0157, $00BB, $00BC, $00BD, $00BE, $00E6,
+    $0104, $012E, $0100, $0106, $00C4, $00C5, $0118, $0112,
+    $010C, $00C9, $0179, $0116, $0122, $0136, $012A, $013B,
+    $0160, $0143, $0145, $00D3, $014C, $00D5, $00D6, $00D7,
+    $0172, $0141, $015A, $016A, $00DC, $017B, $017D, $00DF,
+    $0105, $012F, $0101, $0107, $00E4, $00E5, $0119, $0113,
+    $010D, $00E9, $017A, $0117, $0123, $0137, $012B, $013C,
+    $0161, $0144, $0146, $00F3, $014D, $00F5, $00F6, $00F7,
+    $0173, $0142, $015B, $016B, $00FC, $017C, $017E, $02D9
+    );
+
+{Vietnamese
+}
+  CharCP_1258: array[128..255] of Word =
+  (
+    $20AC, $FFFD, $201A, $0192, $201E, $2026, $2020, $2021,
+    $02C6, $2030, $FFFD, $2039, $0152, $FFFD, $FFFD, $FFFD,
+    $FFFD, $2018, $2019, $201C, $201D, $2022, $2013, $2014,
+    $02DC, $2122, $FFFD, $203A, $0153, $FFFD, $FFFD, $0178,
+    $00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7,
+    $00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF,
+    $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7,
+    $00B8, $00B9, $00BA, $00BB, $00BC, $00BD, $00BE, $00BF,
+    $00C0, $00C1, $00C2, $0102, $00C4, $00C5, $00C6, $00C7,
+    $00C8, $00C9, $00CA, $00CB, $0300, $00CD, $00CE, $00CF,
+    $0110, $00D1, $0309, $00D3, $00D4, $01A0, $00D6, $00D7,
+    $00D8, $00D9, $00DA, $00DB, $00DC, $01AF, $0303, $00DF,
+    $00E0, $00E1, $00E2, $0103, $00E4, $00E5, $00E6, $00E7,
+    $00E8, $00E9, $00EA, $00EB, $0301, $00ED, $00EE, $00EF,
+    $0111, $00F1, $0323, $00F3, $00F4, $01A1, $00F6, $00F7,
+    $00F8, $00F9, $00FA, $00FB, $00FC, $01B0, $20AB, $00FF
+    );
+
+{Cyrillic
+}
+  CharKOI8_R: array[128..255] of Word =
+  (
+    $2500, $2502, $250C, $2510, $2514, $2518, $251C, $2524,
+    $252C, $2534, $253C, $2580, $2584, $2588, $258C, $2590,
+    $2591, $2592, $2593, $2320, $25A0, $2219, $221A, $2248,
+    $2264, $2265, $00A0, $2321, $00B0, $00B2, $00B7, $00F7,
+    $2550, $2551, $2552, $0451, $2553, $2554, $2555, $2556,
+    $2557, $2558, $2559, $255A, $255B, $255C, $255D, $255E,
+    $255F, $2560, $2561, $0401, $2562, $2563, $2564, $2565,
+    $2566, $2567, $2568, $2569, $256A, $256B, $256C, $00A9,
+    $044E, $0430, $0431, $0446, $0434, $0435, $0444, $0433,
+    $0445, $0438, $0439, $043A, $043B, $043C, $043D, $043E,
+    $043F, $044F, $0440, $0441, $0442, $0443, $0436, $0432,
+    $044C, $044B, $0437, $0448, $044D, $0449, $0447, $044A,
+    $042E, $0410, $0411, $0426, $0414, $0415, $0424, $0413,
+    $0425, $0418, $0419, $041A, $041B, $041C, $041D, $041E,
+    $041F, $042F, $0420, $0421, $0422, $0423, $0416, $0412,
+    $042C, $042B, $0417, $0428, $042D, $0429, $0427, $042A
+    );
+
+{Czech (Kamenicky)
+}
+  CharCP_895: array[128..255] of Word =
+  (
+    $010C, $00FC, $00E9, $010F, $00E4, $010E, $0164, $010D,
+    $011B, $011A, $0139, $00CD, $013E, $013A, $00C4, $00C1,
+    $00C9, $017E, $017D, $00F4, $00F6, $00D3, $016F, $00DA,
+    $00FD, $00D6, $00DC, $0160, $013D, $00DD, $0158, $0165,
+    $00E1, $00ED, $00F3, $00FA, $0148, $0147, $016E, $00D4,
+    $0161, $0159, $0155, $0154, $00BC, $00A7, $00AB, $00BB,
+    $2591, $2592, $2593, $2502, $2524, $2561, $2562, $2556,
+    $2555, $2563, $2551, $2557, $255D, $255C, $255B, $2510,
+    $2514, $2534, $252C, $251C, $2500, $253C, $255E, $255F,
+    $255A, $2554, $2569, $2566, $2560, $2550, $256C, $2567,
+    $2568, $2564, $2565, $2559, $2558, $2552, $2553, $256B,
+    $256A, $2518, $250C, $2588, $2584, $258C, $2590, $2580,
+    $03B1, $03B2, $0393, $03C0, $03A3, $03C3, $03BC, $03C4,
+    $03A6, $0398, $03A9, $03B4, $221E, $2205, $03B5, $2229,
+    $2261, $00B1, $2265, $2264, $2320, $2321, $00F7, $2248,
+    $2218, $00B7, $2219, $221A, $207F, $00B2, $25A0, $00A0
+    );
+
+{Eastern European
+}
+  CharCP_852: array[128..255] of Word =
+  (
+    $00C7, $00FC, $00E9, $00E2, $00E4, $016F, $0107, $00E7,
+    $0142, $00EB, $0150, $0151, $00EE, $0179, $00C4, $0106,
+    $00C9, $0139, $013A, $00F4, $00F6, $013D, $013E, $015A,
+    $015B, $00D6, $00DC, $0164, $0165, $0141, $00D7, $010D,
+    $00E1, $00ED, $00F3, $00FA, $0104, $0105, $017D, $017E,
+    $0118, $0119, $00AC, $017A, $010C, $015F, $00AB, $00BB,
+    $2591, $2592, $2593, $2502, $2524, $00C1, $00C2, $011A,
+    $015E, $2563, $2551, $2557, $255D, $017B, $017C, $2510,
+    $2514, $2534, $252C, $251C, $2500, $253C, $0102, $0103,
+    $255A, $2554, $2569, $2566, $2560, $2550, $256C, $00A4,
+    $0111, $0110, $010E, $00CB, $010F, $0147, $00CD, $00CE,
+    $011B, $2518, $250C, $2588, $2584, $0162, $016E, $2580,
+    $00D3, $00DF, $00D4, $0143, $0144, $0148, $0160, $0161,
+    $0154, $00DA, $0155, $0170, $00FD, $00DD, $0163, $00B4,
+    $00AD, $02DD, $02DB, $02C7, $02D8, $00A7, $00F7, $00B8,
+    $00B0, $00A8, $02D9, $0171, $0158, $0159, $25A0, $00A0
+    );
+
+{==============================================================================}
+type
+  TIconvChar = record
+    Charset: TMimeChar;
+    CharName: string;
+  end;
+  TIconvArr = array [0..112] of TIconvChar;
+
+const
+  NotFoundChar = '_';
+
+var
+  SetTwo: set of TMimeChar = [UCS_2, UCS_2LE, UTF_7, UTF_7mod];
+  SetFour: set of TMimeChar = [UCS_4, UCS_4LE, UTF_8];
+  SetLE: set of TMimeChar = [UCS_2LE, UCS_4LE];
+
+  IconvArr: TIconvArr;
+
+{==============================================================================}
+function FindIconvID(const Value, Charname: string): Boolean;
+var
+  s: string;
+begin
+  Result := True;
+  //exact match
+  if Value = Charname then
+    Exit;
+  //Value is on begin of charname
+  s := Value + ' ';
+  if s = Copy(Charname, 1, Length(s)) then
+    Exit;
+  //Value is on end of charname
+  s := ' ' + Value;
+  if s = Copy(Charname, Length(Charname) - Length(s) + 1, Length(s)) then
+    Exit;
+  //value is somewhere inside charname
+  if Pos( s + ' ', Charname) > 0 then
+    Exit;
+  Result := False;
+end;
+
+function GetCPFromIconvID(Value: AnsiString): TMimeChar;
+var
+  n: integer;
+begin
+  Result := ISO_8859_1;
+  Value := UpperCase(Value);
+  for n := 0 to High(IconvArr) do
+    if FindIconvID(Value, IconvArr[n].Charname) then
+    begin
+      Result := IconvArr[n].Charset;
+      Break;
+    end;
+end;
+
+{==============================================================================}
+function GetIconvIDFromCP(Value: TMimeChar): AnsiString;
+var
+  n: integer;
+begin
+  Result := 'ISO-8859-1';
+  for n := 0 to High(IconvArr) do
+    if IconvArr[n].Charset = Value then
+    begin
+      Result := Separateleft(IconvArr[n].Charname, ' ');
+      Break;
+    end;
+end;
+
+{==============================================================================}
+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
+  n: Integer;
+begin
+  for n := 0 to 127 do
+    TargetTable[n] := SourceTable[n];
+end;
+
+{==============================================================================}
+procedure GetArray(CharSet: TMimeChar; var Result: array of Word);
+begin
+  case CharSet of
+    ISO_8859_2:
+      CopyArray(CharISO_8859_2, Result);
+    ISO_8859_3:
+      CopyArray(CharISO_8859_3, Result);
+    ISO_8859_4:
+      CopyArray(CharISO_8859_4, Result);
+    ISO_8859_5:
+      CopyArray(CharISO_8859_5, Result);
+    ISO_8859_6:
+      CopyArray(CharISO_8859_6, Result);
+    ISO_8859_7:
+      CopyArray(CharISO_8859_7, Result);
+    ISO_8859_8:
+      CopyArray(CharISO_8859_8, Result);
+    ISO_8859_9:
+      CopyArray(CharISO_8859_9, Result);
+    ISO_8859_10:
+      CopyArray(CharISO_8859_10, Result);
+    ISO_8859_13:
+      CopyArray(CharISO_8859_13, Result);
+    ISO_8859_14:
+      CopyArray(CharISO_8859_14, Result);
+    ISO_8859_15:
+      CopyArray(CharISO_8859_15, Result);
+    CP1250:
+      CopyArray(CharCP_1250, Result);
+    CP1251:
+      CopyArray(CharCP_1251, Result);
+    CP1252:
+      CopyArray(CharCP_1252, Result);
+    CP1253:
+      CopyArray(CharCP_1253, Result);
+    CP1254:
+      CopyArray(CharCP_1254, Result);
+    CP1255:
+      CopyArray(CharCP_1255, Result);
+    CP1256:
+      CopyArray(CharCP_1256, Result);
+    CP1257:
+      CopyArray(CharCP_1257, Result);
+    CP1258:
+      CopyArray(CharCP_1258, Result);
+    KOI8_R:
+      CopyArray(CharKOI8_R, Result);
+    CP895:
+      CopyArray(CharCP_895, Result);
+    CP852:
+      CopyArray(CharCP_852, Result);
+  else
+      CopyArray(CharISO_8859_1, Result);
+  end;
+end;
+
+{==============================================================================}
+procedure ReadMulti(const Value: AnsiString; var Index: Integer; mb: Byte;
+  var b1, b2, b3, b4: Byte; le: boolean);
+Begin
+  b1 := 0;
+  b2 := 0;
+  b3 := 0;
+  b4 := 0;
+  if Index < 0 then
+    Index := 1;
+  if mb > 4 then
+    mb := 1;
+  if (Index + mb - 1) <= Length(Value) then
+  begin
+    if le then
+      Case mb Of
+        1:
+          b1 := Ord(Value[Index]);
+        2:
+          Begin
+            b1 := Ord(Value[Index]);
+            b2 := Ord(Value[Index + 1]);
+          End;
+        3:
+          Begin
+            b1 := Ord(Value[Index]);
+            b2 := Ord(Value[Index + 1]);
+            b3 := Ord(Value[Index + 2]);
+          End;
+        4:
+          Begin
+            b1 := Ord(Value[Index]);
+            b2 := Ord(Value[Index + 1]);
+            b3 := Ord(Value[Index + 2]);
+            b4 := Ord(Value[Index + 3]);
+          End;
+      end
+    else
+      Case mb Of
+        1:
+          b1 := Ord(Value[Index]);
+        2:
+          Begin
+            b2 := Ord(Value[Index]);
+            b1 := Ord(Value[Index + 1]);
+          End;
+        3:
+          Begin
+            b3 := Ord(Value[Index]);
+            b2 := Ord(Value[Index + 1]);
+            b1 := Ord(Value[Index + 2]);
+          End;
+        4:
+          Begin
+            b4 := Ord(Value[Index]);
+            b3 := Ord(Value[Index + 1]);
+            b2 := Ord(Value[Index + 2]);
+            b1 := Ord(Value[Index + 3]);
+          End;
+      end;
+  end;
+  Inc(Index, mb);
+end;
+
+{==============================================================================}
+function WriteMulti(b1, b2, b3, b4: Byte; mb: Byte; le: boolean): AnsiString;
+begin
+  if mb > 4 then
+    mb := 1;
+  SetLength(Result, mb);
+  if le then
+    case mb Of
+      1:
+        Result[1] := AnsiChar(b1);
+      2:
+        begin
+          Result[1] := AnsiChar(b1);
+          Result[2] := AnsiChar(b2);
+        end;
+      3:
+        begin
+          Result[1] := AnsiChar(b1);
+          Result[2] := AnsiChar(b2);
+          Result[3] := AnsiChar(b3);
+        end;
+      4:
+        begin
+          Result[1] := AnsiChar(b1);
+          Result[2] := AnsiChar(b2);
+          Result[3] := AnsiChar(b3);
+          Result[4] := AnsiChar(b4);
+        end;
+    end
+  else
+    case mb Of
+      1:
+        Result[1] := AnsiChar(b1);
+      2:
+        begin
+          Result[2] := AnsiChar(b1);
+          Result[1] := AnsiChar(b2);
+        end;
+      3:
+        begin
+          Result[3] := AnsiChar(b1);
+          Result[2] := AnsiChar(b2);
+          Result[1] := AnsiChar(b3);
+        end;
+      4:
+        begin
+          Result[4] := AnsiChar(b1);
+          Result[3] := AnsiChar(b2);
+          Result[2] := AnsiChar(b3);
+          Result[1] := AnsiChar(b4);
+        end;
+    end;
+end;
+
+{==============================================================================}
+function UTF8toUCS4(const Value: AnsiString): AnsiString;
+var
+  n, x, ul, m: Integer;
+  s: AnsiString;
+  w1, w2: Word;
+begin
+  Result := '';
+  n := 1;
+  while Length(Value) >= n do
+  begin
+    x := Ord(Value[n]);
+    Inc(n);
+    if x < 128 then
+      Result := Result + WriteMulti(x, 0, 0, 0, 4, false)
+    else
+    begin
+      m := 0;
+      if (x and $E0) = $C0 then
+        m := $1F;
+      if (x and $F0) = $E0 then
+        m := $0F;
+      if (x and $F8) = $F0 then
+        m := $07;
+      if (x and $FC) = $F8 then
+        m := $03;
+      if (x and $FE) = $FC then
+        m := $01;
+      ul := x and m;
+      s := IntToBin(ul, 0);
+      while Length(Value) >= n do
+      begin
+        x := Ord(Value[n]);
+        Inc(n);
+        if (x and $C0) = $80 then
+          s := s + IntToBin(x and $3F, 6)
+        else
+        begin
+          Dec(n);
+          Break;
+        end;
+      end;
+      ul := BinToInt(s);
+      w1 := ul div 65536;
+      w2 := ul mod 65536;
+      Result := Result + WriteMulti(Lo(w2), Hi(w2), Lo(w1), Hi(w1), 4, false);
+    end;
+  end;
+end;
+
+{==============================================================================}
+function UCS4toUTF8(const Value: AnsiString): AnsiString;
+var
+  s, l, k: AnsiString;
+  b1, b2, b3, b4: Byte;
+  n, m, x, y: Integer;
+  b: Byte;
+begin
+  Result := '';
+  n := 1;
+  while Length(Value) >= n do
+  begin
+    ReadMulti(Value, n, 4, b1, b2, b3, b4, false);
+    if (b2 = 0) and (b3 = 0) and (b4 = 0) and (b1 < 128) then
+      Result := Result + AnsiChar(b1)
+    else
+    begin
+      x := (b1 + 256 * b2) + (b3 + 256 * b4) * 65536;
+      l := IntToBin(x, 0);
+      y := Length(l) div 6;
+      s := '';
+      for m := 1 to y do
+      begin
+        k := Copy(l, Length(l) - 5, 6);
+        l := Copy(l, 1, Length(l) - 6);
+        b := BinToInt(k) or $80;
+        s := AnsiChar(b) + s;
+      end;
+      b := BinToInt(l);
+      case y of
+        5:
+          b := b or $FC;
+        4:
+          b := b or $F8;
+        3:
+          b := b or $F0;
+        2:
+          b := b or $E0;
+        1:
+          b := b or $C0;
+      end;
+      s := AnsiChar(b) + s;
+      Result := Result + s;
+    end;
+  end;
+end;
+
+{==============================================================================}
+function UTF7toUCS2(const Value: AnsiString; Modified: Boolean): AnsiString;
+var
+  n, i: Integer;
+  c: AnsiChar;
+  s, t: AnsiString;
+  shift: AnsiChar;
+  table: String;
+begin
+  Result := '';
+  n := 1;
+  if modified then
+  begin
+    shift := '&';
+    table := TableBase64mod;
+  end
+  else
+  begin
+    shift := '+';
+    table := TableBase64;
+  end;
+  while Length(Value) >= n do
+  begin
+    c := Value[n];
+    Inc(n);
+    if c <> shift then
+      Result := Result + WriteMulti(Ord(c), 0, 0, 0, 2, false)
+    else
+    begin
+      s := '';
+      while Length(Value) >= n do
+      begin
+        c := Value[n];
+        Inc(n);
+        if c = '-' then
+          Break;
+        if (c = '=') or (Pos(c, table) < 1) then
+        begin
+          Dec(n);
+          Break;
+        end;
+        s := s + c;
+      end;
+      if s = '' then
+        s := WriteMulti(Ord(shift), 0, 0, 0, 2, false)
+      else
+      begin
+        if modified then
+          t := DecodeBase64mod(s)
+        else
+          t := DecodeBase64(s);
+        if not odd(length(t)) then
+          s := t
+        else
+        begin //ill-formed sequence
+          t := s;
+          s := WriteMulti(Ord(shift), 0, 0, 0, 2, false);
+          for i := 1 to length(t) do
+            s := s + WriteMulti(Ord(t[i]), 0, 0, 0, 2, false);
+        end;
+      end;
+      Result := Result + s;
+    end;
+  end;
+end;
+
+{==============================================================================}
+function UCS2toUTF7(const Value: AnsiString; Modified: Boolean): AnsiString;
+var
+  s: AnsiString;
+  b1, b2, b3, b4: Byte;
+  n, m: Integer;
+  shift: AnsiChar;
+begin
+  Result := '';
+  n := 1;
+  if modified then
+    shift := '&'
+  else
+    shift := '+';
+  while Length(Value) >= n do
+  begin
+    ReadMulti(Value, n, 2, b1, b2, b3, b4, false);
+    if (b2 = 0) and (b1 < 128) then
+      if AnsiChar(b1) = shift then
+        Result := Result + shift + '-'
+      else
+        Result := Result + AnsiChar(b1)
+    else
+    begin
+      s := AnsiChar(b2) + AnsiChar(b1);
+      while Length(Value) >= n do
+      begin
+        ReadMulti(Value, n, 2, b1, b2, b3, b4, false);
+        if (b2 = 0) and (b1 < 128) then
+        begin
+          Dec(n, 2);
+          Break;
+        end;
+        s := s + AnsiChar(b2) + AnsiChar(b1);
+      end;
+      if modified then
+        s := EncodeBase64mod(s)
+      else
+        s := EncodeBase64(s);
+      m := Pos('=', s);
+      if m > 0 then
+        s := Copy(s, 1, m - 1);
+      Result := Result + shift + s + '-';
+    end;
+  end;
+end;
+
+{==============================================================================}
+function CharsetConversion(const Value: AnsiString; CharFrom: TMimeChar;
+  CharTo: TMimeChar): AnsiString;
+begin
+  Result := CharsetConversionEx(Value, CharFrom, CharTo, Replace_None);
+end;
+
+{==============================================================================}
+function CharsetConversionEx(const Value: AnsiString; CharFrom: TMimeChar;
+  CharTo: TMimeChar; const TransformTable: array of Word): AnsiString;
+begin
+  Result := CharsetConversionTrans(Value, CharFrom, CharTo, TransformTable, True);
+end;
+
+{==============================================================================}
+
+function InternalToUcs(const Value: AnsiString; Charfrom: TMimeChar): AnsiString;
+var
+  uni: Word;
+  n: Integer;
+  b1, b2, b3, b4: Byte;
+  SourceTable: array[128..255] of Word;
+  mbf: Byte;
+  lef: Boolean;
+  s: AnsiString;
+begin
+  if CharFrom = UTF_8 then
+    s := UTF8toUCS4(Value)
+  else
+    if CharFrom = UTF_7 then
+      s := UTF7toUCS2(Value, False)
+    else
+      if CharFrom = UTF_7mod then
+        s := UTF7toUCS2(Value, True)
+      else
+        s := Value;
+  GetArray(CharFrom, SourceTable);
+  mbf := 1;
+  if CharFrom in SetTwo then
+    mbf := 2;
+  if CharFrom in SetFour then
+    mbf := 4;
+  lef := CharFrom in SetLe;
+  Result := '';
+  n := 1;
+  while Length(s) >= n do
+  begin
+    ReadMulti(s, n, mbf, b1, b2, b3, b4, lef);
+    //handle BOM
+    if (b3 = 0) and (b4 = 0) then
+    begin
+      if (b1 = $FE) and (b2 = $FF) then
+      begin
+        lef := not lef;
+        continue;
+      end;
+      if (b1 = $FF) and (b2 = $FE) then
+        continue;
+    end;
+    if mbf = 1 then
+      if b1 > 127 then
+      begin
+        uni := SourceTable[b1];
+        b1 := Lo(uni);
+        b2 := Hi(uni);
+      end;
+    Result := Result + WriteMulti(b1, b2, b3, b4, 2, False);
+  end;
+end;
+
+function CharsetConversionTrans(Value: AnsiString; CharFrom: TMimeChar;
+  CharTo: TMimeChar; const TransformTable: array of Word; Translit: Boolean): AnsiString;
+var
+  uni: Word;
+  n, m: Integer;
+  b: Byte;
+  b1, b2, b3, b4: Byte;
+  TargetTable: array[128..255] of Word;
+  mbt: Byte;
+  let: Boolean;
+  ucsstring, s, t: AnsiString;
+  cd: iconv_t;
+  f: Boolean;
+  NotNeedTransform: Boolean;
+  FromID, ToID: string;
+begin
+  NotNeedTransform := (High(TransformTable) = 0);
+  if (CharFrom = CharTo) and NotNeedTransform then
+  begin
+    Result := Value;
+    Exit;
+  end;
+  FromID := GetIDFromCP(CharFrom);
+  ToID := GetIDFromCP(CharTo);
+  cd := Iconv_t(-1);
+  //do two-pass conversion. Transform to UCS-2 first.
+  if not DisableIconv then
+    cd := SynaIconvOpenIgnore('UCS-2BE', FromID);
+  try
+    if cd <> iconv_t(-1) then
+      SynaIconv(cd, Value, ucsstring)
+    else
+      ucsstring := InternalToUcs(Value, CharFrom);
+  finally
+    SynaIconvClose(cd);
+  end;
+  //here we allways have ucstring with UCS-2 encoding
+  //second pass... from UCS-2 to target encoding.
+    if not DisableIconv then
+      if translit then
+        cd := SynaIconvOpenTranslit(ToID, 'UCS-2BE')
+      else
+        cd := SynaIconvOpenIgnore(ToID, 'UCS-2BE');
+  try
+    if (cd <> iconv_t(-1)) and NotNeedTransform then
+    begin
+      if CharTo = UTF_7 then
+        ucsstring := ucsstring + #0 + '-';
+      //when transformtable is not needed and Iconv know target charset,
+      //do it fast by one call.
+      SynaIconv(cd, ucsstring, Result);
+      if CharTo = UTF_7 then
+        Delete(Result, Length(Result), 1);
+    end
+    else
+    begin
+      GetArray(CharTo, TargetTable);
+      mbt := 1;
+      if CharTo in SetTwo then
+        mbt := 2;
+      if CharTo in SetFour then
+        mbt := 4;
+      let := CharTo in SetLe;
+      b3 := 0;
+      b4 := 0;
+      Result := '';
+      for n:= 0 to (Length(ucsstring) div 2) - 1 do
+      begin
+        s := Copy(ucsstring, n * 2 + 1, 2);
+        b2 := Ord(s[1]);
+        b1 := Ord(s[2]);
+        uni := b2 * 256 + b1;
+        if not NotNeedTransform then
+        begin
+          uni := ReplaceUnicode(uni, TransformTable);
+          b1 := Lo(uni);
+          b2 := Hi(uni);
+          s[1] := AnsiChar(b2);
+          s[2] := AnsiChar(b1);
+        end;
+        if cd <> iconv_t(-1) then
+        begin
+          if CharTo = UTF_7 then
+            s := s + #0 + '-';
+          SynaIconv(cd, s, t);
+          if CharTo = UTF_7 then
+            Delete(t, Length(t), 1);
+          Result := Result + t;
+        end
+        else
+        begin
+          f := True;
+          if mbt = 1 then
+            if uni > 127 then
+            begin
+              f := False;
+              b := 0;
+              for m := 128 to 255 do
+                if TargetTable[m] = uni then
+                begin
+                  b := m;
+                  f := True;
+                  Break;
+                end;
+              b1 := b;
+              b2 := 0;
+            end
+            else
+              b1 := Lo(uni);
+          if not f then
+            if translit then
+            begin
+              b1 := Ord(NotFoundChar);
+              b2 := 0;
+              f := True;
+            end;
+          if f then
+            Result := Result + WriteMulti(b1, b2, b3, b4, mbt, let)
+        end;
+      end;
+      if cd = iconv_t(-1) then
+      begin
+        if CharTo = UTF_7 then
+          Result := UCS2toUTF7(Result, false);
+        if CharTo = UTF_7mod then
+          Result := UCS2toUTF7(Result, true);
+        if CharTo = UTF_8 then
+          Result := UCS4toUTF8(Result);
+      end;
+    end;
+  finally
+    SynaIconvClose(cd);
+  end;
+end;
+
+{==============================================================================}
+{$IFNDEF WIN32}
+
+function GetCurCP: TMimeChar;
+begin
+  {$IFNDEF FPC}
+  Result := GetCPFromID(nl_langinfo(_NL_CTYPE_CODESET_NAME));
+  {$ELSE}
+    {$IFDEF FPC_USE_LIBC}
+  Result := GetCPFromID(nl_langinfo(_NL_CTYPE_CODESET_NAME));
+    {$ELSE}
+  //How to get system codepage without LIBC?
+  Result := UTF_8;
+    {$ENDIF}
+  {$ENDIF}
+end;
+
+function GetCurOEMCP: TMimeChar;
+begin
+  Result := GetCurCP;
+end;
+
+{$ELSE}
+
+function CPToMimeChar(Value: Integer): TMimeChar;
+begin
+  case Value of
+    437, 850, 20127:
+      Result := ISO_8859_1; //I know, it is not ideal!
+    737:
+      Result := CP737;
+    775:
+      Result := CP775;
+    852:
+      Result := CP852;
+    855:
+      Result := CP855;
+    857:
+      Result := CP857;
+    858:
+      Result := CP858;
+    860:
+      Result := CP860;
+    861:
+      Result := CP861;
+    862:
+      Result := CP862;
+    863:
+      Result := CP863;
+    864:
+      Result := CP864;
+    865:
+      Result := CP865;
+    866:
+      Result := CP866;
+    869:
+      Result := CP869;
+    874:
+      Result := ISO_8859_15;
+    895:
+      Result := CP895;
+    932:
+      Result := CP932;
+    936:
+      Result := CP936;
+    949:
+      Result := CP949;
+    950:
+      Result := CP950;
+    1200:
+      Result := UCS_2LE;
+    1201:
+      Result := UCS_2;
+    1250:
+      Result := CP1250;
+    1251:
+      Result := CP1251;
+    1253:
+      Result := CP1253;
+    1254:
+      Result := CP1254;
+    1255:
+      Result := CP1255;
+    1256:
+      Result := CP1256;
+    1257:
+      Result := CP1257;
+    1258:
+      Result := CP1258;
+    1361:
+      Result := CP1361;
+    10000:
+      Result := MAC;
+    10004:
+      Result := MACAR;
+    10005:
+      Result := MACHEB;
+    10006:
+      Result := MACGR;
+    10007:
+      Result := MACCYR;
+    10010:
+      Result := MACRO;
+    10017:
+      Result := MACUK;
+    10021:
+      Result := MACTH;
+    10029:
+      Result := MACCE;
+    10079:
+      Result := MACICE;
+    10081:
+      Result := MACTU;
+    10082:
+      Result := MACCRO;
+    12000:
+      Result := UCS_4LE;
+    12001:
+      Result := UCS_4;
+    20866:
+      Result := KOI8_R;
+    20932:
+      Result := JIS_X0208;
+    20936:
+      Result := GB2312;
+    21866:
+      Result := KOI8_U;
+    28591:
+      Result := ISO_8859_1;
+    28592:
+      Result := ISO_8859_2;
+    28593:
+      Result := ISO_8859_3;
+    28594:
+      Result := ISO_8859_4;
+    28595:
+      Result := ISO_8859_5;
+    28596, 708:
+      Result := ISO_8859_6;
+    28597:
+      Result := ISO_8859_7;
+    28598, 38598:
+      Result := ISO_8859_8;
+    28599:
+      Result := ISO_8859_9;
+    28605:
+      Result := ISO_8859_15;
+    50220:
+      Result := ISO_2022_JP; //? ISO 2022 Japanese with no halfwidth Katakana
+    50221:
+      Result := ISO_2022_JP1;//? Japanese with halfwidth Katakana
+    50222:
+      Result := ISO_2022_JP2;//? Japanese JIS X 0201-1989
+    50225:
+      Result := ISO_2022_KR;
+    50227:
+      Result := ISO_2022_CN;//? ISO 2022 Simplified Chinese
+    50229:
+      Result := ISO_2022_CNE;//? ISO 2022 Traditional Chinese
+    51932:
+      Result := EUC_JP;
+    51936:
+      Result := GB2312;
+    51949:
+      Result := EUC_KR;
+    52936:
+      Result := HZ;
+    54936:
+      Result := GB18030;
+    65000:
+      Result := UTF_7;
+    65001:
+      Result := UTF_8;
+    0:
+      Result := UCS_2LE;
+  else
+    Result := CP1252;
+  end;
+end;
+
+function GetCurCP: TMimeChar;
+begin
+  Result := CPToMimeChar(GetACP);
+end;
+
+function GetCurOEMCP: TMimeChar;
+begin
+  Result := CPToMimeChar(GetOEMCP);
+end;
+{$ENDIF}
+
+{==============================================================================}
+function NeedCharsetConversion(const Value: AnsiString): Boolean;
+var
+  n: Integer;
+begin
+  Result := False;
+  for n := 1 to Length(Value) do
+    if (Ord(Value[n]) > 127) or (Ord(Value[n]) = 0) then
+    begin
+      Result := True;
+      Break;
+    end;
+end;
+
+{==============================================================================}
+function IdealCharsetCoding(const Value: AnsiString; CharFrom: TMimeChar;
+  CharTo: TMimeSetChar): TMimeChar;
+var
+  n: Integer;
+  max: Integer;
+  s, t, u: AnsiString;
+  CharSet: TMimeChar;
+begin
+  Result := ISO_8859_1;
+  s := Copy(Value, 1, 1024);  //max first 1KB for next procedure
+  max := 0;
+  for n := Ord(Low(TMimeChar)) to Ord(High(TMimeChar)) do
+  begin
+    CharSet := TMimeChar(n);
+    if CharSet in CharTo then
+    begin
+      t := CharsetConversionTrans(s, CharFrom, CharSet, Replace_None, False);
+      u := CharsetConversionTrans(t, CharSet, CharFrom, Replace_None, False);
+      if s = u then
+      begin
+        Result := CharSet;
+        Exit;
+      end;
+      if Length(u) > max then
+      begin
+        Result := CharSet;
+        max := Length(u);
+      end;
+    end;
+  end;
+end;
+
+{==============================================================================}
+function GetBOM(Value: TMimeChar): AnsiString;
+begin
+  Result := '';
+  case Value of
+    UCS_2:
+      Result := #$fe + #$ff;
+    UCS_4:
+      Result := #$00 + #$00 + #$fe + #$ff;
+    UCS_2LE:
+      Result := #$ff + #$fe;
+    UCS_4LE:
+      Result := #$ff + #$fe + #$00 + #$00;
+    UTF_8:
+      Result := #$ef + #$bb + #$bf;
+  end;
+end;
+
+{==============================================================================}
+function GetCPFromID(Value: AnsiString): TMimeChar;
+begin
+  Value := UpperCase(Value);
+  if (Pos('KAMENICKY', Value) > 0) or (Pos('895', Value) > 0) then
+    Result := CP895
+  else
+  if Pos('MUTF-7', Value) > 0 then
+    Result := UTF_7mod
+  else
+    Result := GetCPFromIconvID(Value);
+end;
+
+{==============================================================================}
+function GetIDFromCP(Value: TMimeChar): AnsiString;
+begin
+  case Value of
+    CP895:
+      Result := 'CP-895';
+    UTF_7mod:
+      Result := 'mUTF-7';
+  else
+    Result := GetIconvIDFromCP(Value);
+  end;
+end;
+
+{==============================================================================}
+function StringToWide(const Value: AnsiString): WideString;
+var
+  n: integer;
+  x, y: integer;
+begin
+  SetLength(Result, Length(Value) div 2);
+  for n := 1 to Length(Value) div 2 do
+  begin
+    x := Ord(Value[((n-1) * 2) + 1]);
+    y := Ord(Value[((n-1) * 2) + 2]);
+    Result[n] := WideChar(x * 256 + y);
+  end;
+end;
+
+{==============================================================================}
+function WideToString(const Value: WideString): AnsiString;
+var
+  n: integer;
+  x: integer;
+begin
+  SetLength(Result, Length(Value) * 2);
+  for n := 1 to Length(Value) do
+  begin
+    x := Ord(Value[n]);
+    Result[((n-1) * 2) + 1] := AnsiChar(x div 256);
+    Result[((n-1) * 2) + 2] := AnsiChar(x mod 256);
+  end;
+end;
+
+{==============================================================================}
+initialization
+begin
+  IconvArr[0].Charset := ISO_8859_1;
+  IconvArr[0].Charname := 'ISO-8859-1 CP819 IBM819 ISO-IR-100 ISO8859-1 ISO_8859-1 ISO_8859-1:1987 L1 LATIN1 CSISOLATIN1';
+  IconvArr[1].Charset := UTF_8;
+  IconvArr[1].Charname := 'UTF-8';
+  IconvArr[2].Charset := UCS_2;
+  IconvArr[2].Charname := 'ISO-10646-UCS-2 UCS-2 CSUNICODE';
+  IconvArr[3].Charset := UCS_2;
+  IconvArr[3].Charname := 'UCS-2BE UNICODE-1-1 UNICODEBIG CSUNICODE11';
+  IconvArr[4].Charset := UCS_2LE;
+  IconvArr[4].Charname := 'UCS-2LE UNICODELITTLE';
+  IconvArr[5].Charset := UCS_4;
+  IconvArr[5].Charname := 'ISO-10646-UCS-4 UCS-4 CSUCS4';
+  IconvArr[6].Charset := UCS_4;
+  IconvArr[6].Charname := 'UCS-4BE';
+  IconvArr[7].Charset := UCS_2LE;
+  IconvArr[7].Charname := 'UCS-4LE';
+  IconvArr[8].Charset := UTF_16;
+  IconvArr[8].Charname := 'UTF-16';
+  IconvArr[9].Charset := UTF_16;
+  IconvArr[9].Charname := 'UTF-16BE';
+  IconvArr[10].Charset := UTF_16LE;
+  IconvArr[10].Charname := 'UTF-16LE';
+  IconvArr[11].Charset := UTF_32;
+  IconvArr[11].Charname := 'UTF-32';
+  IconvArr[12].Charset := UTF_32;
+  IconvArr[12].Charname := 'UTF-32BE';
+  IconvArr[13].Charset := UTF_32;
+  IconvArr[13].Charname := 'UTF-32LE';
+  IconvArr[14].Charset := UTF_7;
+  IconvArr[14].Charname := 'UNICODE-1-1-UTF-7 UTF-7 CSUNICODE11UTF7';
+  IconvArr[15].Charset := C99;
+  IconvArr[15].Charname := 'C99';
+  IconvArr[16].Charset := JAVA;
+  IconvArr[16].Charname := 'JAVA';
+  IconvArr[17].Charset := ISO_8859_1;
+  IconvArr[17].Charname := 'US-ASCII ANSI_X3.4-1968 ANSI_X3.4-1986 ASCII CP367 IBM367 ISO-IR-6 ISO646-US ISO_646.IRV:1991 US CSASCII';
+  IconvArr[18].Charset := ISO_8859_2;
+  IconvArr[18].Charname := 'ISO-8859-2 ISO-IR-101 ISO8859-2 ISO_8859-2 ISO_8859-2:1987 L2 LATIN2 CSISOLATIN2';
+  IconvArr[19].Charset := ISO_8859_3;
+  IconvArr[19].Charname := 'ISO-8859-3 ISO-IR-109 ISO8859-3 ISO_8859-3 ISO_8859-3:1988 L3 LATIN3 CSISOLATIN3';
+  IconvArr[20].Charset := ISO_8859_4;
+  IconvArr[20].Charname := 'ISO-8859-4 ISO-IR-110 ISO8859-4 ISO_8859-4 ISO_8859-4:1988 L4 LATIN4 CSISOLATIN4';
+  IconvArr[21].Charset := ISO_8859_5;
+  IconvArr[21].Charname := 'ISO-8859-5 CYRILLIC ISO-IR-144 ISO8859-5 ISO_8859-5 ISO_8859-5:1988 CSISOLATINCYRILLIC';
+  IconvArr[22].Charset := ISO_8859_6;
+  IconvArr[22].Charname := 'ISO-8859-6 ARABIC ASMO-708 ECMA-114 ISO-IR-127 ISO8859-6 ISO_8859-6 ISO_8859-6:1987 CSISOLATINARABIC';
+  IconvArr[23].Charset := ISO_8859_7;
+  IconvArr[23].Charname := 'ISO-8859-7 ECMA-118 ELOT_928 GREEK GREEK8 ISO-IR-126 ISO8859-7 ISO_8859-7 ISO_8859-7:1987 CSISOLATINGREEK';
+  IconvArr[24].Charset := ISO_8859_8;
+  IconvArr[24].Charname := 'ISO-8859-8 HEBREW ISO_8859-8 ISO-IR-138 ISO8859-8 ISO_8859-8:1988 CSISOLATINHEBREW ISO-8859-8-I';
+  IconvArr[25].Charset := ISO_8859_9;
+  IconvArr[25].Charname := 'ISO-8859-9 ISO-IR-148 ISO8859-9 ISO_8859-9 ISO_8859-9:1989 L5 LATIN5 CSISOLATIN5';
+  IconvArr[26].Charset := ISO_8859_10;
+  IconvArr[26].Charname := 'ISO-8859-10 ISO-IR-157 ISO8859-10 ISO_8859-10 ISO_8859-10:1992 L6 LATIN6 CSISOLATIN6';
+  IconvArr[27].Charset := ISO_8859_13;
+  IconvArr[27].Charname := 'ISO-8859-13 ISO-IR-179 ISO8859-13 ISO_8859-13 L7 LATIN7';
+  IconvArr[28].Charset := ISO_8859_14;
+  IconvArr[28].Charname := 'ISO-8859-14 ISO-CELTIC ISO-IR-199 ISO8859-14 ISO_8859-14 ISO_8859-14:1998 L8 LATIN8';
+  IconvArr[29].Charset := ISO_8859_15;
+  IconvArr[29].Charname := 'ISO-8859-15 ISO-IR-203 ISO8859-15 ISO_8859-15 ISO_8859-15:1998';
+  IconvArr[30].Charset := ISO_8859_16;
+  IconvArr[30].Charname := 'ISO-8859-16 ISO-IR-226 ISO8859-16 ISO_8859-16 ISO_8859-16:2000';
+  IconvArr[31].Charset := KOI8_R;
+  IconvArr[31].Charname := 'KOI8-R CSKOI8R';
+  IconvArr[32].Charset := KOI8_U;
+  IconvArr[32].Charname := 'KOI8-U';
+  IconvArr[33].Charset := KOI8_RU;
+  IconvArr[33].Charname := 'KOI8-RU';
+  IconvArr[34].Charset := CP1250;
+  IconvArr[34].Charname := 'WINDOWS-1250 CP1250 MS-EE';
+  IconvArr[35].Charset := CP1251;
+  IconvArr[35].Charname := 'WINDOWS-1251 CP1251 MS-CYRL';
+  IconvArr[36].Charset := CP1252;
+  IconvArr[36].Charname := 'WINDOWS-1252 CP1252 MS-ANSI';
+  IconvArr[37].Charset := CP1253;
+  IconvArr[37].Charname := 'WINDOWS-1253 CP1253 MS-GREEK';
+  IconvArr[38].Charset := CP1254;
+  IconvArr[38].Charname := 'WINDOWS-1254 CP1254 MS-TURK';
+  IconvArr[39].Charset := CP1255;
+  IconvArr[39].Charname := 'WINDOWS-1255 CP1255 MS-HEBR';
+  IconvArr[40].Charset := CP1256;
+  IconvArr[40].Charname := 'WINDOWS-1256 CP1256 MS-ARAB';
+  IconvArr[41].Charset := CP1257;
+  IconvArr[41].Charname := 'WINDOWS-1257 CP1257 WINBALTRIM';
+  IconvArr[42].Charset := CP1258;
+  IconvArr[42].Charname := 'WINDOWS-1258 CP1258';
+  IconvArr[43].Charset := ISO_8859_1;
+  IconvArr[43].Charname := '850 CP850 IBM850 CSPC850MULTILINGUAL';
+  IconvArr[44].Charset := CP862;
+  IconvArr[44].Charname := '862 CP862 IBM862 CSPC862LATINHEBREW';
+  IconvArr[45].Charset := CP866;
+  IconvArr[45].Charname := '866 CP866 IBM866 CSIBM866';
+  IconvArr[46].Charset := MAC;
+  IconvArr[46].Charname := 'MAC MACINTOSH MACROMAN CSMACINTOSH';
+  IconvArr[47].Charset := MACCE;
+  IconvArr[47].Charname := 'MACCENTRALEUROPE';
+  IconvArr[48].Charset := MACICE;
+  IconvArr[48].Charname := 'MACICELAND';
+  IconvArr[49].Charset := MACCRO;
+  IconvArr[49].Charname := 'MACCROATIAN';
+  IconvArr[50].Charset := MACRO;
+  IconvArr[50].Charname := 'MACROMANIA';
+  IconvArr[51].Charset := MACCYR;
+  IconvArr[51].Charname := 'MACCYRILLIC';
+  IconvArr[52].Charset := MACUK;
+  IconvArr[52].Charname := 'MACUKRAINE';
+  IconvArr[53].Charset := MACGR;
+  IconvArr[53].Charname := 'MACGREEK';
+  IconvArr[54].Charset := MACTU;
+  IconvArr[54].Charname := 'MACTURKISH';
+  IconvArr[55].Charset := MACHEB;
+  IconvArr[55].Charname := 'MACHEBREW';
+  IconvArr[56].Charset := MACAR;
+  IconvArr[56].Charname := 'MACARABIC';
+  IconvArr[57].Charset := MACTH;
+  IconvArr[57].Charname := 'MACTHAI';
+  IconvArr[58].Charset := ROMAN8;
+  IconvArr[58].Charname := 'HP-ROMAN8 R8 ROMAN8 CSHPROMAN8';
+  IconvArr[59].Charset := NEXTSTEP;
+  IconvArr[59].Charname := 'NEXTSTEP';
+  IconvArr[60].Charset := ARMASCII;
+  IconvArr[60].Charname := 'ARMSCII-8';
+  IconvArr[61].Charset := GEORGIAN_AC;
+  IconvArr[61].Charname := 'GEORGIAN-ACADEMY';
+  IconvArr[62].Charset := GEORGIAN_PS;
+  IconvArr[62].Charname := 'GEORGIAN-PS';
+  IconvArr[63].Charset := KOI8_T;
+  IconvArr[63].Charname := 'KOI8-T';
+  IconvArr[64].Charset := MULELAO;
+  IconvArr[64].Charname := 'MULELAO-1';
+  IconvArr[65].Charset := CP1133;
+  IconvArr[65].Charname := 'CP1133 IBM-CP1133';
+  IconvArr[66].Charset := TIS620;
+  IconvArr[66].Charname := 'TIS-620 ISO-IR-166 TIS620 TIS620-0 TIS620.2529-1 TIS620.2533-0 TIS620.2533-1';
+  IconvArr[67].Charset := CP874;
+  IconvArr[67].Charname := 'CP874 WINDOWS-874';
+  IconvArr[68].Charset := VISCII;
+  IconvArr[68].Charname := 'VISCII VISCII1.1-1 CSVISCII';
+  IconvArr[69].Charset := TCVN;
+  IconvArr[69].Charname := 'TCVN TCVN-5712 TCVN5712-1 TCVN5712-1:1993';
+  IconvArr[70].Charset := ISO_IR_14;
+  IconvArr[70].Charname := 'ISO-IR-14 ISO646-JP JIS_C6220-1969-RO JP CSISO14JISC6220RO';
+  IconvArr[71].Charset := JIS_X0201;
+  IconvArr[71].Charname := 'JISX0201-1976 JIS_X0201 X0201 CSHALFWIDTHKATAKANA';
+  IconvArr[72].Charset := JIS_X0208;
+  IconvArr[72].Charname := 'ISO-IR-87 JIS0208 JIS_C6226-1983 JIS_X0208 JIS_X0208-1983 JIS_X0208-1990 X0208 CSISO87JISX0208';
+  IconvArr[73].Charset := JIS_X0212;
+  IconvArr[73].Charname := 'ISO-IR-159 JIS_X0212 JIS_X0212-1990 JIS_X0212.1990-0 X0212 CSISO159JISX02121990';
+  IconvArr[74].Charset := GB1988_80;
+  IconvArr[74].Charname := 'CN GB_1988-80 ISO-IR-57 ISO646-CN CSISO57GB1988';
+  IconvArr[75].Charset := GB2312_80;
+  IconvArr[75].Charname := 'CHINESE GB_2312-80 ISO-IR-58 CSISO58GB231280';
+  IconvArr[76].Charset := ISO_IR_165;
+  IconvArr[76].Charname := 'CN-GB-ISOIR165 ISO-IR-165';
+  IconvArr[77].Charset := ISO_IR_149;
+  IconvArr[77].Charname := 'ISO-IR-149 KOREAN KSC_5601 KS_C_5601-1987 KS_C_5601-1989 CSKSC56011987';
+  IconvArr[78].Charset := EUC_JP;
+  IconvArr[78].Charname := 'EUC-JP EUCJP EXTENDED_UNIX_CODE_PACKED_FORMAT_FOR_JAPANESE CSEUCPKDFMTJAPANESE';
+  IconvArr[79].Charset := SHIFT_JIS;
+  IconvArr[79].Charname := 'SHIFT-JIS MS_KANJI SHIFT_JIS SJIS CSSHIFTJIS';
+  IconvArr[80].Charset := CP932;
+  IconvArr[80].Charname := 'CP932';
+  IconvArr[81].Charset := ISO_2022_JP;
+  IconvArr[81].Charname := 'ISO-2022-JP CSISO2022JP';
+  IconvArr[82].Charset := ISO_2022_JP1;
+  IconvArr[82].Charname := 'ISO-2022-JP-1';
+  IconvArr[83].Charset := ISO_2022_JP2;
+  IconvArr[83].Charname := 'ISO-2022-JP-2 CSISO2022JP2';
+  IconvArr[84].Charset := GB2312;
+  IconvArr[84].Charname := 'CN-GB EUC-CN EUCCN GB2312 CSGB2312';
+  IconvArr[85].Charset := CP936;
+  IconvArr[85].Charname := 'CP936 GBK';
+  IconvArr[86].Charset := GB18030;
+  IconvArr[86].Charname := 'GB18030';
+  IconvArr[87].Charset := ISO_2022_CN;
+  IconvArr[87].Charname := 'ISO-2022-CN CSISO2022CN';
+  IconvArr[88].Charset := ISO_2022_CNE;
+  IconvArr[88].Charname := 'ISO-2022-CN-EXT';
+  IconvArr[89].Charset := HZ;
+  IconvArr[89].Charname := 'HZ HZ-GB-2312';
+  IconvArr[90].Charset := EUC_TW;
+  IconvArr[90].Charname := 'EUC-TW EUCTW CSEUCTW';
+  IconvArr[91].Charset := BIG5;
+  IconvArr[91].Charname := 'BIG5 BIG-5 BIG-FIVE BIGFIVE CN-BIG5 CSBIG5';
+  IconvArr[92].Charset := CP950;
+  IconvArr[92].Charname := 'CP950';
+  IconvArr[93].Charset := BIG5_HKSCS;
+  IconvArr[93].Charname := 'BIG5-HKSCS BIG5HKSCS';
+  IconvArr[94].Charset := EUC_KR;
+  IconvArr[94].Charname := 'EUC-KR EUCKR CSEUCKR';
+  IconvArr[95].Charset := CP949;
+  IconvArr[95].Charname := 'CP949 UHC';
+  IconvArr[96].Charset := CP1361;
+  IconvArr[96].Charname := 'CP1361 JOHAB';
+  IconvArr[97].Charset := ISO_2022_KR;
+  IconvArr[97].Charname := 'ISO-2022-KR CSISO2022KR';
+  IconvArr[98].Charset := ISO_8859_1;
+  IconvArr[98].Charname := '437 CP437 IBM437 CSPC8CODEPAGE437';
+  IconvArr[99].Charset := CP737;
+  IconvArr[99].Charname := 'CP737';
+  IconvArr[100].Charset := CP775;
+  IconvArr[100].Charname := 'CP775 IBM775 CSPC775BALTIC';
+  IconvArr[101].Charset := CP852;
+  IconvArr[101].Charname := '852 CP852 IBM852 CSPCP852';
+  IconvArr[102].Charset := CP853;
+  IconvArr[102].Charname := 'CP853';
+  IconvArr[103].Charset := CP855;
+  IconvArr[103].Charname := '855 CP855 IBM855 CSIBM855';
+  IconvArr[104].Charset := CP857;
+  IconvArr[104].Charname := '857 CP857 IBM857 CSIBM857';
+  IconvArr[105].Charset := CP858;
+  IconvArr[105].Charname := 'CP858';
+  IconvArr[106].Charset := CP860;
+  IconvArr[106].Charname := '860 CP860 IBM860 CSIBM860';
+  IconvArr[107].Charset := CP861;
+  IconvArr[107].Charname := '861 CP-IS CP861 IBM861 CSIBM861';
+  IconvArr[108].Charset := CP863;
+  IconvArr[108].Charname := '863 CP863 IBM863 CSIBM863';
+  IconvArr[109].Charset := CP864;
+  IconvArr[109].Charname := 'CP864 IBM864 CSIBM864';
+  IconvArr[110].Charset := CP865;
+  IconvArr[110].Charname := '865 CP865 IBM865 CSIBM865';
+  IconvArr[111].Charset := CP869;
+  IconvArr[111].Charname := '869 CP-GR CP869 IBM869 CSIBM869';
+  IconvArr[112].Charset := CP1125;
+  IconvArr[112].Charname := 'CP1125';
+end;
+
+end.
diff --git a/Units/Synapse/synacode.pas b/Units/Synapse/synacode.pas
index 18c9040..953fd38 100644
--- a/Units/Synapse/synacode.pas
+++ b/Units/Synapse/synacode.pas
@@ -1,1460 +1,1460 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 002.002.001 |
-|==============================================================================|
-| Content: Coding and decoding support                                         |
-|==============================================================================|
-| Copyright (c)1999-2010, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2000-2010.                |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{:@abstract(Various encoding and decoding support)}
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$Q-}
-{$R-}
-{$H+}
-
-{$IFDEF UNICODE}
-  {$WARN IMPLICIT_STRING_CAST OFF}
-  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
-  {$WARN SUSPICIOUS_TYPECAST OFF}
-{$ENDIF}
-
-unit synacode;
-
-interface
-
-uses
-  SysUtils;
-
-type
-  TSpecials = set of AnsiChar;
-
-const
-
-  SpecialChar: TSpecials =
-  ['=', '(', ')', '[', ']', '<', '>', ':', ';', ',', '@', '/', '?', '\',
-    '"', '_'];
-  NonAsciiChar: TSpecials =
-  [#0..#31, #127..#255];
-  URLFullSpecialChar: TSpecials =
-  [';', '/', '?', ':', '@', '=', '&', '#', '+'];
-  URLSpecialChar: TSpecials =
-  [#$00..#$20, '_', '<', '>', '"', '%', '{', '}', '|', '\', '^', '~', '[', ']',
-    '`', #$7F..#$FF];
-  TableBase64 =
-    'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';
-  TableBase64mod =
-    'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+,=';
-  TableUU =
-    '`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
-  TableXX =
-    '+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
-  ReTablebase64 =
-    #$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$3E +#$40
-    +#$40 +#$40 +#$3F +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C
-    +#$3D +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$01 +#$02 +#$03
-    +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C +#$0D +#$0E +#$0F
-    +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$40 +#$40
-    +#$40 +#$40 +#$40 +#$40 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21
-    +#$22 +#$23 +#$24 +#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D
-    +#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
-  ReTableUU =
-    #$01 +#$02 +#$03 +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C
-    +#$0D +#$0E +#$0F +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18
-    +#$19 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21 +#$22 +#$23 +#$24
-    +#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D +#$2E +#$2F +#$30
-    +#$31 +#$32 +#$33 +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C
-    +#$3D +#$3E +#$3F +#$00 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40
-    +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40
-    +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
-  ReTableXX =
-    #$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$40
-    +#$01 +#$40 +#$40 +#$02 +#$03 +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A
-    +#$0B +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$0C +#$0D +#$0E +#$0F
-    +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$1A +#$1B
-    +#$1C +#$1D +#$1E +#$1F +#$20 +#$21 +#$22 +#$23 +#$24 +#$25 +#$40 +#$40
-    +#$40 +#$40 +#$40 +#$40 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D
-    +#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$34 +#$35 +#$36 +#$37 +#$38 +#$39
-    +#$3A +#$3B +#$3C +#$3D +#$3E +#$3F +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
-
-{:Decodes triplet encoding with a given character delimiter. It is used for
- decoding quoted-printable or URL encoding.}
-function DecodeTriplet(const Value: AnsiString; Delimiter: AnsiChar): AnsiString;
-
-{:Decodes a string from quoted printable form. (also decodes triplet sequences
- like '=7F')}
-function DecodeQuotedPrintable(const Value: AnsiString): AnsiString;
-
-{:Decodes a string of URL encoding. (also decodes triplet sequences like '%7F')}
-function DecodeURL(const Value: AnsiString): AnsiString;
-
-{:Performs triplet encoding with a given character delimiter. Used for encoding
- quoted-printable or URL encoding.}
-function EncodeTriplet(const Value: AnsiString; Delimiter: AnsiChar;
-  Specials: TSpecials): AnsiString;
-
-{:Encodes a string to triplet quoted printable form. All @link(NonAsciiChar)
- are encoded.}
-function EncodeQuotedPrintable(const Value: AnsiString): AnsiString;
-
-{:Encodes a string to triplet quoted printable form. All @link(NonAsciiChar) and
- @link(SpecialChar) are encoded.}
-function EncodeSafeQuotedPrintable(const Value: AnsiString): AnsiString;
-
-{:Encodes a string to URL format. Used for encoding data from a form field in
- HTTP, etc. (Encodes all critical characters including characters used as URL
- delimiters ('/',':', etc.)}
-function EncodeURLElement(const Value: AnsiString): AnsiString;
-
-{:Encodes a string to URL format. Used to encode critical characters in all
- URLs.}
-function EncodeURL(const Value: AnsiString): AnsiString;
-
-{:Decode 4to3 encoding with given table. If some element is not found in table,
- first item from table is used. This is good for buggy coded items by Microsoft
- Outlook. This software sometimes using wrong table for UUcode, where is used
- ' ' instead '`'.}
-function Decode4to3(const Value, Table: AnsiString): AnsiString;
-
-{:Decode 4to3 encoding with given REVERSE table. Using this function with
-reverse table is much faster then @link(Decode4to3). This function is used
-internally for Base64, UU or XX decoding.}
-function Decode4to3Ex(const Value, Table: AnsiString): AnsiString;
-
-{:Encode by system 3to4 (used by Base64, UU coding, etc) by given table.}
-function Encode3to4(const Value, Table: AnsiString): AnsiString;
-
-{:Decode string from base64 format.}
-function DecodeBase64(const Value: AnsiString): AnsiString;
-
-{:Encodes a string to base64 format.}
-function EncodeBase64(const Value: AnsiString): AnsiString;
-
-{:Decode string from modified base64 format. (used in IMAP, for example.)}
-function DecodeBase64mod(const Value: AnsiString): AnsiString;
-
-{:Encodes a string to  modified base64 format. (used in IMAP, for example.)}
-function EncodeBase64mod(const Value: AnsiString): AnsiString;
-
-{:Decodes a string from UUcode format.}
-function DecodeUU(const Value: AnsiString): AnsiString;
-
-{:encode UUcode. it encode only datas, you must also add header and footer for
- proper encode.}
-function EncodeUU(const Value: AnsiString): AnsiString;
-
-{:Decodes a string from XXcode format.}
-function DecodeXX(const Value: AnsiString): AnsiString;
-
-{:decode line with Yenc code. This code is sometimes used in newsgroups.}
-function DecodeYEnc(const Value: AnsiString): AnsiString;
-
-{:Returns a new CRC32 value after adding a new byte of data.}
-function UpdateCrc32(Value: Byte; Crc32: Integer): Integer;
-
-{:return CRC32 from a value string.}
-function Crc32(const Value: AnsiString): Integer;
-
-{:Returns a new CRC16 value after adding a new byte of data.}
-function UpdateCrc16(Value: Byte; Crc16: Word): Word;
-
-{:return CRC16 from a value string.}
-function Crc16(const Value: AnsiString): Word;
-
-{:Returns a binary string with a RSA-MD5 hashing of "Value" string.}
-function MD5(const Value: AnsiString): AnsiString;
-
-{:Returns a binary string with HMAC-MD5 hash.}
-function HMAC_MD5(Text, Key: AnsiString): AnsiString;
-
-{:Returns a binary string with a RSA-MD5 hashing of string what is constructed
- by repeating "value" until length is "Len".}
-function MD5LongHash(const Value: AnsiString; Len: integer): AnsiString;
-
-{:Returns a binary string with a SHA-1 hashing of "Value" string.}
-function SHA1(const Value: AnsiString): AnsiString;
-
-{:Returns a binary string with HMAC-SHA1 hash.}
-function HMAC_SHA1(Text, Key: AnsiString): AnsiString;
-
-{:Returns a binary string with a SHA-1 hashing of string what is constructed
- by repeating "value" until length is "Len".}
-function SHA1LongHash(const Value: AnsiString; Len: integer): AnsiString;
-
-{:Returns a binary string with a RSA-MD4 hashing of "Value" string.}
-function MD4(const Value: AnsiString): AnsiString;
-
-implementation
-
-const
-
-  Crc32Tab: array[0..255] of Integer = (
-    Integer($00000000), Integer($77073096), Integer($EE0E612C), Integer($990951BA),
-    Integer($076DC419), Integer($706AF48F), Integer($E963A535), Integer($9E6495A3),
-    Integer($0EDB8832), Integer($79DCB8A4), Integer($E0D5E91E), Integer($97D2D988),
-    Integer($09B64C2B), Integer($7EB17CBD), Integer($E7B82D07), Integer($90BF1D91),
-    Integer($1DB71064), Integer($6AB020F2), Integer($F3B97148), Integer($84BE41DE),
-    Integer($1ADAD47D), Integer($6DDDE4EB), Integer($F4D4B551), Integer($83D385C7),
-    Integer($136C9856), Integer($646BA8C0), Integer($FD62F97A), Integer($8A65C9EC),
-    Integer($14015C4F), Integer($63066CD9), Integer($FA0F3D63), Integer($8D080DF5),
-    Integer($3B6E20C8), Integer($4C69105E), Integer($D56041E4), Integer($A2677172),
-    Integer($3C03E4D1), Integer($4B04D447), Integer($D20D85FD), Integer($A50AB56B),
-    Integer($35B5A8FA), Integer($42B2986C), Integer($DBBBC9D6), Integer($ACBCF940),
-    Integer($32D86CE3), Integer($45DF5C75), Integer($DCD60DCF), Integer($ABD13D59),
-    Integer($26D930AC), Integer($51DE003A), Integer($C8D75180), Integer($BFD06116),
-    Integer($21B4F4B5), Integer($56B3C423), Integer($CFBA9599), Integer($B8BDA50F),
-    Integer($2802B89E), Integer($5F058808), Integer($C60CD9B2), Integer($B10BE924),
-    Integer($2F6F7C87), Integer($58684C11), Integer($C1611DAB), Integer($B6662D3D),
-    Integer($76DC4190), Integer($01DB7106), Integer($98D220BC), Integer($EFD5102A),
-    Integer($71B18589), Integer($06B6B51F), Integer($9FBFE4A5), Integer($E8B8D433),
-    Integer($7807C9A2), Integer($0F00F934), Integer($9609A88E), Integer($E10E9818),
-    Integer($7F6A0DBB), Integer($086D3D2D), Integer($91646C97), Integer($E6635C01),
-    Integer($6B6B51F4), Integer($1C6C6162), Integer($856530D8), Integer($F262004E),
-    Integer($6C0695ED), Integer($1B01A57B), Integer($8208F4C1), Integer($F50FC457),
-    Integer($65B0D9C6), Integer($12B7E950), Integer($8BBEB8EA), Integer($FCB9887C),
-    Integer($62DD1DDF), Integer($15DA2D49), Integer($8CD37CF3), Integer($FBD44C65),
-    Integer($4DB26158), Integer($3AB551CE), Integer($A3BC0074), Integer($D4BB30E2),
-    Integer($4ADFA541), Integer($3DD895D7), Integer($A4D1C46D), Integer($D3D6F4FB),
-    Integer($4369E96A), Integer($346ED9FC), Integer($AD678846), Integer($DA60B8D0),
-    Integer($44042D73), Integer($33031DE5), Integer($AA0A4C5F), Integer($DD0D7CC9),
-    Integer($5005713C), Integer($270241AA), Integer($BE0B1010), Integer($C90C2086),
-    Integer($5768B525), Integer($206F85B3), Integer($B966D409), Integer($CE61E49F),
-    Integer($5EDEF90E), Integer($29D9C998), Integer($B0D09822), Integer($C7D7A8B4),
-    Integer($59B33D17), Integer($2EB40D81), Integer($B7BD5C3B), Integer($C0BA6CAD),
-    Integer($EDB88320), Integer($9ABFB3B6), Integer($03B6E20C), Integer($74B1D29A),
-    Integer($EAD54739), Integer($9DD277AF), Integer($04DB2615), Integer($73DC1683),
-    Integer($E3630B12), Integer($94643B84), Integer($0D6D6A3E), Integer($7A6A5AA8),
-    Integer($E40ECF0B), Integer($9309FF9D), Integer($0A00AE27), Integer($7D079EB1),
-    Integer($F00F9344), Integer($8708A3D2), Integer($1E01F268), Integer($6906C2FE),
-    Integer($F762575D), Integer($806567CB), Integer($196C3671), Integer($6E6B06E7),
-    Integer($FED41B76), Integer($89D32BE0), Integer($10DA7A5A), Integer($67DD4ACC),
-    Integer($F9B9DF6F), Integer($8EBEEFF9), Integer($17B7BE43), Integer($60B08ED5),
-    Integer($D6D6A3E8), Integer($A1D1937E), Integer($38D8C2C4), Integer($4FDFF252),
-    Integer($D1BB67F1), Integer($A6BC5767), Integer($3FB506DD), Integer($48B2364B),
-    Integer($D80D2BDA), Integer($AF0A1B4C), Integer($36034AF6), Integer($41047A60),
-    Integer($DF60EFC3), Integer($A867DF55), Integer($316E8EEF), Integer($4669BE79),
-    Integer($CB61B38C), Integer($BC66831A), Integer($256FD2A0), Integer($5268E236),
-    Integer($CC0C7795), Integer($BB0B4703), Integer($220216B9), Integer($5505262F),
-    Integer($C5BA3BBE), Integer($B2BD0B28), Integer($2BB45A92), Integer($5CB36A04),
-    Integer($C2D7FFA7), Integer($B5D0CF31), Integer($2CD99E8B), Integer($5BDEAE1D),
-    Integer($9B64C2B0), Integer($EC63F226), Integer($756AA39C), Integer($026D930A),
-    Integer($9C0906A9), Integer($EB0E363F), Integer($72076785), Integer($05005713),
-    Integer($95BF4A82), Integer($E2B87A14), Integer($7BB12BAE), Integer($0CB61B38),
-    Integer($92D28E9B), Integer($E5D5BE0D), Integer($7CDCEFB7), Integer($0BDBDF21),
-    Integer($86D3D2D4), Integer($F1D4E242), Integer($68DDB3F8), Integer($1FDA836E),
-    Integer($81BE16CD), Integer($F6B9265B), Integer($6FB077E1), Integer($18B74777),
-    Integer($88085AE6), Integer($FF0F6A70), Integer($66063BCA), Integer($11010B5C),
-    Integer($8F659EFF), Integer($F862AE69), Integer($616BFFD3), Integer($166CCF45),
-    Integer($A00AE278), Integer($D70DD2EE), Integer($4E048354), Integer($3903B3C2),
-    Integer($A7672661), Integer($D06016F7), Integer($4969474D), Integer($3E6E77DB),
-    Integer($AED16A4A), Integer($D9D65ADC), Integer($40DF0B66), Integer($37D83BF0),
-    Integer($A9BCAE53), Integer($DEBB9EC5), Integer($47B2CF7F), Integer($30B5FFE9),
-    Integer($BDBDF21C), Integer($CABAC28A), Integer($53B39330), Integer($24B4A3A6),
-    Integer($BAD03605), Integer($CDD70693), Integer($54DE5729), Integer($23D967BF),
-    Integer($B3667A2E), Integer($C4614AB8), Integer($5D681B02), Integer($2A6F2B94),
-    Integer($B40BBE37), Integer($C30C8EA1), Integer($5A05DF1B), Integer($2D02EF8D)
-    );
-
-  Crc16Tab: array[0..255] of Word = (
-    $0000, $1189, $2312, $329B, $4624, $57AD, $6536, $74BF,
-    $8C48, $9DC1, $AF5A, $BED3, $CA6C, $DBE5, $E97E, $F8F7,
-    $1081, $0108, $3393, $221A, $56A5, $472C, $75B7, $643E,
-    $9CC9, $8D40, $BFDB, $AE52, $DAED, $CB64, $F9FF, $E876,
-    $2102, $308B, $0210, $1399, $6726, $76AF, $4434, $55BD,
-    $AD4A, $BCC3, $8E58, $9FD1, $EB6E, $FAE7, $C87C, $D9F5,
-    $3183, $200A, $1291, $0318, $77A7, $662E, $54B5, $453C,
-    $BDCB, $AC42, $9ED9, $8F50, $FBEF, $EA66, $D8FD, $C974,
-    $4204, $538D, $6116, $709F, $0420, $15A9, $2732, $36BB,
-    $CE4C, $DFC5, $ED5E, $FCD7, $8868, $99E1, $AB7A, $BAF3,
-    $5285, $430C, $7197, $601E, $14A1, $0528, $37B3, $263A,
-    $DECD, $CF44, $FDDF, $EC56, $98E9, $8960, $BBFB, $AA72,
-    $6306, $728F, $4014, $519D, $2522, $34AB, $0630, $17B9,
-    $EF4E, $FEC7, $CC5C, $DDD5, $A96A, $B8E3, $8A78, $9BF1,
-    $7387, $620E, $5095, $411C, $35A3, $242A, $16B1, $0738,
-    $FFCF, $EE46, $DCDD, $CD54, $B9EB, $A862, $9AF9, $8B70,
-    $8408, $9581, $A71A, $B693, $C22C, $D3A5, $E13E, $F0B7,
-    $0840, $19C9, $2B52, $3ADB, $4E64, $5FED, $6D76, $7CFF,
-    $9489, $8500, $B79B, $A612, $D2AD, $C324, $F1BF, $E036,
-    $18C1, $0948, $3BD3, $2A5A, $5EE5, $4F6C, $7DF7, $6C7E,
-    $A50A, $B483, $8618, $9791, $E32E, $F2A7, $C03C, $D1B5,
-    $2942, $38CB, $0A50, $1BD9, $6F66, $7EEF, $4C74, $5DFD,
-    $B58B, $A402, $9699, $8710, $F3AF, $E226, $D0BD, $C134,
-    $39C3, $284A, $1AD1, $0B58, $7FE7, $6E6E, $5CF5, $4D7C,
-    $C60C, $D785, $E51E, $F497, $8028, $91A1, $A33A, $B2B3,
-    $4A44, $5BCD, $6956, $78DF, $0C60, $1DE9, $2F72, $3EFB,
-    $D68D, $C704, $F59F, $E416, $90A9, $8120, $B3BB, $A232,
-    $5AC5, $4B4C, $79D7, $685E, $1CE1, $0D68, $3FF3, $2E7A,
-    $E70E, $F687, $C41C, $D595, $A12A, $B0A3, $8238, $93B1,
-    $6B46, $7ACF, $4854, $59DD, $2D62, $3CEB, $0E70, $1FF9,
-    $F78F, $E606, $D49D, $C514, $B1AB, $A022, $92B9, $8330,
-    $7BC7, $6A4E, $58D5, $495C, $3DE3, $2C6A, $1EF1, $0F78
-    );
-
-procedure ArrByteToLong(var ArByte: Array of byte; var ArLong: Array of Integer);
-{$IFDEF CIL}
-var
-  n: integer;
-{$ENDIF}
-begin
-  if (High(ArByte) + 1) > ((High(ArLong) + 1) * 4) then
-    Exit;
-  {$IFDEF CIL}
-  for n := 0 to ((high(ArByte) + 1) div 4) - 1 do
-    ArLong[n] := ArByte[n * 4 + 0]
-      + (ArByte[n * 4 + 1] shl 8)
-      + (ArByte[n * 4 + 2] shl 16)
-      + (ArByte[n * 4 + 3] shl 24);
-  {$ELSE}
-  Move(ArByte[0], ArLong[0], High(ArByte) + 1);
-  {$ENDIF}
-end;
-
-procedure ArrLongToByte(var ArLong: Array of Integer; var ArByte: Array of byte);
-{$IFDEF CIL}
-var
-  n: integer;
-{$ENDIF}
-begin
-  if (High(ArByte) + 1) < ((High(ArLong) + 1) * 4) then
-    Exit;
-  {$IFDEF CIL}
-  for n := 0 to high(ArLong) do
-  begin
-    ArByte[n * 4 + 0] := ArLong[n] and $000000FF;
-    ArByte[n * 4 + 1] := (ArLong[n] shr 8) and $000000FF;
-    ArByte[n * 4 + 2] := (ArLong[n] shr 16) and $000000FF;
-    ArByte[n * 4 + 3] := (ArLong[n] shr 24) and $000000FF;
-  end;
-  {$ELSE}
-  Move(ArLong[0], ArByte[0], High(ArByte) + 1);
-  {$ENDIF}
-end;
-
-type
-  TMDCtx = record
-    State: array[0..3] of Integer;
-    Count: array[0..1] of Integer;
-    BufAnsiChar: array[0..63] of Byte;
-    BufLong: array[0..15] of Integer;
-  end;
-  TSHA1Ctx= record
-    Hi, Lo: integer;
-    Buffer: array[0..63] of byte;
-    Index: integer;
-    Hash: array[0..4] of Integer;
-    HashByte: array[0..19] of byte;
-  end;
-
-  TMDTransform = procedure(var Buf: array of LongInt; const Data: array of LongInt);
-
-{==============================================================================}
-
-function DecodeTriplet(const Value: AnsiString; Delimiter: AnsiChar): AnsiString;
-var
-  x, l, lv: Integer;
-  c: AnsiChar;
-  b: Byte;
-  bad: Boolean;
-begin
-  lv := Length(Value);
-  SetLength(Result, lv);
-  x := 1;
-  l := 1;
-  while x <= lv do
-  begin
-    c := Value[x];
-    Inc(x);
-    if c <> Delimiter then
-    begin
-      Result[l] := c;
-      Inc(l);
-    end
-    else
-      if x < lv then
-      begin
-        Case Value[x] Of
-          #13:
-            if (Value[x + 1] = #10) then
-              Inc(x, 2)
-            else
-              Inc(x);
-          #10:
-            if (Value[x + 1] = #13) then
-              Inc(x, 2)
-            else
-              Inc(x);
-        else
-          begin
-            bad := False;
-            Case Value[x] Of
-              '0'..'9': b := (Byte(Value[x]) - 48) Shl 4;
-              'a'..'f', 'A'..'F': b := ((Byte(Value[x]) And 7) + 9) shl 4;
-            else
-              begin
-                b := 0;
-                bad := True;
-              end;
-            end;
-            Case Value[x + 1] Of
-              '0'..'9': b := b Or (Byte(Value[x + 1]) - 48);
-              'a'..'f', 'A'..'F': b := b Or ((Byte(Value[x + 1]) And 7) + 9);
-            else
-              bad := True;
-            end;
-            if bad then
-            begin
-              Result[l] := c;
-              Inc(l);
-            end
-            else
-            begin
-              Inc(x, 2);
-              Result[l] := AnsiChar(b);
-              Inc(l);
-            end;
-          end;
-        end;
-      end
-      else
-        break;
-  end;
-  Dec(l);
-  SetLength(Result, l);
-end;
-
-{==============================================================================}
-
-function DecodeQuotedPrintable(const Value: AnsiString): AnsiString;
-begin
-  Result := DecodeTriplet(Value, '=');
-end;
-
-{==============================================================================}
-
-function DecodeURL(const Value: AnsiString): AnsiString;
-begin
-  Result := DecodeTriplet(Value, '%');
-end;
-
-{==============================================================================}
-
-function EncodeTriplet(const Value: AnsiString; Delimiter: AnsiChar;
-  Specials: TSpecials): AnsiString;
-var
-  n, l: Integer;
-  s: AnsiString;
-  c: AnsiChar;
-begin
-  SetLength(Result, Length(Value) * 3);
-  l := 1;
-  for n := 1 to Length(Value) do
-  begin
-    c := Value[n];
-    if c in Specials then
-    begin
-      Result[l] := Delimiter;
-      Inc(l);
-      s := IntToHex(Ord(c), 2);
-      Result[l] := s[1];
-      Inc(l);
-      Result[l] := s[2];
-      Inc(l);
-    end
-    else
-    begin
-      Result[l] := c;
-      Inc(l);
-    end;
-  end;
-  Dec(l);
-  SetLength(Result, l);
-end;
-
-{==============================================================================}
-
-function EncodeQuotedPrintable(const Value: AnsiString): AnsiString;
-begin
-  Result := EncodeTriplet(Value, '=',  ['='] + NonAsciiChar);
-end;
-
-{==============================================================================}
-
-function EncodeSafeQuotedPrintable(const Value: AnsiString): AnsiString;
-begin
-  Result := EncodeTriplet(Value, '=', SpecialChar + NonAsciiChar);
-end;
-
-{==============================================================================}
-
-function EncodeURLElement(const Value: AnsiString): AnsiString;
-begin
-  Result := EncodeTriplet(Value, '%', URLSpecialChar + URLFullSpecialChar);
-end;
-
-{==============================================================================}
-
-function EncodeURL(const Value: AnsiString): AnsiString;
-begin
-  Result := EncodeTriplet(Value, '%', URLSpecialChar);
-end;
-
-{==============================================================================}
-
-function Decode4to3(const Value, Table: AnsiString): AnsiString;
-var
-  x, y, n, l: Integer;
-  d: array[0..3] of Byte;
-begin
-  SetLength(Result, Length(Value));
-  x := 1;
-  l := 1;
-  while x <= Length(Value) do
-  begin
-    for n := 0 to 3 do
-    begin
-      if x > Length(Value) then
-        d[n] := 64
-      else
-      begin
-        y := Pos(Value[x], Table);
-        if y < 1 then
-          y := 1;
-        d[n] := y - 1;
-      end;
-      Inc(x);
-    end;
-    Result[l] := AnsiChar((D[0] and $3F) shl 2 + (D[1] and $30) shr 4);
-    Inc(l);
-    if d[2] <> 64 then
-    begin
-      Result[l] := AnsiChar((D[1] and $0F) shl 4 + (D[2] and $3C) shr 2);
-      Inc(l);
-      if d[3] <> 64 then
-      begin
-        Result[l] := AnsiChar((D[2] and $03) shl 6 + (D[3] and $3F));
-        Inc(l);
-      end;
-    end;
-  end;
-  Dec(l);
-  SetLength(Result, l);
-end;
-
-{==============================================================================}
-function Decode4to3Ex(const Value, Table: AnsiString): AnsiString;
-var
-  x, y, lv: Integer;
-  d: integer;
-  dl: integer;
-  c: byte;
-  p: integer;
-begin
-  lv := Length(Value);
-  SetLength(Result, lv);
-  x := 1;
-  dl := 4;
-  d := 0;
-  p := 1;
-  while x <= lv do
-  begin
-    y := Ord(Value[x]);
-    if y in [33..127] then
-      c := Ord(Table[y - 32])
-    else
-      c := 64;
-    Inc(x);
-    if c > 63 then
-      continue;
-    d := (d shl 6) or c;
-    dec(dl);
-    if dl <> 0 then
-      continue;
-    Result[p] := AnsiChar((d shr 16) and $ff);
-    inc(p);
-    Result[p] := AnsiChar((d shr 8) and $ff);
-    inc(p);
-    Result[p] := AnsiChar(d and $ff);
-    inc(p);
-    d := 0;
-    dl := 4;
-  end;
-  case dl of
-    1:
-      begin
-        d := d shr 2;
-        Result[p] := AnsiChar((d shr 8) and $ff);
-        inc(p);
-        Result[p] := AnsiChar(d and $ff);
-        inc(p);
-      end;
-    2:
-      begin
-        d := d shr 4;
-        Result[p] := AnsiChar(d and $ff);
-        inc(p);
-      end;
-  end;
-  SetLength(Result, p - 1);
-end;
-
-{==============================================================================}
-
-function Encode3to4(const Value, Table: AnsiString): AnsiString;
-var
-  c: Byte;
-  n, l: Integer;
-  Count: Integer;
-  DOut: array[0..3] of Byte;
-begin
-  setlength(Result, ((Length(Value) + 2) div 3) * 4);
-  l := 1;
-  Count := 1;
-  while Count <= Length(Value) do
-  begin
-    c := Ord(Value[Count]);
-    Inc(Count);
-    DOut[0] := (c and $FC) shr 2;
-    DOut[1] := (c and $03) shl 4;
-    if Count <= Length(Value) then
-    begin
-      c := Ord(Value[Count]);
-      Inc(Count);
-      DOut[1] := DOut[1] + (c and $F0) shr 4;
-      DOut[2] := (c and $0F) shl 2;
-      if Count <= Length(Value) then
-      begin
-        c := Ord(Value[Count]);
-        Inc(Count);
-        DOut[2] := DOut[2] + (c and $C0) shr 6;
-        DOut[3] := (c and $3F);
-      end
-      else
-      begin
-        DOut[3] := $40;
-      end;
-    end
-    else
-    begin
-      DOut[2] := $40;
-      DOut[3] := $40;
-    end;
-    for n := 0 to 3 do
-    begin
-      if (DOut[n] + 1) <= Length(Table) then
-      begin
-        Result[l] := Table[DOut[n] + 1];
-        Inc(l);
-      end;
-    end;
-  end;
-  SetLength(Result, l - 1);
-end;
-
-{==============================================================================}
-
-function DecodeBase64(const Value: AnsiString): AnsiString;
-begin
-  Result := Decode4to3Ex(Value, ReTableBase64);
-end;
-
-{==============================================================================}
-
-function EncodeBase64(const Value: AnsiString): AnsiString;
-begin
-  Result := Encode3to4(Value, TableBase64);
-end;
-
-{==============================================================================}
-
-function DecodeBase64mod(const Value: AnsiString): AnsiString;
-begin
-  Result := Decode4to3(Value, TableBase64mod);
-end;
-
-{==============================================================================}
-
-function EncodeBase64mod(const Value: AnsiString): AnsiString;
-begin
-  Result := Encode3to4(Value, TableBase64mod);
-end;
-
-{==============================================================================}
-
-function DecodeUU(const Value: AnsiString): AnsiString;
-var
-  s: AnsiString;
-  uut: AnsiString;
-  x: Integer;
-begin
-  Result := '';
-  uut := TableUU;
-  s := trim(UpperCase(Value));
-  if s = '' then Exit;
-  if Pos('BEGIN', s) = 1 then
-    Exit;
-  if Pos('END', s) = 1 then
-    Exit;
-  if Pos('TABLE', s) = 1 then
-    Exit; //ignore Table yet (set custom UUT)
-  //begin decoding
-  x := Pos(Value[1], uut) - 1;
-  case (x mod 3) of
-    0: x :=(x div 3)* 4;
-    1: x :=((x div 3) * 4) + 2;
-    2: x :=((x  div 3) * 4) + 3;
-  end;
-  //x - lenght UU line
-  s := Copy(Value, 2, x);
-  if s = '' then
-    Exit;
-  s := s + StringOfChar(' ', x - length(s));
-  Result := Decode4to3(s, uut);
-end;
-
-{==============================================================================}
-
-function EncodeUU(const Value: AnsiString): AnsiString;
-begin
-  Result := '';
-  if Length(Value) < Length(TableUU) then
-    Result := TableUU[Length(Value) + 1] + Encode3to4(Value, TableUU);
-end;
-
-{==============================================================================}
-
-function DecodeXX(const Value: AnsiString): AnsiString;
-var
-  s: AnsiString;
-  x: Integer;
-begin
-  Result := '';
-  s := trim(UpperCase(Value));
-  if s = '' then
-    Exit;
-  if Pos('BEGIN', s) = 1 then
-    Exit;
-  if Pos('END', s) = 1 then
-    Exit;
-  //begin decoding
-  x := Pos(Value[1], TableXX) - 1;
-  case (x mod 3) of
-    0: x :=(x div 3)* 4;
-    1: x :=((x div 3) * 4) + 2;
-    2: x :=((x  div 3) * 4) + 3;
-  end;
-  //x - lenght XX line
-  s := Copy(Value, 2, x);
-  if s = '' then
-    Exit;
-  s := s + StringOfChar(' ', x - length(s));
-  Result := Decode4to3(s, TableXX);
-end;
-
-{==============================================================================}
-
-function DecodeYEnc(const Value: AnsiString): AnsiString;
-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 + AnsiChar(C);
-  end;
-end;
-
-{==============================================================================}
-
-function UpdateCrc32(Value: Byte; Crc32: Integer): Integer;
-begin
-  Result := (Crc32 shr 8)
-    xor crc32tab[Byte(Value xor (Crc32 and Integer($000000FF)))];
-end;
-
-{==============================================================================}
-
-function Crc32(const Value: AnsiString): Integer;
-var
-  n: Integer;
-begin
-  Result := Integer($FFFFFFFF);
-  for n := 1 to Length(Value) do
-    Result := UpdateCrc32(Ord(Value[n]), Result);
-  Result := not Result;
-end;
-
-{==============================================================================}
-
-function UpdateCrc16(Value: Byte; Crc16: Word): Word;
-begin
-  Result := ((Crc16 shr 8) and $00FF) xor
-    crc16tab[Byte(Crc16 xor (Word(Value)) and $00FF)];
-end;
-
-{==============================================================================}
-
-function Crc16(const Value: AnsiString): Word;
-var
-  n: Integer;
-begin
-  Result := $FFFF;
-  for n := 1 to Length(Value) do
-    Result := UpdateCrc16(Ord(Value[n]), Result);
-end;
-
-{==============================================================================}
-
-procedure MDInit(var MDContext: TMDCtx);
-var
-  n: integer;
-begin
-  MDContext.Count[0] := 0;
-  MDContext.Count[1] := 0;
-  for n := 0 to high(MDContext.BufAnsiChar) do
-    MDContext.BufAnsiChar[n] := 0;
-  for n := 0 to high(MDContext.BufLong) do
-    MDContext.BufLong[n] := 0;
-  MDContext.State[0] := Integer($67452301);
-  MDContext.State[1] := Integer($EFCDAB89);
-  MDContext.State[2] := Integer($98BADCFE);
-  MDContext.State[3] := Integer($10325476);
-end;
-
-procedure MD5Transform(var Buf: array of LongInt; const Data: array of LongInt);
-var
-  A, B, C, D: LongInt;
-
-  procedure Round1(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
-  begin
-    Inc(W, (Z xor (X and (Y xor Z))) + Data);
-    W := (W shl S) or (W shr (32 - S));
-    Inc(W, X);
-  end;
-
-  procedure Round2(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
-  begin
-    Inc(W, (Y xor (Z and (X xor Y))) + Data);
-    W := (W shl S) or (W shr (32 - S));
-    Inc(W, X);
-  end;
-
-  procedure Round3(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
-  begin
-    Inc(W, (X xor Y xor Z) + Data);
-    W := (W shl S) or (W shr (32 - S));
-    Inc(W, X);
-  end;
-
-  procedure Round4(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
-  begin
-    Inc(W, (Y xor (X or not Z)) + Data);
-    W := (W shl S) or (W shr (32 - S));
-    Inc(W, X);
-  end;
-begin
-  A := Buf[0];
-  B := Buf[1];
-  C := Buf[2];
-  D := Buf[3];
-
-  Round1(A, B, C, D, Data[0] + Longint($D76AA478), 7);
-  Round1(D, A, B, C, Data[1] + Longint($E8C7B756), 12);
-  Round1(C, D, A, B, Data[2] + Longint($242070DB), 17);
-  Round1(B, C, D, A, Data[3] + Longint($C1BDCEEE), 22);
-  Round1(A, B, C, D, Data[4] + Longint($F57C0FAF), 7);
-  Round1(D, A, B, C, Data[5] + Longint($4787C62A), 12);
-  Round1(C, D, A, B, Data[6] + Longint($A8304613), 17);
-  Round1(B, C, D, A, Data[7] + Longint($FD469501), 22);
-  Round1(A, B, C, D, Data[8] + Longint($698098D8), 7);
-  Round1(D, A, B, C, Data[9] + Longint($8B44F7AF), 12);
-  Round1(C, D, A, B, Data[10] + Longint($FFFF5BB1), 17);
-  Round1(B, C, D, A, Data[11] + Longint($895CD7BE), 22);
-  Round1(A, B, C, D, Data[12] + Longint($6B901122), 7);
-  Round1(D, A, B, C, Data[13] + Longint($FD987193), 12);
-  Round1(C, D, A, B, Data[14] + Longint($A679438E), 17);
-  Round1(B, C, D, A, Data[15] + Longint($49B40821), 22);
-
-  Round2(A, B, C, D, Data[1] + Longint($F61E2562), 5);
-  Round2(D, A, B, C, Data[6] + Longint($C040B340), 9);
-  Round2(C, D, A, B, Data[11] + Longint($265E5A51), 14);
-  Round2(B, C, D, A, Data[0] + Longint($E9B6C7AA), 20);
-  Round2(A, B, C, D, Data[5] + Longint($D62F105D), 5);
-  Round2(D, A, B, C, Data[10] + Longint($02441453), 9);
-  Round2(C, D, A, B, Data[15] + Longint($D8A1E681), 14);
-  Round2(B, C, D, A, Data[4] + Longint($E7D3FBC8), 20);
-  Round2(A, B, C, D, Data[9] + Longint($21E1CDE6), 5);
-  Round2(D, A, B, C, Data[14] + Longint($C33707D6), 9);
-  Round2(C, D, A, B, Data[3] + Longint($F4D50D87), 14);
-  Round2(B, C, D, A, Data[8] + Longint($455A14ED), 20);
-  Round2(A, B, C, D, Data[13] + Longint($A9E3E905), 5);
-  Round2(D, A, B, C, Data[2] + Longint($FCEFA3F8), 9);
-  Round2(C, D, A, B, Data[7] + Longint($676F02D9), 14);
-  Round2(B, C, D, A, Data[12] + Longint($8D2A4C8A), 20);
-
-  Round3(A, B, C, D, Data[5] + Longint($FFFA3942), 4);
-  Round3(D, A, B, C, Data[8] + Longint($8771F681), 11);
-  Round3(C, D, A, B, Data[11] + Longint($6D9D6122), 16);
-  Round3(B, C, D, A, Data[14] + Longint($FDE5380C), 23);
-  Round3(A, B, C, D, Data[1] + Longint($A4BEEA44), 4);
-  Round3(D, A, B, C, Data[4] + Longint($4BDECFA9), 11);
-  Round3(C, D, A, B, Data[7] + Longint($F6BB4B60), 16);
-  Round3(B, C, D, A, Data[10] + Longint($BEBFBC70), 23);
-  Round3(A, B, C, D, Data[13] + Longint($289B7EC6), 4);
-  Round3(D, A, B, C, Data[0] + Longint($EAA127FA), 11);
-  Round3(C, D, A, B, Data[3] + Longint($D4EF3085), 16);
-  Round3(B, C, D, A, Data[6] + Longint($04881D05), 23);
-  Round3(A, B, C, D, Data[9] + Longint($D9D4D039), 4);
-  Round3(D, A, B, C, Data[12] + Longint($E6DB99E5), 11);
-  Round3(C, D, A, B, Data[15] + Longint($1FA27CF8), 16);
-  Round3(B, C, D, A, Data[2] + Longint($C4AC5665), 23);
-
-  Round4(A, B, C, D, Data[0] + Longint($F4292244), 6);
-  Round4(D, A, B, C, Data[7] + Longint($432AFF97), 10);
-  Round4(C, D, A, B, Data[14] + Longint($AB9423A7), 15);
-  Round4(B, C, D, A, Data[5] + Longint($FC93A039), 21);
-  Round4(A, B, C, D, Data[12] + Longint($655B59C3), 6);
-  Round4(D, A, B, C, Data[3] + Longint($8F0CCC92), 10);
-  Round4(C, D, A, B, Data[10] + Longint($FFEFF47D), 15);
-  Round4(B, C, D, A, Data[1] + Longint($85845DD1), 21);
-  Round4(A, B, C, D, Data[8] + Longint($6FA87E4F), 6);
-  Round4(D, A, B, C, Data[15] + Longint($FE2CE6E0), 10);
-  Round4(C, D, A, B, Data[6] + Longint($A3014314), 15);
-  Round4(B, C, D, A, Data[13] + Longint($4E0811A1), 21);
-  Round4(A, B, C, D, Data[4] + Longint($F7537E82), 6);
-  Round4(D, A, B, C, Data[11] + Longint($BD3AF235), 10);
-  Round4(C, D, A, B, Data[2] + Longint($2AD7D2BB), 15);
-  Round4(B, C, D, A, Data[9] + Longint($EB86D391), 21);
-
-  Inc(Buf[0], A);
-  Inc(Buf[1], B);
-  Inc(Buf[2], C);
-  Inc(Buf[3], D);
-end;
-
-//fixed by James McAdams
-procedure MDUpdate(var MDContext: TMDCtx; const Data: AnsiString; transform: TMDTransform);
-var
-  Index, partLen, InputLen, I: integer;
-{$IFDEF CIL}
-  n: integer;
-{$ENDIF}
-begin
-  InputLen := Length(Data);
-  with MDContext do
-  begin
-    Index := (Count[0] shr 3) and $3F;
-    Inc(Count[0], InputLen shl 3);
-    if Count[0] < (InputLen shl 3) then
-      Inc(Count[1]);
-    Inc(Count[1], InputLen shr 29);
-    partLen := 64 - Index;
-    if InputLen >= partLen then
-    begin
-      ArrLongToByte(BufLong, BufAnsiChar);
-      {$IFDEF CIL}
-      for n := 1 to partLen do
-        BufAnsiChar[index - 1 + n] := Ord(Data[n]);
-      {$ELSE}
-      Move(Data[1], BufAnsiChar[Index], partLen);
-      {$ENDIF}
-      ArrByteToLong(BufAnsiChar, BufLong);
-      Transform(State, Buflong);
-      I := partLen;
-  		while I + 63 < InputLen do
-      begin
-        ArrLongToByte(BufLong, BufAnsiChar);
-        {$IFDEF CIL}
-        for n := 1 to 64 do
-          BufAnsiChar[n - 1] := Ord(Data[i + n]);
-        {$ELSE}
-        Move(Data[I+1], BufAnsiChar, 64);
-        {$ENDIF}
-        ArrByteToLong(BufAnsiChar, BufLong);
-        Transform(State, Buflong);
-	  	  inc(I, 64);
-		  end;
-      Index := 0;
-    end
-    else
-      I := 0;
-    ArrLongToByte(BufLong, BufAnsiChar);
-    {$IFDEF CIL}
-    for n := 1 to InputLen-I do
-      BufAnsiChar[Index + n - 1] := Ord(Data[i + n]);
-    {$ELSE}
-    Move(Data[I+1], BufAnsiChar[Index], InputLen-I);
-    {$ENDIF}
-    ArrByteToLong(BufAnsiChar, BufLong);
-  end
-end;
-
-function MDFinal(var MDContext: TMDCtx; transform: TMDTransform): AnsiString;
-var
-  Cnt: Word;
-  P: Byte;
-  digest: array[0..15] of Byte;
-  i: Integer;
-  n: integer;
-begin
-  for I := 0 to 15 do
-    Digest[I] := I + 1;
-  with MDContext do
-  begin
-    Cnt := (Count[0] shr 3) and $3F;
-    P := Cnt;
-    BufAnsiChar[P] := $80;
-    Inc(P);
-    Cnt := 64 - 1 - Cnt;
-    if Cnt < 8 then
-    begin
-      for n := 0 to cnt - 1 do
-        BufAnsiChar[P + n] := 0;
-      ArrByteToLong(BufAnsiChar, BufLong);
-//      FillChar(BufAnsiChar[P], Cnt, #0);
-      Transform(State, BufLong);
-      ArrLongToByte(BufLong, BufAnsiChar);
-      for n := 0 to 55 do
-        BufAnsiChar[n] := 0;
-      ArrByteToLong(BufAnsiChar, BufLong);
-//      FillChar(BufAnsiChar, 56, #0);
-    end
-    else
-    begin
-      for n := 0 to Cnt - 8 - 1 do
-        BufAnsiChar[p + n] := 0;
-      ArrByteToLong(BufAnsiChar, BufLong);
-//      FillChar(BufAnsiChar[P], Cnt - 8, #0);
-    end;
-    BufLong[14] := Count[0];
-    BufLong[15] := Count[1];
-    Transform(State, BufLong);
-    ArrLongToByte(State, Digest);
-//    Move(State, Digest, 16);
-    Result := '';
-    for i := 0 to 15 do
-      Result := Result + AnsiChar(digest[i]);
-  end;
-//  FillChar(MD5Context, SizeOf(TMD5Ctx), #0)
-end;
-
-{==============================================================================}
-
-function MD5(const Value: AnsiString): AnsiString;
-var
-  MDContext: TMDCtx;
-begin
-  MDInit(MDContext);
-  MDUpdate(MDContext, Value, @MD5Transform);
-  Result := MDFinal(MDContext, @MD5Transform);
-end;
-
-{==============================================================================}
-
-function HMAC_MD5(Text, Key: AnsiString): AnsiString;
-var
-  ipad, opad, s: AnsiString;
-  n: Integer;
-  MDContext: TMDCtx;
-begin
-  if Length(Key) > 64 then
-    Key := md5(Key);
-  ipad := StringOfChar(#$36, 64);
-  opad := StringOfChar(#$5C, 64);
-  for n := 1 to Length(Key) do
-  begin
-    ipad[n] := AnsiChar(Byte(ipad[n]) xor Byte(Key[n]));
-    opad[n] := AnsiChar(Byte(opad[n]) xor Byte(Key[n]));
-  end;
-  MDInit(MDContext);
-  MDUpdate(MDContext, ipad, @MD5Transform);
-  MDUpdate(MDContext, Text, @MD5Transform);
-  s := MDFinal(MDContext, @MD5Transform);
-  MDInit(MDContext);
-  MDUpdate(MDContext, opad, @MD5Transform);
-  MDUpdate(MDContext, s, @MD5Transform);
-  Result := MDFinal(MDContext, @MD5Transform);
-end;
-
-{==============================================================================}
-
-function MD5LongHash(const Value: AnsiString; Len: integer): AnsiString;
-var
-  cnt, rest: integer;
-  l: integer;
-  n: integer;
-  MDContext: TMDCtx;
-begin
-  l := length(Value);
-  cnt := Len div l;
-  rest := Len mod l;
-  MDInit(MDContext);
-  for n := 1 to cnt do
-    MDUpdate(MDContext, Value, @MD5Transform);
-  if rest > 0 then
-    MDUpdate(MDContext, Copy(Value, 1, rest), @MD5Transform);
-  Result := MDFinal(MDContext, @MD5Transform);
-end;
-
-{==============================================================================}
-// SHA1 is based on sources by Dave Barton (davebarton@bigfoot.com)
-
-procedure SHA1init( var SHA1Context: TSHA1Ctx );
-var
-  n: integer;
-begin
-  SHA1Context.Hi := 0;
-  SHA1Context.Lo := 0;
-  SHA1Context.Index := 0;
-  for n := 0 to High(SHA1Context.Buffer) do
-    SHA1Context.Buffer[n] := 0;
-  for n := 0 to High(SHA1Context.HashByte) do
-    SHA1Context.HashByte[n] := 0;
-//  FillChar(SHA1Context, SizeOf(TSHA1Ctx), #0);
-  SHA1Context.Hash[0] := integer($67452301);
-  SHA1Context.Hash[1] := integer($EFCDAB89);
-  SHA1Context.Hash[2] := integer($98BADCFE);
-  SHA1Context.Hash[3] := integer($10325476);
-  SHA1Context.Hash[4] := integer($C3D2E1F0);
-end;
-
-//******************************************************************************
-function RB(A: integer): integer;
-begin
-  Result := (A shr 24) or ((A shr 8) and $FF00) or ((A shl 8) and $FF0000) or (A shl 24);
-end;
-
-procedure SHA1Compress(var Data: TSHA1Ctx);
-var
-  A, B, C, D, E, T: integer;
-  W: array[0..79] of integer;
-  i: integer;
-  n: integer;
-
-  function F1(x, y, z: integer): integer;
-  begin
-    Result := z xor (x and (y xor z));
-  end;
-  function F2(x, y, z: integer): integer;
-  begin
-    Result := x xor y xor z;
-  end;
-  function F3(x, y, z: integer): integer;
-  begin
-    Result := (x and y) or (z and (x or y));
-  end;
-  function LRot32(X: integer; c: integer): integer;
-  begin
-    result := (x shl c) or (x shr (32 - c));
-  end;
-begin
-  ArrByteToLong(Data.Buffer, W);
-//  Move(Data.Buffer, W, Sizeof(Data.Buffer));
-  for i := 0 to 15 do
-    W[i] := RB(W[i]);
-  for i := 16 to 79 do
-    W[i] := LRot32(W[i-3] xor W[i-8] xor W[i-14] xor W[i-16], 1);
-  A := Data.Hash[0];
-  B := Data.Hash[1];
-  C := Data.Hash[2];
-  D := Data.Hash[3];
-  E := Data.Hash[4];
-  for i := 0 to 19 do
-  begin
-    T := LRot32(A, 5) + F1(B, C, D) + E + W[i] + integer($5A827999);
-    E := D;
-    D := C;
-    C := LRot32(B, 30);
-    B := A;
-    A := T;
-  end;
-  for i := 20 to 39 do
-  begin
-    T := LRot32(A, 5) + F2(B, C, D) + E + W[i] + integer($6ED9EBA1);
-    E := D;
-    D := C;
-    C := LRot32(B, 30);
-    B := A;
-    A := T;
-  end;
-  for i := 40 to 59 do
-  begin
-    T := LRot32(A, 5) + F3(B, C, D) + E + W[i] + integer($8F1BBCDC);
-    E := D;
-    D := C;
-    C := LRot32(B, 30);
-    B := A;
-    A := T;
-  end;
-  for i := 60 to 79 do
-  begin
-    T := LRot32(A, 5) + F2(B, C, D) + E + W[i] + integer($CA62C1D6);
-    E := D;
-    D := C;
-    C := LRot32(B, 30);
-    B := A;
-    A := T;
-  end;
-  Data.Hash[0] := Data.Hash[0] + A;
-  Data.Hash[1] := Data.Hash[1] + B;
-  Data.Hash[2] := Data.Hash[2] + C;
-  Data.Hash[3] := Data.Hash[3] + D;
-  Data.Hash[4] := Data.Hash[4] + E;
-  for n := 0 to high(w) do
-    w[n] := 0;
-//  FillChar(W, Sizeof(W), 0);
-  for n := 0 to high(Data.Buffer) do
-    Data.Buffer[n] := 0;
-//  FillChar(Data.Buffer, Sizeof(Data.Buffer), 0);
-end;
-
-//******************************************************************************
-procedure SHA1Update(var Context: TSHA1Ctx; const Data: AnsiString);
-var
-  Len: integer;
-  n: integer;
-  i, k: integer;
-begin
-  Len := Length(data);
-  for k := 0 to 7 do
-  begin
-    i := Context.Lo;
-    Inc(Context.Lo, Len);
-    if Context.Lo < i then
-      Inc(Context.Hi);
-  end;
-  for n := 1 to len do
-  begin
-    Context.Buffer[Context.Index] := byte(Data[n]);
-    Inc(Context.Index);
-    if Context.Index = 64 then
-    begin
-      Context.Index := 0;
-      SHA1Compress(Context);
-    end;
-  end;
-end;
-
-//******************************************************************************
-function SHA1Final(var Context: TSHA1Ctx): AnsiString;
-type
-  Pinteger = ^integer;
-var
-  i: integer;
-  procedure ItoArr(var Ar: Array of byte; I, value: Integer);
-  begin
-    Ar[i + 0] := Value and $000000FF;
-    Ar[i + 1] := (Value shr 8) and $000000FF;
-    Ar[i + 2] := (Value shr 16) and $000000FF;
-    Ar[i + 3] := (Value shr 24) and $000000FF;
-  end;
-begin
-  Context.Buffer[Context.Index] := $80;
-  if Context.Index >= 56 then
-    SHA1Compress(Context);
-  ItoArr(Context.Buffer, 56, RB(Context.Hi));
-  ItoArr(Context.Buffer, 60, RB(Context.Lo));
-//  Pinteger(@Context.Buffer[56])^ := RB(Context.Hi);
-//  Pinteger(@Context.Buffer[60])^ := RB(Context.Lo);
-  SHA1Compress(Context);
-  Context.Hash[0] := RB(Context.Hash[0]);
-  Context.Hash[1] := RB(Context.Hash[1]);
-  Context.Hash[2] := RB(Context.Hash[2]);
-  Context.Hash[3] := RB(Context.Hash[3]);
-  Context.Hash[4] := RB(Context.Hash[4]);
-  ArrLongToByte(Context.Hash, Context.HashByte);
-  Result := '';
-  for i := 0 to 19 do
-    Result := Result + AnsiChar(Context.HashByte[i]);
-end;
-
-function SHA1(const Value: AnsiString): AnsiString;
-var
-  SHA1Context: TSHA1Ctx;
-begin
-  SHA1Init(SHA1Context);
-  SHA1Update(SHA1Context, Value);
-  Result := SHA1Final(SHA1Context);
-end;
-
-{==============================================================================}
-
-function HMAC_SHA1(Text, Key: AnsiString): AnsiString;
-var
-  ipad, opad, s: AnsiString;
-  n: Integer;
-  SHA1Context: TSHA1Ctx;
-begin
-  if Length(Key) > 64 then
-    Key := SHA1(Key);
-  ipad := StringOfChar(#$36, 64);
-  opad := StringOfChar(#$5C, 64);
-  for n := 1 to Length(Key) do
-  begin
-    ipad[n] := AnsiChar(Byte(ipad[n]) xor Byte(Key[n]));
-    opad[n] := AnsiChar(Byte(opad[n]) xor Byte(Key[n]));
-  end;
-  SHA1Init(SHA1Context);
-  SHA1Update(SHA1Context, ipad);
-  SHA1Update(SHA1Context, Text);
-  s := SHA1Final(SHA1Context);
-  SHA1Init(SHA1Context);
-  SHA1Update(SHA1Context, opad);
-  SHA1Update(SHA1Context, s);
-  Result := SHA1Final(SHA1Context);
-end;
-
-{==============================================================================}
-
-function SHA1LongHash(const Value: AnsiString; Len: integer): AnsiString;
-var
-  cnt, rest: integer;
-  l: integer;
-  n: integer;
-  SHA1Context: TSHA1Ctx;
-begin
-  l := length(Value);
-  cnt := Len div l;
-  rest := Len mod l;
-  SHA1Init(SHA1Context);
-  for n := 1 to cnt do
-    SHA1Update(SHA1Context, Value);
-  if rest > 0 then
-    SHA1Update(SHA1Context, Copy(Value, 1, rest));
-  Result := SHA1Final(SHA1Context);
-end;
-
-{==============================================================================}
-
-procedure MD4Transform(var Buf: array of LongInt; const Data: array of LongInt);
-var
-  A, B, C, D: LongInt;
-  function LRot32(a, b: longint): longint;
-  begin
-    Result:= (a shl b) or (a shr (32 - b));
-  end;
-begin
-  A := Buf[0];
-  B := Buf[1];
-  C := Buf[2];
-  D := Buf[3];
-
-  A:= LRot32(A + (D xor (B and (C xor D))) + Data[ 0], 3);
-  D:= LRot32(D + (C xor (A and (B xor C))) + Data[ 1], 7);
-  C:= LRot32(C + (B xor (D and (A xor B))) + Data[ 2], 11);
-  B:= LRot32(B + (A xor (C and (D xor A))) + Data[ 3], 19);
-  A:= LRot32(A + (D xor (B and (C xor D))) + Data[ 4], 3);
-  D:= LRot32(D + (C xor (A and (B xor C))) + Data[ 5], 7);
-  C:= LRot32(C + (B xor (D and (A xor B))) + Data[ 6], 11);
-  B:= LRot32(B + (A xor (C and (D xor A))) + Data[ 7], 19);
-  A:= LRot32(A + (D xor (B and (C xor D))) + Data[ 8], 3);
-  D:= LRot32(D + (C xor (A and (B xor C))) + Data[ 9], 7);
-  C:= LRot32(C + (B xor (D and (A xor B))) + Data[10], 11);
-  B:= LRot32(B + (A xor (C and (D xor A))) + Data[11], 19);
-  A:= LRot32(A + (D xor (B and (C xor D))) + Data[12], 3);
-  D:= LRot32(D + (C xor (A and (B xor C))) + Data[13], 7);
-  C:= LRot32(C + (B xor (D and (A xor B))) + Data[14], 11);
-  B:= LRot32(B + (A xor (C and (D xor A))) + Data[15], 19);
-
-  A:= LRot32(A + ((B and C) or (B and D) or (C and D)) + Data[ 0] + longint($5a827999), 3);
-  D:= LRot32(D + ((A and B) or (A and C) or (B and C)) + Data[ 4] + longint($5a827999), 5);
-  C:= LRot32(C + ((D and A) or (D and B) or (A and B)) + Data[ 8] + longint($5a827999), 9);
-  B:= LRot32(B + ((C and D) or (C and A) or (D and A)) + Data[12] + longint($5a827999), 13);
-  A:= LRot32(A + ((B and C) or (B and D) or (C and D)) + Data[ 1] + longint($5a827999), 3);
-  D:= LRot32(D + ((A and B) or (A and C) or (B and C)) + Data[ 5] + longint($5a827999), 5);
-  C:= LRot32(C + ((D and A) or (D and B) or (A and B)) + Data[ 9] + longint($5a827999), 9);
-  B:= LRot32(B + ((C and D) or (C and A) or (D and A)) + Data[13] + longint($5a827999), 13);
-  A:= LRot32(A + ((B and C) or (B and D) or (C and D)) + Data[ 2] + longint($5a827999), 3);
-  D:= LRot32(D + ((A and B) or (A and C) or (B and C)) + Data[ 6] + longint($5a827999), 5);
-  C:= LRot32(C + ((D and A) or (D and B) or (A and B)) + Data[10] + longint($5a827999), 9);
-  B:= LRot32(B + ((C and D) or (C and A) or (D and A)) + Data[14] + longint($5a827999), 13);
-  A:= LRot32(A + ((B and C) or (B and D) or (C and D)) + Data[ 3] + longint($5a827999), 3);
-  D:= LRot32(D + ((A and B) or (A and C) or (B and C)) + Data[ 7] + longint($5a827999), 5);
-  C:= LRot32(C + ((D and A) or (D and B) or (A and B)) + Data[11] + longint($5a827999), 9);
-  B:= LRot32(B + ((C and D) or (C and A) or (D and A)) + Data[15] + longint($5a827999), 13);
-
-  A:= LRot32(A + (B xor C xor D) + Data[ 0] + longint($6ed9eba1), 3);
-  D:= LRot32(D + (A xor B xor C) + Data[ 8] + longint($6ed9eba1), 9);
-  C:= LRot32(C + (D xor A xor B) + Data[ 4] + longint($6ed9eba1), 11);
-  B:= LRot32(B + (C xor D xor A) + Data[12] + longint($6ed9eba1), 15);
-  A:= LRot32(A + (B xor C xor D) + Data[ 2] + longint($6ed9eba1), 3);
-  D:= LRot32(D + (A xor B xor C) + Data[10] + longint($6ed9eba1), 9);
-  C:= LRot32(C + (D xor A xor B) + Data[ 6] + longint($6ed9eba1), 11);
-  B:= LRot32(B + (C xor D xor A) + Data[14] + longint($6ed9eba1), 15);
-  A:= LRot32(A + (B xor C xor D) + Data[ 1] + longint($6ed9eba1), 3);
-  D:= LRot32(D + (A xor B xor C) + Data[ 9] + longint($6ed9eba1), 9);
-  C:= LRot32(C + (D xor A xor B) + Data[ 5] + longint($6ed9eba1), 11);
-  B:= LRot32(B + (C xor D xor A) + Data[13] + longint($6ed9eba1), 15);
-  A:= LRot32(A + (B xor C xor D) + Data[ 3] + longint($6ed9eba1), 3);
-  D:= LRot32(D + (A xor B xor C) + Data[11] + longint($6ed9eba1), 9);
-  C:= LRot32(C + (D xor A xor B) + Data[ 7] + longint($6ed9eba1), 11);
-  B:= LRot32(B + (C xor D xor A) + Data[15] + longint($6ed9eba1), 15);
-
-  Inc(Buf[0], A);
-  Inc(Buf[1], B);
-  Inc(Buf[2], C);
-  Inc(Buf[3], D);
-end;
-
-{==============================================================================}
-
-function MD4(const Value: AnsiString): AnsiString;
-var
-  MDContext: TMDCtx;
-begin
-  MDInit(MDContext);
-  MDUpdate(MDContext, Value, @MD4Transform);
-  Result := MDFinal(MDContext, @MD4Transform);
-end;
-
-{==============================================================================}
-
-
-end.
+{==============================================================================|
+| Project : Ararat Synapse                                       | 002.002.001 |
+|==============================================================================|
+| Content: Coding and decoding support                                         |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2000-2010.                |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@abstract(Various encoding and decoding support)}
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$Q-}
+{$R-}
+{$H+}
+
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+  {$WARN SUSPICIOUS_TYPECAST OFF}
+{$ENDIF}
+
+unit synacode;
+
+interface
+
+uses
+  SysUtils;
+
+type
+  TSpecials = set of AnsiChar;
+
+const
+
+  SpecialChar: TSpecials =
+  ['=', '(', ')', '[', ']', '<', '>', ':', ';', ',', '@', '/', '?', '\',
+    '"', '_'];
+  NonAsciiChar: TSpecials =
+  [#0..#31, #127..#255];
+  URLFullSpecialChar: TSpecials =
+  [';', '/', '?', ':', '@', '=', '&', '#', '+'];
+  URLSpecialChar: TSpecials =
+  [#$00..#$20, '_', '<', '>', '"', '%', '{', '}', '|', '\', '^', '~', '[', ']',
+    '`', #$7F..#$FF];
+  TableBase64 =
+    'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';
+  TableBase64mod =
+    'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+,=';
+  TableUU =
+    '`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
+  TableXX =
+    '+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
+  ReTablebase64 =
+    #$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$3E +#$40
+    +#$40 +#$40 +#$3F +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C
+    +#$3D +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$01 +#$02 +#$03
+    +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C +#$0D +#$0E +#$0F
+    +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$40 +#$40
+    +#$40 +#$40 +#$40 +#$40 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21
+    +#$22 +#$23 +#$24 +#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D
+    +#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
+  ReTableUU =
+    #$01 +#$02 +#$03 +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C
+    +#$0D +#$0E +#$0F +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18
+    +#$19 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21 +#$22 +#$23 +#$24
+    +#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D +#$2E +#$2F +#$30
+    +#$31 +#$32 +#$33 +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C
+    +#$3D +#$3E +#$3F +#$00 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40
+    +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40
+    +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
+  ReTableXX =
+    #$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$40
+    +#$01 +#$40 +#$40 +#$02 +#$03 +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A
+    +#$0B +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$0C +#$0D +#$0E +#$0F
+    +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$1A +#$1B
+    +#$1C +#$1D +#$1E +#$1F +#$20 +#$21 +#$22 +#$23 +#$24 +#$25 +#$40 +#$40
+    +#$40 +#$40 +#$40 +#$40 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D
+    +#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$34 +#$35 +#$36 +#$37 +#$38 +#$39
+    +#$3A +#$3B +#$3C +#$3D +#$3E +#$3F +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
+
+{:Decodes triplet encoding with a given character delimiter. It is used for
+ decoding quoted-printable or URL encoding.}
+function DecodeTriplet(const Value: AnsiString; Delimiter: AnsiChar): AnsiString;
+
+{:Decodes a string from quoted printable form. (also decodes triplet sequences
+ like '=7F')}
+function DecodeQuotedPrintable(const Value: AnsiString): AnsiString;
+
+{:Decodes a string of URL encoding. (also decodes triplet sequences like '%7F')}
+function DecodeURL(const Value: AnsiString): AnsiString;
+
+{:Performs triplet encoding with a given character delimiter. Used for encoding
+ quoted-printable or URL encoding.}
+function EncodeTriplet(const Value: AnsiString; Delimiter: AnsiChar;
+  Specials: TSpecials): AnsiString;
+
+{:Encodes a string to triplet quoted printable form. All @link(NonAsciiChar)
+ are encoded.}
+function EncodeQuotedPrintable(const Value: AnsiString): AnsiString;
+
+{:Encodes a string to triplet quoted printable form. All @link(NonAsciiChar) and
+ @link(SpecialChar) are encoded.}
+function EncodeSafeQuotedPrintable(const Value: AnsiString): AnsiString;
+
+{:Encodes a string to URL format. Used for encoding data from a form field in
+ HTTP, etc. (Encodes all critical characters including characters used as URL
+ delimiters ('/',':', etc.)}
+function EncodeURLElement(const Value: AnsiString): AnsiString;
+
+{:Encodes a string to URL format. Used to encode critical characters in all
+ URLs.}
+function EncodeURL(const Value: AnsiString): AnsiString;
+
+{:Decode 4to3 encoding with given table. If some element is not found in table,
+ first item from table is used. This is good for buggy coded items by Microsoft
+ Outlook. This software sometimes using wrong table for UUcode, where is used
+ ' ' instead '`'.}
+function Decode4to3(const Value, Table: AnsiString): AnsiString;
+
+{:Decode 4to3 encoding with given REVERSE table. Using this function with
+reverse table is much faster then @link(Decode4to3). This function is used
+internally for Base64, UU or XX decoding.}
+function Decode4to3Ex(const Value, Table: AnsiString): AnsiString;
+
+{:Encode by system 3to4 (used by Base64, UU coding, etc) by given table.}
+function Encode3to4(const Value, Table: AnsiString): AnsiString;
+
+{:Decode string from base64 format.}
+function DecodeBase64(const Value: AnsiString): AnsiString;
+
+{:Encodes a string to base64 format.}
+function EncodeBase64(const Value: AnsiString): AnsiString;
+
+{:Decode string from modified base64 format. (used in IMAP, for example.)}
+function DecodeBase64mod(const Value: AnsiString): AnsiString;
+
+{:Encodes a string to  modified base64 format. (used in IMAP, for example.)}
+function EncodeBase64mod(const Value: AnsiString): AnsiString;
+
+{:Decodes a string from UUcode format.}
+function DecodeUU(const Value: AnsiString): AnsiString;
+
+{:encode UUcode. it encode only datas, you must also add header and footer for
+ proper encode.}
+function EncodeUU(const Value: AnsiString): AnsiString;
+
+{:Decodes a string from XXcode format.}
+function DecodeXX(const Value: AnsiString): AnsiString;
+
+{:decode line with Yenc code. This code is sometimes used in newsgroups.}
+function DecodeYEnc(const Value: AnsiString): AnsiString;
+
+{:Returns a new CRC32 value after adding a new byte of data.}
+function UpdateCrc32(Value: Byte; Crc32: Integer): Integer;
+
+{:return CRC32 from a value string.}
+function Crc32(const Value: AnsiString): Integer;
+
+{:Returns a new CRC16 value after adding a new byte of data.}
+function UpdateCrc16(Value: Byte; Crc16: Word): Word;
+
+{:return CRC16 from a value string.}
+function Crc16(const Value: AnsiString): Word;
+
+{:Returns a binary string with a RSA-MD5 hashing of "Value" string.}
+function MD5(const Value: AnsiString): AnsiString;
+
+{:Returns a binary string with HMAC-MD5 hash.}
+function HMAC_MD5(Text, Key: AnsiString): AnsiString;
+
+{:Returns a binary string with a RSA-MD5 hashing of string what is constructed
+ by repeating "value" until length is "Len".}
+function MD5LongHash(const Value: AnsiString; Len: integer): AnsiString;
+
+{:Returns a binary string with a SHA-1 hashing of "Value" string.}
+function SHA1(const Value: AnsiString): AnsiString;
+
+{:Returns a binary string with HMAC-SHA1 hash.}
+function HMAC_SHA1(Text, Key: AnsiString): AnsiString;
+
+{:Returns a binary string with a SHA-1 hashing of string what is constructed
+ by repeating "value" until length is "Len".}
+function SHA1LongHash(const Value: AnsiString; Len: integer): AnsiString;
+
+{:Returns a binary string with a RSA-MD4 hashing of "Value" string.}
+function MD4(const Value: AnsiString): AnsiString;
+
+implementation
+
+const
+
+  Crc32Tab: array[0..255] of Integer = (
+    Integer($00000000), Integer($77073096), Integer($EE0E612C), Integer($990951BA),
+    Integer($076DC419), Integer($706AF48F), Integer($E963A535), Integer($9E6495A3),
+    Integer($0EDB8832), Integer($79DCB8A4), Integer($E0D5E91E), Integer($97D2D988),
+    Integer($09B64C2B), Integer($7EB17CBD), Integer($E7B82D07), Integer($90BF1D91),
+    Integer($1DB71064), Integer($6AB020F2), Integer($F3B97148), Integer($84BE41DE),
+    Integer($1ADAD47D), Integer($6DDDE4EB), Integer($F4D4B551), Integer($83D385C7),
+    Integer($136C9856), Integer($646BA8C0), Integer($FD62F97A), Integer($8A65C9EC),
+    Integer($14015C4F), Integer($63066CD9), Integer($FA0F3D63), Integer($8D080DF5),
+    Integer($3B6E20C8), Integer($4C69105E), Integer($D56041E4), Integer($A2677172),
+    Integer($3C03E4D1), Integer($4B04D447), Integer($D20D85FD), Integer($A50AB56B),
+    Integer($35B5A8FA), Integer($42B2986C), Integer($DBBBC9D6), Integer($ACBCF940),
+    Integer($32D86CE3), Integer($45DF5C75), Integer($DCD60DCF), Integer($ABD13D59),
+    Integer($26D930AC), Integer($51DE003A), Integer($C8D75180), Integer($BFD06116),
+    Integer($21B4F4B5), Integer($56B3C423), Integer($CFBA9599), Integer($B8BDA50F),
+    Integer($2802B89E), Integer($5F058808), Integer($C60CD9B2), Integer($B10BE924),
+    Integer($2F6F7C87), Integer($58684C11), Integer($C1611DAB), Integer($B6662D3D),
+    Integer($76DC4190), Integer($01DB7106), Integer($98D220BC), Integer($EFD5102A),
+    Integer($71B18589), Integer($06B6B51F), Integer($9FBFE4A5), Integer($E8B8D433),
+    Integer($7807C9A2), Integer($0F00F934), Integer($9609A88E), Integer($E10E9818),
+    Integer($7F6A0DBB), Integer($086D3D2D), Integer($91646C97), Integer($E6635C01),
+    Integer($6B6B51F4), Integer($1C6C6162), Integer($856530D8), Integer($F262004E),
+    Integer($6C0695ED), Integer($1B01A57B), Integer($8208F4C1), Integer($F50FC457),
+    Integer($65B0D9C6), Integer($12B7E950), Integer($8BBEB8EA), Integer($FCB9887C),
+    Integer($62DD1DDF), Integer($15DA2D49), Integer($8CD37CF3), Integer($FBD44C65),
+    Integer($4DB26158), Integer($3AB551CE), Integer($A3BC0074), Integer($D4BB30E2),
+    Integer($4ADFA541), Integer($3DD895D7), Integer($A4D1C46D), Integer($D3D6F4FB),
+    Integer($4369E96A), Integer($346ED9FC), Integer($AD678846), Integer($DA60B8D0),
+    Integer($44042D73), Integer($33031DE5), Integer($AA0A4C5F), Integer($DD0D7CC9),
+    Integer($5005713C), Integer($270241AA), Integer($BE0B1010), Integer($C90C2086),
+    Integer($5768B525), Integer($206F85B3), Integer($B966D409), Integer($CE61E49F),
+    Integer($5EDEF90E), Integer($29D9C998), Integer($B0D09822), Integer($C7D7A8B4),
+    Integer($59B33D17), Integer($2EB40D81), Integer($B7BD5C3B), Integer($C0BA6CAD),
+    Integer($EDB88320), Integer($9ABFB3B6), Integer($03B6E20C), Integer($74B1D29A),
+    Integer($EAD54739), Integer($9DD277AF), Integer($04DB2615), Integer($73DC1683),
+    Integer($E3630B12), Integer($94643B84), Integer($0D6D6A3E), Integer($7A6A5AA8),
+    Integer($E40ECF0B), Integer($9309FF9D), Integer($0A00AE27), Integer($7D079EB1),
+    Integer($F00F9344), Integer($8708A3D2), Integer($1E01F268), Integer($6906C2FE),
+    Integer($F762575D), Integer($806567CB), Integer($196C3671), Integer($6E6B06E7),
+    Integer($FED41B76), Integer($89D32BE0), Integer($10DA7A5A), Integer($67DD4ACC),
+    Integer($F9B9DF6F), Integer($8EBEEFF9), Integer($17B7BE43), Integer($60B08ED5),
+    Integer($D6D6A3E8), Integer($A1D1937E), Integer($38D8C2C4), Integer($4FDFF252),
+    Integer($D1BB67F1), Integer($A6BC5767), Integer($3FB506DD), Integer($48B2364B),
+    Integer($D80D2BDA), Integer($AF0A1B4C), Integer($36034AF6), Integer($41047A60),
+    Integer($DF60EFC3), Integer($A867DF55), Integer($316E8EEF), Integer($4669BE79),
+    Integer($CB61B38C), Integer($BC66831A), Integer($256FD2A0), Integer($5268E236),
+    Integer($CC0C7795), Integer($BB0B4703), Integer($220216B9), Integer($5505262F),
+    Integer($C5BA3BBE), Integer($B2BD0B28), Integer($2BB45A92), Integer($5CB36A04),
+    Integer($C2D7FFA7), Integer($B5D0CF31), Integer($2CD99E8B), Integer($5BDEAE1D),
+    Integer($9B64C2B0), Integer($EC63F226), Integer($756AA39C), Integer($026D930A),
+    Integer($9C0906A9), Integer($EB0E363F), Integer($72076785), Integer($05005713),
+    Integer($95BF4A82), Integer($E2B87A14), Integer($7BB12BAE), Integer($0CB61B38),
+    Integer($92D28E9B), Integer($E5D5BE0D), Integer($7CDCEFB7), Integer($0BDBDF21),
+    Integer($86D3D2D4), Integer($F1D4E242), Integer($68DDB3F8), Integer($1FDA836E),
+    Integer($81BE16CD), Integer($F6B9265B), Integer($6FB077E1), Integer($18B74777),
+    Integer($88085AE6), Integer($FF0F6A70), Integer($66063BCA), Integer($11010B5C),
+    Integer($8F659EFF), Integer($F862AE69), Integer($616BFFD3), Integer($166CCF45),
+    Integer($A00AE278), Integer($D70DD2EE), Integer($4E048354), Integer($3903B3C2),
+    Integer($A7672661), Integer($D06016F7), Integer($4969474D), Integer($3E6E77DB),
+    Integer($AED16A4A), Integer($D9D65ADC), Integer($40DF0B66), Integer($37D83BF0),
+    Integer($A9BCAE53), Integer($DEBB9EC5), Integer($47B2CF7F), Integer($30B5FFE9),
+    Integer($BDBDF21C), Integer($CABAC28A), Integer($53B39330), Integer($24B4A3A6),
+    Integer($BAD03605), Integer($CDD70693), Integer($54DE5729), Integer($23D967BF),
+    Integer($B3667A2E), Integer($C4614AB8), Integer($5D681B02), Integer($2A6F2B94),
+    Integer($B40BBE37), Integer($C30C8EA1), Integer($5A05DF1B), Integer($2D02EF8D)
+    );
+
+  Crc16Tab: array[0..255] of Word = (
+    $0000, $1189, $2312, $329B, $4624, $57AD, $6536, $74BF,
+    $8C48, $9DC1, $AF5A, $BED3, $CA6C, $DBE5, $E97E, $F8F7,
+    $1081, $0108, $3393, $221A, $56A5, $472C, $75B7, $643E,
+    $9CC9, $8D40, $BFDB, $AE52, $DAED, $CB64, $F9FF, $E876,
+    $2102, $308B, $0210, $1399, $6726, $76AF, $4434, $55BD,
+    $AD4A, $BCC3, $8E58, $9FD1, $EB6E, $FAE7, $C87C, $D9F5,
+    $3183, $200A, $1291, $0318, $77A7, $662E, $54B5, $453C,
+    $BDCB, $AC42, $9ED9, $8F50, $FBEF, $EA66, $D8FD, $C974,
+    $4204, $538D, $6116, $709F, $0420, $15A9, $2732, $36BB,
+    $CE4C, $DFC5, $ED5E, $FCD7, $8868, $99E1, $AB7A, $BAF3,
+    $5285, $430C, $7197, $601E, $14A1, $0528, $37B3, $263A,
+    $DECD, $CF44, $FDDF, $EC56, $98E9, $8960, $BBFB, $AA72,
+    $6306, $728F, $4014, $519D, $2522, $34AB, $0630, $17B9,
+    $EF4E, $FEC7, $CC5C, $DDD5, $A96A, $B8E3, $8A78, $9BF1,
+    $7387, $620E, $5095, $411C, $35A3, $242A, $16B1, $0738,
+    $FFCF, $EE46, $DCDD, $CD54, $B9EB, $A862, $9AF9, $8B70,
+    $8408, $9581, $A71A, $B693, $C22C, $D3A5, $E13E, $F0B7,
+    $0840, $19C9, $2B52, $3ADB, $4E64, $5FED, $6D76, $7CFF,
+    $9489, $8500, $B79B, $A612, $D2AD, $C324, $F1BF, $E036,
+    $18C1, $0948, $3BD3, $2A5A, $5EE5, $4F6C, $7DF7, $6C7E,
+    $A50A, $B483, $8618, $9791, $E32E, $F2A7, $C03C, $D1B5,
+    $2942, $38CB, $0A50, $1BD9, $6F66, $7EEF, $4C74, $5DFD,
+    $B58B, $A402, $9699, $8710, $F3AF, $E226, $D0BD, $C134,
+    $39C3, $284A, $1AD1, $0B58, $7FE7, $6E6E, $5CF5, $4D7C,
+    $C60C, $D785, $E51E, $F497, $8028, $91A1, $A33A, $B2B3,
+    $4A44, $5BCD, $6956, $78DF, $0C60, $1DE9, $2F72, $3EFB,
+    $D68D, $C704, $F59F, $E416, $90A9, $8120, $B3BB, $A232,
+    $5AC5, $4B4C, $79D7, $685E, $1CE1, $0D68, $3FF3, $2E7A,
+    $E70E, $F687, $C41C, $D595, $A12A, $B0A3, $8238, $93B1,
+    $6B46, $7ACF, $4854, $59DD, $2D62, $3CEB, $0E70, $1FF9,
+    $F78F, $E606, $D49D, $C514, $B1AB, $A022, $92B9, $8330,
+    $7BC7, $6A4E, $58D5, $495C, $3DE3, $2C6A, $1EF1, $0F78
+    );
+
+procedure ArrByteToLong(var ArByte: Array of byte; var ArLong: Array of Integer);
+{$IFDEF CIL}
+var
+  n: integer;
+{$ENDIF}
+begin
+  if (High(ArByte) + 1) > ((High(ArLong) + 1) * 4) then
+    Exit;
+  {$IFDEF CIL}
+  for n := 0 to ((high(ArByte) + 1) div 4) - 1 do
+    ArLong[n] := ArByte[n * 4 + 0]
+      + (ArByte[n * 4 + 1] shl 8)
+      + (ArByte[n * 4 + 2] shl 16)
+      + (ArByte[n * 4 + 3] shl 24);
+  {$ELSE}
+  Move(ArByte[0], ArLong[0], High(ArByte) + 1);
+  {$ENDIF}
+end;
+
+procedure ArrLongToByte(var ArLong: Array of Integer; var ArByte: Array of byte);
+{$IFDEF CIL}
+var
+  n: integer;
+{$ENDIF}
+begin
+  if (High(ArByte) + 1) < ((High(ArLong) + 1) * 4) then
+    Exit;
+  {$IFDEF CIL}
+  for n := 0 to high(ArLong) do
+  begin
+    ArByte[n * 4 + 0] := ArLong[n] and $000000FF;
+    ArByte[n * 4 + 1] := (ArLong[n] shr 8) and $000000FF;
+    ArByte[n * 4 + 2] := (ArLong[n] shr 16) and $000000FF;
+    ArByte[n * 4 + 3] := (ArLong[n] shr 24) and $000000FF;
+  end;
+  {$ELSE}
+  Move(ArLong[0], ArByte[0], High(ArByte) + 1);
+  {$ENDIF}
+end;
+
+type
+  TMDCtx = record
+    State: array[0..3] of Integer;
+    Count: array[0..1] of Integer;
+    BufAnsiChar: array[0..63] of Byte;
+    BufLong: array[0..15] of Integer;
+  end;
+  TSHA1Ctx= record
+    Hi, Lo: integer;
+    Buffer: array[0..63] of byte;
+    Index: integer;
+    Hash: array[0..4] of Integer;
+    HashByte: array[0..19] of byte;
+  end;
+
+  TMDTransform = procedure(var Buf: array of LongInt; const Data: array of LongInt);
+
+{==============================================================================}
+
+function DecodeTriplet(const Value: AnsiString; Delimiter: AnsiChar): AnsiString;
+var
+  x, l, lv: Integer;
+  c: AnsiChar;
+  b: Byte;
+  bad: Boolean;
+begin
+  lv := Length(Value);
+  SetLength(Result, lv);
+  x := 1;
+  l := 1;
+  while x <= lv do
+  begin
+    c := Value[x];
+    Inc(x);
+    if c <> Delimiter then
+    begin
+      Result[l] := c;
+      Inc(l);
+    end
+    else
+      if x < lv then
+      begin
+        Case Value[x] Of
+          #13:
+            if (Value[x + 1] = #10) then
+              Inc(x, 2)
+            else
+              Inc(x);
+          #10:
+            if (Value[x + 1] = #13) then
+              Inc(x, 2)
+            else
+              Inc(x);
+        else
+          begin
+            bad := False;
+            Case Value[x] Of
+              '0'..'9': b := (Byte(Value[x]) - 48) Shl 4;
+              'a'..'f', 'A'..'F': b := ((Byte(Value[x]) And 7) + 9) shl 4;
+            else
+              begin
+                b := 0;
+                bad := True;
+              end;
+            end;
+            Case Value[x + 1] Of
+              '0'..'9': b := b Or (Byte(Value[x + 1]) - 48);
+              'a'..'f', 'A'..'F': b := b Or ((Byte(Value[x + 1]) And 7) + 9);
+            else
+              bad := True;
+            end;
+            if bad then
+            begin
+              Result[l] := c;
+              Inc(l);
+            end
+            else
+            begin
+              Inc(x, 2);
+              Result[l] := AnsiChar(b);
+              Inc(l);
+            end;
+          end;
+        end;
+      end
+      else
+        break;
+  end;
+  Dec(l);
+  SetLength(Result, l);
+end;
+
+{==============================================================================}
+
+function DecodeQuotedPrintable(const Value: AnsiString): AnsiString;
+begin
+  Result := DecodeTriplet(Value, '=');
+end;
+
+{==============================================================================}
+
+function DecodeURL(const Value: AnsiString): AnsiString;
+begin
+  Result := DecodeTriplet(Value, '%');
+end;
+
+{==============================================================================}
+
+function EncodeTriplet(const Value: AnsiString; Delimiter: AnsiChar;
+  Specials: TSpecials): AnsiString;
+var
+  n, l: Integer;
+  s: AnsiString;
+  c: AnsiChar;
+begin
+  SetLength(Result, Length(Value) * 3);
+  l := 1;
+  for n := 1 to Length(Value) do
+  begin
+    c := Value[n];
+    if c in Specials then
+    begin
+      Result[l] := Delimiter;
+      Inc(l);
+      s := IntToHex(Ord(c), 2);
+      Result[l] := s[1];
+      Inc(l);
+      Result[l] := s[2];
+      Inc(l);
+    end
+    else
+    begin
+      Result[l] := c;
+      Inc(l);
+    end;
+  end;
+  Dec(l);
+  SetLength(Result, l);
+end;
+
+{==============================================================================}
+
+function EncodeQuotedPrintable(const Value: AnsiString): AnsiString;
+begin
+  Result := EncodeTriplet(Value, '=',  ['='] + NonAsciiChar);
+end;
+
+{==============================================================================}
+
+function EncodeSafeQuotedPrintable(const Value: AnsiString): AnsiString;
+begin
+  Result := EncodeTriplet(Value, '=', SpecialChar + NonAsciiChar);
+end;
+
+{==============================================================================}
+
+function EncodeURLElement(const Value: AnsiString): AnsiString;
+begin
+  Result := EncodeTriplet(Value, '%', URLSpecialChar + URLFullSpecialChar);
+end;
+
+{==============================================================================}
+
+function EncodeURL(const Value: AnsiString): AnsiString;
+begin
+  Result := EncodeTriplet(Value, '%', URLSpecialChar);
+end;
+
+{==============================================================================}
+
+function Decode4to3(const Value, Table: AnsiString): AnsiString;
+var
+  x, y, n, l: Integer;
+  d: array[0..3] of Byte;
+begin
+  SetLength(Result, Length(Value));
+  x := 1;
+  l := 1;
+  while x <= Length(Value) do
+  begin
+    for n := 0 to 3 do
+    begin
+      if x > Length(Value) then
+        d[n] := 64
+      else
+      begin
+        y := Pos(Value[x], Table);
+        if y < 1 then
+          y := 1;
+        d[n] := y - 1;
+      end;
+      Inc(x);
+    end;
+    Result[l] := AnsiChar((D[0] and $3F) shl 2 + (D[1] and $30) shr 4);
+    Inc(l);
+    if d[2] <> 64 then
+    begin
+      Result[l] := AnsiChar((D[1] and $0F) shl 4 + (D[2] and $3C) shr 2);
+      Inc(l);
+      if d[3] <> 64 then
+      begin
+        Result[l] := AnsiChar((D[2] and $03) shl 6 + (D[3] and $3F));
+        Inc(l);
+      end;
+    end;
+  end;
+  Dec(l);
+  SetLength(Result, l);
+end;
+
+{==============================================================================}
+function Decode4to3Ex(const Value, Table: AnsiString): AnsiString;
+var
+  x, y, lv: Integer;
+  d: integer;
+  dl: integer;
+  c: byte;
+  p: integer;
+begin
+  lv := Length(Value);
+  SetLength(Result, lv);
+  x := 1;
+  dl := 4;
+  d := 0;
+  p := 1;
+  while x <= lv do
+  begin
+    y := Ord(Value[x]);
+    if y in [33..127] then
+      c := Ord(Table[y - 32])
+    else
+      c := 64;
+    Inc(x);
+    if c > 63 then
+      continue;
+    d := (d shl 6) or c;
+    dec(dl);
+    if dl <> 0 then
+      continue;
+    Result[p] := AnsiChar((d shr 16) and $ff);
+    inc(p);
+    Result[p] := AnsiChar((d shr 8) and $ff);
+    inc(p);
+    Result[p] := AnsiChar(d and $ff);
+    inc(p);
+    d := 0;
+    dl := 4;
+  end;
+  case dl of
+    1:
+      begin
+        d := d shr 2;
+        Result[p] := AnsiChar((d shr 8) and $ff);
+        inc(p);
+        Result[p] := AnsiChar(d and $ff);
+        inc(p);
+      end;
+    2:
+      begin
+        d := d shr 4;
+        Result[p] := AnsiChar(d and $ff);
+        inc(p);
+      end;
+  end;
+  SetLength(Result, p - 1);
+end;
+
+{==============================================================================}
+
+function Encode3to4(const Value, Table: AnsiString): AnsiString;
+var
+  c: Byte;
+  n, l: Integer;
+  Count: Integer;
+  DOut: array[0..3] of Byte;
+begin
+  setlength(Result, ((Length(Value) + 2) div 3) * 4);
+  l := 1;
+  Count := 1;
+  while Count <= Length(Value) do
+  begin
+    c := Ord(Value[Count]);
+    Inc(Count);
+    DOut[0] := (c and $FC) shr 2;
+    DOut[1] := (c and $03) shl 4;
+    if Count <= Length(Value) then
+    begin
+      c := Ord(Value[Count]);
+      Inc(Count);
+      DOut[1] := DOut[1] + (c and $F0) shr 4;
+      DOut[2] := (c and $0F) shl 2;
+      if Count <= Length(Value) then
+      begin
+        c := Ord(Value[Count]);
+        Inc(Count);
+        DOut[2] := DOut[2] + (c and $C0) shr 6;
+        DOut[3] := (c and $3F);
+      end
+      else
+      begin
+        DOut[3] := $40;
+      end;
+    end
+    else
+    begin
+      DOut[2] := $40;
+      DOut[3] := $40;
+    end;
+    for n := 0 to 3 do
+    begin
+      if (DOut[n] + 1) <= Length(Table) then
+      begin
+        Result[l] := Table[DOut[n] + 1];
+        Inc(l);
+      end;
+    end;
+  end;
+  SetLength(Result, l - 1);
+end;
+
+{==============================================================================}
+
+function DecodeBase64(const Value: AnsiString): AnsiString;
+begin
+  Result := Decode4to3Ex(Value, ReTableBase64);
+end;
+
+{==============================================================================}
+
+function EncodeBase64(const Value: AnsiString): AnsiString;
+begin
+  Result := Encode3to4(Value, TableBase64);
+end;
+
+{==============================================================================}
+
+function DecodeBase64mod(const Value: AnsiString): AnsiString;
+begin
+  Result := Decode4to3(Value, TableBase64mod);
+end;
+
+{==============================================================================}
+
+function EncodeBase64mod(const Value: AnsiString): AnsiString;
+begin
+  Result := Encode3to4(Value, TableBase64mod);
+end;
+
+{==============================================================================}
+
+function DecodeUU(const Value: AnsiString): AnsiString;
+var
+  s: AnsiString;
+  uut: AnsiString;
+  x: Integer;
+begin
+  Result := '';
+  uut := TableUU;
+  s := trim(UpperCase(Value));
+  if s = '' then Exit;
+  if Pos('BEGIN', s) = 1 then
+    Exit;
+  if Pos('END', s) = 1 then
+    Exit;
+  if Pos('TABLE', s) = 1 then
+    Exit; //ignore Table yet (set custom UUT)
+  //begin decoding
+  x := Pos(Value[1], uut) - 1;
+  case (x mod 3) of
+    0: x :=(x div 3)* 4;
+    1: x :=((x div 3) * 4) + 2;
+    2: x :=((x  div 3) * 4) + 3;
+  end;
+  //x - lenght UU line
+  s := Copy(Value, 2, x);
+  if s = '' then
+    Exit;
+  s := s + StringOfChar(' ', x - length(s));
+  Result := Decode4to3(s, uut);
+end;
+
+{==============================================================================}
+
+function EncodeUU(const Value: AnsiString): AnsiString;
+begin
+  Result := '';
+  if Length(Value) < Length(TableUU) then
+    Result := TableUU[Length(Value) + 1] + Encode3to4(Value, TableUU);
+end;
+
+{==============================================================================}
+
+function DecodeXX(const Value: AnsiString): AnsiString;
+var
+  s: AnsiString;
+  x: Integer;
+begin
+  Result := '';
+  s := trim(UpperCase(Value));
+  if s = '' then
+    Exit;
+  if Pos('BEGIN', s) = 1 then
+    Exit;
+  if Pos('END', s) = 1 then
+    Exit;
+  //begin decoding
+  x := Pos(Value[1], TableXX) - 1;
+  case (x mod 3) of
+    0: x :=(x div 3)* 4;
+    1: x :=((x div 3) * 4) + 2;
+    2: x :=((x  div 3) * 4) + 3;
+  end;
+  //x - lenght XX line
+  s := Copy(Value, 2, x);
+  if s = '' then
+    Exit;
+  s := s + StringOfChar(' ', x - length(s));
+  Result := Decode4to3(s, TableXX);
+end;
+
+{==============================================================================}
+
+function DecodeYEnc(const Value: AnsiString): AnsiString;
+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 + AnsiChar(C);
+  end;
+end;
+
+{==============================================================================}
+
+function UpdateCrc32(Value: Byte; Crc32: Integer): Integer;
+begin
+  Result := (Crc32 shr 8)
+    xor crc32tab[Byte(Value xor (Crc32 and Integer($000000FF)))];
+end;
+
+{==============================================================================}
+
+function Crc32(const Value: AnsiString): Integer;
+var
+  n: Integer;
+begin
+  Result := Integer($FFFFFFFF);
+  for n := 1 to Length(Value) do
+    Result := UpdateCrc32(Ord(Value[n]), Result);
+  Result := not Result;
+end;
+
+{==============================================================================}
+
+function UpdateCrc16(Value: Byte; Crc16: Word): Word;
+begin
+  Result := ((Crc16 shr 8) and $00FF) xor
+    crc16tab[Byte(Crc16 xor (Word(Value)) and $00FF)];
+end;
+
+{==============================================================================}
+
+function Crc16(const Value: AnsiString): Word;
+var
+  n: Integer;
+begin
+  Result := $FFFF;
+  for n := 1 to Length(Value) do
+    Result := UpdateCrc16(Ord(Value[n]), Result);
+end;
+
+{==============================================================================}
+
+procedure MDInit(var MDContext: TMDCtx);
+var
+  n: integer;
+begin
+  MDContext.Count[0] := 0;
+  MDContext.Count[1] := 0;
+  for n := 0 to high(MDContext.BufAnsiChar) do
+    MDContext.BufAnsiChar[n] := 0;
+  for n := 0 to high(MDContext.BufLong) do
+    MDContext.BufLong[n] := 0;
+  MDContext.State[0] := Integer($67452301);
+  MDContext.State[1] := Integer($EFCDAB89);
+  MDContext.State[2] := Integer($98BADCFE);
+  MDContext.State[3] := Integer($10325476);
+end;
+
+procedure MD5Transform(var Buf: array of LongInt; const Data: array of LongInt);
+var
+  A, B, C, D: LongInt;
+
+  procedure Round1(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
+  begin
+    Inc(W, (Z xor (X and (Y xor Z))) + Data);
+    W := (W shl S) or (W shr (32 - S));
+    Inc(W, X);
+  end;
+
+  procedure Round2(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
+  begin
+    Inc(W, (Y xor (Z and (X xor Y))) + Data);
+    W := (W shl S) or (W shr (32 - S));
+    Inc(W, X);
+  end;
+
+  procedure Round3(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
+  begin
+    Inc(W, (X xor Y xor Z) + Data);
+    W := (W shl S) or (W shr (32 - S));
+    Inc(W, X);
+  end;
+
+  procedure Round4(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
+  begin
+    Inc(W, (Y xor (X or not Z)) + Data);
+    W := (W shl S) or (W shr (32 - S));
+    Inc(W, X);
+  end;
+begin
+  A := Buf[0];
+  B := Buf[1];
+  C := Buf[2];
+  D := Buf[3];
+
+  Round1(A, B, C, D, Data[0] + Longint($D76AA478), 7);
+  Round1(D, A, B, C, Data[1] + Longint($E8C7B756), 12);
+  Round1(C, D, A, B, Data[2] + Longint($242070DB), 17);
+  Round1(B, C, D, A, Data[3] + Longint($C1BDCEEE), 22);
+  Round1(A, B, C, D, Data[4] + Longint($F57C0FAF), 7);
+  Round1(D, A, B, C, Data[5] + Longint($4787C62A), 12);
+  Round1(C, D, A, B, Data[6] + Longint($A8304613), 17);
+  Round1(B, C, D, A, Data[7] + Longint($FD469501), 22);
+  Round1(A, B, C, D, Data[8] + Longint($698098D8), 7);
+  Round1(D, A, B, C, Data[9] + Longint($8B44F7AF), 12);
+  Round1(C, D, A, B, Data[10] + Longint($FFFF5BB1), 17);
+  Round1(B, C, D, A, Data[11] + Longint($895CD7BE), 22);
+  Round1(A, B, C, D, Data[12] + Longint($6B901122), 7);
+  Round1(D, A, B, C, Data[13] + Longint($FD987193), 12);
+  Round1(C, D, A, B, Data[14] + Longint($A679438E), 17);
+  Round1(B, C, D, A, Data[15] + Longint($49B40821), 22);
+
+  Round2(A, B, C, D, Data[1] + Longint($F61E2562), 5);
+  Round2(D, A, B, C, Data[6] + Longint($C040B340), 9);
+  Round2(C, D, A, B, Data[11] + Longint($265E5A51), 14);
+  Round2(B, C, D, A, Data[0] + Longint($E9B6C7AA), 20);
+  Round2(A, B, C, D, Data[5] + Longint($D62F105D), 5);
+  Round2(D, A, B, C, Data[10] + Longint($02441453), 9);
+  Round2(C, D, A, B, Data[15] + Longint($D8A1E681), 14);
+  Round2(B, C, D, A, Data[4] + Longint($E7D3FBC8), 20);
+  Round2(A, B, C, D, Data[9] + Longint($21E1CDE6), 5);
+  Round2(D, A, B, C, Data[14] + Longint($C33707D6), 9);
+  Round2(C, D, A, B, Data[3] + Longint($F4D50D87), 14);
+  Round2(B, C, D, A, Data[8] + Longint($455A14ED), 20);
+  Round2(A, B, C, D, Data[13] + Longint($A9E3E905), 5);
+  Round2(D, A, B, C, Data[2] + Longint($FCEFA3F8), 9);
+  Round2(C, D, A, B, Data[7] + Longint($676F02D9), 14);
+  Round2(B, C, D, A, Data[12] + Longint($8D2A4C8A), 20);
+
+  Round3(A, B, C, D, Data[5] + Longint($FFFA3942), 4);
+  Round3(D, A, B, C, Data[8] + Longint($8771F681), 11);
+  Round3(C, D, A, B, Data[11] + Longint($6D9D6122), 16);
+  Round3(B, C, D, A, Data[14] + Longint($FDE5380C), 23);
+  Round3(A, B, C, D, Data[1] + Longint($A4BEEA44), 4);
+  Round3(D, A, B, C, Data[4] + Longint($4BDECFA9), 11);
+  Round3(C, D, A, B, Data[7] + Longint($F6BB4B60), 16);
+  Round3(B, C, D, A, Data[10] + Longint($BEBFBC70), 23);
+  Round3(A, B, C, D, Data[13] + Longint($289B7EC6), 4);
+  Round3(D, A, B, C, Data[0] + Longint($EAA127FA), 11);
+  Round3(C, D, A, B, Data[3] + Longint($D4EF3085), 16);
+  Round3(B, C, D, A, Data[6] + Longint($04881D05), 23);
+  Round3(A, B, C, D, Data[9] + Longint($D9D4D039), 4);
+  Round3(D, A, B, C, Data[12] + Longint($E6DB99E5), 11);
+  Round3(C, D, A, B, Data[15] + Longint($1FA27CF8), 16);
+  Round3(B, C, D, A, Data[2] + Longint($C4AC5665), 23);
+
+  Round4(A, B, C, D, Data[0] + Longint($F4292244), 6);
+  Round4(D, A, B, C, Data[7] + Longint($432AFF97), 10);
+  Round4(C, D, A, B, Data[14] + Longint($AB9423A7), 15);
+  Round4(B, C, D, A, Data[5] + Longint($FC93A039), 21);
+  Round4(A, B, C, D, Data[12] + Longint($655B59C3), 6);
+  Round4(D, A, B, C, Data[3] + Longint($8F0CCC92), 10);
+  Round4(C, D, A, B, Data[10] + Longint($FFEFF47D), 15);
+  Round4(B, C, D, A, Data[1] + Longint($85845DD1), 21);
+  Round4(A, B, C, D, Data[8] + Longint($6FA87E4F), 6);
+  Round4(D, A, B, C, Data[15] + Longint($FE2CE6E0), 10);
+  Round4(C, D, A, B, Data[6] + Longint($A3014314), 15);
+  Round4(B, C, D, A, Data[13] + Longint($4E0811A1), 21);
+  Round4(A, B, C, D, Data[4] + Longint($F7537E82), 6);
+  Round4(D, A, B, C, Data[11] + Longint($BD3AF235), 10);
+  Round4(C, D, A, B, Data[2] + Longint($2AD7D2BB), 15);
+  Round4(B, C, D, A, Data[9] + Longint($EB86D391), 21);
+
+  Inc(Buf[0], A);
+  Inc(Buf[1], B);
+  Inc(Buf[2], C);
+  Inc(Buf[3], D);
+end;
+
+//fixed by James McAdams
+procedure MDUpdate(var MDContext: TMDCtx; const Data: AnsiString; transform: TMDTransform);
+var
+  Index, partLen, InputLen, I: integer;
+{$IFDEF CIL}
+  n: integer;
+{$ENDIF}
+begin
+  InputLen := Length(Data);
+  with MDContext do
+  begin
+    Index := (Count[0] shr 3) and $3F;
+    Inc(Count[0], InputLen shl 3);
+    if Count[0] < (InputLen shl 3) then
+      Inc(Count[1]);
+    Inc(Count[1], InputLen shr 29);
+    partLen := 64 - Index;
+    if InputLen >= partLen then
+    begin
+      ArrLongToByte(BufLong, BufAnsiChar);
+      {$IFDEF CIL}
+      for n := 1 to partLen do
+        BufAnsiChar[index - 1 + n] := Ord(Data[n]);
+      {$ELSE}
+      Move(Data[1], BufAnsiChar[Index], partLen);
+      {$ENDIF}
+      ArrByteToLong(BufAnsiChar, BufLong);
+      Transform(State, Buflong);
+      I := partLen;
+  		while I + 63 < InputLen do
+      begin
+        ArrLongToByte(BufLong, BufAnsiChar);
+        {$IFDEF CIL}
+        for n := 1 to 64 do
+          BufAnsiChar[n - 1] := Ord(Data[i + n]);
+        {$ELSE}
+        Move(Data[I+1], BufAnsiChar, 64);
+        {$ENDIF}
+        ArrByteToLong(BufAnsiChar, BufLong);
+        Transform(State, Buflong);
+	  	  inc(I, 64);
+		  end;
+      Index := 0;
+    end
+    else
+      I := 0;
+    ArrLongToByte(BufLong, BufAnsiChar);
+    {$IFDEF CIL}
+    for n := 1 to InputLen-I do
+      BufAnsiChar[Index + n - 1] := Ord(Data[i + n]);
+    {$ELSE}
+    Move(Data[I+1], BufAnsiChar[Index], InputLen-I);
+    {$ENDIF}
+    ArrByteToLong(BufAnsiChar, BufLong);
+  end
+end;
+
+function MDFinal(var MDContext: TMDCtx; transform: TMDTransform): AnsiString;
+var
+  Cnt: Word;
+  P: Byte;
+  digest: array[0..15] of Byte;
+  i: Integer;
+  n: integer;
+begin
+  for I := 0 to 15 do
+    Digest[I] := I + 1;
+  with MDContext do
+  begin
+    Cnt := (Count[0] shr 3) and $3F;
+    P := Cnt;
+    BufAnsiChar[P] := $80;
+    Inc(P);
+    Cnt := 64 - 1 - Cnt;
+    if Cnt < 8 then
+    begin
+      for n := 0 to cnt - 1 do
+        BufAnsiChar[P + n] := 0;
+      ArrByteToLong(BufAnsiChar, BufLong);
+//      FillChar(BufAnsiChar[P], Cnt, #0);
+      Transform(State, BufLong);
+      ArrLongToByte(BufLong, BufAnsiChar);
+      for n := 0 to 55 do
+        BufAnsiChar[n] := 0;
+      ArrByteToLong(BufAnsiChar, BufLong);
+//      FillChar(BufAnsiChar, 56, #0);
+    end
+    else
+    begin
+      for n := 0 to Cnt - 8 - 1 do
+        BufAnsiChar[p + n] := 0;
+      ArrByteToLong(BufAnsiChar, BufLong);
+//      FillChar(BufAnsiChar[P], Cnt - 8, #0);
+    end;
+    BufLong[14] := Count[0];
+    BufLong[15] := Count[1];
+    Transform(State, BufLong);
+    ArrLongToByte(State, Digest);
+//    Move(State, Digest, 16);
+    Result := '';
+    for i := 0 to 15 do
+      Result := Result + AnsiChar(digest[i]);
+  end;
+//  FillChar(MD5Context, SizeOf(TMD5Ctx), #0)
+end;
+
+{==============================================================================}
+
+function MD5(const Value: AnsiString): AnsiString;
+var
+  MDContext: TMDCtx;
+begin
+  MDInit(MDContext);
+  MDUpdate(MDContext, Value, @MD5Transform);
+  Result := MDFinal(MDContext, @MD5Transform);
+end;
+
+{==============================================================================}
+
+function HMAC_MD5(Text, Key: AnsiString): AnsiString;
+var
+  ipad, opad, s: AnsiString;
+  n: Integer;
+  MDContext: TMDCtx;
+begin
+  if Length(Key) > 64 then
+    Key := md5(Key);
+  ipad := StringOfChar(#$36, 64);
+  opad := StringOfChar(#$5C, 64);
+  for n := 1 to Length(Key) do
+  begin
+    ipad[n] := AnsiChar(Byte(ipad[n]) xor Byte(Key[n]));
+    opad[n] := AnsiChar(Byte(opad[n]) xor Byte(Key[n]));
+  end;
+  MDInit(MDContext);
+  MDUpdate(MDContext, ipad, @MD5Transform);
+  MDUpdate(MDContext, Text, @MD5Transform);
+  s := MDFinal(MDContext, @MD5Transform);
+  MDInit(MDContext);
+  MDUpdate(MDContext, opad, @MD5Transform);
+  MDUpdate(MDContext, s, @MD5Transform);
+  Result := MDFinal(MDContext, @MD5Transform);
+end;
+
+{==============================================================================}
+
+function MD5LongHash(const Value: AnsiString; Len: integer): AnsiString;
+var
+  cnt, rest: integer;
+  l: integer;
+  n: integer;
+  MDContext: TMDCtx;
+begin
+  l := length(Value);
+  cnt := Len div l;
+  rest := Len mod l;
+  MDInit(MDContext);
+  for n := 1 to cnt do
+    MDUpdate(MDContext, Value, @MD5Transform);
+  if rest > 0 then
+    MDUpdate(MDContext, Copy(Value, 1, rest), @MD5Transform);
+  Result := MDFinal(MDContext, @MD5Transform);
+end;
+
+{==============================================================================}
+// SHA1 is based on sources by Dave Barton (davebarton@bigfoot.com)
+
+procedure SHA1init( var SHA1Context: TSHA1Ctx );
+var
+  n: integer;
+begin
+  SHA1Context.Hi := 0;
+  SHA1Context.Lo := 0;
+  SHA1Context.Index := 0;
+  for n := 0 to High(SHA1Context.Buffer) do
+    SHA1Context.Buffer[n] := 0;
+  for n := 0 to High(SHA1Context.HashByte) do
+    SHA1Context.HashByte[n] := 0;
+//  FillChar(SHA1Context, SizeOf(TSHA1Ctx), #0);
+  SHA1Context.Hash[0] := integer($67452301);
+  SHA1Context.Hash[1] := integer($EFCDAB89);
+  SHA1Context.Hash[2] := integer($98BADCFE);
+  SHA1Context.Hash[3] := integer($10325476);
+  SHA1Context.Hash[4] := integer($C3D2E1F0);
+end;
+
+//******************************************************************************
+function RB(A: integer): integer;
+begin
+  Result := (A shr 24) or ((A shr 8) and $FF00) or ((A shl 8) and $FF0000) or (A shl 24);
+end;
+
+procedure SHA1Compress(var Data: TSHA1Ctx);
+var
+  A, B, C, D, E, T: integer;
+  W: array[0..79] of integer;
+  i: integer;
+  n: integer;
+
+  function F1(x, y, z: integer): integer;
+  begin
+    Result := z xor (x and (y xor z));
+  end;
+  function F2(x, y, z: integer): integer;
+  begin
+    Result := x xor y xor z;
+  end;
+  function F3(x, y, z: integer): integer;
+  begin
+    Result := (x and y) or (z and (x or y));
+  end;
+  function LRot32(X: integer; c: integer): integer;
+  begin
+    result := (x shl c) or (x shr (32 - c));
+  end;
+begin
+  ArrByteToLong(Data.Buffer, W);
+//  Move(Data.Buffer, W, Sizeof(Data.Buffer));
+  for i := 0 to 15 do
+    W[i] := RB(W[i]);
+  for i := 16 to 79 do
+    W[i] := LRot32(W[i-3] xor W[i-8] xor W[i-14] xor W[i-16], 1);
+  A := Data.Hash[0];
+  B := Data.Hash[1];
+  C := Data.Hash[2];
+  D := Data.Hash[3];
+  E := Data.Hash[4];
+  for i := 0 to 19 do
+  begin
+    T := LRot32(A, 5) + F1(B, C, D) + E + W[i] + integer($5A827999);
+    E := D;
+    D := C;
+    C := LRot32(B, 30);
+    B := A;
+    A := T;
+  end;
+  for i := 20 to 39 do
+  begin
+    T := LRot32(A, 5) + F2(B, C, D) + E + W[i] + integer($6ED9EBA1);
+    E := D;
+    D := C;
+    C := LRot32(B, 30);
+    B := A;
+    A := T;
+  end;
+  for i := 40 to 59 do
+  begin
+    T := LRot32(A, 5) + F3(B, C, D) + E + W[i] + integer($8F1BBCDC);
+    E := D;
+    D := C;
+    C := LRot32(B, 30);
+    B := A;
+    A := T;
+  end;
+  for i := 60 to 79 do
+  begin
+    T := LRot32(A, 5) + F2(B, C, D) + E + W[i] + integer($CA62C1D6);
+    E := D;
+    D := C;
+    C := LRot32(B, 30);
+    B := A;
+    A := T;
+  end;
+  Data.Hash[0] := Data.Hash[0] + A;
+  Data.Hash[1] := Data.Hash[1] + B;
+  Data.Hash[2] := Data.Hash[2] + C;
+  Data.Hash[3] := Data.Hash[3] + D;
+  Data.Hash[4] := Data.Hash[4] + E;
+  for n := 0 to high(w) do
+    w[n] := 0;
+//  FillChar(W, Sizeof(W), 0);
+  for n := 0 to high(Data.Buffer) do
+    Data.Buffer[n] := 0;
+//  FillChar(Data.Buffer, Sizeof(Data.Buffer), 0);
+end;
+
+//******************************************************************************
+procedure SHA1Update(var Context: TSHA1Ctx; const Data: AnsiString);
+var
+  Len: integer;
+  n: integer;
+  i, k: integer;
+begin
+  Len := Length(data);
+  for k := 0 to 7 do
+  begin
+    i := Context.Lo;
+    Inc(Context.Lo, Len);
+    if Context.Lo < i then
+      Inc(Context.Hi);
+  end;
+  for n := 1 to len do
+  begin
+    Context.Buffer[Context.Index] := byte(Data[n]);
+    Inc(Context.Index);
+    if Context.Index = 64 then
+    begin
+      Context.Index := 0;
+      SHA1Compress(Context);
+    end;
+  end;
+end;
+
+//******************************************************************************
+function SHA1Final(var Context: TSHA1Ctx): AnsiString;
+type
+  Pinteger = ^integer;
+var
+  i: integer;
+  procedure ItoArr(var Ar: Array of byte; I, value: Integer);
+  begin
+    Ar[i + 0] := Value and $000000FF;
+    Ar[i + 1] := (Value shr 8) and $000000FF;
+    Ar[i + 2] := (Value shr 16) and $000000FF;
+    Ar[i + 3] := (Value shr 24) and $000000FF;
+  end;
+begin
+  Context.Buffer[Context.Index] := $80;
+  if Context.Index >= 56 then
+    SHA1Compress(Context);
+  ItoArr(Context.Buffer, 56, RB(Context.Hi));
+  ItoArr(Context.Buffer, 60, RB(Context.Lo));
+//  Pinteger(@Context.Buffer[56])^ := RB(Context.Hi);
+//  Pinteger(@Context.Buffer[60])^ := RB(Context.Lo);
+  SHA1Compress(Context);
+  Context.Hash[0] := RB(Context.Hash[0]);
+  Context.Hash[1] := RB(Context.Hash[1]);
+  Context.Hash[2] := RB(Context.Hash[2]);
+  Context.Hash[3] := RB(Context.Hash[3]);
+  Context.Hash[4] := RB(Context.Hash[4]);
+  ArrLongToByte(Context.Hash, Context.HashByte);
+  Result := '';
+  for i := 0 to 19 do
+    Result := Result + AnsiChar(Context.HashByte[i]);
+end;
+
+function SHA1(const Value: AnsiString): AnsiString;
+var
+  SHA1Context: TSHA1Ctx;
+begin
+  SHA1Init(SHA1Context);
+  SHA1Update(SHA1Context, Value);
+  Result := SHA1Final(SHA1Context);
+end;
+
+{==============================================================================}
+
+function HMAC_SHA1(Text, Key: AnsiString): AnsiString;
+var
+  ipad, opad, s: AnsiString;
+  n: Integer;
+  SHA1Context: TSHA1Ctx;
+begin
+  if Length(Key) > 64 then
+    Key := SHA1(Key);
+  ipad := StringOfChar(#$36, 64);
+  opad := StringOfChar(#$5C, 64);
+  for n := 1 to Length(Key) do
+  begin
+    ipad[n] := AnsiChar(Byte(ipad[n]) xor Byte(Key[n]));
+    opad[n] := AnsiChar(Byte(opad[n]) xor Byte(Key[n]));
+  end;
+  SHA1Init(SHA1Context);
+  SHA1Update(SHA1Context, ipad);
+  SHA1Update(SHA1Context, Text);
+  s := SHA1Final(SHA1Context);
+  SHA1Init(SHA1Context);
+  SHA1Update(SHA1Context, opad);
+  SHA1Update(SHA1Context, s);
+  Result := SHA1Final(SHA1Context);
+end;
+
+{==============================================================================}
+
+function SHA1LongHash(const Value: AnsiString; Len: integer): AnsiString;
+var
+  cnt, rest: integer;
+  l: integer;
+  n: integer;
+  SHA1Context: TSHA1Ctx;
+begin
+  l := length(Value);
+  cnt := Len div l;
+  rest := Len mod l;
+  SHA1Init(SHA1Context);
+  for n := 1 to cnt do
+    SHA1Update(SHA1Context, Value);
+  if rest > 0 then
+    SHA1Update(SHA1Context, Copy(Value, 1, rest));
+  Result := SHA1Final(SHA1Context);
+end;
+
+{==============================================================================}
+
+procedure MD4Transform(var Buf: array of LongInt; const Data: array of LongInt);
+var
+  A, B, C, D: LongInt;
+  function LRot32(a, b: longint): longint;
+  begin
+    Result:= (a shl b) or (a shr (32 - b));
+  end;
+begin
+  A := Buf[0];
+  B := Buf[1];
+  C := Buf[2];
+  D := Buf[3];
+
+  A:= LRot32(A + (D xor (B and (C xor D))) + Data[ 0], 3);
+  D:= LRot32(D + (C xor (A and (B xor C))) + Data[ 1], 7);
+  C:= LRot32(C + (B xor (D and (A xor B))) + Data[ 2], 11);
+  B:= LRot32(B + (A xor (C and (D xor A))) + Data[ 3], 19);
+  A:= LRot32(A + (D xor (B and (C xor D))) + Data[ 4], 3);
+  D:= LRot32(D + (C xor (A and (B xor C))) + Data[ 5], 7);
+  C:= LRot32(C + (B xor (D and (A xor B))) + Data[ 6], 11);
+  B:= LRot32(B + (A xor (C and (D xor A))) + Data[ 7], 19);
+  A:= LRot32(A + (D xor (B and (C xor D))) + Data[ 8], 3);
+  D:= LRot32(D + (C xor (A and (B xor C))) + Data[ 9], 7);
+  C:= LRot32(C + (B xor (D and (A xor B))) + Data[10], 11);
+  B:= LRot32(B + (A xor (C and (D xor A))) + Data[11], 19);
+  A:= LRot32(A + (D xor (B and (C xor D))) + Data[12], 3);
+  D:= LRot32(D + (C xor (A and (B xor C))) + Data[13], 7);
+  C:= LRot32(C + (B xor (D and (A xor B))) + Data[14], 11);
+  B:= LRot32(B + (A xor (C and (D xor A))) + Data[15], 19);
+
+  A:= LRot32(A + ((B and C) or (B and D) or (C and D)) + Data[ 0] + longint($5a827999), 3);
+  D:= LRot32(D + ((A and B) or (A and C) or (B and C)) + Data[ 4] + longint($5a827999), 5);
+  C:= LRot32(C + ((D and A) or (D and B) or (A and B)) + Data[ 8] + longint($5a827999), 9);
+  B:= LRot32(B + ((C and D) or (C and A) or (D and A)) + Data[12] + longint($5a827999), 13);
+  A:= LRot32(A + ((B and C) or (B and D) or (C and D)) + Data[ 1] + longint($5a827999), 3);
+  D:= LRot32(D + ((A and B) or (A and C) or (B and C)) + Data[ 5] + longint($5a827999), 5);
+  C:= LRot32(C + ((D and A) or (D and B) or (A and B)) + Data[ 9] + longint($5a827999), 9);
+  B:= LRot32(B + ((C and D) or (C and A) or (D and A)) + Data[13] + longint($5a827999), 13);
+  A:= LRot32(A + ((B and C) or (B and D) or (C and D)) + Data[ 2] + longint($5a827999), 3);
+  D:= LRot32(D + ((A and B) or (A and C) or (B and C)) + Data[ 6] + longint($5a827999), 5);
+  C:= LRot32(C + ((D and A) or (D and B) or (A and B)) + Data[10] + longint($5a827999), 9);
+  B:= LRot32(B + ((C and D) or (C and A) or (D and A)) + Data[14] + longint($5a827999), 13);
+  A:= LRot32(A + ((B and C) or (B and D) or (C and D)) + Data[ 3] + longint($5a827999), 3);
+  D:= LRot32(D + ((A and B) or (A and C) or (B and C)) + Data[ 7] + longint($5a827999), 5);
+  C:= LRot32(C + ((D and A) or (D and B) or (A and B)) + Data[11] + longint($5a827999), 9);
+  B:= LRot32(B + ((C and D) or (C and A) or (D and A)) + Data[15] + longint($5a827999), 13);
+
+  A:= LRot32(A + (B xor C xor D) + Data[ 0] + longint($6ed9eba1), 3);
+  D:= LRot32(D + (A xor B xor C) + Data[ 8] + longint($6ed9eba1), 9);
+  C:= LRot32(C + (D xor A xor B) + Data[ 4] + longint($6ed9eba1), 11);
+  B:= LRot32(B + (C xor D xor A) + Data[12] + longint($6ed9eba1), 15);
+  A:= LRot32(A + (B xor C xor D) + Data[ 2] + longint($6ed9eba1), 3);
+  D:= LRot32(D + (A xor B xor C) + Data[10] + longint($6ed9eba1), 9);
+  C:= LRot32(C + (D xor A xor B) + Data[ 6] + longint($6ed9eba1), 11);
+  B:= LRot32(B + (C xor D xor A) + Data[14] + longint($6ed9eba1), 15);
+  A:= LRot32(A + (B xor C xor D) + Data[ 1] + longint($6ed9eba1), 3);
+  D:= LRot32(D + (A xor B xor C) + Data[ 9] + longint($6ed9eba1), 9);
+  C:= LRot32(C + (D xor A xor B) + Data[ 5] + longint($6ed9eba1), 11);
+  B:= LRot32(B + (C xor D xor A) + Data[13] + longint($6ed9eba1), 15);
+  A:= LRot32(A + (B xor C xor D) + Data[ 3] + longint($6ed9eba1), 3);
+  D:= LRot32(D + (A xor B xor C) + Data[11] + longint($6ed9eba1), 9);
+  C:= LRot32(C + (D xor A xor B) + Data[ 7] + longint($6ed9eba1), 11);
+  B:= LRot32(B + (C xor D xor A) + Data[15] + longint($6ed9eba1), 15);
+
+  Inc(Buf[0], A);
+  Inc(Buf[1], B);
+  Inc(Buf[2], C);
+  Inc(Buf[3], D);
+end;
+
+{==============================================================================}
+
+function MD4(const Value: AnsiString): AnsiString;
+var
+  MDContext: TMDCtx;
+begin
+  MDInit(MDContext);
+  MDUpdate(MDContext, Value, @MD4Transform);
+  Result := MDFinal(MDContext, @MD4Transform);
+end;
+
+{==============================================================================}
+
+
+end.
diff --git a/Units/Synapse/synacrypt.pas b/Units/Synapse/synacrypt.pas
index dc43b9b..5a2641f 100644
--- a/Units/Synapse/synacrypt.pas
+++ b/Units/Synapse/synacrypt.pas
@@ -1,1228 +1,1228 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 001.000.001 |
-|==============================================================================|
-| Content: Encryption support                                                  |
-|==============================================================================|
-| Copyright (c)2007-2010, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2007-2010.                |
-| All Rights Reserved.                                                         |
-| Based on work of David Barton and Eric Young                                 |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{:@abstract(Encryption support)
-
-Implemented are DES and 3DES encryption/decryption by ECB, CBC, CFB-8bit,
- CFB-block, OFB and CTR methods.
-}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$Q-}
-{$R-}
-{$H+}
-
-{$IFDEF UNICODE}
-  {$WARN IMPLICIT_STRING_CAST OFF}
-  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
-{$ENDIF}
-
-unit synacrypt;
-
-interface
-
-uses
-  SysUtils, Classes, synautil;
-
-type
-  {:@abstract(Implementation of common routines for 64-bit block ciphers)
-
-   Do not use this class directly, use descendants only!}
-  TSynaBlockCipher= class(TObject)
-  protected
-    procedure InitKey(Key: AnsiString); virtual;
-  private
-    IV, CV: AnsiString;
-    procedure IncCounter;
-  public
-    {:Sets the IV to Value and performs a reset}
-    procedure SetIV(const Value: AnsiString); virtual;
-    {:Returns the current chaining information, not the actual IV}
-    function GetIV: AnsiString; virtual;
-    {:Reset any stored chaining information}
-    procedure Reset; virtual;
-    {:Encrypt a 64-bit block of data using the ECB method of encryption}
-    function EncryptECB(const InData: AnsiString): AnsiString; virtual;
-    {:Decrypt a 64-bit block of data using the ECB method of decryption}
-    function DecryptECB(const InData: AnsiString): AnsiString; virtual;
-    {:Encrypt data using the CBC method of encryption}
-    function EncryptCBC(const Indata: AnsiString): AnsiString; virtual;
-    {:Decrypt data using the CBC method of decryption}
-    function DecryptCBC(const Indata: AnsiString): AnsiString; virtual;
-    {:Encrypt data using the CFB (8 bit) method of encryption}
-    function EncryptCFB8bit(const Indata: AnsiString): AnsiString; virtual;
-    {:Decrypt data using the CFB (8 bit) method of decryption}
-    function DecryptCFB8bit(const Indata: AnsiString): AnsiString; virtual;
-    {:Encrypt data using the CFB (block) method of encryption}
-    function EncryptCFBblock(const Indata: AnsiString): AnsiString; virtual;
-    {:Decrypt data using the CFB (block) method of decryption}
-    function DecryptCFBblock(const Indata: AnsiString): AnsiString; virtual;
-    {:Encrypt data using the OFB method of encryption}
-    function EncryptOFB(const Indata: AnsiString): AnsiString; virtual;
-    {:Decrypt data using the OFB method of decryption}
-    function DecryptOFB(const Indata: AnsiString): AnsiString; virtual;
-    {:Encrypt data using the CTR method of encryption}
-    function EncryptCTR(const Indata: AnsiString): AnsiString; virtual;
-    {:Decrypt data using the CTR method of decryption}
-    function DecryptCTR(const Indata: AnsiString): AnsiString; virtual;
-    {:Create a encryptor/decryptor instance and initialize it by the Key.}
-    constructor Create(Key: AnsiString);
-  end;
-
-  {:@abstract(Datatype for holding one DES key data)
-
-    This data type is used internally.}
-  TDesKeyData = array[0..31] of integer;
-
-  {:@abstract(Implementation of common routines for DES encryption)
-
-   Do not use this class directly, use descendants only!}
-  TSynaCustomDes = class(TSynaBlockcipher)
-  protected
-    procedure DoInit(KeyB: AnsiString; var KeyData: TDesKeyData);
-    function EncryptBlock(const InData: AnsiString; var KeyData: TDesKeyData): AnsiString;
-    function DecryptBlock(const InData: AnsiString; var KeyData: TDesKeyData): AnsiString;
-  end;
-
-  {:@abstract(Implementation of DES encryption)}
-  TSynaDes= class(TSynaCustomDes)
-  protected
-    KeyData: TDesKeyData;
-    procedure InitKey(Key: AnsiString); override;
-  public
-    {:Encrypt a 64-bit block of data using the ECB method of encryption}
-    function EncryptECB(const InData: AnsiString): AnsiString; override;
-    {:Decrypt a 64-bit block of data using the ECB method of decryption}
-    function DecryptECB(const InData: AnsiString): AnsiString; override;
-  end;
-
-  {:@abstract(Implementation of 3DES encryption)}
-  TSyna3Des= class(TSynaCustomDes)
-  protected
-    KeyData: array[0..2] of TDesKeyData;
-    procedure InitKey(Key: AnsiString); override;
-  public
-    {:Encrypt a 64-bit block of data using the ECB method of encryption}
-    function EncryptECB(const InData: AnsiString): AnsiString; override;
-    {:Decrypt a 64-bit block of data using the ECB method of decryption}
-    function DecryptECB(const InData: AnsiString): AnsiString; override;
-  end;
-
-{:Call internal test of all DES encryptions. Returns @true if all is OK.}
-function TestDes: boolean;
-{:Call internal test of all 3DES encryptions. Returns @true if all is OK.}
-function Test3Des: boolean;
-
-{==============================================================================}
-implementation
-
-const
-  shifts2: array[0..15]of byte=
-    (0,0,1,1,1,1,1,1,0,1,1,1,1,1,1,0);
-
-  des_skb: array[0..7,0..63]of integer=(
-    (
-    (* for C bits (numbered as per FIPS 46) 1 2 3 4 5 6 *)
-    integer($00000000),integer($00000010),integer($20000000),integer($20000010),
-    integer($00010000),integer($00010010),integer($20010000),integer($20010010),
-    integer($00000800),integer($00000810),integer($20000800),integer($20000810),
-    integer($00010800),integer($00010810),integer($20010800),integer($20010810),
-    integer($00000020),integer($00000030),integer($20000020),integer($20000030),
-    integer($00010020),integer($00010030),integer($20010020),integer($20010030),
-    integer($00000820),integer($00000830),integer($20000820),integer($20000830),
-    integer($00010820),integer($00010830),integer($20010820),integer($20010830),
-    integer($00080000),integer($00080010),integer($20080000),integer($20080010),
-    integer($00090000),integer($00090010),integer($20090000),integer($20090010),
-    integer($00080800),integer($00080810),integer($20080800),integer($20080810),
-    integer($00090800),integer($00090810),integer($20090800),integer($20090810),
-    integer($00080020),integer($00080030),integer($20080020),integer($20080030),
-    integer($00090020),integer($00090030),integer($20090020),integer($20090030),
-    integer($00080820),integer($00080830),integer($20080820),integer($20080830),
-    integer($00090820),integer($00090830),integer($20090820),integer($20090830)
-    ),(
-    (* for C bits (numbered as per FIPS 46) 7 8 10 11 12 13 *)
-    integer($00000000),integer($02000000),integer($00002000),integer($02002000),
-    integer($00200000),integer($02200000),integer($00202000),integer($02202000),
-    integer($00000004),integer($02000004),integer($00002004),integer($02002004),
-    integer($00200004),integer($02200004),integer($00202004),integer($02202004),
-    integer($00000400),integer($02000400),integer($00002400),integer($02002400),
-    integer($00200400),integer($02200400),integer($00202400),integer($02202400),
-    integer($00000404),integer($02000404),integer($00002404),integer($02002404),
-    integer($00200404),integer($02200404),integer($00202404),integer($02202404),
-    integer($10000000),integer($12000000),integer($10002000),integer($12002000),
-    integer($10200000),integer($12200000),integer($10202000),integer($12202000),
-    integer($10000004),integer($12000004),integer($10002004),integer($12002004),
-    integer($10200004),integer($12200004),integer($10202004),integer($12202004),
-    integer($10000400),integer($12000400),integer($10002400),integer($12002400),
-    integer($10200400),integer($12200400),integer($10202400),integer($12202400),
-    integer($10000404),integer($12000404),integer($10002404),integer($12002404),
-    integer($10200404),integer($12200404),integer($10202404),integer($12202404)
-    ),(
-    (* for C bits (numbered as per FIPS 46) 14 15 16 17 19 20 *)
-    integer($00000000),integer($00000001),integer($00040000),integer($00040001),
-    integer($01000000),integer($01000001),integer($01040000),integer($01040001),
-    integer($00000002),integer($00000003),integer($00040002),integer($00040003),
-    integer($01000002),integer($01000003),integer($01040002),integer($01040003),
-    integer($00000200),integer($00000201),integer($00040200),integer($00040201),
-    integer($01000200),integer($01000201),integer($01040200),integer($01040201),
-    integer($00000202),integer($00000203),integer($00040202),integer($00040203),
-    integer($01000202),integer($01000203),integer($01040202),integer($01040203),
-    integer($08000000),integer($08000001),integer($08040000),integer($08040001),
-    integer($09000000),integer($09000001),integer($09040000),integer($09040001),
-    integer($08000002),integer($08000003),integer($08040002),integer($08040003),
-    integer($09000002),integer($09000003),integer($09040002),integer($09040003),
-    integer($08000200),integer($08000201),integer($08040200),integer($08040201),
-    integer($09000200),integer($09000201),integer($09040200),integer($09040201),
-    integer($08000202),integer($08000203),integer($08040202),integer($08040203),
-    integer($09000202),integer($09000203),integer($09040202),integer($09040203)
-    ),(
-    (* for C bits (numbered as per FIPS 46) 21 23 24 26 27 28 *)
-    integer($00000000),integer($00100000),integer($00000100),integer($00100100),
-    integer($00000008),integer($00100008),integer($00000108),integer($00100108),
-    integer($00001000),integer($00101000),integer($00001100),integer($00101100),
-    integer($00001008),integer($00101008),integer($00001108),integer($00101108),
-    integer($04000000),integer($04100000),integer($04000100),integer($04100100),
-    integer($04000008),integer($04100008),integer($04000108),integer($04100108),
-    integer($04001000),integer($04101000),integer($04001100),integer($04101100),
-    integer($04001008),integer($04101008),integer($04001108),integer($04101108),
-    integer($00020000),integer($00120000),integer($00020100),integer($00120100),
-    integer($00020008),integer($00120008),integer($00020108),integer($00120108),
-    integer($00021000),integer($00121000),integer($00021100),integer($00121100),
-    integer($00021008),integer($00121008),integer($00021108),integer($00121108),
-    integer($04020000),integer($04120000),integer($04020100),integer($04120100),
-    integer($04020008),integer($04120008),integer($04020108),integer($04120108),
-    integer($04021000),integer($04121000),integer($04021100),integer($04121100),
-    integer($04021008),integer($04121008),integer($04021108),integer($04121108)
-    ),(
-    (* for D bits (numbered as per FIPS 46) 1 2 3 4 5 6 *)
-    integer($00000000),integer($10000000),integer($00010000),integer($10010000),
-    integer($00000004),integer($10000004),integer($00010004),integer($10010004),
-    integer($20000000),integer($30000000),integer($20010000),integer($30010000),
-    integer($20000004),integer($30000004),integer($20010004),integer($30010004),
-    integer($00100000),integer($10100000),integer($00110000),integer($10110000),
-    integer($00100004),integer($10100004),integer($00110004),integer($10110004),
-    integer($20100000),integer($30100000),integer($20110000),integer($30110000),
-    integer($20100004),integer($30100004),integer($20110004),integer($30110004),
-    integer($00001000),integer($10001000),integer($00011000),integer($10011000),
-    integer($00001004),integer($10001004),integer($00011004),integer($10011004),
-    integer($20001000),integer($30001000),integer($20011000),integer($30011000),
-    integer($20001004),integer($30001004),integer($20011004),integer($30011004),
-    integer($00101000),integer($10101000),integer($00111000),integer($10111000),
-    integer($00101004),integer($10101004),integer($00111004),integer($10111004),
-    integer($20101000),integer($30101000),integer($20111000),integer($30111000),
-    integer($20101004),integer($30101004),integer($20111004),integer($30111004)
-    ),(
-    (* for D bits (numbered as per FIPS 46) 8 9 11 12 13 14 *)
-    integer($00000000),integer($08000000),integer($00000008),integer($08000008),
-    integer($00000400),integer($08000400),integer($00000408),integer($08000408),
-    integer($00020000),integer($08020000),integer($00020008),integer($08020008),
-    integer($00020400),integer($08020400),integer($00020408),integer($08020408),
-    integer($00000001),integer($08000001),integer($00000009),integer($08000009),
-    integer($00000401),integer($08000401),integer($00000409),integer($08000409),
-    integer($00020001),integer($08020001),integer($00020009),integer($08020009),
-    integer($00020401),integer($08020401),integer($00020409),integer($08020409),
-    integer($02000000),integer($0A000000),integer($02000008),integer($0A000008),
-    integer($02000400),integer($0A000400),integer($02000408),integer($0A000408),
-    integer($02020000),integer($0A020000),integer($02020008),integer($0A020008),
-    integer($02020400),integer($0A020400),integer($02020408),integer($0A020408),
-    integer($02000001),integer($0A000001),integer($02000009),integer($0A000009),
-    integer($02000401),integer($0A000401),integer($02000409),integer($0A000409),
-    integer($02020001),integer($0A020001),integer($02020009),integer($0A020009),
-    integer($02020401),integer($0A020401),integer($02020409),integer($0A020409)
-    ),(
-    (* for D bits (numbered as per FIPS 46) 16 17 18 19 20 21 *)
-    integer($00000000),integer($00000100),integer($00080000),integer($00080100),
-    integer($01000000),integer($01000100),integer($01080000),integer($01080100),
-    integer($00000010),integer($00000110),integer($00080010),integer($00080110),
-    integer($01000010),integer($01000110),integer($01080010),integer($01080110),
-    integer($00200000),integer($00200100),integer($00280000),integer($00280100),
-    integer($01200000),integer($01200100),integer($01280000),integer($01280100),
-    integer($00200010),integer($00200110),integer($00280010),integer($00280110),
-    integer($01200010),integer($01200110),integer($01280010),integer($01280110),
-    integer($00000200),integer($00000300),integer($00080200),integer($00080300),
-    integer($01000200),integer($01000300),integer($01080200),integer($01080300),
-    integer($00000210),integer($00000310),integer($00080210),integer($00080310),
-    integer($01000210),integer($01000310),integer($01080210),integer($01080310),
-    integer($00200200),integer($00200300),integer($00280200),integer($00280300),
-    integer($01200200),integer($01200300),integer($01280200),integer($01280300),
-    integer($00200210),integer($00200310),integer($00280210),integer($00280310),
-    integer($01200210),integer($01200310),integer($01280210),integer($01280310)
-    ),(
-    (* for D bits (numbered as per FIPS 46) 22 23 24 25 27 28 *)
-    integer($00000000),integer($04000000),integer($00040000),integer($04040000),
-    integer($00000002),integer($04000002),integer($00040002),integer($04040002),
-    integer($00002000),integer($04002000),integer($00042000),integer($04042000),
-    integer($00002002),integer($04002002),integer($00042002),integer($04042002),
-    integer($00000020),integer($04000020),integer($00040020),integer($04040020),
-    integer($00000022),integer($04000022),integer($00040022),integer($04040022),
-    integer($00002020),integer($04002020),integer($00042020),integer($04042020),
-    integer($00002022),integer($04002022),integer($00042022),integer($04042022),
-    integer($00000800),integer($04000800),integer($00040800),integer($04040800),
-    integer($00000802),integer($04000802),integer($00040802),integer($04040802),
-    integer($00002800),integer($04002800),integer($00042800),integer($04042800),
-    integer($00002802),integer($04002802),integer($00042802),integer($04042802),
-    integer($00000820),integer($04000820),integer($00040820),integer($04040820),
-    integer($00000822),integer($04000822),integer($00040822),integer($04040822),
-    integer($00002820),integer($04002820),integer($00042820),integer($04042820),
-    integer($00002822),integer($04002822),integer($00042822),integer($04042822)
-    ));
-
-  des_sptrans: array[0..7,0..63] of integer=(
-    (
-    (* nibble 0 *)
-    integer($02080800), integer($00080000), integer($02000002), integer($02080802),
-    integer($02000000), integer($00080802), integer($00080002), integer($02000002),
-    integer($00080802), integer($02080800), integer($02080000), integer($00000802),
-    integer($02000802), integer($02000000), integer($00000000), integer($00080002),
-    integer($00080000), integer($00000002), integer($02000800), integer($00080800),
-    integer($02080802), integer($02080000), integer($00000802), integer($02000800),
-    integer($00000002), integer($00000800), integer($00080800), integer($02080002),
-    integer($00000800), integer($02000802), integer($02080002), integer($00000000),
-    integer($00000000), integer($02080802), integer($02000800), integer($00080002),
-    integer($02080800), integer($00080000), integer($00000802), integer($02000800),
-    integer($02080002), integer($00000800), integer($00080800), integer($02000002),
-    integer($00080802), integer($00000002), integer($02000002), integer($02080000),
-    integer($02080802), integer($00080800), integer($02080000), integer($02000802),
-    integer($02000000), integer($00000802), integer($00080002), integer($00000000),
-    integer($00080000), integer($02000000), integer($02000802), integer($02080800),
-    integer($00000002), integer($02080002), integer($00000800), integer($00080802)
-    ),(
-    (* nibble 1 *)
-    integer($40108010), integer($00000000), integer($00108000), integer($40100000),
-    integer($40000010), integer($00008010), integer($40008000), integer($00108000),
-    integer($00008000), integer($40100010), integer($00000010), integer($40008000),
-    integer($00100010), integer($40108000), integer($40100000), integer($00000010),
-    integer($00100000), integer($40008010), integer($40100010), integer($00008000),
-    integer($00108010), integer($40000000), integer($00000000), integer($00100010),
-    integer($40008010), integer($00108010), integer($40108000), integer($40000010),
-    integer($40000000), integer($00100000), integer($00008010), integer($40108010),
-    integer($00100010), integer($40108000), integer($40008000), integer($00108010),
-    integer($40108010), integer($00100010), integer($40000010), integer($00000000),
-    integer($40000000), integer($00008010), integer($00100000), integer($40100010),
-    integer($00008000), integer($40000000), integer($00108010), integer($40008010),
-    integer($40108000), integer($00008000), integer($00000000), integer($40000010),
-    integer($00000010), integer($40108010), integer($00108000), integer($40100000),
-    integer($40100010), integer($00100000), integer($00008010), integer($40008000),
-    integer($40008010), integer($00000010), integer($40100000), integer($00108000)
-    ),(
-    (* nibble 2 *)
-    integer($04000001), integer($04040100), integer($00000100), integer($04000101),
-    integer($00040001), integer($04000000), integer($04000101), integer($00040100),
-    integer($04000100), integer($00040000), integer($04040000), integer($00000001),
-    integer($04040101), integer($00000101), integer($00000001), integer($04040001),
-    integer($00000000), integer($00040001), integer($04040100), integer($00000100),
-    integer($00000101), integer($04040101), integer($00040000), integer($04000001),
-    integer($04040001), integer($04000100), integer($00040101), integer($04040000),
-    integer($00040100), integer($00000000), integer($04000000), integer($00040101),
-    integer($04040100), integer($00000100), integer($00000001), integer($00040000),
-    integer($00000101), integer($00040001), integer($04040000), integer($04000101),
-    integer($00000000), integer($04040100), integer($00040100), integer($04040001),
-    integer($00040001), integer($04000000), integer($04040101), integer($00000001),
-    integer($00040101), integer($04000001), integer($04000000), integer($04040101),
-    integer($00040000), integer($04000100), integer($04000101), integer($00040100),
-    integer($04000100), integer($00000000), integer($04040001), integer($00000101),
-    integer($04000001), integer($00040101), integer($00000100), integer($04040000)
-    ),(
-    (* nibble 3 *)
-    integer($00401008), integer($10001000), integer($00000008), integer($10401008),
-    integer($00000000), integer($10400000), integer($10001008), integer($00400008),
-    integer($10401000), integer($10000008), integer($10000000), integer($00001008),
-    integer($10000008), integer($00401008), integer($00400000), integer($10000000),
-    integer($10400008), integer($00401000), integer($00001000), integer($00000008),
-    integer($00401000), integer($10001008), integer($10400000), integer($00001000),
-    integer($00001008), integer($00000000), integer($00400008), integer($10401000),
-    integer($10001000), integer($10400008), integer($10401008), integer($00400000),
-    integer($10400008), integer($00001008), integer($00400000), integer($10000008),
-    integer($00401000), integer($10001000), integer($00000008), integer($10400000),
-    integer($10001008), integer($00000000), integer($00001000), integer($00400008),
-    integer($00000000), integer($10400008), integer($10401000), integer($00001000),
-    integer($10000000), integer($10401008), integer($00401008), integer($00400000),
-    integer($10401008), integer($00000008), integer($10001000), integer($00401008),
-    integer($00400008), integer($00401000), integer($10400000), integer($10001008),
-    integer($00001008), integer($10000000), integer($10000008), integer($10401000)
-    ),(
-    (* nibble 4 *)
-    integer($08000000), integer($00010000), integer($00000400), integer($08010420),
-    integer($08010020), integer($08000400), integer($00010420), integer($08010000),
-    integer($00010000), integer($00000020), integer($08000020), integer($00010400),
-    integer($08000420), integer($08010020), integer($08010400), integer($00000000),
-    integer($00010400), integer($08000000), integer($00010020), integer($00000420),
-    integer($08000400), integer($00010420), integer($00000000), integer($08000020),
-    integer($00000020), integer($08000420), integer($08010420), integer($00010020),
-    integer($08010000), integer($00000400), integer($00000420), integer($08010400),
-    integer($08010400), integer($08000420), integer($00010020), integer($08010000),
-    integer($00010000), integer($00000020), integer($08000020), integer($08000400),
-    integer($08000000), integer($00010400), integer($08010420), integer($00000000),
-    integer($00010420), integer($08000000), integer($00000400), integer($00010020),
-    integer($08000420), integer($00000400), integer($00000000), integer($08010420),
-    integer($08010020), integer($08010400), integer($00000420), integer($00010000),
-    integer($00010400), integer($08010020), integer($08000400), integer($00000420),
-    integer($00000020), integer($00010420), integer($08010000), integer($08000020)
-    ),(
-    (* nibble 5 *)
-    integer($80000040), integer($00200040), integer($00000000), integer($80202000),
-    integer($00200040), integer($00002000), integer($80002040), integer($00200000),
-    integer($00002040), integer($80202040), integer($00202000), integer($80000000),
-    integer($80002000), integer($80000040), integer($80200000), integer($00202040),
-    integer($00200000), integer($80002040), integer($80200040), integer($00000000),
-    integer($00002000), integer($00000040), integer($80202000), integer($80200040),
-    integer($80202040), integer($80200000), integer($80000000), integer($00002040),
-    integer($00000040), integer($00202000), integer($00202040), integer($80002000),
-    integer($00002040), integer($80000000), integer($80002000), integer($00202040),
-    integer($80202000), integer($00200040), integer($00000000), integer($80002000),
-    integer($80000000), integer($00002000), integer($80200040), integer($00200000),
-    integer($00200040), integer($80202040), integer($00202000), integer($00000040),
-    integer($80202040), integer($00202000), integer($00200000), integer($80002040),
-    integer($80000040), integer($80200000), integer($00202040), integer($00000000),
-    integer($00002000), integer($80000040), integer($80002040), integer($80202000),
-    integer($80200000), integer($00002040), integer($00000040), integer($80200040)
-    ),(
-    (* nibble 6 *)
-    integer($00004000), integer($00000200), integer($01000200), integer($01000004),
-    integer($01004204), integer($00004004), integer($00004200), integer($00000000),
-    integer($01000000), integer($01000204), integer($00000204), integer($01004000),
-    integer($00000004), integer($01004200), integer($01004000), integer($00000204),
-    integer($01000204), integer($00004000), integer($00004004), integer($01004204),
-    integer($00000000), integer($01000200), integer($01000004), integer($00004200),
-    integer($01004004), integer($00004204), integer($01004200), integer($00000004),
-    integer($00004204), integer($01004004), integer($00000200), integer($01000000),
-    integer($00004204), integer($01004000), integer($01004004), integer($00000204),
-    integer($00004000), integer($00000200), integer($01000000), integer($01004004),
-    integer($01000204), integer($00004204), integer($00004200), integer($00000000),
-    integer($00000200), integer($01000004), integer($00000004), integer($01000200),
-    integer($00000000), integer($01000204), integer($01000200), integer($00004200),
-    integer($00000204), integer($00004000), integer($01004204), integer($01000000),
-    integer($01004200), integer($00000004), integer($00004004), integer($01004204),
-    integer($01000004), integer($01004200), integer($01004000), integer($00004004)
-    ),(
-    (* nibble 7 *)
-    integer($20800080), integer($20820000), integer($00020080), integer($00000000),
-    integer($20020000), integer($00800080), integer($20800000), integer($20820080),
-    integer($00000080), integer($20000000), integer($00820000), integer($00020080),
-    integer($00820080), integer($20020080), integer($20000080), integer($20800000),
-    integer($00020000), integer($00820080), integer($00800080), integer($20020000),
-    integer($20820080), integer($20000080), integer($00000000), integer($00820000),
-    integer($20000000), integer($00800000), integer($20020080), integer($20800080),
-    integer($00800000), integer($00020000), integer($20820000), integer($00000080),
-    integer($00800000), integer($00020000), integer($20000080), integer($20820080),
-    integer($00020080), integer($20000000), integer($00000000), integer($00820000),
-    integer($20800080), integer($20020080), integer($20020000), integer($00800080),
-    integer($20820000), integer($00000080), integer($00800080), integer($20020000),
-    integer($20820080), integer($00800000), integer($20800000), integer($20000080),
-    integer($00820000), integer($00020080), integer($20020080), integer($20800000),
-    integer($00000080), integer($20820000), integer($00820080), integer($00000000),
-    integer($20000000), integer($20800080), integer($00020000), integer($00820080)
-    ));
-
-{==============================================================================}
-
-function XorString(Indata1, Indata2: AnsiString): AnsiString;
-var
-  i: integer;
-begin
-  Indata2 := PadString(Indata2, length(Indata1), #0);
-  Result := '';
-  for i := 1 to length(Indata1) do
-    Result := Result + AnsiChar(ord(Indata1[i]) xor ord(Indata2[i]));
-end;
-
-procedure hperm_op(var a, t: integer; n, m: integer);
-begin
-  t:= ((a shl (16 - n)) xor a) and m;
-  a:= a xor t xor (t shr (16 - n));
-end;
-
-procedure perm_op(var a, b, t: integer; n, m: integer);
-begin
-  t:= ((a shr n) xor b) and m;
-  b:= b xor t;
-  a:= a xor (t shl n);
-end;
-
-{==============================================================================}
-procedure TSynaBlockCipher.IncCounter;
-var
-  i: integer;
-begin
-  Inc(CV[8]);
-  i:= 7;
-  while (i> 0) and (CV[i + 1] = #0) do
-  begin
-    Inc(CV[i]);
-    Dec(i);
-  end;
-end;
-
-procedure TSynaBlockCipher.Reset;
-begin
-  CV := IV;
-end;
-
-procedure TSynaBlockCipher.InitKey(Key: AnsiString);
-begin
-end;
-
-procedure TSynaBlockCipher.SetIV(const Value: AnsiString);
-begin
-  IV := PadString(Value, 8, #0);
-  Reset;
-end;
-
-function TSynaBlockCipher.GetIV: AnsiString;
-begin
-  Result := CV;
-end;
-
-function TSynaBlockCipher.EncryptECB(const InData: AnsiString): AnsiString;
-begin
-  Result := InData;
-end;
-
-function TSynaBlockCipher.DecryptECB(const InData: AnsiString): AnsiString;
-begin
-  Result := InData;
-end;
-
-function TSynaBlockCipher.EncryptCBC(const Indata: AnsiString): AnsiString;
-var
-  i: integer;
-  s: ansistring;
-  l: integer;
-begin
-  Result := '';
-  l := Length(InData);
-  for i:= 1 to (l div 8) do
-  begin
-    s := copy(Indata, (i - 1) * 8 + 1, 8);
-    s := XorString(s, CV);
-    s := EncryptECB(s);
-    CV := s;
-    Result := Result + s;
-  end;
-  if (l mod 8)<> 0 then
-  begin
-    CV := EncryptECB(CV);
-    s := copy(Indata, (l div 8) * 8 + 1, l mod 8);
-    s := XorString(s, CV);
-    Result := Result + s;
-  end;
-end;
-
-function TSynaBlockCipher.DecryptCBC(const Indata: AnsiString): AnsiString;
-var
-  i: integer;
-  s, temp: ansistring;
-  l: integer;
-begin
-  Result := '';
-  l := Length(InData);
-  for i:= 1 to (l div 8) do
-  begin
-    s := copy(Indata, (i - 1) * 8 + 1, 8);
-    temp := s;
-    s := DecryptECB(s);
-    s := XorString(s, CV);
-    Result := Result + s;
-    CV := Temp;
-  end;
-  if (l mod 8)<> 0 then
-  begin
-    CV := EncryptECB(CV);
-    s := copy(Indata, (l div 8) * 8 + 1, l mod 8);
-    s := XorString(s, CV);
-    Result := Result + s;
-  end;
-end;
-
-function TSynaBlockCipher.EncryptCFB8bit(const Indata: AnsiString): AnsiString;
-var
-  i: integer;
-  Temp: AnsiString;
-  c: AnsiChar;
-begin
-  Result := '';
-  for i:= 1 to Length(Indata) do
-  begin
-    Temp := EncryptECB(CV);
-    c := AnsiChar(ord(InData[i]) xor ord(temp[1]));
-    Result := Result + c;
-    Delete(CV, 1, 1);
-    CV := CV + c;
-  end;
-end;
-
-function TSynaBlockCipher.DecryptCFB8bit(const Indata: AnsiString): AnsiString;
-var
-  i: integer;
-  Temp: AnsiString;
-  c: AnsiChar;
-begin
-  Result := '';
-  for i:= 1 to length(Indata) do
-  begin
-    c:= Indata[i];
-    Temp := EncryptECB(CV);
-    Result := Result + AnsiChar(ord(InData[i]) xor ord(temp[1]));
-    Delete(CV, 1, 1);
-    CV := CV + c;
-  end;
-end;
-
-function TSynaBlockCipher.EncryptCFBblock(const Indata: AnsiString): AnsiString;
-var
-  i: integer;
-  s: AnsiString;
-  l: integer;
-begin
-  Result := '';
-  l := Length(InData);
-  for i:= 1 to (l div 8) do
-  begin
-    CV := EncryptECB(CV);
-    s := copy(Indata, (i - 1) * 8 + 1, 8);
-    s := XorString(s, CV);
-    Result := Result + s;
-    CV := s;
-  end;
-  if (l mod 8)<> 0 then
-  begin
-    CV := EncryptECB(CV);
-    s := copy(Indata, (l div 8) * 8 + 1, l mod 8);
-    s := XorString(s, CV);
-    Result := Result + s;
-  end;
-end;
-
-function TSynaBlockCipher.DecryptCFBblock(const Indata: AnsiString): AnsiString;
-var
-  i: integer;
-  S, Temp: AnsiString;
-  l: integer;
-begin
-  Result := '';
-  l := Length(InData);
-  for i:= 1 to (l div 8) do
-  begin
-    s := copy(Indata, (i - 1) * 8 + 1, 8);
-    Temp := s;
-    CV := EncryptECB(CV);
-    s := XorString(s, CV);
-    Result := result + s;
-    CV := temp;
-  end;
-  if (l mod 8)<> 0 then
-  begin
-    CV := EncryptECB(CV);
-    s := copy(Indata, (l div 8) * 8 + 1, l mod 8);
-    s := XorString(s, CV);
-    Result := Result + s;
-  end;
-end;
-
-function TSynaBlockCipher.EncryptOFB(const Indata: AnsiString): AnsiString;
-var
-  i: integer;
-  s: AnsiString;
-  l: integer;
-begin
-  Result := '';
-  l := Length(InData);
-  for i:= 1 to (l div 8) do
-  begin
-    CV := EncryptECB(CV);
-    s := copy(Indata, (i - 1) * 8 + 1, 8);
-    s := XorString(s, CV);
-    Result := Result + s;
-  end;
-  if (l mod 8)<> 0 then
-  begin
-    CV := EncryptECB(CV);
-    s := copy(Indata, (l div 8) * 8 + 1, l mod 8);
-    s := XorString(s, CV);
-    Result := Result + s;
-  end;
-end;
-
-function TSynaBlockCipher.DecryptOFB(const Indata: AnsiString): AnsiString;
-var
-  i: integer;
-  s: AnsiString;
-  l: integer;
-begin
-  Result := '';
-  l := Length(InData);
-  for i:= 1 to (l div 8) do
-  begin
-    Cv := EncryptECB(CV);
-    s := copy(Indata, (i - 1) * 8 + 1, 8);
-    s := XorString(s, CV);
-    Result := Result + s;
-  end;
-  if (l mod 8)<> 0 then
-  begin
-    CV := EncryptECB(CV);
-    s := copy(Indata, (l div 8) * 8 + 1, l mod 8);
-    s := XorString(s, CV);
-    Result := Result + s;
-  end;
-end;
-
-function TSynaBlockCipher.EncryptCTR(const Indata: AnsiString): AnsiString;
-var
-  temp: AnsiString;
-  i: integer;
-  s: AnsiString;
-  l: integer;
-begin
-  Result := '';
-  l := Length(InData);
-  for i:= 1 to (l div 8) do
-  begin
-    temp := EncryptECB(CV);
-    IncCounter;
-    s := copy(Indata, (i - 1) * 8 + 1, 8);
-    s := XorString(s, temp);
-    Result := Result + s;
-  end;
-  if (l mod 8)<> 0 then
-  begin
-    temp := EncryptECB(CV);
-    IncCounter;
-    s := copy(Indata, (l div 8) * 8 + 1, l mod 8);
-    s := XorString(s, temp);
-    Result := Result + s;
-  end;
-end;
-
-function TSynaBlockCipher.DecryptCTR(const Indata: AnsiString): AnsiString;
-var
-  temp: AnsiString;
-  s: AnsiString;
-  i: integer;
-  l: integer;
-begin
-  Result := '';
-  l := Length(InData);
-  for i:= 1 to (l div 8) do
-  begin
-    temp := EncryptECB(CV);
-    IncCounter;
-    s := copy(Indata, (i - 1) * 8 + 1, 8);
-    s := XorString(s, temp);
-    Result := Result + s;
-  end;
-  if (l mod 8)<> 0 then
-  begin
-    temp := EncryptECB(CV);
-    IncCounter;
-    s := copy(Indata, (l div 8) * 8 + 1, l mod 8);
-    s := XorString(s, temp);
-    Result := Result + s;
-  end;
-end;
-
-constructor TSynaBlockCipher.Create(Key: AnsiString);
-begin
-  inherited Create;
-  InitKey(Key);
-  IV := StringOfChar(#0, 8);
-  IV := EncryptECB(IV);
-  Reset;
-end;
-
-{==============================================================================}
-
-procedure TSynaCustomDes.DoInit(KeyB: AnsiString; var KeyData: TDesKeyData);
-var
-  c, d, t, s, t2, i: integer;
-begin
-  KeyB := PadString(KeyB, 8, #0);
-  c:= ord(KeyB[1]) or (ord(KeyB[2]) shl 8) or (ord(KeyB[3]) shl 16) or (ord(KeyB[4]) shl 24);
-  d:= ord(KeyB[5]) or (ord(KeyB[6]) shl 8) or (ord(KeyB[7]) shl 16) or (ord(KeyB[8]) shl 24);
-  perm_op(d,c,t,4,integer($0f0f0f0f));
-  hperm_op(c,t,integer(-2),integer($cccc0000));
-  hperm_op(d,t,integer(-2),integer($cccc0000));
-  perm_op(d,c,t,1,integer($55555555));
-  perm_op(c,d,t,8,integer($00ff00ff));
-  perm_op(d,c,t,1,integer($55555555));
-  d:= ((d and $ff) shl 16) or (d and $ff00) or ((d and $ff0000) shr 16) or
-        ((c and integer($f0000000)) shr 4);
-  c:= c and $fffffff;
-  for i:= 0 to 15 do
-  begin
-    if shifts2[i]<> 0 then
-    begin
-      c:= ((c shr 2) or (c shl 26));
-      d:= ((d shr 2) or (d shl 26));
-    end
-    else
-    begin
-      c:= ((c shr 1) or (c shl 27));
-      d:= ((d shr 1) or (d shl 27));
-    end;
-    c:= c and $fffffff;
-    d:= d and $fffffff;
-    s:= des_skb[0,c and $3f] or
-        des_skb[1,((c shr  6) and $03) or ((c shr  7) and $3c)] or
-        des_skb[2,((c shr 13) and $0f) or ((c shr 14) and $30)] or
-        des_skb[3,((c shr 20) and $01) or ((c shr 21) and $06) or ((c shr 22) and $38)];
-    t:= des_skb[4,d and $3f] or
-        des_skb[5,((d shr  7) and $03) or ((d shr  8) and $3c)] or
-        des_skb[6, (d shr 15) and $3f                         ] or
-        des_skb[7,((d shr 21) and $0f) or ((d shr 22) and $30)];
-    t2:= ((t shl 16) or (s and $ffff));
-    KeyData[(i shl 1)]:= ((t2 shl 2) or (t2 shr 30));
-    t2:= ((s shr 16) or (t and integer($ffff0000)));
-    KeyData[(i shl 1)+1]:= ((t2 shl 6) or (t2 shr 26));
-  end;
-end;
-
-function TSynaCustomDes.EncryptBlock(const InData: AnsiString; var KeyData: TDesKeyData): AnsiString;
-var
-  l, r, t, u: integer;
-  i: longint;
-begin
-  r := Swapbytes(DecodeLongint(Indata, 1));
-  l := swapbytes(DecodeLongint(Indata, 5));
-  t:= ((l shr 4) xor r) and $0f0f0f0f;
-  r:= r xor t;
-  l:= l xor (t shl 4);
-  t:= ((r shr 16) xor l) and $0000ffff;
-  l:= l xor t;
-  r:= r xor (t shl 16);
-  t:= ((l shr 2) xor r) and $33333333;
-  r:= r xor t;
-  l:= l xor (t shl 2);
-  t:= ((r shr 8) xor l) and $00ff00ff;
-  l:= l xor t;
-  r:= r xor (t shl 8);
-  t:= ((l shr 1) xor r) and $55555555;
-  r:= r xor t;
-  l:= l xor (t shl 1);
-  r:= (r shr 29) or (r shl 3);
-  l:= (l shr 29) or (l shl 3);
-  i:= 0;
-  while i< 32 do
-  begin
-    u:= r xor KeyData[i  ];
-    t:= r xor KeyData[i+1];
-    t:= (t shr 4) or (t shl 28);
-    l:= l xor des_SPtrans[0,(u shr  2) and $3f] xor
-              des_SPtrans[2,(u shr 10) and $3f] xor
-              des_SPtrans[4,(u shr 18) and $3f] xor
-              des_SPtrans[6,(u shr 26) and $3f] xor
-              des_SPtrans[1,(t shr  2) and $3f] xor
-              des_SPtrans[3,(t shr 10) and $3f] xor
-              des_SPtrans[5,(t shr 18) and $3f] xor
-              des_SPtrans[7,(t shr 26) and $3f];
-    u:= l xor KeyData[i+2];
-    t:= l xor KeyData[i+3];
-    t:= (t shr 4) or (t shl 28);
-    r:= r xor des_SPtrans[0,(u shr  2) and $3f] xor
-              des_SPtrans[2,(u shr 10) and $3f] xor
-              des_SPtrans[4,(u shr 18) and $3f] xor
-              des_SPtrans[6,(u shr 26) and $3f] xor
-              des_SPtrans[1,(t shr  2) and $3f] xor
-              des_SPtrans[3,(t shr 10) and $3f] xor
-              des_SPtrans[5,(t shr 18) and $3f] xor
-              des_SPtrans[7,(t shr 26) and $3f];
-    u:= r xor KeyData[i+4];
-    t:= r xor KeyData[i+5];
-    t:= (t shr 4) or (t shl 28);
-    l:= l xor des_SPtrans[0,(u shr  2) and $3f] xor
-              des_SPtrans[2,(u shr 10) and $3f] xor
-              des_SPtrans[4,(u shr 18) and $3f] xor
-              des_SPtrans[6,(u shr 26) and $3f] xor
-              des_SPtrans[1,(t shr  2) and $3f] xor
-              des_SPtrans[3,(t shr 10) and $3f] xor
-              des_SPtrans[5,(t shr 18) and $3f] xor
-              des_SPtrans[7,(t shr 26) and $3f];
-    u:= l xor KeyData[i+6];
-    t:= l xor KeyData[i+7];
-    t:= (t shr 4) or (t shl 28);
-    r:= r xor des_SPtrans[0,(u shr  2) and $3f] xor
-              des_SPtrans[2,(u shr 10) and $3f] xor
-              des_SPtrans[4,(u shr 18) and $3f] xor
-              des_SPtrans[6,(u shr 26) and $3f] xor
-              des_SPtrans[1,(t shr  2) and $3f] xor
-              des_SPtrans[3,(t shr 10) and $3f] xor
-              des_SPtrans[5,(t shr 18) and $3f] xor
-              des_SPtrans[7,(t shr 26) and $3f];
-    Inc(i,8);
-  end;
-  r:= (r shr 3) or (r shl 29);
-  l:= (l shr 3) or (l shl 29);
-  t:= ((r shr 1) xor l) and $55555555;
-  l:= l xor t;
-  r:= r xor (t shl 1);
-  t:= ((l shr 8) xor r) and $00ff00ff;
-  r:= r xor t;
-  l:= l xor (t shl 8);
-  t:= ((r shr 2) xor l) and $33333333;
-  l:= l xor t;
-  r:= r xor (t shl 2);
-  t:= ((l shr 16) xor r) and $0000ffff;
-  r:= r xor t;
-  l:= l xor (t shl 16);
-  t:= ((r shr 4) xor l) and $0f0f0f0f;
-  l:= l xor t;
-  r:= r xor (t shl 4);
-  Result := CodeLongInt(Swapbytes(l)) + CodeLongInt(Swapbytes(r));
-end;
-
-function TSynaCustomDes.DecryptBlock(const InData: AnsiString; var KeyData: TDesKeyData): AnsiString;
-var
-  l, r, t, u: integer;
-  i: longint;
-begin
-  r := Swapbytes(DecodeLongint(Indata, 1));
-  l := Swapbytes(DecodeLongint(Indata, 5));
-  t:= ((l shr 4) xor r) and $0f0f0f0f;
-  r:= r xor t;
-  l:= l xor (t shl 4);
-  t:= ((r shr 16) xor l) and $0000ffff;
-  l:= l xor t;
-  r:= r xor (t shl 16);
-  t:= ((l shr 2) xor r) and $33333333;
-  r:= r xor t;
-  l:= l xor (t shl 2);
-  t:= ((r shr 8) xor l) and $00ff00ff;
-  l:= l xor t;
-  r:= r xor (t shl 8);
-  t:= ((l shr 1) xor r) and $55555555;
-  r:= r xor t;
-  l:= l xor (t shl 1);
-  r:= (r shr 29) or (r shl 3);
-  l:= (l shr 29) or (l shl 3);
-  i:= 30;
-  while i> 0 do
-  begin
-    u:= r xor KeyData[i  ];
-    t:= r xor KeyData[i+1];
-    t:= (t shr 4) or (t shl 28);
-    l:= l xor des_SPtrans[0,(u shr  2) and $3f] xor
-              des_SPtrans[2,(u shr 10) and $3f] xor
-              des_SPtrans[4,(u shr 18) and $3f] xor
-              des_SPtrans[6,(u shr 26) and $3f] xor
-              des_SPtrans[1,(t shr  2) and $3f] xor
-              des_SPtrans[3,(t shr 10) and $3f] xor
-              des_SPtrans[5,(t shr 18) and $3f] xor
-              des_SPtrans[7,(t shr 26) and $3f];
-    u:= l xor KeyData[i-2];
-    t:= l xor KeyData[i-1];
-    t:= (t shr 4) or (t shl 28);
-    r:= r xor des_SPtrans[0,(u shr  2) and $3f] xor
-              des_SPtrans[2,(u shr 10) and $3f] xor
-              des_SPtrans[4,(u shr 18) and $3f] xor
-              des_SPtrans[6,(u shr 26) and $3f] xor
-              des_SPtrans[1,(t shr  2) and $3f] xor
-              des_SPtrans[3,(t shr 10) and $3f] xor
-              des_SPtrans[5,(t shr 18) and $3f] xor
-              des_SPtrans[7,(t shr 26) and $3f];
-    u:= r xor KeyData[i-4];
-    t:= r xor KeyData[i-3];
-    t:= (t shr 4) or (t shl 28);
-    l:= l xor des_SPtrans[0,(u shr  2) and $3f] xor
-              des_SPtrans[2,(u shr 10) and $3f] xor
-              des_SPtrans[4,(u shr 18) and $3f] xor
-              des_SPtrans[6,(u shr 26) and $3f] xor
-              des_SPtrans[1,(t shr  2) and $3f] xor
-              des_SPtrans[3,(t shr 10) and $3f] xor
-              des_SPtrans[5,(t shr 18) and $3f] xor
-              des_SPtrans[7,(t shr 26) and $3f];
-    u:= l xor KeyData[i-6];
-    t:= l xor KeyData[i-5];
-    t:= (t shr 4) or (t shl 28);
-    r:= r xor des_SPtrans[0,(u shr  2) and $3f] xor
-              des_SPtrans[2,(u shr 10) and $3f] xor
-              des_SPtrans[4,(u shr 18) and $3f] xor
-              des_SPtrans[6,(u shr 26) and $3f] xor
-              des_SPtrans[1,(t shr  2) and $3f] xor
-              des_SPtrans[3,(t shr 10) and $3f] xor
-              des_SPtrans[5,(t shr 18) and $3f] xor
-              des_SPtrans[7,(t shr 26) and $3f];
-    Dec(i,8);
-  end;
-  r:= (r shr 3) or (r shl 29);
-  l:= (l shr 3) or (l shl 29);
-  t:= ((r shr 1) xor l) and $55555555;
-  l:= l xor t;
-  r:= r xor (t shl 1);
-  t:= ((l shr 8) xor r) and $00ff00ff;
-  r:= r xor t;
-  l:= l xor (t shl 8);
-  t:= ((r shr 2) xor l) and $33333333;
-  l:= l xor t;
-  r:= r xor (t shl 2);
-  t:= ((l shr 16) xor r) and $0000ffff;
-  r:= r xor t;
-  l:= l xor (t shl 16);
-  t:= ((r shr 4) xor l) and $0f0f0f0f;
-  l:= l xor t;
-  r:= r xor (t shl 4);
-  Result := CodeLongInt(Swapbytes(l)) + CodeLongInt(Swapbytes(r));
-end;
-
-{==============================================================================}
-
-procedure TSynaDes.InitKey(Key: AnsiString);
-begin
-  Key := PadString(Key, 8, #0);
-  DoInit(Key,KeyData);
-end;
-
-function TSynaDes.EncryptECB(const InData: AnsiString): AnsiString;
-begin
-  Result := EncryptBlock(InData,KeyData);
-end;
-
-function TSynaDes.DecryptECB(const InData: AnsiString): AnsiString;
-begin
-  Result := DecryptBlock(Indata,KeyData);
-end;
-
-{==============================================================================}
-
-procedure TSyna3Des.InitKey(Key: AnsiString);
-var
-  Size: integer;
-  n: integer;
-begin
-  Size := length(Key);
-  key := PadString(key, 3 * 8, #0);
-  DoInit(Copy(key, 1, 8),KeyData[0]);
-  DoInit(Copy(key, 9, 8),KeyData[1]);
-  if Size > 16 then
-    DoInit(Copy(key, 17, 8),KeyData[2])
-  else
-    for n := 0 to high(KeyData[0]) do
-      KeyData[2][n] := Keydata[0][n];
-end;
-
-function TSyna3Des.EncryptECB(const InData: AnsiString): AnsiString;
-begin
-  Result := EncryptBlock(Indata,KeyData[0]);
-  Result := DecryptBlock(Result,KeyData[1]);
-  Result := EncryptBlock(Result,KeyData[2]);
-end;
-
-function TSyna3Des.DecryptECB(const InData: AnsiString): AnsiString;
-begin
-  Result := DecryptBlock(InData,KeyData[2]);
-  Result := EncryptBlock(Result,KeyData[1]);
-  Result := DecryptBlock(Result,KeyData[0]);
-end;
-
-{==============================================================================}
-
-function TestDes: boolean;
-var
-  des: TSynaDes;
-  s, t: string;
-const
-  key = '01234567';
-  data1= '01234567';
-  data2= '0123456789abcdefghij';
-begin
-  //ECB
-  des := TSynaDes.Create(key);
-  try
-    s := des.EncryptECB(data1);
-    t := strtohex(s);
-    result := t = 'c50ad028c6da9800';
-    s := des.DecryptECB(s);
-    result := result and (data1 = s);
-  finally
-    des.free;
-  end;
-  //CBC
-  des := TSynaDes.Create(key);
-  try
-    s := des.EncryptCBC(data2);
-    t := strtohex(s);
-    result := result and (t = 'eec50f6353115ad6dee90a22ed1b6a88a0926e35');
-    des.Reset;
-    s := des.DecryptCBC(s);
-    result := result and (data2 = s);
-  finally
-    des.free;
-  end;
-  //CFB-8bit
-  des := TSynaDes.Create(key);
-  try
-    s := des.EncryptCFB8bit(data2);
-    t := strtohex(s);
-    result := result and (t = 'eb6aa12c2f0ff634b4dfb6da6cb2af8f9c5c1452');
-    des.Reset;
-    s := des.DecryptCFB8bit(s);
-    result := result and (data2 = s);
-  finally
-    des.free;
-  end;
-  //CFB-block
-  des := TSynaDes.Create(key);
-  try
-    s := des.EncryptCFBblock(data2);
-    t := strtohex(s);
-    result := result and (t = 'ebdbbaa7f9286cdec28605e07f9b7f3be1053257');
-    des.Reset;
-    s := des.DecryptCFBblock(s);
-    result := result and (data2 = s);
-  finally
-    des.free;
-  end;
-  //OFB
-  des := TSynaDes.Create(key);
-  try
-    s := des.EncryptOFB(data2);
-    t := strtohex(s);
-    result := result and (t = 'ebdbbaa7f9286cdee0b8b3798c4c34baac87dbdc');
-    des.Reset;
-    s := des.DecryptOFB(s);
-    result := result and (data2 = s);
-  finally
-    des.free;
-  end;
-  //CTR
-  des := TSynaDes.Create(key);
-  try
-    s := des.EncryptCTR(data2);
-    t := strtohex(s);
-    result := result and (t = 'ebdbbaa7f9286cde0dd20b45f3afd9aa1b91b87e');
-    des.Reset;
-    s := des.DecryptCTR(s);
-    result := result and (data2 = s);
-  finally
-    des.free;
-  end;
-end;
-
-function Test3Des: boolean;
-var
-  des: TSyna3Des;
-  s, t: string;
-const
-  key = '0123456789abcdefghijklmn';
-  data1= '01234567';
-  data2= '0123456789abcdefghij';
-begin
-  //ECB
-  des := TSyna3Des.Create(key);
-  try
-    s := des.EncryptECB(data1);
-    t := strtohex(s);
-    result := t = 'e0dee91008dc460c';
-    s := des.DecryptECB(s);
-    result := result and (data1 = s);
-  finally
-    des.free;
-  end;
-  //CBC
-  des := TSyna3Des.Create(key);
-  try
-    s := des.EncryptCBC(data2);
-    t := strtohex(s);
-    result := result and (t = 'ee844a2a4f49c01b91a1599b8eba29128c1ad87a');
-    des.Reset;
-    s := des.DecryptCBC(s);
-    result := result and (data2 = s);
-  finally
-    des.free;
-  end;
-  //CFB-8bit
-  des := TSyna3Des.Create(key);
-  try
-    s := des.EncryptCFB8bit(data2);
-    t := strtohex(s);
-    result := result and (t = '935bbf5210c32cfa1faf61f91e8dc02dfa0ff1e8');
-    des.Reset;
-    s := des.DecryptCFB8bit(s);
-    result := result and (data2 = s);
-  finally
-    des.free;
-  end;
-  //CFB-block
-  des := TSyna3Des.Create(key);
-  try
-    s := des.EncryptCFBblock(data2);
-    t := strtohex(s);
-    result := result and (t = '93754e3d54828fbf4bd81f1739419e8d2cfe1671');
-    des.Reset;
-    s := des.DecryptCFBblock(s);
-    result := result and (data2 = s);
-  finally
-    des.free;
-  end;
-  //OFB
-  des := TSyna3Des.Create(key);
-  try
-    s := des.EncryptOFB(data2);
-    t := strtohex(s);
-    result := result and (t = '93754e3d54828fbf04ef0a5efc926ebdf2d95f20');
-    des.Reset;
-    s := des.DecryptOFB(s);
-    result := result and (data2 = s);
-  finally
-    des.free;
-  end;
-  //CTR
-  des := TSyna3Des.Create(key);
-  try
-    s := des.EncryptCTR(data2);
-    t := strtohex(s);
-    result := result and (t = '93754e3d54828fbf1c51a121d2c93f989e70b3ad');
-    des.Reset;
-    s := des.DecryptCTR(s);
-    result := result and (data2 = s);
-  finally
-    des.free;
-  end;
-end;
-
-{==============================================================================}
-
-end.
+{==============================================================================|
+| Project : Ararat Synapse                                       | 001.000.001 |
+|==============================================================================|
+| Content: Encryption support                                                  |
+|==============================================================================|
+| Copyright (c)2007-2010, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2007-2010.                |
+| All Rights Reserved.                                                         |
+| Based on work of David Barton and Eric Young                                 |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@abstract(Encryption support)
+
+Implemented are DES and 3DES encryption/decryption by ECB, CBC, CFB-8bit,
+ CFB-block, OFB and CTR methods.
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$Q-}
+{$R-}
+{$H+}
+
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit synacrypt;
+
+interface
+
+uses
+  SysUtils, Classes, synautil;
+
+type
+  {:@abstract(Implementation of common routines for 64-bit block ciphers)
+
+   Do not use this class directly, use descendants only!}
+  TSynaBlockCipher= class(TObject)
+  protected
+    procedure InitKey(Key: AnsiString); virtual;
+  private
+    IV, CV: AnsiString;
+    procedure IncCounter;
+  public
+    {:Sets the IV to Value and performs a reset}
+    procedure SetIV(const Value: AnsiString); virtual;
+    {:Returns the current chaining information, not the actual IV}
+    function GetIV: AnsiString; virtual;
+    {:Reset any stored chaining information}
+    procedure Reset; virtual;
+    {:Encrypt a 64-bit block of data using the ECB method of encryption}
+    function EncryptECB(const InData: AnsiString): AnsiString; virtual;
+    {:Decrypt a 64-bit block of data using the ECB method of decryption}
+    function DecryptECB(const InData: AnsiString): AnsiString; virtual;
+    {:Encrypt data using the CBC method of encryption}
+    function EncryptCBC(const Indata: AnsiString): AnsiString; virtual;
+    {:Decrypt data using the CBC method of decryption}
+    function DecryptCBC(const Indata: AnsiString): AnsiString; virtual;
+    {:Encrypt data using the CFB (8 bit) method of encryption}
+    function EncryptCFB8bit(const Indata: AnsiString): AnsiString; virtual;
+    {:Decrypt data using the CFB (8 bit) method of decryption}
+    function DecryptCFB8bit(const Indata: AnsiString): AnsiString; virtual;
+    {:Encrypt data using the CFB (block) method of encryption}
+    function EncryptCFBblock(const Indata: AnsiString): AnsiString; virtual;
+    {:Decrypt data using the CFB (block) method of decryption}
+    function DecryptCFBblock(const Indata: AnsiString): AnsiString; virtual;
+    {:Encrypt data using the OFB method of encryption}
+    function EncryptOFB(const Indata: AnsiString): AnsiString; virtual;
+    {:Decrypt data using the OFB method of decryption}
+    function DecryptOFB(const Indata: AnsiString): AnsiString; virtual;
+    {:Encrypt data using the CTR method of encryption}
+    function EncryptCTR(const Indata: AnsiString): AnsiString; virtual;
+    {:Decrypt data using the CTR method of decryption}
+    function DecryptCTR(const Indata: AnsiString): AnsiString; virtual;
+    {:Create a encryptor/decryptor instance and initialize it by the Key.}
+    constructor Create(Key: AnsiString);
+  end;
+
+  {:@abstract(Datatype for holding one DES key data)
+
+    This data type is used internally.}
+  TDesKeyData = array[0..31] of integer;
+
+  {:@abstract(Implementation of common routines for DES encryption)
+
+   Do not use this class directly, use descendants only!}
+  TSynaCustomDes = class(TSynaBlockcipher)
+  protected
+    procedure DoInit(KeyB: AnsiString; var KeyData: TDesKeyData);
+    function EncryptBlock(const InData: AnsiString; var KeyData: TDesKeyData): AnsiString;
+    function DecryptBlock(const InData: AnsiString; var KeyData: TDesKeyData): AnsiString;
+  end;
+
+  {:@abstract(Implementation of DES encryption)}
+  TSynaDes= class(TSynaCustomDes)
+  protected
+    KeyData: TDesKeyData;
+    procedure InitKey(Key: AnsiString); override;
+  public
+    {:Encrypt a 64-bit block of data using the ECB method of encryption}
+    function EncryptECB(const InData: AnsiString): AnsiString; override;
+    {:Decrypt a 64-bit block of data using the ECB method of decryption}
+    function DecryptECB(const InData: AnsiString): AnsiString; override;
+  end;
+
+  {:@abstract(Implementation of 3DES encryption)}
+  TSyna3Des= class(TSynaCustomDes)
+  protected
+    KeyData: array[0..2] of TDesKeyData;
+    procedure InitKey(Key: AnsiString); override;
+  public
+    {:Encrypt a 64-bit block of data using the ECB method of encryption}
+    function EncryptECB(const InData: AnsiString): AnsiString; override;
+    {:Decrypt a 64-bit block of data using the ECB method of decryption}
+    function DecryptECB(const InData: AnsiString): AnsiString; override;
+  end;
+
+{:Call internal test of all DES encryptions. Returns @true if all is OK.}
+function TestDes: boolean;
+{:Call internal test of all 3DES encryptions. Returns @true if all is OK.}
+function Test3Des: boolean;
+
+{==============================================================================}
+implementation
+
+const
+  shifts2: array[0..15]of byte=
+    (0,0,1,1,1,1,1,1,0,1,1,1,1,1,1,0);
+
+  des_skb: array[0..7,0..63]of integer=(
+    (
+    (* for C bits (numbered as per FIPS 46) 1 2 3 4 5 6 *)
+    integer($00000000),integer($00000010),integer($20000000),integer($20000010),
+    integer($00010000),integer($00010010),integer($20010000),integer($20010010),
+    integer($00000800),integer($00000810),integer($20000800),integer($20000810),
+    integer($00010800),integer($00010810),integer($20010800),integer($20010810),
+    integer($00000020),integer($00000030),integer($20000020),integer($20000030),
+    integer($00010020),integer($00010030),integer($20010020),integer($20010030),
+    integer($00000820),integer($00000830),integer($20000820),integer($20000830),
+    integer($00010820),integer($00010830),integer($20010820),integer($20010830),
+    integer($00080000),integer($00080010),integer($20080000),integer($20080010),
+    integer($00090000),integer($00090010),integer($20090000),integer($20090010),
+    integer($00080800),integer($00080810),integer($20080800),integer($20080810),
+    integer($00090800),integer($00090810),integer($20090800),integer($20090810),
+    integer($00080020),integer($00080030),integer($20080020),integer($20080030),
+    integer($00090020),integer($00090030),integer($20090020),integer($20090030),
+    integer($00080820),integer($00080830),integer($20080820),integer($20080830),
+    integer($00090820),integer($00090830),integer($20090820),integer($20090830)
+    ),(
+    (* for C bits (numbered as per FIPS 46) 7 8 10 11 12 13 *)
+    integer($00000000),integer($02000000),integer($00002000),integer($02002000),
+    integer($00200000),integer($02200000),integer($00202000),integer($02202000),
+    integer($00000004),integer($02000004),integer($00002004),integer($02002004),
+    integer($00200004),integer($02200004),integer($00202004),integer($02202004),
+    integer($00000400),integer($02000400),integer($00002400),integer($02002400),
+    integer($00200400),integer($02200400),integer($00202400),integer($02202400),
+    integer($00000404),integer($02000404),integer($00002404),integer($02002404),
+    integer($00200404),integer($02200404),integer($00202404),integer($02202404),
+    integer($10000000),integer($12000000),integer($10002000),integer($12002000),
+    integer($10200000),integer($12200000),integer($10202000),integer($12202000),
+    integer($10000004),integer($12000004),integer($10002004),integer($12002004),
+    integer($10200004),integer($12200004),integer($10202004),integer($12202004),
+    integer($10000400),integer($12000400),integer($10002400),integer($12002400),
+    integer($10200400),integer($12200400),integer($10202400),integer($12202400),
+    integer($10000404),integer($12000404),integer($10002404),integer($12002404),
+    integer($10200404),integer($12200404),integer($10202404),integer($12202404)
+    ),(
+    (* for C bits (numbered as per FIPS 46) 14 15 16 17 19 20 *)
+    integer($00000000),integer($00000001),integer($00040000),integer($00040001),
+    integer($01000000),integer($01000001),integer($01040000),integer($01040001),
+    integer($00000002),integer($00000003),integer($00040002),integer($00040003),
+    integer($01000002),integer($01000003),integer($01040002),integer($01040003),
+    integer($00000200),integer($00000201),integer($00040200),integer($00040201),
+    integer($01000200),integer($01000201),integer($01040200),integer($01040201),
+    integer($00000202),integer($00000203),integer($00040202),integer($00040203),
+    integer($01000202),integer($01000203),integer($01040202),integer($01040203),
+    integer($08000000),integer($08000001),integer($08040000),integer($08040001),
+    integer($09000000),integer($09000001),integer($09040000),integer($09040001),
+    integer($08000002),integer($08000003),integer($08040002),integer($08040003),
+    integer($09000002),integer($09000003),integer($09040002),integer($09040003),
+    integer($08000200),integer($08000201),integer($08040200),integer($08040201),
+    integer($09000200),integer($09000201),integer($09040200),integer($09040201),
+    integer($08000202),integer($08000203),integer($08040202),integer($08040203),
+    integer($09000202),integer($09000203),integer($09040202),integer($09040203)
+    ),(
+    (* for C bits (numbered as per FIPS 46) 21 23 24 26 27 28 *)
+    integer($00000000),integer($00100000),integer($00000100),integer($00100100),
+    integer($00000008),integer($00100008),integer($00000108),integer($00100108),
+    integer($00001000),integer($00101000),integer($00001100),integer($00101100),
+    integer($00001008),integer($00101008),integer($00001108),integer($00101108),
+    integer($04000000),integer($04100000),integer($04000100),integer($04100100),
+    integer($04000008),integer($04100008),integer($04000108),integer($04100108),
+    integer($04001000),integer($04101000),integer($04001100),integer($04101100),
+    integer($04001008),integer($04101008),integer($04001108),integer($04101108),
+    integer($00020000),integer($00120000),integer($00020100),integer($00120100),
+    integer($00020008),integer($00120008),integer($00020108),integer($00120108),
+    integer($00021000),integer($00121000),integer($00021100),integer($00121100),
+    integer($00021008),integer($00121008),integer($00021108),integer($00121108),
+    integer($04020000),integer($04120000),integer($04020100),integer($04120100),
+    integer($04020008),integer($04120008),integer($04020108),integer($04120108),
+    integer($04021000),integer($04121000),integer($04021100),integer($04121100),
+    integer($04021008),integer($04121008),integer($04021108),integer($04121108)
+    ),(
+    (* for D bits (numbered as per FIPS 46) 1 2 3 4 5 6 *)
+    integer($00000000),integer($10000000),integer($00010000),integer($10010000),
+    integer($00000004),integer($10000004),integer($00010004),integer($10010004),
+    integer($20000000),integer($30000000),integer($20010000),integer($30010000),
+    integer($20000004),integer($30000004),integer($20010004),integer($30010004),
+    integer($00100000),integer($10100000),integer($00110000),integer($10110000),
+    integer($00100004),integer($10100004),integer($00110004),integer($10110004),
+    integer($20100000),integer($30100000),integer($20110000),integer($30110000),
+    integer($20100004),integer($30100004),integer($20110004),integer($30110004),
+    integer($00001000),integer($10001000),integer($00011000),integer($10011000),
+    integer($00001004),integer($10001004),integer($00011004),integer($10011004),
+    integer($20001000),integer($30001000),integer($20011000),integer($30011000),
+    integer($20001004),integer($30001004),integer($20011004),integer($30011004),
+    integer($00101000),integer($10101000),integer($00111000),integer($10111000),
+    integer($00101004),integer($10101004),integer($00111004),integer($10111004),
+    integer($20101000),integer($30101000),integer($20111000),integer($30111000),
+    integer($20101004),integer($30101004),integer($20111004),integer($30111004)
+    ),(
+    (* for D bits (numbered as per FIPS 46) 8 9 11 12 13 14 *)
+    integer($00000000),integer($08000000),integer($00000008),integer($08000008),
+    integer($00000400),integer($08000400),integer($00000408),integer($08000408),
+    integer($00020000),integer($08020000),integer($00020008),integer($08020008),
+    integer($00020400),integer($08020400),integer($00020408),integer($08020408),
+    integer($00000001),integer($08000001),integer($00000009),integer($08000009),
+    integer($00000401),integer($08000401),integer($00000409),integer($08000409),
+    integer($00020001),integer($08020001),integer($00020009),integer($08020009),
+    integer($00020401),integer($08020401),integer($00020409),integer($08020409),
+    integer($02000000),integer($0A000000),integer($02000008),integer($0A000008),
+    integer($02000400),integer($0A000400),integer($02000408),integer($0A000408),
+    integer($02020000),integer($0A020000),integer($02020008),integer($0A020008),
+    integer($02020400),integer($0A020400),integer($02020408),integer($0A020408),
+    integer($02000001),integer($0A000001),integer($02000009),integer($0A000009),
+    integer($02000401),integer($0A000401),integer($02000409),integer($0A000409),
+    integer($02020001),integer($0A020001),integer($02020009),integer($0A020009),
+    integer($02020401),integer($0A020401),integer($02020409),integer($0A020409)
+    ),(
+    (* for D bits (numbered as per FIPS 46) 16 17 18 19 20 21 *)
+    integer($00000000),integer($00000100),integer($00080000),integer($00080100),
+    integer($01000000),integer($01000100),integer($01080000),integer($01080100),
+    integer($00000010),integer($00000110),integer($00080010),integer($00080110),
+    integer($01000010),integer($01000110),integer($01080010),integer($01080110),
+    integer($00200000),integer($00200100),integer($00280000),integer($00280100),
+    integer($01200000),integer($01200100),integer($01280000),integer($01280100),
+    integer($00200010),integer($00200110),integer($00280010),integer($00280110),
+    integer($01200010),integer($01200110),integer($01280010),integer($01280110),
+    integer($00000200),integer($00000300),integer($00080200),integer($00080300),
+    integer($01000200),integer($01000300),integer($01080200),integer($01080300),
+    integer($00000210),integer($00000310),integer($00080210),integer($00080310),
+    integer($01000210),integer($01000310),integer($01080210),integer($01080310),
+    integer($00200200),integer($00200300),integer($00280200),integer($00280300),
+    integer($01200200),integer($01200300),integer($01280200),integer($01280300),
+    integer($00200210),integer($00200310),integer($00280210),integer($00280310),
+    integer($01200210),integer($01200310),integer($01280210),integer($01280310)
+    ),(
+    (* for D bits (numbered as per FIPS 46) 22 23 24 25 27 28 *)
+    integer($00000000),integer($04000000),integer($00040000),integer($04040000),
+    integer($00000002),integer($04000002),integer($00040002),integer($04040002),
+    integer($00002000),integer($04002000),integer($00042000),integer($04042000),
+    integer($00002002),integer($04002002),integer($00042002),integer($04042002),
+    integer($00000020),integer($04000020),integer($00040020),integer($04040020),
+    integer($00000022),integer($04000022),integer($00040022),integer($04040022),
+    integer($00002020),integer($04002020),integer($00042020),integer($04042020),
+    integer($00002022),integer($04002022),integer($00042022),integer($04042022),
+    integer($00000800),integer($04000800),integer($00040800),integer($04040800),
+    integer($00000802),integer($04000802),integer($00040802),integer($04040802),
+    integer($00002800),integer($04002800),integer($00042800),integer($04042800),
+    integer($00002802),integer($04002802),integer($00042802),integer($04042802),
+    integer($00000820),integer($04000820),integer($00040820),integer($04040820),
+    integer($00000822),integer($04000822),integer($00040822),integer($04040822),
+    integer($00002820),integer($04002820),integer($00042820),integer($04042820),
+    integer($00002822),integer($04002822),integer($00042822),integer($04042822)
+    ));
+
+  des_sptrans: array[0..7,0..63] of integer=(
+    (
+    (* nibble 0 *)
+    integer($02080800), integer($00080000), integer($02000002), integer($02080802),
+    integer($02000000), integer($00080802), integer($00080002), integer($02000002),
+    integer($00080802), integer($02080800), integer($02080000), integer($00000802),
+    integer($02000802), integer($02000000), integer($00000000), integer($00080002),
+    integer($00080000), integer($00000002), integer($02000800), integer($00080800),
+    integer($02080802), integer($02080000), integer($00000802), integer($02000800),
+    integer($00000002), integer($00000800), integer($00080800), integer($02080002),
+    integer($00000800), integer($02000802), integer($02080002), integer($00000000),
+    integer($00000000), integer($02080802), integer($02000800), integer($00080002),
+    integer($02080800), integer($00080000), integer($00000802), integer($02000800),
+    integer($02080002), integer($00000800), integer($00080800), integer($02000002),
+    integer($00080802), integer($00000002), integer($02000002), integer($02080000),
+    integer($02080802), integer($00080800), integer($02080000), integer($02000802),
+    integer($02000000), integer($00000802), integer($00080002), integer($00000000),
+    integer($00080000), integer($02000000), integer($02000802), integer($02080800),
+    integer($00000002), integer($02080002), integer($00000800), integer($00080802)
+    ),(
+    (* nibble 1 *)
+    integer($40108010), integer($00000000), integer($00108000), integer($40100000),
+    integer($40000010), integer($00008010), integer($40008000), integer($00108000),
+    integer($00008000), integer($40100010), integer($00000010), integer($40008000),
+    integer($00100010), integer($40108000), integer($40100000), integer($00000010),
+    integer($00100000), integer($40008010), integer($40100010), integer($00008000),
+    integer($00108010), integer($40000000), integer($00000000), integer($00100010),
+    integer($40008010), integer($00108010), integer($40108000), integer($40000010),
+    integer($40000000), integer($00100000), integer($00008010), integer($40108010),
+    integer($00100010), integer($40108000), integer($40008000), integer($00108010),
+    integer($40108010), integer($00100010), integer($40000010), integer($00000000),
+    integer($40000000), integer($00008010), integer($00100000), integer($40100010),
+    integer($00008000), integer($40000000), integer($00108010), integer($40008010),
+    integer($40108000), integer($00008000), integer($00000000), integer($40000010),
+    integer($00000010), integer($40108010), integer($00108000), integer($40100000),
+    integer($40100010), integer($00100000), integer($00008010), integer($40008000),
+    integer($40008010), integer($00000010), integer($40100000), integer($00108000)
+    ),(
+    (* nibble 2 *)
+    integer($04000001), integer($04040100), integer($00000100), integer($04000101),
+    integer($00040001), integer($04000000), integer($04000101), integer($00040100),
+    integer($04000100), integer($00040000), integer($04040000), integer($00000001),
+    integer($04040101), integer($00000101), integer($00000001), integer($04040001),
+    integer($00000000), integer($00040001), integer($04040100), integer($00000100),
+    integer($00000101), integer($04040101), integer($00040000), integer($04000001),
+    integer($04040001), integer($04000100), integer($00040101), integer($04040000),
+    integer($00040100), integer($00000000), integer($04000000), integer($00040101),
+    integer($04040100), integer($00000100), integer($00000001), integer($00040000),
+    integer($00000101), integer($00040001), integer($04040000), integer($04000101),
+    integer($00000000), integer($04040100), integer($00040100), integer($04040001),
+    integer($00040001), integer($04000000), integer($04040101), integer($00000001),
+    integer($00040101), integer($04000001), integer($04000000), integer($04040101),
+    integer($00040000), integer($04000100), integer($04000101), integer($00040100),
+    integer($04000100), integer($00000000), integer($04040001), integer($00000101),
+    integer($04000001), integer($00040101), integer($00000100), integer($04040000)
+    ),(
+    (* nibble 3 *)
+    integer($00401008), integer($10001000), integer($00000008), integer($10401008),
+    integer($00000000), integer($10400000), integer($10001008), integer($00400008),
+    integer($10401000), integer($10000008), integer($10000000), integer($00001008),
+    integer($10000008), integer($00401008), integer($00400000), integer($10000000),
+    integer($10400008), integer($00401000), integer($00001000), integer($00000008),
+    integer($00401000), integer($10001008), integer($10400000), integer($00001000),
+    integer($00001008), integer($00000000), integer($00400008), integer($10401000),
+    integer($10001000), integer($10400008), integer($10401008), integer($00400000),
+    integer($10400008), integer($00001008), integer($00400000), integer($10000008),
+    integer($00401000), integer($10001000), integer($00000008), integer($10400000),
+    integer($10001008), integer($00000000), integer($00001000), integer($00400008),
+    integer($00000000), integer($10400008), integer($10401000), integer($00001000),
+    integer($10000000), integer($10401008), integer($00401008), integer($00400000),
+    integer($10401008), integer($00000008), integer($10001000), integer($00401008),
+    integer($00400008), integer($00401000), integer($10400000), integer($10001008),
+    integer($00001008), integer($10000000), integer($10000008), integer($10401000)
+    ),(
+    (* nibble 4 *)
+    integer($08000000), integer($00010000), integer($00000400), integer($08010420),
+    integer($08010020), integer($08000400), integer($00010420), integer($08010000),
+    integer($00010000), integer($00000020), integer($08000020), integer($00010400),
+    integer($08000420), integer($08010020), integer($08010400), integer($00000000),
+    integer($00010400), integer($08000000), integer($00010020), integer($00000420),
+    integer($08000400), integer($00010420), integer($00000000), integer($08000020),
+    integer($00000020), integer($08000420), integer($08010420), integer($00010020),
+    integer($08010000), integer($00000400), integer($00000420), integer($08010400),
+    integer($08010400), integer($08000420), integer($00010020), integer($08010000),
+    integer($00010000), integer($00000020), integer($08000020), integer($08000400),
+    integer($08000000), integer($00010400), integer($08010420), integer($00000000),
+    integer($00010420), integer($08000000), integer($00000400), integer($00010020),
+    integer($08000420), integer($00000400), integer($00000000), integer($08010420),
+    integer($08010020), integer($08010400), integer($00000420), integer($00010000),
+    integer($00010400), integer($08010020), integer($08000400), integer($00000420),
+    integer($00000020), integer($00010420), integer($08010000), integer($08000020)
+    ),(
+    (* nibble 5 *)
+    integer($80000040), integer($00200040), integer($00000000), integer($80202000),
+    integer($00200040), integer($00002000), integer($80002040), integer($00200000),
+    integer($00002040), integer($80202040), integer($00202000), integer($80000000),
+    integer($80002000), integer($80000040), integer($80200000), integer($00202040),
+    integer($00200000), integer($80002040), integer($80200040), integer($00000000),
+    integer($00002000), integer($00000040), integer($80202000), integer($80200040),
+    integer($80202040), integer($80200000), integer($80000000), integer($00002040),
+    integer($00000040), integer($00202000), integer($00202040), integer($80002000),
+    integer($00002040), integer($80000000), integer($80002000), integer($00202040),
+    integer($80202000), integer($00200040), integer($00000000), integer($80002000),
+    integer($80000000), integer($00002000), integer($80200040), integer($00200000),
+    integer($00200040), integer($80202040), integer($00202000), integer($00000040),
+    integer($80202040), integer($00202000), integer($00200000), integer($80002040),
+    integer($80000040), integer($80200000), integer($00202040), integer($00000000),
+    integer($00002000), integer($80000040), integer($80002040), integer($80202000),
+    integer($80200000), integer($00002040), integer($00000040), integer($80200040)
+    ),(
+    (* nibble 6 *)
+    integer($00004000), integer($00000200), integer($01000200), integer($01000004),
+    integer($01004204), integer($00004004), integer($00004200), integer($00000000),
+    integer($01000000), integer($01000204), integer($00000204), integer($01004000),
+    integer($00000004), integer($01004200), integer($01004000), integer($00000204),
+    integer($01000204), integer($00004000), integer($00004004), integer($01004204),
+    integer($00000000), integer($01000200), integer($01000004), integer($00004200),
+    integer($01004004), integer($00004204), integer($01004200), integer($00000004),
+    integer($00004204), integer($01004004), integer($00000200), integer($01000000),
+    integer($00004204), integer($01004000), integer($01004004), integer($00000204),
+    integer($00004000), integer($00000200), integer($01000000), integer($01004004),
+    integer($01000204), integer($00004204), integer($00004200), integer($00000000),
+    integer($00000200), integer($01000004), integer($00000004), integer($01000200),
+    integer($00000000), integer($01000204), integer($01000200), integer($00004200),
+    integer($00000204), integer($00004000), integer($01004204), integer($01000000),
+    integer($01004200), integer($00000004), integer($00004004), integer($01004204),
+    integer($01000004), integer($01004200), integer($01004000), integer($00004004)
+    ),(
+    (* nibble 7 *)
+    integer($20800080), integer($20820000), integer($00020080), integer($00000000),
+    integer($20020000), integer($00800080), integer($20800000), integer($20820080),
+    integer($00000080), integer($20000000), integer($00820000), integer($00020080),
+    integer($00820080), integer($20020080), integer($20000080), integer($20800000),
+    integer($00020000), integer($00820080), integer($00800080), integer($20020000),
+    integer($20820080), integer($20000080), integer($00000000), integer($00820000),
+    integer($20000000), integer($00800000), integer($20020080), integer($20800080),
+    integer($00800000), integer($00020000), integer($20820000), integer($00000080),
+    integer($00800000), integer($00020000), integer($20000080), integer($20820080),
+    integer($00020080), integer($20000000), integer($00000000), integer($00820000),
+    integer($20800080), integer($20020080), integer($20020000), integer($00800080),
+    integer($20820000), integer($00000080), integer($00800080), integer($20020000),
+    integer($20820080), integer($00800000), integer($20800000), integer($20000080),
+    integer($00820000), integer($00020080), integer($20020080), integer($20800000),
+    integer($00000080), integer($20820000), integer($00820080), integer($00000000),
+    integer($20000000), integer($20800080), integer($00020000), integer($00820080)
+    ));
+
+{==============================================================================}
+
+function XorString(Indata1, Indata2: AnsiString): AnsiString;
+var
+  i: integer;
+begin
+  Indata2 := PadString(Indata2, length(Indata1), #0);
+  Result := '';
+  for i := 1 to length(Indata1) do
+    Result := Result + AnsiChar(ord(Indata1[i]) xor ord(Indata2[i]));
+end;
+
+procedure hperm_op(var a, t: integer; n, m: integer);
+begin
+  t:= ((a shl (16 - n)) xor a) and m;
+  a:= a xor t xor (t shr (16 - n));
+end;
+
+procedure perm_op(var a, b, t: integer; n, m: integer);
+begin
+  t:= ((a shr n) xor b) and m;
+  b:= b xor t;
+  a:= a xor (t shl n);
+end;
+
+{==============================================================================}
+procedure TSynaBlockCipher.IncCounter;
+var
+  i: integer;
+begin
+  Inc(CV[8]);
+  i:= 7;
+  while (i> 0) and (CV[i + 1] = #0) do
+  begin
+    Inc(CV[i]);
+    Dec(i);
+  end;
+end;
+
+procedure TSynaBlockCipher.Reset;
+begin
+  CV := IV;
+end;
+
+procedure TSynaBlockCipher.InitKey(Key: AnsiString);
+begin
+end;
+
+procedure TSynaBlockCipher.SetIV(const Value: AnsiString);
+begin
+  IV := PadString(Value, 8, #0);
+  Reset;
+end;
+
+function TSynaBlockCipher.GetIV: AnsiString;
+begin
+  Result := CV;
+end;
+
+function TSynaBlockCipher.EncryptECB(const InData: AnsiString): AnsiString;
+begin
+  Result := InData;
+end;
+
+function TSynaBlockCipher.DecryptECB(const InData: AnsiString): AnsiString;
+begin
+  Result := InData;
+end;
+
+function TSynaBlockCipher.EncryptCBC(const Indata: AnsiString): AnsiString;
+var
+  i: integer;
+  s: ansistring;
+  l: integer;
+begin
+  Result := '';
+  l := Length(InData);
+  for i:= 1 to (l div 8) do
+  begin
+    s := copy(Indata, (i - 1) * 8 + 1, 8);
+    s := XorString(s, CV);
+    s := EncryptECB(s);
+    CV := s;
+    Result := Result + s;
+  end;
+  if (l mod 8)<> 0 then
+  begin
+    CV := EncryptECB(CV);
+    s := copy(Indata, (l div 8) * 8 + 1, l mod 8);
+    s := XorString(s, CV);
+    Result := Result + s;
+  end;
+end;
+
+function TSynaBlockCipher.DecryptCBC(const Indata: AnsiString): AnsiString;
+var
+  i: integer;
+  s, temp: ansistring;
+  l: integer;
+begin
+  Result := '';
+  l := Length(InData);
+  for i:= 1 to (l div 8) do
+  begin
+    s := copy(Indata, (i - 1) * 8 + 1, 8);
+    temp := s;
+    s := DecryptECB(s);
+    s := XorString(s, CV);
+    Result := Result + s;
+    CV := Temp;
+  end;
+  if (l mod 8)<> 0 then
+  begin
+    CV := EncryptECB(CV);
+    s := copy(Indata, (l div 8) * 8 + 1, l mod 8);
+    s := XorString(s, CV);
+    Result := Result + s;
+  end;
+end;
+
+function TSynaBlockCipher.EncryptCFB8bit(const Indata: AnsiString): AnsiString;
+var
+  i: integer;
+  Temp: AnsiString;
+  c: AnsiChar;
+begin
+  Result := '';
+  for i:= 1 to Length(Indata) do
+  begin
+    Temp := EncryptECB(CV);
+    c := AnsiChar(ord(InData[i]) xor ord(temp[1]));
+    Result := Result + c;
+    Delete(CV, 1, 1);
+    CV := CV + c;
+  end;
+end;
+
+function TSynaBlockCipher.DecryptCFB8bit(const Indata: AnsiString): AnsiString;
+var
+  i: integer;
+  Temp: AnsiString;
+  c: AnsiChar;
+begin
+  Result := '';
+  for i:= 1 to length(Indata) do
+  begin
+    c:= Indata[i];
+    Temp := EncryptECB(CV);
+    Result := Result + AnsiChar(ord(InData[i]) xor ord(temp[1]));
+    Delete(CV, 1, 1);
+    CV := CV + c;
+  end;
+end;
+
+function TSynaBlockCipher.EncryptCFBblock(const Indata: AnsiString): AnsiString;
+var
+  i: integer;
+  s: AnsiString;
+  l: integer;
+begin
+  Result := '';
+  l := Length(InData);
+  for i:= 1 to (l div 8) do
+  begin
+    CV := EncryptECB(CV);
+    s := copy(Indata, (i - 1) * 8 + 1, 8);
+    s := XorString(s, CV);
+    Result := Result + s;
+    CV := s;
+  end;
+  if (l mod 8)<> 0 then
+  begin
+    CV := EncryptECB(CV);
+    s := copy(Indata, (l div 8) * 8 + 1, l mod 8);
+    s := XorString(s, CV);
+    Result := Result + s;
+  end;
+end;
+
+function TSynaBlockCipher.DecryptCFBblock(const Indata: AnsiString): AnsiString;
+var
+  i: integer;
+  S, Temp: AnsiString;
+  l: integer;
+begin
+  Result := '';
+  l := Length(InData);
+  for i:= 1 to (l div 8) do
+  begin
+    s := copy(Indata, (i - 1) * 8 + 1, 8);
+    Temp := s;
+    CV := EncryptECB(CV);
+    s := XorString(s, CV);
+    Result := result + s;
+    CV := temp;
+  end;
+  if (l mod 8)<> 0 then
+  begin
+    CV := EncryptECB(CV);
+    s := copy(Indata, (l div 8) * 8 + 1, l mod 8);
+    s := XorString(s, CV);
+    Result := Result + s;
+  end;
+end;
+
+function TSynaBlockCipher.EncryptOFB(const Indata: AnsiString): AnsiString;
+var
+  i: integer;
+  s: AnsiString;
+  l: integer;
+begin
+  Result := '';
+  l := Length(InData);
+  for i:= 1 to (l div 8) do
+  begin
+    CV := EncryptECB(CV);
+    s := copy(Indata, (i - 1) * 8 + 1, 8);
+    s := XorString(s, CV);
+    Result := Result + s;
+  end;
+  if (l mod 8)<> 0 then
+  begin
+    CV := EncryptECB(CV);
+    s := copy(Indata, (l div 8) * 8 + 1, l mod 8);
+    s := XorString(s, CV);
+    Result := Result + s;
+  end;
+end;
+
+function TSynaBlockCipher.DecryptOFB(const Indata: AnsiString): AnsiString;
+var
+  i: integer;
+  s: AnsiString;
+  l: integer;
+begin
+  Result := '';
+  l := Length(InData);
+  for i:= 1 to (l div 8) do
+  begin
+    Cv := EncryptECB(CV);
+    s := copy(Indata, (i - 1) * 8 + 1, 8);
+    s := XorString(s, CV);
+    Result := Result + s;
+  end;
+  if (l mod 8)<> 0 then
+  begin
+    CV := EncryptECB(CV);
+    s := copy(Indata, (l div 8) * 8 + 1, l mod 8);
+    s := XorString(s, CV);
+    Result := Result + s;
+  end;
+end;
+
+function TSynaBlockCipher.EncryptCTR(const Indata: AnsiString): AnsiString;
+var
+  temp: AnsiString;
+  i: integer;
+  s: AnsiString;
+  l: integer;
+begin
+  Result := '';
+  l := Length(InData);
+  for i:= 1 to (l div 8) do
+  begin
+    temp := EncryptECB(CV);
+    IncCounter;
+    s := copy(Indata, (i - 1) * 8 + 1, 8);
+    s := XorString(s, temp);
+    Result := Result + s;
+  end;
+  if (l mod 8)<> 0 then
+  begin
+    temp := EncryptECB(CV);
+    IncCounter;
+    s := copy(Indata, (l div 8) * 8 + 1, l mod 8);
+    s := XorString(s, temp);
+    Result := Result + s;
+  end;
+end;
+
+function TSynaBlockCipher.DecryptCTR(const Indata: AnsiString): AnsiString;
+var
+  temp: AnsiString;
+  s: AnsiString;
+  i: integer;
+  l: integer;
+begin
+  Result := '';
+  l := Length(InData);
+  for i:= 1 to (l div 8) do
+  begin
+    temp := EncryptECB(CV);
+    IncCounter;
+    s := copy(Indata, (i - 1) * 8 + 1, 8);
+    s := XorString(s, temp);
+    Result := Result + s;
+  end;
+  if (l mod 8)<> 0 then
+  begin
+    temp := EncryptECB(CV);
+    IncCounter;
+    s := copy(Indata, (l div 8) * 8 + 1, l mod 8);
+    s := XorString(s, temp);
+    Result := Result + s;
+  end;
+end;
+
+constructor TSynaBlockCipher.Create(Key: AnsiString);
+begin
+  inherited Create;
+  InitKey(Key);
+  IV := StringOfChar(#0, 8);
+  IV := EncryptECB(IV);
+  Reset;
+end;
+
+{==============================================================================}
+
+procedure TSynaCustomDes.DoInit(KeyB: AnsiString; var KeyData: TDesKeyData);
+var
+  c, d, t, s, t2, i: integer;
+begin
+  KeyB := PadString(KeyB, 8, #0);
+  c:= ord(KeyB[1]) or (ord(KeyB[2]) shl 8) or (ord(KeyB[3]) shl 16) or (ord(KeyB[4]) shl 24);
+  d:= ord(KeyB[5]) or (ord(KeyB[6]) shl 8) or (ord(KeyB[7]) shl 16) or (ord(KeyB[8]) shl 24);
+  perm_op(d,c,t,4,integer($0f0f0f0f));
+  hperm_op(c,t,integer(-2),integer($cccc0000));
+  hperm_op(d,t,integer(-2),integer($cccc0000));
+  perm_op(d,c,t,1,integer($55555555));
+  perm_op(c,d,t,8,integer($00ff00ff));
+  perm_op(d,c,t,1,integer($55555555));
+  d:= ((d and $ff) shl 16) or (d and $ff00) or ((d and $ff0000) shr 16) or
+        ((c and integer($f0000000)) shr 4);
+  c:= c and $fffffff;
+  for i:= 0 to 15 do
+  begin
+    if shifts2[i]<> 0 then
+    begin
+      c:= ((c shr 2) or (c shl 26));
+      d:= ((d shr 2) or (d shl 26));
+    end
+    else
+    begin
+      c:= ((c shr 1) or (c shl 27));
+      d:= ((d shr 1) or (d shl 27));
+    end;
+    c:= c and $fffffff;
+    d:= d and $fffffff;
+    s:= des_skb[0,c and $3f] or
+        des_skb[1,((c shr  6) and $03) or ((c shr  7) and $3c)] or
+        des_skb[2,((c shr 13) and $0f) or ((c shr 14) and $30)] or
+        des_skb[3,((c shr 20) and $01) or ((c shr 21) and $06) or ((c shr 22) and $38)];
+    t:= des_skb[4,d and $3f] or
+        des_skb[5,((d shr  7) and $03) or ((d shr  8) and $3c)] or
+        des_skb[6, (d shr 15) and $3f                         ] or
+        des_skb[7,((d shr 21) and $0f) or ((d shr 22) and $30)];
+    t2:= ((t shl 16) or (s and $ffff));
+    KeyData[(i shl 1)]:= ((t2 shl 2) or (t2 shr 30));
+    t2:= ((s shr 16) or (t and integer($ffff0000)));
+    KeyData[(i shl 1)+1]:= ((t2 shl 6) or (t2 shr 26));
+  end;
+end;
+
+function TSynaCustomDes.EncryptBlock(const InData: AnsiString; var KeyData: TDesKeyData): AnsiString;
+var
+  l, r, t, u: integer;
+  i: longint;
+begin
+  r := Swapbytes(DecodeLongint(Indata, 1));
+  l := swapbytes(DecodeLongint(Indata, 5));
+  t:= ((l shr 4) xor r) and $0f0f0f0f;
+  r:= r xor t;
+  l:= l xor (t shl 4);
+  t:= ((r shr 16) xor l) and $0000ffff;
+  l:= l xor t;
+  r:= r xor (t shl 16);
+  t:= ((l shr 2) xor r) and $33333333;
+  r:= r xor t;
+  l:= l xor (t shl 2);
+  t:= ((r shr 8) xor l) and $00ff00ff;
+  l:= l xor t;
+  r:= r xor (t shl 8);
+  t:= ((l shr 1) xor r) and $55555555;
+  r:= r xor t;
+  l:= l xor (t shl 1);
+  r:= (r shr 29) or (r shl 3);
+  l:= (l shr 29) or (l shl 3);
+  i:= 0;
+  while i< 32 do
+  begin
+    u:= r xor KeyData[i  ];
+    t:= r xor KeyData[i+1];
+    t:= (t shr 4) or (t shl 28);
+    l:= l xor des_SPtrans[0,(u shr  2) and $3f] xor
+              des_SPtrans[2,(u shr 10) and $3f] xor
+              des_SPtrans[4,(u shr 18) and $3f] xor
+              des_SPtrans[6,(u shr 26) and $3f] xor
+              des_SPtrans[1,(t shr  2) and $3f] xor
+              des_SPtrans[3,(t shr 10) and $3f] xor
+              des_SPtrans[5,(t shr 18) and $3f] xor
+              des_SPtrans[7,(t shr 26) and $3f];
+    u:= l xor KeyData[i+2];
+    t:= l xor KeyData[i+3];
+    t:= (t shr 4) or (t shl 28);
+    r:= r xor des_SPtrans[0,(u shr  2) and $3f] xor
+              des_SPtrans[2,(u shr 10) and $3f] xor
+              des_SPtrans[4,(u shr 18) and $3f] xor
+              des_SPtrans[6,(u shr 26) and $3f] xor
+              des_SPtrans[1,(t shr  2) and $3f] xor
+              des_SPtrans[3,(t shr 10) and $3f] xor
+              des_SPtrans[5,(t shr 18) and $3f] xor
+              des_SPtrans[7,(t shr 26) and $3f];
+    u:= r xor KeyData[i+4];
+    t:= r xor KeyData[i+5];
+    t:= (t shr 4) or (t shl 28);
+    l:= l xor des_SPtrans[0,(u shr  2) and $3f] xor
+              des_SPtrans[2,(u shr 10) and $3f] xor
+              des_SPtrans[4,(u shr 18) and $3f] xor
+              des_SPtrans[6,(u shr 26) and $3f] xor
+              des_SPtrans[1,(t shr  2) and $3f] xor
+              des_SPtrans[3,(t shr 10) and $3f] xor
+              des_SPtrans[5,(t shr 18) and $3f] xor
+              des_SPtrans[7,(t shr 26) and $3f];
+    u:= l xor KeyData[i+6];
+    t:= l xor KeyData[i+7];
+    t:= (t shr 4) or (t shl 28);
+    r:= r xor des_SPtrans[0,(u shr  2) and $3f] xor
+              des_SPtrans[2,(u shr 10) and $3f] xor
+              des_SPtrans[4,(u shr 18) and $3f] xor
+              des_SPtrans[6,(u shr 26) and $3f] xor
+              des_SPtrans[1,(t shr  2) and $3f] xor
+              des_SPtrans[3,(t shr 10) and $3f] xor
+              des_SPtrans[5,(t shr 18) and $3f] xor
+              des_SPtrans[7,(t shr 26) and $3f];
+    Inc(i,8);
+  end;
+  r:= (r shr 3) or (r shl 29);
+  l:= (l shr 3) or (l shl 29);
+  t:= ((r shr 1) xor l) and $55555555;
+  l:= l xor t;
+  r:= r xor (t shl 1);
+  t:= ((l shr 8) xor r) and $00ff00ff;
+  r:= r xor t;
+  l:= l xor (t shl 8);
+  t:= ((r shr 2) xor l) and $33333333;
+  l:= l xor t;
+  r:= r xor (t shl 2);
+  t:= ((l shr 16) xor r) and $0000ffff;
+  r:= r xor t;
+  l:= l xor (t shl 16);
+  t:= ((r shr 4) xor l) and $0f0f0f0f;
+  l:= l xor t;
+  r:= r xor (t shl 4);
+  Result := CodeLongInt(Swapbytes(l)) + CodeLongInt(Swapbytes(r));
+end;
+
+function TSynaCustomDes.DecryptBlock(const InData: AnsiString; var KeyData: TDesKeyData): AnsiString;
+var
+  l, r, t, u: integer;
+  i: longint;
+begin
+  r := Swapbytes(DecodeLongint(Indata, 1));
+  l := Swapbytes(DecodeLongint(Indata, 5));
+  t:= ((l shr 4) xor r) and $0f0f0f0f;
+  r:= r xor t;
+  l:= l xor (t shl 4);
+  t:= ((r shr 16) xor l) and $0000ffff;
+  l:= l xor t;
+  r:= r xor (t shl 16);
+  t:= ((l shr 2) xor r) and $33333333;
+  r:= r xor t;
+  l:= l xor (t shl 2);
+  t:= ((r shr 8) xor l) and $00ff00ff;
+  l:= l xor t;
+  r:= r xor (t shl 8);
+  t:= ((l shr 1) xor r) and $55555555;
+  r:= r xor t;
+  l:= l xor (t shl 1);
+  r:= (r shr 29) or (r shl 3);
+  l:= (l shr 29) or (l shl 3);
+  i:= 30;
+  while i> 0 do
+  begin
+    u:= r xor KeyData[i  ];
+    t:= r xor KeyData[i+1];
+    t:= (t shr 4) or (t shl 28);
+    l:= l xor des_SPtrans[0,(u shr  2) and $3f] xor
+              des_SPtrans[2,(u shr 10) and $3f] xor
+              des_SPtrans[4,(u shr 18) and $3f] xor
+              des_SPtrans[6,(u shr 26) and $3f] xor
+              des_SPtrans[1,(t shr  2) and $3f] xor
+              des_SPtrans[3,(t shr 10) and $3f] xor
+              des_SPtrans[5,(t shr 18) and $3f] xor
+              des_SPtrans[7,(t shr 26) and $3f];
+    u:= l xor KeyData[i-2];
+    t:= l xor KeyData[i-1];
+    t:= (t shr 4) or (t shl 28);
+    r:= r xor des_SPtrans[0,(u shr  2) and $3f] xor
+              des_SPtrans[2,(u shr 10) and $3f] xor
+              des_SPtrans[4,(u shr 18) and $3f] xor
+              des_SPtrans[6,(u shr 26) and $3f] xor
+              des_SPtrans[1,(t shr  2) and $3f] xor
+              des_SPtrans[3,(t shr 10) and $3f] xor
+              des_SPtrans[5,(t shr 18) and $3f] xor
+              des_SPtrans[7,(t shr 26) and $3f];
+    u:= r xor KeyData[i-4];
+    t:= r xor KeyData[i-3];
+    t:= (t shr 4) or (t shl 28);
+    l:= l xor des_SPtrans[0,(u shr  2) and $3f] xor
+              des_SPtrans[2,(u shr 10) and $3f] xor
+              des_SPtrans[4,(u shr 18) and $3f] xor
+              des_SPtrans[6,(u shr 26) and $3f] xor
+              des_SPtrans[1,(t shr  2) and $3f] xor
+              des_SPtrans[3,(t shr 10) and $3f] xor
+              des_SPtrans[5,(t shr 18) and $3f] xor
+              des_SPtrans[7,(t shr 26) and $3f];
+    u:= l xor KeyData[i-6];
+    t:= l xor KeyData[i-5];
+    t:= (t shr 4) or (t shl 28);
+    r:= r xor des_SPtrans[0,(u shr  2) and $3f] xor
+              des_SPtrans[2,(u shr 10) and $3f] xor
+              des_SPtrans[4,(u shr 18) and $3f] xor
+              des_SPtrans[6,(u shr 26) and $3f] xor
+              des_SPtrans[1,(t shr  2) and $3f] xor
+              des_SPtrans[3,(t shr 10) and $3f] xor
+              des_SPtrans[5,(t shr 18) and $3f] xor
+              des_SPtrans[7,(t shr 26) and $3f];
+    Dec(i,8);
+  end;
+  r:= (r shr 3) or (r shl 29);
+  l:= (l shr 3) or (l shl 29);
+  t:= ((r shr 1) xor l) and $55555555;
+  l:= l xor t;
+  r:= r xor (t shl 1);
+  t:= ((l shr 8) xor r) and $00ff00ff;
+  r:= r xor t;
+  l:= l xor (t shl 8);
+  t:= ((r shr 2) xor l) and $33333333;
+  l:= l xor t;
+  r:= r xor (t shl 2);
+  t:= ((l shr 16) xor r) and $0000ffff;
+  r:= r xor t;
+  l:= l xor (t shl 16);
+  t:= ((r shr 4) xor l) and $0f0f0f0f;
+  l:= l xor t;
+  r:= r xor (t shl 4);
+  Result := CodeLongInt(Swapbytes(l)) + CodeLongInt(Swapbytes(r));
+end;
+
+{==============================================================================}
+
+procedure TSynaDes.InitKey(Key: AnsiString);
+begin
+  Key := PadString(Key, 8, #0);
+  DoInit(Key,KeyData);
+end;
+
+function TSynaDes.EncryptECB(const InData: AnsiString): AnsiString;
+begin
+  Result := EncryptBlock(InData,KeyData);
+end;
+
+function TSynaDes.DecryptECB(const InData: AnsiString): AnsiString;
+begin
+  Result := DecryptBlock(Indata,KeyData);
+end;
+
+{==============================================================================}
+
+procedure TSyna3Des.InitKey(Key: AnsiString);
+var
+  Size: integer;
+  n: integer;
+begin
+  Size := length(Key);
+  key := PadString(key, 3 * 8, #0);
+  DoInit(Copy(key, 1, 8),KeyData[0]);
+  DoInit(Copy(key, 9, 8),KeyData[1]);
+  if Size > 16 then
+    DoInit(Copy(key, 17, 8),KeyData[2])
+  else
+    for n := 0 to high(KeyData[0]) do
+      KeyData[2][n] := Keydata[0][n];
+end;
+
+function TSyna3Des.EncryptECB(const InData: AnsiString): AnsiString;
+begin
+  Result := EncryptBlock(Indata,KeyData[0]);
+  Result := DecryptBlock(Result,KeyData[1]);
+  Result := EncryptBlock(Result,KeyData[2]);
+end;
+
+function TSyna3Des.DecryptECB(const InData: AnsiString): AnsiString;
+begin
+  Result := DecryptBlock(InData,KeyData[2]);
+  Result := EncryptBlock(Result,KeyData[1]);
+  Result := DecryptBlock(Result,KeyData[0]);
+end;
+
+{==============================================================================}
+
+function TestDes: boolean;
+var
+  des: TSynaDes;
+  s, t: string;
+const
+  key = '01234567';
+  data1= '01234567';
+  data2= '0123456789abcdefghij';
+begin
+  //ECB
+  des := TSynaDes.Create(key);
+  try
+    s := des.EncryptECB(data1);
+    t := strtohex(s);
+    result := t = 'c50ad028c6da9800';
+    s := des.DecryptECB(s);
+    result := result and (data1 = s);
+  finally
+    des.free;
+  end;
+  //CBC
+  des := TSynaDes.Create(key);
+  try
+    s := des.EncryptCBC(data2);
+    t := strtohex(s);
+    result := result and (t = 'eec50f6353115ad6dee90a22ed1b6a88a0926e35');
+    des.Reset;
+    s := des.DecryptCBC(s);
+    result := result and (data2 = s);
+  finally
+    des.free;
+  end;
+  //CFB-8bit
+  des := TSynaDes.Create(key);
+  try
+    s := des.EncryptCFB8bit(data2);
+    t := strtohex(s);
+    result := result and (t = 'eb6aa12c2f0ff634b4dfb6da6cb2af8f9c5c1452');
+    des.Reset;
+    s := des.DecryptCFB8bit(s);
+    result := result and (data2 = s);
+  finally
+    des.free;
+  end;
+  //CFB-block
+  des := TSynaDes.Create(key);
+  try
+    s := des.EncryptCFBblock(data2);
+    t := strtohex(s);
+    result := result and (t = 'ebdbbaa7f9286cdec28605e07f9b7f3be1053257');
+    des.Reset;
+    s := des.DecryptCFBblock(s);
+    result := result and (data2 = s);
+  finally
+    des.free;
+  end;
+  //OFB
+  des := TSynaDes.Create(key);
+  try
+    s := des.EncryptOFB(data2);
+    t := strtohex(s);
+    result := result and (t = 'ebdbbaa7f9286cdee0b8b3798c4c34baac87dbdc');
+    des.Reset;
+    s := des.DecryptOFB(s);
+    result := result and (data2 = s);
+  finally
+    des.free;
+  end;
+  //CTR
+  des := TSynaDes.Create(key);
+  try
+    s := des.EncryptCTR(data2);
+    t := strtohex(s);
+    result := result and (t = 'ebdbbaa7f9286cde0dd20b45f3afd9aa1b91b87e');
+    des.Reset;
+    s := des.DecryptCTR(s);
+    result := result and (data2 = s);
+  finally
+    des.free;
+  end;
+end;
+
+function Test3Des: boolean;
+var
+  des: TSyna3Des;
+  s, t: string;
+const
+  key = '0123456789abcdefghijklmn';
+  data1= '01234567';
+  data2= '0123456789abcdefghij';
+begin
+  //ECB
+  des := TSyna3Des.Create(key);
+  try
+    s := des.EncryptECB(data1);
+    t := strtohex(s);
+    result := t = 'e0dee91008dc460c';
+    s := des.DecryptECB(s);
+    result := result and (data1 = s);
+  finally
+    des.free;
+  end;
+  //CBC
+  des := TSyna3Des.Create(key);
+  try
+    s := des.EncryptCBC(data2);
+    t := strtohex(s);
+    result := result and (t = 'ee844a2a4f49c01b91a1599b8eba29128c1ad87a');
+    des.Reset;
+    s := des.DecryptCBC(s);
+    result := result and (data2 = s);
+  finally
+    des.free;
+  end;
+  //CFB-8bit
+  des := TSyna3Des.Create(key);
+  try
+    s := des.EncryptCFB8bit(data2);
+    t := strtohex(s);
+    result := result and (t = '935bbf5210c32cfa1faf61f91e8dc02dfa0ff1e8');
+    des.Reset;
+    s := des.DecryptCFB8bit(s);
+    result := result and (data2 = s);
+  finally
+    des.free;
+  end;
+  //CFB-block
+  des := TSyna3Des.Create(key);
+  try
+    s := des.EncryptCFBblock(data2);
+    t := strtohex(s);
+    result := result and (t = '93754e3d54828fbf4bd81f1739419e8d2cfe1671');
+    des.Reset;
+    s := des.DecryptCFBblock(s);
+    result := result and (data2 = s);
+  finally
+    des.free;
+  end;
+  //OFB
+  des := TSyna3Des.Create(key);
+  try
+    s := des.EncryptOFB(data2);
+    t := strtohex(s);
+    result := result and (t = '93754e3d54828fbf04ef0a5efc926ebdf2d95f20');
+    des.Reset;
+    s := des.DecryptOFB(s);
+    result := result and (data2 = s);
+  finally
+    des.free;
+  end;
+  //CTR
+  des := TSyna3Des.Create(key);
+  try
+    s := des.EncryptCTR(data2);
+    t := strtohex(s);
+    result := result and (t = '93754e3d54828fbf1c51a121d2c93f989e70b3ad');
+    des.Reset;
+    s := des.DecryptCTR(s);
+    result := result and (data2 = s);
+  finally
+    des.free;
+  end;
+end;
+
+{==============================================================================}
+
+end.
diff --git a/Units/Synapse/synadbg.pas b/Units/Synapse/synadbg.pas
index a8e7f26..c17f581 100644
--- a/Units/Synapse/synadbg.pas
+++ b/Units/Synapse/synadbg.pas
@@ -1,156 +1,156 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 001.001.001 |
-|==============================================================================|
-| Content: Socket debug tools                                                  |
-|==============================================================================|
-| Copyright (c)2008-2010, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2008-2010.                |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{:@abstract(Socket debug tools)
-
-Routines for help with debugging of events on the Sockets.
-}
-
-{$IFDEF UNICODE}
-  {$WARN IMPLICIT_STRING_CAST OFF}
-  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
-{$ENDIF}
-
-unit synadbg;
-
-interface
-
-uses
-  blcksock, synsock, synautil, classes, sysutils;
-
-type
-  TSynaDebug = class(TObject)
-    class procedure HookStatus(Sender: TObject; Reason: THookSocketReason; const Value: string);
-    class procedure HookMonitor(Sender: TObject; Writing: Boolean; const Buffer: TMemory; Len: Integer);
-  end;
-
-procedure AppendToLog(const value: Ansistring);
-
-var
-  LogFile: string;
-
-implementation
-
-procedure AppendToLog(const value: Ansistring);
-var
-  st: TFileStream;
-  s: string;
-  h, m, ss, ms: word;
-  dt: Tdatetime;
-begin
-  if fileexists(LogFile) then
-    st := TFileStream.Create(LogFile, fmOpenReadWrite or fmShareDenyWrite)
-  else
-    st := TFileStream.Create(LogFile, fmCreate or fmShareDenyWrite);
-  try
-    st.Position := st.Size;
-    dt := now;
-    decodetime(dt, h, m, ss, ms);
-    s := formatdatetime('yyyymmdd-hhnnss', dt) + format('.%.3d', [ms]) + ' ' + value;
-    WriteStrToStream(st, s);
-  finally
-    st.free;
-  end;
-end;
-
-class procedure TSynaDebug.HookStatus(Sender: TObject; Reason: THookSocketReason; const Value: string);
-var
-  s: string;
-begin
-  case Reason of
-    HR_ResolvingBegin:
-      s := 'HR_ResolvingBegin';
-    HR_ResolvingEnd:
-      s := 'HR_ResolvingEnd';
-    HR_SocketCreate:
-      s := 'HR_SocketCreate';
-    HR_SocketClose:
-      s := 'HR_SocketClose';
-    HR_Bind:
-      s := 'HR_Bind';
-    HR_Connect:
-      s := 'HR_Connect';
-    HR_CanRead:
-      s := 'HR_CanRead';
-    HR_CanWrite:
-      s := 'HR_CanWrite';
-    HR_Listen:
-      s := 'HR_Listen';
-    HR_Accept:
-      s := 'HR_Accept';
-    HR_ReadCount:
-      s := 'HR_ReadCount';
-    HR_WriteCount:
-      s := 'HR_WriteCount';
-    HR_Wait:
-      s := 'HR_Wait';
-    HR_Error:
-      s := 'HR_Error';
-  else
-    s := '-unknown-';
-  end;
-  s := inttohex(integer(Sender), 8) + s + ': ' + value + CRLF;
-  AppendToLog(s);
-end;
-
-class procedure TSynaDebug.HookMonitor(Sender: TObject; Writing: Boolean; const Buffer: TMemory; Len: Integer);
-var
-  s, d: Ansistring;
-begin
-  setlength(s, len);
-  move(Buffer^, pointer(s)^, len);
-  if writing then
-    d := '-> '
-  else
-    d := '<- ';
-  s :=inttohex(integer(Sender), 8) + d + s + CRLF;
-  AppendToLog(s);
-end;
-
-initialization
-begin
-  Logfile := changefileext(paramstr(0), '.slog');
-end;
-
-end.
+{==============================================================================|
+| Project : Ararat Synapse                                       | 001.001.001 |
+|==============================================================================|
+| Content: Socket debug tools                                                  |
+|==============================================================================|
+| Copyright (c)2008-2010, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2008-2010.                |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@abstract(Socket debug tools)
+
+Routines for help with debugging of events on the Sockets.
+}
+
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit synadbg;
+
+interface
+
+uses
+  blcksock, synsock, synautil, classes, sysutils;
+
+type
+  TSynaDebug = class(TObject)
+    class procedure HookStatus(Sender: TObject; Reason: THookSocketReason; const Value: string);
+    class procedure HookMonitor(Sender: TObject; Writing: Boolean; const Buffer: TMemory; Len: Integer);
+  end;
+
+procedure AppendToLog(const value: Ansistring);
+
+var
+  LogFile: string;
+
+implementation
+
+procedure AppendToLog(const value: Ansistring);
+var
+  st: TFileStream;
+  s: string;
+  h, m, ss, ms: word;
+  dt: Tdatetime;
+begin
+  if fileexists(LogFile) then
+    st := TFileStream.Create(LogFile, fmOpenReadWrite or fmShareDenyWrite)
+  else
+    st := TFileStream.Create(LogFile, fmCreate or fmShareDenyWrite);
+  try
+    st.Position := st.Size;
+    dt := now;
+    decodetime(dt, h, m, ss, ms);
+    s := formatdatetime('yyyymmdd-hhnnss', dt) + format('.%.3d', [ms]) + ' ' + value;
+    WriteStrToStream(st, s);
+  finally
+    st.free;
+  end;
+end;
+
+class procedure TSynaDebug.HookStatus(Sender: TObject; Reason: THookSocketReason; const Value: string);
+var
+  s: string;
+begin
+  case Reason of
+    HR_ResolvingBegin:
+      s := 'HR_ResolvingBegin';
+    HR_ResolvingEnd:
+      s := 'HR_ResolvingEnd';
+    HR_SocketCreate:
+      s := 'HR_SocketCreate';
+    HR_SocketClose:
+      s := 'HR_SocketClose';
+    HR_Bind:
+      s := 'HR_Bind';
+    HR_Connect:
+      s := 'HR_Connect';
+    HR_CanRead:
+      s := 'HR_CanRead';
+    HR_CanWrite:
+      s := 'HR_CanWrite';
+    HR_Listen:
+      s := 'HR_Listen';
+    HR_Accept:
+      s := 'HR_Accept';
+    HR_ReadCount:
+      s := 'HR_ReadCount';
+    HR_WriteCount:
+      s := 'HR_WriteCount';
+    HR_Wait:
+      s := 'HR_Wait';
+    HR_Error:
+      s := 'HR_Error';
+  else
+    s := '-unknown-';
+  end;
+  s := inttohex(integer(Sender), 8) + s + ': ' + value + CRLF;
+  AppendToLog(s);
+end;
+
+class procedure TSynaDebug.HookMonitor(Sender: TObject; Writing: Boolean; const Buffer: TMemory; Len: Integer);
+var
+  s, d: Ansistring;
+begin
+  setlength(s, len);
+  move(Buffer^, pointer(s)^, len);
+  if writing then
+    d := '-> '
+  else
+    d := '<- ';
+  s :=inttohex(integer(Sender), 8) + d + s + CRLF;
+  AppendToLog(s);
+end;
+
+initialization
+begin
+  Logfile := changefileext(paramstr(0), '.slog');
+end;
+
+end.
diff --git a/Units/Synapse/synafpc.pas b/Units/Synapse/synafpc.pas
index cd39e70..eb5cc3d 100644
--- a/Units/Synapse/synafpc.pas
+++ b/Units/Synapse/synafpc.pas
@@ -1,137 +1,137 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 001.001.002 |
-|==============================================================================|
-| Content: Utils for FreePascal compatibility                                  |
-|==============================================================================|
-| Copyright (c)1999-2010, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2003-2010.                |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{:@exclude}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$H+}
-//old Delphi does not have MSWINDOWS define.
-{$IFDEF WIN32}
-  {$IFNDEF MSWINDOWS}
-    {$DEFINE MSWINDOWS}
-  {$ENDIF}
-{$ENDIF}
-
-unit synafpc;
-
-interface
-
-uses
-{$IFDEF FPC}
-  dynlibs, sysutils;
-{$ELSE}
-  {$IFDEF MSWINDOWS}
-  Windows;
-  {$ELSE}
-  SysUtils;
-  {$ENDIF}
-{$ENDIF}
-
-{$IFDEF FPC}
-type
-  TLibHandle = dynlibs.TLibHandle;
-  
-function LoadLibrary(ModuleName: PChar): TLibHandle;
-function FreeLibrary(Module: TLibHandle): LongBool;
-function GetProcAddress(Module: TLibHandle; Proc: PChar): Pointer;
-function GetModuleFileName(Module: TLibHandle; Buffer: PChar; BufLen: Integer): Integer;
-{$ELSE}
-type
-  {$IFDEF CIL}
-  TLibHandle = Integer;
-  {$ELSE}
-  TLibHandle = HModule;
-  {$ENDIF}
-  {$IFDEF VER100}
-  LongWord = DWord;
-  {$ENDIF}
-{$ENDIF}
-
-procedure Sleep(milliseconds: Cardinal);
-
-
-implementation
-
-{==============================================================================}
-{$IFDEF FPC}
-function LoadLibrary(ModuleName: PChar): TLibHandle;
-begin
-  Result := dynlibs.LoadLibrary(Modulename);
-end;
-
-function FreeLibrary(Module: TLibHandle): LongBool;
-begin
-  Result := dynlibs.UnloadLibrary(Module);
-end;
-
-function GetProcAddress(Module: TLibHandle; Proc: PChar): Pointer;
-begin
-  Result := dynlibs.GetProcedureAddress(Module, Proc);
-end;
-
-function GetModuleFileName(Module: TLibHandle; Buffer: PChar; BufLen: Integer): Integer;
-begin
-  Result := 0;
-end;
-
-{$ELSE}
-{$ENDIF}
-
-procedure Sleep(milliseconds: Cardinal);
-begin
-{$IFDEF MSWINDOWS}
-  {$IFDEF FPC}
-  sysutils.sleep(milliseconds);
-  {$ELSE}
-  windows.sleep(milliseconds);
-  {$ENDIF}
-{$ELSE}
-  sysutils.sleep(milliseconds);
-{$ENDIF}
-
-end;
-
-end.
+{==============================================================================|
+| Project : Ararat Synapse                                       | 001.001.002 |
+|==============================================================================|
+| Content: Utils for FreePascal compatibility                                  |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2003-2010.                |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@exclude}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+//old Delphi does not have MSWINDOWS define.
+{$IFDEF WIN32}
+  {$IFNDEF MSWINDOWS}
+    {$DEFINE MSWINDOWS}
+  {$ENDIF}
+{$ENDIF}
+
+unit synafpc;
+
+interface
+
+uses
+{$IFDEF FPC}
+  dynlibs, sysutils;
+{$ELSE}
+  {$IFDEF MSWINDOWS}
+  Windows;
+  {$ELSE}
+  SysUtils;
+  {$ENDIF}
+{$ENDIF}
+
+{$IFDEF FPC}
+type
+  TLibHandle = dynlibs.TLibHandle;
+  
+function LoadLibrary(ModuleName: PChar): TLibHandle;
+function FreeLibrary(Module: TLibHandle): LongBool;
+function GetProcAddress(Module: TLibHandle; Proc: PChar): Pointer;
+function GetModuleFileName(Module: TLibHandle; Buffer: PChar; BufLen: Integer): Integer;
+{$ELSE}
+type
+  {$IFDEF CIL}
+  TLibHandle = Integer;
+  {$ELSE}
+  TLibHandle = HModule;
+  {$ENDIF}
+  {$IFDEF VER100}
+  LongWord = DWord;
+  {$ENDIF}
+{$ENDIF}
+
+procedure Sleep(milliseconds: Cardinal);
+
+
+implementation
+
+{==============================================================================}
+{$IFDEF FPC}
+function LoadLibrary(ModuleName: PChar): TLibHandle;
+begin
+  Result := dynlibs.LoadLibrary(Modulename);
+end;
+
+function FreeLibrary(Module: TLibHandle): LongBool;
+begin
+  Result := dynlibs.UnloadLibrary(Module);
+end;
+
+function GetProcAddress(Module: TLibHandle; Proc: PChar): Pointer;
+begin
+  Result := dynlibs.GetProcedureAddress(Module, Proc);
+end;
+
+function GetModuleFileName(Module: TLibHandle; Buffer: PChar; BufLen: Integer): Integer;
+begin
+  Result := 0;
+end;
+
+{$ELSE}
+{$ENDIF}
+
+procedure Sleep(milliseconds: Cardinal);
+begin
+{$IFDEF MSWINDOWS}
+  {$IFDEF FPC}
+  sysutils.sleep(milliseconds);
+  {$ELSE}
+  windows.sleep(milliseconds);
+  {$ENDIF}
+{$ELSE}
+  sysutils.sleep(milliseconds);
+{$ENDIF}
+
+end;
+
+end.
diff --git a/Units/Synapse/synaicnv.pas b/Units/Synapse/synaicnv.pas
index 3dd79c5..e171a7f 100644
--- a/Units/Synapse/synaicnv.pas
+++ b/Units/Synapse/synaicnv.pas
@@ -1,363 +1,363 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 001.001.001 |
-|==============================================================================|
-| Content: ICONV support for Win32, Linux and .NET                             |
-|==============================================================================|
-| Copyright (c)2004-2010, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2004-2010.                |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$H+}
-//old Delphi does not have MSWINDOWS define.
-{$IFDEF WIN32}
-  {$IFNDEF MSWINDOWS}
-    {$DEFINE MSWINDOWS}
-  {$ENDIF}
-{$ENDIF}
-
-{:@abstract(LibIconv support)
-
-This unit is Pascal interface to LibIconv library for charset translations.
-LibIconv is loaded dynamicly on-demand. If this library is not found in system,
-requested LibIconv function just return errorcode.
-}
-unit synaicnv;
-
-interface
-
-uses
-{$IFDEF CIL}
-  System.Runtime.InteropServices,
-  System.Text,
-{$ENDIF}
-  synafpc,
-{$IFNDEF MSWINDOWS}
-  {$IFNDEF FPC}
-  Libc,
-  {$ENDIF}
-  SysUtils;
-{$ELSE}
-  Windows;
-{$ENDIF}
-
-
-const
-  {$IFNDEF MSWINDOWS}
-  DLLIconvName = 'libiconv.so';
-  {$ELSE}
-  DLLIconvName = 'iconv.dll';
-  {$ENDIF}
-
-type
-  size_t = Cardinal;
-{$IFDEF CIL}
-  iconv_t = IntPtr;
-{$ELSE}
-  iconv_t = Pointer;
-{$ENDIF}
-  argptr = iconv_t;
-
-var
-  iconvLibHandle: TLibHandle = 0;
-
-function SynaIconvOpen(const tocode, fromcode: Ansistring): iconv_t;
-function SynaIconvOpenTranslit(const tocode, fromcode: Ansistring): iconv_t;
-function SynaIconvOpenIgnore(const tocode, fromcode: Ansistring): iconv_t;
-function SynaIconv(cd: iconv_t; inbuf: AnsiString; var outbuf: AnsiString): integer;
-function SynaIconvClose(var cd: iconv_t): integer;
-function SynaIconvCtl(cd: iconv_t; request: integer; argument: argptr): integer;
-
-function IsIconvloaded: Boolean;
-function InitIconvInterface: Boolean;
-function DestroyIconvInterface: Boolean;
-
-const
-  ICONV_TRIVIALP          = 0;  // int *argument
-  ICONV_GET_TRANSLITERATE = 1;  // int *argument
-  ICONV_SET_TRANSLITERATE = 2;  // const int *argument
-  ICONV_GET_DISCARD_ILSEQ = 3;  // int *argument
-  ICONV_SET_DISCARD_ILSEQ = 4;  // const int *argument
-
-
-implementation
-
-uses SyncObjs;
-
-{$IFDEF CIL}
-  [DllImport(DLLIconvName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'libiconv_open')]
-    function _iconv_open(tocode: string; fromcode: string): iconv_t; external;
-
-  [DllImport(DLLIconvName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'libiconv')]
-    function _iconv(cd: iconv_t; var inbuf: IntPtr; var inbytesleft: size_t;
-    var outbuf: IntPtr; var outbytesleft: size_t): size_t; external;
-
-  [DllImport(DLLIconvName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'libiconv_close')]
-    function _iconv_close(cd: iconv_t): integer; external;
-
-  [DllImport(DLLIconvName, CharSet = CharSet.Ansi,
-    SetLastError = False, CallingConvention= CallingConvention.cdecl,
-    EntryPoint = 'libiconvctl')]
-    function _iconvctl(cd: iconv_t; request: integer; argument: argptr): integer; external;
-
-{$ELSE}
-type
-  Ticonv_open = function(tocode: pAnsichar; fromcode: pAnsichar): iconv_t; cdecl;
-  Ticonv = function(cd: iconv_t; var inbuf: pointer; var inbytesleft: size_t;
-    var outbuf: pointer; var outbytesleft: size_t): size_t; cdecl;
-  Ticonv_close = function(cd: iconv_t): integer; cdecl;
-  Ticonvctl = function(cd: iconv_t; request: integer; argument: argptr): integer; cdecl;
-var
-  _iconv_open: Ticonv_open = nil;
-  _iconv: Ticonv = nil;
-  _iconv_close: Ticonv_close = nil;
-  _iconvctl: Ticonvctl = nil;
-{$ENDIF}
-
-
-var
-  IconvCS: TCriticalSection;
-  Iconvloaded: boolean = false;
-
-function SynaIconvOpen (const tocode, fromcode: Ansistring): iconv_t;
-begin
-{$IFDEF CIL}
-  try
-    Result := _iconv_open(tocode, fromcode);
-  except
-    on Exception do
-      Result := iconv_t(-1);
-  end;
-{$ELSE}
-  if InitIconvInterface and Assigned(_iconv_open) then
-    Result := _iconv_open(PAnsiChar(tocode), PAnsiChar(fromcode))
-  else
-    Result := iconv_t(-1);
-{$ENDIF}
-end;
-
-function SynaIconvOpenTranslit (const tocode, fromcode: Ansistring): iconv_t;
-begin
-  Result := SynaIconvOpen(tocode + '//IGNORE//TRANSLIT', fromcode);
-end;
-
-function SynaIconvOpenIgnore (const tocode, fromcode: Ansistring): iconv_t;
-begin
-  Result := SynaIconvOpen(tocode + '//IGNORE', fromcode);
-end;
-
-function SynaIconv (cd: iconv_t; inbuf: AnsiString; var outbuf: AnsiString): integer;
-var
-{$IFDEF CIL}
-  ib, ob: IntPtr;
-  ibsave, obsave: IntPtr;
-  l: integer;
-{$ELSE}
-  ib, ob: Pointer;
-{$ENDIF}
-  ix, ox: size_t;
-begin
-{$IFDEF CIL}
-  l := Length(inbuf) * 4;
-  ibsave := IntPtr.Zero;
-  obsave := IntPtr.Zero;
-  try
-    ibsave := Marshal.StringToHGlobalAnsi(inbuf);
-    obsave := Marshal.AllocHGlobal(l);
-    ib := ibsave;
-    ob := obsave;
-    ix := Length(inbuf);
-    ox := l;
-    _iconv(cd, ib, ix, ob, ox);
-    Outbuf := Marshal.PtrToStringAnsi(obsave, l);
-    setlength(Outbuf, l - ox);
-    Result := Length(inbuf) - ix;
-  finally
-    Marshal.FreeCoTaskMem(ibsave);
-    Marshal.FreeHGlobal(obsave);
-  end;
-{$ELSE}
-  if InitIconvInterface and Assigned(_iconv) then
-  begin
-    setlength(Outbuf, Length(inbuf) * 4);
-    ib := Pointer(inbuf);
-    ob := Pointer(Outbuf);
-    ix := Length(inbuf);
-    ox := Length(Outbuf);
-    _iconv(cd, ib, ix, ob, ox);
-    setlength(Outbuf, cardinal(Length(Outbuf)) - ox);
-    Result := Cardinal(Length(inbuf)) - ix;
-  end
-  else
-  begin
-    Outbuf := '';
-    Result := 0;
-  end;
-{$ENDIF}
-end;
-
-function SynaIconvClose(var cd: iconv_t): integer;
-begin
-  if cd = iconv_t(-1) then
-  begin
-    Result := 0;
-    Exit;
-  end;
-{$IFDEF CIL}
-  try;
-    Result := _iconv_close(cd)
-  except
-    on Exception do
-      Result := -1;
-  end;
-  cd := iconv_t(-1);
-{$ELSE}
-  if InitIconvInterface and Assigned(_iconv_close) then
-    Result := _iconv_close(cd)
-  else
-    Result := -1;
-  cd := iconv_t(-1);
-{$ENDIF}
-end;
-
-function SynaIconvCtl (cd: iconv_t; request: integer; argument: argptr): integer;
-begin
-{$IFDEF CIL}
-  Result := _iconvctl(cd, request, argument)
-{$ELSE}
-  if InitIconvInterface and Assigned(_iconvctl) then
-    Result := _iconvctl(cd, request, argument)
-  else
-    Result := 0;
-{$ENDIF}
-end;
-
-function InitIconvInterface: Boolean;
-begin
-  IconvCS.Enter;
-  try
-    if not IsIconvloaded then
-    begin
-{$IFDEF CIL}
-      IconvLibHandle := 1;
-{$ELSE}
-      IconvLibHandle := LoadLibrary(PChar(DLLIconvName));
-{$ENDIF}
-      if (IconvLibHandle <> 0) then
-      begin
-{$IFNDEF CIL}
-        _iconv_open := GetProcAddress(IconvLibHandle, PAnsiChar(AnsiString('libiconv_open')));
-        _iconv := GetProcAddress(IconvLibHandle, PAnsiChar(AnsiString('libiconv')));
-        _iconv_close := GetProcAddress(IconvLibHandle, PAnsiChar(AnsiString('libiconv_close')));
-        _iconvctl := GetProcAddress(IconvLibHandle, PAnsiChar(AnsiString('libiconvctl')));
-{$ENDIF}
-        Result := True;
-        Iconvloaded := True;
-      end
-      else
-      begin
-        //load failed!
-        if IconvLibHandle <> 0 then
-        begin
-{$IFNDEF CIL}
-          FreeLibrary(IconvLibHandle);
-{$ENDIF}
-          IconvLibHandle := 0;
-        end;
-        Result := False;
-      end;
-    end
-    else
-      //loaded before...
-      Result := true;
-  finally
-    IconvCS.Leave;
-  end;
-end;
-
-function DestroyIconvInterface: Boolean;
-begin
-  IconvCS.Enter;
-  try
-    Iconvloaded := false;
-    if IconvLibHandle <> 0 then
-    begin
-{$IFNDEF CIL}
-      FreeLibrary(IconvLibHandle);
-{$ENDIF}
-      IconvLibHandle := 0;
-    end;
-{$IFNDEF CIL}
-    _iconv_open := nil;
-    _iconv := nil;
-    _iconv_close := nil;
-    _iconvctl := nil;
-{$ENDIF}
-  finally
-    IconvCS.Leave;
-  end;
-  Result := True;
-end;
-
-function IsIconvloaded: Boolean;
-begin
-  Result := IconvLoaded;
-end;
-
- initialization
-begin
-  IconvCS:= TCriticalSection.Create;
-end;
-
-finalization
-begin
-{$IFNDEF CIL}
-  DestroyIconvInterface;
-{$ENDIF}
-  IconvCS.Free;
-end;
-
-end.
+{==============================================================================|
+| Project : Ararat Synapse                                       | 001.001.001 |
+|==============================================================================|
+| Content: ICONV support for Win32, Linux and .NET                             |
+|==============================================================================|
+| Copyright (c)2004-2010, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2004-2010.                |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+//old Delphi does not have MSWINDOWS define.
+{$IFDEF WIN32}
+  {$IFNDEF MSWINDOWS}
+    {$DEFINE MSWINDOWS}
+  {$ENDIF}
+{$ENDIF}
+
+{:@abstract(LibIconv support)
+
+This unit is Pascal interface to LibIconv library for charset translations.
+LibIconv is loaded dynamicly on-demand. If this library is not found in system,
+requested LibIconv function just return errorcode.
+}
+unit synaicnv;
+
+interface
+
+uses
+{$IFDEF CIL}
+  System.Runtime.InteropServices,
+  System.Text,
+{$ENDIF}
+  synafpc,
+{$IFNDEF MSWINDOWS}
+  {$IFNDEF FPC}
+  Libc,
+  {$ENDIF}
+  SysUtils;
+{$ELSE}
+  Windows;
+{$ENDIF}
+
+
+const
+  {$IFNDEF MSWINDOWS}
+  DLLIconvName = 'libiconv.so';
+  {$ELSE}
+  DLLIconvName = 'iconv.dll';
+  {$ENDIF}
+
+type
+  size_t = Cardinal;
+{$IFDEF CIL}
+  iconv_t = IntPtr;
+{$ELSE}
+  iconv_t = Pointer;
+{$ENDIF}
+  argptr = iconv_t;
+
+var
+  iconvLibHandle: TLibHandle = 0;
+
+function SynaIconvOpen(const tocode, fromcode: Ansistring): iconv_t;
+function SynaIconvOpenTranslit(const tocode, fromcode: Ansistring): iconv_t;
+function SynaIconvOpenIgnore(const tocode, fromcode: Ansistring): iconv_t;
+function SynaIconv(cd: iconv_t; inbuf: AnsiString; var outbuf: AnsiString): integer;
+function SynaIconvClose(var cd: iconv_t): integer;
+function SynaIconvCtl(cd: iconv_t; request: integer; argument: argptr): integer;
+
+function IsIconvloaded: Boolean;
+function InitIconvInterface: Boolean;
+function DestroyIconvInterface: Boolean;
+
+const
+  ICONV_TRIVIALP          = 0;  // int *argument
+  ICONV_GET_TRANSLITERATE = 1;  // int *argument
+  ICONV_SET_TRANSLITERATE = 2;  // const int *argument
+  ICONV_GET_DISCARD_ILSEQ = 3;  // int *argument
+  ICONV_SET_DISCARD_ILSEQ = 4;  // const int *argument
+
+
+implementation
+
+uses SyncObjs;
+
+{$IFDEF CIL}
+  [DllImport(DLLIconvName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'libiconv_open')]
+    function _iconv_open(tocode: string; fromcode: string): iconv_t; external;
+
+  [DllImport(DLLIconvName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'libiconv')]
+    function _iconv(cd: iconv_t; var inbuf: IntPtr; var inbytesleft: size_t;
+    var outbuf: IntPtr; var outbytesleft: size_t): size_t; external;
+
+  [DllImport(DLLIconvName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'libiconv_close')]
+    function _iconv_close(cd: iconv_t): integer; external;
+
+  [DllImport(DLLIconvName, CharSet = CharSet.Ansi,
+    SetLastError = False, CallingConvention= CallingConvention.cdecl,
+    EntryPoint = 'libiconvctl')]
+    function _iconvctl(cd: iconv_t; request: integer; argument: argptr): integer; external;
+
+{$ELSE}
+type
+  Ticonv_open = function(tocode: pAnsichar; fromcode: pAnsichar): iconv_t; cdecl;
+  Ticonv = function(cd: iconv_t; var inbuf: pointer; var inbytesleft: size_t;
+    var outbuf: pointer; var outbytesleft: size_t): size_t; cdecl;
+  Ticonv_close = function(cd: iconv_t): integer; cdecl;
+  Ticonvctl = function(cd: iconv_t; request: integer; argument: argptr): integer; cdecl;
+var
+  _iconv_open: Ticonv_open = nil;
+  _iconv: Ticonv = nil;
+  _iconv_close: Ticonv_close = nil;
+  _iconvctl: Ticonvctl = nil;
+{$ENDIF}
+
+
+var
+  IconvCS: TCriticalSection;
+  Iconvloaded: boolean = false;
+
+function SynaIconvOpen (const tocode, fromcode: Ansistring): iconv_t;
+begin
+{$IFDEF CIL}
+  try
+    Result := _iconv_open(tocode, fromcode);
+  except
+    on Exception do
+      Result := iconv_t(-1);
+  end;
+{$ELSE}
+  if InitIconvInterface and Assigned(_iconv_open) then
+    Result := _iconv_open(PAnsiChar(tocode), PAnsiChar(fromcode))
+  else
+    Result := iconv_t(-1);
+{$ENDIF}
+end;
+
+function SynaIconvOpenTranslit (const tocode, fromcode: Ansistring): iconv_t;
+begin
+  Result := SynaIconvOpen(tocode + '//IGNORE//TRANSLIT', fromcode);
+end;
+
+function SynaIconvOpenIgnore (const tocode, fromcode: Ansistring): iconv_t;
+begin
+  Result := SynaIconvOpen(tocode + '//IGNORE', fromcode);
+end;
+
+function SynaIconv (cd: iconv_t; inbuf: AnsiString; var outbuf: AnsiString): integer;
+var
+{$IFDEF CIL}
+  ib, ob: IntPtr;
+  ibsave, obsave: IntPtr;
+  l: integer;
+{$ELSE}
+  ib, ob: Pointer;
+{$ENDIF}
+  ix, ox: size_t;
+begin
+{$IFDEF CIL}
+  l := Length(inbuf) * 4;
+  ibsave := IntPtr.Zero;
+  obsave := IntPtr.Zero;
+  try
+    ibsave := Marshal.StringToHGlobalAnsi(inbuf);
+    obsave := Marshal.AllocHGlobal(l);
+    ib := ibsave;
+    ob := obsave;
+    ix := Length(inbuf);
+    ox := l;
+    _iconv(cd, ib, ix, ob, ox);
+    Outbuf := Marshal.PtrToStringAnsi(obsave, l);
+    setlength(Outbuf, l - ox);
+    Result := Length(inbuf) - ix;
+  finally
+    Marshal.FreeCoTaskMem(ibsave);
+    Marshal.FreeHGlobal(obsave);
+  end;
+{$ELSE}
+  if InitIconvInterface and Assigned(_iconv) then
+  begin
+    setlength(Outbuf, Length(inbuf) * 4);
+    ib := Pointer(inbuf);
+    ob := Pointer(Outbuf);
+    ix := Length(inbuf);
+    ox := Length(Outbuf);
+    _iconv(cd, ib, ix, ob, ox);
+    setlength(Outbuf, cardinal(Length(Outbuf)) - ox);
+    Result := Cardinal(Length(inbuf)) - ix;
+  end
+  else
+  begin
+    Outbuf := '';
+    Result := 0;
+  end;
+{$ENDIF}
+end;
+
+function SynaIconvClose(var cd: iconv_t): integer;
+begin
+  if cd = iconv_t(-1) then
+  begin
+    Result := 0;
+    Exit;
+  end;
+{$IFDEF CIL}
+  try;
+    Result := _iconv_close(cd)
+  except
+    on Exception do
+      Result := -1;
+  end;
+  cd := iconv_t(-1);
+{$ELSE}
+  if InitIconvInterface and Assigned(_iconv_close) then
+    Result := _iconv_close(cd)
+  else
+    Result := -1;
+  cd := iconv_t(-1);
+{$ENDIF}
+end;
+
+function SynaIconvCtl (cd: iconv_t; request: integer; argument: argptr): integer;
+begin
+{$IFDEF CIL}
+  Result := _iconvctl(cd, request, argument)
+{$ELSE}
+  if InitIconvInterface and Assigned(_iconvctl) then
+    Result := _iconvctl(cd, request, argument)
+  else
+    Result := 0;
+{$ENDIF}
+end;
+
+function InitIconvInterface: Boolean;
+begin
+  IconvCS.Enter;
+  try
+    if not IsIconvloaded then
+    begin
+{$IFDEF CIL}
+      IconvLibHandle := 1;
+{$ELSE}
+      IconvLibHandle := LoadLibrary(PChar(DLLIconvName));
+{$ENDIF}
+      if (IconvLibHandle <> 0) then
+      begin
+{$IFNDEF CIL}
+        _iconv_open := GetProcAddress(IconvLibHandle, PAnsiChar(AnsiString('libiconv_open')));
+        _iconv := GetProcAddress(IconvLibHandle, PAnsiChar(AnsiString('libiconv')));
+        _iconv_close := GetProcAddress(IconvLibHandle, PAnsiChar(AnsiString('libiconv_close')));
+        _iconvctl := GetProcAddress(IconvLibHandle, PAnsiChar(AnsiString('libiconvctl')));
+{$ENDIF}
+        Result := True;
+        Iconvloaded := True;
+      end
+      else
+      begin
+        //load failed!
+        if IconvLibHandle <> 0 then
+        begin
+{$IFNDEF CIL}
+          FreeLibrary(IconvLibHandle);
+{$ENDIF}
+          IconvLibHandle := 0;
+        end;
+        Result := False;
+      end;
+    end
+    else
+      //loaded before...
+      Result := true;
+  finally
+    IconvCS.Leave;
+  end;
+end;
+
+function DestroyIconvInterface: Boolean;
+begin
+  IconvCS.Enter;
+  try
+    Iconvloaded := false;
+    if IconvLibHandle <> 0 then
+    begin
+{$IFNDEF CIL}
+      FreeLibrary(IconvLibHandle);
+{$ENDIF}
+      IconvLibHandle := 0;
+    end;
+{$IFNDEF CIL}
+    _iconv_open := nil;
+    _iconv := nil;
+    _iconv_close := nil;
+    _iconvctl := nil;
+{$ENDIF}
+  finally
+    IconvCS.Leave;
+  end;
+  Result := True;
+end;
+
+function IsIconvloaded: Boolean;
+begin
+  Result := IconvLoaded;
+end;
+
+ initialization
+begin
+  IconvCS:= TCriticalSection.Create;
+end;
+
+finalization
+begin
+{$IFNDEF CIL}
+  DestroyIconvInterface;
+{$ENDIF}
+  IconvCS.Free;
+end;
+
+end.
diff --git a/Units/Synapse/synaip.pas b/Units/Synapse/synaip.pas
index 82a7da4..f133723 100644
--- a/Units/Synapse/synaip.pas
+++ b/Units/Synapse/synaip.pas
@@ -1,422 +1,422 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 001.002.001 |
-|==============================================================================|
-| Content: IP address support procedures and functions                         |
-|==============================================================================|
-| Copyright (c)2006-2010, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c) 2006-2010.               |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{:@abstract(IP adress support procedures and functions)}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$Q-}
-{$R-}
-{$H+}
-
-{$IFDEF UNICODE}
-  {$WARN IMPLICIT_STRING_CAST OFF}
-  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
-  {$WARN SUSPICIOUS_TYPECAST OFF}
-{$ENDIF}
-
-unit synaip;
-
-interface
-
-uses
-  SysUtils, SynaUtil;
-
-type
-{:binary form of IPv6 adress (for string conversion routines)}
-  TIp6Bytes = array [0..15] of Byte;
-{:binary form of IPv6 adress (for string conversion routines)}
-  TIp6Words = array [0..7] of Word;
-
-{:Returns @TRUE, if "Value" is a valid IPv4 address. Cannot be a symbolic Name!}
-function IsIP(const Value: string): Boolean;
-
-{:Returns @TRUE, if "Value" is a valid IPv6 address. Cannot be a symbolic Name!}
-function IsIP6(const Value: string): Boolean;
-
-{:Returns a string with the "Host" ip address converted to binary form.}
-function IPToID(Host: string): Ansistring;
-
-{:Convert IPv6 address from their string form to binary byte array.}
-function StrToIp6(value: string): TIp6Bytes;
-
-{:Convert IPv6 address from binary byte array to string form.}
-function Ip6ToStr(value: TIp6Bytes): string;
-
-{:Convert IPv4 address from their string form to binary.}
-function StrToIp(value: string): integer;
-
-{:Convert IPv4 address from binary to string form.}
-function IpToStr(value: integer): string;
-
-{:Convert IPv4 address to reverse form.}
-function ReverseIP(Value: AnsiString): AnsiString;
-
-{:Convert IPv6 address to reverse form.}
-function ReverseIP6(Value: AnsiString): AnsiString;
-
-{:Expand short form of IPv6 address to long form.}
-function ExpandIP6(Value: AnsiString): AnsiString;
-
-
-implementation
-
-{==============================================================================}
-
-function IsIP(const Value: string): Boolean;
-var
-  TempIP: string;
-  function ByteIsOk(const Value: string): Boolean;
-  var
-    x, n: integer;
-  begin
-    x := StrToIntDef(Value, -1);
-    Result := (x >= 0) and (x < 256);
-    // X may be in correct range, but value still may not be correct value!
-    // i.e. "$80"
-    if Result then
-      for n := 1 to length(Value) do
-        if not (AnsiChar(Value[n]) in ['0'..'9']) then
-        begin
-          Result := False;
-          Break;
-        end;
-  end;
-begin
-  TempIP := Value;
-  Result := False;
-  if not ByteIsOk(Fetch(TempIP, '.')) then
-    Exit;
-  if not ByteIsOk(Fetch(TempIP, '.')) then
-    Exit;
-  if not ByteIsOk(Fetch(TempIP, '.')) then
-    Exit;
-  if ByteIsOk(TempIP) then
-    Result := True;
-end;
-
-{==============================================================================}
-
-function IsIP6(const Value: string): Boolean;
-var
-  TempIP: string;
-  s,t: string;
-  x: integer;
-  partcount: integer;
-  zerocount: integer;
-  First: Boolean;
-begin
-  TempIP := Value;
-  Result := False;
-  if Value = '::' then
-  begin
-    Result := True;
-    Exit;
-  end;
-  partcount := 0;
-  zerocount := 0;
-  First := True;
-  while tempIP <> '' do
-  begin
-    s := fetch(TempIP, ':');
-    if not(First) and (s = '') then
-      Inc(zerocount);
-    First := False;
-    if zerocount > 1 then
-      break;
-    Inc(partCount);
-    if s = '' then
-      Continue;
-    if partCount > 8 then
-      break;
-    if tempIP = '' then
-    begin
-      t := SeparateRight(s, '%');
-      s := SeparateLeft(s, '%');
-      x := StrToIntDef('$' + t, -1);
-      if (x < 0) or (x > $ffff) then
-        break;
-    end;
-    x := StrToIntDef('$' + s, -1);
-    if (x < 0) or (x > $ffff) then
-      break;
-    if tempIP = '' then
-      if not((PartCount = 1) and (ZeroCount = 0)) then
-        Result := True;
-  end;
-end;
-
-{==============================================================================}
-function IPToID(Host: string): Ansistring;
-var
-  s: string;
-  i, x: Integer;
-begin
-  Result := '';
-  for x := 0 to 3 do
-  begin
-    s := Fetch(Host, '.');
-    i := StrToIntDef(s, 0);
-    Result := Result + AnsiChar(i);
-  end;
-end;
-
-{==============================================================================}
-
-function StrToIp(value: string): integer;
-var
-  s: string;
-  i, x: Integer;
-begin
-  Result := 0;
-  for x := 0 to 3 do
-  begin
-    s := Fetch(value, '.');
-    i := StrToIntDef(s, 0);
-    Result := (256 * Result) + i;
-  end;
-end;
-
-{==============================================================================}
-
-function IpToStr(value: integer): string;
-var
-  x1, x2: word;
-  y1, y2: byte;
-begin
-  Result := '';
-  x1 := value shr 16;
-  x2 := value and $FFFF;
-  y1 := x1 div $100;
-  y2 := x1 mod $100;
-  Result := inttostr(y1) + '.' + inttostr(y2) + '.';
-  y1 := x2 div $100;
-  y2 := x2 mod $100;
-  Result := Result + inttostr(y1) + '.' + inttostr(y2);
-end;
-
-{==============================================================================}
-
-function ExpandIP6(Value: AnsiString): AnsiString;
-var
- n: integer;
- s: ansistring;
- x: integer;
-begin
-  Result := '';
-  if value = '' then
-    exit;
-  x := countofchar(value, ':');
-  if x > 7 then
-    exit;
-  if value[1] = ':' then
-    value := '0' + value;
-  if value[length(value)] = ':' then
-    value := value + '0';
-  x := 8 - x;
-  s := '';
-  for n := 1 to x do
-    s := s + ':0';
-  s := s + ':';
-  Result := replacestring(value, '::', s);
-end;
-{==============================================================================}
-
-function StrToIp6(Value: string): TIp6Bytes;
-var
- IPv6: TIp6Words;
- Index: Integer;
- n: integer;
- b1, b2: byte;
- s: string;
- x: integer;
-begin
-  for n := 0 to 15 do
-    Result[n] := 0;
-  for n := 0 to 7 do
-    Ipv6[n] := 0;
-  Index := 0;
-  Value := ExpandIP6(value);
-  if value = '' then
-    exit;
-  while Value <> '' do
-  begin
-    if Index > 7 then
-      Exit;
-    s := fetch(value, ':');
-    if s = '@' then
-      break;
-    if s = '' then
-    begin
-      IPv6[Index] := 0;
-    end
-    else
-    begin
-      x := StrToIntDef('$' + s, -1);
-      if (x > 65535) or (x < 0) then
-        Exit;
-      IPv6[Index] := x;
-    end;
-    Inc(Index);
-  end;
-  for n := 0 to 7 do
-  begin
-    b1 := ipv6[n] div 256;
-    b2 := ipv6[n] mod 256;
-    Result[n * 2] := b1;
-    Result[(n * 2) + 1] := b2;
-  end;
-end;
-
-{==============================================================================}
-//based on routine by the Free Pascal development team
-function Ip6ToStr(value: TIp6Bytes): string;
-var
-  i, x: byte;
-  zr1,zr2: set of byte;
-  zc1,zc2: byte;
-  have_skipped: boolean;
-  ip6w: TIp6words;
-begin
-  zr1 := [];
-  zr2 := [];
-  zc1 := 0;
-  zc2 := 0;
-  for i := 0 to 7 do
-  begin
-    x := i * 2;
-    ip6w[i] := value[x] * 256 + value[x + 1];
-    if ip6w[i] = 0 then
-    begin
-      include(zr2, i);
-      inc(zc2);
-    end
-    else
-    begin
-      if zc1 < zc2 then
-      begin
-        zc1 := zc2;
-        zr1 := zr2;
-        zc2 := 0;
-        zr2 := [];
-      end;
-    end;
-  end;
-  if zc1 < zc2 then
-  begin
-    zr1 := zr2;
-  end;
-  SetLength(Result, 8*5-1);
-  SetLength(Result, 0);
-  have_skipped := false;
-  for i := 0 to 7 do
-  begin
-    if not(i in zr1) then
-    begin
-      if have_skipped then
-      begin
-        if Result = '' then
-          Result := '::'
-        else
-          Result := Result + ':';
-        have_skipped := false;
-      end;
-      Result := Result + IntToHex(Ip6w[i], 1) + ':';
-    end
-    else
-    begin
-      have_skipped := true;
-    end;
-  end;
-  if have_skipped then
-    if Result = '' then
-      Result := '::0'
-    else
-      Result := Result + ':';
-
-  if Result = '' then
-    Result := '::0';
-  if not (7 in zr1) then
-    SetLength(Result, Length(Result)-1);
-  Result := LowerCase(result);
-end;
-
-{==============================================================================}
-function ReverseIP(Value: AnsiString): AnsiString;
-var
-  x: Integer;
-begin
-  Result := '';
-  repeat
-    x := LastDelimiter('.', Value);
-    Result := Result + '.' + Copy(Value, x + 1, Length(Value) - x);
-    Delete(Value, x, Length(Value) - x + 1);
-  until x < 1;
-  if Length(Result) > 0 then
-    if Result[1] = '.' then
-      Delete(Result, 1, 1);
-end;
-
-{==============================================================================}
-function ReverseIP6(Value: AnsiString): AnsiString;
-var
-  ip6: TIp6bytes;
-  n: integer;
-  x, y: integer;
-begin
-  ip6 := StrToIP6(Value);
-  x := ip6[15] div 16;
-  y := ip6[15] mod 16;
-  Result := IntToHex(y, 1) + '.' + IntToHex(x, 1);
-  for n := 14 downto 0 do
-  begin
-    x := ip6[n] div 16;
-    y := ip6[n] mod 16;
-    Result := Result + '.' + IntToHex(y, 1) + '.' + IntToHex(x, 1);
-  end;
-end;
-
-{==============================================================================}
-end.
+{==============================================================================|
+| Project : Ararat Synapse                                       | 001.002.001 |
+|==============================================================================|
+| Content: IP address support procedures and functions                         |
+|==============================================================================|
+| Copyright (c)2006-2010, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c) 2006-2010.               |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@abstract(IP adress support procedures and functions)}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$Q-}
+{$R-}
+{$H+}
+
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+  {$WARN SUSPICIOUS_TYPECAST OFF}
+{$ENDIF}
+
+unit synaip;
+
+interface
+
+uses
+  SysUtils, SynaUtil;
+
+type
+{:binary form of IPv6 adress (for string conversion routines)}
+  TIp6Bytes = array [0..15] of Byte;
+{:binary form of IPv6 adress (for string conversion routines)}
+  TIp6Words = array [0..7] of Word;
+
+{:Returns @TRUE, if "Value" is a valid IPv4 address. Cannot be a symbolic Name!}
+function IsIP(const Value: string): Boolean;
+
+{:Returns @TRUE, if "Value" is a valid IPv6 address. Cannot be a symbolic Name!}
+function IsIP6(const Value: string): Boolean;
+
+{:Returns a string with the "Host" ip address converted to binary form.}
+function IPToID(Host: string): Ansistring;
+
+{:Convert IPv6 address from their string form to binary byte array.}
+function StrToIp6(value: string): TIp6Bytes;
+
+{:Convert IPv6 address from binary byte array to string form.}
+function Ip6ToStr(value: TIp6Bytes): string;
+
+{:Convert IPv4 address from their string form to binary.}
+function StrToIp(value: string): integer;
+
+{:Convert IPv4 address from binary to string form.}
+function IpToStr(value: integer): string;
+
+{:Convert IPv4 address to reverse form.}
+function ReverseIP(Value: AnsiString): AnsiString;
+
+{:Convert IPv6 address to reverse form.}
+function ReverseIP6(Value: AnsiString): AnsiString;
+
+{:Expand short form of IPv6 address to long form.}
+function ExpandIP6(Value: AnsiString): AnsiString;
+
+
+implementation
+
+{==============================================================================}
+
+function IsIP(const Value: string): Boolean;
+var
+  TempIP: string;
+  function ByteIsOk(const Value: string): Boolean;
+  var
+    x, n: integer;
+  begin
+    x := StrToIntDef(Value, -1);
+    Result := (x >= 0) and (x < 256);
+    // X may be in correct range, but value still may not be correct value!
+    // i.e. "$80"
+    if Result then
+      for n := 1 to length(Value) do
+        if not (AnsiChar(Value[n]) in ['0'..'9']) then
+        begin
+          Result := False;
+          Break;
+        end;
+  end;
+begin
+  TempIP := Value;
+  Result := False;
+  if not ByteIsOk(Fetch(TempIP, '.')) then
+    Exit;
+  if not ByteIsOk(Fetch(TempIP, '.')) then
+    Exit;
+  if not ByteIsOk(Fetch(TempIP, '.')) then
+    Exit;
+  if ByteIsOk(TempIP) then
+    Result := True;
+end;
+
+{==============================================================================}
+
+function IsIP6(const Value: string): Boolean;
+var
+  TempIP: string;
+  s,t: string;
+  x: integer;
+  partcount: integer;
+  zerocount: integer;
+  First: Boolean;
+begin
+  TempIP := Value;
+  Result := False;
+  if Value = '::' then
+  begin
+    Result := True;
+    Exit;
+  end;
+  partcount := 0;
+  zerocount := 0;
+  First := True;
+  while tempIP <> '' do
+  begin
+    s := fetch(TempIP, ':');
+    if not(First) and (s = '') then
+      Inc(zerocount);
+    First := False;
+    if zerocount > 1 then
+      break;
+    Inc(partCount);
+    if s = '' then
+      Continue;
+    if partCount > 8 then
+      break;
+    if tempIP = '' then
+    begin
+      t := SeparateRight(s, '%');
+      s := SeparateLeft(s, '%');
+      x := StrToIntDef('$' + t, -1);
+      if (x < 0) or (x > $ffff) then
+        break;
+    end;
+    x := StrToIntDef('$' + s, -1);
+    if (x < 0) or (x > $ffff) then
+      break;
+    if tempIP = '' then
+      if not((PartCount = 1) and (ZeroCount = 0)) then
+        Result := True;
+  end;
+end;
+
+{==============================================================================}
+function IPToID(Host: string): Ansistring;
+var
+  s: string;
+  i, x: Integer;
+begin
+  Result := '';
+  for x := 0 to 3 do
+  begin
+    s := Fetch(Host, '.');
+    i := StrToIntDef(s, 0);
+    Result := Result + AnsiChar(i);
+  end;
+end;
+
+{==============================================================================}
+
+function StrToIp(value: string): integer;
+var
+  s: string;
+  i, x: Integer;
+begin
+  Result := 0;
+  for x := 0 to 3 do
+  begin
+    s := Fetch(value, '.');
+    i := StrToIntDef(s, 0);
+    Result := (256 * Result) + i;
+  end;
+end;
+
+{==============================================================================}
+
+function IpToStr(value: integer): string;
+var
+  x1, x2: word;
+  y1, y2: byte;
+begin
+  Result := '';
+  x1 := value shr 16;
+  x2 := value and $FFFF;
+  y1 := x1 div $100;
+  y2 := x1 mod $100;
+  Result := inttostr(y1) + '.' + inttostr(y2) + '.';
+  y1 := x2 div $100;
+  y2 := x2 mod $100;
+  Result := Result + inttostr(y1) + '.' + inttostr(y2);
+end;
+
+{==============================================================================}
+
+function ExpandIP6(Value: AnsiString): AnsiString;
+var
+ n: integer;
+ s: ansistring;
+ x: integer;
+begin
+  Result := '';
+  if value = '' then
+    exit;
+  x := countofchar(value, ':');
+  if x > 7 then
+    exit;
+  if value[1] = ':' then
+    value := '0' + value;
+  if value[length(value)] = ':' then
+    value := value + '0';
+  x := 8 - x;
+  s := '';
+  for n := 1 to x do
+    s := s + ':0';
+  s := s + ':';
+  Result := replacestring(value, '::', s);
+end;
+{==============================================================================}
+
+function StrToIp6(Value: string): TIp6Bytes;
+var
+ IPv6: TIp6Words;
+ Index: Integer;
+ n: integer;
+ b1, b2: byte;
+ s: string;
+ x: integer;
+begin
+  for n := 0 to 15 do
+    Result[n] := 0;
+  for n := 0 to 7 do
+    Ipv6[n] := 0;
+  Index := 0;
+  Value := ExpandIP6(value);
+  if value = '' then
+    exit;
+  while Value <> '' do
+  begin
+    if Index > 7 then
+      Exit;
+    s := fetch(value, ':');
+    if s = '@' then
+      break;
+    if s = '' then
+    begin
+      IPv6[Index] := 0;
+    end
+    else
+    begin
+      x := StrToIntDef('$' + s, -1);
+      if (x > 65535) or (x < 0) then
+        Exit;
+      IPv6[Index] := x;
+    end;
+    Inc(Index);
+  end;
+  for n := 0 to 7 do
+  begin
+    b1 := ipv6[n] div 256;
+    b2 := ipv6[n] mod 256;
+    Result[n * 2] := b1;
+    Result[(n * 2) + 1] := b2;
+  end;
+end;
+
+{==============================================================================}
+//based on routine by the Free Pascal development team
+function Ip6ToStr(value: TIp6Bytes): string;
+var
+  i, x: byte;
+  zr1,zr2: set of byte;
+  zc1,zc2: byte;
+  have_skipped: boolean;
+  ip6w: TIp6words;
+begin
+  zr1 := [];
+  zr2 := [];
+  zc1 := 0;
+  zc2 := 0;
+  for i := 0 to 7 do
+  begin
+    x := i * 2;
+    ip6w[i] := value[x] * 256 + value[x + 1];
+    if ip6w[i] = 0 then
+    begin
+      include(zr2, i);
+      inc(zc2);
+    end
+    else
+    begin
+      if zc1 < zc2 then
+      begin
+        zc1 := zc2;
+        zr1 := zr2;
+        zc2 := 0;
+        zr2 := [];
+      end;
+    end;
+  end;
+  if zc1 < zc2 then
+  begin
+    zr1 := zr2;
+  end;
+  SetLength(Result, 8*5-1);
+  SetLength(Result, 0);
+  have_skipped := false;
+  for i := 0 to 7 do
+  begin
+    if not(i in zr1) then
+    begin
+      if have_skipped then
+      begin
+        if Result = '' then
+          Result := '::'
+        else
+          Result := Result + ':';
+        have_skipped := false;
+      end;
+      Result := Result + IntToHex(Ip6w[i], 1) + ':';
+    end
+    else
+    begin
+      have_skipped := true;
+    end;
+  end;
+  if have_skipped then
+    if Result = '' then
+      Result := '::0'
+    else
+      Result := Result + ':';
+
+  if Result = '' then
+    Result := '::0';
+  if not (7 in zr1) then
+    SetLength(Result, Length(Result)-1);
+  Result := LowerCase(result);
+end;
+
+{==============================================================================}
+function ReverseIP(Value: AnsiString): AnsiString;
+var
+  x: Integer;
+begin
+  Result := '';
+  repeat
+    x := LastDelimiter('.', Value);
+    Result := Result + '.' + Copy(Value, x + 1, Length(Value) - x);
+    Delete(Value, x, Length(Value) - x + 1);
+  until x < 1;
+  if Length(Result) > 0 then
+    if Result[1] = '.' then
+      Delete(Result, 1, 1);
+end;
+
+{==============================================================================}
+function ReverseIP6(Value: AnsiString): AnsiString;
+var
+  ip6: TIp6bytes;
+  n: integer;
+  x, y: integer;
+begin
+  ip6 := StrToIP6(Value);
+  x := ip6[15] div 16;
+  y := ip6[15] mod 16;
+  Result := IntToHex(y, 1) + '.' + IntToHex(x, 1);
+  for n := 14 downto 0 do
+  begin
+    x := ip6[n] div 16;
+    y := ip6[n] mod 16;
+    Result := Result + '.' + IntToHex(y, 1) + '.' + IntToHex(x, 1);
+  end;
+end;
+
+{==============================================================================}
+end.
diff --git a/Units/Synapse/synamisc.pas b/Units/Synapse/synamisc.pas
index 1bcfe6d..b88b3df 100644
--- a/Units/Synapse/synamisc.pas
+++ b/Units/Synapse/synamisc.pas
@@ -1,394 +1,394 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 001.003.000 |
-|==============================================================================|
-| Content: misc. procedures and functions                                      |
-|==============================================================================|
-| Copyright (c)1999-2010, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c) 2002-2010.               |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{:@abstract(Misc. network based utilities)}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$Q-}
-{$H+}
-
-{$IFDEF UNICODE}
-  {$WARN IMPLICIT_STRING_CAST OFF}
-  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
-{$ENDIF}
-
-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}
-  Libc;
-{$ELSE}
-  Windows;
-{$ENDIF}
-
-Type
-  {:@abstract(This record contains information about proxy setting.)}
-  TProxySetting = record
-    Host: string;
-    Port: string;
-    Bypass: string;
-  end;
-
-{:By this function you can turn-on computer on network, if this computer
- supporting Wake-on-lan feature. You need MAC number (network card indentifier)
- of computer for turn-on. You can also assign target IP addres. If you not
- specify it, then is used broadcast for delivery magic wake-on packet. However
- broadcasts workinh only on your local network. When you need to wake-up
- computer on another network, you must specify any existing IP addres on same
- network segment as targeting computer.}
-procedure WakeOnLan(MAC, IP: string);
-
-{:Autodetect current DNS servers used by system. If is defined more then one DNS
- server, then result is comma-delimited.}
-function GetDNS: string;
-
-{:Autodetect InternetExplorer proxy setting for given protocol. This function
-working only on windows!}
-function GetIEProxy(protocol: string): TProxySetting;
-
-{:Return all known IP addresses on local system. Addresses are divided by comma.}
-function GetLocalIPs: string;
-
-implementation
-
-{==============================================================================}
-procedure WakeOnLan(MAC, IP: string);
-var
-  sock: TUDPBlockSocket;
-  HexMac: Ansistring;
-  data: Ansistring;
-  n: integer;
-  b: Byte;
-begin
-  if MAC <> '' then
-  begin
-    MAC := ReplaceString(MAC, '-', '');
-    MAC := ReplaceString(MAC, ':', '');
-    if Length(MAC) < 12 then
-      Exit;
-    HexMac := '';
-    for n := 0 to 5 do
-    begin
-      b := StrToIntDef('$' + MAC[n * 2 + 1] + MAC[n * 2 + 2], 0);
-      HexMac := HexMac + char(b);
-    end;
-    if IP = '' then
-      IP := cBroadcast;
-    sock := TUDPBlockSocket.Create;
-    try
-      sock.CreateSocket;
-      sock.EnableBroadcast(true);
-      sock.Connect(IP, '9');
-      data := #$FF + #$FF + #$FF + #$FF + #$FF + #$FF;
-      for n := 1 to 16 do
-        data := data + HexMac;
-      sock.SendString(data);
-    finally
-      sock.Free;
-    end;
-  end;
-end;
-
-{==============================================================================}
-
-{$IFNDEF LINUX}
-function GetDNSbyIpHlp: string;
-type
-  PTIP_ADDRESS_STRING = ^TIP_ADDRESS_STRING;
-  TIP_ADDRESS_STRING = array[0..15] of Ansichar;
-  PTIP_ADDR_STRING = ^TIP_ADDR_STRING;
-  TIP_ADDR_STRING = packed record
-    Next: PTIP_ADDR_STRING;
-    IpAddress: TIP_ADDRESS_STRING;
-    IpMask: TIP_ADDRESS_STRING;
-    Context: DWORD;
-  end;
-  PTFixedInfo = ^TFixedInfo;
-  TFixedInfo = packed record
-    HostName: array[1..128 + 4] of Ansichar;
-    DomainName: array[1..128 + 4] of Ansichar;
-    CurrentDNSServer: PTIP_ADDR_STRING;
-    DNSServerList: TIP_ADDR_STRING;
-    NodeType: UINT;
-    ScopeID: array[1..256 + 4] of Ansichar;
-    EnableRouting: UINT;
-    EnableProxy: UINT;
-    EnableDNS: UINT;
-  end;
-const
-  IpHlpDLL = 'IPHLPAPI.DLL';
-var
-  IpHlpModule: THandle;
-  FixedInfo: PTFixedInfo;
-  InfoSize: Longint;
-  PDnsServer: PTIP_ADDR_STRING;
-  err: integer;
-  GetNetworkParams: function(FixedInfo: PTFixedInfo; pOutPutLen: PULONG): DWORD; stdcall;
-begin
-  InfoSize := 0;
-  Result := '...';
-  IpHlpModule := LoadLibrary(IpHlpDLL);
-  if IpHlpModule = 0 then
-    exit;
-  try
-    GetNetworkParams := GetProcAddress(IpHlpModule,PAnsiChar(AnsiString('GetNetworkParams')));
-    if @GetNetworkParams = nil then
-      Exit;
-    err := GetNetworkParams(Nil, @InfoSize);
-    if err <> ERROR_BUFFER_OVERFLOW then
-      Exit;
-    Result := '';
-    GetMem (FixedInfo, InfoSize);
-    try
-      err := GetNetworkParams(FixedInfo, @InfoSize);
-      if err <> ERROR_SUCCESS then
-        exit;
-      with FixedInfo^ do
-      begin
-        Result := DnsServerList.IpAddress;
-        PDnsServer := DnsServerList.Next;
-        while PDnsServer <> Nil do
-        begin
-          if Result <> '' then
-            Result := Result + ',';
-          Result := Result + PDnsServer^.IPAddress;
-          PDnsServer := PDnsServer.Next;
-        end;
-    end;
-    finally
-      FreeMem(FixedInfo);
-    end;
-  finally
-    FreeLibrary(IpHlpModule);
-  end;
-end;
-
-function ReadReg(SubKey, Vn: PChar): string;
-var
- OpenKey: HKEY;
- DataType, DataSize: integer;
- Temp: array [0..2048] of char;
-begin
-  Result := '';
-  if RegOpenKeyEx(HKEY_LOCAL_MACHINE, SubKey, REG_OPTION_NON_VOLATILE,
-    KEY_READ, OpenKey) = ERROR_SUCCESS then
-  begin
-    DataType := REG_SZ;
-    DataSize := SizeOf(Temp);
-    if RegQueryValueEx(OpenKey, Vn, nil, @DataType, @Temp, @DataSize) = ERROR_SUCCESS then
-      SetString(Result, Temp, DataSize div SizeOf(Char) - 1);
-    RegCloseKey(OpenKey);
-   end;
-end ;
-{$ENDIF}
-
-function GetDNS: string;
-{$IFDEF LINUX}
-var
-  l: TStringList;
-  n: integer;
-begin
-  Result := '';
-  l := TStringList.Create;
-  try
-    l.LoadFromFile('/etc/resolv.conf');
-    for n := 0 to l.Count - 1 do
-      if Pos('NAMESERVER', uppercase(l[n])) = 1 then
-      begin
-        if Result <> '' then
-          Result := Result + ',';
-        Result := Result + SeparateRight(l[n], ' ');
-      end;
-  finally
-    l.Free;
-  end;
-end;
-{$ELSE}
-const
-  NTdyn = 'System\CurrentControlSet\Services\Tcpip\Parameters\Temporary';
-  NTfix = 'System\CurrentControlSet\Services\Tcpip\Parameters';
-  W9xfix = 'System\CurrentControlSet\Services\MSTCP';
-begin
-  Result := GetDNSbyIpHlp;
-  if Result = '...' then
-  begin
-    if Win32Platform = VER_PLATFORM_WIN32_NT then
-    begin
-      Result := ReadReg(NTdyn, 'NameServer');
-      if result = '' then
-        Result := ReadReg(NTfix, 'NameServer');
-      if result = '' then
-        Result := ReadReg(NTfix, 'DhcpNameServer');
-    end
-    else
-      Result := ReadReg(W9xfix, 'NameServer');
-    Result := ReplaceString(trim(Result), ' ', ',');
-  end;
-end;
-{$ENDIF}
-
-{==============================================================================}
-
-function GetIEProxy(protocol: string): TProxySetting;
-{$IFDEF LINUX}
-begin
-  Result.Host := '';
-  Result.Port := '';
-  Result.Bypass := '';
-end;
-{$ELSE}
-type
-  PInternetProxyInfo = ^TInternetProxyInfo;
-  TInternetProxyInfo = packed record
-    dwAccessType: DWORD;
-    lpszProxy: LPCSTR;
-    lpszProxyBypass: LPCSTR;
-  end;
-const
-  INTERNET_OPTION_PROXY = 38;
-  INTERNET_OPEN_TYPE_PROXY = 3;
-  WininetDLL = 'WININET.DLL';
-var
-  WininetModule: THandle;
-  ProxyInfo: PInternetProxyInfo;
-  Err: Boolean;
-  Len: DWORD;
-  Proxy: string;
-  DefProxy: string;
-  ProxyList: TStringList;
-  n: integer;
-  InternetQueryOption: function (hInet: Pointer; dwOption: DWORD;
-    lpBuffer: Pointer; var lpdwBufferLength: DWORD): BOOL; stdcall;
-begin
-  Result.Host := '';
-  Result.Port := '';
-  Result.Bypass := '';
-  WininetModule := LoadLibrary(WininetDLL);
-  if WininetModule = 0 then
-    exit;
-  try
-    InternetQueryOption := GetProcAddress(WininetModule,PAnsiChar(AnsiString('InternetQueryOptionA')));
-    if @InternetQueryOption = nil then
-      Exit;
-
-    if protocol = '' then
-      protocol := 'http';
-    Len := 4096;
-    GetMem(ProxyInfo, Len);
-    ProxyList := TStringList.Create;
-    try
-      Err := InternetQueryOption(nil, INTERNET_OPTION_PROXY, ProxyInfo, Len);
-      if Err then
-        if ProxyInfo^.dwAccessType = INTERNET_OPEN_TYPE_PROXY then
-        begin
-          ProxyList.CommaText := ReplaceString(ProxyInfo^.lpszProxy, ' ', ',');
-          Proxy := '';
-          DefProxy := '';
-          for n := 0 to ProxyList.Count -1 do
-          begin
-            if Pos(lowercase(protocol) + '=', lowercase(ProxyList[n])) = 1 then
-            begin
-              Proxy := SeparateRight(ProxyList[n], '=');
-              break;
-            end;
-            if Pos('=', ProxyList[n]) < 1 then
-              DefProxy := ProxyList[n];
-          end;
-          if Proxy = '' then
-            Proxy := DefProxy;
-          if Proxy <> '' then
-          begin
-            Result.Host := Trim(SeparateLeft(Proxy, ':'));
-            Result.Port := Trim(SeparateRight(Proxy, ':'));
-          end;
-          Result.Bypass := ReplaceString(ProxyInfo^.lpszProxyBypass, ' ', ',');
-        end;
-    finally
-      ProxyList.Free;
-      FreeMem(ProxyInfo);
-    end;
-  finally
-    FreeLibrary(WininetModule);
-  end;
-end;
-{$ENDIF}
-
-{==============================================================================}
-
-function GetLocalIPs: string;
-var
-  TcpSock: TTCPBlockSocket;
-  ipList: TStringList;
-begin
-  Result := '';
-  ipList := TStringList.Create;
-  try
-    TcpSock := TTCPBlockSocket.create;
-    try
-      TcpSock.ResolveNameToIP(TcpSock.LocalName, ipList);
-      Result := ipList.CommaText;
-    finally
-      TcpSock.Free;
-    end;
-  finally
-    ipList.Free;
-  end;
-end;
-
-{==============================================================================}
-
-end.
+{==============================================================================|
+| Project : Ararat Synapse                                       | 001.003.000 |
+|==============================================================================|
+| Content: misc. procedures and functions                                      |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c) 2002-2010.               |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@abstract(Misc. network based utilities)}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$Q-}
+{$H+}
+
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+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}
+  Libc;
+{$ELSE}
+  Windows;
+{$ENDIF}
+
+Type
+  {:@abstract(This record contains information about proxy setting.)}
+  TProxySetting = record
+    Host: string;
+    Port: string;
+    Bypass: string;
+  end;
+
+{:By this function you can turn-on computer on network, if this computer
+ supporting Wake-on-lan feature. You need MAC number (network card indentifier)
+ of computer for turn-on. You can also assign target IP addres. If you not
+ specify it, then is used broadcast for delivery magic wake-on packet. However
+ broadcasts workinh only on your local network. When you need to wake-up
+ computer on another network, you must specify any existing IP addres on same
+ network segment as targeting computer.}
+procedure WakeOnLan(MAC, IP: string);
+
+{:Autodetect current DNS servers used by system. If is defined more then one DNS
+ server, then result is comma-delimited.}
+function GetDNS: string;
+
+{:Autodetect InternetExplorer proxy setting for given protocol. This function
+working only on windows!}
+function GetIEProxy(protocol: string): TProxySetting;
+
+{:Return all known IP addresses on local system. Addresses are divided by comma.}
+function GetLocalIPs: string;
+
+implementation
+
+{==============================================================================}
+procedure WakeOnLan(MAC, IP: string);
+var
+  sock: TUDPBlockSocket;
+  HexMac: Ansistring;
+  data: Ansistring;
+  n: integer;
+  b: Byte;
+begin
+  if MAC <> '' then
+  begin
+    MAC := ReplaceString(MAC, '-', '');
+    MAC := ReplaceString(MAC, ':', '');
+    if Length(MAC) < 12 then
+      Exit;
+    HexMac := '';
+    for n := 0 to 5 do
+    begin
+      b := StrToIntDef('$' + MAC[n * 2 + 1] + MAC[n * 2 + 2], 0);
+      HexMac := HexMac + char(b);
+    end;
+    if IP = '' then
+      IP := cBroadcast;
+    sock := TUDPBlockSocket.Create;
+    try
+      sock.CreateSocket;
+      sock.EnableBroadcast(true);
+      sock.Connect(IP, '9');
+      data := #$FF + #$FF + #$FF + #$FF + #$FF + #$FF;
+      for n := 1 to 16 do
+        data := data + HexMac;
+      sock.SendString(data);
+    finally
+      sock.Free;
+    end;
+  end;
+end;
+
+{==============================================================================}
+
+{$IFNDEF LINUX}
+function GetDNSbyIpHlp: string;
+type
+  PTIP_ADDRESS_STRING = ^TIP_ADDRESS_STRING;
+  TIP_ADDRESS_STRING = array[0..15] of Ansichar;
+  PTIP_ADDR_STRING = ^TIP_ADDR_STRING;
+  TIP_ADDR_STRING = packed record
+    Next: PTIP_ADDR_STRING;
+    IpAddress: TIP_ADDRESS_STRING;
+    IpMask: TIP_ADDRESS_STRING;
+    Context: DWORD;
+  end;
+  PTFixedInfo = ^TFixedInfo;
+  TFixedInfo = packed record
+    HostName: array[1..128 + 4] of Ansichar;
+    DomainName: array[1..128 + 4] of Ansichar;
+    CurrentDNSServer: PTIP_ADDR_STRING;
+    DNSServerList: TIP_ADDR_STRING;
+    NodeType: UINT;
+    ScopeID: array[1..256 + 4] of Ansichar;
+    EnableRouting: UINT;
+    EnableProxy: UINT;
+    EnableDNS: UINT;
+  end;
+const
+  IpHlpDLL = 'IPHLPAPI.DLL';
+var
+  IpHlpModule: THandle;
+  FixedInfo: PTFixedInfo;
+  InfoSize: Longint;
+  PDnsServer: PTIP_ADDR_STRING;
+  err: integer;
+  GetNetworkParams: function(FixedInfo: PTFixedInfo; pOutPutLen: PULONG): DWORD; stdcall;
+begin
+  InfoSize := 0;
+  Result := '...';
+  IpHlpModule := LoadLibrary(IpHlpDLL);
+  if IpHlpModule = 0 then
+    exit;
+  try
+    GetNetworkParams := GetProcAddress(IpHlpModule,PAnsiChar(AnsiString('GetNetworkParams')));
+    if @GetNetworkParams = nil then
+      Exit;
+    err := GetNetworkParams(Nil, @InfoSize);
+    if err <> ERROR_BUFFER_OVERFLOW then
+      Exit;
+    Result := '';
+    GetMem (FixedInfo, InfoSize);
+    try
+      err := GetNetworkParams(FixedInfo, @InfoSize);
+      if err <> ERROR_SUCCESS then
+        exit;
+      with FixedInfo^ do
+      begin
+        Result := DnsServerList.IpAddress;
+        PDnsServer := DnsServerList.Next;
+        while PDnsServer <> Nil do
+        begin
+          if Result <> '' then
+            Result := Result + ',';
+          Result := Result + PDnsServer^.IPAddress;
+          PDnsServer := PDnsServer.Next;
+        end;
+    end;
+    finally
+      FreeMem(FixedInfo);
+    end;
+  finally
+    FreeLibrary(IpHlpModule);
+  end;
+end;
+
+function ReadReg(SubKey, Vn: PChar): string;
+var
+ OpenKey: HKEY;
+ DataType, DataSize: integer;
+ Temp: array [0..2048] of char;
+begin
+  Result := '';
+  if RegOpenKeyEx(HKEY_LOCAL_MACHINE, SubKey, REG_OPTION_NON_VOLATILE,
+    KEY_READ, OpenKey) = ERROR_SUCCESS then
+  begin
+    DataType := REG_SZ;
+    DataSize := SizeOf(Temp);
+    if RegQueryValueEx(OpenKey, Vn, nil, @DataType, @Temp, @DataSize) = ERROR_SUCCESS then
+      SetString(Result, Temp, DataSize div SizeOf(Char) - 1);
+    RegCloseKey(OpenKey);
+   end;
+end ;
+{$ENDIF}
+
+function GetDNS: string;
+{$IFDEF LINUX}
+var
+  l: TStringList;
+  n: integer;
+begin
+  Result := '';
+  l := TStringList.Create;
+  try
+    l.LoadFromFile('/etc/resolv.conf');
+    for n := 0 to l.Count - 1 do
+      if Pos('NAMESERVER', uppercase(l[n])) = 1 then
+      begin
+        if Result <> '' then
+          Result := Result + ',';
+        Result := Result + SeparateRight(l[n], ' ');
+      end;
+  finally
+    l.Free;
+  end;
+end;
+{$ELSE}
+const
+  NTdyn = 'System\CurrentControlSet\Services\Tcpip\Parameters\Temporary';
+  NTfix = 'System\CurrentControlSet\Services\Tcpip\Parameters';
+  W9xfix = 'System\CurrentControlSet\Services\MSTCP';
+begin
+  Result := GetDNSbyIpHlp;
+  if Result = '...' then
+  begin
+    if Win32Platform = VER_PLATFORM_WIN32_NT then
+    begin
+      Result := ReadReg(NTdyn, 'NameServer');
+      if result = '' then
+        Result := ReadReg(NTfix, 'NameServer');
+      if result = '' then
+        Result := ReadReg(NTfix, 'DhcpNameServer');
+    end
+    else
+      Result := ReadReg(W9xfix, 'NameServer');
+    Result := ReplaceString(trim(Result), ' ', ',');
+  end;
+end;
+{$ENDIF}
+
+{==============================================================================}
+
+function GetIEProxy(protocol: string): TProxySetting;
+{$IFDEF LINUX}
+begin
+  Result.Host := '';
+  Result.Port := '';
+  Result.Bypass := '';
+end;
+{$ELSE}
+type
+  PInternetProxyInfo = ^TInternetProxyInfo;
+  TInternetProxyInfo = packed record
+    dwAccessType: DWORD;
+    lpszProxy: LPCSTR;
+    lpszProxyBypass: LPCSTR;
+  end;
+const
+  INTERNET_OPTION_PROXY = 38;
+  INTERNET_OPEN_TYPE_PROXY = 3;
+  WininetDLL = 'WININET.DLL';
+var
+  WininetModule: THandle;
+  ProxyInfo: PInternetProxyInfo;
+  Err: Boolean;
+  Len: DWORD;
+  Proxy: string;
+  DefProxy: string;
+  ProxyList: TStringList;
+  n: integer;
+  InternetQueryOption: function (hInet: Pointer; dwOption: DWORD;
+    lpBuffer: Pointer; var lpdwBufferLength: DWORD): BOOL; stdcall;
+begin
+  Result.Host := '';
+  Result.Port := '';
+  Result.Bypass := '';
+  WininetModule := LoadLibrary(WininetDLL);
+  if WininetModule = 0 then
+    exit;
+  try
+    InternetQueryOption := GetProcAddress(WininetModule,PAnsiChar(AnsiString('InternetQueryOptionA')));
+    if @InternetQueryOption = nil then
+      Exit;
+
+    if protocol = '' then
+      protocol := 'http';
+    Len := 4096;
+    GetMem(ProxyInfo, Len);
+    ProxyList := TStringList.Create;
+    try
+      Err := InternetQueryOption(nil, INTERNET_OPTION_PROXY, ProxyInfo, Len);
+      if Err then
+        if ProxyInfo^.dwAccessType = INTERNET_OPEN_TYPE_PROXY then
+        begin
+          ProxyList.CommaText := ReplaceString(ProxyInfo^.lpszProxy, ' ', ',');
+          Proxy := '';
+          DefProxy := '';
+          for n := 0 to ProxyList.Count -1 do
+          begin
+            if Pos(lowercase(protocol) + '=', lowercase(ProxyList[n])) = 1 then
+            begin
+              Proxy := SeparateRight(ProxyList[n], '=');
+              break;
+            end;
+            if Pos('=', ProxyList[n]) < 1 then
+              DefProxy := ProxyList[n];
+          end;
+          if Proxy = '' then
+            Proxy := DefProxy;
+          if Proxy <> '' then
+          begin
+            Result.Host := Trim(SeparateLeft(Proxy, ':'));
+            Result.Port := Trim(SeparateRight(Proxy, ':'));
+          end;
+          Result.Bypass := ReplaceString(ProxyInfo^.lpszProxyBypass, ' ', ',');
+        end;
+    finally
+      ProxyList.Free;
+      FreeMem(ProxyInfo);
+    end;
+  finally
+    FreeLibrary(WininetModule);
+  end;
+end;
+{$ENDIF}
+
+{==============================================================================}
+
+function GetLocalIPs: string;
+var
+  TcpSock: TTCPBlockSocket;
+  ipList: TStringList;
+begin
+  Result := '';
+  ipList := TStringList.Create;
+  try
+    TcpSock := TTCPBlockSocket.create;
+    try
+      TcpSock.ResolveNameToIP(TcpSock.LocalName, ipList);
+      Result := ipList.CommaText;
+    finally
+      TcpSock.Free;
+    end;
+  finally
+    ipList.Free;
+  end;
+end;
+
+{==============================================================================}
+
+end.
diff --git a/Units/Synapse/synaser.pas b/Units/Synapse/synaser.pas
index 5ea07c1..5533b59 100644
--- a/Units/Synapse/synaser.pas
+++ b/Units/Synapse/synaser.pas
@@ -1,2318 +1,2318 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 007.004.000 |
-|==============================================================================|
-| Content: Serial port support                                                 |
-|==============================================================================|
-| Copyright (c)2001-2010, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2001-2010.                |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|  (c)2002, Hans-Georg Joepgen (cpom Comport Ownership Manager and bugfixes)   |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{: @abstract(Serial port communication library)
-This unit contains a class that implements serial port communication for Windows
- or Linux. This class provides numerous methods with same name and functionality
-  as methods of the Ararat Synapse TCP/IP library.
-
-The following is a small example how establish a connection by modem (in this
-case with my USB modem):
-@longcode(#
-  ser:=TBlockSerial.Create;
-  try
-    ser.Connect('COM3');
-    ser.config(460800,8,'N',0,false,true);
-    ser.ATCommand('AT');
-    if (ser.LastError <> 0) or (not ser.ATResult) then
-      Exit;
-    ser.ATConnect('ATDT+420971200111');
-    if (ser.LastError <> 0) or (not ser.ATResult) then
-      Exit;
-    // you are now connected to a modem at +420971200111
-    // you can transmit or receive data now
-  finally
-    ser.free;
-  end;
-#)
-}
-
-//old Delphi does not have MSWINDOWS define.
-{$IFDEF WIN32}
-  {$IFNDEF MSWINDOWS}
-    {$DEFINE MSWINDOWS}
-  {$ENDIF}
-{$ENDIF}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-  {$IFDEF MSWINDOWS}
-    {$ASMMODE intel}
-  {$ENDIF}
-  {define working mode w/o LIBC for fpc}
-  {$DEFINE NO_LIBC}
-{$ENDIF}
-{$Q-}
-{$H+}
-{$M+}
-
-unit synaser;
-
-interface
-
-uses
-{$IFNDEF MSWINDOWS}
-  {$IFNDEF NO_LIBC}
-  Libc,
-  KernelIoctl,
-  {$ELSE}
-  termio, baseunix, unix,
-  {$ENDIF}
-  {$IFNDEF FPC}
-  Types,
-  {$ENDIF}
-{$ELSE}
-  Windows, registry,
-  {$IFDEF FPC}
-  winver,
-  {$ENDIF}
-{$ENDIF}
-  synafpc,
-  Classes, SysUtils, synautil;
-
-const
-  CR = #$0d;
-  LF = #$0a;
-  CRLF = CR + LF;
-  cSerialChunk = 8192;
-
-  LockfileDirectory = '/var/lock'; {HGJ}
-  PortIsClosed = -1;               {HGJ}
-  ErrAlreadyOwned = 9991;          {HGJ}
-  ErrAlreadyInUse = 9992;          {HGJ}
-  ErrWrongParameter = 9993;        {HGJ}
-  ErrPortNotOpen = 9994;           {HGJ}
-  ErrNoDeviceAnswer =  9995;       {HGJ}
-  ErrMaxBuffer = 9996;
-  ErrTimeout = 9997;
-  ErrNotRead = 9998;
-  ErrFrame = 9999;
-  ErrOverrun = 10000;
-  ErrRxOver = 10001;
-  ErrRxParity = 10002;
-  ErrTxFull = 10003;
-
-  dcb_Binary = $00000001;
-  dcb_ParityCheck = $00000002;
-  dcb_OutxCtsFlow = $00000004;
-  dcb_OutxDsrFlow = $00000008;
-  dcb_DtrControlMask = $00000030;
-  dcb_DtrControlDisable = $00000000;
-  dcb_DtrControlEnable = $00000010;
-  dcb_DtrControlHandshake = $00000020;
-  dcb_DsrSensivity = $00000040;
-  dcb_TXContinueOnXoff = $00000080;
-  dcb_OutX = $00000100;
-  dcb_InX = $00000200;
-  dcb_ErrorChar = $00000400;
-  dcb_NullStrip = $00000800;
-  dcb_RtsControlMask = $00003000;
-  dcb_RtsControlDisable = $00000000;
-  dcb_RtsControlEnable = $00001000;
-  dcb_RtsControlHandshake = $00002000;
-  dcb_RtsControlToggle = $00003000;
-  dcb_AbortOnError = $00004000;
-  dcb_Reserveds = $FFFF8000;
-
-  {:stopbit value for 1 stopbit}
-  SB1 = 0;
-  {:stopbit value for 1.5 stopbit}
-  SB1andHalf = 1;
-  {:stopbit value for 2 stopbits}
-  SB2 = 2;
-
-{$IFNDEF MSWINDOWS}
-const
-  INVALID_HANDLE_VALUE = THandle(-1);
-  CS7fix = $0000020;
-
-type
-  TDCB = record
-    DCBlength: DWORD;
-    BaudRate: DWORD;
-    Flags: Longint;
-    wReserved: Word;
-    XonLim: Word;
-    XoffLim: Word;
-    ByteSize: Byte;
-    Parity: Byte;
-    StopBits: Byte;
-    XonChar: CHAR;
-    XoffChar: CHAR;
-    ErrorChar: CHAR;
-    EofChar: CHAR;
-    EvtChar: CHAR;
-    wReserved1: Word;
-  end;
-  PDCB = ^TDCB;
-
-const
-{$IFDEF LINUX}
-  MaxRates = 30;
-{$ELSE}
-  MaxRates = 19;  //FPC on some platforms not know high speeds?
-{$ENDIF}
-  Rates: array[0..MaxRates, 0..1] of cardinal =
-  (
-    (0, B0),
-    (50, B50),
-    (75, B75),
-    (110, B110),
-    (134, B134),
-    (150, B150),
-    (200, B200),
-    (300, B300),
-    (600, B600),
-    (1200, B1200),
-    (1800, B1800),
-    (2400, B2400),
-    (4800, B4800),
-    (9600, B9600),
-    (19200, B19200),
-    (38400, B38400),
-    (57600, B57600),
-    (115200, B115200),
-    (230400, B230400),
-    (460800, B460800)
-{$IFDEF LINUX}
-    ,(500000, B500000),
-    (576000, B576000),
-    (921600, B921600),
-    (1000000, B1000000),
-    (1152000, B1152000),
-    (1500000, B1500000),
-    (2000000, B2000000),
-    (2500000, B2500000),
-    (3000000, B3000000),
-    (3500000, B3500000),
-    (4000000, B4000000)
-{$ENDIF}
-    );
-{$ENDIF}
-
-const
-  sOK = 0;
-  sErr = integer(-1);
-
-type
-
-  {:Possible status event types for @link(THookSerialStatus)}
-  THookSerialReason = (
-    HR_SerialClose,
-    HR_Connect,
-    HR_CanRead,
-    HR_CanWrite,
-    HR_ReadCount,
-    HR_WriteCount,
-    HR_Wait
-    );
-
-  {:procedural prototype for status event hooking}
-  THookSerialStatus = procedure(Sender: TObject; Reason: THookSerialReason;
-    const Value: string) of object;
-
-  {:@abstract(Exception type for SynaSer errors)}
-  ESynaSerError = class(Exception)
-  public
-    ErrorCode: integer;
-    ErrorMessage: string;
-  end;
-
-  {:@abstract(Main class implementing all communication routines)}
-  TBlockSerial = class(TObject)
-  protected
-    FOnStatus: THookSerialStatus;
-    Fhandle: THandle;
-    FTag: integer;
-    FDevice: string;
-    FLastError: integer;
-    FLastErrorDesc: string;
-    FBuffer: AnsiString;
-    FRaiseExcept: boolean;
-    FRecvBuffer: integer;
-    FSendBuffer: integer;
-    FModemWord: integer;
-    FRTSToggle: Boolean;
-    FDeadlockTimeout: integer;
-    FInstanceActive: boolean;      {HGJ}
-    FTestDSR: Boolean;
-    FTestCTS: Boolean;
-    FLastCR: Boolean;
-    FLastLF: Boolean;
-    FMaxLineLength: Integer;
-    FLinuxLock: Boolean;
-    FMaxSendBandwidth: Integer;
-    FNextSend: LongWord;
-    FMaxRecvBandwidth: Integer;
-    FNextRecv: LongWord;
-    FConvertLineEnd: Boolean;
-    FATResult: Boolean;
-    FAtTimeout: integer;
-    FInterPacketTimeout: Boolean;
-    FComNr: integer;
-{$IFDEF MSWINDOWS}
-    FPortAddr: Word;
-    function CanEvent(Event: dword; Timeout: integer): boolean;
-    procedure DecodeCommError(Error: DWord); virtual;
-    function GetPortAddr: Word;  virtual;
-    function ReadTxEmpty(PortAddr: Word): Boolean; virtual;
-{$ENDIF}
-    procedure SetSizeRecvBuffer(size: integer); virtual;
-    function GetDSR: Boolean; virtual;
-    procedure SetDTRF(Value: Boolean); virtual;
-    function GetCTS: Boolean; virtual;
-    procedure SetRTSF(Value: Boolean); virtual;
-    function GetCarrier: Boolean; virtual;
-    function GetRing: Boolean; virtual;
-    procedure DoStatus(Reason: THookSerialReason; const Value: string); virtual;
-    procedure GetComNr(Value: string); virtual;
-    function PreTestFailing: boolean; virtual;{HGJ}
-    function TestCtrlLine: Boolean; virtual;
-{$IFNDEF MSWINDOWS}
-    procedure DcbToTermios(const dcb: TDCB; var term: termios); virtual;
-    procedure TermiosToDcb(const term: termios; var dcb: TDCB); virtual;
-{$ENDIF}
-{$IFDEF LINUX}
-    function ReadLockfile: integer; virtual;
-    function LockfileName: String; virtual;
-    procedure CreateLockfile(PidNr: integer); virtual;
-{$ENDIF}
-    procedure LimitBandwidth(Length: Integer; MaxB: integer; var Next: LongWord); virtual;
-    procedure SetBandwidth(Value: Integer); virtual;
-  public
-    {: data Control Block with communication parameters. Usable only when you
-     need to call API directly.}
-    DCB: Tdcb;
-{$IFNDEF MSWINDOWS}
-    TermiosStruc: termios;
-{$ENDIF}
-    {:Object constructor.}
-    constructor Create;
-    {:Object destructor.}
-    destructor Destroy; override;
-
-    {:Returns a string containing the version number of the library.}
-    class function GetVersion: string; virtual;
-
-    {:Destroy handle in use. It close connection to serial port.}
-    procedure CloseSocket; virtual;
-
-    {:Reconfigure communication parameters on the fly. You must be connected to
-     port before!
-     @param(baud Define connection speed. Baud rate can be from 50 to 4000000
-      bits per second. (it depends on your hardware!))
-     @param(bits Number of bits in communication.)
-     @param(parity Define communication parity (N - None, O - Odd, E - Even, M - Mark or S - Space).)
-     @param(stop Define number of stopbits. Use constants @link(SB1),
-      @link(SB1andHalf) and @link(SB2).)
-     @param(softflow Enable XON/XOFF handshake.)
-     @param(hardflow Enable CTS/RTS handshake.)}
-    procedure Config(baud, bits: integer; parity: char; stop: integer;
-      softflow, hardflow: boolean); virtual;
-
-    {:Connects to the port indicated by comport. Comport can be used in Windows
-     style (COM2), or in Linux style (/dev/ttyS1). When you use windows style
-     in Linux, then it will be converted to Linux name. And vice versa! However
-     you can specify any device name! (other device names then standart is not
-     converted!)
-
-     After successfull connection the DTR signal is set (if you not set hardware
-     handshake, then the RTS signal is set, too!)
-
-     Connection parameters is predefined by your system configuration. If you
-     need use another parameters, then you can use Config method after.
-     Notes:
-
-      - Remember, the commonly used serial Laplink cable does not support
-       hardware handshake.
-
-      - Before setting any handshake you must be sure that it is supported by
-       your hardware.
-
-      - Some serial devices are slow. In some cases you must wait up to a few
-       seconds after connection for the device to respond.
-
-      - when you connect to a modem device, then is best to test it by an empty
-       AT command. (call ATCommand('AT'))}
-    procedure Connect(comport: string); virtual;
-
-    {:Set communication parameters from the DCB structure (the DCB structure is
-     simulated under Linux).}
-    procedure SetCommState; virtual;
-
-    {:Read communication parameters into the DCB structure (DCB structure is
-     simulated under Linux).}
-    procedure GetCommState; virtual;
-
-    {:Sends Length bytes of data from Buffer through the connected port.}
-    function SendBuffer(buffer: pointer; length: integer): integer; virtual;
-
-    {:One data BYTE is sent.}
-    procedure SendByte(data: byte); virtual;
-
-    {:Send the string in the data parameter. No terminator is appended by this
-     method. If you need to send a string with CR/LF terminator, you must append
-     the CR/LF characters to the data string!
-
-     Since no terminator is appended, you can use this function for sending
-     binary data too.}
-    procedure SendString(data: AnsiString); virtual;
-
-    {:send four bytes as integer.}
-    procedure SendInteger(Data: integer); virtual;
-
-    {:send data as one block. Each block begins with integer value with Length
-     of block.}
-    procedure SendBlock(const Data: AnsiString); virtual;
-
-    {:send content of stream from current position}
-    procedure SendStreamRaw(const Stream: TStream); virtual;
-
-    {:send content of stream as block. see @link(SendBlock)}
-    procedure SendStream(const Stream: TStream); virtual;
-
-    {:send content of stream as block, but this is compatioble with Indy library.
-     (it have swapped lenght of block). See @link(SendStream)}
-    procedure SendStreamIndy(const Stream: TStream); virtual;
-
-    {:Waits until the allocated buffer is filled by received data. Returns number
-     of data bytes received, which equals to the Length value under normal
-     operation. If it is not equal, the communication channel is possibly broken.
-
-     This method not using any internal buffering, like all others receiving
-     methods. You cannot freely combine this method with all others receiving
-     methods!}
-    function RecvBuffer(buffer: pointer; length: integer): integer; virtual;
-
-    {:Method waits until data is received. If no data is received within
-     the Timeout (in milliseconds) period, @link(LastError) is set to
-     @link(ErrTimeout). This method is used to read any amount of data
-     (e. g. 1MB), and may be freely combined with all receviving methods what
-     have Timeout parameter, like the @link(RecvString), @link(RecvByte) or
-     @link(RecvTerminated) methods.}
-    function RecvBufferEx(buffer: pointer; length: integer; timeout: integer): integer; virtual;
-
-    {:It is like recvBufferEx, but data is readed to dynamicly allocated binary
-     string.}
-    function RecvBufferStr(Length: Integer; Timeout: Integer): AnsiString; virtual;
-
-    {:Read all available data and return it in the function result string. This
-     function may be combined with @link(RecvString), @link(RecvByte) or related
-     methods.}
-    function RecvPacket(Timeout: Integer): AnsiString; virtual;
-
-    {:Waits until one data byte is received which is returned as the function
-     result. If no data is received within the Timeout (in milliseconds) period,
-     @link(LastError) is set to @link(ErrTimeout).}
-    function RecvByte(timeout: integer): byte; virtual;
-
-    {:This method waits until a terminated data string is received. This string
-     is terminated by the Terminator string. The resulting string is returned
-     without this termination string! If no data is received within the Timeout
-     (in milliseconds) period, @link(LastError) is set to @link(ErrTimeout).}
-    function RecvTerminated(Timeout: Integer; const Terminator: AnsiString): AnsiString; virtual;
-
-    {:This method waits until a terminated data string is received. The string
-     is terminated by a CR/LF sequence. The resulting string is returned without
-     the terminator (CR/LF)! If no data is received within the Timeout (in
-     milliseconds) period, @link(LastError) is set to @link(ErrTimeout).
-
-     If @link(ConvertLineEnd) is used, then the CR/LF sequence may not be exactly
-     CR/LF. See the description of @link(ConvertLineEnd).
-
-     This method serves for line protocol implementation and uses its own
-     buffers to maximize performance. Therefore do NOT use this method with the
-     @link(RecvBuffer) method to receive data as it may cause data loss.}
-    function Recvstring(timeout: integer): AnsiString; virtual;
-
-    {:Waits until four data bytes are received which is returned as the function
-     integer result. If no data is received within the Timeout (in milliseconds) period,
-     @link(LastError) is set to @link(ErrTimeout).}
-    function RecvInteger(Timeout: Integer): Integer; virtual;
-
-    {:Waits until one data block is received. See @link(sendblock). If no data
-     is received within the Timeout (in milliseconds) period, @link(LastError)
-     is set to @link(ErrTimeout).}
-    function RecvBlock(Timeout: Integer): AnsiString; virtual;
-
-    {:Receive all data to stream, until some error occured. (for example timeout)}
-    procedure RecvStreamRaw(const Stream: TStream; Timeout: Integer); virtual;
-
-    {:receive requested count of bytes to stream}
-    procedure RecvStreamSize(const Stream: TStream; Timeout: Integer; Size: Integer); virtual;
-
-    {:receive block of data to stream. (Data can be sended by @link(sendstream)}
-    procedure RecvStream(const Stream: TStream; Timeout: Integer); virtual;
-
-    {:receive block of data to stream. (Data can be sended by @link(sendstreamIndy)}
-    procedure RecvStreamIndy(const Stream: TStream; Timeout: Integer); virtual;
-
-    {:Returns the number of received bytes waiting for reading. 0 is returned
-     when there is no data waiting.}
-    function WaitingData: integer; virtual;
-
-    {:Same as @link(WaitingData), but in respect to data in the internal
-     @link(LineBuffer).}
-    function WaitingDataEx: integer; virtual;
-
-    {:Returns the number of bytes waiting to be sent in the output buffer.
-     0 is returned when the output buffer is empty.}
-    function SendingData: integer; virtual;
-
-    {:Enable or disable RTS driven communication (half-duplex). It can be used
-     to communicate with RS485 converters, or other special equipment. If you
-     enable this feature, the system automatically controls the RTS signal.
-
-     Notes:
-
-     - On Windows NT (or higher) ir RTS signal driven by system driver.
-
-     - On Win9x family is used special code for waiting until last byte is
-      sended from your UART.
-
-     - On Linux you must have kernel 2.1 or higher!}
-    procedure EnableRTSToggle(value: boolean); virtual;
-
-    {:Waits until all data to is sent and buffers are emptied.
-     Warning: On Windows systems is this method returns when all buffers are
-     flushed to the serial port controller, before the last byte is sent!}
-    procedure Flush; virtual;
-
-    {:Unconditionally empty all buffers. It is good when you need to interrupt
-     communication and for cleanups.}
-    procedure Purge; virtual;
-
-    {:Returns @True, if you can from read any data from the port. Status is
-     tested for a period of time given by the Timeout parameter (in milliseconds).
-     If the value of the Timeout parameter is 0, the status is tested only once
-     and the function returns immediately. If the value of the Timeout parameter
-     is set to -1, the function returns only after it detects data on the port
-     (this may cause the process to hang).}
-    function CanRead(Timeout: integer): boolean; virtual;
-
-    {:Returns @True, if you can write any data to the port (this function is not
-     sending the contents of the buffer). Status is tested for a period of time
-     given by the Timeout parameter (in milliseconds). If the value of
-     the Timeout parameter is 0, the status is tested only once and the function
-     returns immediately. If the value of the  Timeout parameter is set to -1,
-     the function returns only after it detects that it can write data to
-     the port (this may cause the process to hang).}
-    function CanWrite(Timeout: integer): boolean; virtual;
-
-    {:Same as @link(CanRead), but the test is against data in the internal
-    @link(LineBuffer) too.}
-    function CanReadEx(Timeout: integer): boolean; virtual;
-
-    {:Returns the status word of the modem. Decoding the status word could yield
-     the status of carrier detect signaland other signals. This method is used
-     internally by the modem status reading properties. You usually do not need
-     to call this method directly.}
-    function ModemStatus: integer; virtual;
-
-    {:Send a break signal to the communication device for Duration milliseconds.}
-    procedure SetBreak(Duration: integer); virtual;
-
-    {:This function is designed to send AT commands to the modem. The AT command
-     is sent in the Value parameter and the response is returned in the function
-     return value (may contain multiple lines!).
-     If the AT command is processed successfully (modem returns OK), then the
-     @link(ATResult) property is set to True.
-
-     This function is designed only for AT commands that return OK or ERROR
-     response! To call connection commands the @link(ATConnect) method.
-     Remember, when you connect to a modem device, it is in AT command mode.
-     Now you can send AT commands to the modem. If you need to transfer data to
-     the modem on the other side of the line, you must first switch to data mode
-     using the @link(ATConnect) method.}
-    function ATCommand(value: AnsiString): AnsiString; virtual;
-
-    {:This function is used to send connect type AT commands to the modem. It is
-     for commands to switch to connected state. (ATD, ATA, ATO,...)
-     It sends the AT command in the Value parameter and returns the modem's
-     response (may be multiple lines - usually with connection parameters info).
-     If the AT command is processed successfully (the modem returns CONNECT),
-     then the ATResult property is set to @True.
-
-     This function is designed only for AT commands which respond by CONNECT,
-     BUSY, NO DIALTONE NO CARRIER or ERROR. For other AT commands use the
-     @link(ATCommand) method.
-
-     The connect timeout is 90*@link(ATTimeout). If this command is successful
-     (@link(ATresult) is @true), then the modem is in data state. When you now
-     send or receive some data, it is not to or from your modem, but from the
-     modem on other side of the line. Now you can transfer your data.
-     If the connection attempt failed (@link(ATResult) is @False), then the
-     modem is still in AT command mode.}
-    function ATConnect(value: AnsiString): AnsiString; virtual;
-
-    {:If you "manually" call API functions, forward their return code in
-     the SerialResult parameter to this function, which evaluates it and sets
-     @link(LastError) and @link(LastErrorDesc).}
-    function SerialCheck(SerialResult: integer): integer; virtual;
-
-    {:If @link(Lasterror) is not 0 and exceptions are enabled, then this procedure
-     raises an exception. This method is used internally. You may need it only
-     in special cases.}
-    procedure ExceptCheck; virtual;
-
-    {:Set Synaser to error state with ErrNumber code. Usually used by internal
-     routines.}
-    procedure SetSynaError(ErrNumber: integer); virtual;
-
-    {:Raise Synaser error with ErrNumber code. Usually used by internal routines.}
-    procedure RaiseSynaError(ErrNumber: integer); virtual;
-{$IFDEF LINUX}
-    function  cpomComportAccessible: boolean; virtual;{HGJ}
-    procedure cpomReleaseComport; virtual; {HGJ}
-{$ENDIF}
-    {:True device name of currently used port}
-    property Device: string read FDevice;
-
-    {:Error code of last operation. Value is defined by the host operating
-     system, but value 0 is always OK.}
-    property LastError: integer read FLastError;
-
-    {:Human readable description of LastError code.}
-    property LastErrorDesc: string read FLastErrorDesc;
-
-    {:Indicates if the last @link(ATCommand) or @link(ATConnect) method was successful}
-    property ATResult: Boolean read FATResult;
-
-    {:Read the value of the RTS signal.}
-    property RTS: Boolean write SetRTSF;
-
-    {:Indicates the presence of the CTS signal}
-    property CTS: boolean read GetCTS;
-
-    {:Use this property to set the value of the DTR signal.}
-    property DTR: Boolean write SetDTRF;
-
-    {:Exposes the status of the DSR signal.}
-    property DSR: boolean read GetDSR;
-
-    {:Indicates the presence of the Carrier signal}
-    property Carrier: boolean read GetCarrier;
-
-    {:Reflects the status of the Ring signal.}
-    property Ring: boolean read GetRing;
-
-    {:indicates if this instance of SynaSer is active. (Connected to some port)}
-    property InstanceActive: boolean read FInstanceActive; {HGJ}
-
-    {:Defines maximum bandwidth for all sending operations in bytes per second.
-     If this value is set to 0 (default), bandwidth limitation is not used.}
-    property MaxSendBandwidth: Integer read FMaxSendBandwidth Write FMaxSendBandwidth;
-
-    {:Defines maximum bandwidth for all receiving operations in bytes per second.
-     If this value is set to 0 (default), bandwidth limitation is not used.}
-    property MaxRecvBandwidth: Integer read FMaxRecvBandwidth Write FMaxRecvBandwidth;
-
-    {:Defines maximum bandwidth for all sending and receiving operations
-     in bytes per second. If this value is set to 0 (default), bandwidth
-     limitation is not used.}
-    property MaxBandwidth: Integer Write SetBandwidth;
-
-    {:Size of the Windows internal receive buffer. Default value is usually
-     4096 bytes. Note: Valid only in Windows versions!}
-    property SizeRecvBuffer: integer read FRecvBuffer write SetSizeRecvBuffer;
-  published
-    {:Returns the descriptive text associated with ErrorCode. You need this
-     method only in special cases. Description of LastError is now accessible
-     through the LastErrorDesc property.}
-    class function GetErrorDesc(ErrorCode: integer): string;
-
-    {:Freely usable property}
-    property Tag: integer read FTag write FTag;
-
-    {:Contains the handle of the open communication port.
-    You may need this value to directly call communication functions outside
-    SynaSer.}
-    property Handle: THandle read Fhandle write FHandle;
-
-    {:Internally used read buffer.}
-    property LineBuffer: AnsiString read FBuffer write FBuffer;
-
-    {:If @true, communication errors raise exceptions. If @false (default), only
-     the @link(LastError) value is set.}
-    property RaiseExcept: boolean read FRaiseExcept write FRaiseExcept;
-
-    {:This event is triggered when the communication status changes. It can be
-     used to monitor communication status.}
-    property OnStatus: THookSerialStatus read FOnStatus write FOnStatus;
-
-    {:If you set this property to @true, then the value of the DSR signal
-     is tested before every data transfer. It can be used to detect the presence
-     of a communications device.}
-    property TestDSR: boolean read FTestDSR write FTestDSR;
-
-    {:If you set this property to @true, then the value of the CTS signal
-     is tested before every data transfer. It can be used to detect the presence
-     of a communications device. Warning: This property cannot be used if you
-     need hardware handshake!}
-    property TestCTS: boolean read FTestCTS write FTestCTS;
-
-    {:Use this property you to limit the maximum size of LineBuffer
-     (as a protection against unlimited memory allocation for LineBuffer).
-     Default value is 0 - no limit.}
-    property MaxLineLength: Integer read FMaxLineLength Write FMaxLineLength;
-
-    {:This timeout value is used as deadlock protection when trying to send data
-     to (or receive data from) a device that stopped communicating during data
-     transmission (e.g. by physically disconnecting the device).
-     The timeout value is in milliseconds. The default value is 30,000 (30 seconds).}
-    property DeadlockTimeout: Integer read FDeadlockTimeout Write FDeadlockTimeout;
-
-    {:If set to @true (default value), port locking is enabled (under Linux only).
-     WARNING: To use this feature, the application must run by a user with full
-     permission to the /var/lock directory!}
-    property LinuxLock: Boolean read FLinuxLock write FLinuxLock;
-
-    {:Indicates if non-standard line terminators should be converted to a CR/LF pair
-     (standard DOS line terminator). If @TRUE, line terminators CR, single LF
-     or LF/CR are converted to CR/LF. Defaults to @FALSE.
-     This property has effect only on the behavior of the RecvString method.}
-    property ConvertLineEnd: Boolean read FConvertLineEnd Write FConvertLineEnd;
-
-    {:Timeout for AT modem based operations}
-    property AtTimeout: integer read FAtTimeout Write FAtTimeout;
-
-    {:If @true (default), then all timeouts is timeout between two characters.
-     If @False, then timeout is overall for whoole reading operation.}
-    property InterPacketTimeout: Boolean read FInterPacketTimeout Write FInterPacketTimeout;
-  end;
-
-{:Returns list of existing computer serial ports. Working properly only in Windows!}
-function GetSerialPortNames: string;
-
-implementation
-
-constructor TBlockSerial.Create;
-begin
-  inherited create;
-  FRaiseExcept := false;
-  FHandle := INVALID_HANDLE_VALUE;
-  FDevice := '';
-  FComNr:= PortIsClosed;               {HGJ}
-  FInstanceActive:= false;             {HGJ}
-  Fbuffer := '';
-  FRTSToggle := False;
-  FMaxLineLength := 0;
-  FTestDSR := False;
-  FTestCTS := False;
-  FDeadlockTimeout := 30000;
-  FLinuxLock := True;
-  FMaxSendBandwidth := 0;
-  FNextSend := 0;
-  FMaxRecvBandwidth := 0;
-  FNextRecv := 0;
-  FConvertLineEnd := False;
-  SetSynaError(sOK);
-  FRecvBuffer := 4096;
-  FLastCR := False;
-  FLastLF := False;
-  FAtTimeout := 1000;
-  FInterPacketTimeout := True;
-end;
-
-destructor TBlockSerial.Destroy;
-begin
-  CloseSocket;
-  inherited destroy;
-end;
-
-class function TBlockSerial.GetVersion: string;
-begin
-	Result := 'SynaSer 7.4.0';
-end;
-
-procedure TBlockSerial.CloseSocket;
-begin
-  if Fhandle <> INVALID_HANDLE_VALUE then
-  begin
-    Purge;
-    RTS := False;
-    DTR := False;
-    FileClose(FHandle);
-  end;
-  if InstanceActive then
-  begin
-    {$IFDEF LINUX}
-    if FLinuxLock then
-      cpomReleaseComport;
-    {$ENDIF}
-    FInstanceActive:= false
-  end;
-  Fhandle := INVALID_HANDLE_VALUE;
-  FComNr:= PortIsClosed;
-  SetSynaError(sOK);
-  DoStatus(HR_SerialClose, FDevice);
-end;
-
-{$IFDEF MSWINDOWS}
-function TBlockSerial.GetPortAddr: Word;
-begin
-  Result := 0;
-  if Win32Platform <> VER_PLATFORM_WIN32_NT then
-  begin
-    EscapeCommFunction(FHandle, 10);
-    asm
-      MOV @Result, DX;
-    end;
-  end;
-end;
-
-function TBlockSerial.ReadTxEmpty(PortAddr: Word): Boolean;
-begin
-  Result := True;
-  if Win32Platform <> VER_PLATFORM_WIN32_NT then
-  begin
-    asm
-      MOV DX, PortAddr;
-      ADD DX, 5;
-      IN AL, DX;
-      AND AL, $40;
-      JZ @K;
-      MOV AL,1;
-    @K: MOV @Result, AL;
-    end;
-  end;
-end;
-{$ENDIF}
-
-procedure TBlockSerial.GetComNr(Value: string);
-begin
-  FComNr := PortIsClosed;
-  if pos('COM', uppercase(Value)) = 1 then
-    FComNr := StrToIntdef(copy(Value, 4, Length(Value) - 3), PortIsClosed + 1) - 1;
-  if pos('/DEV/TTYS', uppercase(Value)) = 1 then
-    FComNr := StrToIntdef(copy(Value, 10, Length(Value) - 9), PortIsClosed - 1);
-end;
-
-procedure TBlockSerial.SetBandwidth(Value: Integer);
-begin
-  MaxSendBandwidth := Value;
-  MaxRecvBandwidth := Value;
-end;
-
-procedure TBlockSerial.LimitBandwidth(Length: Integer; MaxB: integer; var Next: LongWord);
-var
-  x: LongWord;
-  y: LongWord;
-begin
-  if MaxB > 0 then
-  begin
-    y := GetTick;
-    if Next > y then
-    begin
-      x := Next - y;
-      if x > 0 then
-      begin
-        DoStatus(HR_Wait, IntToStr(x));
-        sleep(x);
-      end;
-    end;
-    Next := GetTick + Trunc((Length / MaxB) * 1000);
-  end;
-end;
-
-procedure TBlockSerial.Config(baud, bits: integer; parity: char; stop: integer;
-  softflow, hardflow: boolean);
-begin
-  FillChar(dcb, SizeOf(dcb), 0);
-  GetCommState;
-  dcb.DCBlength := SizeOf(dcb);
-  dcb.BaudRate := baud;
-  dcb.ByteSize := bits;
-  case parity of
-    'N', 'n': dcb.parity := 0;
-    'O', 'o': dcb.parity := 1;
-    'E', 'e': dcb.parity := 2;
-    'M', 'm': dcb.parity := 3;
-    'S', 's': dcb.parity := 4;
-  end;
-  dcb.StopBits := stop;
-  dcb.XonChar := #17;
-  dcb.XoffChar := #19;
-  dcb.XonLim := FRecvBuffer div 4;
-  dcb.XoffLim := FRecvBuffer div 4;
-  dcb.Flags := dcb_Binary;
-  if softflow then
-    dcb.Flags := dcb.Flags or dcb_OutX or dcb_InX;
-  if hardflow then
-    dcb.Flags := dcb.Flags or dcb_OutxCtsFlow or dcb_RtsControlHandshake
-  else
-    dcb.Flags := dcb.Flags or dcb_RtsControlEnable;
-  dcb.Flags := dcb.Flags or dcb_DtrControlEnable;
-  if dcb.Parity > 0 then
-    dcb.Flags := dcb.Flags or dcb_ParityCheck;
-  SetCommState;
-end;
-
-procedure TBlockSerial.Connect(comport: string);
-{$IFDEF MSWINDOWS}
-var
-  CommTimeouts: TCommTimeouts;
-{$ENDIF}
-begin
-  // Is this TBlockSerial Instance already busy?
-  if InstanceActive then           {HGJ}
-  begin                            {HGJ}
-    RaiseSynaError(ErrAlreadyInUse);
-    Exit;                          {HGJ}
-  end;                             {HGJ}
-  FBuffer := '';
-  FDevice := comport;
-  GetComNr(comport);
-{$IFDEF MSWINDOWS}
-  SetLastError (sOK);
-{$ELSE}
-  {$IFNDEF FPC}
-  SetLastError (sOK);
-  {$ELSE}
-  fpSetErrno(sOK);
-  {$ENDIF}
-{$ENDIF}
-{$IFNDEF MSWINDOWS}
-  if FComNr <> PortIsClosed then
-    FDevice := '/dev/ttyS' + IntToStr(FComNr);
-  // Comport already owned by another process?          {HGJ}
-  if FLinuxLock then
-    if not cpomComportAccessible then
-    begin
-      RaiseSynaError(ErrAlreadyOwned);
-      Exit;
-    end;
-{$IFNDEF FPC}
-  FHandle := THandle(Libc.open(pchar(FDevice), O_RDWR or O_SYNC));
-{$ELSE}
-  FHandle := THandle(fpOpen(FDevice, O_RDWR or O_SYNC));
-{$ENDIF}
-  if FHandle = INVALID_HANDLE_VALUE then  //because THandle is not integer on all platforms!
-    SerialCheck(-1)
-  else
-    SerialCheck(0);
-  {$IFDEF LINUX}
-  if FLastError <> sOK then
-    if FLinuxLock then
-      cpomReleaseComport;
-  {$ENDIF}
-  ExceptCheck;
-  if FLastError <> sOK then
-    Exit;
-{$ELSE}
-  if FComNr <> PortIsClosed then
-    FDevice := '\\.\COM' + IntToStr(FComNr + 1);
-  FHandle := THandle(CreateFile(PChar(FDevice), GENERIC_READ or GENERIC_WRITE,
-    0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED, 0));
-  if FHandle = INVALID_HANDLE_VALUE then  //because THandle is not integer on all platforms!
-    SerialCheck(-1)
-  else
-    SerialCheck(0);
-  ExceptCheck;
-  if FLastError <> sOK then
-    Exit;
-  SetCommMask(FHandle, 0);
-  SetupComm(Fhandle, FRecvBuffer, 0);
-  CommTimeOuts.ReadIntervalTimeout := MAXWORD;
-  CommTimeOuts.ReadTotalTimeoutMultiplier := 0;
-  CommTimeOuts.ReadTotalTimeoutConstant := 0;
-  CommTimeOuts.WriteTotalTimeoutMultiplier := 0;
-  CommTimeOuts.WriteTotalTimeoutConstant := 0;
-  SetCommTimeOuts(FHandle, CommTimeOuts);
-  FPortAddr := GetPortAddr;
-{$ENDIF}
-  SetSynaError(sOK);
-  if not TestCtrlLine then  {HGJ}
-  begin
-    SetSynaError(ErrNoDeviceAnswer);
-    FileClose(FHandle);         {HGJ}
-    {$IFDEF LINUX}
-    if FLinuxLock then
-      cpomReleaseComport;                {HGJ}
-    {$ENDIF}                             {HGJ}
-    Fhandle := INVALID_HANDLE_VALUE;     {HGJ}
-    FComNr:= PortIsClosed;               {HGJ}
-  end
-  else
-  begin
-    FInstanceActive:= True;
-    RTS := True;
-    DTR := True;
-    Purge;
-  end;
-  ExceptCheck;
-  DoStatus(HR_Connect, FDevice);
-end;
-
-function TBlockSerial.SendBuffer(buffer: pointer; length: integer): integer;
-{$IFDEF MSWINDOWS}
-var
-  Overlapped: TOverlapped;
-  x, y, Err: DWord;
-{$ENDIF}
-begin
-  Result := 0;
-  if PreTestFailing then   {HGJ}
-    Exit;                  {HGJ}
-  LimitBandwidth(Length, FMaxSendBandwidth, FNextsend);
-  if FRTSToggle then
-  begin
-    Flush;
-    RTS := True;
-  end;
-{$IFNDEF MSWINDOWS}
-  result := FileWrite(Fhandle, Buffer^, Length);
-  serialcheck(result);
-{$ELSE}
-  FillChar(Overlapped, Sizeof(Overlapped), 0);
-  SetSynaError(sOK);
-  y := 0;
-  if not WriteFile(FHandle, Buffer^, Length, DWord(Result), @Overlapped) then
-    y := GetLastError;
-  if y = ERROR_IO_PENDING then
-  begin
-    x := WaitForSingleObject(FHandle, FDeadlockTimeout);
-    if x = WAIT_TIMEOUT then
-    begin
-      PurgeComm(FHandle, PURGE_TXABORT);
-      SetSynaError(ErrTimeout);
-    end;
-    GetOverlappedResult(FHandle, Overlapped, Dword(Result), False);
-  end
-  else
-    SetSynaError(y);
-  ClearCommError(FHandle, err, nil);
-  if err <> 0 then
-    DecodeCommError(err);
-{$ENDIF}
-  if FRTSToggle then
-  begin
-    Flush;
-    CanWrite(255);
-    RTS := False;
-  end;
-  ExceptCheck;
-  DoStatus(HR_WriteCount, IntToStr(Result));
-end;
-
-procedure TBlockSerial.SendByte(data: byte);
-begin
-  SendBuffer(@Data, 1);
-end;
-
-procedure TBlockSerial.SendString(data: AnsiString);
-begin
-  SendBuffer(Pointer(Data), Length(Data));
-end;
-
-procedure TBlockSerial.SendInteger(Data: integer);
-begin
-  SendBuffer(@data, SizeOf(Data));
-end;
-
-procedure TBlockSerial.SendBlock(const Data: AnsiString);
-begin
-  SendInteger(Length(data));
-  SendString(Data);
-end;
-
-procedure TBlockSerial.SendStreamRaw(const Stream: TStream);
-var
-  si: integer;
-  x, y, yr: integer;
-  s: AnsiString;
-begin
-  si := Stream.Size - Stream.Position;
-  x := 0;
-  while x < si do
-  begin
-    y := si - x;
-    if y > cSerialChunk then
-      y := cSerialChunk;
-    Setlength(s, y);
-    yr := Stream.read(PAnsiChar(s)^, y);
-    if yr > 0 then
-    begin
-      SetLength(s, yr);
-      SendString(s);
-      Inc(x, yr);
-    end
-    else
-      break;
-  end;
-end;
-
-procedure TBlockSerial.SendStreamIndy(const Stream: TStream);
-var
-  si: integer;
-begin
-  si := Stream.Size - Stream.Position;
-  si := Swapbytes(si);
-  SendInteger(si);
-  SendStreamRaw(Stream);
-end;
-
-procedure TBlockSerial.SendStream(const Stream: TStream);
-var
-  si: integer;
-begin
-  si := Stream.Size - Stream.Position;
-  SendInteger(si);
-  SendStreamRaw(Stream);
-end;
-
-function TBlockSerial.RecvBuffer(buffer: pointer; length: integer): integer;
-{$IFNDEF MSWINDOWS}
-begin
-  Result := 0;
-  if PreTestFailing then   {HGJ}
-    Exit;                  {HGJ}
-  LimitBandwidth(Length, FMaxRecvBandwidth, FNextRecv);
-  result := FileRead(FHandle, Buffer^, length);
-  serialcheck(result);
-{$ELSE}
-var
-  Overlapped: TOverlapped;
-  x, y, Err: DWord;
-begin
-  Result := 0;
-  if PreTestFailing then   {HGJ}
-    Exit;                  {HGJ}
-  LimitBandwidth(Length, FMaxRecvBandwidth, FNextRecv);
-  FillChar(Overlapped, Sizeof(Overlapped), 0);
-  SetSynaError(sOK);
-  y := 0;
-  if not ReadFile(FHandle, Buffer^, length, Dword(Result), @Overlapped) then
-    y := GetLastError;
-  if y = ERROR_IO_PENDING then
-  begin
-    x := WaitForSingleObject(FHandle, FDeadlockTimeout);
-    if x = WAIT_TIMEOUT then
-    begin
-      PurgeComm(FHandle, PURGE_RXABORT);
-      SetSynaError(ErrTimeout);
-    end;
-    GetOverlappedResult(FHandle, Overlapped, Dword(Result), False);
-  end
-  else
-    SetSynaError(y);
-  ClearCommError(FHandle, err, nil);
-  if err <> 0 then
-    DecodeCommError(err);
-{$ENDIF}
-  ExceptCheck;
-  DoStatus(HR_ReadCount, IntToStr(Result));
-end;
-
-function TBlockSerial.RecvBufferEx(buffer: pointer; length: integer; timeout: integer): integer;
-var
-  s: AnsiString;
-  rl, l: integer;
-  ti: LongWord;
-begin
-  Result := 0;
-  if PreTestFailing then   {HGJ}
-    Exit;                  {HGJ}
-  SetSynaError(sOK);
-  rl := 0;
-  repeat
-    ti := GetTick;
-    s := RecvPacket(Timeout);
-    l := System.Length(s);
-    if (rl + l) > Length then
-      l := Length - rl;
-    Move(Pointer(s)^, IncPoint(Buffer, rl)^, l);
-    rl := rl + l;
-    if FLastError <> sOK then
-      Break;
-    if rl >= Length then
-      Break;
-    if not FInterPacketTimeout then
-    begin
-      Timeout := Timeout - integer(TickDelta(ti, GetTick));
-      if Timeout <= 0 then
-      begin
-        SetSynaError(ErrTimeout);
-        Break;
-      end;
-    end;
-  until False;
-  delete(s, 1, l);
-  FBuffer := s;
-  Result := rl;
-end;
-
-function TBlockSerial.RecvBufferStr(Length: Integer; Timeout: Integer): AnsiString;
-var
-  x: integer;
-begin
-  Result := '';
-  if PreTestFailing then   {HGJ}
-    Exit;                  {HGJ}
-  SetSynaError(sOK);
-  if Length > 0 then
-  begin
-    Setlength(Result, Length);
-    x := RecvBufferEx(PAnsiChar(Result), Length , Timeout);
-    if FLastError = sOK then
-      SetLength(Result, x)
-    else
-      Result := '';
-  end;
-end;
-
-function TBlockSerial.RecvPacket(Timeout: Integer): AnsiString;
-var
-  x: integer;
-begin
-  Result := '';
-  if PreTestFailing then   {HGJ}
-    Exit;                  {HGJ}
-  SetSynaError(sOK);
-  if FBuffer <> '' then
-  begin
-    Result := FBuffer;
-    FBuffer := '';
-  end
-  else
-  begin
-    //not drain CPU on large downloads...
-    Sleep(0);
-    x := WaitingData;
-    if x > 0 then
-    begin
-      SetLength(Result, x);
-      x := RecvBuffer(Pointer(Result), x);
-      if x >= 0 then
-        SetLength(Result, x);
-    end
-    else
-    begin
-      if CanRead(Timeout) then
-      begin
-        x := WaitingData;
-        if x = 0 then
-          SetSynaError(ErrTimeout);
-        if x > 0 then
-        begin
-          SetLength(Result, x);
-          x := RecvBuffer(Pointer(Result), x);
-          if x >= 0 then
-            SetLength(Result, x);
-        end;
-      end
-      else
-        SetSynaError(ErrTimeout);
-    end;
-  end;
-  ExceptCheck;
-end;
-
-
-function TBlockSerial.RecvByte(timeout: integer): byte;
-begin
-  Result := 0;
-  if PreTestFailing then   {HGJ}
-    Exit;                  {HGJ}
-  SetSynaError(sOK);
-  if FBuffer = '' then
-    FBuffer := RecvPacket(Timeout);
-  if (FLastError = sOK) and (FBuffer <> '') then
-  begin
-    Result := Ord(FBuffer[1]);
-    System.Delete(FBuffer, 1, 1);
-  end;
-  ExceptCheck;
-end;
-
-function TBlockSerial.RecvTerminated(Timeout: Integer; const Terminator: AnsiString): AnsiString;
-var
-  x: Integer;
-  s: AnsiString;
-  l: Integer;
-  CorCRLF: Boolean;
-  t: ansistring;
-  tl: integer;
-  ti: LongWord;
-begin
-  Result := '';
-  if PreTestFailing then   {HGJ}
-    Exit;                  {HGJ}
-  SetSynaError(sOK);
-  l := system.Length(Terminator);
-  if l = 0 then
-    Exit;
-  tl := l;
-  CorCRLF := FConvertLineEnd and (Terminator = CRLF);
-  s := '';
-  x := 0;
-  repeat
-    ti := GetTick;
-    //get rest of FBuffer or incomming new data...
-    s := s + RecvPacket(Timeout);
-    if FLastError <> sOK then
-      Break;
-    x := 0;
-    if Length(s) > 0 then
-      if CorCRLF then
-      begin
-        if FLastCR and (s[1] = LF) then
-          Delete(s, 1, 1);
-        if FLastLF and (s[1] = CR) then
-          Delete(s, 1, 1);
-        FLastCR := False;
-        FLastLF := False;
-        t := '';
-        x := PosCRLF(s, t);
-        tl := system.Length(t);
-        if t = CR then
-          FLastCR := True;
-        if t = LF then
-          FLastLF := True;
-      end
-      else
-      begin
-        x := pos(Terminator, s);
-        tl := l;
-      end;
-    if (FMaxLineLength <> 0) and (system.Length(s) > FMaxLineLength) then
-    begin
-      SetSynaError(ErrMaxBuffer);
-      Break;
-    end;
-    if x > 0 then
-      Break;
-    if not FInterPacketTimeout then
-    begin
-      Timeout := Timeout - integer(TickDelta(ti, GetTick));
-      if Timeout <= 0 then
-      begin
-        SetSynaError(ErrTimeout);
-        Break;
-      end;
-    end;
-  until False;
-  if x > 0 then
-  begin
-    Result := Copy(s, 1, x - 1);
-    System.Delete(s, 1, x + tl - 1);
-  end;
-  FBuffer := s;
-  ExceptCheck;
-end;
-
-
-function TBlockSerial.RecvString(Timeout: Integer): AnsiString;
-var
-  s: AnsiString;
-begin
-  Result := '';
-  s := RecvTerminated(Timeout, #13 + #10);
-  if FLastError = sOK then
-    Result := s;
-end;
-
-function TBlockSerial.RecvInteger(Timeout: Integer): Integer;
-var
-  s: AnsiString;
-begin
-  Result := 0;
-  s := RecvBufferStr(4, Timeout);
-  if FLastError = 0 then
-    Result := (ord(s[1]) + ord(s[2]) * 256) + (ord(s[3]) + ord(s[4]) * 256) * 65536;
-end;
-
-function TBlockSerial.RecvBlock(Timeout: Integer): AnsiString;
-var
-  x: integer;
-begin
-  Result := '';
-  x := RecvInteger(Timeout);
-  if FLastError = 0 then
-    Result := RecvBufferStr(x, Timeout);
-end;
-
-procedure TBlockSerial.RecvStreamRaw(const Stream: TStream; Timeout: Integer);
-var
-  s: AnsiString;
-begin
-  repeat
-    s := RecvPacket(Timeout);
-    if FLastError = 0 then
-      WriteStrToStream(Stream, s);
-  until FLastError <> 0;
-end;
-
-procedure TBlockSerial.RecvStreamSize(const Stream: TStream; Timeout: Integer; Size: Integer);
-var
-  s: AnsiString;
-  n: integer;
-begin
-  for n := 1 to (Size div cSerialChunk) do
-  begin
-    s := RecvBufferStr(cSerialChunk, Timeout);
-    if FLastError <> 0 then
-      Exit;
-    Stream.Write(PAnsichar(s)^, cSerialChunk);
-  end;
-  n := Size mod cSerialChunk;
-  if n > 0 then
-  begin
-    s := RecvBufferStr(n, Timeout);
-    if FLastError <> 0 then
-      Exit;
-    Stream.Write(PAnsichar(s)^, n);
-  end;
-end;
-
-procedure TBlockSerial.RecvStreamIndy(const Stream: TStream; Timeout: Integer);
-var
-  x: integer;
-begin
-  x := RecvInteger(Timeout);
-  x := SwapBytes(x);
-  if FLastError = 0 then
-    RecvStreamSize(Stream, Timeout, x);
-end;
-
-procedure TBlockSerial.RecvStream(const Stream: TStream; Timeout: Integer);
-var
-  x: integer;
-begin
-  x := RecvInteger(Timeout);
-  if FLastError = 0 then
-    RecvStreamSize(Stream, Timeout, x);
-end;
-
-{$IFNDEF MSWINDOWS}
-function TBlockSerial.WaitingData: integer;
-begin
-{$IFNDEF FPC}
-  serialcheck(ioctl(FHandle, FIONREAD, @result));
-{$ELSE}
-  serialcheck(fpIoctl(FHandle, FIONREAD, @result));
-{$ENDIF}
-  if FLastError <> 0 then
-    Result := 0;
-  ExceptCheck;
-end;
-{$ELSE}
-function TBlockSerial.WaitingData: integer;
-var
-  stat: TComStat;
-  err: DWORD;
-begin
-  if ClearCommError(FHandle, err, @stat) then
-  begin
-    SetSynaError(sOK);
-    Result := stat.cbInQue;
-  end
-  else
-  begin
-    SerialCheck(sErr);
-    Result := 0;
-  end;
-  ExceptCheck;
-end;
-{$ENDIF}
-
-function TBlockSerial.WaitingDataEx: integer;
-begin
-	if FBuffer <> '' then
-  	Result := Length(FBuffer)
-  else
-  	Result := Waitingdata;
-end;
-
-{$IFNDEF MSWINDOWS}
-function TBlockSerial.SendingData: integer;
-begin
-  SetSynaError(sOK);
-  Result := 0;
-end;
-{$ELSE}
-function TBlockSerial.SendingData: integer;
-var
-  stat: TComStat;
-  err: DWORD;
-begin
-  SetSynaError(sOK);
-  if not ClearCommError(FHandle, err, @stat) then
-    serialcheck(sErr);
-  ExceptCheck;
-  result := stat.cbOutQue;
-end;
-{$ENDIF}
-
-{$IFNDEF MSWINDOWS}
-procedure TBlockSerial.DcbToTermios(const dcb: TDCB; var term: termios);
-var
-  n: integer;
-  x: cardinal;
-begin
-  //others
-  cfmakeraw(term);
-  term.c_cflag := term.c_cflag or CREAD;
-  term.c_cflag := term.c_cflag or CLOCAL;
-  term.c_cflag := term.c_cflag or HUPCL;
-  //hardware handshake
-  if (dcb.flags and dcb_RtsControlHandshake) > 0 then
-    term.c_cflag := term.c_cflag or CRTSCTS
-  else
-    term.c_cflag := term.c_cflag and (not CRTSCTS);
-  //software handshake
-  if (dcb.flags and dcb_OutX) > 0 then
-    term.c_iflag := term.c_iflag or IXON or IXOFF or IXANY
-  else
-    term.c_iflag := term.c_iflag and (not (IXON or IXOFF or IXANY));
-  //size of byte
-  term.c_cflag := term.c_cflag and (not CSIZE);
-  case dcb.bytesize of
-    5:
-      term.c_cflag := term.c_cflag or CS5;
-    6:
-      term.c_cflag := term.c_cflag or CS6;
-    7:
-{$IFDEF FPC}
-      term.c_cflag := term.c_cflag or CS7;
-{$ELSE}
-      term.c_cflag := term.c_cflag or CS7fix;
-{$ENDIF}
-    8:
-      term.c_cflag := term.c_cflag or CS8;
-  end;
-  //parity
-  if (dcb.flags and dcb_ParityCheck) > 0 then
-    term.c_cflag := term.c_cflag or PARENB
-  else
-    term.c_cflag := term.c_cflag and (not PARENB);
-  case dcb.parity of
-    1: //'O'
-      term.c_cflag := term.c_cflag or PARODD;
-    2: //'E'
-      term.c_cflag := term.c_cflag and (not PARODD);
-  end;
-  //stop bits
-  if dcb.stopbits > 0 then
-    term.c_cflag := term.c_cflag or CSTOPB
-  else
-    term.c_cflag := term.c_cflag and (not CSTOPB);
-  //set baudrate;
-  x := 0;
-  for n := 0 to Maxrates do
-    if rates[n, 0] = dcb.BaudRate then
-    begin
-      x := rates[n, 1];
-      break;
-    end;
-  cfsetospeed(term, x);
-  cfsetispeed(term, x);
-end;
-
-procedure TBlockSerial.TermiosToDcb(const term: termios; var dcb: TDCB);
-var
-  n: integer;
-  x: cardinal;
-begin
-  //set baudrate;
-  dcb.baudrate := 0;
- {$IFDEF FPC}
-  //why FPC not have cfgetospeed???
-  x := term.c_oflag and $0F;
- {$ELSE}
-  x := cfgetospeed(term);
- {$ENDIF}
-  for n := 0 to Maxrates do
-    if rates[n, 1] = x then
-    begin
-      dcb.baudrate := rates[n, 0];
-      break;
-    end;
-  //hardware handshake
-  if (term.c_cflag and CRTSCTS) > 0 then
-    dcb.flags := dcb.flags or dcb_RtsControlHandshake or dcb_OutxCtsFlow
-  else
-    dcb.flags := dcb.flags and (not (dcb_RtsControlHandshake or dcb_OutxCtsFlow));
-  //software handshake
-  if (term.c_cflag and IXOFF) > 0 then
-    dcb.flags := dcb.flags or dcb_OutX or dcb_InX
-  else
-    dcb.flags := dcb.flags and (not (dcb_OutX or dcb_InX));
-  //size of byte
-  case term.c_cflag and CSIZE of
-    CS5:
-      dcb.bytesize := 5;
-    CS6:
-      dcb.bytesize := 6;
-    CS7fix:
-      dcb.bytesize := 7;
-    CS8:
-      dcb.bytesize := 8;
-  end;
-  //parity
-  if (term.c_cflag and PARENB) > 0 then
-    dcb.flags := dcb.flags or dcb_ParityCheck
-  else
-    dcb.flags := dcb.flags and (not dcb_ParityCheck);
-  dcb.parity := 0;
-  if (term.c_cflag and PARODD) > 0 then
-    dcb.parity := 1
-  else
-    dcb.parity := 2;
-  //stop bits
-  if (term.c_cflag and CSTOPB) > 0 then
-    dcb.stopbits := 2
-  else
-    dcb.stopbits := 0;
-end;
-{$ENDIF}
-
-{$IFNDEF MSWINDOWS}
-procedure TBlockSerial.SetCommState;
-begin
-  DcbToTermios(dcb, termiosstruc);
-  SerialCheck(tcsetattr(FHandle, TCSANOW, termiosstruc));
-  ExceptCheck;
-end;
-{$ELSE}
-procedure TBlockSerial.SetCommState;
-begin
-  SetSynaError(sOK);
-  if not windows.SetCommState(Fhandle, dcb) then
-    SerialCheck(sErr);
-  ExceptCheck;
-end;
-{$ENDIF}
-
-{$IFNDEF MSWINDOWS}
-procedure TBlockSerial.GetCommState;
-begin
-  SerialCheck(tcgetattr(FHandle, termiosstruc));
-  ExceptCheck;
-  TermiostoDCB(termiosstruc, dcb);
-end;
-{$ELSE}
-procedure TBlockSerial.GetCommState;
-begin
-  SetSynaError(sOK);
-  if not windows.GetCommState(Fhandle, dcb) then
-    SerialCheck(sErr);
-  ExceptCheck;
-end;
-{$ENDIF}
-
-procedure TBlockSerial.SetSizeRecvBuffer(size: integer);
-begin
-{$IFDEF MSWINDOWS}
-  SetupComm(Fhandle, size, 0);
-  GetCommState;
-  dcb.XonLim := size div 4;
-  dcb.XoffLim := size div 4;
-  SetCommState;
-{$ENDIF}
-  FRecvBuffer := size;
-end;
-
-function TBlockSerial.GetDSR: Boolean;
-begin
-  ModemStatus;
-{$IFNDEF MSWINDOWS}
-  Result := (FModemWord and TIOCM_DSR) > 0;
-{$ELSE}
-  Result := (FModemWord and MS_DSR_ON) > 0;
-{$ENDIF}
-end;
-
-procedure TBlockSerial.SetDTRF(Value: Boolean);
-begin
-{$IFNDEF MSWINDOWS}
-  ModemStatus;
-  if Value then
-    FModemWord := FModemWord or TIOCM_DTR
-  else
-    FModemWord := FModemWord and not TIOCM_DTR;
-  {$IFNDEF FPC}
-  ioctl(FHandle, TIOCMSET, @FModemWord);
-  {$ELSE}
-  fpioctl(FHandle, TIOCMSET, @FModemWord);
-  {$ENDIF}
-{$ELSE}
-  if Value then
-    EscapeCommFunction(FHandle, SETDTR)
-  else
-    EscapeCommFunction(FHandle, CLRDTR);
-{$ENDIF}
-end;
-
-function TBlockSerial.GetCTS: Boolean;
-begin
-  ModemStatus;
-{$IFNDEF MSWINDOWS}
-  Result := (FModemWord and TIOCM_CTS) > 0;
-{$ELSE}
-  Result := (FModemWord and MS_CTS_ON) > 0;
-{$ENDIF}
-end;
-
-procedure TBlockSerial.SetRTSF(Value: Boolean);
-begin
-{$IFNDEF MSWINDOWS}
-  ModemStatus;
-  if Value then
-    FModemWord := FModemWord or TIOCM_RTS
-  else
-    FModemWord := FModemWord and not TIOCM_RTS;
-  {$IFNDEF FPC}
-  ioctl(FHandle, TIOCMSET, @FModemWord);
-  {$ELSE}
-  fpioctl(FHandle, TIOCMSET, @FModemWord);
-  {$ENDIF}
-{$ELSE}
-  if Value then
-    EscapeCommFunction(FHandle, SETRTS)
-  else
-    EscapeCommFunction(FHandle, CLRRTS);
-{$ENDIF}
-end;
-
-function TBlockSerial.GetCarrier: Boolean;
-begin
-  ModemStatus;
-{$IFNDEF MSWINDOWS}
-  Result := (FModemWord and TIOCM_CAR) > 0;
-{$ELSE}
-  Result := (FModemWord and MS_RLSD_ON) > 0;
-{$ENDIF}
-end;
-
-function TBlockSerial.GetRing: Boolean;
-begin
-  ModemStatus;
-{$IFNDEF MSWINDOWS}
-  Result := (FModemWord and TIOCM_RNG) > 0;
-{$ELSE}
-  Result := (FModemWord and MS_RING_ON) > 0;
-{$ENDIF}
-end;
-
-{$IFDEF MSWINDOWS}
-function TBlockSerial.CanEvent(Event: dword; Timeout: integer): boolean;
-var
-  ex: DWord;
-  y: Integer;
-  Overlapped: TOverlapped;
-begin
-  FillChar(Overlapped, Sizeof(Overlapped), 0);
-  Overlapped.hEvent := CreateEvent(nil, True, False, nil);
-  try
-    SetCommMask(FHandle, Event);
-    SetSynaError(sOK);
-    if (Event = EV_RXCHAR) and (Waitingdata > 0) then
-      Result := True
-    else
-    begin
-      y := 0;
-      if not WaitCommEvent(FHandle, ex, @Overlapped) then
-        y := GetLastError;
-      if y = ERROR_IO_PENDING then
-      begin
-        //timedout
-        WaitForSingleObject(Overlapped.hEvent, Timeout);
-        SetCommMask(FHandle, 0);
-        GetOverlappedResult(FHandle, Overlapped, DWord(y), True);
-      end;
-      Result := (ex and Event) = Event;
-    end;
-  finally
-    SetCommMask(FHandle, 0);
-    CloseHandle(Overlapped.hEvent);
-  end;
-end;
-{$ENDIF}
-
-{$IFNDEF MSWINDOWS}
-function TBlockSerial.CanRead(Timeout: integer): boolean;
-var
-  FDSet: TFDSet;
-  TimeVal: PTimeVal;
-  TimeV: TTimeVal;
-  x: Integer;
-begin
-  TimeV.tv_usec := (Timeout mod 1000) * 1000;
-  TimeV.tv_sec := Timeout div 1000;
-  TimeVal := @TimeV;
-  if Timeout = -1 then
-    TimeVal := nil;
-  {$IFNDEF FPC}
-  FD_ZERO(FDSet);
-  FD_SET(FHandle, FDSet);
-  x := Select(FHandle + 1, @FDSet, nil, nil, TimeVal);
-  {$ELSE}
-  fpFD_ZERO(FDSet);
-  fpFD_SET(FHandle, FDSet);
-  x := fpSelect(FHandle + 1, @FDSet, nil, nil, TimeVal);
-  {$ENDIF}
-  SerialCheck(x);
-  if FLastError <> sOK then
-    x := 0;
-  Result := x > 0;
-  ExceptCheck;
-  if Result then
-    DoStatus(HR_CanRead, '');
-end;
-{$ELSE}
-function TBlockSerial.CanRead(Timeout: integer): boolean;
-begin
-  Result := WaitingData > 0;
-  if not Result then
-    Result := CanEvent(EV_RXCHAR, Timeout);
-  if Result then
-    DoStatus(HR_CanRead, '');
-end;
-{$ENDIF}
-
-{$IFNDEF MSWINDOWS}
-function TBlockSerial.CanWrite(Timeout: integer): boolean;
-var
-  FDSet: TFDSet;
-  TimeVal: PTimeVal;
-  TimeV: TTimeVal;
-  x: Integer;
-begin
-  TimeV.tv_usec := (Timeout mod 1000) * 1000;
-  TimeV.tv_sec := Timeout div 1000;
-  TimeVal := @TimeV;
-  if Timeout = -1 then
-    TimeVal := nil;
-  {$IFNDEF FPC}
-  FD_ZERO(FDSet);
-  FD_SET(FHandle, FDSet);
-  x := Select(FHandle + 1, nil, @FDSet, nil, TimeVal);
-  {$ELSE}
-  fpFD_ZERO(FDSet);
-  fpFD_SET(FHandle, FDSet);
-  x := fpSelect(FHandle + 1, nil, @FDSet, nil, TimeVal);
-  {$ENDIF}
-  SerialCheck(x);
-  if FLastError <> sOK then
-    x := 0;
-  Result := x > 0;
-  ExceptCheck;
-  if Result then
-    DoStatus(HR_CanWrite, '');
-end;
-{$ELSE}
-function TBlockSerial.CanWrite(Timeout: integer): boolean;
-var
-  t: LongWord;
-begin
-  Result := SendingData = 0;
-  if not Result then
-	  Result := CanEvent(EV_TXEMPTY, Timeout);
-  if Result and (Win32Platform <> VER_PLATFORM_WIN32_NT) then
-  begin
-    t := GetTick;
-    while not ReadTxEmpty(FPortAddr) do
-    begin
-      if TickDelta(t, GetTick) > 255 then
-        Break;
-      Sleep(0);
-    end;
-  end;
-  if Result then
-    DoStatus(HR_CanWrite, '');
-end;
-{$ENDIF}
-
-function TBlockSerial.CanReadEx(Timeout: integer): boolean;
-begin
-	if Fbuffer <> '' then
-  	Result := True
-  else
-  	Result := CanRead(Timeout);
-end;
-
-procedure TBlockSerial.EnableRTSToggle(Value: boolean);
-begin
-  SetSynaError(sOK);
-{$IFNDEF MSWINDOWS}
-  FRTSToggle := Value;
-  if Value then
-    RTS:=False;
-{$ELSE}
-  if Win32Platform = VER_PLATFORM_WIN32_NT then
-  begin
-    GetCommState;
-    if value then
-      dcb.Flags := dcb.Flags or dcb_RtsControlToggle
-    else
-      dcb.flags := dcb.flags and (not dcb_RtsControlToggle);
-    SetCommState;
-  end
-  else
-  begin
-    FRTSToggle := Value;
-    if Value then
-      RTS:=False;
-  end;
-{$ENDIF}
-end;
-
-procedure TBlockSerial.Flush;
-begin
-{$IFNDEF MSWINDOWS}
-  SerialCheck(tcdrain(FHandle));
-{$ELSE}
-  SetSynaError(sOK);
-  if not Flushfilebuffers(FHandle) then
-    SerialCheck(sErr);
-{$ENDIF}
-  ExceptCheck;
-end;
-
-{$IFNDEF MSWINDOWS}
-procedure TBlockSerial.Purge;
-begin
-  {$IFNDEF FPC}
-  SerialCheck(ioctl(FHandle, TCFLSH, TCIOFLUSH));
-  {$ELSE}
-  SerialCheck(fpioctl(FHandle, TCFLSH, TCIOFLUSH));
-  {$ENDIF}
-  FBuffer := '';
-  ExceptCheck;
-end;
-{$ELSE}
-procedure TBlockSerial.Purge;
-var
-  x: integer;
-begin
-  SetSynaError(sOK);
-  x := PURGE_TXABORT or PURGE_TXCLEAR or PURGE_RXABORT or PURGE_RXCLEAR;
-  if not PurgeComm(FHandle, x) then
-    SerialCheck(sErr);
-  FBuffer := '';
-  ExceptCheck;
-end;
-{$ENDIF}
-
-function TBlockSerial.ModemStatus: integer;
-begin
-  Result := 0;
-{$IFNDEF MSWINDOWS}
-  {$IFNDEF FPC}
-  SerialCheck(ioctl(FHandle, TIOCMGET, @Result));
-  {$ELSE}
-  SerialCheck(fpioctl(FHandle, TIOCMGET, @Result));
-  {$ENDIF}
-{$ELSE}
-  SetSynaError(sOK);
-  if not GetCommModemStatus(FHandle, dword(Result)) then
-    SerialCheck(sErr);
-{$ENDIF}
-  ExceptCheck;
-  FModemWord := Result;
-end;
-
-procedure TBlockSerial.SetBreak(Duration: integer);
-begin
-{$IFNDEF MSWINDOWS}
-  SerialCheck(tcsendbreak(FHandle, Duration));
-{$ELSE}
-  SetCommBreak(FHandle);
-  Sleep(Duration);
-  SetSynaError(sOK);
-  if not ClearCommBreak(FHandle) then
-    SerialCheck(sErr);
-{$ENDIF}
-end;
-
-{$IFDEF MSWINDOWS}
-procedure TBlockSerial.DecodeCommError(Error: DWord);
-begin
-  if (Error and DWord(CE_FRAME)) > 1 then
-    FLastError := ErrFrame;
-  if (Error and DWord(CE_OVERRUN)) > 1 then
-    FLastError := ErrOverrun;
-  if (Error and DWord(CE_RXOVER)) > 1 then
-    FLastError := ErrRxOver;
-  if (Error and DWord(CE_RXPARITY)) > 1 then
-    FLastError := ErrRxParity;
-  if (Error and DWord(CE_TXFULL)) > 1 then
-    FLastError := ErrTxFull;
-end;
-{$ENDIF}
-
-//HGJ
-function TBlockSerial.PreTestFailing: Boolean;
-begin
-  if not FInstanceActive then
-  begin
-    RaiseSynaError(ErrPortNotOpen);
-    result:= true;
-    Exit;
-  end;
-  Result := not TestCtrlLine;
-  if result then
-    RaiseSynaError(ErrNoDeviceAnswer)
-end;
-
-function TBlockSerial.TestCtrlLine: Boolean;
-begin
-  result := ((not FTestDSR) or DSR) and ((not FTestCTS) or CTS);
-end;
-
-function TBlockSerial.ATCommand(value: AnsiString): AnsiString;
-var
-  s: AnsiString;
-  ConvSave: Boolean;
-begin
-  result := '';
-  FAtResult := False;
-  ConvSave := FConvertLineEnd;
-  try
-    FConvertLineEnd := True;
-    SendString(value + #$0D);
-    repeat
-      s := RecvString(FAtTimeout);
-      if s <> Value then
-        result := result + s + CRLF;
-      if s = 'OK' then
-      begin
-        FAtResult := True;
-        break;
-      end;
-      if s = 'ERROR' then
-        break;
-    until FLastError <> sOK;
-  finally
-    FConvertLineEnd := Convsave;
-  end;
-end;
-
-
-function TBlockSerial.ATConnect(value: AnsiString): AnsiString;
-var
-  s: AnsiString;
-  ConvSave: Boolean;
-begin
-  result := '';
-  FAtResult := False;
-  ConvSave := FConvertLineEnd;
-  try
-    FConvertLineEnd := True;
-    SendString(value + #$0D);
-    repeat
-      s := RecvString(90 * FAtTimeout);
-      if s <> Value then
-        result := result + s + CRLF;
-      if s = 'NO CARRIER' then
-        break;
-      if s = 'ERROR' then
-        break;
-      if s = 'BUSY' then
-        break;
-      if s = 'NO DIALTONE' then
-        break;
-      if Pos('CONNECT', s) = 1 then
-      begin
-        FAtResult := True;
-        break;
-      end;
-    until FLastError <> sOK;
-  finally
-    FConvertLineEnd := Convsave;
-  end;
-end;
-
-function TBlockSerial.SerialCheck(SerialResult: integer): integer;
-begin
-  if SerialResult = integer(INVALID_HANDLE_VALUE) then
-{$IFDEF MSWINDOWS}
-    result := GetLastError
-{$ELSE}
-  {$IFNDEF FPC}
-    result := GetLastError
-  {$ELSE}
-    result := fpGetErrno
-  {$ENDIF}
-{$ENDIF}
-  else
-    result := sOK;
-  FLastError := result;
-  FLastErrorDesc := GetErrorDesc(FLastError);
-end;
-
-procedure TBlockSerial.ExceptCheck;
-var
-  e: ESynaSerError;
-  s: string;
-begin
-  if FRaiseExcept and (FLastError <> sOK) then
-  begin
-    s := GetErrorDesc(FLastError);
-    e := ESynaSerError.CreateFmt('Communication error %d: %s', [FLastError, s]);
-    e.ErrorCode := FLastError;
-    e.ErrorMessage := s;
-    raise e;
-  end;
-end;
-
-procedure TBlockSerial.SetSynaError(ErrNumber: integer);
-begin
-  FLastError := ErrNumber;
-  FLastErrorDesc := GetErrorDesc(FLastError);
-end;
-
-procedure TBlockSerial.RaiseSynaError(ErrNumber: integer);
-begin
-  SetSynaError(ErrNumber);
-  ExceptCheck;
-end;
-
-procedure TBlockSerial.DoStatus(Reason: THookSerialReason; const Value: string);
-begin
-  if assigned(OnStatus) then
-    OnStatus(Self, Reason, Value);
-end;
-
-{======================================================================}
-
-class function TBlockSerial.GetErrorDesc(ErrorCode: integer): string;
-begin
-  Result:= '';
-  case ErrorCode of
-    sOK:               Result := 'OK';
-    ErrAlreadyOwned:   Result := 'Port owned by other process';{HGJ}
-    ErrAlreadyInUse:   Result := 'Instance already in use';    {HGJ}
-    ErrWrongParameter: Result := 'Wrong paramter at call';     {HGJ}
-    ErrPortNotOpen:    Result := 'Instance not yet connected'; {HGJ}
-    ErrNoDeviceAnswer: Result := 'No device answer detected';  {HGJ}
-    ErrMaxBuffer:      Result := 'Maximal buffer length exceeded';
-    ErrTimeout:        Result := 'Timeout during operation';
-    ErrNotRead:        Result := 'Reading of data failed';
-    ErrFrame:          Result := 'Receive framing error';
-    ErrOverrun:        Result := 'Receive Overrun Error';
-    ErrRxOver:         Result := 'Receive Queue overflow';
-    ErrRxParity:       Result := 'Receive Parity Error';
-    ErrTxFull:         Result := 'Tranceive Queue is full';
-  end;
-  if Result = '' then
-  begin
-    Result := SysErrorMessage(ErrorCode);
-  end;
-end;
-
-
-{---------- cpom Comport Ownership Manager Routines -------------
- by Hans-Georg Joepgen of Stuttgart, Germany.
- Copyright (c) 2002, by Hans-Georg Joepgen
-
-  Stefan Krauss of Stuttgart, Germany, contributed literature and Internet
-  research results, invaluable advice and excellent answers to the Comport
-  Ownership Manager.
-}
-
-{$IFDEF LINUX}
-
-function TBlockSerial.LockfileName: String;
-var
-  s: string;
-begin
-  s := SeparateRight(FDevice, '/dev/');
-  result := LockfileDirectory + '/LCK..' + s;
-end;
-
-procedure TBlockSerial.CreateLockfile(PidNr: integer);
-var
-  f: TextFile;
-  s: string;
-begin
-  // Create content for file
-  s := IntToStr(PidNr);
-  while length(s) < 10 do
-    s := ' ' + s;
-  // Create file
-  try
-    AssignFile(f, LockfileName);
-    try
-      Rewrite(f);
-      writeln(f, s);
-    finally
-      CloseFile(f);
-    end;
-    // Allow all users to enjoy the benefits of cpom
-    s := 'chmod a+rw ' + LockfileName;
-{$IFNDEF FPC}
-    FileSetReadOnly( LockfileName, False ) ;
- // Libc.system(pchar(s));
-{$ELSE}
-    fpSystem(s);
-{$ENDIF}
-  except
-    // not raise exception, if you not have write permission for lock.
-    on Exception do
-      ;
-  end;
-end;
-
-function TBlockSerial.ReadLockfile: integer;
-{Returns PID from Lockfile. Lockfile must exist.}
-var
-  f: TextFile;
-  s: string;
-begin
-  AssignFile(f, LockfileName);
-  Reset(f);
-  try
-    readln(f, s);
-  finally
-    CloseFile(f);
-  end;
-  Result := StrToIntDef(s, -1)
-end;
-
-function TBlockSerial.cpomComportAccessible: boolean;
-var
-  MyPid: integer;
-  Filename: string;
-begin
-  Filename := LockfileName;
-  {$IFNDEF FPC}
-  MyPid := Libc.getpid;
-  {$ELSE}
-  MyPid := fpGetPid;
-  {$ENDIF}
-  // Make sure, the Lock Files Directory exists. We need it.
-  if not DirectoryExists(LockfileDirectory) then
-    CreateDir(LockfileDirectory);
-  // Check the Lockfile
-  if not FileExists (Filename) then
-  begin // comport is not locked. Lock it for us.
-    CreateLockfile(MyPid);
-    result := true;
-    exit;  // done.
-  end;
-  // Is port owned by orphan? Then it's time for error recovery.
-  //FPC forgot to add getsid.. :-(
-  {$IFNDEF FPC}
-  if Libc.getsid(ReadLockfile) = -1 then
-  begin //  Lockfile was left from former desaster
-    DeleteFile(Filename); // error recovery
-    CreateLockfile(MyPid);
-    result := true;
-    exit;
-  end;
-  {$ENDIF}
-  result := false // Sorry, port is owned by living PID and locked
-end;
-
-procedure TBlockSerial.cpomReleaseComport;
-begin
-  DeleteFile(LockfileName);
-end;
-
-{$ENDIF}
-{----------------------------------------------------------------}
-
-{$IFDEF MSWINDOWS}
-function GetSerialPortNames: string;
-var
-  reg: TRegistry;
-  l, v: TStringList;
-  n: integer;
-begin
-  l := TStringList.Create;
-  v := TStringList.Create;
-  reg := TRegistry.Create;
-  try
-{$IFNDEF VER100}
-{$IFNDEF VER120}
-    reg.Access := KEY_READ;
-{$ENDIF}
-{$ENDIF}
-    reg.RootKey := HKEY_LOCAL_MACHINE;
-    reg.OpenKey('\HARDWARE\DEVICEMAP\SERIALCOMM', false);
-    reg.GetValueNames(l);
-    for n := 0 to l.Count - 1 do
-      v.Add(reg.ReadString(l[n]));
-    Result := v.CommaText;
-  finally
-    reg.Free;
-    l.Free;
-    v.Free;
-  end;
-end;
-{$ENDIF}
-{$IFNDEF MSWINDOWS}
-function GetSerialPortNames: string;
-var
-  Index: Integer;
-  Data: string;
-  TmpPorts: String;
-  sr : TSearchRec;
-begin
-  try
-    TmpPorts := '';
-    if FindFirst('/dev/ttyS*', $FFFFFFFF, sr) = 0 then
-    begin
-      repeat
-        if (sr.Attr and $FFFFFFFF) = Sr.Attr then
-        begin
-          data := sr.Name;
-          index := length(data);
-          while (index > 1) and (data[index] <> '/') do
-            index := index - 1;
-          TmpPorts := TmpPorts + ' ' + copy(data, 1, index + 1);
-        end;
-      until FindNext(sr) <> 0;
-    end;
-    FindClose(sr);
-  finally
-    Result:=TmpPorts;
-  end;
-end;
-{$ENDIF}
-
-end.
+{==============================================================================|
+| Project : Ararat Synapse                                       | 007.004.000 |
+|==============================================================================|
+| Content: Serial port support                                                 |
+|==============================================================================|
+| Copyright (c)2001-2010, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2001-2010.                |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|  (c)2002, Hans-Georg Joepgen (cpom Comport Ownership Manager and bugfixes)   |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{: @abstract(Serial port communication library)
+This unit contains a class that implements serial port communication for Windows
+ or Linux. This class provides numerous methods with same name and functionality
+  as methods of the Ararat Synapse TCP/IP library.
+
+The following is a small example how establish a connection by modem (in this
+case with my USB modem):
+@longcode(#
+  ser:=TBlockSerial.Create;
+  try
+    ser.Connect('COM3');
+    ser.config(460800,8,'N',0,false,true);
+    ser.ATCommand('AT');
+    if (ser.LastError <> 0) or (not ser.ATResult) then
+      Exit;
+    ser.ATConnect('ATDT+420971200111');
+    if (ser.LastError <> 0) or (not ser.ATResult) then
+      Exit;
+    // you are now connected to a modem at +420971200111
+    // you can transmit or receive data now
+  finally
+    ser.free;
+  end;
+#)
+}
+
+//old Delphi does not have MSWINDOWS define.
+{$IFDEF WIN32}
+  {$IFNDEF MSWINDOWS}
+    {$DEFINE MSWINDOWS}
+  {$ENDIF}
+{$ENDIF}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+  {$IFDEF MSWINDOWS}
+    {$ASMMODE intel}
+  {$ENDIF}
+  {define working mode w/o LIBC for fpc}
+  {$DEFINE NO_LIBC}
+{$ENDIF}
+{$Q-}
+{$H+}
+{$M+}
+
+unit synaser;
+
+interface
+
+uses
+{$IFNDEF MSWINDOWS}
+  {$IFNDEF NO_LIBC}
+  Libc,
+  KernelIoctl,
+  {$ELSE}
+  termio, baseunix, unix,
+  {$ENDIF}
+  {$IFNDEF FPC}
+  Types,
+  {$ENDIF}
+{$ELSE}
+  Windows, registry,
+  {$IFDEF FPC}
+  winver,
+  {$ENDIF}
+{$ENDIF}
+  synafpc,
+  Classes, SysUtils, synautil;
+
+const
+  CR = #$0d;
+  LF = #$0a;
+  CRLF = CR + LF;
+  cSerialChunk = 8192;
+
+  LockfileDirectory = '/var/lock'; {HGJ}
+  PortIsClosed = -1;               {HGJ}
+  ErrAlreadyOwned = 9991;          {HGJ}
+  ErrAlreadyInUse = 9992;          {HGJ}
+  ErrWrongParameter = 9993;        {HGJ}
+  ErrPortNotOpen = 9994;           {HGJ}
+  ErrNoDeviceAnswer =  9995;       {HGJ}
+  ErrMaxBuffer = 9996;
+  ErrTimeout = 9997;
+  ErrNotRead = 9998;
+  ErrFrame = 9999;
+  ErrOverrun = 10000;
+  ErrRxOver = 10001;
+  ErrRxParity = 10002;
+  ErrTxFull = 10003;
+
+  dcb_Binary = $00000001;
+  dcb_ParityCheck = $00000002;
+  dcb_OutxCtsFlow = $00000004;
+  dcb_OutxDsrFlow = $00000008;
+  dcb_DtrControlMask = $00000030;
+  dcb_DtrControlDisable = $00000000;
+  dcb_DtrControlEnable = $00000010;
+  dcb_DtrControlHandshake = $00000020;
+  dcb_DsrSensivity = $00000040;
+  dcb_TXContinueOnXoff = $00000080;
+  dcb_OutX = $00000100;
+  dcb_InX = $00000200;
+  dcb_ErrorChar = $00000400;
+  dcb_NullStrip = $00000800;
+  dcb_RtsControlMask = $00003000;
+  dcb_RtsControlDisable = $00000000;
+  dcb_RtsControlEnable = $00001000;
+  dcb_RtsControlHandshake = $00002000;
+  dcb_RtsControlToggle = $00003000;
+  dcb_AbortOnError = $00004000;
+  dcb_Reserveds = $FFFF8000;
+
+  {:stopbit value for 1 stopbit}
+  SB1 = 0;
+  {:stopbit value for 1.5 stopbit}
+  SB1andHalf = 1;
+  {:stopbit value for 2 stopbits}
+  SB2 = 2;
+
+{$IFNDEF MSWINDOWS}
+const
+  INVALID_HANDLE_VALUE = THandle(-1);
+  CS7fix = $0000020;
+
+type
+  TDCB = record
+    DCBlength: DWORD;
+    BaudRate: DWORD;
+    Flags: Longint;
+    wReserved: Word;
+    XonLim: Word;
+    XoffLim: Word;
+    ByteSize: Byte;
+    Parity: Byte;
+    StopBits: Byte;
+    XonChar: CHAR;
+    XoffChar: CHAR;
+    ErrorChar: CHAR;
+    EofChar: CHAR;
+    EvtChar: CHAR;
+    wReserved1: Word;
+  end;
+  PDCB = ^TDCB;
+
+const
+{$IFDEF LINUX}
+  MaxRates = 30;
+{$ELSE}
+  MaxRates = 19;  //FPC on some platforms not know high speeds?
+{$ENDIF}
+  Rates: array[0..MaxRates, 0..1] of cardinal =
+  (
+    (0, B0),
+    (50, B50),
+    (75, B75),
+    (110, B110),
+    (134, B134),
+    (150, B150),
+    (200, B200),
+    (300, B300),
+    (600, B600),
+    (1200, B1200),
+    (1800, B1800),
+    (2400, B2400),
+    (4800, B4800),
+    (9600, B9600),
+    (19200, B19200),
+    (38400, B38400),
+    (57600, B57600),
+    (115200, B115200),
+    (230400, B230400),
+    (460800, B460800)
+{$IFDEF LINUX}
+    ,(500000, B500000),
+    (576000, B576000),
+    (921600, B921600),
+    (1000000, B1000000),
+    (1152000, B1152000),
+    (1500000, B1500000),
+    (2000000, B2000000),
+    (2500000, B2500000),
+    (3000000, B3000000),
+    (3500000, B3500000),
+    (4000000, B4000000)
+{$ENDIF}
+    );
+{$ENDIF}
+
+const
+  sOK = 0;
+  sErr = integer(-1);
+
+type
+
+  {:Possible status event types for @link(THookSerialStatus)}
+  THookSerialReason = (
+    HR_SerialClose,
+    HR_Connect,
+    HR_CanRead,
+    HR_CanWrite,
+    HR_ReadCount,
+    HR_WriteCount,
+    HR_Wait
+    );
+
+  {:procedural prototype for status event hooking}
+  THookSerialStatus = procedure(Sender: TObject; Reason: THookSerialReason;
+    const Value: string) of object;
+
+  {:@abstract(Exception type for SynaSer errors)}
+  ESynaSerError = class(Exception)
+  public
+    ErrorCode: integer;
+    ErrorMessage: string;
+  end;
+
+  {:@abstract(Main class implementing all communication routines)}
+  TBlockSerial = class(TObject)
+  protected
+    FOnStatus: THookSerialStatus;
+    Fhandle: THandle;
+    FTag: integer;
+    FDevice: string;
+    FLastError: integer;
+    FLastErrorDesc: string;
+    FBuffer: AnsiString;
+    FRaiseExcept: boolean;
+    FRecvBuffer: integer;
+    FSendBuffer: integer;
+    FModemWord: integer;
+    FRTSToggle: Boolean;
+    FDeadlockTimeout: integer;
+    FInstanceActive: boolean;      {HGJ}
+    FTestDSR: Boolean;
+    FTestCTS: Boolean;
+    FLastCR: Boolean;
+    FLastLF: Boolean;
+    FMaxLineLength: Integer;
+    FLinuxLock: Boolean;
+    FMaxSendBandwidth: Integer;
+    FNextSend: LongWord;
+    FMaxRecvBandwidth: Integer;
+    FNextRecv: LongWord;
+    FConvertLineEnd: Boolean;
+    FATResult: Boolean;
+    FAtTimeout: integer;
+    FInterPacketTimeout: Boolean;
+    FComNr: integer;
+{$IFDEF MSWINDOWS}
+    FPortAddr: Word;
+    function CanEvent(Event: dword; Timeout: integer): boolean;
+    procedure DecodeCommError(Error: DWord); virtual;
+    function GetPortAddr: Word;  virtual;
+    function ReadTxEmpty(PortAddr: Word): Boolean; virtual;
+{$ENDIF}
+    procedure SetSizeRecvBuffer(size: integer); virtual;
+    function GetDSR: Boolean; virtual;
+    procedure SetDTRF(Value: Boolean); virtual;
+    function GetCTS: Boolean; virtual;
+    procedure SetRTSF(Value: Boolean); virtual;
+    function GetCarrier: Boolean; virtual;
+    function GetRing: Boolean; virtual;
+    procedure DoStatus(Reason: THookSerialReason; const Value: string); virtual;
+    procedure GetComNr(Value: string); virtual;
+    function PreTestFailing: boolean; virtual;{HGJ}
+    function TestCtrlLine: Boolean; virtual;
+{$IFNDEF MSWINDOWS}
+    procedure DcbToTermios(const dcb: TDCB; var term: termios); virtual;
+    procedure TermiosToDcb(const term: termios; var dcb: TDCB); virtual;
+{$ENDIF}
+{$IFDEF LINUX}
+    function ReadLockfile: integer; virtual;
+    function LockfileName: String; virtual;
+    procedure CreateLockfile(PidNr: integer); virtual;
+{$ENDIF}
+    procedure LimitBandwidth(Length: Integer; MaxB: integer; var Next: LongWord); virtual;
+    procedure SetBandwidth(Value: Integer); virtual;
+  public
+    {: data Control Block with communication parameters. Usable only when you
+     need to call API directly.}
+    DCB: Tdcb;
+{$IFNDEF MSWINDOWS}
+    TermiosStruc: termios;
+{$ENDIF}
+    {:Object constructor.}
+    constructor Create;
+    {:Object destructor.}
+    destructor Destroy; override;
+
+    {:Returns a string containing the version number of the library.}
+    class function GetVersion: string; virtual;
+
+    {:Destroy handle in use. It close connection to serial port.}
+    procedure CloseSocket; virtual;
+
+    {:Reconfigure communication parameters on the fly. You must be connected to
+     port before!
+     @param(baud Define connection speed. Baud rate can be from 50 to 4000000
+      bits per second. (it depends on your hardware!))
+     @param(bits Number of bits in communication.)
+     @param(parity Define communication parity (N - None, O - Odd, E - Even, M - Mark or S - Space).)
+     @param(stop Define number of stopbits. Use constants @link(SB1),
+      @link(SB1andHalf) and @link(SB2).)
+     @param(softflow Enable XON/XOFF handshake.)
+     @param(hardflow Enable CTS/RTS handshake.)}
+    procedure Config(baud, bits: integer; parity: char; stop: integer;
+      softflow, hardflow: boolean); virtual;
+
+    {:Connects to the port indicated by comport. Comport can be used in Windows
+     style (COM2), or in Linux style (/dev/ttyS1). When you use windows style
+     in Linux, then it will be converted to Linux name. And vice versa! However
+     you can specify any device name! (other device names then standart is not
+     converted!)
+
+     After successfull connection the DTR signal is set (if you not set hardware
+     handshake, then the RTS signal is set, too!)
+
+     Connection parameters is predefined by your system configuration. If you
+     need use another parameters, then you can use Config method after.
+     Notes:
+
+      - Remember, the commonly used serial Laplink cable does not support
+       hardware handshake.
+
+      - Before setting any handshake you must be sure that it is supported by
+       your hardware.
+
+      - Some serial devices are slow. In some cases you must wait up to a few
+       seconds after connection for the device to respond.
+
+      - when you connect to a modem device, then is best to test it by an empty
+       AT command. (call ATCommand('AT'))}
+    procedure Connect(comport: string); virtual;
+
+    {:Set communication parameters from the DCB structure (the DCB structure is
+     simulated under Linux).}
+    procedure SetCommState; virtual;
+
+    {:Read communication parameters into the DCB structure (DCB structure is
+     simulated under Linux).}
+    procedure GetCommState; virtual;
+
+    {:Sends Length bytes of data from Buffer through the connected port.}
+    function SendBuffer(buffer: pointer; length: integer): integer; virtual;
+
+    {:One data BYTE is sent.}
+    procedure SendByte(data: byte); virtual;
+
+    {:Send the string in the data parameter. No terminator is appended by this
+     method. If you need to send a string with CR/LF terminator, you must append
+     the CR/LF characters to the data string!
+
+     Since no terminator is appended, you can use this function for sending
+     binary data too.}
+    procedure SendString(data: AnsiString); virtual;
+
+    {:send four bytes as integer.}
+    procedure SendInteger(Data: integer); virtual;
+
+    {:send data as one block. Each block begins with integer value with Length
+     of block.}
+    procedure SendBlock(const Data: AnsiString); virtual;
+
+    {:send content of stream from current position}
+    procedure SendStreamRaw(const Stream: TStream); virtual;
+
+    {:send content of stream as block. see @link(SendBlock)}
+    procedure SendStream(const Stream: TStream); virtual;
+
+    {:send content of stream as block, but this is compatioble with Indy library.
+     (it have swapped lenght of block). See @link(SendStream)}
+    procedure SendStreamIndy(const Stream: TStream); virtual;
+
+    {:Waits until the allocated buffer is filled by received data. Returns number
+     of data bytes received, which equals to the Length value under normal
+     operation. If it is not equal, the communication channel is possibly broken.
+
+     This method not using any internal buffering, like all others receiving
+     methods. You cannot freely combine this method with all others receiving
+     methods!}
+    function RecvBuffer(buffer: pointer; length: integer): integer; virtual;
+
+    {:Method waits until data is received. If no data is received within
+     the Timeout (in milliseconds) period, @link(LastError) is set to
+     @link(ErrTimeout). This method is used to read any amount of data
+     (e. g. 1MB), and may be freely combined with all receviving methods what
+     have Timeout parameter, like the @link(RecvString), @link(RecvByte) or
+     @link(RecvTerminated) methods.}
+    function RecvBufferEx(buffer: pointer; length: integer; timeout: integer): integer; virtual;
+
+    {:It is like recvBufferEx, but data is readed to dynamicly allocated binary
+     string.}
+    function RecvBufferStr(Length: Integer; Timeout: Integer): AnsiString; virtual;
+
+    {:Read all available data and return it in the function result string. This
+     function may be combined with @link(RecvString), @link(RecvByte) or related
+     methods.}
+    function RecvPacket(Timeout: Integer): AnsiString; virtual;
+
+    {:Waits until one data byte is received which is returned as the function
+     result. If no data is received within the Timeout (in milliseconds) period,
+     @link(LastError) is set to @link(ErrTimeout).}
+    function RecvByte(timeout: integer): byte; virtual;
+
+    {:This method waits until a terminated data string is received. This string
+     is terminated by the Terminator string. The resulting string is returned
+     without this termination string! If no data is received within the Timeout
+     (in milliseconds) period, @link(LastError) is set to @link(ErrTimeout).}
+    function RecvTerminated(Timeout: Integer; const Terminator: AnsiString): AnsiString; virtual;
+
+    {:This method waits until a terminated data string is received. The string
+     is terminated by a CR/LF sequence. The resulting string is returned without
+     the terminator (CR/LF)! If no data is received within the Timeout (in
+     milliseconds) period, @link(LastError) is set to @link(ErrTimeout).
+
+     If @link(ConvertLineEnd) is used, then the CR/LF sequence may not be exactly
+     CR/LF. See the description of @link(ConvertLineEnd).
+
+     This method serves for line protocol implementation and uses its own
+     buffers to maximize performance. Therefore do NOT use this method with the
+     @link(RecvBuffer) method to receive data as it may cause data loss.}
+    function Recvstring(timeout: integer): AnsiString; virtual;
+
+    {:Waits until four data bytes are received which is returned as the function
+     integer result. If no data is received within the Timeout (in milliseconds) period,
+     @link(LastError) is set to @link(ErrTimeout).}
+    function RecvInteger(Timeout: Integer): Integer; virtual;
+
+    {:Waits until one data block is received. See @link(sendblock). If no data
+     is received within the Timeout (in milliseconds) period, @link(LastError)
+     is set to @link(ErrTimeout).}
+    function RecvBlock(Timeout: Integer): AnsiString; virtual;
+
+    {:Receive all data to stream, until some error occured. (for example timeout)}
+    procedure RecvStreamRaw(const Stream: TStream; Timeout: Integer); virtual;
+
+    {:receive requested count of bytes to stream}
+    procedure RecvStreamSize(const Stream: TStream; Timeout: Integer; Size: Integer); virtual;
+
+    {:receive block of data to stream. (Data can be sended by @link(sendstream)}
+    procedure RecvStream(const Stream: TStream; Timeout: Integer); virtual;
+
+    {:receive block of data to stream. (Data can be sended by @link(sendstreamIndy)}
+    procedure RecvStreamIndy(const Stream: TStream; Timeout: Integer); virtual;
+
+    {:Returns the number of received bytes waiting for reading. 0 is returned
+     when there is no data waiting.}
+    function WaitingData: integer; virtual;
+
+    {:Same as @link(WaitingData), but in respect to data in the internal
+     @link(LineBuffer).}
+    function WaitingDataEx: integer; virtual;
+
+    {:Returns the number of bytes waiting to be sent in the output buffer.
+     0 is returned when the output buffer is empty.}
+    function SendingData: integer; virtual;
+
+    {:Enable or disable RTS driven communication (half-duplex). It can be used
+     to communicate with RS485 converters, or other special equipment. If you
+     enable this feature, the system automatically controls the RTS signal.
+
+     Notes:
+
+     - On Windows NT (or higher) ir RTS signal driven by system driver.
+
+     - On Win9x family is used special code for waiting until last byte is
+      sended from your UART.
+
+     - On Linux you must have kernel 2.1 or higher!}
+    procedure EnableRTSToggle(value: boolean); virtual;
+
+    {:Waits until all data to is sent and buffers are emptied.
+     Warning: On Windows systems is this method returns when all buffers are
+     flushed to the serial port controller, before the last byte is sent!}
+    procedure Flush; virtual;
+
+    {:Unconditionally empty all buffers. It is good when you need to interrupt
+     communication and for cleanups.}
+    procedure Purge; virtual;
+
+    {:Returns @True, if you can from read any data from the port. Status is
+     tested for a period of time given by the Timeout parameter (in milliseconds).
+     If the value of the Timeout parameter is 0, the status is tested only once
+     and the function returns immediately. If the value of the Timeout parameter
+     is set to -1, the function returns only after it detects data on the port
+     (this may cause the process to hang).}
+    function CanRead(Timeout: integer): boolean; virtual;
+
+    {:Returns @True, if you can write any data to the port (this function is not
+     sending the contents of the buffer). Status is tested for a period of time
+     given by the Timeout parameter (in milliseconds). If the value of
+     the Timeout parameter is 0, the status is tested only once and the function
+     returns immediately. If the value of the  Timeout parameter is set to -1,
+     the function returns only after it detects that it can write data to
+     the port (this may cause the process to hang).}
+    function CanWrite(Timeout: integer): boolean; virtual;
+
+    {:Same as @link(CanRead), but the test is against data in the internal
+    @link(LineBuffer) too.}
+    function CanReadEx(Timeout: integer): boolean; virtual;
+
+    {:Returns the status word of the modem. Decoding the status word could yield
+     the status of carrier detect signaland other signals. This method is used
+     internally by the modem status reading properties. You usually do not need
+     to call this method directly.}
+    function ModemStatus: integer; virtual;
+
+    {:Send a break signal to the communication device for Duration milliseconds.}
+    procedure SetBreak(Duration: integer); virtual;
+
+    {:This function is designed to send AT commands to the modem. The AT command
+     is sent in the Value parameter and the response is returned in the function
+     return value (may contain multiple lines!).
+     If the AT command is processed successfully (modem returns OK), then the
+     @link(ATResult) property is set to True.
+
+     This function is designed only for AT commands that return OK or ERROR
+     response! To call connection commands the @link(ATConnect) method.
+     Remember, when you connect to a modem device, it is in AT command mode.
+     Now you can send AT commands to the modem. If you need to transfer data to
+     the modem on the other side of the line, you must first switch to data mode
+     using the @link(ATConnect) method.}
+    function ATCommand(value: AnsiString): AnsiString; virtual;
+
+    {:This function is used to send connect type AT commands to the modem. It is
+     for commands to switch to connected state. (ATD, ATA, ATO,...)
+     It sends the AT command in the Value parameter and returns the modem's
+     response (may be multiple lines - usually with connection parameters info).
+     If the AT command is processed successfully (the modem returns CONNECT),
+     then the ATResult property is set to @True.
+
+     This function is designed only for AT commands which respond by CONNECT,
+     BUSY, NO DIALTONE NO CARRIER or ERROR. For other AT commands use the
+     @link(ATCommand) method.
+
+     The connect timeout is 90*@link(ATTimeout). If this command is successful
+     (@link(ATresult) is @true), then the modem is in data state. When you now
+     send or receive some data, it is not to or from your modem, but from the
+     modem on other side of the line. Now you can transfer your data.
+     If the connection attempt failed (@link(ATResult) is @False), then the
+     modem is still in AT command mode.}
+    function ATConnect(value: AnsiString): AnsiString; virtual;
+
+    {:If you "manually" call API functions, forward their return code in
+     the SerialResult parameter to this function, which evaluates it and sets
+     @link(LastError) and @link(LastErrorDesc).}
+    function SerialCheck(SerialResult: integer): integer; virtual;
+
+    {:If @link(Lasterror) is not 0 and exceptions are enabled, then this procedure
+     raises an exception. This method is used internally. You may need it only
+     in special cases.}
+    procedure ExceptCheck; virtual;
+
+    {:Set Synaser to error state with ErrNumber code. Usually used by internal
+     routines.}
+    procedure SetSynaError(ErrNumber: integer); virtual;
+
+    {:Raise Synaser error with ErrNumber code. Usually used by internal routines.}
+    procedure RaiseSynaError(ErrNumber: integer); virtual;
+{$IFDEF LINUX}
+    function  cpomComportAccessible: boolean; virtual;{HGJ}
+    procedure cpomReleaseComport; virtual; {HGJ}
+{$ENDIF}
+    {:True device name of currently used port}
+    property Device: string read FDevice;
+
+    {:Error code of last operation. Value is defined by the host operating
+     system, but value 0 is always OK.}
+    property LastError: integer read FLastError;
+
+    {:Human readable description of LastError code.}
+    property LastErrorDesc: string read FLastErrorDesc;
+
+    {:Indicates if the last @link(ATCommand) or @link(ATConnect) method was successful}
+    property ATResult: Boolean read FATResult;
+
+    {:Read the value of the RTS signal.}
+    property RTS: Boolean write SetRTSF;
+
+    {:Indicates the presence of the CTS signal}
+    property CTS: boolean read GetCTS;
+
+    {:Use this property to set the value of the DTR signal.}
+    property DTR: Boolean write SetDTRF;
+
+    {:Exposes the status of the DSR signal.}
+    property DSR: boolean read GetDSR;
+
+    {:Indicates the presence of the Carrier signal}
+    property Carrier: boolean read GetCarrier;
+
+    {:Reflects the status of the Ring signal.}
+    property Ring: boolean read GetRing;
+
+    {:indicates if this instance of SynaSer is active. (Connected to some port)}
+    property InstanceActive: boolean read FInstanceActive; {HGJ}
+
+    {:Defines maximum bandwidth for all sending operations in bytes per second.
+     If this value is set to 0 (default), bandwidth limitation is not used.}
+    property MaxSendBandwidth: Integer read FMaxSendBandwidth Write FMaxSendBandwidth;
+
+    {:Defines maximum bandwidth for all receiving operations in bytes per second.
+     If this value is set to 0 (default), bandwidth limitation is not used.}
+    property MaxRecvBandwidth: Integer read FMaxRecvBandwidth Write FMaxRecvBandwidth;
+
+    {:Defines maximum bandwidth for all sending and receiving operations
+     in bytes per second. If this value is set to 0 (default), bandwidth
+     limitation is not used.}
+    property MaxBandwidth: Integer Write SetBandwidth;
+
+    {:Size of the Windows internal receive buffer. Default value is usually
+     4096 bytes. Note: Valid only in Windows versions!}
+    property SizeRecvBuffer: integer read FRecvBuffer write SetSizeRecvBuffer;
+  published
+    {:Returns the descriptive text associated with ErrorCode. You need this
+     method only in special cases. Description of LastError is now accessible
+     through the LastErrorDesc property.}
+    class function GetErrorDesc(ErrorCode: integer): string;
+
+    {:Freely usable property}
+    property Tag: integer read FTag write FTag;
+
+    {:Contains the handle of the open communication port.
+    You may need this value to directly call communication functions outside
+    SynaSer.}
+    property Handle: THandle read Fhandle write FHandle;
+
+    {:Internally used read buffer.}
+    property LineBuffer: AnsiString read FBuffer write FBuffer;
+
+    {:If @true, communication errors raise exceptions. If @false (default), only
+     the @link(LastError) value is set.}
+    property RaiseExcept: boolean read FRaiseExcept write FRaiseExcept;
+
+    {:This event is triggered when the communication status changes. It can be
+     used to monitor communication status.}
+    property OnStatus: THookSerialStatus read FOnStatus write FOnStatus;
+
+    {:If you set this property to @true, then the value of the DSR signal
+     is tested before every data transfer. It can be used to detect the presence
+     of a communications device.}
+    property TestDSR: boolean read FTestDSR write FTestDSR;
+
+    {:If you set this property to @true, then the value of the CTS signal
+     is tested before every data transfer. It can be used to detect the presence
+     of a communications device. Warning: This property cannot be used if you
+     need hardware handshake!}
+    property TestCTS: boolean read FTestCTS write FTestCTS;
+
+    {:Use this property you to limit the maximum size of LineBuffer
+     (as a protection against unlimited memory allocation for LineBuffer).
+     Default value is 0 - no limit.}
+    property MaxLineLength: Integer read FMaxLineLength Write FMaxLineLength;
+
+    {:This timeout value is used as deadlock protection when trying to send data
+     to (or receive data from) a device that stopped communicating during data
+     transmission (e.g. by physically disconnecting the device).
+     The timeout value is in milliseconds. The default value is 30,000 (30 seconds).}
+    property DeadlockTimeout: Integer read FDeadlockTimeout Write FDeadlockTimeout;
+
+    {:If set to @true (default value), port locking is enabled (under Linux only).
+     WARNING: To use this feature, the application must run by a user with full
+     permission to the /var/lock directory!}
+    property LinuxLock: Boolean read FLinuxLock write FLinuxLock;
+
+    {:Indicates if non-standard line terminators should be converted to a CR/LF pair
+     (standard DOS line terminator). If @TRUE, line terminators CR, single LF
+     or LF/CR are converted to CR/LF. Defaults to @FALSE.
+     This property has effect only on the behavior of the RecvString method.}
+    property ConvertLineEnd: Boolean read FConvertLineEnd Write FConvertLineEnd;
+
+    {:Timeout for AT modem based operations}
+    property AtTimeout: integer read FAtTimeout Write FAtTimeout;
+
+    {:If @true (default), then all timeouts is timeout between two characters.
+     If @False, then timeout is overall for whoole reading operation.}
+    property InterPacketTimeout: Boolean read FInterPacketTimeout Write FInterPacketTimeout;
+  end;
+
+{:Returns list of existing computer serial ports. Working properly only in Windows!}
+function GetSerialPortNames: string;
+
+implementation
+
+constructor TBlockSerial.Create;
+begin
+  inherited create;
+  FRaiseExcept := false;
+  FHandle := INVALID_HANDLE_VALUE;
+  FDevice := '';
+  FComNr:= PortIsClosed;               {HGJ}
+  FInstanceActive:= false;             {HGJ}
+  Fbuffer := '';
+  FRTSToggle := False;
+  FMaxLineLength := 0;
+  FTestDSR := False;
+  FTestCTS := False;
+  FDeadlockTimeout := 30000;
+  FLinuxLock := True;
+  FMaxSendBandwidth := 0;
+  FNextSend := 0;
+  FMaxRecvBandwidth := 0;
+  FNextRecv := 0;
+  FConvertLineEnd := False;
+  SetSynaError(sOK);
+  FRecvBuffer := 4096;
+  FLastCR := False;
+  FLastLF := False;
+  FAtTimeout := 1000;
+  FInterPacketTimeout := True;
+end;
+
+destructor TBlockSerial.Destroy;
+begin
+  CloseSocket;
+  inherited destroy;
+end;
+
+class function TBlockSerial.GetVersion: string;
+begin
+	Result := 'SynaSer 7.4.0';
+end;
+
+procedure TBlockSerial.CloseSocket;
+begin
+  if Fhandle <> INVALID_HANDLE_VALUE then
+  begin
+    Purge;
+    RTS := False;
+    DTR := False;
+    FileClose(FHandle);
+  end;
+  if InstanceActive then
+  begin
+    {$IFDEF LINUX}
+    if FLinuxLock then
+      cpomReleaseComport;
+    {$ENDIF}
+    FInstanceActive:= false
+  end;
+  Fhandle := INVALID_HANDLE_VALUE;
+  FComNr:= PortIsClosed;
+  SetSynaError(sOK);
+  DoStatus(HR_SerialClose, FDevice);
+end;
+
+{$IFDEF MSWINDOWS}
+function TBlockSerial.GetPortAddr: Word;
+begin
+  Result := 0;
+  if Win32Platform <> VER_PLATFORM_WIN32_NT then
+  begin
+    EscapeCommFunction(FHandle, 10);
+    asm
+      MOV @Result, DX;
+    end;
+  end;
+end;
+
+function TBlockSerial.ReadTxEmpty(PortAddr: Word): Boolean;
+begin
+  Result := True;
+  if Win32Platform <> VER_PLATFORM_WIN32_NT then
+  begin
+    asm
+      MOV DX, PortAddr;
+      ADD DX, 5;
+      IN AL, DX;
+      AND AL, $40;
+      JZ @K;
+      MOV AL,1;
+    @K: MOV @Result, AL;
+    end;
+  end;
+end;
+{$ENDIF}
+
+procedure TBlockSerial.GetComNr(Value: string);
+begin
+  FComNr := PortIsClosed;
+  if pos('COM', uppercase(Value)) = 1 then
+    FComNr := StrToIntdef(copy(Value, 4, Length(Value) - 3), PortIsClosed + 1) - 1;
+  if pos('/DEV/TTYS', uppercase(Value)) = 1 then
+    FComNr := StrToIntdef(copy(Value, 10, Length(Value) - 9), PortIsClosed - 1);
+end;
+
+procedure TBlockSerial.SetBandwidth(Value: Integer);
+begin
+  MaxSendBandwidth := Value;
+  MaxRecvBandwidth := Value;
+end;
+
+procedure TBlockSerial.LimitBandwidth(Length: Integer; MaxB: integer; var Next: LongWord);
+var
+  x: LongWord;
+  y: LongWord;
+begin
+  if MaxB > 0 then
+  begin
+    y := GetTick;
+    if Next > y then
+    begin
+      x := Next - y;
+      if x > 0 then
+      begin
+        DoStatus(HR_Wait, IntToStr(x));
+        sleep(x);
+      end;
+    end;
+    Next := GetTick + Trunc((Length / MaxB) * 1000);
+  end;
+end;
+
+procedure TBlockSerial.Config(baud, bits: integer; parity: char; stop: integer;
+  softflow, hardflow: boolean);
+begin
+  FillChar(dcb, SizeOf(dcb), 0);
+  GetCommState;
+  dcb.DCBlength := SizeOf(dcb);
+  dcb.BaudRate := baud;
+  dcb.ByteSize := bits;
+  case parity of
+    'N', 'n': dcb.parity := 0;
+    'O', 'o': dcb.parity := 1;
+    'E', 'e': dcb.parity := 2;
+    'M', 'm': dcb.parity := 3;
+    'S', 's': dcb.parity := 4;
+  end;
+  dcb.StopBits := stop;
+  dcb.XonChar := #17;
+  dcb.XoffChar := #19;
+  dcb.XonLim := FRecvBuffer div 4;
+  dcb.XoffLim := FRecvBuffer div 4;
+  dcb.Flags := dcb_Binary;
+  if softflow then
+    dcb.Flags := dcb.Flags or dcb_OutX or dcb_InX;
+  if hardflow then
+    dcb.Flags := dcb.Flags or dcb_OutxCtsFlow or dcb_RtsControlHandshake
+  else
+    dcb.Flags := dcb.Flags or dcb_RtsControlEnable;
+  dcb.Flags := dcb.Flags or dcb_DtrControlEnable;
+  if dcb.Parity > 0 then
+    dcb.Flags := dcb.Flags or dcb_ParityCheck;
+  SetCommState;
+end;
+
+procedure TBlockSerial.Connect(comport: string);
+{$IFDEF MSWINDOWS}
+var
+  CommTimeouts: TCommTimeouts;
+{$ENDIF}
+begin
+  // Is this TBlockSerial Instance already busy?
+  if InstanceActive then           {HGJ}
+  begin                            {HGJ}
+    RaiseSynaError(ErrAlreadyInUse);
+    Exit;                          {HGJ}
+  end;                             {HGJ}
+  FBuffer := '';
+  FDevice := comport;
+  GetComNr(comport);
+{$IFDEF MSWINDOWS}
+  SetLastError (sOK);
+{$ELSE}
+  {$IFNDEF FPC}
+  SetLastError (sOK);
+  {$ELSE}
+  fpSetErrno(sOK);
+  {$ENDIF}
+{$ENDIF}
+{$IFNDEF MSWINDOWS}
+  if FComNr <> PortIsClosed then
+    FDevice := '/dev/ttyS' + IntToStr(FComNr);
+  // Comport already owned by another process?          {HGJ}
+  if FLinuxLock then
+    if not cpomComportAccessible then
+    begin
+      RaiseSynaError(ErrAlreadyOwned);
+      Exit;
+    end;
+{$IFNDEF FPC}
+  FHandle := THandle(Libc.open(pchar(FDevice), O_RDWR or O_SYNC));
+{$ELSE}
+  FHandle := THandle(fpOpen(FDevice, O_RDWR or O_SYNC));
+{$ENDIF}
+  if FHandle = INVALID_HANDLE_VALUE then  //because THandle is not integer on all platforms!
+    SerialCheck(-1)
+  else
+    SerialCheck(0);
+  {$IFDEF LINUX}
+  if FLastError <> sOK then
+    if FLinuxLock then
+      cpomReleaseComport;
+  {$ENDIF}
+  ExceptCheck;
+  if FLastError <> sOK then
+    Exit;
+{$ELSE}
+  if FComNr <> PortIsClosed then
+    FDevice := '\\.\COM' + IntToStr(FComNr + 1);
+  FHandle := THandle(CreateFile(PChar(FDevice), GENERIC_READ or GENERIC_WRITE,
+    0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED, 0));
+  if FHandle = INVALID_HANDLE_VALUE then  //because THandle is not integer on all platforms!
+    SerialCheck(-1)
+  else
+    SerialCheck(0);
+  ExceptCheck;
+  if FLastError <> sOK then
+    Exit;
+  SetCommMask(FHandle, 0);
+  SetupComm(Fhandle, FRecvBuffer, 0);
+  CommTimeOuts.ReadIntervalTimeout := MAXWORD;
+  CommTimeOuts.ReadTotalTimeoutMultiplier := 0;
+  CommTimeOuts.ReadTotalTimeoutConstant := 0;
+  CommTimeOuts.WriteTotalTimeoutMultiplier := 0;
+  CommTimeOuts.WriteTotalTimeoutConstant := 0;
+  SetCommTimeOuts(FHandle, CommTimeOuts);
+  FPortAddr := GetPortAddr;
+{$ENDIF}
+  SetSynaError(sOK);
+  if not TestCtrlLine then  {HGJ}
+  begin
+    SetSynaError(ErrNoDeviceAnswer);
+    FileClose(FHandle);         {HGJ}
+    {$IFDEF LINUX}
+    if FLinuxLock then
+      cpomReleaseComport;                {HGJ}
+    {$ENDIF}                             {HGJ}
+    Fhandle := INVALID_HANDLE_VALUE;     {HGJ}
+    FComNr:= PortIsClosed;               {HGJ}
+  end
+  else
+  begin
+    FInstanceActive:= True;
+    RTS := True;
+    DTR := True;
+    Purge;
+  end;
+  ExceptCheck;
+  DoStatus(HR_Connect, FDevice);
+end;
+
+function TBlockSerial.SendBuffer(buffer: pointer; length: integer): integer;
+{$IFDEF MSWINDOWS}
+var
+  Overlapped: TOverlapped;
+  x, y, Err: DWord;
+{$ENDIF}
+begin
+  Result := 0;
+  if PreTestFailing then   {HGJ}
+    Exit;                  {HGJ}
+  LimitBandwidth(Length, FMaxSendBandwidth, FNextsend);
+  if FRTSToggle then
+  begin
+    Flush;
+    RTS := True;
+  end;
+{$IFNDEF MSWINDOWS}
+  result := FileWrite(Fhandle, Buffer^, Length);
+  serialcheck(result);
+{$ELSE}
+  FillChar(Overlapped, Sizeof(Overlapped), 0);
+  SetSynaError(sOK);
+  y := 0;
+  if not WriteFile(FHandle, Buffer^, Length, DWord(Result), @Overlapped) then
+    y := GetLastError;
+  if y = ERROR_IO_PENDING then
+  begin
+    x := WaitForSingleObject(FHandle, FDeadlockTimeout);
+    if x = WAIT_TIMEOUT then
+    begin
+      PurgeComm(FHandle, PURGE_TXABORT);
+      SetSynaError(ErrTimeout);
+    end;
+    GetOverlappedResult(FHandle, Overlapped, Dword(Result), False);
+  end
+  else
+    SetSynaError(y);
+  ClearCommError(FHandle, err, nil);
+  if err <> 0 then
+    DecodeCommError(err);
+{$ENDIF}
+  if FRTSToggle then
+  begin
+    Flush;
+    CanWrite(255);
+    RTS := False;
+  end;
+  ExceptCheck;
+  DoStatus(HR_WriteCount, IntToStr(Result));
+end;
+
+procedure TBlockSerial.SendByte(data: byte);
+begin
+  SendBuffer(@Data, 1);
+end;
+
+procedure TBlockSerial.SendString(data: AnsiString);
+begin
+  SendBuffer(Pointer(Data), Length(Data));
+end;
+
+procedure TBlockSerial.SendInteger(Data: integer);
+begin
+  SendBuffer(@data, SizeOf(Data));
+end;
+
+procedure TBlockSerial.SendBlock(const Data: AnsiString);
+begin
+  SendInteger(Length(data));
+  SendString(Data);
+end;
+
+procedure TBlockSerial.SendStreamRaw(const Stream: TStream);
+var
+  si: integer;
+  x, y, yr: integer;
+  s: AnsiString;
+begin
+  si := Stream.Size - Stream.Position;
+  x := 0;
+  while x < si do
+  begin
+    y := si - x;
+    if y > cSerialChunk then
+      y := cSerialChunk;
+    Setlength(s, y);
+    yr := Stream.read(PAnsiChar(s)^, y);
+    if yr > 0 then
+    begin
+      SetLength(s, yr);
+      SendString(s);
+      Inc(x, yr);
+    end
+    else
+      break;
+  end;
+end;
+
+procedure TBlockSerial.SendStreamIndy(const Stream: TStream);
+var
+  si: integer;
+begin
+  si := Stream.Size - Stream.Position;
+  si := Swapbytes(si);
+  SendInteger(si);
+  SendStreamRaw(Stream);
+end;
+
+procedure TBlockSerial.SendStream(const Stream: TStream);
+var
+  si: integer;
+begin
+  si := Stream.Size - Stream.Position;
+  SendInteger(si);
+  SendStreamRaw(Stream);
+end;
+
+function TBlockSerial.RecvBuffer(buffer: pointer; length: integer): integer;
+{$IFNDEF MSWINDOWS}
+begin
+  Result := 0;
+  if PreTestFailing then   {HGJ}
+    Exit;                  {HGJ}
+  LimitBandwidth(Length, FMaxRecvBandwidth, FNextRecv);
+  result := FileRead(FHandle, Buffer^, length);
+  serialcheck(result);
+{$ELSE}
+var
+  Overlapped: TOverlapped;
+  x, y, Err: DWord;
+begin
+  Result := 0;
+  if PreTestFailing then   {HGJ}
+    Exit;                  {HGJ}
+  LimitBandwidth(Length, FMaxRecvBandwidth, FNextRecv);
+  FillChar(Overlapped, Sizeof(Overlapped), 0);
+  SetSynaError(sOK);
+  y := 0;
+  if not ReadFile(FHandle, Buffer^, length, Dword(Result), @Overlapped) then
+    y := GetLastError;
+  if y = ERROR_IO_PENDING then
+  begin
+    x := WaitForSingleObject(FHandle, FDeadlockTimeout);
+    if x = WAIT_TIMEOUT then
+    begin
+      PurgeComm(FHandle, PURGE_RXABORT);
+      SetSynaError(ErrTimeout);
+    end;
+    GetOverlappedResult(FHandle, Overlapped, Dword(Result), False);
+  end
+  else
+    SetSynaError(y);
+  ClearCommError(FHandle, err, nil);
+  if err <> 0 then
+    DecodeCommError(err);
+{$ENDIF}
+  ExceptCheck;
+  DoStatus(HR_ReadCount, IntToStr(Result));
+end;
+
+function TBlockSerial.RecvBufferEx(buffer: pointer; length: integer; timeout: integer): integer;
+var
+  s: AnsiString;
+  rl, l: integer;
+  ti: LongWord;
+begin
+  Result := 0;
+  if PreTestFailing then   {HGJ}
+    Exit;                  {HGJ}
+  SetSynaError(sOK);
+  rl := 0;
+  repeat
+    ti := GetTick;
+    s := RecvPacket(Timeout);
+    l := System.Length(s);
+    if (rl + l) > Length then
+      l := Length - rl;
+    Move(Pointer(s)^, IncPoint(Buffer, rl)^, l);
+    rl := rl + l;
+    if FLastError <> sOK then
+      Break;
+    if rl >= Length then
+      Break;
+    if not FInterPacketTimeout then
+    begin
+      Timeout := Timeout - integer(TickDelta(ti, GetTick));
+      if Timeout <= 0 then
+      begin
+        SetSynaError(ErrTimeout);
+        Break;
+      end;
+    end;
+  until False;
+  delete(s, 1, l);
+  FBuffer := s;
+  Result := rl;
+end;
+
+function TBlockSerial.RecvBufferStr(Length: Integer; Timeout: Integer): AnsiString;
+var
+  x: integer;
+begin
+  Result := '';
+  if PreTestFailing then   {HGJ}
+    Exit;                  {HGJ}
+  SetSynaError(sOK);
+  if Length > 0 then
+  begin
+    Setlength(Result, Length);
+    x := RecvBufferEx(PAnsiChar(Result), Length , Timeout);
+    if FLastError = sOK then
+      SetLength(Result, x)
+    else
+      Result := '';
+  end;
+end;
+
+function TBlockSerial.RecvPacket(Timeout: Integer): AnsiString;
+var
+  x: integer;
+begin
+  Result := '';
+  if PreTestFailing then   {HGJ}
+    Exit;                  {HGJ}
+  SetSynaError(sOK);
+  if FBuffer <> '' then
+  begin
+    Result := FBuffer;
+    FBuffer := '';
+  end
+  else
+  begin
+    //not drain CPU on large downloads...
+    Sleep(0);
+    x := WaitingData;
+    if x > 0 then
+    begin
+      SetLength(Result, x);
+      x := RecvBuffer(Pointer(Result), x);
+      if x >= 0 then
+        SetLength(Result, x);
+    end
+    else
+    begin
+      if CanRead(Timeout) then
+      begin
+        x := WaitingData;
+        if x = 0 then
+          SetSynaError(ErrTimeout);
+        if x > 0 then
+        begin
+          SetLength(Result, x);
+          x := RecvBuffer(Pointer(Result), x);
+          if x >= 0 then
+            SetLength(Result, x);
+        end;
+      end
+      else
+        SetSynaError(ErrTimeout);
+    end;
+  end;
+  ExceptCheck;
+end;
+
+
+function TBlockSerial.RecvByte(timeout: integer): byte;
+begin
+  Result := 0;
+  if PreTestFailing then   {HGJ}
+    Exit;                  {HGJ}
+  SetSynaError(sOK);
+  if FBuffer = '' then
+    FBuffer := RecvPacket(Timeout);
+  if (FLastError = sOK) and (FBuffer <> '') then
+  begin
+    Result := Ord(FBuffer[1]);
+    System.Delete(FBuffer, 1, 1);
+  end;
+  ExceptCheck;
+end;
+
+function TBlockSerial.RecvTerminated(Timeout: Integer; const Terminator: AnsiString): AnsiString;
+var
+  x: Integer;
+  s: AnsiString;
+  l: Integer;
+  CorCRLF: Boolean;
+  t: ansistring;
+  tl: integer;
+  ti: LongWord;
+begin
+  Result := '';
+  if PreTestFailing then   {HGJ}
+    Exit;                  {HGJ}
+  SetSynaError(sOK);
+  l := system.Length(Terminator);
+  if l = 0 then
+    Exit;
+  tl := l;
+  CorCRLF := FConvertLineEnd and (Terminator = CRLF);
+  s := '';
+  x := 0;
+  repeat
+    ti := GetTick;
+    //get rest of FBuffer or incomming new data...
+    s := s + RecvPacket(Timeout);
+    if FLastError <> sOK then
+      Break;
+    x := 0;
+    if Length(s) > 0 then
+      if CorCRLF then
+      begin
+        if FLastCR and (s[1] = LF) then
+          Delete(s, 1, 1);
+        if FLastLF and (s[1] = CR) then
+          Delete(s, 1, 1);
+        FLastCR := False;
+        FLastLF := False;
+        t := '';
+        x := PosCRLF(s, t);
+        tl := system.Length(t);
+        if t = CR then
+          FLastCR := True;
+        if t = LF then
+          FLastLF := True;
+      end
+      else
+      begin
+        x := pos(Terminator, s);
+        tl := l;
+      end;
+    if (FMaxLineLength <> 0) and (system.Length(s) > FMaxLineLength) then
+    begin
+      SetSynaError(ErrMaxBuffer);
+      Break;
+    end;
+    if x > 0 then
+      Break;
+    if not FInterPacketTimeout then
+    begin
+      Timeout := Timeout - integer(TickDelta(ti, GetTick));
+      if Timeout <= 0 then
+      begin
+        SetSynaError(ErrTimeout);
+        Break;
+      end;
+    end;
+  until False;
+  if x > 0 then
+  begin
+    Result := Copy(s, 1, x - 1);
+    System.Delete(s, 1, x + tl - 1);
+  end;
+  FBuffer := s;
+  ExceptCheck;
+end;
+
+
+function TBlockSerial.RecvString(Timeout: Integer): AnsiString;
+var
+  s: AnsiString;
+begin
+  Result := '';
+  s := RecvTerminated(Timeout, #13 + #10);
+  if FLastError = sOK then
+    Result := s;
+end;
+
+function TBlockSerial.RecvInteger(Timeout: Integer): Integer;
+var
+  s: AnsiString;
+begin
+  Result := 0;
+  s := RecvBufferStr(4, Timeout);
+  if FLastError = 0 then
+    Result := (ord(s[1]) + ord(s[2]) * 256) + (ord(s[3]) + ord(s[4]) * 256) * 65536;
+end;
+
+function TBlockSerial.RecvBlock(Timeout: Integer): AnsiString;
+var
+  x: integer;
+begin
+  Result := '';
+  x := RecvInteger(Timeout);
+  if FLastError = 0 then
+    Result := RecvBufferStr(x, Timeout);
+end;
+
+procedure TBlockSerial.RecvStreamRaw(const Stream: TStream; Timeout: Integer);
+var
+  s: AnsiString;
+begin
+  repeat
+    s := RecvPacket(Timeout);
+    if FLastError = 0 then
+      WriteStrToStream(Stream, s);
+  until FLastError <> 0;
+end;
+
+procedure TBlockSerial.RecvStreamSize(const Stream: TStream; Timeout: Integer; Size: Integer);
+var
+  s: AnsiString;
+  n: integer;
+begin
+  for n := 1 to (Size div cSerialChunk) do
+  begin
+    s := RecvBufferStr(cSerialChunk, Timeout);
+    if FLastError <> 0 then
+      Exit;
+    Stream.Write(PAnsichar(s)^, cSerialChunk);
+  end;
+  n := Size mod cSerialChunk;
+  if n > 0 then
+  begin
+    s := RecvBufferStr(n, Timeout);
+    if FLastError <> 0 then
+      Exit;
+    Stream.Write(PAnsichar(s)^, n);
+  end;
+end;
+
+procedure TBlockSerial.RecvStreamIndy(const Stream: TStream; Timeout: Integer);
+var
+  x: integer;
+begin
+  x := RecvInteger(Timeout);
+  x := SwapBytes(x);
+  if FLastError = 0 then
+    RecvStreamSize(Stream, Timeout, x);
+end;
+
+procedure TBlockSerial.RecvStream(const Stream: TStream; Timeout: Integer);
+var
+  x: integer;
+begin
+  x := RecvInteger(Timeout);
+  if FLastError = 0 then
+    RecvStreamSize(Stream, Timeout, x);
+end;
+
+{$IFNDEF MSWINDOWS}
+function TBlockSerial.WaitingData: integer;
+begin
+{$IFNDEF FPC}
+  serialcheck(ioctl(FHandle, FIONREAD, @result));
+{$ELSE}
+  serialcheck(fpIoctl(FHandle, FIONREAD, @result));
+{$ENDIF}
+  if FLastError <> 0 then
+    Result := 0;
+  ExceptCheck;
+end;
+{$ELSE}
+function TBlockSerial.WaitingData: integer;
+var
+  stat: TComStat;
+  err: DWORD;
+begin
+  if ClearCommError(FHandle, err, @stat) then
+  begin
+    SetSynaError(sOK);
+    Result := stat.cbInQue;
+  end
+  else
+  begin
+    SerialCheck(sErr);
+    Result := 0;
+  end;
+  ExceptCheck;
+end;
+{$ENDIF}
+
+function TBlockSerial.WaitingDataEx: integer;
+begin
+	if FBuffer <> '' then
+  	Result := Length(FBuffer)
+  else
+  	Result := Waitingdata;
+end;
+
+{$IFNDEF MSWINDOWS}
+function TBlockSerial.SendingData: integer;
+begin
+  SetSynaError(sOK);
+  Result := 0;
+end;
+{$ELSE}
+function TBlockSerial.SendingData: integer;
+var
+  stat: TComStat;
+  err: DWORD;
+begin
+  SetSynaError(sOK);
+  if not ClearCommError(FHandle, err, @stat) then
+    serialcheck(sErr);
+  ExceptCheck;
+  result := stat.cbOutQue;
+end;
+{$ENDIF}
+
+{$IFNDEF MSWINDOWS}
+procedure TBlockSerial.DcbToTermios(const dcb: TDCB; var term: termios);
+var
+  n: integer;
+  x: cardinal;
+begin
+  //others
+  cfmakeraw(term);
+  term.c_cflag := term.c_cflag or CREAD;
+  term.c_cflag := term.c_cflag or CLOCAL;
+  term.c_cflag := term.c_cflag or HUPCL;
+  //hardware handshake
+  if (dcb.flags and dcb_RtsControlHandshake) > 0 then
+    term.c_cflag := term.c_cflag or CRTSCTS
+  else
+    term.c_cflag := term.c_cflag and (not CRTSCTS);
+  //software handshake
+  if (dcb.flags and dcb_OutX) > 0 then
+    term.c_iflag := term.c_iflag or IXON or IXOFF or IXANY
+  else
+    term.c_iflag := term.c_iflag and (not (IXON or IXOFF or IXANY));
+  //size of byte
+  term.c_cflag := term.c_cflag and (not CSIZE);
+  case dcb.bytesize of
+    5:
+      term.c_cflag := term.c_cflag or CS5;
+    6:
+      term.c_cflag := term.c_cflag or CS6;
+    7:
+{$IFDEF FPC}
+      term.c_cflag := term.c_cflag or CS7;
+{$ELSE}
+      term.c_cflag := term.c_cflag or CS7fix;
+{$ENDIF}
+    8:
+      term.c_cflag := term.c_cflag or CS8;
+  end;
+  //parity
+  if (dcb.flags and dcb_ParityCheck) > 0 then
+    term.c_cflag := term.c_cflag or PARENB
+  else
+    term.c_cflag := term.c_cflag and (not PARENB);
+  case dcb.parity of
+    1: //'O'
+      term.c_cflag := term.c_cflag or PARODD;
+    2: //'E'
+      term.c_cflag := term.c_cflag and (not PARODD);
+  end;
+  //stop bits
+  if dcb.stopbits > 0 then
+    term.c_cflag := term.c_cflag or CSTOPB
+  else
+    term.c_cflag := term.c_cflag and (not CSTOPB);
+  //set baudrate;
+  x := 0;
+  for n := 0 to Maxrates do
+    if rates[n, 0] = dcb.BaudRate then
+    begin
+      x := rates[n, 1];
+      break;
+    end;
+  cfsetospeed(term, x);
+  cfsetispeed(term, x);
+end;
+
+procedure TBlockSerial.TermiosToDcb(const term: termios; var dcb: TDCB);
+var
+  n: integer;
+  x: cardinal;
+begin
+  //set baudrate;
+  dcb.baudrate := 0;
+ {$IFDEF FPC}
+  //why FPC not have cfgetospeed???
+  x := term.c_oflag and $0F;
+ {$ELSE}
+  x := cfgetospeed(term);
+ {$ENDIF}
+  for n := 0 to Maxrates do
+    if rates[n, 1] = x then
+    begin
+      dcb.baudrate := rates[n, 0];
+      break;
+    end;
+  //hardware handshake
+  if (term.c_cflag and CRTSCTS) > 0 then
+    dcb.flags := dcb.flags or dcb_RtsControlHandshake or dcb_OutxCtsFlow
+  else
+    dcb.flags := dcb.flags and (not (dcb_RtsControlHandshake or dcb_OutxCtsFlow));
+  //software handshake
+  if (term.c_cflag and IXOFF) > 0 then
+    dcb.flags := dcb.flags or dcb_OutX or dcb_InX
+  else
+    dcb.flags := dcb.flags and (not (dcb_OutX or dcb_InX));
+  //size of byte
+  case term.c_cflag and CSIZE of
+    CS5:
+      dcb.bytesize := 5;
+    CS6:
+      dcb.bytesize := 6;
+    CS7fix:
+      dcb.bytesize := 7;
+    CS8:
+      dcb.bytesize := 8;
+  end;
+  //parity
+  if (term.c_cflag and PARENB) > 0 then
+    dcb.flags := dcb.flags or dcb_ParityCheck
+  else
+    dcb.flags := dcb.flags and (not dcb_ParityCheck);
+  dcb.parity := 0;
+  if (term.c_cflag and PARODD) > 0 then
+    dcb.parity := 1
+  else
+    dcb.parity := 2;
+  //stop bits
+  if (term.c_cflag and CSTOPB) > 0 then
+    dcb.stopbits := 2
+  else
+    dcb.stopbits := 0;
+end;
+{$ENDIF}
+
+{$IFNDEF MSWINDOWS}
+procedure TBlockSerial.SetCommState;
+begin
+  DcbToTermios(dcb, termiosstruc);
+  SerialCheck(tcsetattr(FHandle, TCSANOW, termiosstruc));
+  ExceptCheck;
+end;
+{$ELSE}
+procedure TBlockSerial.SetCommState;
+begin
+  SetSynaError(sOK);
+  if not windows.SetCommState(Fhandle, dcb) then
+    SerialCheck(sErr);
+  ExceptCheck;
+end;
+{$ENDIF}
+
+{$IFNDEF MSWINDOWS}
+procedure TBlockSerial.GetCommState;
+begin
+  SerialCheck(tcgetattr(FHandle, termiosstruc));
+  ExceptCheck;
+  TermiostoDCB(termiosstruc, dcb);
+end;
+{$ELSE}
+procedure TBlockSerial.GetCommState;
+begin
+  SetSynaError(sOK);
+  if not windows.GetCommState(Fhandle, dcb) then
+    SerialCheck(sErr);
+  ExceptCheck;
+end;
+{$ENDIF}
+
+procedure TBlockSerial.SetSizeRecvBuffer(size: integer);
+begin
+{$IFDEF MSWINDOWS}
+  SetupComm(Fhandle, size, 0);
+  GetCommState;
+  dcb.XonLim := size div 4;
+  dcb.XoffLim := size div 4;
+  SetCommState;
+{$ENDIF}
+  FRecvBuffer := size;
+end;
+
+function TBlockSerial.GetDSR: Boolean;
+begin
+  ModemStatus;
+{$IFNDEF MSWINDOWS}
+  Result := (FModemWord and TIOCM_DSR) > 0;
+{$ELSE}
+  Result := (FModemWord and MS_DSR_ON) > 0;
+{$ENDIF}
+end;
+
+procedure TBlockSerial.SetDTRF(Value: Boolean);
+begin
+{$IFNDEF MSWINDOWS}
+  ModemStatus;
+  if Value then
+    FModemWord := FModemWord or TIOCM_DTR
+  else
+    FModemWord := FModemWord and not TIOCM_DTR;
+  {$IFNDEF FPC}
+  ioctl(FHandle, TIOCMSET, @FModemWord);
+  {$ELSE}
+  fpioctl(FHandle, TIOCMSET, @FModemWord);
+  {$ENDIF}
+{$ELSE}
+  if Value then
+    EscapeCommFunction(FHandle, SETDTR)
+  else
+    EscapeCommFunction(FHandle, CLRDTR);
+{$ENDIF}
+end;
+
+function TBlockSerial.GetCTS: Boolean;
+begin
+  ModemStatus;
+{$IFNDEF MSWINDOWS}
+  Result := (FModemWord and TIOCM_CTS) > 0;
+{$ELSE}
+  Result := (FModemWord and MS_CTS_ON) > 0;
+{$ENDIF}
+end;
+
+procedure TBlockSerial.SetRTSF(Value: Boolean);
+begin
+{$IFNDEF MSWINDOWS}
+  ModemStatus;
+  if Value then
+    FModemWord := FModemWord or TIOCM_RTS
+  else
+    FModemWord := FModemWord and not TIOCM_RTS;
+  {$IFNDEF FPC}
+  ioctl(FHandle, TIOCMSET, @FModemWord);
+  {$ELSE}
+  fpioctl(FHandle, TIOCMSET, @FModemWord);
+  {$ENDIF}
+{$ELSE}
+  if Value then
+    EscapeCommFunction(FHandle, SETRTS)
+  else
+    EscapeCommFunction(FHandle, CLRRTS);
+{$ENDIF}
+end;
+
+function TBlockSerial.GetCarrier: Boolean;
+begin
+  ModemStatus;
+{$IFNDEF MSWINDOWS}
+  Result := (FModemWord and TIOCM_CAR) > 0;
+{$ELSE}
+  Result := (FModemWord and MS_RLSD_ON) > 0;
+{$ENDIF}
+end;
+
+function TBlockSerial.GetRing: Boolean;
+begin
+  ModemStatus;
+{$IFNDEF MSWINDOWS}
+  Result := (FModemWord and TIOCM_RNG) > 0;
+{$ELSE}
+  Result := (FModemWord and MS_RING_ON) > 0;
+{$ENDIF}
+end;
+
+{$IFDEF MSWINDOWS}
+function TBlockSerial.CanEvent(Event: dword; Timeout: integer): boolean;
+var
+  ex: DWord;
+  y: Integer;
+  Overlapped: TOverlapped;
+begin
+  FillChar(Overlapped, Sizeof(Overlapped), 0);
+  Overlapped.hEvent := CreateEvent(nil, True, False, nil);
+  try
+    SetCommMask(FHandle, Event);
+    SetSynaError(sOK);
+    if (Event = EV_RXCHAR) and (Waitingdata > 0) then
+      Result := True
+    else
+    begin
+      y := 0;
+      if not WaitCommEvent(FHandle, ex, @Overlapped) then
+        y := GetLastError;
+      if y = ERROR_IO_PENDING then
+      begin
+        //timedout
+        WaitForSingleObject(Overlapped.hEvent, Timeout);
+        SetCommMask(FHandle, 0);
+        GetOverlappedResult(FHandle, Overlapped, DWord(y), True);
+      end;
+      Result := (ex and Event) = Event;
+    end;
+  finally
+    SetCommMask(FHandle, 0);
+    CloseHandle(Overlapped.hEvent);
+  end;
+end;
+{$ENDIF}
+
+{$IFNDEF MSWINDOWS}
+function TBlockSerial.CanRead(Timeout: integer): boolean;
+var
+  FDSet: TFDSet;
+  TimeVal: PTimeVal;
+  TimeV: TTimeVal;
+  x: Integer;
+begin
+  TimeV.tv_usec := (Timeout mod 1000) * 1000;
+  TimeV.tv_sec := Timeout div 1000;
+  TimeVal := @TimeV;
+  if Timeout = -1 then
+    TimeVal := nil;
+  {$IFNDEF FPC}
+  FD_ZERO(FDSet);
+  FD_SET(FHandle, FDSet);
+  x := Select(FHandle + 1, @FDSet, nil, nil, TimeVal);
+  {$ELSE}
+  fpFD_ZERO(FDSet);
+  fpFD_SET(FHandle, FDSet);
+  x := fpSelect(FHandle + 1, @FDSet, nil, nil, TimeVal);
+  {$ENDIF}
+  SerialCheck(x);
+  if FLastError <> sOK then
+    x := 0;
+  Result := x > 0;
+  ExceptCheck;
+  if Result then
+    DoStatus(HR_CanRead, '');
+end;
+{$ELSE}
+function TBlockSerial.CanRead(Timeout: integer): boolean;
+begin
+  Result := WaitingData > 0;
+  if not Result then
+    Result := CanEvent(EV_RXCHAR, Timeout);
+  if Result then
+    DoStatus(HR_CanRead, '');
+end;
+{$ENDIF}
+
+{$IFNDEF MSWINDOWS}
+function TBlockSerial.CanWrite(Timeout: integer): boolean;
+var
+  FDSet: TFDSet;
+  TimeVal: PTimeVal;
+  TimeV: TTimeVal;
+  x: Integer;
+begin
+  TimeV.tv_usec := (Timeout mod 1000) * 1000;
+  TimeV.tv_sec := Timeout div 1000;
+  TimeVal := @TimeV;
+  if Timeout = -1 then
+    TimeVal := nil;
+  {$IFNDEF FPC}
+  FD_ZERO(FDSet);
+  FD_SET(FHandle, FDSet);
+  x := Select(FHandle + 1, nil, @FDSet, nil, TimeVal);
+  {$ELSE}
+  fpFD_ZERO(FDSet);
+  fpFD_SET(FHandle, FDSet);
+  x := fpSelect(FHandle + 1, nil, @FDSet, nil, TimeVal);
+  {$ENDIF}
+  SerialCheck(x);
+  if FLastError <> sOK then
+    x := 0;
+  Result := x > 0;
+  ExceptCheck;
+  if Result then
+    DoStatus(HR_CanWrite, '');
+end;
+{$ELSE}
+function TBlockSerial.CanWrite(Timeout: integer): boolean;
+var
+  t: LongWord;
+begin
+  Result := SendingData = 0;
+  if not Result then
+	  Result := CanEvent(EV_TXEMPTY, Timeout);
+  if Result and (Win32Platform <> VER_PLATFORM_WIN32_NT) then
+  begin
+    t := GetTick;
+    while not ReadTxEmpty(FPortAddr) do
+    begin
+      if TickDelta(t, GetTick) > 255 then
+        Break;
+      Sleep(0);
+    end;
+  end;
+  if Result then
+    DoStatus(HR_CanWrite, '');
+end;
+{$ENDIF}
+
+function TBlockSerial.CanReadEx(Timeout: integer): boolean;
+begin
+	if Fbuffer <> '' then
+  	Result := True
+  else
+  	Result := CanRead(Timeout);
+end;
+
+procedure TBlockSerial.EnableRTSToggle(Value: boolean);
+begin
+  SetSynaError(sOK);
+{$IFNDEF MSWINDOWS}
+  FRTSToggle := Value;
+  if Value then
+    RTS:=False;
+{$ELSE}
+  if Win32Platform = VER_PLATFORM_WIN32_NT then
+  begin
+    GetCommState;
+    if value then
+      dcb.Flags := dcb.Flags or dcb_RtsControlToggle
+    else
+      dcb.flags := dcb.flags and (not dcb_RtsControlToggle);
+    SetCommState;
+  end
+  else
+  begin
+    FRTSToggle := Value;
+    if Value then
+      RTS:=False;
+  end;
+{$ENDIF}
+end;
+
+procedure TBlockSerial.Flush;
+begin
+{$IFNDEF MSWINDOWS}
+  SerialCheck(tcdrain(FHandle));
+{$ELSE}
+  SetSynaError(sOK);
+  if not Flushfilebuffers(FHandle) then
+    SerialCheck(sErr);
+{$ENDIF}
+  ExceptCheck;
+end;
+
+{$IFNDEF MSWINDOWS}
+procedure TBlockSerial.Purge;
+begin
+  {$IFNDEF FPC}
+  SerialCheck(ioctl(FHandle, TCFLSH, TCIOFLUSH));
+  {$ELSE}
+  SerialCheck(fpioctl(FHandle, TCFLSH, TCIOFLUSH));
+  {$ENDIF}
+  FBuffer := '';
+  ExceptCheck;
+end;
+{$ELSE}
+procedure TBlockSerial.Purge;
+var
+  x: integer;
+begin
+  SetSynaError(sOK);
+  x := PURGE_TXABORT or PURGE_TXCLEAR or PURGE_RXABORT or PURGE_RXCLEAR;
+  if not PurgeComm(FHandle, x) then
+    SerialCheck(sErr);
+  FBuffer := '';
+  ExceptCheck;
+end;
+{$ENDIF}
+
+function TBlockSerial.ModemStatus: integer;
+begin
+  Result := 0;
+{$IFNDEF MSWINDOWS}
+  {$IFNDEF FPC}
+  SerialCheck(ioctl(FHandle, TIOCMGET, @Result));
+  {$ELSE}
+  SerialCheck(fpioctl(FHandle, TIOCMGET, @Result));
+  {$ENDIF}
+{$ELSE}
+  SetSynaError(sOK);
+  if not GetCommModemStatus(FHandle, dword(Result)) then
+    SerialCheck(sErr);
+{$ENDIF}
+  ExceptCheck;
+  FModemWord := Result;
+end;
+
+procedure TBlockSerial.SetBreak(Duration: integer);
+begin
+{$IFNDEF MSWINDOWS}
+  SerialCheck(tcsendbreak(FHandle, Duration));
+{$ELSE}
+  SetCommBreak(FHandle);
+  Sleep(Duration);
+  SetSynaError(sOK);
+  if not ClearCommBreak(FHandle) then
+    SerialCheck(sErr);
+{$ENDIF}
+end;
+
+{$IFDEF MSWINDOWS}
+procedure TBlockSerial.DecodeCommError(Error: DWord);
+begin
+  if (Error and DWord(CE_FRAME)) > 1 then
+    FLastError := ErrFrame;
+  if (Error and DWord(CE_OVERRUN)) > 1 then
+    FLastError := ErrOverrun;
+  if (Error and DWord(CE_RXOVER)) > 1 then
+    FLastError := ErrRxOver;
+  if (Error and DWord(CE_RXPARITY)) > 1 then
+    FLastError := ErrRxParity;
+  if (Error and DWord(CE_TXFULL)) > 1 then
+    FLastError := ErrTxFull;
+end;
+{$ENDIF}
+
+//HGJ
+function TBlockSerial.PreTestFailing: Boolean;
+begin
+  if not FInstanceActive then
+  begin
+    RaiseSynaError(ErrPortNotOpen);
+    result:= true;
+    Exit;
+  end;
+  Result := not TestCtrlLine;
+  if result then
+    RaiseSynaError(ErrNoDeviceAnswer)
+end;
+
+function TBlockSerial.TestCtrlLine: Boolean;
+begin
+  result := ((not FTestDSR) or DSR) and ((not FTestCTS) or CTS);
+end;
+
+function TBlockSerial.ATCommand(value: AnsiString): AnsiString;
+var
+  s: AnsiString;
+  ConvSave: Boolean;
+begin
+  result := '';
+  FAtResult := False;
+  ConvSave := FConvertLineEnd;
+  try
+    FConvertLineEnd := True;
+    SendString(value + #$0D);
+    repeat
+      s := RecvString(FAtTimeout);
+      if s <> Value then
+        result := result + s + CRLF;
+      if s = 'OK' then
+      begin
+        FAtResult := True;
+        break;
+      end;
+      if s = 'ERROR' then
+        break;
+    until FLastError <> sOK;
+  finally
+    FConvertLineEnd := Convsave;
+  end;
+end;
+
+
+function TBlockSerial.ATConnect(value: AnsiString): AnsiString;
+var
+  s: AnsiString;
+  ConvSave: Boolean;
+begin
+  result := '';
+  FAtResult := False;
+  ConvSave := FConvertLineEnd;
+  try
+    FConvertLineEnd := True;
+    SendString(value + #$0D);
+    repeat
+      s := RecvString(90 * FAtTimeout);
+      if s <> Value then
+        result := result + s + CRLF;
+      if s = 'NO CARRIER' then
+        break;
+      if s = 'ERROR' then
+        break;
+      if s = 'BUSY' then
+        break;
+      if s = 'NO DIALTONE' then
+        break;
+      if Pos('CONNECT', s) = 1 then
+      begin
+        FAtResult := True;
+        break;
+      end;
+    until FLastError <> sOK;
+  finally
+    FConvertLineEnd := Convsave;
+  end;
+end;
+
+function TBlockSerial.SerialCheck(SerialResult: integer): integer;
+begin
+  if SerialResult = integer(INVALID_HANDLE_VALUE) then
+{$IFDEF MSWINDOWS}
+    result := GetLastError
+{$ELSE}
+  {$IFNDEF FPC}
+    result := GetLastError
+  {$ELSE}
+    result := fpGetErrno
+  {$ENDIF}
+{$ENDIF}
+  else
+    result := sOK;
+  FLastError := result;
+  FLastErrorDesc := GetErrorDesc(FLastError);
+end;
+
+procedure TBlockSerial.ExceptCheck;
+var
+  e: ESynaSerError;
+  s: string;
+begin
+  if FRaiseExcept and (FLastError <> sOK) then
+  begin
+    s := GetErrorDesc(FLastError);
+    e := ESynaSerError.CreateFmt('Communication error %d: %s', [FLastError, s]);
+    e.ErrorCode := FLastError;
+    e.ErrorMessage := s;
+    raise e;
+  end;
+end;
+
+procedure TBlockSerial.SetSynaError(ErrNumber: integer);
+begin
+  FLastError := ErrNumber;
+  FLastErrorDesc := GetErrorDesc(FLastError);
+end;
+
+procedure TBlockSerial.RaiseSynaError(ErrNumber: integer);
+begin
+  SetSynaError(ErrNumber);
+  ExceptCheck;
+end;
+
+procedure TBlockSerial.DoStatus(Reason: THookSerialReason; const Value: string);
+begin
+  if assigned(OnStatus) then
+    OnStatus(Self, Reason, Value);
+end;
+
+{======================================================================}
+
+class function TBlockSerial.GetErrorDesc(ErrorCode: integer): string;
+begin
+  Result:= '';
+  case ErrorCode of
+    sOK:               Result := 'OK';
+    ErrAlreadyOwned:   Result := 'Port owned by other process';{HGJ}
+    ErrAlreadyInUse:   Result := 'Instance already in use';    {HGJ}
+    ErrWrongParameter: Result := 'Wrong paramter at call';     {HGJ}
+    ErrPortNotOpen:    Result := 'Instance not yet connected'; {HGJ}
+    ErrNoDeviceAnswer: Result := 'No device answer detected';  {HGJ}
+    ErrMaxBuffer:      Result := 'Maximal buffer length exceeded';
+    ErrTimeout:        Result := 'Timeout during operation';
+    ErrNotRead:        Result := 'Reading of data failed';
+    ErrFrame:          Result := 'Receive framing error';
+    ErrOverrun:        Result := 'Receive Overrun Error';
+    ErrRxOver:         Result := 'Receive Queue overflow';
+    ErrRxParity:       Result := 'Receive Parity Error';
+    ErrTxFull:         Result := 'Tranceive Queue is full';
+  end;
+  if Result = '' then
+  begin
+    Result := SysErrorMessage(ErrorCode);
+  end;
+end;
+
+
+{---------- cpom Comport Ownership Manager Routines -------------
+ by Hans-Georg Joepgen of Stuttgart, Germany.
+ Copyright (c) 2002, by Hans-Georg Joepgen
+
+  Stefan Krauss of Stuttgart, Germany, contributed literature and Internet
+  research results, invaluable advice and excellent answers to the Comport
+  Ownership Manager.
+}
+
+{$IFDEF LINUX}
+
+function TBlockSerial.LockfileName: String;
+var
+  s: string;
+begin
+  s := SeparateRight(FDevice, '/dev/');
+  result := LockfileDirectory + '/LCK..' + s;
+end;
+
+procedure TBlockSerial.CreateLockfile(PidNr: integer);
+var
+  f: TextFile;
+  s: string;
+begin
+  // Create content for file
+  s := IntToStr(PidNr);
+  while length(s) < 10 do
+    s := ' ' + s;
+  // Create file
+  try
+    AssignFile(f, LockfileName);
+    try
+      Rewrite(f);
+      writeln(f, s);
+    finally
+      CloseFile(f);
+    end;
+    // Allow all users to enjoy the benefits of cpom
+    s := 'chmod a+rw ' + LockfileName;
+{$IFNDEF FPC}
+    FileSetReadOnly( LockfileName, False ) ;
+ // Libc.system(pchar(s));
+{$ELSE}
+    fpSystem(s);
+{$ENDIF}
+  except
+    // not raise exception, if you not have write permission for lock.
+    on Exception do
+      ;
+  end;
+end;
+
+function TBlockSerial.ReadLockfile: integer;
+{Returns PID from Lockfile. Lockfile must exist.}
+var
+  f: TextFile;
+  s: string;
+begin
+  AssignFile(f, LockfileName);
+  Reset(f);
+  try
+    readln(f, s);
+  finally
+    CloseFile(f);
+  end;
+  Result := StrToIntDef(s, -1)
+end;
+
+function TBlockSerial.cpomComportAccessible: boolean;
+var
+  MyPid: integer;
+  Filename: string;
+begin
+  Filename := LockfileName;
+  {$IFNDEF FPC}
+  MyPid := Libc.getpid;
+  {$ELSE}
+  MyPid := fpGetPid;
+  {$ENDIF}
+  // Make sure, the Lock Files Directory exists. We need it.
+  if not DirectoryExists(LockfileDirectory) then
+    CreateDir(LockfileDirectory);
+  // Check the Lockfile
+  if not FileExists (Filename) then
+  begin // comport is not locked. Lock it for us.
+    CreateLockfile(MyPid);
+    result := true;
+    exit;  // done.
+  end;
+  // Is port owned by orphan? Then it's time for error recovery.
+  //FPC forgot to add getsid.. :-(
+  {$IFNDEF FPC}
+  if Libc.getsid(ReadLockfile) = -1 then
+  begin //  Lockfile was left from former desaster
+    DeleteFile(Filename); // error recovery
+    CreateLockfile(MyPid);
+    result := true;
+    exit;
+  end;
+  {$ENDIF}
+  result := false // Sorry, port is owned by living PID and locked
+end;
+
+procedure TBlockSerial.cpomReleaseComport;
+begin
+  DeleteFile(LockfileName);
+end;
+
+{$ENDIF}
+{----------------------------------------------------------------}
+
+{$IFDEF MSWINDOWS}
+function GetSerialPortNames: string;
+var
+  reg: TRegistry;
+  l, v: TStringList;
+  n: integer;
+begin
+  l := TStringList.Create;
+  v := TStringList.Create;
+  reg := TRegistry.Create;
+  try
+{$IFNDEF VER100}
+{$IFNDEF VER120}
+    reg.Access := KEY_READ;
+{$ENDIF}
+{$ENDIF}
+    reg.RootKey := HKEY_LOCAL_MACHINE;
+    reg.OpenKey('\HARDWARE\DEVICEMAP\SERIALCOMM', false);
+    reg.GetValueNames(l);
+    for n := 0 to l.Count - 1 do
+      v.Add(reg.ReadString(l[n]));
+    Result := v.CommaText;
+  finally
+    reg.Free;
+    l.Free;
+    v.Free;
+  end;
+end;
+{$ENDIF}
+{$IFNDEF MSWINDOWS}
+function GetSerialPortNames: string;
+var
+  Index: Integer;
+  Data: string;
+  TmpPorts: String;
+  sr : TSearchRec;
+begin
+  try
+    TmpPorts := '';
+    if FindFirst('/dev/ttyS*', $FFFFFFFF, sr) = 0 then
+    begin
+      repeat
+        if (sr.Attr and $FFFFFFFF) = Sr.Attr then
+        begin
+          data := sr.Name;
+          index := length(data);
+          while (index > 1) and (data[index] <> '/') do
+            index := index - 1;
+          TmpPorts := TmpPorts + ' ' + copy(data, 1, index + 1);
+        end;
+      until FindNext(sr) <> 0;
+    end;
+    FindClose(sr);
+  finally
+    Result:=TmpPorts;
+  end;
+end;
+{$ENDIF}
+
+end.
diff --git a/Units/Synapse/synautil.pas b/Units/Synapse/synautil.pas
index db7f483..38abec1 100644
--- a/Units/Synapse/synautil.pas
+++ b/Units/Synapse/synautil.pas
@@ -1,1820 +1,1820 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 004.014.000 |
-|==============================================================================|
-| Content: support procedures and functions                                    |
-|==============================================================================|
-| Copyright (c)1999-2010, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c) 1999-2010.               |
-| Portions created by Hernan Sanchez are Copyright (c) 2000.                   |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|   Hernan Sanchez (hernan.sanchez@iname.com)                                  |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{:@abstract(Support procedures and functions)}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$Q-}
-{$R-}
-{$H+}
-
-//old Delphi does not have MSWINDOWS define.
-{$IFDEF WIN32}
-  {$IFNDEF MSWINDOWS}
-    {$DEFINE MSWINDOWS}
-  {$ENDIF}
-{$ENDIF}
-
-{$IFDEF UNICODE}
-  {$WARN IMPLICIT_STRING_CAST OFF}
-  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
-  {$WARN SUSPICIOUS_TYPECAST OFF}
-{$ENDIF}
-
-unit synautil;
-
-interface
-
-uses
-{$IFDEF MSWINDOWS}
-  Windows,
-{$ELSE}
-  {$IFDEF FPC}
-    UnixUtil, Unix, BaseUnix,
-  {$ELSE}
-    Libc,
-  {$ENDIF}
-{$ENDIF}
-{$IFDEF CIL}
-  System.IO,
-{$ENDIF}
-  SysUtils, Classes, SynaFpc;
-
-{$IFDEF VER100}
-type
-  int64 = integer;
-{$ENDIF}
-
-{:Return your timezone bias from UTC time in minutes.}
-function TimeZoneBias: integer;
-
-{:Return your timezone bias from UTC time in string representation like "+0200".}
-function TimeZone: string;
-
-{:Returns current time in format defined in RFC-822. Useful for SMTP messages,
- but other protocols use this time format as well. Results contains the timezone
- specification. Four digit year is used to break any Y2K concerns. (Example
- 'Fri, 15 Oct 1999 21:14:56 +0200')}
-function Rfc822DateTime(t: TDateTime): string;
-
-{:Returns date and time in format defined in C compilers in format "mmm dd hh:nn:ss"}
-function CDateTime(t: TDateTime): string;
-
-{:Returns date and time in format defined in format 'yymmdd hhnnss'}
-function SimpleDateTime(t: TDateTime): string;
-
-{:Returns date and time in format defined in ANSI C compilers in format
- "ddd mmm d hh:nn:ss yyyy" }
-function AnsiCDateTime(t: TDateTime): string;
-
-{:Decode three-letter string with name of month to their month number. If string
- not match any month name, then is returned 0. For parsing are used predefined
- names for English, French and German and names from system locale too.}
-function GetMonthNumber(Value: String): integer;
-
-{:Return decoded time from given string. Time must be witch separator ':'. You
- can use "hh:mm" or "hh:mm:ss".}
-function GetTimeFromStr(Value: string): TDateTime;
-
-{:Decode string in format "m-d-y" to TDateTime type.}
-function GetDateMDYFromStr(Value: string): TDateTime;
-
-{:Decode various string representations of date and time to Tdatetime type.
- This function do all timezone corrections too! This function can decode lot of
-  formats like:
- @longcode(#
- ddd, d mmm yyyy hh:mm:ss
- ddd, d mmm yy hh:mm:ss
- ddd, mmm d yyyy hh:mm:ss
- ddd mmm dd hh:mm:ss yyyy #)
-
-and more with lot of modifications, include:
-@longcode(#
-Sun, 06 Nov 1994 08:49:37 GMT    ; RFC 822, updated by RFC 1123
-Sunday, 06-Nov-94 08:49:37 GMT   ; RFC 850, obsoleted by RFC 1036
-Sun Nov  6 08:49:37 1994         ; ANSI C's asctime() Format
-#)
-Timezone corrections known lot of symbolic timezone names (like CEST, EDT, etc.)
-or numeric representation (like +0200). By convention defined in RFC timezone
- +0000 is GMT and -0000 is current your system timezone.}
-function DecodeRfcDateTime(Value: string): TDateTime;
-
-{:Return current system date and time in UTC timezone.}
-function GetUTTime: TDateTime;
-
-{:Set Newdt as current system date and time in UTC timezone. This function work
- only if you have administrator rights!}
-function SetUTTime(Newdt: TDateTime): Boolean;
-
-{:Return current value of system timer with precizion 1 millisecond. Good for
- measure time difference.}
-function GetTick: LongWord;
-
-{:Return difference between two timestamps. It working fine only for differences
- smaller then maxint. (difference must be smaller then 24 days.)}
-function TickDelta(TickOld, TickNew: LongWord): LongWord;
-
-{:Return two characters, which ordinal values represents the value in byte
- format. (High-endian)}
-function CodeInt(Value: Word): Ansistring;
-
-{:Decodes two characters located at "Index" offset position of the "Value"
- string to Word values.}
-function DecodeInt(const Value: Ansistring; Index: Integer): Word;
-
-{:Return four characters, which ordinal values represents the value in byte
- format. (High-endian)}
-function CodeLongInt(Value: LongInt): Ansistring;
-
-{:Decodes four characters located at "Index" offset position of the "Value"
- string to LongInt values.}
-function DecodeLongInt(const Value: Ansistring; Index: Integer): LongInt;
-
-{:Dump binary buffer stored in a string to a result string.}
-function DumpStr(const Buffer: Ansistring): string;
-
-{:Dump binary buffer stored in a string to a result string. All bytes with code
- of character is written as character, not as hexadecimal value.}
-function DumpExStr(const Buffer: Ansistring): string;
-
-{:Dump binary buffer stored in a string to a file with DumpFile filename.}
-procedure Dump(const Buffer: AnsiString; DumpFile: string);
-
-{:Dump binary buffer stored in a string to a file with DumpFile filename. All
- bytes with code of character is written as character, not as hexadecimal value.}
-procedure DumpEx(const Buffer: AnsiString; DumpFile: string);
-
-{:Like TrimLeft, but remove only spaces, not control characters!}
-function TrimSPLeft(const S: string): string;
-
-{:Like TrimRight, but remove only spaces, not control characters!}
-function TrimSPRight(const S: string): string;
-
-{:Like Trim, but remove only spaces, not control characters!}
-function TrimSP(const S: string): string;
-
-{:Returns a portion of the "Value" string located to the left of the "Delimiter"
- string. If a delimiter is not found, results is original string.}
-function SeparateLeft(const Value, Delimiter: string): string;
-
-{:Returns the portion of the "Value" string located to the right of the
- "Delimiter" string. If a delimiter is not found, results is original string.}
-function SeparateRight(const Value, Delimiter: string): string;
-
-{:Returns parameter value from string in format:
- parameter1="value1"; parameter2=value2}
-function GetParameter(const Value, Parameter: string): string;
-
-{:parse value string with elements differed by Delimiter into stringlist.}
-procedure ParseParametersEx(Value, Delimiter: string; const Parameters: TStrings);
-
-{:parse value string with elements differed by ';' into stringlist.}
-procedure ParseParameters(Value: string; const Parameters: TStrings);
-
-{:Index of string in stringlist with same beginning as Value is returned.}
-function IndexByBegin(Value: string; const List: TStrings): integer;
-
-{:Returns only the e-mail portion of an address from the full address format.
- i.e. returns 'nobody@@somewhere.com' from '"someone" <nobody@@somewhere.com>'}
-function GetEmailAddr(const Value: string): string;
-
-{:Returns only the description part from a full address format. i.e. returns
- 'someone' from '"someone" <nobody@@somewhere.com>'}
-function GetEmailDesc(Value: string): string;
-
-{:Returns a string with hexadecimal digits representing the corresponding values
- of the bytes found in "Value" string.}
-function StrToHex(const Value: Ansistring): string;
-
-{:Returns a string of binary "Digits" representing "Value".}
-function IntToBin(Value: Integer; Digits: Byte): string;
-
-{:Returns an integer equivalent of the binary string in "Value".
- (i.e. ('10001010') returns 138)}
-function BinToInt(const Value: string): Integer;
-
-{:Parses a URL to its various components.}
-function ParseURL(URL: string; var Prot, User, Pass, Host, Port, Path,
-  Para: string): string;
-
-{:Replaces all "Search" string values found within "Value" string, with the
- "Replace" string value.}
-function ReplaceString(Value, Search, Replace: AnsiString): AnsiString;
-
-{:It is like RPos, but search is from specified possition.}
-function RPosEx(const Sub, Value: string; From: integer): Integer;
-
-{:It is like POS function, but from right side of Value string.}
-function RPos(const Sub, Value: String): Integer;
-
-{:Like @link(fetch), but working with binary strings, not with text.}
-function FetchBin(var Value: string; const Delimiter: string): string;
-
-{:Fetch string from left of Value string.}
-function Fetch(var Value: string; const Delimiter: string): string;
-
-{:Fetch string from left of Value string. This function ignore delimitesr inside
- quotations.}
-function FetchEx(var Value: string; const Delimiter, Quotation: string): string;
-
-{:If string is binary string (contains non-printable characters), then is
- returned true.}
-function IsBinaryString(const Value: AnsiString): Boolean;
-
-{:return position of string terminator in string. If terminator found, then is
- returned in terminator parameter.
- Possible line terminators are: CRLF, LFCR, CR, LF}
-function PosCRLF(const Value: AnsiString; var Terminator: AnsiString): integer;
-
-{:Delete empty strings from end of stringlist.}
-Procedure StringsTrim(const value: TStrings);
-
-{:Like Pos function, buf from given string possition.}
-function PosFrom(const SubStr, Value: String; From: integer): integer;
-
-{$IFNDEF CIL}
-{:Increase pointer by value.}
-function IncPoint(const p: pointer; Value: integer): pointer;
-{$ENDIF}
-
-{:Get string between PairBegin and PairEnd. This function respect nesting.
- For example:
- @longcode(#
- Value is: 'Hi! (hello(yes!))'
- pairbegin is: '('
- pairend is: ')'
- In this case result is: 'hello(yes!)'#)}
-function GetBetween(const PairBegin, PairEnd, Value: string): string;
-
-{:Return count of Chr in Value string.}
-function CountOfChar(const Value: string; Chr: char): integer;
-
-{:Remove quotation from Value string. If Value is not quoted, then return same
- string without any modification. }
-function UnquoteStr(const Value: string; Quote: Char): string;
-
-{:Quote Value string. If Value contains some Quote chars, then it is doubled.}
-function QuoteStr(const Value: string; Quote: Char): string;
-
-{:Convert lines in stringlist from 'name: value' form to 'name=value' form.}
-procedure HeadersToList(const Value: TStrings);
-
-{:Convert lines in stringlist from 'name=value' form to 'name: value' form.}
-procedure ListToHeaders(const Value: TStrings);
-
-{:swap bytes in integer.}
-function SwapBytes(Value: integer): integer;
-
-{:read string with requested length form stream.}
-function ReadStrFromStream(const Stream: TStream; len: integer): AnsiString;
-
-{:write string to stream.}
-procedure WriteStrToStream(const Stream: TStream; Value: AnsiString);
-
-{:Return filename of new temporary file in Dir (if empty, then default temporary
- directory is used) and with optional filename prefix.}
-function GetTempFile(const Dir, prefix: AnsiString): AnsiString;
-
-{:Return padded string. If length is greater, string is truncated. If length is
- smaller, string is padded by Pad character.}
-function PadString(const Value: AnsiString; len: integer; Pad: AnsiChar): AnsiString;
-
-{:Read header from "Value" stringlist beginning at "Index" position. If header
- is Splitted into multiple lines, then this procedure de-split it into one line.}
-function NormalizeHeader(Value: TStrings; var Index: Integer): string;
-
-var
-  {:can be used for your own months strings for @link(getmonthnumber)}
-  CustomMonthNames: array[1..12] of string;
-
-implementation
-
-{==============================================================================}
-
-const
-  MyDayNames: array[1..7] of AnsiString =
-    ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
-var
-  MyMonthNames: array[0..6, 1..12] of String =
-    (
-    ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',  //rewrited by system locales
-     'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'),
-    ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',  //English
-     'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'),
-    ('jan', 'fév', 'mar', 'avr', 'mai', 'jun', //French
-     'jul', 'aoû', 'sep', 'oct', 'nov', 'déc'),
-    ('jan', 'fev', 'mar', 'avr', 'mai', 'jun',  //French#2
-     'jul', 'aou', 'sep', 'oct', 'nov', 'dec'),
-    ('Jan', 'Feb', 'Mar', 'Apr', 'Mai', 'Jun',  //German
-     'Jul', 'Aug', 'Sep', 'Okt', 'Nov', 'Dez'),
-    ('Jan', 'Feb', 'Mär', 'Apr', 'Mai', 'Jun',  //German#2
-     'Jul', 'Aug', 'Sep', 'Okt', 'Nov', 'Dez'),
-    ('Led', 'Úno', 'Bøe', 'Dub', 'Kvì', 'Èen',  //Czech
-     'Èec', 'Srp', 'Záø', 'Øíj', 'Lis', 'Pro')
-     );
-
-
-{==============================================================================}
-
-function TimeZoneBias: integer;
-{$IFNDEF MSWINDOWS}
-{$IFNDEF FPC}
-var
-  t: TTime_T;
-  UT: TUnixTime;
-begin
-  __time(@T);
-  localtime_r(@T, UT);
-  Result := ut.__tm_gmtoff div 60;
-{$ELSE}
-begin
-  Result := TZSeconds div 60;
-{$ENDIF}
-{$ELSE}
-var
-  zoneinfo: TTimeZoneInformation;
-  bias: Integer;
-begin
-  case GetTimeZoneInformation(Zoneinfo) of
-    2:
-      bias := zoneinfo.Bias + zoneinfo.DaylightBias;
-    1:
-      bias := zoneinfo.Bias + zoneinfo.StandardBias;
-  else
-    bias := zoneinfo.Bias;
-  end;
-  Result := bias * (-1);
-{$ENDIF}
-end;
-
-{==============================================================================}
-
-function TimeZone: string;
-var
-  bias: Integer;
-  h, m: Integer;
-begin
-  bias := TimeZoneBias;
-  if bias >= 0 then
-    Result := '+'
-  else
-    Result := '-';
-  bias := Abs(bias);
-  h := bias div 60;
-  m := bias mod 60;
-  Result := Result + Format('%.2d%.2d', [h, m]);
-end;
-
-{==============================================================================}
-
-function Rfc822DateTime(t: TDateTime): string;
-var
-  wYear, wMonth, wDay: word;
-begin
-  DecodeDate(t, wYear, wMonth, wDay);
-  Result := Format('%s, %d %s %s %s', [MyDayNames[DayOfWeek(t)], wDay,
-    MyMonthNames[1, wMonth], FormatDateTime('yyyy hh":"nn":"ss', t), TimeZone]);
-end;
-
-{==============================================================================}
-
-function CDateTime(t: TDateTime): string;
-var
-  wYear, wMonth, wDay: word;
-begin
-  DecodeDate(t, wYear, wMonth, wDay);
-  Result:= Format('%s %2d %s', [MyMonthNames[1, wMonth], wDay,
-    FormatDateTime('hh":"nn":"ss', t)]);
-end;
-
-{==============================================================================}
-
-function SimpleDateTime(t: TDateTime): string;
-begin
-  Result := FormatDateTime('yymmdd hhnnss', t);
-end;
-
-{==============================================================================}
-
-function AnsiCDateTime(t: TDateTime): string;
-var
-  wYear, wMonth, wDay: word;
-begin
-  DecodeDate(t, wYear, wMonth, wDay);
-  Result := Format('%s %s %d %s', [MyDayNames[DayOfWeek(t)], MyMonthNames[1, wMonth],
-    wDay, FormatDateTime('hh":"nn":"ss yyyy ', t)]);
-end;
-
-{==============================================================================}
-
-function DecodeTimeZone(Value: string; var Zone: integer): Boolean;
-var
-  x: integer;
-  zh, zm: integer;
-  s: string;
-begin
-  Result := false;
-  s := Value;
-  if (Pos('+', s) = 1) or (Pos('-',s) = 1) then
-  begin
-    if s = '-0000' then
-      Zone := TimeZoneBias
-    else
-      if Length(s) > 4 then
-      begin
-        zh := StrToIntdef(s[2] + s[3], 0);
-        zm := StrToIntdef(s[4] + s[5], 0);
-        zone := zh * 60 + zm;
-        if s[1] = '-' then
-          zone := zone * (-1);
-      end;
-    Result := True;
-  end
-  else
-  begin
-    x := 32767;
-    if s = 'NZDT' then x := 13;
-    if s = 'IDLE' then x := 12;
-    if s = 'NZST' then x := 12;
-    if s = 'NZT' then x := 12;
-    if s = 'EADT' then x := 11;
-    if s = 'GST' then x := 10;
-    if s = 'JST' then x := 9;
-    if s = 'CCT' then x := 8;
-    if s = 'WADT' then x := 8;
-    if s = 'WAST' then x := 7;
-    if s = 'ZP6' then x := 6;
-    if s = 'ZP5' then x := 5;
-    if s = 'ZP4' then x := 4;
-    if s = 'BT' then x := 3;
-    if s = 'EET' then x := 2;
-    if s = 'MEST' then x := 2;
-    if s = 'MESZ' then x := 2;
-    if s = 'SST' then x := 2;
-    if s = 'FST' then x := 2;
-    if s = 'CEST' then x := 2;
-    if s = 'CET' then x := 1;
-    if s = 'FWT' then x := 1;
-    if s = 'MET' then x := 1;
-    if s = 'MEWT' then x := 1;
-    if s = 'SWT' then x := 1;
-    if s = 'UT' then x := 0;
-    if s = 'UTC' then x := 0;
-    if s = 'GMT' then x := 0;
-    if s = 'WET' then x := 0;
-    if s = 'WAT' then x := -1;
-    if s = 'BST' then x := -1;
-    if s = 'AT' then x := -2;
-    if s = 'ADT' then x := -3;
-    if s = 'AST' then x := -4;
-    if s = 'EDT' then x := -4;
-    if s = 'EST' then x := -5;
-    if s = 'CDT' then x := -5;
-    if s = 'CST' then x := -6;
-    if s = 'MDT' then x := -6;
-    if s = 'MST' then x := -7;
-    if s = 'PDT' then x := -7;
-    if s = 'PST' then x := -8;
-    if s = 'YDT' then x := -8;
-    if s = 'YST' then x := -9;
-    if s = 'HDT' then x := -9;
-    if s = 'AHST' then x := -10;
-    if s = 'CAT' then x := -10;
-    if s = 'HST' then x := -10;
-    if s = 'EAST' then x := -10;
-    if s = 'NT' then x := -11;
-    if s = 'IDLW' then x := -12;
-    if x <> 32767 then
-    begin
-      zone := x * 60;
-      Result := True;
-    end;
-  end;
-end;
-
-{==============================================================================}
-
-function GetMonthNumber(Value: String): integer;
-var
-  n: integer;
-  function TestMonth(Value: String; Index: Integer): Boolean;
-  var
-    n: integer;
-  begin
-    Result := False;
-    for n := 0 to 6 do
-      if Value = AnsiUppercase(MyMonthNames[n, Index]) then
-      begin
-        Result := True;
-        Break;
-      end;
-  end;
-begin
-  Result := 0;
-  Value := AnsiUppercase(Value);
-  for n := 1 to 12 do
-    if TestMonth(Value, n) or (Value = AnsiUppercase(CustomMonthNames[n])) then
-    begin
-      Result := n;
-      Break;
-    end;
-end;
-
-{==============================================================================}
-
-function GetTimeFromStr(Value: string): TDateTime;
-var
-  x: integer;
-begin
-  x := rpos(':', Value);
-  if (x > 0) and ((Length(Value) - x) > 2) then
-    Value := Copy(Value, 1, x + 2);
-  Value := ReplaceString(Value, ':', TimeSeparator);
-  Result := -1;
-  try
-    Result := StrToTime(Value);
-  except
-    on Exception do ;
-  end;
-end;
-
-{==============================================================================}
-
-function GetDateMDYFromStr(Value: string): TDateTime;
-var
-  wYear, wMonth, wDay: word;
-  s: string;
-begin
-  Result := 0;
-  s := Fetch(Value, '-');
-  wMonth := StrToIntDef(s, 12);
-  s := Fetch(Value, '-');
-  wDay := StrToIntDef(s, 30);
-  wYear := StrToIntDef(Value, 1899);
-  if wYear < 1000 then
-    if (wYear > 99) then
-      wYear := wYear + 1900
-    else
-      if wYear > 50 then
-        wYear := wYear + 1900
-      else
-        wYear := wYear + 2000;
-  try
-    Result := EncodeDate(wYear, wMonth, wDay);
-  except
-    on Exception do ;
-  end;
-end;
-
-{==============================================================================}
-
-function DecodeRfcDateTime(Value: string): TDateTime;
-var
-  day, month, year: Word;
-  zone: integer;
-  x, y: integer;
-  s: string;
-  t: TDateTime;
-begin
-// ddd, d mmm yyyy hh:mm:ss
-// ddd, d mmm yy hh:mm:ss
-// ddd, mmm d yyyy hh:mm:ss
-// ddd mmm dd hh:mm:ss yyyy
-// Sun, 06 Nov 1994 08:49:37 GMT    ; RFC 822, updated by RFC 1123
-// Sunday, 06-Nov-94 08:49:37 GMT   ; RFC 850, obsoleted by RFC 1036
-// Sun Nov  6 08:49:37 1994         ; ANSI C's asctime() Format
-
-  Result := 0;
-  if Value = '' then
-    Exit;
-  day := 0;
-  month := 0;
-  year := 0;
-  zone := 0;
-  Value := ReplaceString(Value, ' -', ' #');
-  Value := ReplaceString(Value, '-', ' ');
-  Value := ReplaceString(Value, ' #', ' -');
-  while Value <> '' do
-  begin
-    s := Fetch(Value, ' ');
-    s := uppercase(s);
-    // timezone
-    if DecodetimeZone(s, x) then
-    begin
-      zone := x;
-      continue;
-    end;
-    x := StrToIntDef(s, 0);
-    // day or year
-    if x > 0 then
-      if (x < 32) and (day = 0) then
-      begin
-        day := x;
-        continue;
-      end
-      else
-      begin
-        if (year = 0) and ((month > 0) or (x > 12)) then
-        begin
-          year := x;
-          if year < 32 then
-            year := year + 2000;
-          if year < 1000 then
-           year := year + 1900;
-          continue;
-        end;
-      end;
-    // time
-    if rpos(':', s) > Pos(':', s) then
-    begin
-      t := GetTimeFromStr(s);
-      if t <> -1 then
-        Result := t;
-      continue;
-    end;
-    //timezone daylight saving time
-    if s = 'DST' then
-    begin
-      zone := zone + 60;
-      continue;
-    end;
-    // month
-    y := GetMonthNumber(s);
-    if (y > 0) and (month = 0) then
-      month := y;
-  end;
-  if year = 0 then
-    year := 1980;
-  if month < 1 then
-    month := 1;
-  if month > 12 then
-    month := 12;
-  if day < 1 then
-    day := 1;
-  x := MonthDays[IsLeapYear(year), month];
-  if day > x then
-    day := x;
-  Result := Result + Encodedate(year, month, day);
-  zone := zone - TimeZoneBias;
-  x := zone div 1440;
-  Result := Result - x;
-  zone := zone mod 1440;
-  t := EncodeTime(Abs(zone) div 60, Abs(zone) mod 60, 0, 0);
-  if zone < 0 then
-    t := 0 - t;
-  Result := Result - t;
-end;
-
-{==============================================================================}
-
-function GetUTTime: TDateTime;
-{$IFDEF MSWINDOWS}
-{$IFNDEF FPC}
-var
-  st: TSystemTime;
-begin
-  GetSystemTime(st);
-  result := SystemTimeToDateTime(st);
-{$ELSE}
-var
-  st: SysUtils.TSystemTime;
-  stw: Windows.TSystemTime;
-begin
-  GetSystemTime(stw);
-  st.Year := stw.wYear;
-  st.Month := stw.wMonth;
-  st.Day := stw.wDay;
-  st.Hour := stw.wHour;
-  st.Minute := stw.wMinute;
-  st.Second := stw.wSecond;
-  st.Millisecond := stw.wMilliseconds;
-  result := SystemTimeToDateTime(st);
-{$ENDIF}
-{$ELSE}
-{$IFNDEF FPC}
-var
-  TV: TTimeVal;
-begin
-  gettimeofday(TV, nil);
-  Result := UnixDateDelta + (TV.tv_sec + TV.tv_usec / 1000000) / 86400;
-{$ELSE}
-var
-  TV: TimeVal;
-begin
-  fpgettimeofday(@TV, nil);
-  Result := UnixDateDelta + (TV.tv_sec + TV.tv_usec / 1000000) / 86400;
-{$ENDIF}
-{$ENDIF}
-end;
-
-{==============================================================================}
-
-function SetUTTime(Newdt: TDateTime): Boolean;
-{$IFDEF MSWINDOWS}
-{$IFNDEF FPC}
-var
-  st: TSystemTime;
-begin
-  DateTimeToSystemTime(newdt,st);
-  Result := SetSystemTime(st);
-{$ELSE}
-var
-  st: SysUtils.TSystemTime;
-  stw: Windows.TSystemTime;
-begin
-  DateTimeToSystemTime(newdt,st);
-  stw.wYear := st.Year;
-  stw.wMonth := st.Month;
-  stw.wDay := st.Day;
-  stw.wHour := st.Hour;
-  stw.wMinute := st.Minute;
-  stw.wSecond := st.Second;
-  stw.wMilliseconds := st.Millisecond;
-  Result := SetSystemTime(stw);
-{$ENDIF}
-{$ELSE}
-{$IFNDEF FPC}
-var
-  TV: TTimeVal;
-  d: double;
-  TZ: Ttimezone;
-  PZ: PTimeZone;
-begin
-  TZ.tz_minuteswest := 0;
-  TZ.tz_dsttime := 0;
-  PZ := @TZ;
-  gettimeofday(TV, PZ);
-  d := (newdt - UnixDateDelta) * 86400;
-  TV.tv_sec := trunc(d);
-  TV.tv_usec := trunc(frac(d) * 1000000);
-  Result := settimeofday(TV, TZ) <> -1;
-{$ELSE}
-var
-  TV: TimeVal;
-  d: double;
-begin
-  d := (newdt - UnixDateDelta) * 86400;
-  TV.tv_sec := trunc(d);
-  TV.tv_usec := trunc(frac(d) * 1000000);
-  Result := fpsettimeofday(@TV, nil) <> -1;
-{$ENDIF}
-{$ENDIF}
-end;
-
-{==============================================================================}
-
-{$IFNDEF MSWINDOWS}
-function GetTick: LongWord;
-var
-  Stamp: TTimeStamp;
-begin
-  Stamp := DateTimeToTimeStamp(Now);
-  Result := Stamp.Time;
-end;
-{$ELSE}
-function GetTick: LongWord;
-var
-  tick, freq: TLargeInteger;
-{$IFDEF VER100}
-  x: TLargeInteger;
-{$ENDIF}
-begin
-  if Windows.QueryPerformanceFrequency(freq) then
-  begin
-    Windows.QueryPerformanceCounter(tick);
-{$IFDEF VER100}
-    x.QuadPart := (tick.QuadPart / freq.QuadPart) * 1000;
-    Result := x.LowPart;
-{$ELSE}
-    Result := Trunc((tick / freq) * 1000) and High(LongWord)
-{$ENDIF}
-  end
-  else
-    Result := Windows.GetTickCount;
-end;
-{$ENDIF}
-
-{==============================================================================}
-
-function TickDelta(TickOld, TickNew: LongWord): LongWord;
-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 + LongWord(MaxInt) + 1;
-      TickOld := TickOld + LongWord(MaxInt) + 1;
-    end;
-    Result := TickNew - TickOld;
-    if TickNew < TickOld then
-      if Result > 0 then
-        Result := 0 - Result;
-  end;
-end;
-
-{==============================================================================}
-
-function CodeInt(Value: Word): Ansistring;
-begin
-  setlength(result, 2);
-  result[1] := AnsiChar(Value div 256);
-  result[2] := AnsiChar(Value mod 256);
-//  Result := AnsiChar(Value div 256) + AnsiChar(Value mod 256)
-end;
-
-{==============================================================================}
-
-function DecodeInt(const Value: Ansistring; Index: Integer): Word;
-var
-  x, y: Byte;
-begin
-  if Length(Value) > Index then
-    x := Ord(Value[Index])
-  else
-    x := 0;
-  if Length(Value) >= (Index + 1) then
-    y := Ord(Value[Index + 1])
-  else
-    y := 0;
-  Result := x * 256 + y;
-end;
-
-{==============================================================================}
-
-function CodeLongInt(Value: Longint): Ansistring;
-var
-  x, y: word;
-begin
-  // this is fix for negative numbers on systems where longint = integer
-  x := (Value shr 16) and integer($ffff);
-  y := Value and integer($ffff);
-  setlength(result, 4);
-  result[1] := AnsiChar(x div 256);
-  result[2] := AnsiChar(x mod 256);
-  result[3] := AnsiChar(y div 256);
-  result[4] := AnsiChar(y mod 256);
-end;
-
-{==============================================================================}
-
-function DecodeLongInt(const Value: Ansistring; Index: Integer): LongInt;
-var
-  x, y: Byte;
-  xl, yl: Byte;
-begin
-  if Length(Value) > Index then
-    x := Ord(Value[Index])
-  else
-    x := 0;
-  if Length(Value) >= (Index + 1) then
-    y := Ord(Value[Index + 1])
-  else
-    y := 0;
-  if Length(Value) >= (Index + 2) then
-    xl := Ord(Value[Index + 2])
-  else
-    xl := 0;
-  if Length(Value) >= (Index + 3) then
-    yl := Ord(Value[Index + 3])
-  else
-    yl := 0;
-  Result := ((x * 256 + y) * 65536) + (xl * 256 + yl);
-end;
-
-{==============================================================================}
-
-function DumpStr(const Buffer: Ansistring): string;
-var
-  n: Integer;
-begin
-  Result := '';
-  for n := 1 to Length(Buffer) do
-    Result := Result + ' +#$' + IntToHex(Ord(Buffer[n]), 2);
-end;
-
-{==============================================================================}
-
-function DumpExStr(const Buffer: Ansistring): string;
-var
-  n: Integer;
-  x: Byte;
-begin
-  Result := '';
-  for n := 1 to Length(Buffer) do
-  begin
-    x := Ord(Buffer[n]);
-    if x in [65..90, 97..122] then
-      Result := Result + ' +''' + char(x) + ''''
-    else
-      Result := Result + ' +#$' + IntToHex(Ord(Buffer[n]), 2);
-  end;
-end;
-
-{==============================================================================}
-
-procedure Dump(const Buffer: AnsiString; DumpFile: string);
-var
-  f: Text;
-begin
-  AssignFile(f, DumpFile);
-  if FileExists(DumpFile) then
-    DeleteFile(DumpFile);
-  Rewrite(f);
-  try
-    Writeln(f, DumpStr(Buffer));
-  finally
-    CloseFile(f);
-  end;
-end;
-
-{==============================================================================}
-
-procedure DumpEx(const Buffer: AnsiString; DumpFile: string);
-var
-  f: Text;
-begin
-  AssignFile(f, DumpFile);
-  if FileExists(DumpFile) then
-    DeleteFile(DumpFile);
-  Rewrite(f);
-  try
-    Writeln(f, DumpExStr(Buffer));
-  finally
-    CloseFile(f);
-  end;
-end;
-
-{==============================================================================}
-
-function TrimSPLeft(const S: string): string;
-var
-  I, L: Integer;
-begin
-  Result := '';
-  if S = '' then
-    Exit;
-  L := Length(S);
-  I := 1;
-  while (I <= L) and (S[I] = ' ') do
-    Inc(I);
-  Result := Copy(S, I, Maxint);
-end;
-
-{==============================================================================}
-
-function TrimSPRight(const S: string): string;
-var
-  I: Integer;
-begin
-  Result := '';
-  if S = '' then
-    Exit;
-  I := Length(S);
-  while (I > 0) and (S[I] = ' ') do
-    Dec(I);
-  Result := Copy(S, 1, I);
-end;
-
-{==============================================================================}
-
-function TrimSP(const S: string): string;
-begin
-  Result := TrimSPLeft(s);
-  Result := TrimSPRight(Result);
-end;
-
-{==============================================================================}
-
-function SeparateLeft(const Value, Delimiter: string): string;
-var
-  x: Integer;
-begin
-  x := Pos(Delimiter, Value);
-  if x < 1 then
-    Result := Value
-  else
-    Result := Copy(Value, 1, x - 1);
-end;
-
-{==============================================================================}
-
-function SeparateRight(const Value, Delimiter: string): string;
-var
-  x: Integer;
-begin
-  x := Pos(Delimiter, Value);
-  if x > 0 then
-    x := x + Length(Delimiter) - 1;
-  Result := Copy(Value, x + 1, Length(Value) - x);
-end;
-
-{==============================================================================}
-
-function GetParameter(const Value, Parameter: string): string;
-var
-  s: string;
-  v: string;
-begin
-  Result := '';
-  v := Value;
-  while v <> '' do
-  begin
-    s := Trim(FetchEx(v, ';', '"'));
-    if Pos(Uppercase(parameter), Uppercase(s)) = 1 then
-    begin                       
-      Delete(s, 1, Length(Parameter));
-      s := Trim(s);
-      if s = '' then
-        Break;
-      if s[1] = '=' then
-      begin
-        Result := Trim(SeparateRight(s, '='));
-        Result := UnquoteStr(Result, '"');
-        break;
-      end;
-    end;
-  end;
-end;
-
-{==============================================================================}
-
-procedure ParseParametersEx(Value, Delimiter: string; const Parameters: TStrings);
-var
-  s: string;
-begin
-  Parameters.Clear;
-  while Value <> '' do
-  begin
-    s := Trim(FetchEx(Value, Delimiter, '"'));
-    Parameters.Add(s);
-  end;
-end;
-
-{==============================================================================}
-
-procedure ParseParameters(Value: string; const Parameters: TStrings);
-begin
-  ParseParametersEx(Value, ';', Parameters);
-end;
-
-{==============================================================================}
-
-function IndexByBegin(Value: string; const List: TStrings): integer;
-var
-  n: integer;
-  s: string;
-begin
-  Result := -1;
-  Value := uppercase(Value);
-  for n := 0 to List.Count -1 do
-  begin
-    s := UpperCase(List[n]);
-    if Pos(Value, s) = 1 then
-    begin
-      Result := n;
-      Break;
-    end;
-  end;
-end;
-
-{==============================================================================}
-
-function GetEmailAddr(const Value: string): string;
-var
-  s: string;
-begin
-  s := SeparateRight(Value, '<');
-  s := SeparateLeft(s, '>');
-  Result := Trim(s);
-end;
-
-{==============================================================================}
-
-function GetEmailDesc(Value: string): string;
-var
-  s: string;
-begin
-  Value := Trim(Value);
-  s := SeparateRight(Value, '"');
-  if s <> Value then
-    s := SeparateLeft(s, '"')
-  else
-  begin
-    s := SeparateLeft(Value, '<');
-    if s = Value then
-    begin
-      s := SeparateRight(Value, '(');
-      if s <> Value then
-        s := SeparateLeft(s, ')')
-      else
-        s := '';
-    end;
-  end;
-  Result := Trim(s);
-end;
-
-{==============================================================================}
-
-function StrToHex(const Value: Ansistring): string;
-var
-  n: Integer;
-begin
-  Result := '';
-  for n := 1 to Length(Value) do
-    Result := Result + IntToHex(Byte(Value[n]), 2);
-  Result := LowerCase(Result);
-end;
-
-{==============================================================================}
-
-function IntToBin(Value: Integer; Digits: Byte): string;
-var
-  x, y, n: Integer;
-begin
-  Result := '';
-  x := Value;
-  repeat
-    y := x mod 2;
-    x := x div 2;
-    if y > 0 then
-      Result := '1' + Result
-    else
-      Result := '0' + Result;
-  until x = 0;
-  x := Length(Result);
-  for n := x to Digits - 1 do
-    Result := '0' + Result;
-end;
-
-{==============================================================================}
-
-function BinToInt(const Value: string): Integer;
-var
-  n: Integer;
-begin
-  Result := 0;
-  for n := 1 to Length(Value) do
-  begin
-    if Value[n] = '0' then
-      Result := Result * 2
-    else
-      if Value[n] = '1' then
-        Result := Result * 2 + 1
-      else
-        Break;
-  end;
-end;
-
-{==============================================================================}
-
-function ParseURL(URL: string; var Prot, User, Pass, Host, Port, Path,
-  Para: string): string;
-var
-  x, y: Integer;
-  sURL: string;
-  s: string;
-  s1, s2: string;
-begin
-  Prot := 'http';
-  User := '';
-  Pass := '';
-  Port := '80';
-  Para := '';
-
-  x := Pos('://', URL);
-  if x > 0 then
-  begin
-    Prot := SeparateLeft(URL, '://');
-    sURL := SeparateRight(URL, '://');
-  end
-  else
-    sURL := URL;
-  if UpperCase(Prot) = 'HTTPS' then
-    Port := '443';
-  if UpperCase(Prot) = 'FTP' then
-    Port := '21';
-  x := Pos('@', sURL);
-  y := Pos('/', sURL);
-  if (x > 0) and ((x < y) or (y < 1))then
-  begin
-    s := SeparateLeft(sURL, '@');
-    sURL := SeparateRight(sURL, '@');
-    x := Pos(':', s);
-    if x > 0 then
-    begin
-      User := SeparateLeft(s, ':');
-      Pass := SeparateRight(s, ':');
-    end
-    else
-      User := s;
-  end;
-  x := Pos('/', sURL);
-  if x > 0 then
-  begin
-    s1 := SeparateLeft(sURL, '/');
-    s2 := SeparateRight(sURL, '/');
-  end
-  else
-  begin
-    s1 := sURL;
-    s2 := '';
-  end;
-  if Pos('[', s1) = 1 then
-  begin
-    Host := Separateleft(s1, ']');
-    Delete(Host, 1, 1);
-    s1 := SeparateRight(s1, ']');
-    if Pos(':', s1) = 1 then
-      Port := SeparateRight(s1, ':');
-  end
-  else
-  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
-  begin
-    Path := '/' + SeparateLeft(s2, '?');
-    Para := SeparateRight(s2, '?');
-  end
-  else
-    Path := '/' + s2;
-  if Host = '' then
-    Host := 'localhost';
-end;
-
-{==============================================================================}
-
-function ReplaceString(Value, Search, Replace: AnsiString): AnsiString;
-var
-  x, l, ls, lr: Integer;
-begin
-  if (Value = '') or (Search = '') then
-  begin
-    Result := Value;
-    Exit;
-  end;
-  ls := Length(Search);
-  lr := Length(Replace);
-  Result := '';
-  x := Pos(Search, Value);
-  while x > 0 do
-  begin
-    {$IFNDEF CIL}
-    l := Length(Result);
-    SetLength(Result, l + x - 1);
-    Move(Pointer(Value)^, Pointer(@Result[l + 1])^, x - 1);
-    {$ELSE}
-    Result:=Result+Copy(Value,1,x-1);
-    {$ENDIF}
-    {$IFNDEF CIL}
-    l := Length(Result);
-    SetLength(Result, l + lr);
-    Move(Pointer(Replace)^, Pointer(@Result[l + 1])^, lr);
-    {$ELSE}
-    Result:=Result+Replace;
-    {$ENDIF}
-    Delete(Value, 1, x - 1 + ls);
-    x := Pos(Search, Value);
-  end;
-  Result := Result + Value;
-end;
-
-{==============================================================================}
-
-function RPosEx(const Sub, Value: string; From: integer): Integer;
-var
-  n: Integer;
-  l: Integer;
-begin
-  result := 0;
-  l := Length(Sub);
-  for n := From - l + 1 downto 1 do
-  begin
-    if Copy(Value, n, l) = Sub then
-    begin
-      result := n;
-      break;
-    end;
-  end;
-end;
-
-{==============================================================================}
-
-function RPos(const Sub, Value: String): Integer;
-begin
-  Result := RPosEx(Sub, Value, Length(Value));
-end;
-
-{==============================================================================}
-
-function FetchBin(var Value: string; const Delimiter: string): string;
-var
-  s: string;
-begin
-  Result := SeparateLeft(Value, Delimiter);
-  s := SeparateRight(Value, Delimiter);
-  if s = Value then
-    Value := ''
-  else
-    Value := s;
-end;
-
-{==============================================================================}
-
-function Fetch(var Value: string; const Delimiter: string): string;
-begin
-  Result := FetchBin(Value, Delimiter);
-  Result := TrimSP(Result);
-  Value := TrimSP(Value);
-end;
-
-{==============================================================================}
-
-function FetchEx(var Value: string; const Delimiter, Quotation: string): string;
-var
-  b: Boolean;
-begin
-  Result := '';
-  b := False;
-  while Length(Value) > 0 do
-  begin
-    if b then
-    begin
-      if Pos(Quotation, Value) = 1 then
-        b := False;
-      Result := Result + Value[1];
-      Delete(Value, 1, 1);
-    end
-    else
-    begin
-      if Pos(Delimiter, Value) = 1 then
-      begin
-        Delete(Value, 1, Length(delimiter));
-        break;
-      end;
-      b := Pos(Quotation, Value) = 1;
-      Result := Result + Value[1];
-      Delete(Value, 1, 1);
-    end;
-  end;
-end;
-
-{==============================================================================}
-
-function IsBinaryString(const Value: AnsiString): Boolean;
-var
-  n: integer;
-begin
-  Result := False;
-  for n := 1 to Length(Value) do
-    if Value[n] in [#0..#8, #10..#31] then
-      //ignore null-terminated strings
-      if not ((n = Length(value)) and (Value[n] = AnsiChar(#0))) then
-      begin
-        Result := True;
-        Break;
-      end;
-end;
-
-{==============================================================================}
-
-function PosCRLF(const Value: AnsiString; var Terminator: AnsiString): integer;
-var
-  n, l: integer;
-begin
-  Result := -1;
-  Terminator := '';
-  l := length(value);
-  for n := 1 to l do
-    if value[n] in [#$0d, #$0a] then
-    begin
-      Result := n;
-      Terminator := Value[n];
-      if n <> l then
-        case value[n] of
-          #$0d:
-            if value[n + 1] = #$0a then
-              Terminator := #$0d + #$0a;
-          #$0a:
-            if value[n + 1] = #$0d then
-              Terminator := #$0a + #$0d;
-        end;
-      Break;
-    end;
-end;
-
-{==============================================================================}
-
-Procedure StringsTrim(const Value: TStrings);
-var
-  n: integer;
-begin
-  for n := Value.Count - 1 downto 0 do
-    if Value[n] = '' then
-      Value.Delete(n)
-    else
-      Break;
-end;
-
-{==============================================================================}
-
-function PosFrom(const SubStr, Value: String; From: integer): integer;
-var
-  ls,lv: integer;
-begin
-  Result := 0;
-  ls := Length(SubStr);
-  lv := Length(Value);
-  if (ls = 0) or (lv = 0) then
-    Exit;
-  if From < 1 then
-    From := 1;
-  while (ls + from - 1) <= (lv) do
-  begin
-    {$IFNDEF CIL}
-    if CompareMem(@SubStr[1],@Value[from],ls) then
-    {$ELSE}
-    if SubStr = copy(Value, from, ls) then
-    {$ENDIF}
-    begin
-      result := from;
-      break;
-    end
-    else
-      inc(from);
-  end;
-end;
-
-{==============================================================================}
-
-{$IFNDEF CIL}
-function IncPoint(const p: pointer; Value: integer): pointer;
-begin
-  Result := PAnsiChar(p) + Value;
-end;
-{$ENDIF}
-
-{==============================================================================}
-//improved by 'DoggyDawg'
-function GetBetween(const PairBegin, PairEnd, Value: string): string;
-var
-  n: integer;
-  x: integer;
-  s: string;
-  lenBegin: integer;
-  lenEnd: integer;
-  str: string;
-  max: integer;
-begin
-  lenBegin := Length(PairBegin);
-  lenEnd := Length(PairEnd);
-  n := Length(Value);
-  if (Value = PairBegin + PairEnd) then
-  begin
-    Result := '';//nothing between
-    exit;
-  end;
-  if (n < lenBegin + lenEnd) then
-  begin
-    Result := Value;
-    exit;
-  end;
-  s := SeparateRight(Value, PairBegin);
-  if (s = Value) then
-  begin
-    Result := Value;
-    exit;
-  end;
-  n := Pos(PairEnd, s);
-  if (n = 0) then
-  begin
-    Result := Value;
-    exit;
-  end;
-  Result := '';
-  x := 1;
-  max := Length(s) - lenEnd + 1;
-  for n := 1 to max do
-  begin
-    str := copy(s, n, lenEnd);
-    if (str = PairEnd) then
-    begin
-      Dec(x);
-      if (x <= 0) then
-        Break;
-    end;
-    str := copy(s, n, lenBegin);
-    if (str = PairBegin) then
-      Inc(x);
-    Result := Result + s[n];
-  end;
-end;
-
-{==============================================================================}
-
-function CountOfChar(const Value: string; Chr: char): integer;
-var
-  n: integer;
-begin
-  Result := 0;
-  for n := 1 to Length(Value) do
-    if Value[n] = chr then
-      Inc(Result);
-end;
-
-{==============================================================================}
-// ! do not use AnsiExtractQuotedStr, it's very buggy and can crash application!
-function UnquoteStr(const Value: string; Quote: Char): string;
-var
-  n: integer;
-  inq, dq: Boolean;
-  c, cn: char;
-begin
-  Result := '';
-  if Value = '' then
-    Exit;
-  if Value = Quote + Quote then
-    Exit;
-  inq := False;
-  dq := False;
-  for n := 1 to Length(Value) do
-  begin
-    c := Value[n];
-    if n <> Length(Value) then
-      cn := Value[n + 1]
-    else
-      cn := #0;
-    if c = quote then
-      if dq then
-        dq := False
-      else
-        if not inq then
-          inq := True
-        else
-          if cn = quote then
-          begin
-            Result := Result + Quote;
-            dq := True;
-          end
-          else
-            inq := False
-    else
-      Result := Result + c;
-  end;
-end;
-
-{==============================================================================}
-
-function QuoteStr(const Value: string; Quote: Char): string;
-var
-  n: integer;
-begin
-  Result := '';
-  for n := 1 to length(value) do
-  begin
-    Result := result + Value[n];
-    if value[n] = Quote then
-      Result := Result + Quote;
-  end;
-  Result :=  Quote + Result + Quote;
-end;
-
-{==============================================================================}
-
-procedure HeadersToList(const Value: TStrings);
-var
-  n, x, y: integer;
-  s: string;
-begin
-  for n := 0 to Value.Count -1 do
-  begin
-    s := Value[n];
-    x := Pos(':', s);
-    if x > 0 then
-    begin
-      y:= Pos('=',s); 
-      if not ((y > 0) and (y < x)) then
-      begin
-        s[x] := '=';
-        Value[n] := s;
-      end;
-    end;
-  end;
-end;
-
-{==============================================================================}
-
-procedure ListToHeaders(const Value: TStrings);
-var
-  n, x: integer;
-  s: string;
-begin
-  for n := 0 to Value.Count -1 do
-  begin
-    s := Value[n];
-    x := Pos('=', s);
-    if x > 0 then
-    begin
-      s[x] := ':';
-      Value[n] := s;
-    end;
-  end;
-end;
-
-{==============================================================================}
-
-function SwapBytes(Value: integer): integer;
-var
-  s: AnsiString;
-  x, y, xl, yl: Byte;
-begin
-  s := CodeLongInt(Value);
-  x := Ord(s[4]);
-  y := Ord(s[3]);
-  xl := Ord(s[2]);
-  yl := Ord(s[1]);
-  Result := ((x * 256 + y) * 65536) + (xl * 256 + yl);
-end;
-
-{==============================================================================}
-
-function ReadStrFromStream(const Stream: TStream; len: integer): AnsiString;
-var
-  x: integer;
-{$IFDEF CIL}
-  buf: Array of Byte;
-{$ENDIF}
-begin
-{$IFDEF CIL}
-  Setlength(buf, Len);
-  x := Stream.read(buf, Len);
-  SetLength(buf, x);
-  Result := StringOf(Buf);
-{$ELSE}
-  Setlength(Result, Len);
-  x := Stream.read(PAnsiChar(Result)^, Len);
-  SetLength(Result, x);
-{$ENDIF}
-end;
-
-{==============================================================================}
-
-procedure WriteStrToStream(const Stream: TStream; Value: AnsiString);
-{$IFDEF CIL}
-var
-  buf: Array of Byte;
-{$ENDIF}
-begin
-{$IFDEF CIL}
-  buf := BytesOf(Value);
-  Stream.Write(buf,length(Value));
-{$ELSE}
-  Stream.Write(PAnsiChar(Value)^, Length(Value));
-{$ENDIF}
-end;
-
-{==============================================================================}
-function GetTempFile(const Dir, prefix: AnsiString): AnsiString;
-{$IFNDEF FPC}
-{$IFDEF MSWINDOWS}
-var
-  Path: AnsiString;
-  x: integer;
-{$ENDIF}
-{$ENDIF}
-begin
-{$IFDEF FPC}
-  Result := GetTempFileName(Dir, Prefix);
-{$ELSE}
-  {$IFNDEF MSWINDOWS}
-    Result := tempnam(Pointer(Dir), Pointer(prefix));
-  {$ELSE}
-    {$IFDEF CIL}
-  Result := System.IO.Path.GetTempFileName;
-    {$ELSE}
-  if Dir = '' then
-  begin
-    SetLength(Path, MAX_PATH);
-	  x := GetTempPath(Length(Path), PChar(Path));
-  	SetLength(Path, x);
-  end
-  else
-    Path := Dir;
-  x := Length(Path);
-  if Path[x] <> '\' then
-    Path := Path + '\';
-  SetLength(Result, MAX_PATH + 1);
-  GetTempFileName(PChar(Path), PChar(Prefix), 0, PChar(Result));
-  Result := PChar(Result);
-  SetFileattributes(PChar(Result), GetFileAttributes(PChar(Result)) or FILE_ATTRIBUTE_TEMPORARY);
-    {$ENDIF}
-  {$ENDIF}
-{$ENDIF}
-end;
-
-{==============================================================================}
-
-function PadString(const Value: AnsiString; len: integer; Pad: AnsiChar): AnsiString;
-begin
-  if length(value) >= len then
-    Result := Copy(value, 1, len)
-  else
-    Result := Value + StringOfChar(Pad, len - length(value));
-end;
-
-{==============================================================================}
-
-function NormalizeHeader(Value: TStrings; var Index: Integer): string;
-var
-  s, t: string;
-  n: Integer;
-begin
-  s := Value[Index];
-  Inc(Index);
-  if s <> '' then
-    while (Value.Count - 1) > Index do
-    begin
-      t := Value[Index];
-      if t = '' then
-        Break;
-      for n := 1 to Length(t) do
-        if t[n] = #9 then
-          t[n] := ' ';
-      if not(AnsiChar(t[1]) in [' ', '"', ':', '=']) then
-        Break
-      else
-      begin
-        s := s + ' ' + Trim(t);
-        Inc(Index);
-      end;
-    end;
-  Result := TrimRight(s);
-end;
-
-{==============================================================================}
-var
-  n: integer;
-begin
-  for n :=  1 to 12 do
-  begin
-    CustomMonthNames[n] := ShortMonthNames[n];
-    MyMonthNames[0, n] := ShortMonthNames[n];
-  end;
-end.
+{==============================================================================|
+| Project : Ararat Synapse                                       | 004.014.000 |
+|==============================================================================|
+| Content: support procedures and functions                                    |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c) 1999-2010.               |
+| Portions created by Hernan Sanchez are Copyright (c) 2000.                   |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|   Hernan Sanchez (hernan.sanchez@iname.com)                                  |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@abstract(Support procedures and functions)}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$Q-}
+{$R-}
+{$H+}
+
+//old Delphi does not have MSWINDOWS define.
+{$IFDEF WIN32}
+  {$IFNDEF MSWINDOWS}
+    {$DEFINE MSWINDOWS}
+  {$ENDIF}
+{$ENDIF}
+
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+  {$WARN SUSPICIOUS_TYPECAST OFF}
+{$ENDIF}
+
+unit synautil;
+
+interface
+
+uses
+{$IFDEF MSWINDOWS}
+  Windows,
+{$ELSE}
+  {$IFDEF FPC}
+    UnixUtil, Unix, BaseUnix,
+  {$ELSE}
+    Libc,
+  {$ENDIF}
+{$ENDIF}
+{$IFDEF CIL}
+  System.IO,
+{$ENDIF}
+  SysUtils, Classes, SynaFpc;
+
+{$IFDEF VER100}
+type
+  int64 = integer;
+{$ENDIF}
+
+{:Return your timezone bias from UTC time in minutes.}
+function TimeZoneBias: integer;
+
+{:Return your timezone bias from UTC time in string representation like "+0200".}
+function TimeZone: string;
+
+{:Returns current time in format defined in RFC-822. Useful for SMTP messages,
+ but other protocols use this time format as well. Results contains the timezone
+ specification. Four digit year is used to break any Y2K concerns. (Example
+ 'Fri, 15 Oct 1999 21:14:56 +0200')}
+function Rfc822DateTime(t: TDateTime): string;
+
+{:Returns date and time in format defined in C compilers in format "mmm dd hh:nn:ss"}
+function CDateTime(t: TDateTime): string;
+
+{:Returns date and time in format defined in format 'yymmdd hhnnss'}
+function SimpleDateTime(t: TDateTime): string;
+
+{:Returns date and time in format defined in ANSI C compilers in format
+ "ddd mmm d hh:nn:ss yyyy" }
+function AnsiCDateTime(t: TDateTime): string;
+
+{:Decode three-letter string with name of month to their month number. If string
+ not match any month name, then is returned 0. For parsing are used predefined
+ names for English, French and German and names from system locale too.}
+function GetMonthNumber(Value: String): integer;
+
+{:Return decoded time from given string. Time must be witch separator ':'. You
+ can use "hh:mm" or "hh:mm:ss".}
+function GetTimeFromStr(Value: string): TDateTime;
+
+{:Decode string in format "m-d-y" to TDateTime type.}
+function GetDateMDYFromStr(Value: string): TDateTime;
+
+{:Decode various string representations of date and time to Tdatetime type.
+ This function do all timezone corrections too! This function can decode lot of
+  formats like:
+ @longcode(#
+ ddd, d mmm yyyy hh:mm:ss
+ ddd, d mmm yy hh:mm:ss
+ ddd, mmm d yyyy hh:mm:ss
+ ddd mmm dd hh:mm:ss yyyy #)
+
+and more with lot of modifications, include:
+@longcode(#
+Sun, 06 Nov 1994 08:49:37 GMT    ; RFC 822, updated by RFC 1123
+Sunday, 06-Nov-94 08:49:37 GMT   ; RFC 850, obsoleted by RFC 1036
+Sun Nov  6 08:49:37 1994         ; ANSI C's asctime() Format
+#)
+Timezone corrections known lot of symbolic timezone names (like CEST, EDT, etc.)
+or numeric representation (like +0200). By convention defined in RFC timezone
+ +0000 is GMT and -0000 is current your system timezone.}
+function DecodeRfcDateTime(Value: string): TDateTime;
+
+{:Return current system date and time in UTC timezone.}
+function GetUTTime: TDateTime;
+
+{:Set Newdt as current system date and time in UTC timezone. This function work
+ only if you have administrator rights!}
+function SetUTTime(Newdt: TDateTime): Boolean;
+
+{:Return current value of system timer with precizion 1 millisecond. Good for
+ measure time difference.}
+function GetTick: LongWord;
+
+{:Return difference between two timestamps. It working fine only for differences
+ smaller then maxint. (difference must be smaller then 24 days.)}
+function TickDelta(TickOld, TickNew: LongWord): LongWord;
+
+{:Return two characters, which ordinal values represents the value in byte
+ format. (High-endian)}
+function CodeInt(Value: Word): Ansistring;
+
+{:Decodes two characters located at "Index" offset position of the "Value"
+ string to Word values.}
+function DecodeInt(const Value: Ansistring; Index: Integer): Word;
+
+{:Return four characters, which ordinal values represents the value in byte
+ format. (High-endian)}
+function CodeLongInt(Value: LongInt): Ansistring;
+
+{:Decodes four characters located at "Index" offset position of the "Value"
+ string to LongInt values.}
+function DecodeLongInt(const Value: Ansistring; Index: Integer): LongInt;
+
+{:Dump binary buffer stored in a string to a result string.}
+function DumpStr(const Buffer: Ansistring): string;
+
+{:Dump binary buffer stored in a string to a result string. All bytes with code
+ of character is written as character, not as hexadecimal value.}
+function DumpExStr(const Buffer: Ansistring): string;
+
+{:Dump binary buffer stored in a string to a file with DumpFile filename.}
+procedure Dump(const Buffer: AnsiString; DumpFile: string);
+
+{:Dump binary buffer stored in a string to a file with DumpFile filename. All
+ bytes with code of character is written as character, not as hexadecimal value.}
+procedure DumpEx(const Buffer: AnsiString; DumpFile: string);
+
+{:Like TrimLeft, but remove only spaces, not control characters!}
+function TrimSPLeft(const S: string): string;
+
+{:Like TrimRight, but remove only spaces, not control characters!}
+function TrimSPRight(const S: string): string;
+
+{:Like Trim, but remove only spaces, not control characters!}
+function TrimSP(const S: string): string;
+
+{:Returns a portion of the "Value" string located to the left of the "Delimiter"
+ string. If a delimiter is not found, results is original string.}
+function SeparateLeft(const Value, Delimiter: string): string;
+
+{:Returns the portion of the "Value" string located to the right of the
+ "Delimiter" string. If a delimiter is not found, results is original string.}
+function SeparateRight(const Value, Delimiter: string): string;
+
+{:Returns parameter value from string in format:
+ parameter1="value1"; parameter2=value2}
+function GetParameter(const Value, Parameter: string): string;
+
+{:parse value string with elements differed by Delimiter into stringlist.}
+procedure ParseParametersEx(Value, Delimiter: string; const Parameters: TStrings);
+
+{:parse value string with elements differed by ';' into stringlist.}
+procedure ParseParameters(Value: string; const Parameters: TStrings);
+
+{:Index of string in stringlist with same beginning as Value is returned.}
+function IndexByBegin(Value: string; const List: TStrings): integer;
+
+{:Returns only the e-mail portion of an address from the full address format.
+ i.e. returns 'nobody@@somewhere.com' from '"someone" <nobody@@somewhere.com>'}
+function GetEmailAddr(const Value: string): string;
+
+{:Returns only the description part from a full address format. i.e. returns
+ 'someone' from '"someone" <nobody@@somewhere.com>'}
+function GetEmailDesc(Value: string): string;
+
+{:Returns a string with hexadecimal digits representing the corresponding values
+ of the bytes found in "Value" string.}
+function StrToHex(const Value: Ansistring): string;
+
+{:Returns a string of binary "Digits" representing "Value".}
+function IntToBin(Value: Integer; Digits: Byte): string;
+
+{:Returns an integer equivalent of the binary string in "Value".
+ (i.e. ('10001010') returns 138)}
+function BinToInt(const Value: string): Integer;
+
+{:Parses a URL to its various components.}
+function ParseURL(URL: string; var Prot, User, Pass, Host, Port, Path,
+  Para: string): string;
+
+{:Replaces all "Search" string values found within "Value" string, with the
+ "Replace" string value.}
+function ReplaceString(Value, Search, Replace: AnsiString): AnsiString;
+
+{:It is like RPos, but search is from specified possition.}
+function RPosEx(const Sub, Value: string; From: integer): Integer;
+
+{:It is like POS function, but from right side of Value string.}
+function RPos(const Sub, Value: String): Integer;
+
+{:Like @link(fetch), but working with binary strings, not with text.}
+function FetchBin(var Value: string; const Delimiter: string): string;
+
+{:Fetch string from left of Value string.}
+function Fetch(var Value: string; const Delimiter: string): string;
+
+{:Fetch string from left of Value string. This function ignore delimitesr inside
+ quotations.}
+function FetchEx(var Value: string; const Delimiter, Quotation: string): string;
+
+{:If string is binary string (contains non-printable characters), then is
+ returned true.}
+function IsBinaryString(const Value: AnsiString): Boolean;
+
+{:return position of string terminator in string. If terminator found, then is
+ returned in terminator parameter.
+ Possible line terminators are: CRLF, LFCR, CR, LF}
+function PosCRLF(const Value: AnsiString; var Terminator: AnsiString): integer;
+
+{:Delete empty strings from end of stringlist.}
+Procedure StringsTrim(const value: TStrings);
+
+{:Like Pos function, buf from given string possition.}
+function PosFrom(const SubStr, Value: String; From: integer): integer;
+
+{$IFNDEF CIL}
+{:Increase pointer by value.}
+function IncPoint(const p: pointer; Value: integer): pointer;
+{$ENDIF}
+
+{:Get string between PairBegin and PairEnd. This function respect nesting.
+ For example:
+ @longcode(#
+ Value is: 'Hi! (hello(yes!))'
+ pairbegin is: '('
+ pairend is: ')'
+ In this case result is: 'hello(yes!)'#)}
+function GetBetween(const PairBegin, PairEnd, Value: string): string;
+
+{:Return count of Chr in Value string.}
+function CountOfChar(const Value: string; Chr: char): integer;
+
+{:Remove quotation from Value string. If Value is not quoted, then return same
+ string without any modification. }
+function UnquoteStr(const Value: string; Quote: Char): string;
+
+{:Quote Value string. If Value contains some Quote chars, then it is doubled.}
+function QuoteStr(const Value: string; Quote: Char): string;
+
+{:Convert lines in stringlist from 'name: value' form to 'name=value' form.}
+procedure HeadersToList(const Value: TStrings);
+
+{:Convert lines in stringlist from 'name=value' form to 'name: value' form.}
+procedure ListToHeaders(const Value: TStrings);
+
+{:swap bytes in integer.}
+function SwapBytes(Value: integer): integer;
+
+{:read string with requested length form stream.}
+function ReadStrFromStream(const Stream: TStream; len: integer): AnsiString;
+
+{:write string to stream.}
+procedure WriteStrToStream(const Stream: TStream; Value: AnsiString);
+
+{:Return filename of new temporary file in Dir (if empty, then default temporary
+ directory is used) and with optional filename prefix.}
+function GetTempFile(const Dir, prefix: AnsiString): AnsiString;
+
+{:Return padded string. If length is greater, string is truncated. If length is
+ smaller, string is padded by Pad character.}
+function PadString(const Value: AnsiString; len: integer; Pad: AnsiChar): AnsiString;
+
+{:Read header from "Value" stringlist beginning at "Index" position. If header
+ is Splitted into multiple lines, then this procedure de-split it into one line.}
+function NormalizeHeader(Value: TStrings; var Index: Integer): string;
+
+var
+  {:can be used for your own months strings for @link(getmonthnumber)}
+  CustomMonthNames: array[1..12] of string;
+
+implementation
+
+{==============================================================================}
+
+const
+  MyDayNames: array[1..7] of AnsiString =
+    ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
+var
+  MyMonthNames: array[0..6, 1..12] of String =
+    (
+    ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',  //rewrited by system locales
+     'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'),
+    ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',  //English
+     'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'),
+    ('jan', 'fév', 'mar', 'avr', 'mai', 'jun', //French
+     'jul', 'aoû', 'sep', 'oct', 'nov', 'déc'),
+    ('jan', 'fev', 'mar', 'avr', 'mai', 'jun',  //French#2
+     'jul', 'aou', 'sep', 'oct', 'nov', 'dec'),
+    ('Jan', 'Feb', 'Mar', 'Apr', 'Mai', 'Jun',  //German
+     'Jul', 'Aug', 'Sep', 'Okt', 'Nov', 'Dez'),
+    ('Jan', 'Feb', 'Mär', 'Apr', 'Mai', 'Jun',  //German#2
+     'Jul', 'Aug', 'Sep', 'Okt', 'Nov', 'Dez'),
+    ('Led', 'Úno', 'Bøe', 'Dub', 'Kvì', 'Èen',  //Czech
+     'Èec', 'Srp', 'Záø', 'Øíj', 'Lis', 'Pro')
+     );
+
+
+{==============================================================================}
+
+function TimeZoneBias: integer;
+{$IFNDEF MSWINDOWS}
+{$IFNDEF FPC}
+var
+  t: TTime_T;
+  UT: TUnixTime;
+begin
+  __time(@T);
+  localtime_r(@T, UT);
+  Result := ut.__tm_gmtoff div 60;
+{$ELSE}
+begin
+  Result := TZSeconds div 60;
+{$ENDIF}
+{$ELSE}
+var
+  zoneinfo: TTimeZoneInformation;
+  bias: Integer;
+begin
+  case GetTimeZoneInformation(Zoneinfo) of
+    2:
+      bias := zoneinfo.Bias + zoneinfo.DaylightBias;
+    1:
+      bias := zoneinfo.Bias + zoneinfo.StandardBias;
+  else
+    bias := zoneinfo.Bias;
+  end;
+  Result := bias * (-1);
+{$ENDIF}
+end;
+
+{==============================================================================}
+
+function TimeZone: string;
+var
+  bias: Integer;
+  h, m: Integer;
+begin
+  bias := TimeZoneBias;
+  if bias >= 0 then
+    Result := '+'
+  else
+    Result := '-';
+  bias := Abs(bias);
+  h := bias div 60;
+  m := bias mod 60;
+  Result := Result + Format('%.2d%.2d', [h, m]);
+end;
+
+{==============================================================================}
+
+function Rfc822DateTime(t: TDateTime): string;
+var
+  wYear, wMonth, wDay: word;
+begin
+  DecodeDate(t, wYear, wMonth, wDay);
+  Result := Format('%s, %d %s %s %s', [MyDayNames[DayOfWeek(t)], wDay,
+    MyMonthNames[1, wMonth], FormatDateTime('yyyy hh":"nn":"ss', t), TimeZone]);
+end;
+
+{==============================================================================}
+
+function CDateTime(t: TDateTime): string;
+var
+  wYear, wMonth, wDay: word;
+begin
+  DecodeDate(t, wYear, wMonth, wDay);
+  Result:= Format('%s %2d %s', [MyMonthNames[1, wMonth], wDay,
+    FormatDateTime('hh":"nn":"ss', t)]);
+end;
+
+{==============================================================================}
+
+function SimpleDateTime(t: TDateTime): string;
+begin
+  Result := FormatDateTime('yymmdd hhnnss', t);
+end;
+
+{==============================================================================}
+
+function AnsiCDateTime(t: TDateTime): string;
+var
+  wYear, wMonth, wDay: word;
+begin
+  DecodeDate(t, wYear, wMonth, wDay);
+  Result := Format('%s %s %d %s', [MyDayNames[DayOfWeek(t)], MyMonthNames[1, wMonth],
+    wDay, FormatDateTime('hh":"nn":"ss yyyy ', t)]);
+end;
+
+{==============================================================================}
+
+function DecodeTimeZone(Value: string; var Zone: integer): Boolean;
+var
+  x: integer;
+  zh, zm: integer;
+  s: string;
+begin
+  Result := false;
+  s := Value;
+  if (Pos('+', s) = 1) or (Pos('-',s) = 1) then
+  begin
+    if s = '-0000' then
+      Zone := TimeZoneBias
+    else
+      if Length(s) > 4 then
+      begin
+        zh := StrToIntdef(s[2] + s[3], 0);
+        zm := StrToIntdef(s[4] + s[5], 0);
+        zone := zh * 60 + zm;
+        if s[1] = '-' then
+          zone := zone * (-1);
+      end;
+    Result := True;
+  end
+  else
+  begin
+    x := 32767;
+    if s = 'NZDT' then x := 13;
+    if s = 'IDLE' then x := 12;
+    if s = 'NZST' then x := 12;
+    if s = 'NZT' then x := 12;
+    if s = 'EADT' then x := 11;
+    if s = 'GST' then x := 10;
+    if s = 'JST' then x := 9;
+    if s = 'CCT' then x := 8;
+    if s = 'WADT' then x := 8;
+    if s = 'WAST' then x := 7;
+    if s = 'ZP6' then x := 6;
+    if s = 'ZP5' then x := 5;
+    if s = 'ZP4' then x := 4;
+    if s = 'BT' then x := 3;
+    if s = 'EET' then x := 2;
+    if s = 'MEST' then x := 2;
+    if s = 'MESZ' then x := 2;
+    if s = 'SST' then x := 2;
+    if s = 'FST' then x := 2;
+    if s = 'CEST' then x := 2;
+    if s = 'CET' then x := 1;
+    if s = 'FWT' then x := 1;
+    if s = 'MET' then x := 1;
+    if s = 'MEWT' then x := 1;
+    if s = 'SWT' then x := 1;
+    if s = 'UT' then x := 0;
+    if s = 'UTC' then x := 0;
+    if s = 'GMT' then x := 0;
+    if s = 'WET' then x := 0;
+    if s = 'WAT' then x := -1;
+    if s = 'BST' then x := -1;
+    if s = 'AT' then x := -2;
+    if s = 'ADT' then x := -3;
+    if s = 'AST' then x := -4;
+    if s = 'EDT' then x := -4;
+    if s = 'EST' then x := -5;
+    if s = 'CDT' then x := -5;
+    if s = 'CST' then x := -6;
+    if s = 'MDT' then x := -6;
+    if s = 'MST' then x := -7;
+    if s = 'PDT' then x := -7;
+    if s = 'PST' then x := -8;
+    if s = 'YDT' then x := -8;
+    if s = 'YST' then x := -9;
+    if s = 'HDT' then x := -9;
+    if s = 'AHST' then x := -10;
+    if s = 'CAT' then x := -10;
+    if s = 'HST' then x := -10;
+    if s = 'EAST' then x := -10;
+    if s = 'NT' then x := -11;
+    if s = 'IDLW' then x := -12;
+    if x <> 32767 then
+    begin
+      zone := x * 60;
+      Result := True;
+    end;
+  end;
+end;
+
+{==============================================================================}
+
+function GetMonthNumber(Value: String): integer;
+var
+  n: integer;
+  function TestMonth(Value: String; Index: Integer): Boolean;
+  var
+    n: integer;
+  begin
+    Result := False;
+    for n := 0 to 6 do
+      if Value = AnsiUppercase(MyMonthNames[n, Index]) then
+      begin
+        Result := True;
+        Break;
+      end;
+  end;
+begin
+  Result := 0;
+  Value := AnsiUppercase(Value);
+  for n := 1 to 12 do
+    if TestMonth(Value, n) or (Value = AnsiUppercase(CustomMonthNames[n])) then
+    begin
+      Result := n;
+      Break;
+    end;
+end;
+
+{==============================================================================}
+
+function GetTimeFromStr(Value: string): TDateTime;
+var
+  x: integer;
+begin
+  x := rpos(':', Value);
+  if (x > 0) and ((Length(Value) - x) > 2) then
+    Value := Copy(Value, 1, x + 2);
+  Value := ReplaceString(Value, ':', TimeSeparator);
+  Result := -1;
+  try
+    Result := StrToTime(Value);
+  except
+    on Exception do ;
+  end;
+end;
+
+{==============================================================================}
+
+function GetDateMDYFromStr(Value: string): TDateTime;
+var
+  wYear, wMonth, wDay: word;
+  s: string;
+begin
+  Result := 0;
+  s := Fetch(Value, '-');
+  wMonth := StrToIntDef(s, 12);
+  s := Fetch(Value, '-');
+  wDay := StrToIntDef(s, 30);
+  wYear := StrToIntDef(Value, 1899);
+  if wYear < 1000 then
+    if (wYear > 99) then
+      wYear := wYear + 1900
+    else
+      if wYear > 50 then
+        wYear := wYear + 1900
+      else
+        wYear := wYear + 2000;
+  try
+    Result := EncodeDate(wYear, wMonth, wDay);
+  except
+    on Exception do ;
+  end;
+end;
+
+{==============================================================================}
+
+function DecodeRfcDateTime(Value: string): TDateTime;
+var
+  day, month, year: Word;
+  zone: integer;
+  x, y: integer;
+  s: string;
+  t: TDateTime;
+begin
+// ddd, d mmm yyyy hh:mm:ss
+// ddd, d mmm yy hh:mm:ss
+// ddd, mmm d yyyy hh:mm:ss
+// ddd mmm dd hh:mm:ss yyyy
+// Sun, 06 Nov 1994 08:49:37 GMT    ; RFC 822, updated by RFC 1123
+// Sunday, 06-Nov-94 08:49:37 GMT   ; RFC 850, obsoleted by RFC 1036
+// Sun Nov  6 08:49:37 1994         ; ANSI C's asctime() Format
+
+  Result := 0;
+  if Value = '' then
+    Exit;
+  day := 0;
+  month := 0;
+  year := 0;
+  zone := 0;
+  Value := ReplaceString(Value, ' -', ' #');
+  Value := ReplaceString(Value, '-', ' ');
+  Value := ReplaceString(Value, ' #', ' -');
+  while Value <> '' do
+  begin
+    s := Fetch(Value, ' ');
+    s := uppercase(s);
+    // timezone
+    if DecodetimeZone(s, x) then
+    begin
+      zone := x;
+      continue;
+    end;
+    x := StrToIntDef(s, 0);
+    // day or year
+    if x > 0 then
+      if (x < 32) and (day = 0) then
+      begin
+        day := x;
+        continue;
+      end
+      else
+      begin
+        if (year = 0) and ((month > 0) or (x > 12)) then
+        begin
+          year := x;
+          if year < 32 then
+            year := year + 2000;
+          if year < 1000 then
+           year := year + 1900;
+          continue;
+        end;
+      end;
+    // time
+    if rpos(':', s) > Pos(':', s) then
+    begin
+      t := GetTimeFromStr(s);
+      if t <> -1 then
+        Result := t;
+      continue;
+    end;
+    //timezone daylight saving time
+    if s = 'DST' then
+    begin
+      zone := zone + 60;
+      continue;
+    end;
+    // month
+    y := GetMonthNumber(s);
+    if (y > 0) and (month = 0) then
+      month := y;
+  end;
+  if year = 0 then
+    year := 1980;
+  if month < 1 then
+    month := 1;
+  if month > 12 then
+    month := 12;
+  if day < 1 then
+    day := 1;
+  x := MonthDays[IsLeapYear(year), month];
+  if day > x then
+    day := x;
+  Result := Result + Encodedate(year, month, day);
+  zone := zone - TimeZoneBias;
+  x := zone div 1440;
+  Result := Result - x;
+  zone := zone mod 1440;
+  t := EncodeTime(Abs(zone) div 60, Abs(zone) mod 60, 0, 0);
+  if zone < 0 then
+    t := 0 - t;
+  Result := Result - t;
+end;
+
+{==============================================================================}
+
+function GetUTTime: TDateTime;
+{$IFDEF MSWINDOWS}
+{$IFNDEF FPC}
+var
+  st: TSystemTime;
+begin
+  GetSystemTime(st);
+  result := SystemTimeToDateTime(st);
+{$ELSE}
+var
+  st: SysUtils.TSystemTime;
+  stw: Windows.TSystemTime;
+begin
+  GetSystemTime(stw);
+  st.Year := stw.wYear;
+  st.Month := stw.wMonth;
+  st.Day := stw.wDay;
+  st.Hour := stw.wHour;
+  st.Minute := stw.wMinute;
+  st.Second := stw.wSecond;
+  st.Millisecond := stw.wMilliseconds;
+  result := SystemTimeToDateTime(st);
+{$ENDIF}
+{$ELSE}
+{$IFNDEF FPC}
+var
+  TV: TTimeVal;
+begin
+  gettimeofday(TV, nil);
+  Result := UnixDateDelta + (TV.tv_sec + TV.tv_usec / 1000000) / 86400;
+{$ELSE}
+var
+  TV: TimeVal;
+begin
+  fpgettimeofday(@TV, nil);
+  Result := UnixDateDelta + (TV.tv_sec + TV.tv_usec / 1000000) / 86400;
+{$ENDIF}
+{$ENDIF}
+end;
+
+{==============================================================================}
+
+function SetUTTime(Newdt: TDateTime): Boolean;
+{$IFDEF MSWINDOWS}
+{$IFNDEF FPC}
+var
+  st: TSystemTime;
+begin
+  DateTimeToSystemTime(newdt,st);
+  Result := SetSystemTime(st);
+{$ELSE}
+var
+  st: SysUtils.TSystemTime;
+  stw: Windows.TSystemTime;
+begin
+  DateTimeToSystemTime(newdt,st);
+  stw.wYear := st.Year;
+  stw.wMonth := st.Month;
+  stw.wDay := st.Day;
+  stw.wHour := st.Hour;
+  stw.wMinute := st.Minute;
+  stw.wSecond := st.Second;
+  stw.wMilliseconds := st.Millisecond;
+  Result := SetSystemTime(stw);
+{$ENDIF}
+{$ELSE}
+{$IFNDEF FPC}
+var
+  TV: TTimeVal;
+  d: double;
+  TZ: Ttimezone;
+  PZ: PTimeZone;
+begin
+  TZ.tz_minuteswest := 0;
+  TZ.tz_dsttime := 0;
+  PZ := @TZ;
+  gettimeofday(TV, PZ);
+  d := (newdt - UnixDateDelta) * 86400;
+  TV.tv_sec := trunc(d);
+  TV.tv_usec := trunc(frac(d) * 1000000);
+  Result := settimeofday(TV, TZ) <> -1;
+{$ELSE}
+var
+  TV: TimeVal;
+  d: double;
+begin
+  d := (newdt - UnixDateDelta) * 86400;
+  TV.tv_sec := trunc(d);
+  TV.tv_usec := trunc(frac(d) * 1000000);
+  Result := fpsettimeofday(@TV, nil) <> -1;
+{$ENDIF}
+{$ENDIF}
+end;
+
+{==============================================================================}
+
+{$IFNDEF MSWINDOWS}
+function GetTick: LongWord;
+var
+  Stamp: TTimeStamp;
+begin
+  Stamp := DateTimeToTimeStamp(Now);
+  Result := Stamp.Time;
+end;
+{$ELSE}
+function GetTick: LongWord;
+var
+  tick, freq: TLargeInteger;
+{$IFDEF VER100}
+  x: TLargeInteger;
+{$ENDIF}
+begin
+  if Windows.QueryPerformanceFrequency(freq) then
+  begin
+    Windows.QueryPerformanceCounter(tick);
+{$IFDEF VER100}
+    x.QuadPart := (tick.QuadPart / freq.QuadPart) * 1000;
+    Result := x.LowPart;
+{$ELSE}
+    Result := Trunc((tick / freq) * 1000) and High(LongWord)
+{$ENDIF}
+  end
+  else
+    Result := Windows.GetTickCount;
+end;
+{$ENDIF}
+
+{==============================================================================}
+
+function TickDelta(TickOld, TickNew: LongWord): LongWord;
+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 + LongWord(MaxInt) + 1;
+      TickOld := TickOld + LongWord(MaxInt) + 1;
+    end;
+    Result := TickNew - TickOld;
+    if TickNew < TickOld then
+      if Result > 0 then
+        Result := 0 - Result;
+  end;
+end;
+
+{==============================================================================}
+
+function CodeInt(Value: Word): Ansistring;
+begin
+  setlength(result, 2);
+  result[1] := AnsiChar(Value div 256);
+  result[2] := AnsiChar(Value mod 256);
+//  Result := AnsiChar(Value div 256) + AnsiChar(Value mod 256)
+end;
+
+{==============================================================================}
+
+function DecodeInt(const Value: Ansistring; Index: Integer): Word;
+var
+  x, y: Byte;
+begin
+  if Length(Value) > Index then
+    x := Ord(Value[Index])
+  else
+    x := 0;
+  if Length(Value) >= (Index + 1) then
+    y := Ord(Value[Index + 1])
+  else
+    y := 0;
+  Result := x * 256 + y;
+end;
+
+{==============================================================================}
+
+function CodeLongInt(Value: Longint): Ansistring;
+var
+  x, y: word;
+begin
+  // this is fix for negative numbers on systems where longint = integer
+  x := (Value shr 16) and integer($ffff);
+  y := Value and integer($ffff);
+  setlength(result, 4);
+  result[1] := AnsiChar(x div 256);
+  result[2] := AnsiChar(x mod 256);
+  result[3] := AnsiChar(y div 256);
+  result[4] := AnsiChar(y mod 256);
+end;
+
+{==============================================================================}
+
+function DecodeLongInt(const Value: Ansistring; Index: Integer): LongInt;
+var
+  x, y: Byte;
+  xl, yl: Byte;
+begin
+  if Length(Value) > Index then
+    x := Ord(Value[Index])
+  else
+    x := 0;
+  if Length(Value) >= (Index + 1) then
+    y := Ord(Value[Index + 1])
+  else
+    y := 0;
+  if Length(Value) >= (Index + 2) then
+    xl := Ord(Value[Index + 2])
+  else
+    xl := 0;
+  if Length(Value) >= (Index + 3) then
+    yl := Ord(Value[Index + 3])
+  else
+    yl := 0;
+  Result := ((x * 256 + y) * 65536) + (xl * 256 + yl);
+end;
+
+{==============================================================================}
+
+function DumpStr(const Buffer: Ansistring): string;
+var
+  n: Integer;
+begin
+  Result := '';
+  for n := 1 to Length(Buffer) do
+    Result := Result + ' +#$' + IntToHex(Ord(Buffer[n]), 2);
+end;
+
+{==============================================================================}
+
+function DumpExStr(const Buffer: Ansistring): string;
+var
+  n: Integer;
+  x: Byte;
+begin
+  Result := '';
+  for n := 1 to Length(Buffer) do
+  begin
+    x := Ord(Buffer[n]);
+    if x in [65..90, 97..122] then
+      Result := Result + ' +''' + char(x) + ''''
+    else
+      Result := Result + ' +#$' + IntToHex(Ord(Buffer[n]), 2);
+  end;
+end;
+
+{==============================================================================}
+
+procedure Dump(const Buffer: AnsiString; DumpFile: string);
+var
+  f: Text;
+begin
+  AssignFile(f, DumpFile);
+  if FileExists(DumpFile) then
+    DeleteFile(DumpFile);
+  Rewrite(f);
+  try
+    Writeln(f, DumpStr(Buffer));
+  finally
+    CloseFile(f);
+  end;
+end;
+
+{==============================================================================}
+
+procedure DumpEx(const Buffer: AnsiString; DumpFile: string);
+var
+  f: Text;
+begin
+  AssignFile(f, DumpFile);
+  if FileExists(DumpFile) then
+    DeleteFile(DumpFile);
+  Rewrite(f);
+  try
+    Writeln(f, DumpExStr(Buffer));
+  finally
+    CloseFile(f);
+  end;
+end;
+
+{==============================================================================}
+
+function TrimSPLeft(const S: string): string;
+var
+  I, L: Integer;
+begin
+  Result := '';
+  if S = '' then
+    Exit;
+  L := Length(S);
+  I := 1;
+  while (I <= L) and (S[I] = ' ') do
+    Inc(I);
+  Result := Copy(S, I, Maxint);
+end;
+
+{==============================================================================}
+
+function TrimSPRight(const S: string): string;
+var
+  I: Integer;
+begin
+  Result := '';
+  if S = '' then
+    Exit;
+  I := Length(S);
+  while (I > 0) and (S[I] = ' ') do
+    Dec(I);
+  Result := Copy(S, 1, I);
+end;
+
+{==============================================================================}
+
+function TrimSP(const S: string): string;
+begin
+  Result := TrimSPLeft(s);
+  Result := TrimSPRight(Result);
+end;
+
+{==============================================================================}
+
+function SeparateLeft(const Value, Delimiter: string): string;
+var
+  x: Integer;
+begin
+  x := Pos(Delimiter, Value);
+  if x < 1 then
+    Result := Value
+  else
+    Result := Copy(Value, 1, x - 1);
+end;
+
+{==============================================================================}
+
+function SeparateRight(const Value, Delimiter: string): string;
+var
+  x: Integer;
+begin
+  x := Pos(Delimiter, Value);
+  if x > 0 then
+    x := x + Length(Delimiter) - 1;
+  Result := Copy(Value, x + 1, Length(Value) - x);
+end;
+
+{==============================================================================}
+
+function GetParameter(const Value, Parameter: string): string;
+var
+  s: string;
+  v: string;
+begin
+  Result := '';
+  v := Value;
+  while v <> '' do
+  begin
+    s := Trim(FetchEx(v, ';', '"'));
+    if Pos(Uppercase(parameter), Uppercase(s)) = 1 then
+    begin                       
+      Delete(s, 1, Length(Parameter));
+      s := Trim(s);
+      if s = '' then
+        Break;
+      if s[1] = '=' then
+      begin
+        Result := Trim(SeparateRight(s, '='));
+        Result := UnquoteStr(Result, '"');
+        break;
+      end;
+    end;
+  end;
+end;
+
+{==============================================================================}
+
+procedure ParseParametersEx(Value, Delimiter: string; const Parameters: TStrings);
+var
+  s: string;
+begin
+  Parameters.Clear;
+  while Value <> '' do
+  begin
+    s := Trim(FetchEx(Value, Delimiter, '"'));
+    Parameters.Add(s);
+  end;
+end;
+
+{==============================================================================}
+
+procedure ParseParameters(Value: string; const Parameters: TStrings);
+begin
+  ParseParametersEx(Value, ';', Parameters);
+end;
+
+{==============================================================================}
+
+function IndexByBegin(Value: string; const List: TStrings): integer;
+var
+  n: integer;
+  s: string;
+begin
+  Result := -1;
+  Value := uppercase(Value);
+  for n := 0 to List.Count -1 do
+  begin
+    s := UpperCase(List[n]);
+    if Pos(Value, s) = 1 then
+    begin
+      Result := n;
+      Break;
+    end;
+  end;
+end;
+
+{==============================================================================}
+
+function GetEmailAddr(const Value: string): string;
+var
+  s: string;
+begin
+  s := SeparateRight(Value, '<');
+  s := SeparateLeft(s, '>');
+  Result := Trim(s);
+end;
+
+{==============================================================================}
+
+function GetEmailDesc(Value: string): string;
+var
+  s: string;
+begin
+  Value := Trim(Value);
+  s := SeparateRight(Value, '"');
+  if s <> Value then
+    s := SeparateLeft(s, '"')
+  else
+  begin
+    s := SeparateLeft(Value, '<');
+    if s = Value then
+    begin
+      s := SeparateRight(Value, '(');
+      if s <> Value then
+        s := SeparateLeft(s, ')')
+      else
+        s := '';
+    end;
+  end;
+  Result := Trim(s);
+end;
+
+{==============================================================================}
+
+function StrToHex(const Value: Ansistring): string;
+var
+  n: Integer;
+begin
+  Result := '';
+  for n := 1 to Length(Value) do
+    Result := Result + IntToHex(Byte(Value[n]), 2);
+  Result := LowerCase(Result);
+end;
+
+{==============================================================================}
+
+function IntToBin(Value: Integer; Digits: Byte): string;
+var
+  x, y, n: Integer;
+begin
+  Result := '';
+  x := Value;
+  repeat
+    y := x mod 2;
+    x := x div 2;
+    if y > 0 then
+      Result := '1' + Result
+    else
+      Result := '0' + Result;
+  until x = 0;
+  x := Length(Result);
+  for n := x to Digits - 1 do
+    Result := '0' + Result;
+end;
+
+{==============================================================================}
+
+function BinToInt(const Value: string): Integer;
+var
+  n: Integer;
+begin
+  Result := 0;
+  for n := 1 to Length(Value) do
+  begin
+    if Value[n] = '0' then
+      Result := Result * 2
+    else
+      if Value[n] = '1' then
+        Result := Result * 2 + 1
+      else
+        Break;
+  end;
+end;
+
+{==============================================================================}
+
+function ParseURL(URL: string; var Prot, User, Pass, Host, Port, Path,
+  Para: string): string;
+var
+  x, y: Integer;
+  sURL: string;
+  s: string;
+  s1, s2: string;
+begin
+  Prot := 'http';
+  User := '';
+  Pass := '';
+  Port := '80';
+  Para := '';
+
+  x := Pos('://', URL);
+  if x > 0 then
+  begin
+    Prot := SeparateLeft(URL, '://');
+    sURL := SeparateRight(URL, '://');
+  end
+  else
+    sURL := URL;
+  if UpperCase(Prot) = 'HTTPS' then
+    Port := '443';
+  if UpperCase(Prot) = 'FTP' then
+    Port := '21';
+  x := Pos('@', sURL);
+  y := Pos('/', sURL);
+  if (x > 0) and ((x < y) or (y < 1))then
+  begin
+    s := SeparateLeft(sURL, '@');
+    sURL := SeparateRight(sURL, '@');
+    x := Pos(':', s);
+    if x > 0 then
+    begin
+      User := SeparateLeft(s, ':');
+      Pass := SeparateRight(s, ':');
+    end
+    else
+      User := s;
+  end;
+  x := Pos('/', sURL);
+  if x > 0 then
+  begin
+    s1 := SeparateLeft(sURL, '/');
+    s2 := SeparateRight(sURL, '/');
+  end
+  else
+  begin
+    s1 := sURL;
+    s2 := '';
+  end;
+  if Pos('[', s1) = 1 then
+  begin
+    Host := Separateleft(s1, ']');
+    Delete(Host, 1, 1);
+    s1 := SeparateRight(s1, ']');
+    if Pos(':', s1) = 1 then
+      Port := SeparateRight(s1, ':');
+  end
+  else
+  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
+  begin
+    Path := '/' + SeparateLeft(s2, '?');
+    Para := SeparateRight(s2, '?');
+  end
+  else
+    Path := '/' + s2;
+  if Host = '' then
+    Host := 'localhost';
+end;
+
+{==============================================================================}
+
+function ReplaceString(Value, Search, Replace: AnsiString): AnsiString;
+var
+  x, l, ls, lr: Integer;
+begin
+  if (Value = '') or (Search = '') then
+  begin
+    Result := Value;
+    Exit;
+  end;
+  ls := Length(Search);
+  lr := Length(Replace);
+  Result := '';
+  x := Pos(Search, Value);
+  while x > 0 do
+  begin
+    {$IFNDEF CIL}
+    l := Length(Result);
+    SetLength(Result, l + x - 1);
+    Move(Pointer(Value)^, Pointer(@Result[l + 1])^, x - 1);
+    {$ELSE}
+    Result:=Result+Copy(Value,1,x-1);
+    {$ENDIF}
+    {$IFNDEF CIL}
+    l := Length(Result);
+    SetLength(Result, l + lr);
+    Move(Pointer(Replace)^, Pointer(@Result[l + 1])^, lr);
+    {$ELSE}
+    Result:=Result+Replace;
+    {$ENDIF}
+    Delete(Value, 1, x - 1 + ls);
+    x := Pos(Search, Value);
+  end;
+  Result := Result + Value;
+end;
+
+{==============================================================================}
+
+function RPosEx(const Sub, Value: string; From: integer): Integer;
+var
+  n: Integer;
+  l: Integer;
+begin
+  result := 0;
+  l := Length(Sub);
+  for n := From - l + 1 downto 1 do
+  begin
+    if Copy(Value, n, l) = Sub then
+    begin
+      result := n;
+      break;
+    end;
+  end;
+end;
+
+{==============================================================================}
+
+function RPos(const Sub, Value: String): Integer;
+begin
+  Result := RPosEx(Sub, Value, Length(Value));
+end;
+
+{==============================================================================}
+
+function FetchBin(var Value: string; const Delimiter: string): string;
+var
+  s: string;
+begin
+  Result := SeparateLeft(Value, Delimiter);
+  s := SeparateRight(Value, Delimiter);
+  if s = Value then
+    Value := ''
+  else
+    Value := s;
+end;
+
+{==============================================================================}
+
+function Fetch(var Value: string; const Delimiter: string): string;
+begin
+  Result := FetchBin(Value, Delimiter);
+  Result := TrimSP(Result);
+  Value := TrimSP(Value);
+end;
+
+{==============================================================================}
+
+function FetchEx(var Value: string; const Delimiter, Quotation: string): string;
+var
+  b: Boolean;
+begin
+  Result := '';
+  b := False;
+  while Length(Value) > 0 do
+  begin
+    if b then
+    begin
+      if Pos(Quotation, Value) = 1 then
+        b := False;
+      Result := Result + Value[1];
+      Delete(Value, 1, 1);
+    end
+    else
+    begin
+      if Pos(Delimiter, Value) = 1 then
+      begin
+        Delete(Value, 1, Length(delimiter));
+        break;
+      end;
+      b := Pos(Quotation, Value) = 1;
+      Result := Result + Value[1];
+      Delete(Value, 1, 1);
+    end;
+  end;
+end;
+
+{==============================================================================}
+
+function IsBinaryString(const Value: AnsiString): Boolean;
+var
+  n: integer;
+begin
+  Result := False;
+  for n := 1 to Length(Value) do
+    if Value[n] in [#0..#8, #10..#31] then
+      //ignore null-terminated strings
+      if not ((n = Length(value)) and (Value[n] = AnsiChar(#0))) then
+      begin
+        Result := True;
+        Break;
+      end;
+end;
+
+{==============================================================================}
+
+function PosCRLF(const Value: AnsiString; var Terminator: AnsiString): integer;
+var
+  n, l: integer;
+begin
+  Result := -1;
+  Terminator := '';
+  l := length(value);
+  for n := 1 to l do
+    if value[n] in [#$0d, #$0a] then
+    begin
+      Result := n;
+      Terminator := Value[n];
+      if n <> l then
+        case value[n] of
+          #$0d:
+            if value[n + 1] = #$0a then
+              Terminator := #$0d + #$0a;
+          #$0a:
+            if value[n + 1] = #$0d then
+              Terminator := #$0a + #$0d;
+        end;
+      Break;
+    end;
+end;
+
+{==============================================================================}
+
+Procedure StringsTrim(const Value: TStrings);
+var
+  n: integer;
+begin
+  for n := Value.Count - 1 downto 0 do
+    if Value[n] = '' then
+      Value.Delete(n)
+    else
+      Break;
+end;
+
+{==============================================================================}
+
+function PosFrom(const SubStr, Value: String; From: integer): integer;
+var
+  ls,lv: integer;
+begin
+  Result := 0;
+  ls := Length(SubStr);
+  lv := Length(Value);
+  if (ls = 0) or (lv = 0) then
+    Exit;
+  if From < 1 then
+    From := 1;
+  while (ls + from - 1) <= (lv) do
+  begin
+    {$IFNDEF CIL}
+    if CompareMem(@SubStr[1],@Value[from],ls) then
+    {$ELSE}
+    if SubStr = copy(Value, from, ls) then
+    {$ENDIF}
+    begin
+      result := from;
+      break;
+    end
+    else
+      inc(from);
+  end;
+end;
+
+{==============================================================================}
+
+{$IFNDEF CIL}
+function IncPoint(const p: pointer; Value: integer): pointer;
+begin
+  Result := PAnsiChar(p) + Value;
+end;
+{$ENDIF}
+
+{==============================================================================}
+//improved by 'DoggyDawg'
+function GetBetween(const PairBegin, PairEnd, Value: string): string;
+var
+  n: integer;
+  x: integer;
+  s: string;
+  lenBegin: integer;
+  lenEnd: integer;
+  str: string;
+  max: integer;
+begin
+  lenBegin := Length(PairBegin);
+  lenEnd := Length(PairEnd);
+  n := Length(Value);
+  if (Value = PairBegin + PairEnd) then
+  begin
+    Result := '';//nothing between
+    exit;
+  end;
+  if (n < lenBegin + lenEnd) then
+  begin
+    Result := Value;
+    exit;
+  end;
+  s := SeparateRight(Value, PairBegin);
+  if (s = Value) then
+  begin
+    Result := Value;
+    exit;
+  end;
+  n := Pos(PairEnd, s);
+  if (n = 0) then
+  begin
+    Result := Value;
+    exit;
+  end;
+  Result := '';
+  x := 1;
+  max := Length(s) - lenEnd + 1;
+  for n := 1 to max do
+  begin
+    str := copy(s, n, lenEnd);
+    if (str = PairEnd) then
+    begin
+      Dec(x);
+      if (x <= 0) then
+        Break;
+    end;
+    str := copy(s, n, lenBegin);
+    if (str = PairBegin) then
+      Inc(x);
+    Result := Result + s[n];
+  end;
+end;
+
+{==============================================================================}
+
+function CountOfChar(const Value: string; Chr: char): integer;
+var
+  n: integer;
+begin
+  Result := 0;
+  for n := 1 to Length(Value) do
+    if Value[n] = chr then
+      Inc(Result);
+end;
+
+{==============================================================================}
+// ! do not use AnsiExtractQuotedStr, it's very buggy and can crash application!
+function UnquoteStr(const Value: string; Quote: Char): string;
+var
+  n: integer;
+  inq, dq: Boolean;
+  c, cn: char;
+begin
+  Result := '';
+  if Value = '' then
+    Exit;
+  if Value = Quote + Quote then
+    Exit;
+  inq := False;
+  dq := False;
+  for n := 1 to Length(Value) do
+  begin
+    c := Value[n];
+    if n <> Length(Value) then
+      cn := Value[n + 1]
+    else
+      cn := #0;
+    if c = quote then
+      if dq then
+        dq := False
+      else
+        if not inq then
+          inq := True
+        else
+          if cn = quote then
+          begin
+            Result := Result + Quote;
+            dq := True;
+          end
+          else
+            inq := False
+    else
+      Result := Result + c;
+  end;
+end;
+
+{==============================================================================}
+
+function QuoteStr(const Value: string; Quote: Char): string;
+var
+  n: integer;
+begin
+  Result := '';
+  for n := 1 to length(value) do
+  begin
+    Result := result + Value[n];
+    if value[n] = Quote then
+      Result := Result + Quote;
+  end;
+  Result :=  Quote + Result + Quote;
+end;
+
+{==============================================================================}
+
+procedure HeadersToList(const Value: TStrings);
+var
+  n, x, y: integer;
+  s: string;
+begin
+  for n := 0 to Value.Count -1 do
+  begin
+    s := Value[n];
+    x := Pos(':', s);
+    if x > 0 then
+    begin
+      y:= Pos('=',s); 
+      if not ((y > 0) and (y < x)) then
+      begin
+        s[x] := '=';
+        Value[n] := s;
+      end;
+    end;
+  end;
+end;
+
+{==============================================================================}
+
+procedure ListToHeaders(const Value: TStrings);
+var
+  n, x: integer;
+  s: string;
+begin
+  for n := 0 to Value.Count -1 do
+  begin
+    s := Value[n];
+    x := Pos('=', s);
+    if x > 0 then
+    begin
+      s[x] := ':';
+      Value[n] := s;
+    end;
+  end;
+end;
+
+{==============================================================================}
+
+function SwapBytes(Value: integer): integer;
+var
+  s: AnsiString;
+  x, y, xl, yl: Byte;
+begin
+  s := CodeLongInt(Value);
+  x := Ord(s[4]);
+  y := Ord(s[3]);
+  xl := Ord(s[2]);
+  yl := Ord(s[1]);
+  Result := ((x * 256 + y) * 65536) + (xl * 256 + yl);
+end;
+
+{==============================================================================}
+
+function ReadStrFromStream(const Stream: TStream; len: integer): AnsiString;
+var
+  x: integer;
+{$IFDEF CIL}
+  buf: Array of Byte;
+{$ENDIF}
+begin
+{$IFDEF CIL}
+  Setlength(buf, Len);
+  x := Stream.read(buf, Len);
+  SetLength(buf, x);
+  Result := StringOf(Buf);
+{$ELSE}
+  Setlength(Result, Len);
+  x := Stream.read(PAnsiChar(Result)^, Len);
+  SetLength(Result, x);
+{$ENDIF}
+end;
+
+{==============================================================================}
+
+procedure WriteStrToStream(const Stream: TStream; Value: AnsiString);
+{$IFDEF CIL}
+var
+  buf: Array of Byte;
+{$ENDIF}
+begin
+{$IFDEF CIL}
+  buf := BytesOf(Value);
+  Stream.Write(buf,length(Value));
+{$ELSE}
+  Stream.Write(PAnsiChar(Value)^, Length(Value));
+{$ENDIF}
+end;
+
+{==============================================================================}
+function GetTempFile(const Dir, prefix: AnsiString): AnsiString;
+{$IFNDEF FPC}
+{$IFDEF MSWINDOWS}
+var
+  Path: AnsiString;
+  x: integer;
+{$ENDIF}
+{$ENDIF}
+begin
+{$IFDEF FPC}
+  Result := GetTempFileName(Dir, Prefix);
+{$ELSE}
+  {$IFNDEF MSWINDOWS}
+    Result := tempnam(Pointer(Dir), Pointer(prefix));
+  {$ELSE}
+    {$IFDEF CIL}
+  Result := System.IO.Path.GetTempFileName;
+    {$ELSE}
+  if Dir = '' then
+  begin
+    SetLength(Path, MAX_PATH);
+	  x := GetTempPath(Length(Path), PChar(Path));
+  	SetLength(Path, x);
+  end
+  else
+    Path := Dir;
+  x := Length(Path);
+  if Path[x] <> '\' then
+    Path := Path + '\';
+  SetLength(Result, MAX_PATH + 1);
+  GetTempFileName(PChar(Path), PChar(Prefix), 0, PChar(Result));
+  Result := PChar(Result);
+  SetFileattributes(PChar(Result), GetFileAttributes(PChar(Result)) or FILE_ATTRIBUTE_TEMPORARY);
+    {$ENDIF}
+  {$ENDIF}
+{$ENDIF}
+end;
+
+{==============================================================================}
+
+function PadString(const Value: AnsiString; len: integer; Pad: AnsiChar): AnsiString;
+begin
+  if length(value) >= len then
+    Result := Copy(value, 1, len)
+  else
+    Result := Value + StringOfChar(Pad, len - length(value));
+end;
+
+{==============================================================================}
+
+function NormalizeHeader(Value: TStrings; var Index: Integer): string;
+var
+  s, t: string;
+  n: Integer;
+begin
+  s := Value[Index];
+  Inc(Index);
+  if s <> '' then
+    while (Value.Count - 1) > Index do
+    begin
+      t := Value[Index];
+      if t = '' then
+        Break;
+      for n := 1 to Length(t) do
+        if t[n] = #9 then
+          t[n] := ' ';
+      if not(AnsiChar(t[1]) in [' ', '"', ':', '=']) then
+        Break
+      else
+      begin
+        s := s + ' ' + Trim(t);
+        Inc(Index);
+      end;
+    end;
+  Result := TrimRight(s);
+end;
+
+{==============================================================================}
+var
+  n: integer;
+begin
+  for n :=  1 to 12 do
+  begin
+    CustomMonthNames[n] := ShortMonthNames[n];
+    MyMonthNames[0, n] := ShortMonthNames[n];
+  end;
+end.
diff --git a/Units/Synapse/synsock.pas b/Units/Synapse/synsock.pas
index c1cad2e..7c9d7c6 100644
--- a/Units/Synapse/synsock.pas
+++ b/Units/Synapse/synsock.pas
@@ -1,77 +1,77 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 005.002.000 |
-|==============================================================================|
-| Content: Socket Independent Platform Layer                                   |
-|==============================================================================|
-| Copyright (c)1999-2010, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2001-20010.                |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{:@exclude}
-
-unit synsock;
-
-{$MINENUMSIZE 4}
-
-//old Delphi does not have MSWINDOWS define.
-{$IFDEF WIN32}
-  {$IFNDEF MSWINDOWS}
-    {$DEFINE MSWINDOWS}
-  {$ENDIF}
-{$ENDIF}
-
-{$IFDEF CIL}
-  {$I ssdotnet.pas}
-{$ELSE}
-  {$IFDEF MSWINDOWS}
-    {$I sswin32.pas}
-  {$ELSE}
-    {$IFDEF WINCE}
-      {$I sswin32.pas}  //not complete yet!
-    {$ELSE}
-      {$IFDEF FPC}
-        {$I ssfpc.pas}
-      {$ELSE}
-        {$I sslinux.pas}
-      {$ENDIF}
-    {$ENDIF}
-  {$ENDIF}
-{$ENDIF}
-
-end.
-
+{==============================================================================|
+| Project : Ararat Synapse                                       | 005.002.000 |
+|==============================================================================|
+| Content: Socket Independent Platform Layer                                   |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2001-20010.                |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@exclude}
+
+unit synsock;
+
+{$MINENUMSIZE 4}
+
+//old Delphi does not have MSWINDOWS define.
+{$IFDEF WIN32}
+  {$IFNDEF MSWINDOWS}
+    {$DEFINE MSWINDOWS}
+  {$ENDIF}
+{$ENDIF}
+
+{$IFDEF CIL}
+  {$I ssdotnet.pas}
+{$ELSE}
+  {$IFDEF MSWINDOWS}
+    {$I sswin32.pas}
+  {$ELSE}
+    {$IFDEF WINCE}
+      {$I sswin32.pas}  //not complete yet!
+    {$ELSE}
+      {$IFDEF FPC}
+        {$I ssfpc.pas}
+      {$ELSE}
+        {$I sslinux.pas}
+      {$ENDIF}
+    {$ENDIF}
+  {$ENDIF}
+{$ENDIF}
+
+end.
+
diff --git a/Units/Synapse/tlntsend.pas b/Units/Synapse/tlntsend.pas
index 557266c..1cac10f 100644
--- a/Units/Synapse/tlntsend.pas
+++ b/Units/Synapse/tlntsend.pas
@@ -1,364 +1,364 @@
-{==============================================================================|
-| Project : Ararat Synapse                                       | 001.003.001 |
-|==============================================================================|
-| Content: TELNET and SSH2 client                                              |
-|==============================================================================|
-| Copyright (c)1999-2010, Lukas Gebauer                                        |
-| All rights reserved.                                                         |
-|                                                                              |
-| Redistribution and use in source and binary forms, with or without           |
-| modification, are permitted provided that the following conditions are met:  |
-|                                                                              |
-| Redistributions of source code must retain the above copyright notice, this  |
-| list of conditions and the following disclaimer.                             |
-|                                                                              |
-| Redistributions in binary form must reproduce the above copyright notice,    |
-| this list of conditions and the following disclaimer in the documentation    |
-| and/or other materials provided with the distribution.                       |
-|                                                                              |
-| Neither the name of Lukas Gebauer nor the names of its contributors may      |
-| be used to endorse or promote products derived from this software without    |
-| specific prior written permission.                                           |
-|                                                                              |
-| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
-| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
-| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
-| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
-| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
-| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
-| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
-| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
-| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
-| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
-| DAMAGE.                                                                      |
-|==============================================================================|
-| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2002-2010.                |
-| All Rights Reserved.                                                         |
-|==============================================================================|
-| Contributor(s):                                                              |
-|==============================================================================|
-| History: see HISTORY.HTM from distribution package                           |
-|          (Found at URL: http://www.ararat.cz/synapse/)                       |
-|==============================================================================}
-
-{:@abstract(Telnet script client)
-
-Used RFC: RFC-854
-}
-
-{$IFDEF FPC}
-  {$MODE DELPHI}
-{$ENDIF}
-{$H+}
-
-{$IFDEF UNICODE}
-  {$WARN IMPLICIT_STRING_CAST OFF}
-  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
-{$ENDIF}
-
-unit tlntsend;
-
-interface
-
-uses
-  SysUtils, Classes,
-  blcksock, synautil;
-
-const
-  cTelnetProtocol = '23';
-  cSSHProtocol = '22';
-
-  TLNT_EOR                = #239;
-  TLNT_SE                 = #240;
-  TLNT_NOP                = #241;
-  TLNT_DATA_MARK          = #242;
-  TLNT_BREAK              = #243;
-  TLNT_IP                 = #244;
-  TLNT_AO                 = #245;
-  TLNT_AYT                = #246;
-  TLNT_EC                 = #247;
-  TLNT_EL                 = #248;
-  TLNT_GA                 = #249;
-  TLNT_SB                 = #250;
-  TLNT_WILL               = #251;
-  TLNT_WONT               = #252;
-  TLNT_DO                 = #253;
-  TLNT_DONT               = #254;
-  TLNT_IAC                = #255;
-
-type
-  {:@abstract(State of telnet protocol). Used internaly by TTelnetSend.}
-  TTelnetState =(tsDATA, tsIAC, tsIAC_SB, tsIAC_WILL, tsIAC_DO, tsIAC_WONT,
-     tsIAC_DONT, tsIAC_SBIAC, tsIAC_SBDATA, tsSBDATA_IAC);
-
-  {:@abstract(Class with implementation of Telnet/SSH script client.)
-
-   Note: Are you missing properties for specify server address and port? Look to
-   parent @link(TSynaClient) too!}
-  TTelnetSend = class(TSynaClient)
-  private
-    FSock: TTCPBlockSocket;
-    FBuffer: Ansistring;
-    FState: TTelnetState;
-    FSessionLog: Ansistring;
-    FSubNeg: Ansistring;
-    FSubType: Ansichar;
-    FTermType: Ansistring;
-    function Connect: Boolean;
-    function Negotiate(const Buf: Ansistring): Ansistring;
-    procedure FilterHook(Sender: TObject; var Value: AnsiString);
-  public
-    constructor Create;
-    destructor Destroy; override;
-
-    {:Connects to Telnet server.}
-    function Login: Boolean;
-
-    {:Connects to SSH2 server and login by Username and Password properties.
-
-     You must use some of SSL plugins with SSH support. For exammple CryptLib.}
-    function SSHLogin: Boolean;
-
-    {:Logout from telnet server.}
-    procedure Logout;
-
-    {:Send this data to telnet server.}
-    procedure Send(const Value: string);
-
-    {:Reading data from telnet server until Value is readed. If it is not readed
-     until timeout, result is @false. Otherwise result is @true.}
-    function WaitFor(const Value: string): Boolean;
-
-    {:Read data terminated by terminator from telnet server.}
-    function RecvTerminated(const Terminator: string): string;
-
-    {:Read string from telnet server.}
-    function RecvString: string;
-  published
-    {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
-    property Sock: TTCPBlockSocket read FSock;
-
-    {:all readed datas in this session (from connect) is stored in this large
-     string.}
-    property SessionLog: Ansistring read FSessionLog write FSessionLog;
-
-    {:Terminal type indentification. By default is 'SYNAPSE'.}
-    property TermType: Ansistring read FTermType write FTermType;
-  end;
-
-implementation
-
-constructor TTelnetSend.Create;
-begin
-  inherited Create;
-  FSock := TTCPBlockSocket.Create;
-  FSock.Owner := self;
-  FSock.OnReadFilter := FilterHook;
-  FTimeout := 60000;
-  FTargetPort := cTelnetProtocol;
-  FSubNeg := '';
-  FSubType := #0;
-  FTermType := 'SYNAPSE';
-end;
-
-destructor TTelnetSend.Destroy;
-begin
-  FSock.Free;
-  inherited Destroy;
-end;
-
-function TTelnetSend.Connect: Boolean;
-begin
-  // Do not call this function! It is calling by LOGIN method!
-  FBuffer := '';
-  FSessionLog := '';
-  FState := tsDATA;
-  FSock.CloseSocket;
-  FSock.LineBuffer := '';
-  FSock.Bind(FIPInterface, cAnyPort);
-  FSock.Connect(FTargetHost, FTargetPort);
-  Result := FSock.LastError = 0;
-end;
-
-function TTelnetSend.RecvTerminated(const Terminator: string): string;
-begin
-  Result := FSock.RecvTerminated(FTimeout, Terminator);
-end;
-
-function TTelnetSend.RecvString: string;
-begin
-  Result := FSock.RecvTerminated(FTimeout, CRLF);
-end;
-
-function TTelnetSend.WaitFor(const Value: string): Boolean;
-begin
-  Result := FSock.RecvTerminated(FTimeout, Value) <> '';
-end;
-
-procedure TTelnetSend.FilterHook(Sender: TObject; var Value: AnsiString);
-begin
-  Value := Negotiate(Value);
-  FSessionLog := FSessionLog + Value;
-end;
-
-function TTelnetSend.Negotiate(const Buf: Ansistring): Ansistring;
-var
-  n: integer;
-  c: Ansichar;
-  Reply: Ansistring;
-  SubReply: Ansistring;
-begin
-  Result := '';
-  for n := 1 to Length(Buf) do
-  begin
-    c := Buf[n];
-    Reply := '';
-    case FState of
-      tsData:
-        if c = TLNT_IAC then
-          FState := tsIAC
-        else
-          Result := Result + c;
-
-      tsIAC:
-        case c of
-          TLNT_IAC:
-            begin
-              FState := tsData;
-              Result := Result + TLNT_IAC;
-            end;
-          TLNT_WILL:
-            FState := tsIAC_WILL;
-          TLNT_WONT:
-            FState := tsIAC_WONT;
-          TLNT_DONT:
-            FState := tsIAC_DONT;
-          TLNT_DO:
-            FState := tsIAC_DO;
-          TLNT_EOR:
-            FState := tsDATA;
-          TLNT_SB:
-            begin
-              FState := tsIAC_SB;
-              FSubType := #0;
-              FSubNeg := '';
-            end;
-        else
-          FState := tsData;
-        end;
-
-      tsIAC_WILL:
-        begin
-        case c of
-          #3:  //suppress GA
-            Reply := TLNT_DO;
-        else
-          Reply := TLNT_DONT;
-        end;
-          FState := tsData;
-        end;
-
-      tsIAC_WONT:
-        begin
-          Reply := TLNT_DONT;
-          FState := tsData;
-        end;
-
-      tsIAC_DO:
-      begin
-        case c of
-          #24:  //termtype
-            Reply := TLNT_WILL;
-        else
-          Reply := TLNT_WONT;
-        end;
-        FState := tsData;
-      end;
-
-      tsIAC_DONT:
-      begin
-        Reply := TLNT_WONT;
-        FState := tsData;
-      end;
-
-      tsIAC_SB:
-        begin
-          FSubType := c;
-          FState := tsIAC_SBDATA;
-        end;
-
-      tsIAC_SBDATA:
-        begin
-          if c = TLNT_IAC then
-            FState := tsSBDATA_IAC
-          else
-            FSubNeg := FSubNeg + c;
-        end;
-
-      tsSBDATA_IAC:
-        case c of
-          TLNT_IAC:
-            begin
-              FState := tsIAC_SBDATA;
-              FSubNeg := FSubNeg + c;
-            end;
-          TLNT_SE:
-            begin
-              SubReply := '';
-              case FSubType of
-                #24:  //termtype
-                  begin
-                    if (FSubNeg <> '') and (FSubNeg[1] = #1) then
-                      SubReply := #0 + FTermType;
-                  end;
-              end;
-              Sock.SendString(TLNT_IAC + TLNT_SB + FSubType + SubReply + TLNT_IAC + TLNT_SE);
-              FState := tsDATA;
-            end;
-         else
-           FState := tsDATA;
-         end;
-
-      else
-        FState := tsData;
-    end;
-    if Reply <> '' then
-      Sock.SendString(TLNT_IAC + Reply + c);
-  end;
-
-end;
-
-procedure TTelnetSend.Send(const Value: string);
-begin
-  Sock.SendString(ReplaceString(Value, TLNT_IAC, TLNT_IAC + TLNT_IAC));
-end;
-
-function TTelnetSend.Login: Boolean;
-begin
-  Result := False;
-  if not Connect then
-    Exit;
-  Result := True;
-end;
-
-function TTelnetSend.SSHLogin: Boolean;
-begin
-  Result := False;
-  if Connect then
-  begin
-    FSock.SSL.SSLType := LT_SSHv2;
-    FSock.SSL.Username := FUsername;
-    FSock.SSL.Password := FPassword;
-    FSock.SSLDoConnect;
-    Result := FSock.LastError = 0;
-  end;
-end;
-
-procedure TTelnetSend.Logout;
-begin
-  FSock.CloseSocket;
-end;
-
-
-end.
+{==============================================================================|
+| Project : Ararat Synapse                                       | 001.003.001 |
+|==============================================================================|
+| Content: TELNET and SSH2 client                                              |
+|==============================================================================|
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
+| All rights reserved.                                                         |
+|                                                                              |
+| Redistribution and use in source and binary forms, with or without           |
+| modification, are permitted provided that the following conditions are met:  |
+|                                                                              |
+| Redistributions of source code must retain the above copyright notice, this  |
+| list of conditions and the following disclaimer.                             |
+|                                                                              |
+| Redistributions in binary form must reproduce the above copyright notice,    |
+| this list of conditions and the following disclaimer in the documentation    |
+| and/or other materials provided with the distribution.                       |
+|                                                                              |
+| Neither the name of Lukas Gebauer nor the names of its contributors may      |
+| be used to endorse or promote products derived from this software without    |
+| specific prior written permission.                                           |
+|                                                                              |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
+| DAMAGE.                                                                      |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2002-2010.                |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{:@abstract(Telnet script client)
+
+Used RFC: RFC-854
+}
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+unit tlntsend;
+
+interface
+
+uses
+  SysUtils, Classes,
+  blcksock, synautil;
+
+const
+  cTelnetProtocol = '23';
+  cSSHProtocol = '22';
+
+  TLNT_EOR                = #239;
+  TLNT_SE                 = #240;
+  TLNT_NOP                = #241;
+  TLNT_DATA_MARK          = #242;
+  TLNT_BREAK              = #243;
+  TLNT_IP                 = #244;
+  TLNT_AO                 = #245;
+  TLNT_AYT                = #246;
+  TLNT_EC                 = #247;
+  TLNT_EL                 = #248;
+  TLNT_GA                 = #249;
+  TLNT_SB                 = #250;
+  TLNT_WILL               = #251;
+  TLNT_WONT               = #252;
+  TLNT_DO                 = #253;
+  TLNT_DONT               = #254;
+  TLNT_IAC                = #255;
+
+type
+  {:@abstract(State of telnet protocol). Used internaly by TTelnetSend.}
+  TTelnetState =(tsDATA, tsIAC, tsIAC_SB, tsIAC_WILL, tsIAC_DO, tsIAC_WONT,
+     tsIAC_DONT, tsIAC_SBIAC, tsIAC_SBDATA, tsSBDATA_IAC);
+
+  {:@abstract(Class with implementation of Telnet/SSH script client.)
+
+   Note: Are you missing properties for specify server address and port? Look to
+   parent @link(TSynaClient) too!}
+  TTelnetSend = class(TSynaClient)
+  private
+    FSock: TTCPBlockSocket;
+    FBuffer: Ansistring;
+    FState: TTelnetState;
+    FSessionLog: Ansistring;
+    FSubNeg: Ansistring;
+    FSubType: Ansichar;
+    FTermType: Ansistring;
+    function Connect: Boolean;
+    function Negotiate(const Buf: Ansistring): Ansistring;
+    procedure FilterHook(Sender: TObject; var Value: AnsiString);
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    {:Connects to Telnet server.}
+    function Login: Boolean;
+
+    {:Connects to SSH2 server and login by Username and Password properties.
+
+     You must use some of SSL plugins with SSH support. For exammple CryptLib.}
+    function SSHLogin: Boolean;
+
+    {:Logout from telnet server.}
+    procedure Logout;
+
+    {:Send this data to telnet server.}
+    procedure Send(const Value: string);
+
+    {:Reading data from telnet server until Value is readed. If it is not readed
+     until timeout, result is @false. Otherwise result is @true.}
+    function WaitFor(const Value: string): Boolean;
+
+    {:Read data terminated by terminator from telnet server.}
+    function RecvTerminated(const Terminator: string): string;
+
+    {:Read string from telnet server.}
+    function RecvString: string;
+  published
+    {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
+    property Sock: TTCPBlockSocket read FSock;
+
+    {:all readed datas in this session (from connect) is stored in this large
+     string.}
+    property SessionLog: Ansistring read FSessionLog write FSessionLog;
+
+    {:Terminal type indentification. By default is 'SYNAPSE'.}
+    property TermType: Ansistring read FTermType write FTermType;
+  end;
+
+implementation
+
+constructor TTelnetSend.Create;
+begin
+  inherited Create;
+  FSock := TTCPBlockSocket.Create;
+  FSock.Owner := self;
+  FSock.OnReadFilter := FilterHook;
+  FTimeout := 60000;
+  FTargetPort := cTelnetProtocol;
+  FSubNeg := '';
+  FSubType := #0;
+  FTermType := 'SYNAPSE';
+end;
+
+destructor TTelnetSend.Destroy;
+begin
+  FSock.Free;
+  inherited Destroy;
+end;
+
+function TTelnetSend.Connect: Boolean;
+begin
+  // Do not call this function! It is calling by LOGIN method!
+  FBuffer := '';
+  FSessionLog := '';
+  FState := tsDATA;
+  FSock.CloseSocket;
+  FSock.LineBuffer := '';
+  FSock.Bind(FIPInterface, cAnyPort);
+  FSock.Connect(FTargetHost, FTargetPort);
+  Result := FSock.LastError = 0;
+end;
+
+function TTelnetSend.RecvTerminated(const Terminator: string): string;
+begin
+  Result := FSock.RecvTerminated(FTimeout, Terminator);
+end;
+
+function TTelnetSend.RecvString: string;
+begin
+  Result := FSock.RecvTerminated(FTimeout, CRLF);
+end;
+
+function TTelnetSend.WaitFor(const Value: string): Boolean;
+begin
+  Result := FSock.RecvTerminated(FTimeout, Value) <> '';
+end;
+
+procedure TTelnetSend.FilterHook(Sender: TObject; var Value: AnsiString);
+begin
+  Value := Negotiate(Value);
+  FSessionLog := FSessionLog + Value;
+end;
+
+function TTelnetSend.Negotiate(const Buf: Ansistring): Ansistring;
+var
+  n: integer;
+  c: Ansichar;
+  Reply: Ansistring;
+  SubReply: Ansistring;
+begin
+  Result := '';
+  for n := 1 to Length(Buf) do
+  begin
+    c := Buf[n];
+    Reply := '';
+    case FState of
+      tsData:
+        if c = TLNT_IAC then
+          FState := tsIAC
+        else
+          Result := Result + c;
+
+      tsIAC:
+        case c of
+          TLNT_IAC:
+            begin
+              FState := tsData;
+              Result := Result + TLNT_IAC;
+            end;
+          TLNT_WILL:
+            FState := tsIAC_WILL;
+          TLNT_WONT:
+            FState := tsIAC_WONT;
+          TLNT_DONT:
+            FState := tsIAC_DONT;
+          TLNT_DO:
+            FState := tsIAC_DO;
+          TLNT_EOR:
+            FState := tsDATA;
+          TLNT_SB:
+            begin
+              FState := tsIAC_SB;
+              FSubType := #0;
+              FSubNeg := '';
+            end;
+        else
+          FState := tsData;
+        end;
+
+      tsIAC_WILL:
+        begin
+        case c of
+          #3:  //suppress GA
+            Reply := TLNT_DO;
+        else
+          Reply := TLNT_DONT;
+        end;
+          FState := tsData;
+        end;
+
+      tsIAC_WONT:
+        begin
+          Reply := TLNT_DONT;
+          FState := tsData;
+        end;
+
+      tsIAC_DO:
+      begin
+        case c of
+          #24:  //termtype
+            Reply := TLNT_WILL;
+        else
+          Reply := TLNT_WONT;
+        end;
+        FState := tsData;
+      end;
+
+      tsIAC_DONT:
+      begin
+        Reply := TLNT_WONT;
+        FState := tsData;
+      end;
+
+      tsIAC_SB:
+        begin
+          FSubType := c;
+          FState := tsIAC_SBDATA;
+        end;
+
+      tsIAC_SBDATA:
+        begin
+          if c = TLNT_IAC then
+            FState := tsSBDATA_IAC
+          else
+            FSubNeg := FSubNeg + c;
+        end;
+
+      tsSBDATA_IAC:
+        case c of
+          TLNT_IAC:
+            begin
+              FState := tsIAC_SBDATA;
+              FSubNeg := FSubNeg + c;
+            end;
+          TLNT_SE:
+            begin
+              SubReply := '';
+              case FSubType of
+                #24:  //termtype
+                  begin
+                    if (FSubNeg <> '') and (FSubNeg[1] = #1) then
+                      SubReply := #0 + FTermType;
+                  end;
+              end;
+              Sock.SendString(TLNT_IAC + TLNT_SB + FSubType + SubReply + TLNT_IAC + TLNT_SE);
+              FState := tsDATA;
+            end;
+         else
+           FState := tsDATA;
+         end;
+
+      else
+        FState := tsData;
+    end;
+    if Reply <> '' then
+      Sock.SendString(TLNT_IAC + Reply + c);
+  end;
+
+end;
+
+procedure TTelnetSend.Send(const Value: string);
+begin
+  Sock.SendString(ReplaceString(Value, TLNT_IAC, TLNT_IAC + TLNT_IAC));
+end;
+
+function TTelnetSend.Login: Boolean;
+begin
+  Result := False;
+  if not Connect then
+    Exit;
+  Result := True;
+end;
+
+function TTelnetSend.SSHLogin: Boolean;
+begin
+  Result := False;
+  if Connect then
+  begin
+    FSock.SSL.SSLType := LT_SSHv2;
+    FSock.SSL.Username := FUsername;
+    FSock.SSL.Password := FPassword;
+    FSock.SSLDoConnect;
+    Result := FSock.LastError = 0;
+  end;
+end;
+
+procedure TTelnetSend.Logout;
+begin
+  FSock.CloseSocket;
+end;
+
+
+end.