Fixed issue with settings file being saved in the wrong directory.

Simba now has some parameters (-o/--open to open a file and -r/--run to run that file at startup).
Simba now opens a file correctly if you double click an associated .simb file.
Initalized several TPA-functions-results.. (BoxFromTPA could return random values when sending an empty TPA).
Opening/Creating a 'script' will now happen in a new tab (unless the current tab is the same as the default script)
Restructured the internets unit (+ implemented all of the HTTP-client stuff).
And updated the Synapse units.


git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@538 3f818213-9676-44b0-a9b4-5e4c4e03d09d

trunk/Projects/SAMufasaGUI/simbasettings.pas

@@ -8,9 +8,6 @@ uses
   Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
   ComCtrls, StdCtrls, settings;
 
-const
-   SimbaSettingsFile = 'settings.xml';
-
 type
 
   { TSettingsForm }
@@ -34,6 +31,7 @@ type
 
 var
   SettingsForm: TSettingsForm;
+  SimbaSettingsFile : string;
 
 implementation
 

trunk/Projects/SAMufasaGUI/testunit.pas

@@ -43,7 +43,7 @@ uses
   ColorBox              , about, framefunctionlist, ocr, updateform, simbasettings;
 
 const
-    SimbaVersion = 537;
+    SimbaVersion = 538;
 
 type
 
@@ -342,6 +342,7 @@ type
     procedure RefreshTabSender(sender : PtrInt);
     procedure CreateDefaultEnvironment;
     procedure InitalizeTMThread(var Thread : TMThread);
+    procedure HandleParameters;
   end;
 
   procedure formWriteln( S : String);
@@ -838,6 +839,7 @@ begin
   CreateSetting('Settings/Interpreter/UseCPascal', 'False');
   CreateSetting('Settings/Fonts/LoadOnStartUp', 'True');
   CreateSetting('Settings/Tabs/OpenNextOnClose','False');
+  CreateSetting('Settings/Tabs/OpenScriptInNewTab','True');
   CreateSetting('Settings/ColourPicker/ShowHistoryOnPick', 'True');
   CreateSetting('Settings/Updater/RemoteLink',
                 'http://old.villavu.com/merlijn/Simba'{$IFDEF WINDOWS}+'.exe'{$ENDIF});
@@ -928,6 +930,34 @@ begin
 
 end;
 
+procedure TForm1.HandleParameters;
+var
+  DoRun : Boolean;
+  ErrorMsg : string;
+begin
+  DoRun := false;
+  if Paramcount = 1 then
+  begin
+    if FileExists(ParamStr(1)) then
+      LoadScriptFile(paramstr(1));
+  end else
+  begin;
+    ErrorMsg:=Application.CheckOptions('ro:','run open:');
+    if ErrorMsg <> '' then
+      writeln(ErrorMSG)
+    else
+    begin
+      if Application.HasOption('o','open') then
+      begin;
+        LoadScriptFile(Application.GetOptionValue('o','open'));
+        DoRun:= Application.HasOption('r','run');
+      end;
+    end;
+  end;
+  if DoRun then
+    Self.RunScript;
+end;
+
 
 procedure TForm1.ActionTabLastExecute(Sender: TObject);
 var
@@ -1015,7 +1045,8 @@ end;
 
 procedure TForm1.ActionNewExecute(Sender: TObject);
 begin
-  Self.ClearScript;
+  //Self.ClearScript;
+  Self.AddTab;
 end;
 
 procedure TForm1.ActionNewTabExecute(Sender: TObject);
@@ -1336,7 +1367,8 @@ procedure TForm1.FormCreate(Sender: TObject);
 begin
   Randomize;
   MainDir:= ExtractFileDir(Application.ExeName);
-  if FileExists(MainDir + DS + SimbaSettingsFile) then
+  SimbaSettingsFile := MainDir + DS + 'settings.xml';
+  if FileExists(SimbaSettingsFile) then
     Application.CreateForm(TSettingsForm,SettingsForm)
   else  begin
     Application.CreateForm(TSettingsForm,SettingsForm);
@@ -1368,6 +1400,7 @@ begin
   {$endif}
   frmFunctionList.OnEndDock:= @frmFunctionList.FrameEndDock;
   FirstRun := true;//Our next run is the first run.
+  HandleParameters;
 end;
 
 procedure TForm1.FormDestroy(Sender: TObject);
@@ -1827,14 +1860,19 @@ begin
 end;
 
 function TForm1.OpenScript: boolean;
+var
+  OpenInNewTab : boolean;
 begin
   Result := False;
+  OpenInNewTab:= (LowerCase(LoadSettingDef('Settings/Tabs/OpenScriptInNewTab','True')) = 'true');
+  if not OpenInNewTab then
     if CanExitOrOpen = false then
       Exit;
   with TOpenDialog.Create(nil) do
   try
     Filter:= 'Simba Files|*.simb;*.cogat;*.mufa;*.txt|Any files|*.*';
     if Execute then
+      if FileExists(filename) then
         result := LoadScriptFile(filename);
   finally
     Free;
@@ -1842,9 +1880,14 @@ begin
 end;
 
 function TForm1.LoadScriptFile(FileName : string): boolean;
+var
+  OpenInNewTab : boolean;
 begin
+  OpenInNewTab:= (LowerCase(LoadSettingDef('Settings/Tabs/OpenScriptInNewTab','True')) = 'true');
   if FileExists(FileName) then
   begin;
+    if OpenInNewTab and (CurrScript.SynEdit.Text <> CurrScript.ScriptDefault) then //Add la tab!
+      self.addtab;
     with CurrScript do
     begin
       filename := SetDirSeparators(filename);

trunk/Units/MMLAddon/PSInc/Wrappers/internets.inc

@@ -2,3 +2,47 @@ function ps_GetPage(S: String): String; extdecl;
 begin
   result := GetPage(S);
 end;
+
+function ps_InitializeHTTPClient(HandleCookies, HandleRedirects: Boolean): Integer; extdecl;
+begin
+  result := CurrThread.MInternet.CreateHTTPClient(HandleCookies); extdecl;
+end;
+
+procedure ps_FreeHTTPClient(Client: Integer); extdecl;
+begin;
+  CurrThread.MInternet.GetHTTPClient(Client).Free;
+end;
+
+function ps_GetHTTPPage(Client: Integer; URL: string): string; extdecl;
+begin
+  result := CurrThread.MInternet.GetHTTPClient(Client).GetHTTPPage(url);
+end;
+procedure ps_SetHTTPUserAgent(Client: Integer; Agent: string); extdecl;
+begin
+  CurrThread.MInternet.GetHTTPClient(Client).SetHTTPUserAgent(agent);
+end;
+
+function ps_PostHTTPPage(Client: Integer; Url: string; PostData: string): string; extdecl;
+begin
+  result := CurrThread.MInternet.GetHTTPClient(Client).PostHTTPPage(url,postdata);
+end;
+
+function ps_PostHTTPPageEx(Client: Integer; Url: string): string; extdecl;
+begin
+  result := CurrThread.MInternet.GetHTTPClient(Client).PostHTTPPage(url);
+end;
+
+procedure ps_ClearPostData(Client: Integer); extdecl;
+begin
+  CurrThread.MInternet.GetHTTPClient(Client).ClearPostData;
+end;
+
+procedure ps_AddPostVariable(Client: Integer; VarName, VarValue: string); extdecl;
+begin
+  CurrThread.MInternet.GetHTTPClient(Client).AddPostVariable(varname,varvalue);
+end;
+
+function ps_GetRawHeaders(Client: Integer): string; extdecl;
+begin
+  result := CurrThread.MInternet.GetHTTPClient(client).GetRawHeaders;
+end;

trunk/Units/MMLAddon/PSInc/psexportedmethods.inc

@@ -150,6 +150,16 @@ AddFunction(@ps_Replace,'function ReplaceWrap(Text, FindStr, ReplaceStr: string;
 SetCurrSection('Web');
 AddFunction(@OpenWebPage,'procedure OpenWebPage(url : string);');
 AddFunction(@ps_GetPage,'function GetPage(url : string): string;');
+AddFunction(@ps_InitializeHTTPClient,'function InitializeHTTPClient(HandleCookies, HandleRedirects: Boolean): Integer;');
+AddFunction(@ps_FreeHTTPClient,'procedure FreeHTTPClient(Client: Integer);');
+AddFunction(@ps_GetHTTPPage,'function GetHTTPPage(Client: Integer; URL: string): string;');
+AddFunction(@ps_SetHTTPUserAgent,'procedure SetHTTPUserAgent(Client: Integer; Agent: string);');
+AddFunction(@ps_PostHTTPPage,'function PostHTTPPage(Client: Integer; Url: string; PostData: string): string;');
+AddFunction(@ps_PostHTTPPageEx,'function PostHTTPPageEx(Client: Integer; Url: string): string;');
+AddFunction(@ps_ClearPostData,'procedure ClearPostData(Client: Integer);');
+AddFunction(@ps_AddPostVariable,'procedure AddPostVariable(Client: Integer; VarName, VarValue: string);');
+AddFunction(@ps_GetRawHeaders,'function GetRawHeaders(Client: Integer): string;');
+
 
 
 { Color Conversions and Speed }

trunk/Units/MMLAddon/internets.pas

@@ -5,13 +5,47 @@ unit internets;
 interface
 
 uses
-  Classes, SysUtils;
+  Classes, SysUtils,httpsend;
 
 function GetPage(URL: String): String;
 
+type
+
+  { THTTPClient }
+
+  THTTPClient = class(TObject)
+  private
+    HTTPSend : THTTPSend;
+    fHandleCookies : boolean;
+    PostVariables : TStringList;
+  public
+    procedure SetHTTPUserAgent(agent : string);
+    function GetHTTPPage(url : string ) : string;
+    function PostHTTPPage(Url: string; PostData: string): string;overload;
+    function PostHTTPPage(Url: string): string;overload;
+    function GetRawHeaders: string;
+    procedure ClearPostData;
+    procedure AddPostVariable(VarName, VarValue: string);
+    constructor Create(HandleCookies : boolean = true);
+    destructor Destroy;override;
+  end;
+  { TMInternet }
+  TMInternet = class(TObject)
+  protected
+    Client : TObject;
+    Connections : TList;
+    HTTPClients : TList;
+  public
+    function CreateHTTPClient(HandleCookies : boolean = true) : integer;
+    function GetHTTPClient(Index : integer) : THTTPClient;
+    procedure FreeHTTPClient(Index: Integer);
+    constructor Create(Owner : TObject);
+    destructor Destroy;override;
+  end;
+
 implementation
 uses
-  httpsend;
+  synacode;
 
 { OTHER }
 function GetPage(URL: String): String;
@@ -20,9 +54,133 @@ var
 begin
   s:=TStringList.Create;
   HttpGetText(URL, s);
-  result := String(s.GetText);
+  result := s.Text;
   s.Free;
 end;
 
+{ TMInternet }
+
+function TMInternet.CreateHTTPClient(HandleCookies: boolean = true): integer;
+begin;
+  Result := HTTPClients.Add(THTTPClient.Create(HandleCookies));
+end;
+
+function TMInternet.GetHTTPClient(Index: integer): THTTPClient;
+begin
+  if (index < 0) or (index >= HTTPClients.Count) then
+    raise exception.CreateFmt('GetHTTPClient: Trying to acces an index(%d) that is out of range',[index]);
+  if HTTPClients[index] = nil then
+    raise exception.CreateFmt('GetHTTPClient: Trying to acces an index(%d) that is freed',[index]);
+  result := THTTPClient(httpclients[index]);
+end;
+
+procedure TMInternet.FreeHTTPClient(Index: Integer);
+begin
+  if (index < 0) or (index >= HTTPClients.Count) then
+    raise exception.CreateFmt('FreeHTTPClient: Trying to free an index(%d) that is out of range',[index]);
+  if HTTPClients[index] = nil then
+    raise exception.CreateFmt('FreeHTTPClient: Trying to free an index(%d) that is already freed',[index]);
+  THTTPClient(HTTPClients[index]).Free;
+end;
+
+constructor TMInternet.Create(Owner: TObject);
+begin
+  inherited Create;
+  client := Owner;
+  Connections := TList.Create;
+  HTTPClients := TList.Create;
+end;
+
+destructor TMInternet.Destroy;
+var
+  i : integer;
+begin
+  for i := Connections.Count -1 downto 0 do
+    if Connections[i] <> nil then
+      TObject(Connections[i]).Free;
+  for i := HTTPClients.Count -1 downto 0 do
+    if HTTPClients[i] <> nil then
+      THTTPClient(HTTPClients[i]).Free;
+  Connections.Free;
+  HTTPClients.Free;
+  inherited Destroy;
+end;
+
+{ THTTPClient }
+
+procedure THTTPClient.SetHTTPUserAgent(agent: string);
+begin
+  HTTPSend.UserAgent := agent;
+end;
+
+function THTTPClient.GetHTTPPage(url: string): string;
+begin
+  if not fHandleCookies then
+    HTTPSend.Cookies.Clear;
+  HTTPSend.MimeType :=  'text/html';
+  if HTTPSend.HTTPMethod('GET',url) then
+  begin;
+    SetLength(result,HTTPSend.Document.Size);
+    HTTPSend.Document.Read(result[1],length(result));
+  end else
+    result := '';
+end;
+
+function THTTPClient.PostHTTPPage(Url: string; PostData: string): string;
+begin
+  HTTPSend.MimeType := 'application/x-www-form-urlencoded';
+  HTTPSend.Document.Clear;
+  HTTPSend.Document.Write(Postdata[1],length(postdata));
+  if HTTPSend.HTTPMethod('POST',url) then
+  begin;
+    SetLength(result,HTTPSend.Document.Size);
+    HTTPSend.Document.Read(result[1],Length(result));
+  end else
+    result := '';
+end;
+
+function THTTPClient.PostHTTPPage(Url: string): string;
+var
+  PostData : string;
+  i : integer;
+begin
+  PostData := '';
+  for i := 0 to PostVariables.Count - 1 do
+    PostData := PostData + PostVariables[i] +'&';
+  if Length(PostData) > 1 then
+    setlength(postdata,length(postdata) - 1); //Wipe away that last &
+  result := PostHTTPPage(url,postdata);
+end;
+
+function THTTPClient.GetRawHeaders: string;
+begin
+  Result := HTTPSend.Headers.Text;
+end;
+
+procedure THTTPClient.ClearPostData;
+begin
+  PostVariables.Clear;
+end;
+
+procedure THTTPClient.AddPostVariable(VarName, VarValue: string);
+begin
+  PostVariables.Add(Varname + '=' + VarValue);
+end;
+
+constructor THTTPClient.Create(HandleCookies : boolean = true);
+begin
+  inherited Create;
+  HTTPSend := THTTPSend.Create;
+  fHandleCookies:= HandleCookies;
+  PostVariables := TStringList.Create;
+end;
+
+destructor THTTPClient.Destroy;
+begin
+  HTTPSend.Free;
+  PostVariables.Free;
+  inherited Destroy;
+end;
+
 end.
 

trunk/Units/MMLAddon/mmlpsthread.pas

@@ -32,7 +32,7 @@ interface
 uses
   Classes, SysUtils, client, uPSComponent,uPSCompiler,
   uPSRuntime,stdCtrls, uPSPreProcessor,MufasaTypes, web,
-  bitmaps, plugins, libloader, dynlibs;
+  bitmaps, plugins, libloader, dynlibs,internets;
 
 
 type
@@ -82,6 +82,7 @@ type
 
     public
       Client : TClient;
+      MInternet : TMInternet;
       StartTime : LongWord;
       DebugMemo : TMemo;
 
@@ -184,7 +185,6 @@ uses
   uPSR_extctrls, //Runtime-libs
   Graphics, //For Graphics types
   math, //Maths!
-  internets, // internets
   strutils,
   tpa, //Tpa stuff
   forms,//Forms
@@ -265,6 +265,7 @@ end;
 constructor TMThread.Create(CreateSuspended: boolean; TheSyncInfo: PSyncInfo; plugin_dir: string);
 begin
   Client := TClient.Create(plugin_dir);
+  MInternet := TMInternet.Create(Client);
   SyncInfo:= TheSyncInfo;
   ExportedMethods:= GetExportedMethods;
   FreeOnTerminate := True;
@@ -276,6 +277,7 @@ end;
 
 destructor TMThread.Destroy;
 begin
+  MInternet.Free;
   Client.Free;
   inherited Destroy;
 end;

trunk/Units/MMLCore/client.pas

@@ -51,7 +51,6 @@ It binds all the components together.
             MBitmaps : TMBitmaps;
             MDTM: TMDTM;
             MOCR: TMOCR;
-
     end;
 
 implementation

trunk/Units/MMLCore/tpa.pas

@@ -672,6 +672,7 @@ function MiddleTPA(tpa: TPointArray): TPoint;
 var
    i, l: Integer;
 begin
+  FillChar(result,sizeof(TPoint),0);
   l := High(tpa);
   if (l < 0) then Exit;
   Result.x := 0;
@@ -1073,6 +1074,7 @@ function GetATPABounds(ATPA: T2DPointArray): TBox;
 var
   I,II,L2,L : Integer;
 begin;
+  FillChar(result,sizeof(TBox),0);
   L := High(ATPA);
   if (l < 0) then Exit;
   For I := 0 to L do
@@ -1108,6 +1110,7 @@ function GetTPABounds(TPA: TPointArray): TBox;
 var
   I,L : Integer;
 begin;
+  FillChar(result,sizeof(TBox),0);
   L := High(TPA);
   if (l < 0) then Exit;
   Result.x1 := TPA[0].x;

trunk/Units/Synapse/asn1util.pas

@@ -62,6 +62,11 @@ For sample of using, look to @link(TSnmpSend) or @link(TLdapSend)class.
   {$MODE DELPHI}
 {$ENDIF}
 
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
 unit asn1util;
 
 interface

trunk/Units/Synapse/blcksock.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 009.006.000 |
+| Project : Ararat Synapse                                       | 009.008.002 |
 |==============================================================================|
 | Content: Library base                                                        |
 |==============================================================================|
-| Copyright (c)1999-2008, Lukas Gebauer                                        |
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)1999-2008.                |
+| Portions created by Lukas Gebauer are Copyright (c)1999-2010.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -82,6 +82,18 @@ Core with implementation basic socket classes.
 {$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
@@ -309,6 +321,7 @@ type
     FSocket: TSocket;
     FLastError: Integer;
     FLastErrorDesc: string;
+    FOwner: TObject;
     procedure SetDelayedOption(const Value: TSynaOption);
     procedure DelayedOption(const Value: TSynaOption);
     procedure ProcessDelayedOptions;
@@ -383,6 +396,16 @@ type
      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;
@@ -672,10 +695,13 @@ type
     {:Return value of protocol type for socket creation.}
     function GetSocketProtocol: integer; Virtual;
 
-    {:WSA structure with information about socket provider. On linux is this
+    {:WSA structure with information about socket provider. On non-windows 
-     structure simulated!}
+     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;
 
@@ -821,6 +847,8 @@ type
       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)
@@ -923,10 +951,6 @@ type
     constructor CreateWithSSL(SSLPlugin: TSSLClass);
     destructor Destroy; override;
 
-    {:Return descriptive string for @link(LastError). On case of error
-     in SSL/TLS subsystem, it returns right error description.}
-    function GetErrorDescEx: string; override;
-
     {:See @link(TBlockSocket.CloseSocket)}
     procedure CloseSocket; override;
 
@@ -939,7 +963,7 @@ type
 
      If you use SOCKS, activate incoming TCP connection by this proxy. (By BIND
      method of SOCKS.)}
-    procedure Listen; virtual;
+    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
@@ -948,7 +972,7 @@ type
      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;
+    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
@@ -1017,6 +1041,10 @@ type
     {:@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
@@ -1136,6 +1164,30 @@ type
     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.
 
@@ -1457,6 +1509,7 @@ begin
   FStopFlag := False;
   FNonblockSendTimeout := 15000;
   FHeartbeatRate := 0;
+  FOwner := nil;
 {$IFNDEF ONCEWINSOCK}
   if Stub = '' then
     Stub := DLLStackName;
@@ -1508,7 +1561,7 @@ var
   li: TLinger;
   x: integer;
   buf: TMemory;
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
   timeval: TTimeval;
 {$ENDIF}
 begin
@@ -1558,7 +1611,7 @@ begin
         synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_RCVTIMEO),
           buf, SizeOf(Value.Value));
         {$ELSE}
-          {$IFDEF WIN32}
+          {$IFDEF MSWINDOWS}
         buf := @Value.Value;
         synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_RCVTIMEO),
           buf, SizeOf(Value.Value));
@@ -1575,7 +1628,7 @@ begin
         {$IFDEF CIL}
         buf := System.BitConverter.GetBytes(value.Value);
         {$ELSE}
-          {$IFDEF WIN32}
+          {$IFDEF MSWINDOWS}
         buf := @Value.Value;
         synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_SNDTIMEO),
           buf, SizeOf(Value.Value));
@@ -1840,6 +1893,22 @@ begin
   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);
@@ -2014,6 +2083,7 @@ var
 {$ENDIF}
 begin
   b := true;
+  l := 0;
   if WithSize then
   begin
     l := Stream.Size - Stream.Position;;
@@ -2189,7 +2259,7 @@ begin
   end
   else
   begin
-    {$IFDEF WIN32}
+    {$IFDEF MSWINDOWS}
     //not drain CPU on large downloads...
     Sleep(0);
     {$ENDIF}
@@ -3145,7 +3215,7 @@ end;
 
 function TSocksBlockSocket.SocksOpen: boolean;
 var
-  Buf: string;
+  Buf: AnsiString;
   n: integer;
 begin
   Result := False;
@@ -3175,8 +3245,8 @@ begin
           ;
         2:
           begin
-            Buf := #1 + char(Length(FSocksUsername)) + FSocksUsername
+            Buf := #1 + AnsiChar(Length(FSocksUsername)) + FSocksUsername
-              + char(Length(FSocksPassword)) + FSocksPassword;
+              + AnsiChar(Length(FSocksPassword)) + FSocksPassword;
             SendString(Buf);
             Buf := RecvBufferStr(2, FSocksTimeout);
             if Length(Buf) < 2 then
@@ -3199,14 +3269,14 @@ end;
 function TSocksBlockSocket.SocksRequest(Cmd: Byte;
   const IP, Port: string): Boolean;
 var
-  Buf: string;
+  Buf: AnsiString;
 begin
   FBypassFlag := True;
   try
     if FSocksType <> ST_Socks5 then
-      Buf := #4 + char(Cmd) + SocksCode(IP, Port)
+      Buf := #4 + AnsiChar(Cmd) + SocksCode(IP, Port)
     else
-      Buf := #5 + char(Cmd) + #0 + SocksCode(IP, Port);
+      Buf := #5 + AnsiChar(Cmd) + #0 + SocksCode(IP, Port);
     SendString(Buf);
     Result := FLastError = 0;
   finally
@@ -3216,7 +3286,7 @@ end;
 
 function TSocksBlockSocket.SocksResponse: Boolean;
 var
-  Buf, s: string;
+  Buf, s: AnsiString;
   x: integer;
 begin
   Result := False;
@@ -3249,7 +3319,7 @@ begin
             x := RecvByte(FSocksTimeout);
             if FLastError <> 0 then
               Exit;
-            s := char(x) + RecvBufferStr(x, FSocksTimeout);
+            s := AnsiChar(x) + RecvBufferStr(x, FSocksTimeout);
           end;
         4:
           s := RecvBufferStr(16, FSocksTimeout);
@@ -3304,10 +3374,10 @@ begin
         ip6 := StrToIP6(IP);
         Result := #4;
         for n := 0 to 15 do
-          Result := Result + char(ip6[n]);
+          Result := Result + AnsiChar(ip6[n]);
       end
       else
-        Result := #3 + char(Length(IP)) + IP;
+        Result := #3 + AnsiChar(Length(IP)) + IP;
     Result := Result + CodeInt(ResolvePort(Port));
   end;
 end;
@@ -3667,8 +3737,7 @@ var
 begin
   if FSocksIP = '' then
   begin
-    SockCheck(synsock.Listen(FSocket, SOMAXCONN));
+    inherited Listen;
-    GetSins;
   end
   else
   begin
@@ -3690,9 +3759,9 @@ begin
     FSocksLocalPort := FSocksResponsePort;
     FSocksRemoteIP := '';
     FSocksRemotePort := '';
-  end;
     ExceptCheck;
     DoStatus(HR_Listen, '');
+  end;
 end;
 
 function TTCPBlockSocket.Accept: TSocket;
@@ -3704,14 +3773,13 @@ begin
     FSocksRemoteIP := FSocksResponseIP;
     FSocksRemotePort := FSocksResponsePort;
     Result := FSocket;
+    ExceptCheck;
+    DoStatus(HR_Accept, '');
   end
   else
   begin
-    Result := synsock.Accept(FSocket, FRemoteSin);
+    result := inherited Accept;
-///    SockCheck(Result);
   end;
-  ExceptCheck;
-  DoStatus(HR_Accept, '');
 end;
 
 procedure TTCPBlockSocket.Connect(IP, Port: string);
@@ -3956,6 +4024,30 @@ 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;

trunk/Units/Synapse/clamsend.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.001.000 |
+| Project : Ararat Synapse                                       | 001.001.001 |
 |==============================================================================|
 | Content: ClamAV-daemon client                                                |
 |==============================================================================|
-| Copyright (c)2005-2009, Lukas Gebauer                                        |
+| Copyright (c)2005-2010, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2005-2009.                |
+| Portions created by Lukas Gebauer are Copyright (c)2005-2010.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -54,6 +54,11 @@ daemon from ClamAV. See more about ClamAV on @LINK(http://www.clamav.net)
 {$Q-}
 {$H+}
 
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
 unit clamsend;
 
 interface
@@ -121,7 +126,9 @@ constructor TClamSend.Create;
 begin
   inherited Create;
   FSock := TTCPBlockSocket.Create;
+  FSock.Owner := self;
   FDSock := TTCPBlockSocket.Create;
+  FDSock.Owner := self;
   FTimeout := 60000;
   FTargetPort := cClamProtocol;
   FSession := false;
@@ -247,7 +254,6 @@ end;
 function TClamSend.ScanStream2(const Value: TStream): AnsiString;
 var
   i: integer;
-  s: AnsiString;
 begin
   Result := '';
   if not FSession then

trunk/Units/Synapse/dnssend.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 002.007.004 |
+| Project : Ararat Synapse                                       | 002.007.006 |
 |==============================================================================|
 | Content: DNS client                                                          |
 |==============================================================================|
-| Copyright (c)1999-2007, Lukas Gebauer                                        |
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2000-2007.                |
+| Portions created by Lukas Gebauer are Copyright (c)2000-2010.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -54,6 +54,11 @@ Used RFC: RFC-1035, RFC-1183, RFC1706, RFC1712, RFC2163, RFC2230
 {$Q-}
 {$H+}
 
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
 unit dnssend;
 
 interface
@@ -212,7 +217,9 @@ constructor TDNSSend.Create;
 begin
   inherited Create;
   FSock := TUDPBlockSocket.Create;
+  FSock.Owner := self;
   FTCPSock := TTCPBlockSocket.Create;
+  FTCPSock.Owner := self;
   FUseTCP := False;
   FTimeout := 10000;
   FTargetPort := cDnsProtocol;
@@ -246,13 +253,13 @@ begin
     for n := 1 to Length(Value) do
       if Value[n] = '.' then
       begin
-        Result := Result + Char(Length(s)) + s;
+        Result := Result + AnsiChar(Length(s)) + s;
         s := '';
       end
       else
         s := s + Value[n];
     if s <> '' then
-      Result := Result + Char(Length(s)) + s;
+      Result := Result + AnsiChar(Length(s)) + s;
     Result := Result + #0;
   end;
 end;

trunk/Units/Synapse/ftpsend.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 003.005.001 |
+| Project : Ararat Synapse                                       | 003.005.003 |
 |==============================================================================|
 | Content: FTP client                                                          |
 |==============================================================================|
-| Copyright (c)1999-2008, Lukas Gebauer                                        |
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c) 1999-2008.               |
+| Portions created by Lukas Gebauer are Copyright (c) 1999-2010.               |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -53,6 +53,11 @@ Used RFC: RFC-959, RFC-2228, RFC-2428
 {$ENDIF}
 {$H+}
 
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
 unit ftpsend;
 
 interface
@@ -84,18 +89,17 @@ type
    listing of FTP server.}
   TFTPListRec = class(TObject)
   private
-    FFileName: string;
+    FFileName: String;
     FDirectory: Boolean;
     FReadable: Boolean;
     FFileSize: Longint;
     FFileTime: TDateTime;
     FOriginalLine: string;
     FMask: string;
-    FPermission: string;
+    FPermission: String;
   public
     {: You can assign another TFTPListRec to this object.}
     procedure Assign(Value: TFTPListRec); virtual;
-  published
     {:name of file}
     property FileName: string read FFileName write FFileName;
     {:if name is subdirectory not file.}
@@ -135,16 +139,16 @@ type
     YearTime: string;
     Year: string;
     Hours: string;
-    HoursModif: string;
+    HoursModif: Ansistring;
     Minutes: string;
     Seconds: string;
-    Size: string;
+    Size: Ansistring;
-    Permissions: string;
+    Permissions: Ansistring;
     DirFlag: string;
     function GetListItem(Index: integer): TFTPListRec; virtual;
     function ParseEPLF(Value: string): Boolean; virtual;
     procedure ClearStore; virtual;
-    function ParseByMask(Value, NextValue, Mask: string): Integer; virtual;
+    function ParseByMask(Value, NextValue, Mask: ansistring): Integer; virtual;
     function CheckValues: Boolean; virtual;
     procedure FillRecord(const Value: TFTPListRec); virtual;
   public
@@ -465,8 +469,10 @@ begin
   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;
@@ -508,7 +514,7 @@ end;
 
 function TFTPSend.ReadResult: Integer;
 var
-  s, c: string;
+  s, c: AnsiString;
 begin
   FFullResult.Clear;
   c := '';
@@ -818,7 +824,7 @@ end;
 procedure TFTPSend.ParseRemoteEPSV(Value: string);
 var
   n: integer;
-  s, v: string;
+  s, v: AnsiString;
 begin
   s := SeparateRight(Value, '(');
   s := Trim(SeparateLeft(s, ')'));
@@ -1336,11 +1342,11 @@ begin
   DirFlag := '';
 end;
 
-function TFTPList.ParseByMask(Value, NextValue, Mask: string): Integer;
+function TFTPList.ParseByMask(Value, NextValue, Mask: AnsiString): Integer;
 var
   Ivalue, IMask: integer;
-  MaskC, LastMaskC: Char;
+  MaskC, LastMaskC: AnsiChar;
-  c: char;
+  c: AnsiChar;
   s: string;
 begin
   ClearStore;

trunk/Units/Synapse/ftptsend.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.001.000 |
+| Project : Ararat Synapse                                       | 001.001.001 |
 |==============================================================================|
 | Content: Trivial FTP (TFTP) client and server                                |
 |==============================================================================|
-| Copyright (c)1999-2004, Lukas Gebauer                                        |
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2003-2004.                |
+| Portions created by Lukas Gebauer are Copyright (c)2003-2010.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -53,6 +53,11 @@ Used RFC: RFC-1350
 {$Q-}
 {$H+}
 
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
 unit ftptsend;
 
 interface
@@ -134,6 +139,7 @@ constructor TTFTPSend.Create;
 begin
   inherited Create;
   FSock := TUDPBlockSocket.Create;
+  FSock.Owner := self;
   FTargetPort := cTFTPProtocol;
   FData := TMemoryStream.Create;
   FErrorCode := 0;

trunk/Units/Synapse/httpsend.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 003.012.002 |
+| Project : Ararat Synapse                                       | 003.012.004 |
 |==============================================================================|
 | Content: HTTP client                                                         |
 |==============================================================================|
-| Copyright (c)1999-2008, Lukas Gebauer                                        |
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c) 1999-2008.               |
+| Portions created by Lukas Gebauer are Copyright (c) 1999-2010.               |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -51,6 +51,17 @@ Used RFC: RFC-1867, RFC-1947, RFC-2388, RFC-2616
   {$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;
 
@@ -264,6 +275,7 @@ begin
   FCookies := TStringList.Create;
   FDocument := TMemoryStream.Create;
   FSock := TTCPBlockSocket.Create;
+  FSock.Owner := self;
   FSock.ConvertLineEnd := True;
   FSock.SizeRecvBuffer := c64k;
   FSock.SizeSendBuffer := c64k;
@@ -321,7 +333,7 @@ begin
   if FProtocol = '0.9' then
     Result := FHeaders[0] + CRLF
   else
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
     Result := AdjustLineBreaks(FHeaders.Text, tlbsCRLF);
 {$ELSE}
     Result := FHeaders.Text;

trunk/Units/Synapse/imapsend.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 002.005.001 |
+| Project : Ararat Synapse                                       | 002.005.002 |
 |==============================================================================|
 | Content: IMAP4rev1 client                                                    |
 |==============================================================================|
-| Copyright (c)1999-2004, Lukas Gebauer                                        |
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2001-2004.                |
+| Portions created by Lukas Gebauer are Copyright (c)2001-2010.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -52,6 +52,11 @@ Used RFC: RFC-2060, RFC-2595
 {$ENDIF}
 {$H+}
 
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
 unit imapsend;
 
 interface
@@ -269,6 +274,7 @@ begin
   FFullResult := TStringList.Create;
   FIMAPcap := TStringList.Create;
   FSock := TTCPBlockSocket.Create;
+  FSock.Owner := self;
   FSock.ConvertLineEnd := True;
   FSock.SizeRecvBuffer := 32768;
   FSock.SizeSendBuffer := 32768;

trunk/Units/Synapse/ldapsend.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.006.001 |
+| Project : Ararat Synapse                                       | 001.007.000 |
 |==============================================================================|
 | Content: LDAP client                                                         |
 |==============================================================================|
-| Copyright (c)1999-2009, Lukas Gebauer                                        |
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2003-2009.                |
+| Portions created by Lukas Gebauer are Copyright (c)2003-2010.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -52,6 +52,11 @@ Used RFC: RFC-2251, RFC-2254, RFC-2829, RFC-2830
 {$ENDIF}
 {$H+}
 
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
 unit ldapsend;
 
 interface
@@ -124,6 +129,8 @@ type
     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;
@@ -391,6 +398,17 @@ 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;
@@ -499,6 +517,7 @@ begin
   FReferals := TStringList.Create;
   FFullResult := '';
   FSock := TTCPBlockSocket.Create;
+  FSock.Owner := self;
   FTimeout := 60000;
   FTargetPort := cLDAPProtocol;
   FAutoTLS := False;

trunk/Units/Synapse/mimeinln.pas

@@ -53,6 +53,11 @@ Used RFC: RFC-2047, RFC-2231
 {$ENDIF}
 {$H+}
 
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
 unit mimeinln;
 
 interface

trunk/Units/Synapse/mimepart.pas

@@ -55,6 +55,11 @@ Used RFC: RFC-2045
 {$Q-}
 {$R-}
 
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
 unit mimepart;
 
 interface

trunk/Units/Synapse/nntpsend.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.005.001 |
+| Project : Ararat Synapse                                       | 001.005.002 |
 |==============================================================================|
 | Content: NNTP client                                                         |
 |==============================================================================|
-| Copyright (c)1999-2007, Lukas Gebauer                                        |
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c) 1999-2007.               |
+| Portions created by Lukas Gebauer are Copyright (c) 1999-2010.               |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -53,6 +53,12 @@ Used RFC: RFC-977, RFC-2980
 {$ENDIF}
 {$H+}
 
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+  {$WARN SUSPICIOUS_TYPECAST OFF}
+{$ENDIF}
+
 unit nntpsend;
 
 interface
@@ -195,6 +201,7 @@ constructor TNNTPSend.Create;
 begin
   inherited Create;
   FSock := TTCPBlockSocket.Create;
+  FSock.Owner := self;
   FData := TStringList.Create;
   FDataToSend := TStringList.Create;
   FNNTPcap := TStringList.Create;

trunk/Units/Synapse/pingsend.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 004.000.000 |
+| Project : Ararat Synapse                                       | 004.000.002 |
 |==============================================================================|
 | Content: PING sender                                                         |
 |==============================================================================|
-| Copyright (c)1999-2007, Lukas Gebauer                                        |
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2000-2007.                |
+| Portions created by Lukas Gebauer are Copyright (c)2000-2010.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -66,6 +66,17 @@ Note: This unit is NOT portable to .NET!
 {$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;
 
@@ -74,7 +85,7 @@ interface
 uses
   SysUtils,
   synsock, blcksock, synautil, synafpc, synaip
-{$IFDEF WIN32}
+{$IFDEF MSWINDOWS}
   , windows
 {$ENDIF}
   ;
@@ -107,7 +118,7 @@ type
   TPINGSend = class(TSynaClient)
   private
     FSock: TICMPBlockSocket;
-    FBuffer: string;
+    FBuffer: Ansistring;
     FSeq: Integer;
     FId: Integer;
     FPacketSize: Integer;
@@ -122,8 +133,8 @@ type
     FReplyErrorDesc: string;
     FTTL: Byte;
     Fsin: TVarSin;
-    function Checksum(Value: string): Word;
+    function Checksum(Value: AnsiString): Word;
-    function Checksum6(Value: string): Word;
+    function Checksum6(Value: AnsiString): Word;
     function ReadPacket: Boolean;
     procedure TranslateError;
     procedure TranslateErrorIpHlp(value: integer);
@@ -184,7 +195,7 @@ implementation
 
 type
   {:Record for ICMP ECHO packet header.}
-  TIcmpEchoHeader = record
+  TIcmpEchoHeader = packed record
     i_type: Byte;
     i_code: Byte;
     i_checkSum: Word;
@@ -195,7 +206,7 @@ type
 
   {:record used internally by TPingSend for compute checksum of ICMPv6 packet
    pseudoheader.}
-  TICMP6Packet = record
+  TICMP6Packet = packed record
     in_source: TInAddr6;
     in_dest: TInAddr6;
     Length: integer;
@@ -205,20 +216,20 @@ type
     proto: Byte;
   end;
 
-{$IFDEF WIN32}
+{$IFDEF MSWINDOWS}
 const
   DLLIcmpName = 'iphlpapi.dll';
 type
-  TIP_OPTION_INFORMATION = packed record
+  TIP_OPTION_INFORMATION = record
     TTL: Byte;
     TOS: Byte;
     Flags: Byte;
     OptionsSize: Byte;
-    OptionsData: PChar;
+    OptionsData: PAnsiChar;
   end;
   PIP_OPTION_INFORMATION = ^TIP_OPTION_INFORMATION;
 
-  TICMP_ECHO_REPLY = packed record
+  TICMP_ECHO_REPLY = record
     Address: TInAddr;
     Status: integer;
     RoundTripTime: integer;
@@ -229,7 +240,7 @@ type
   end;
   PICMP_ECHO_REPLY = ^TICMP_ECHO_REPLY;
 
-  TICMPV6_ECHO_REPLY = packed record
+  TICMPV6_ECHO_REPLY = record
     Address: TSockAddrIn6;
     Status: integer;
     RoundTripTime: integer;
@@ -264,6 +275,7 @@ constructor TPINGSend.Create;
 begin
   inherited Create;
   FSock := TICMPBlockSocket.Create;
+  FSock.Owner := self;
   FTimeout := 5000;
   FPacketSize := 32;
   FSeq := 0;
@@ -331,7 +343,7 @@ begin
   FReplyError := IE_Other;
   GenErrorDesc;
   FBuffer := StringOfChar(#55, SizeOf(TICMPEchoHeader) + FPacketSize);
-{$IFDEF WIN32}
+{$IFDEF MSWINDOWS}
   b := IsHostIP6(host);
   if not(b) and IcmpHelper4 then
     result := InternalPingIpHlp(host)
@@ -399,7 +411,7 @@ begin
       break;
     if fSock.IP6used then
     begin
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
       IcmpEchoHeaderPtr := Pointer(FBuffer);
 {$ELSE}
 //WinXP SP1 with networking update doing this think by another way ;-O
@@ -436,7 +448,7 @@ begin
     end;
 end;
 
-function TPINGSend.Checksum(Value: string): Word;
+function TPINGSend.Checksum(Value: AnsiString): Word;
 var
   CkSum: integer;
   Num, Remain: Integer;
@@ -458,7 +470,7 @@ begin
   Result := Word(not CkSum);
 end;
 
-function TPINGSend.Checksum6(Value: string): Word;
+function TPINGSend.Checksum6(Value: AnsiString): Word;
 const
   IOC_OUT = $40000000;
   IOC_IN = $80000000;
@@ -467,13 +479,13 @@ const
   SIO_ROUTING_INTERFACE_QUERY = 20 or IOC_WS2 or IOC_INOUT;
 var
   ICMP6Ptr: ^TICMP6Packet;
-  s: string;
+  s: AnsiString;
   b: integer;
   ip6: TSockAddrIn6;
   x: integer;
 begin
   Result := 0;
-{$IFDEF WIN32}
+{$IFDEF MSWINDOWS}
   s := StringOfChar(#0, SizeOf(TICMP6Packet)) + Value;
   ICMP6Ptr := Pointer(s);
   x := synsock.WSAIoctl(FSock.Socket, SIO_ROUTING_INTERFACE_QUERY,
@@ -565,13 +577,13 @@ begin
 end;
 
 function TPINGSend.InternalPingIpHlp(const Host: string): Boolean;
-{$IFDEF WIN32}
+{$IFDEF MSWINDOWS}
 var
   PingIp6: boolean;
   PingHandle: integer;
   r: integer;
   ipo: TIP_OPTION_INFORMATION;
-  RBuff: string;
+  RBuff: Ansistring;
   ip4reply: PICMP_ECHO_REPLY;
   ip6reply: PICMPV6_ECHO_REPLY;
   ip6: TSockAddrIn6;
@@ -595,7 +607,7 @@ begin
       begin
         FillChar(ip6, sizeof(ip6), 0);
         r := Icmp6SendEcho2(PingHandle, nil, nil, nil, @ip6, @Fsin,
-          Pchar(FBuffer), length(FBuffer), @ipo, pchar(RBuff), length(RBuff), FTimeout);
+          PAnsichar(FBuffer), length(FBuffer), @ipo, pAnsichar(RBuff), length(RBuff), FTimeout);
         if r > 0 then
         begin
           RBuff := #0 + #0 + RBuff;
@@ -610,7 +622,7 @@ begin
       else
       begin
         r := IcmpSendEcho2(PingHandle, nil, nil, nil, Fsin.sin_addr,
-          Pchar(FBuffer), length(FBuffer), @ipo, pchar(RBuff), length(RBuff), FTimeout);
+          PAnsichar(FBuffer), length(FBuffer), @ipo, pAnsichar(RBuff), length(RBuff), FTimeout);
         if r > 0 then
         begin
           ip4reply := PICMP_ECHO_REPLY(pointer(RBuff));
@@ -678,7 +690,7 @@ begin
   end;
 end;
 
-{$IFDEF WIN32}
+{$IFDEF MSWINDOWS}
 initialization
 begin
   IcmpHelper4 := false;

trunk/Units/Synapse/pop3send.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 002.006.000 |
+| Project : Ararat Synapse                                       | 002.006.002 |
 |==============================================================================|
 | Content: POP3 client                                                         |
 |==============================================================================|
-| Copyright (c)1999-2007, Lukas Gebauer                                        |
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2001-2007.                |
+| Portions created by Lukas Gebauer are Copyright (c)2001-2010.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -51,6 +51,12 @@ Used RFC: RFC-1734, RFC-1939, RFC-2195, RFC-2449, RFC-2595
   {$MODE DELPHI}
 {$ENDIF}
 {$H+}
+{$M+}
+
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
 
 unit pop3send;
 
@@ -203,6 +209,7 @@ begin
   FFullResult := TStringList.Create;
   FPOP3cap := TStringList.Create;
   FSock := TTCPBlockSocket.Create;
+  FSock.Owner := self;
   FSock.ConvertLineEnd := true;
   FTimeout := 60000;
   FTargetPort := cPop3Protocol;
@@ -224,7 +231,7 @@ end;
 
 function TPOP3Send.ReadResult(Full: Boolean): Integer;
 var
-  s: string;
+  s: AnsiString;
 begin
   Result := 0;
   FFullResult.Clear;

trunk/Units/Synapse/slogsend.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.002.002 |
+| Project : Ararat Synapse                                       | 001.002.003 |
 |==============================================================================|
 | Content: SysLog client                                                       |
 |==============================================================================|
-| Copyright (c)1999-2003, Lukas Gebauer                                        |
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2001-2003.                |
+| Portions created by Lukas Gebauer are Copyright (c)2001-2010.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -264,6 +264,7 @@ constructor TSyslogSend.Create;
 begin
   inherited Create;
   FSock := TUDPBlockSocket.Create;
+  FSock.Owner := self;
   FSysLogMessage := TSysLogMessage.Create;
   FTargetPort := cSysLogProtocol;
 end;

trunk/Units/Synapse/smtpsend.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 003.005.000 |
+| Project : Ararat Synapse                                       | 003.005.001 |
 |==============================================================================|
 | Content: SMTP client                                                         |
 |==============================================================================|
-| Copyright (c)1999-2009, Lukas Gebauer                                        |
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c) 1999-2009.               |
+| Portions created by Lukas Gebauer are Copyright (c) 1999-2010.               |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -53,6 +53,11 @@ Used RFC: RFC-1869, RFC-1870, RFC-1893, RFC-2034, RFC-2104, RFC-2195, RFC-2487,
 {$ENDIF}
 {$H+}
 
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
 unit smtpsend;
 
 interface
@@ -261,6 +266,7 @@ begin
   FFullResult := TStringList.Create;
   FESMTPcap := TStringList.Create;
   FSock := TTCPBlockSocket.Create;
+  FSock.Owner := self;
   FSock.ConvertLineEnd := true;
   FTimeout := 60000;
   FTargetPort := cSmtpProtocol;
@@ -315,7 +321,7 @@ end;
 
 function TSMTPSend.ReadResult: Integer;
 var
-  s: string;
+  s: String;
 begin
   Result := 0;
   FFullResult.Clear;

trunk/Units/Synapse/snmpsend.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 003.000.009 |
+| Project : Ararat Synapse                                       | 003.000.010 |
 |==============================================================================|
 | Content: SNMP client                                                         |
 |==============================================================================|
-| Copyright (c)1999-2007, Lukas Gebauer                                        |
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2000-2007.                |
+| Portions created by Lukas Gebauer are Copyright (c)2000-2010.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -56,6 +56,11 @@ Used RFC: RFC-1157, RFC-1901, RFC-3412, RFC-3414, RFC-3416
 {$Q-}
 {$H+}
 
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
 unit snmpsend;
 
 interface
@@ -771,6 +776,7 @@ begin
   FQuery.Clear;
   FReply.Clear;
   FSock := TUDPBlockSocket.Create;
+  FSock.Owner := self;
   FTimeout := 5000;
   FTargetPort := cSnmpProtocol;
   FHostIP := '';

trunk/Units/Synapse/sntpsend.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 003.000.002 |
+| Project : Ararat Synapse                                       | 003.000.003 |
 |==============================================================================|
 | Content: SNTP client                                                         |
 |==============================================================================|
-| Copyright (c)1999-2007, Lukas Gebauer                                        |
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2000-2007.                |
+| Portions created by Lukas Gebauer are Copyright (c)2000-2010.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -101,7 +101,7 @@ type
     FMaxSyncDiff: double;
     FSyncTime: Boolean;
     FSock: TUDPBlockSocket;
-    FBuffer: string;
+    FBuffer: AnsiString;
     FLi, FVn, Fmode : byte;
     function StrToNTP(const Value: AnsiString): TNtp;
     function NTPtoStr(const Value: Tntp): AnsiString;
@@ -162,6 +162,7 @@ constructor TSNTPSend.Create;
 begin
   inherited Create;
   FSock := TUDPBlockSocket.Create;
+  FSock.Owner := self;
   FTimeout := 5000;
   FTargetPort := cNtpProtocol;
   FMaxSyncDiff := 3600;

trunk/Units/Synapse/ssfpc.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.001.000 |
+| Project : Ararat Synapse                                       | 001.001.001 |
 |==============================================================================|
 | Content: Socket Independent Platform Layer - FreePascal definition include   |
 |==============================================================================|
-| Copyright (c)2006-2009, Lukas Gebauer                                        |
+| Copyright (c)2006-2010, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2006-2009.                |
+| Portions created by Lukas Gebauer are Copyright (c)2006-2010.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -113,6 +113,7 @@ const
   IPPROTO_UDP    =   17;	{ User Datagram Protocol		}
   IPPROTO_IPV6   =   41;
   IPPROTO_ICMPV6 =   58;
+  IPPROTO_RM     =  113;
 
   IPPROTO_RAW    =   255;
   IPPROTO_MAX    =   256;

trunk/Units/Synapse/ssl_openssl.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.001.000 |
+| Project : Ararat Synapse                                       | 001.001.001 |
 |==============================================================================|
 | Content: SSL support by OpenSSL                                              |
 |==============================================================================|
@@ -80,6 +80,11 @@ accepting of new connections!
 {$ENDIF}
 {$H+}
 
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
 unit ssl_openssl;
 
 interface
@@ -615,8 +620,7 @@ begin
     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
+    Result := 0;
-  else
   if (err <> 0) then
     FLastError := err;
 end;

trunk/Units/Synapse/ssl_openssl_lib.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 003.005.000 |
+| Project : Ararat Synapse                                       | 003.006.001 |
 |==============================================================================|
 | Content: SSL support by OpenSSL                                              |
 |==============================================================================|
-| Copyright (c)1999-2008, Lukas Gebauer                                        |
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2002-2008.                |
+| Portions created by Lukas Gebauer are Copyright (c)2002-2010.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -60,6 +60,13 @@ Special thanks to Gregor Ibic <gregor.ibic@intelicom.si>
   (*$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).
@@ -77,7 +84,7 @@ uses
 {$ENDIF}
   Classes,
   synafpc,
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
   Libc, SysUtils;
 {$ELSE}
   Windows;
@@ -95,7 +102,7 @@ const
   {$ENDIF}
 {$ELSE}
 var
-  {$IFNDEF WIN32}
+  {$IFNDEF MSWINDOWS}
   DLLSSLName: string = 'libssl.so';
   DLLUtilName: string = 'libcrypto.so';
   {$ELSE}
@@ -319,6 +326,11 @@ var
     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')]
@@ -674,6 +686,7 @@ var
   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;
@@ -782,6 +795,7 @@ type
   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;
@@ -880,6 +894,7 @@ var
   _SslCtxSetDefaultPasswdCb: TSslCtxSetDefaultPasswdCb = nil;
   _SslCtxSetDefaultPasswdCbUserdata: TSslCtxSetDefaultPasswdCbUserdata = nil;
   _SslCtxLoadVerifyLocations: TSslCtxLoadVerifyLocations = nil;
+  _SslCtxCtrl: TSslCtxCtrl = nil;
   _SslNew: TSslNew = nil;
   _SslFree: TSslFree = nil;
   _SslAccept: TSslAccept = nil;
@@ -1135,6 +1150,14 @@ begin
     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
@@ -1352,7 +1375,7 @@ procedure ErrErrorString(e: integer; var buf: Ansistring; len: integer);
 begin
   if InitSSLInterface and Assigned(_ErrErrorString) then
     _ErrErrorString(e, Pointer(buf), len);
-  buf := PChar(Buf);
+  buf := PAnsiChar(Buf);
 end;
 
 function ErrGetError: integer;
@@ -1736,6 +1759,7 @@ begin
         _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');
@@ -1919,6 +1943,7 @@ begin
     _SslCtxSetDefaultPasswdCb := nil;
     _SslCtxSetDefaultPasswdCbUserdata := nil;
     _SslCtxLoadVerifyLocations := nil;
+    _SslCtxCtrl := nil;
     _SslNew := nil;
     _SslFree := nil;
     _SslAccept := nil;

trunk/Units/Synapse/sslinux.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 002.000.008 |
+| Project : Ararat Synapse                                       | 002.000.009 |
 |==============================================================================|
 | Content: Socket Independent Platform Layer - Linux definition include        |
 |==============================================================================|
-| Copyright (c)1999-2003, Lukas Gebauer                                        |
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2003.                     |
+| Portions created by Lukas Gebauer are Copyright (c)2003-2010.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -129,6 +129,7 @@ const
   IPPROTO_UDP    =   17;	{ User Datagram Protocol		}
   IPPROTO_IPV6   =   41;
   IPPROTO_ICMPV6 =   58;
+  IPPROTO_RM     =  113;
 
   IPPROTO_RAW    =   255;
   IPPROTO_MAX    =   256;

trunk/Units/Synapse/sswin32.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 002.002.000 |
+| Project : Ararat Synapse                                       | 002.002.003 |
 |==============================================================================|
 | Content: Socket Independent Platform Layer - Win32 definition include        |
 |==============================================================================|
-| Copyright (c)1999-2008, Lukas Gebauer                                        |
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2003.                     |
+| Portions created by Lukas Gebauer are Copyright (c)2003-2010.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -44,8 +44,6 @@
 
 {:@exclude}
 
-{$IFDEF WIN32}
-
 //{$DEFINE WINSOCK1}
 {Note about define WINSOCK1:
 If you activate this compiler directive, then socket interface level 1.1 is
@@ -260,7 +258,11 @@ type
   u_long = Longint;
   pu_long = ^u_long;
   pu_short = ^u_short;
+{$IFDEF FPC}
+  TSocket = ptruint;
+{$ELSE}
   TSocket = u_int;
+{$ENDIF}
   TAddrFamily = integer;
 
   TMemory = pointer;
@@ -286,7 +288,7 @@ const
   FD_SETSIZE     =   64;
 type
   PFDSet = ^TFDSet;
-  TFDSet = packed record
+  TFDSet = record
     fd_count: u_int;
     fd_array: array[0..FD_SETSIZE-1] of TSocket;
   end;
@@ -298,7 +300,7 @@ const
 
 type
   PTimeVal = ^TTimeVal;
-  TTimeVal = packed record
+  TTimeVal = record
     tv_sec: Longint;
     tv_usec: Longint;
   end;
@@ -311,6 +313,7 @@ const
   IPPROTO_UDP    =   17;	{ User Datagram Protocol		}
   IPPROTO_IPV6   =   41;
   IPPROTO_ICMPV6 =   58;
+  IPPROTO_RM     =  113;
 
   IPPROTO_RAW    =   255;
   IPPROTO_MAX    =   256;
@@ -318,14 +321,14 @@ const
 type
 
   PInAddr = ^TInAddr;
-  TInAddr = packed record
+  TInAddr = record
     case integer of
       0: (S_bytes: packed array [0..3] of byte);
       1: (S_addr: u_long);
   end;
 
   PSockAddrIn = ^TSockAddrIn;
-  TSockAddrIn = packed record
+  TSockAddrIn = record
     case Integer of
       0: (sin_family: u_short;
           sin_port: u_short;
@@ -341,7 +344,7 @@ type
   end;
 
   PInAddr6 = ^TInAddr6;
-  TInAddr6 = packed record
+  TInAddr6 = record
     case integer of
       0: (S6_addr: packed array [0..15] of byte);
       1: (u6_addr8: packed array [0..15] of byte);
@@ -350,7 +353,7 @@ type
   end;
 
   PSockAddrIn6 = ^TSockAddrIn6;
-  TSockAddrIn6 = packed record
+  TSockAddrIn6 = record
 		sin6_family:   u_short;     // AF_INET6
 		sin6_port:     u_short;     // Transport level port number
 		sin6_flowinfo: u_long;	    // IPv6 flow information
@@ -366,7 +369,7 @@ type
   end;
 
   PHostEnt = ^THostEnt;
-  THostEnt = packed record
+  THostEnt = record
     h_name: PAnsiChar;
     h_aliases: ^PAnsiChar;
     h_addrtype: Smallint;
@@ -377,7 +380,7 @@ type
   end;
 
   PNetEnt = ^TNetEnt;
-  TNetEnt = packed record
+  TNetEnt = record
     n_name: PAnsiChar;
     n_aliases: ^PAnsiChar;
     n_addrtype: Smallint;
@@ -385,15 +388,20 @@ type
   end;
 
   PServEnt = ^TServEnt;
-  TServEnt = packed record
+  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 = packed record
+  TProtoEnt = record
     p_name: PAnsiChar;
     p_aliases: ^PAnsichar;
     p_proto: Smallint;
@@ -526,7 +534,7 @@ type
 
   { Structure used by kernel to pass protocol information in raw sockets. }
   PSockProto = ^TSockProto;
-  TSockProto = packed record
+  TSockProto = record
     sp_family: u_short;
     sp_protocol: u_short;
   end;
@@ -553,7 +561,7 @@ const
 type
 { Structure used for manipulating linger option. }
   PLinger = ^TLinger;
-  TLinger = packed record
+  TLinger = record
     l_onoff: u_short;
     l_linger: u_short;
   end;
@@ -715,14 +723,22 @@ const
   WSASYS_STATUS_LEN      =   128;
 type
   PWSAData = ^TWSAData;
-  TWSAData = packed record
+  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;
@@ -1167,10 +1183,10 @@ begin
       Sin.sin_family := AF_INET;
       ProtoEnt := synsock.GetProtoByNumber(SockProtocol);
       ServEnt := nil;
-      if ProtoEnt <> nil then
+      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(Port, 0))
+        Sin.sin_port := synsock.htons(StrToIntDef(string(Port), 0))
       else
         Sin.sin_port := ServEnt^.s_port;
       if IP = cBroadcast then
@@ -1282,7 +1298,7 @@ var
   IP: u_long;
   PAdrPtr: PaPInAddr;
   i: Integer;
-  s: AnsiString;
+  s: String;
   InAddr: TInAddr;
 begin
   IPList.Clear;
@@ -1312,7 +1328,7 @@ begin
       end;
     end
     else
-      IPList.Add(Name);
+      IPList.Add(string(Name));
   end
   else
   begin
@@ -1342,7 +1358,7 @@ begin
             if r = 0 then
             begin
               host := PAnsiChar(host);
-              IPList.Add(host);
+              IPList.Add(string(host));
             end;
           end;
           AddrNext := AddrNext^.ai_next;
@@ -1375,7 +1391,7 @@ begin
       if ProtoEnt <> nil then
         ServEnt := synsock.GetServByName(PAnsiChar(Port), ProtoEnt^.p_name);
       if ServEnt = nil then
-        Result := StrToIntDef(Port, 0)
+        Result := StrToIntDef(string(Port), 0)
       else
         Result := synsock.htons(ServEnt^.s_port);
     finally
@@ -1581,5 +1597,3 @@ finalization
 begin
   SynSockCS.Free;
 end;
-
-{$ENDIF}

trunk/Units/Synapse/synachar.pas

@@ -60,6 +60,11 @@ Internal routines knows all major charsets for Europe or America. For East-Asian
 {$Q-}
 {$H+}
 
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
 unit synachar;
 
 interface

trunk/Units/Synapse/synacode.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 002.002.000 |
+| Project : Ararat Synapse                                       | 002.002.001 |
 |==============================================================================|
 | Content: Coding and decoding support                                         |
 |==============================================================================|
-| Copyright (c)1999-2007, Lukas Gebauer                                        |
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2000-2007.                |
+| Portions created by Lukas Gebauer are Copyright (c)2000-2010.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -50,6 +50,12 @@
 {$R-}
 {$H+}
 
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+  {$WARN SUSPICIOUS_TYPECAST OFF}
+{$ENDIF}
+
 unit synacode;
 
 interface
@@ -66,7 +72,7 @@ const
   ['=', '(', ')', '[', ']', '<', '>', ':', ';', ',', '@', '/', '?', '\',
     '"', '_'];
   NonAsciiChar: TSpecials =
-  [Char(0)..Char(31), Char(127)..Char(255)];
+  [#0..#31, #127..#255];
   URLFullSpecialChar: TSpecials =
   [';', '/', '?', ':', '@', '=', '&', '#', '+'];
   URLSpecialChar: TSpecials =

trunk/Units/Synapse/synacrypt.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.000.000 |
+| Project : Ararat Synapse                                       | 001.000.001 |
 |==============================================================================|
 | Content: Encryption support                                                  |
 |==============================================================================|
-| Copyright (c)2007, Lukas Gebauer                                             |
+| Copyright (c)2007-2010, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2007.                     |
+| Portions created by Lukas Gebauer are Copyright (c)2007-2010.                |
 | All Rights Reserved.                                                         |
 | Based on work of David Barton and Eric Young                                 |
 |==============================================================================|
@@ -56,6 +56,11 @@ Implemented are DES and 3DES encryption/decryption by ECB, CBC, CFB-8bit,
 {$R-}
 {$H+}
 
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
 unit synacrypt;
 
 interface

trunk/Units/Synapse/synadbg.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.001.000 |
+| Project : Ararat Synapse                                       | 001.001.001 |
 |==============================================================================|
 | Content: Socket debug tools                                                  |
 |==============================================================================|
-| Copyright (c)2008, Lukas Gebauer                                             |
+| Copyright (c)2008-2010, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2008.                     |
+| Portions created by Lukas Gebauer are Copyright (c)2008-2010.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -47,6 +47,10 @@
 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;
 

trunk/Units/Synapse/synafpc.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.001.001 |
+| Project : Ararat Synapse                                       | 001.001.002 |
 |==============================================================================|
 | Content: Utils for FreePascal compatibility                                  |
 |==============================================================================|
-| Copyright (c)1999-2007, Lukas Gebauer                                        |
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2003-2007.                |
+| Portions created by Lukas Gebauer are Copyright (c)2003-2010.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -48,6 +48,12 @@
   {$MODE DELPHI}
 {$ENDIF}
 {$H+}
+//old Delphi does not have MSWINDOWS define.
+{$IFDEF WIN32}
+  {$IFNDEF MSWINDOWS}
+    {$DEFINE MSWINDOWS}
+  {$ENDIF}
+{$ENDIF}
 
 unit synafpc;
 
@@ -57,7 +63,7 @@ uses
 {$IFDEF FPC}
   dynlibs, sysutils;
 {$ELSE}
-  {$IFDEF WIN32}
+  {$IFDEF MSWINDOWS}
   Windows;
   {$ELSE}
   SysUtils;
@@ -116,7 +122,7 @@ end;
 
 procedure Sleep(milliseconds: Cardinal);
 begin
-{$IFDEF WIN32}
+{$IFDEF MSWINDOWS}
   {$IFDEF FPC}
   sysutils.sleep(milliseconds);
   {$ELSE}

trunk/Units/Synapse/synaicnv.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.001.000 |
+| Project : Ararat Synapse                                       | 001.001.001 |
 |==============================================================================|
 | Content: ICONV support for Win32, Linux and .NET                             |
 |==============================================================================|
-| Copyright (c)2004-2008, Lukas Gebauer                                        |
+| Copyright (c)2004-2010, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2004-2008.                |
+| Portions created by Lukas Gebauer are Copyright (c)2004-2010.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -46,6 +46,12 @@
   {$MODE DELPHI}
 {$ENDIF}
 {$H+}
+//old Delphi does not have MSWINDOWS define.
+{$IFDEF WIN32}
+  {$IFNDEF MSWINDOWS}
+    {$DEFINE MSWINDOWS}
+  {$ENDIF}
+{$ENDIF}
 
 {:@abstract(LibIconv support)
 
@@ -63,7 +69,7 @@ uses
   System.Text,
 {$ENDIF}
   synafpc,
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
   {$IFNDEF FPC}
   Libc,
   {$ENDIF}
@@ -74,7 +80,7 @@ uses
 
 
 const
-  {$IFNDEF WIN32}
+  {$IFNDEF MSWINDOWS}
   DLLIconvName = 'libiconv.so';
   {$ELSE}
   DLLIconvName = 'iconv.dll';

trunk/Units/Synapse/synaip.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.002.000 |
+| Project : Ararat Synapse                                       | 001.002.001 |
 |==============================================================================|
 | Content: IP address support procedures and functions                         |
 |==============================================================================|
-| Copyright (c)2006-2009, Lukas Gebauer                                        |
+| Copyright (c)2006-2010, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c) 2006-2008.               |
+| Portions created by Lukas Gebauer are Copyright (c) 2006-2010.               |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -51,6 +51,12 @@
 {$R-}
 {$H+}
 
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+  {$WARN SUSPICIOUS_TYPECAST OFF}
+{$ENDIF}
+
 unit synaip;
 
 interface
@@ -112,7 +118,7 @@ var
     // i.e. "$80"
     if Result then
       for n := 1 to length(Value) do
-        if not (Value[n] in ['0'..'9']) then
+        if not (AnsiChar(Value[n]) in ['0'..'9']) then
         begin
           Result := False;
           Break;
@@ -193,7 +199,7 @@ begin
   begin
     s := Fetch(Host, '.');
     i := StrToIntDef(s, 0);
-    Result := Result + Chr(i);
+    Result := Result + AnsiChar(i);
   end;
 end;
 

trunk/Units/Synapse/synamisc.pas

@@ -3,7 +3,7 @@
 |==============================================================================|
 | Content: misc. procedures and functions                                      |
 |==============================================================================|
-| Copyright (c)1999-2008, Lukas Gebauer                                        |
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c) 2002-2008.               |
+| Portions created by Lukas Gebauer are Copyright (c) 2002-2010.               |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -50,6 +50,11 @@
 {$Q-}
 {$H+}
 
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
 unit synamisc;
 
 interface

trunk/Units/Synapse/synaser.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 007.003.000 |
+| Project : Ararat Synapse                                       | 007.004.000 |
 |==============================================================================|
 | Content: Serial port support                                                 |
 |==============================================================================|
-| Copyright (c)2001-2008, Lukas Gebauer                                        |
+| Copyright (c)2001-2010, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2001-2008.                |
+| Portions created by Lukas Gebauer are Copyright (c)2001-2010.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -69,9 +69,16 @@ case with my USB modem):
 #)
 }
 
+//old Delphi does not have MSWINDOWS define.
+{$IFDEF WIN32}
+  {$IFNDEF MSWINDOWS}
+    {$DEFINE MSWINDOWS}
+  {$ENDIF}
+{$ENDIF}
+
 {$IFDEF FPC}
   {$MODE DELPHI}
-  {$IFDEF WIN32}
+  {$IFDEF MSWINDOWS}
     {$ASMMODE intel}
   {$ENDIF}
   {define working mode w/o LIBC for fpc}
@@ -86,7 +93,7 @@ unit synaser;
 interface
 
 uses
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
   {$IFNDEF NO_LIBC}
   Libc,
   KernelIoctl,
@@ -156,13 +163,13 @@ const
   {:stopbit value for 2 stopbits}
   SB2 = 2;
 
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
 const
   INVALID_HANDLE_VALUE = THandle(-1);
   CS7fix = $0000020;
 
 type
-  TDCB = packed record
+  TDCB = record
     DCBlength: DWORD;
     BaudRate: DWORD;
     Flags: Longint;
@@ -182,8 +189,11 @@ type
   PDCB = ^TDCB;
 
 const
-//  MaxRates = 30;
+{$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),
@@ -205,8 +215,9 @@ const
     (57600, B57600),
     (115200, B115200),
     (230400, B230400),
-    (460800, B460800){,
+    (460800, B460800)
-    (500000, B500000),
+{$IFDEF LINUX}
+    ,(500000, B500000),
     (576000, B576000),
     (921600, B921600),
     (1000000, B1000000),
@@ -216,7 +227,8 @@ const
     (2500000, B2500000),
     (3000000, B3000000),
     (3500000, B3500000),
-    (4000000, B4000000)}
+    (4000000, B4000000)
+{$ENDIF}
     );
 {$ENDIF}
 
@@ -257,7 +269,7 @@ type
     FDevice: string;
     FLastError: integer;
     FLastErrorDesc: string;
-    FBuffer: string;
+    FBuffer: AnsiString;
     FRaiseExcept: boolean;
     FRecvBuffer: integer;
     FSendBuffer: integer;
@@ -280,7 +292,7 @@ type
     FAtTimeout: integer;
     FInterPacketTimeout: Boolean;
     FComNr: integer;
-{$IFDEF WIN32}
+{$IFDEF MSWINDOWS}
     FPortAddr: Word;
     function CanEvent(Event: dword; Timeout: integer): boolean;
     procedure DecodeCommError(Error: DWord); virtual;
@@ -298,7 +310,7 @@ type
     procedure GetComNr(Value: string); virtual;
     function PreTestFailing: boolean; virtual;{HGJ}
     function TestCtrlLine: Boolean; virtual;
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
     procedure DcbToTermios(const dcb: TDCB; var term: termios); virtual;
     procedure TermiosToDcb(const term: termios; var dcb: TDCB); virtual;
 {$ENDIF}
@@ -313,7 +325,7 @@ type
     {: data Control Block with communication parameters. Usable only when you
      need to call API directly.}
     DCB: Tdcb;
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
     TermiosStruc: termios;
 {$ENDIF}
     {:Object constructor.}
@@ -386,14 +398,14 @@ type
 
      Since no terminator is appended, you can use this function for sending
      binary data too.}
-    procedure SendString(data: string); virtual;
+    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: string); virtual;
+    procedure SendBlock(const Data: AnsiString); virtual;
 
     {:send content of stream from current position}
     procedure SendStreamRaw(const Stream: TStream); virtual;
@@ -424,12 +436,12 @@ type
 
     {:It is like recvBufferEx, but data is readed to dynamicly allocated binary
      string.}
-    function RecvBufferStr(Length: Integer; Timeout: Integer): string; virtual;
+    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): string; virtual;
+    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,
@@ -440,7 +452,7 @@ type
      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: string): string; virtual;
+    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
@@ -453,7 +465,7 @@ type
      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): string; virtual;
+    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,
@@ -463,7 +475,7 @@ type
     {: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): string; virtual;
+    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;
@@ -554,7 +566,7 @@ type
      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: string): string; virtual;
+    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,...)
@@ -573,7 +585,7 @@ type
      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: string): string; virtual;
+    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
@@ -660,7 +672,7 @@ type
     property Handle: THandle read Fhandle write FHandle;
 
     {:Internally used read buffer.}
-    property LineBuffer: string read FBuffer write FBuffer;
+    property LineBuffer: AnsiString read FBuffer write FBuffer;
 
     {:If @true, communication errors raise exceptions. If @false (default), only
      the @link(LastError) value is set.}
@@ -752,7 +764,7 @@ end;
 
 class function TBlockSerial.GetVersion: string;
 begin
-	Result := 'SynaSer 6.3.5';
+	Result := 'SynaSer 7.4.0';
 end;
 
 procedure TBlockSerial.CloseSocket;
@@ -762,7 +774,7 @@ begin
     Purge;
     RTS := False;
     DTR := False;
-    FileClose(integer(FHandle));
+    FileClose(FHandle);
   end;
   if InstanceActive then
   begin
@@ -778,7 +790,7 @@ begin
   DoStatus(HR_SerialClose, FDevice);
 end;
 
-{$IFDEF WIN32}
+{$IFDEF MSWINDOWS}
 function TBlockSerial.GetPortAddr: Word;
 begin
   Result := 0;
@@ -849,6 +861,7 @@ 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;
@@ -878,7 +891,7 @@ begin
 end;
 
 procedure TBlockSerial.Connect(comport: string);
-{$IFDEF WIN32}
+{$IFDEF MSWINDOWS}
 var
   CommTimeouts: TCommTimeouts;
 {$ENDIF}
@@ -892,7 +905,7 @@ begin
   FBuffer := '';
   FDevice := comport;
   GetComNr(comport);
-{$IFDEF WIN32}
+{$IFDEF MSWINDOWS}
   SetLastError (sOK);
 {$ELSE}
   {$IFNDEF FPC}
@@ -901,7 +914,7 @@ begin
   fpSetErrno(sOK);
   {$ENDIF}
 {$ENDIF}
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
   if FComNr <> PortIsClosed then
     FDevice := '/dev/ttyS' + IntToStr(FComNr);
   // Comport already owned by another process?          {HGJ}
@@ -916,7 +929,10 @@ begin
 {$ELSE}
   FHandle := THandle(fpOpen(FDevice, O_RDWR or O_SYNC));
 {$ENDIF}
-  SerialCheck(integer(FHandle));
+  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
@@ -930,7 +946,10 @@ begin
     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));
-  SerialCheck(integer(FHandle));
+  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;
@@ -948,7 +967,7 @@ begin
   if not TestCtrlLine then  {HGJ}
   begin
     SetSynaError(ErrNoDeviceAnswer);
-    FileClose(integer(FHandle));         {HGJ}
+    FileClose(FHandle);         {HGJ}
     {$IFDEF LINUX}
     if FLinuxLock then
       cpomReleaseComport;                {HGJ}
@@ -968,7 +987,7 @@ begin
 end;
 
 function TBlockSerial.SendBuffer(buffer: pointer; length: integer): integer;
-{$IFDEF WIN32}
+{$IFDEF MSWINDOWS}
 var
   Overlapped: TOverlapped;
   x, y, Err: DWord;
@@ -983,8 +1002,8 @@ begin
     Flush;
     RTS := True;
   end;
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
-  result := FileWrite(integer(Fhandle), Buffer^, Length);
+  result := FileWrite(Fhandle, Buffer^, Length);
   serialcheck(result);
 {$ELSE}
   FillChar(Overlapped, Sizeof(Overlapped), 0);
@@ -1023,7 +1042,7 @@ begin
   SendBuffer(@Data, 1);
 end;
 
-procedure TBlockSerial.SendString(data: string);
+procedure TBlockSerial.SendString(data: AnsiString);
 begin
   SendBuffer(Pointer(Data), Length(Data));
 end;
@@ -1033,7 +1052,7 @@ begin
   SendBuffer(@data, SizeOf(Data));
 end;
 
-procedure TBlockSerial.SendBlock(const Data: string);
+procedure TBlockSerial.SendBlock(const Data: AnsiString);
 begin
   SendInteger(Length(data));
   SendString(Data);
@@ -1043,7 +1062,7 @@ procedure TBlockSerial.SendStreamRaw(const Stream: TStream);
 var
   si: integer;
   x, y, yr: integer;
-  s: string;
+  s: AnsiString;
 begin
   si := Stream.Size - Stream.Position;
   x := 0;
@@ -1053,7 +1072,7 @@ begin
     if y > cSerialChunk then
       y := cSerialChunk;
     Setlength(s, y);
-    yr := Stream.read(Pchar(s)^, y);
+    yr := Stream.read(PAnsiChar(s)^, y);
     if yr > 0 then
     begin
       SetLength(s, yr);
@@ -1085,13 +1104,13 @@ begin
 end;
 
 function TBlockSerial.RecvBuffer(buffer: pointer; length: integer): integer;
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
 begin
   Result := 0;
   if PreTestFailing then   {HGJ}
     Exit;                  {HGJ}
   LimitBandwidth(Length, FMaxRecvBandwidth, FNextRecv);
-  result := FileRead(integer(FHandle), Buffer^, length);
+  result := FileRead(FHandle, Buffer^, length);
   serialcheck(result);
 {$ELSE}
 var
@@ -1129,7 +1148,7 @@ end;
 
 function TBlockSerial.RecvBufferEx(buffer: pointer; length: integer; timeout: integer): integer;
 var
-  s: string;
+  s: AnsiString;
   rl, l: integer;
   ti: LongWord;
 begin
@@ -1165,7 +1184,7 @@ begin
   Result := rl;
 end;
 
-function TBlockSerial.RecvBufferStr(Length: Integer; Timeout: Integer): string;
+function TBlockSerial.RecvBufferStr(Length: Integer; Timeout: Integer): AnsiString;
 var
   x: integer;
 begin
@@ -1176,7 +1195,7 @@ begin
   if Length > 0 then
   begin
     Setlength(Result, Length);
-    x := RecvBufferEx(PChar(Result), Length , Timeout);
+    x := RecvBufferEx(PAnsiChar(Result), Length , Timeout);
     if FLastError = sOK then
       SetLength(Result, x)
     else
@@ -1184,7 +1203,7 @@ begin
   end;
 end;
 
-function TBlockSerial.RecvPacket(Timeout: Integer): string;
+function TBlockSerial.RecvPacket(Timeout: Integer): AnsiString;
 var
   x: integer;
 begin
@@ -1248,10 +1267,10 @@ begin
   ExceptCheck;
 end;
 
-function TBlockSerial.RecvTerminated(Timeout: Integer; const Terminator: string): string;
+function TBlockSerial.RecvTerminated(Timeout: Integer; const Terminator: AnsiString): AnsiString;
 var
   x: Integer;
-  s: string;
+  s: AnsiString;
   l: Integer;
   CorCRLF: Boolean;
   t: ansistring;
@@ -1325,9 +1344,9 @@ begin
 end;
 
 
-function TBlockSerial.RecvString(Timeout: Integer): string;
+function TBlockSerial.RecvString(Timeout: Integer): AnsiString;
 var
-  s: string;
+  s: AnsiString;
 begin
   Result := '';
   s := RecvTerminated(Timeout, #13 + #10);
@@ -1337,7 +1356,7 @@ end;
 
 function TBlockSerial.RecvInteger(Timeout: Integer): Integer;
 var
-  s: string;
+  s: AnsiString;
 begin
   Result := 0;
   s := RecvBufferStr(4, Timeout);
@@ -1345,7 +1364,7 @@ begin
     Result := (ord(s[1]) + ord(s[2]) * 256) + (ord(s[3]) + ord(s[4]) * 256) * 65536;
 end;
 
-function TBlockSerial.RecvBlock(Timeout: Integer): string;
+function TBlockSerial.RecvBlock(Timeout: Integer): AnsiString;
 var
   x: integer;
 begin
@@ -1357,7 +1376,7 @@ end;
 
 procedure TBlockSerial.RecvStreamRaw(const Stream: TStream; Timeout: Integer);
 var
-  s: string;
+  s: AnsiString;
 begin
   repeat
     s := RecvPacket(Timeout);
@@ -1368,7 +1387,7 @@ end;
 
 procedure TBlockSerial.RecvStreamSize(const Stream: TStream; Timeout: Integer; Size: Integer);
 var
-  s: string;
+  s: AnsiString;
   n: integer;
 begin
   for n := 1 to (Size div cSerialChunk) do
@@ -1376,7 +1395,7 @@ begin
     s := RecvBufferStr(cSerialChunk, Timeout);
     if FLastError <> 0 then
       Exit;
-    Stream.Write(Pchar(s)^, cSerialChunk);
+    Stream.Write(PAnsichar(s)^, cSerialChunk);
   end;
   n := Size mod cSerialChunk;
   if n > 0 then
@@ -1384,7 +1403,7 @@ begin
     s := RecvBufferStr(n, Timeout);
     if FLastError <> 0 then
       Exit;
-    Stream.Write(Pchar(s)^, n);
+    Stream.Write(PAnsichar(s)^, n);
   end;
 end;
 
@@ -1407,11 +1426,11 @@ begin
     RecvStreamSize(Stream, Timeout, x);
 end;
 
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
 function TBlockSerial.WaitingData: integer;
 begin
 {$IFNDEF FPC}
-  serialcheck(ioctl(integer(FHandle), FIONREAD, @result));
+  serialcheck(ioctl(FHandle, FIONREAD, @result));
 {$ELSE}
   serialcheck(fpIoctl(FHandle, FIONREAD, @result));
 {$ENDIF}
@@ -1447,7 +1466,7 @@ begin
   	Result := Waitingdata;
 end;
 
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
 function TBlockSerial.SendingData: integer;
 begin
   SetSynaError(sOK);
@@ -1467,7 +1486,7 @@ begin
 end;
 {$ENDIF}
 
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
 procedure TBlockSerial.DcbToTermios(const dcb: TDCB; var term: termios);
 var
   n: integer;
@@ -1590,11 +1609,11 @@ begin
 end;
 {$ENDIF}
 
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
 procedure TBlockSerial.SetCommState;
 begin
   DcbToTermios(dcb, termiosstruc);
-  SerialCheck(tcsetattr(integer(FHandle), TCSANOW, termiosstruc));
+  SerialCheck(tcsetattr(FHandle, TCSANOW, termiosstruc));
   ExceptCheck;
 end;
 {$ELSE}
@@ -1607,10 +1626,10 @@ begin
 end;
 {$ENDIF}
 
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
 procedure TBlockSerial.GetCommState;
 begin
-  SerialCheck(tcgetattr(integer(FHandle), termiosstruc));
+  SerialCheck(tcgetattr(FHandle, termiosstruc));
   ExceptCheck;
   TermiostoDCB(termiosstruc, dcb);
 end;
@@ -1626,7 +1645,7 @@ end;
 
 procedure TBlockSerial.SetSizeRecvBuffer(size: integer);
 begin
-{$IFDEF WIN32}
+{$IFDEF MSWINDOWS}
   SetupComm(Fhandle, size, 0);
   GetCommState;
   dcb.XonLim := size div 4;
@@ -1639,7 +1658,7 @@ end;
 function TBlockSerial.GetDSR: Boolean;
 begin
   ModemStatus;
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
   Result := (FModemWord and TIOCM_DSR) > 0;
 {$ELSE}
   Result := (FModemWord and MS_DSR_ON) > 0;
@@ -1648,16 +1667,16 @@ end;
 
 procedure TBlockSerial.SetDTRF(Value: Boolean);
 begin
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
   ModemStatus;
   if Value then
     FModemWord := FModemWord or TIOCM_DTR
   else
     FModemWord := FModemWord and not TIOCM_DTR;
   {$IFNDEF FPC}
-  ioctl(integer(FHandle), TIOCMSET, @FModemWord);
+  ioctl(FHandle, TIOCMSET, @FModemWord);
   {$ELSE}
-  fpioctl(integer(FHandle), TIOCMSET, @FModemWord);
+  fpioctl(FHandle, TIOCMSET, @FModemWord);
   {$ENDIF}
 {$ELSE}
   if Value then
@@ -1670,7 +1689,7 @@ end;
 function TBlockSerial.GetCTS: Boolean;
 begin
   ModemStatus;
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
   Result := (FModemWord and TIOCM_CTS) > 0;
 {$ELSE}
   Result := (FModemWord and MS_CTS_ON) > 0;
@@ -1679,16 +1698,16 @@ end;
 
 procedure TBlockSerial.SetRTSF(Value: Boolean);
 begin
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
   ModemStatus;
   if Value then
     FModemWord := FModemWord or TIOCM_RTS
   else
     FModemWord := FModemWord and not TIOCM_RTS;
   {$IFNDEF FPC}
-  ioctl(integer(FHandle), TIOCMSET, @FModemWord);
+  ioctl(FHandle, TIOCMSET, @FModemWord);
   {$ELSE}
-  fpioctl(integer(FHandle), TIOCMSET, @FModemWord);
+  fpioctl(FHandle, TIOCMSET, @FModemWord);
   {$ENDIF}
 {$ELSE}
   if Value then
@@ -1701,7 +1720,7 @@ end;
 function TBlockSerial.GetCarrier: Boolean;
 begin
   ModemStatus;
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
   Result := (FModemWord and TIOCM_CAR) > 0;
 {$ELSE}
   Result := (FModemWord and MS_RLSD_ON) > 0;
@@ -1711,14 +1730,14 @@ end;
 function TBlockSerial.GetRing: Boolean;
 begin
   ModemStatus;
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
   Result := (FModemWord and TIOCM_RNG) > 0;
 {$ELSE}
   Result := (FModemWord and MS_RING_ON) > 0;
 {$ENDIF}
 end;
 
-{$IFDEF WIN32}
+{$IFDEF MSWINDOWS}
 function TBlockSerial.CanEvent(Event: dword; Timeout: integer): boolean;
 var
   ex: DWord;
@@ -1753,7 +1772,7 @@ begin
 end;
 {$ENDIF}
 
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
 function TBlockSerial.CanRead(Timeout: integer): boolean;
 var
   FDSet: TFDSet;
@@ -1768,12 +1787,12 @@ begin
     TimeVal := nil;
   {$IFNDEF FPC}
   FD_ZERO(FDSet);
-  FD_SET(integer(FHandle), FDSet);
+  FD_SET(FHandle, FDSet);
-  x := Select(integer(FHandle) + 1, @FDSet, nil, nil, TimeVal);
+  x := Select(FHandle + 1, @FDSet, nil, nil, TimeVal);
   {$ELSE}
   fpFD_ZERO(FDSet);
-  fpFD_SET(integer(FHandle), FDSet);
+  fpFD_SET(FHandle, FDSet);
-  x := fpSelect(integer(FHandle) + 1, @FDSet, nil, nil, TimeVal);
+  x := fpSelect(FHandle + 1, @FDSet, nil, nil, TimeVal);
   {$ENDIF}
   SerialCheck(x);
   if FLastError <> sOK then
@@ -1794,7 +1813,7 @@ begin
 end;
 {$ENDIF}
 
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
 function TBlockSerial.CanWrite(Timeout: integer): boolean;
 var
   FDSet: TFDSet;
@@ -1809,12 +1828,12 @@ begin
     TimeVal := nil;
   {$IFNDEF FPC}
   FD_ZERO(FDSet);
-  FD_SET(integer(FHandle), FDSet);
+  FD_SET(FHandle, FDSet);
-  x := Select(integer(FHandle) + 1, nil, @FDSet, nil, TimeVal);
+  x := Select(FHandle + 1, nil, @FDSet, nil, TimeVal);
   {$ELSE}
   fpFD_ZERO(FDSet);
-  fpFD_SET(integer(FHandle), FDSet);
+  fpFD_SET(FHandle, FDSet);
-  x := fpSelect(integer(FHandle) + 1, nil, @FDSet, nil, TimeVal);
+  x := fpSelect(FHandle + 1, nil, @FDSet, nil, TimeVal);
   {$ENDIF}
   SerialCheck(x);
   if FLastError <> sOK then
@@ -1858,7 +1877,7 @@ end;
 procedure TBlockSerial.EnableRTSToggle(Value: boolean);
 begin
   SetSynaError(sOK);
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
   FRTSToggle := Value;
   if Value then
     RTS:=False;
@@ -1883,8 +1902,8 @@ end;
 
 procedure TBlockSerial.Flush;
 begin
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
-  SerialCheck(tcdrain(integer(FHandle)));
+  SerialCheck(tcdrain(FHandle));
 {$ELSE}
   SetSynaError(sOK);
   if not Flushfilebuffers(FHandle) then
@@ -1893,13 +1912,13 @@ begin
   ExceptCheck;
 end;
 
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
 procedure TBlockSerial.Purge;
 begin
   {$IFNDEF FPC}
-  SerialCheck(ioctl(integer(FHandle), TCFLSH, TCIOFLUSH));
+  SerialCheck(ioctl(FHandle, TCFLSH, TCIOFLUSH));
   {$ELSE}
-  SerialCheck(fpioctl(integer(FHandle), TCFLSH, TCIOFLUSH));
+  SerialCheck(fpioctl(FHandle, TCFLSH, TCIOFLUSH));
   {$ENDIF}
   FBuffer := '';
   ExceptCheck;
@@ -1921,11 +1940,11 @@ end;
 function TBlockSerial.ModemStatus: integer;
 begin
   Result := 0;
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
   {$IFNDEF FPC}
-  SerialCheck(ioctl(integer(FHandle), TIOCMGET, @Result));
+  SerialCheck(ioctl(FHandle, TIOCMGET, @Result));
   {$ELSE}
-  SerialCheck(fpioctl(integer(FHandle), TIOCMGET, @Result));
+  SerialCheck(fpioctl(FHandle, TIOCMGET, @Result));
   {$ENDIF}
 {$ELSE}
   SetSynaError(sOK);
@@ -1938,8 +1957,8 @@ end;
 
 procedure TBlockSerial.SetBreak(Duration: integer);
 begin
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
-  SerialCheck(tcsendbreak(integer(FHandle), Duration));
+  SerialCheck(tcsendbreak(FHandle, Duration));
 {$ELSE}
   SetCommBreak(FHandle);
   Sleep(Duration);
@@ -1949,7 +1968,7 @@ begin
 {$ENDIF}
 end;
 
-{$IFDEF WIN32}
+{$IFDEF MSWINDOWS}
 procedure TBlockSerial.DecodeCommError(Error: DWord);
 begin
   if (Error and DWord(CE_FRAME)) > 1 then
@@ -1984,9 +2003,9 @@ begin
   result := ((not FTestDSR) or DSR) and ((not FTestCTS) or CTS);
 end;
 
-function TBlockSerial.ATCommand(value: string): string;
+function TBlockSerial.ATCommand(value: AnsiString): AnsiString;
 var
-  s: string;
+  s: AnsiString;
   ConvSave: Boolean;
 begin
   result := '';
@@ -2013,9 +2032,9 @@ begin
 end;
 
 
-function TBlockSerial.ATConnect(value: string): string;
+function TBlockSerial.ATConnect(value: AnsiString): AnsiString;
 var
-  s: string;
+  s: AnsiString;
   ConvSave: Boolean;
 begin
   result := '';
@@ -2050,7 +2069,7 @@ end;
 function TBlockSerial.SerialCheck(SerialResult: integer): integer;
 begin
   if SerialResult = integer(INVALID_HANDLE_VALUE) then
-{$IFDEF WIN32}
+{$IFDEF MSWINDOWS}
     result := GetLastError
 {$ELSE}
   {$IFNDEF FPC}
@@ -2166,7 +2185,8 @@ begin
     // Allow all users to enjoy the benefits of cpom
     s := 'chmod a+rw ' + LockfileName;
 {$IFNDEF FPC}
-    Libc.system(pchar(s));
+    FileSetReadOnly( LockfileName, False ) ;
+ // Libc.system(pchar(s));
 {$ELSE}
     fpSystem(s);
 {$ENDIF}
@@ -2236,7 +2256,7 @@ end;
 {$ENDIF}
 {----------------------------------------------------------------}
 
-{$IFDEF WIN32}
+{$IFDEF MSWINDOWS}
 function GetSerialPortNames: string;
 var
   reg: TRegistry;
@@ -2265,7 +2285,7 @@ begin
   end;
 end;
 {$ENDIF}
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
 function GetSerialPortNames: string;
 var
   Index: Integer;

trunk/Units/Synapse/synautil.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 004.013.000 |
+| Project : Ararat Synapse                                       | 004.014.000 |
 |==============================================================================|
 | Content: support procedures and functions                                    |
 |==============================================================================|
-| Copyright (c)1999-2008, Lukas Gebauer                                        |
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c) 1999-2008.               |
+| Portions created by Lukas Gebauer are Copyright (c) 1999-2010.               |
 | Portions created by Hernan Sanchez are Copyright (c) 2000.                   |
 | All Rights Reserved.                                                         |
 |==============================================================================|
@@ -53,12 +53,25 @@
 {$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 WIN32}
+{$IFDEF MSWINDOWS}
   Windows,
 {$ELSE}
   {$IFDEF FPC}
@@ -102,7 +115,7 @@ 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: AnsiString): integer;
+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".}
@@ -251,7 +264,7 @@ 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: string): Boolean;
+function IsBinaryString(const Value: AnsiString): Boolean;
 
 {:return position of string terminator in string. If terminator found, then is
  returned in terminator parameter.
@@ -327,7 +340,7 @@ const
   MyDayNames: array[1..7] of AnsiString =
     ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
 var
-  MyMonthNames: array[0..6, 1..12] of AnsiString =
+  MyMonthNames: array[0..6, 1..12] of String =
     (
     ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',  //rewrited by system locales
      'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'),
@@ -349,7 +362,7 @@ var
 {==============================================================================}
 
 function TimeZoneBias: integer;
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
 {$IFNDEF FPC}
 var
   t: TTime_T;
@@ -526,10 +539,10 @@ end;
 
 {==============================================================================}
 
-function GetMonthNumber(Value: AnsiString): integer;
+function GetMonthNumber(Value: String): integer;
 var
   n: integer;
-  function TestMonth(Value: AnsiString; Index: Integer): Boolean;
+  function TestMonth(Value: String; Index: Integer): Boolean;
   var
     n: integer;
   begin
@@ -700,7 +713,7 @@ end;
 {==============================================================================}
 
 function GetUTTime: TDateTime;
-{$IFDEF WIN32}
+{$IFDEF MSWINDOWS}
 {$IFNDEF FPC}
 var
   st: TSystemTime;
@@ -742,7 +755,7 @@ end;
 {==============================================================================}
 
 function SetUTTime(Newdt: TDateTime): Boolean;
-{$IFDEF WIN32}
+{$IFDEF MSWINDOWS}
 {$IFNDEF FPC}
 var
   st: TSystemTime;
@@ -795,7 +808,7 @@ end;
 
 {==============================================================================}
 
-{$IFNDEF WIN32}
+{$IFNDEF MSWINDOWS}
 function GetTick: LongWord;
 var
   Stamp: TTimeStamp;
@@ -1405,7 +1418,7 @@ end;
 
 {==============================================================================}
 
-function IsBinaryString(const Value: string): Boolean;
+function IsBinaryString(const Value: AnsiString): Boolean;
 var
   n: integer;
 begin
@@ -1413,7 +1426,7 @@ begin
   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] = #0)) then
+      if not ((n = Length(value)) and (Value[n] = AnsiChar(#0))) then
       begin
         Result := True;
         Break;
@@ -1720,7 +1733,7 @@ end;
 {==============================================================================}
 function GetTempFile(const Dir, prefix: AnsiString): AnsiString;
 {$IFNDEF FPC}
-{$IFDEF WIN32}
+{$IFDEF MSWINDOWS}
 var
   Path: AnsiString;
   x: integer;
@@ -1730,7 +1743,7 @@ begin
 {$IFDEF FPC}
   Result := GetTempFileName(Dir, Prefix);
 {$ELSE}
-  {$IFNDEF WIN32}
+  {$IFNDEF MSWINDOWS}
     Result := tempnam(Pointer(Dir), Pointer(prefix));
   {$ELSE}
     {$IFDEF CIL}
@@ -1784,7 +1797,7 @@ begin
       for n := 1 to Length(t) do
         if t[n] = #9 then
           t[n] := ' ';
-      if not(t[1] in [' ', '"', ':', '=']) then
+      if not(AnsiChar(t[1]) in [' ', '"', ':', '=']) then
         Break
       else
       begin

trunk/Units/Synapse/synsock.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 005.001.000 |
+| Project : Ararat Synapse                                       | 005.002.000 |
 |==============================================================================|
 | Content: Socket Independent Platform Layer                                   |
 |==============================================================================|
-| Copyright (c)1999-2003, Lukas Gebauer                                        |
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2001-2003.                |
+| Portions created by Lukas Gebauer are Copyright (c)2001-20010.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -48,20 +48,30 @@ unit synsock;
 
 {$MINENUMSIZE 4}
 
-{$IFDEF CIL}
+//old Delphi does not have MSWINDOWS define.
-  {$I ssdotnet.pas}
+{$IFDEF WIN32}
+  {$IFNDEF MSWINDOWS}
+    {$DEFINE MSWINDOWS}
+  {$ENDIF}
 {$ENDIF}
 
-{$IFDEF WIN32}
+{$IFDEF CIL}
-  {$I sswin32.pas}
+  {$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.
 

trunk/Units/Synapse/tlntsend.pas

@@ -1,9 +1,9 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.003.000 |
+| Project : Ararat Synapse                                       | 001.003.001 |
 |==============================================================================|
 | Content: TELNET and SSH2 client                                              |
 |==============================================================================|
-| Copyright (c)1999-2008, Lukas Gebauer                                        |
+| Copyright (c)1999-2010, Lukas Gebauer                                        |
 | All rights reserved.                                                         |
 |                                                                              |
 | Redistribution and use in source and binary forms, with or without           |
@@ -33,7 +33,7 @@
 | DAMAGE.                                                                      |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2002-2008.                |
+| Portions created by Lukas Gebauer are Copyright (c)2002-2010.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -52,6 +52,11 @@ Used RFC: RFC-854
 {$ENDIF}
 {$H+}
 
+{$IFDEF UNICODE}
+  {$WARN IMPLICIT_STRING_CAST OFF}
+  {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
 unit tlntsend;
 
 interface
@@ -148,6 +153,7 @@ constructor TTelnetSend.Create;
 begin
   inherited Create;
   FSock := TTCPBlockSocket.Create;
+  FSock.Owner := self;
   FSock.OnReadFilter := FilterHook;
   FTimeout := 60000;
   FTargetPort := cTelnetProtocol;