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
This commit is contained in:
Raymond
parent
1865e848e2
commit
87c496ca85
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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,24 +1860,34 @@ begin
|
|||
end;
|
||||
|
||||
function TForm1.OpenScript: boolean;
|
||||
var
|
||||
OpenInNewTab : boolean;
|
||||
begin
|
||||
Result := False;
|
||||
if CanExitOrOpen = false then
|
||||
Exit;
|
||||
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
|
||||
result := LoadScriptFile(filename);
|
||||
if FileExists(filename) then
|
||||
result := LoadScriptFile(filename);
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
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);
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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 }
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -51,7 +51,6 @@ It binds all the components together.
|
|||
MBitmaps : TMBitmaps;
|
||||
MDTM: TMDTM;
|
||||
MOCR: TMOCR;
|
||||
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
structure simulated!}
|
||||
{:WSA structure with information about socket provider. On non-windows
|
||||
platforms this structure is simulated!}
|
||||
property WSAData: TWSADATA read GetWsaData;
|
||||
|
||||
{:FDset structure prepared for usage with this socket.}
|
||||
property FDset: TFDSet read FFDset;
|
||||
|
||||
{:Structure describing local socket side.}
|
||||
property LocalSin: TVarSin read FLocalSin write FLocalSin;
|
||||
|
||||
|
|
@ -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
|
||||
+ char(Length(FSocksPassword)) + FSocksPassword;
|
||||
Buf := #1 + AnsiChar(Length(FSocksUsername)) + FSocksUsername
|
||||
+ 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));
|
||||
GetSins;
|
||||
inherited Listen;
|
||||
end
|
||||
else
|
||||
begin
|
||||
|
|
@ -3690,9 +3759,9 @@ begin
|
|||
FSocksLocalPort := FSocksResponsePort;
|
||||
FSocksRemoteIP := '';
|
||||
FSocksRemotePort := '';
|
||||
ExceptCheck;
|
||||
DoStatus(HR_Listen, '');
|
||||
end;
|
||||
ExceptCheck;
|
||||
DoStatus(HR_Listen, '');
|
||||
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);
|
||||
/// SockCheck(Result);
|
||||
result := inherited Accept;
|
||||
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;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
Permissions: string;
|
||||
Size: Ansistring;
|
||||
Permissions: Ansistring;
|
||||
DirFlag: string;
|
||||
function GetListItem(Index: integer): TFTPListRec; virtual;
|
||||
function ParseEPLF(Value: string): Boolean; virtual;
|
||||
procedure ClearStore; virtual;
|
||||
function ParseByMask(Value, NextValue, Mask: 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;
|
||||
c: char;
|
||||
MaskC, LastMaskC: AnsiChar;
|
||||
c: AnsiChar;
|
||||
s: string;
|
||||
begin
|
||||
ClearStore;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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 Checksum6(Value: string): Word;
|
||||
function Checksum(Value: AnsiString): 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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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 := '';
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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,10 +620,9 @@ 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
|
||||
else
|
||||
if (err <> 0) then
|
||||
FLastError := err;
|
||||
Result := 0;
|
||||
if (err <> 0) then
|
||||
FLastError := err;
|
||||
end;
|
||||
|
||||
function TSSLOpenSSL.WaitingData: Integer;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -1580,6 +1596,4 @@ end;
|
|||
finalization
|
||||
begin
|
||||
SynSockCS.Free;
|
||||
end;
|
||||
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 =
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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}
|
||||
|
|
|
|||
|
|
@ -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';
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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){,
|
||||
(500000, B500000),
|
||||
(460800, B460800)
|
||||
{$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}
|
||||
result := FileWrite(integer(Fhandle), Buffer^, Length);
|
||||
{$IFNDEF MSWINDOWS}
|
||||
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);
|
||||
x := Select(integer(FHandle) + 1, @FDSet, nil, nil, TimeVal);
|
||||
FD_SET(FHandle, FDSet);
|
||||
x := Select(FHandle + 1, @FDSet, nil, nil, TimeVal);
|
||||
{$ELSE}
|
||||
fpFD_ZERO(FDSet);
|
||||
fpFD_SET(integer(FHandle), FDSet);
|
||||
x := fpSelect(integer(FHandle) + 1, @FDSet, nil, nil, TimeVal);
|
||||
fpFD_SET(FHandle, FDSet);
|
||||
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);
|
||||
x := Select(integer(FHandle) + 1, nil, @FDSet, nil, TimeVal);
|
||||
FD_SET(FHandle, FDSet);
|
||||
x := Select(FHandle + 1, nil, @FDSet, nil, TimeVal);
|
||||
{$ELSE}
|
||||
fpFD_ZERO(FDSet);
|
||||
fpFD_SET(integer(FHandle), FDSet);
|
||||
x := fpSelect(integer(FHandle) + 1, nil, @FDSet, nil, TimeVal);
|
||||
fpFD_SET(FHandle, FDSet);
|
||||
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}
|
||||
SerialCheck(tcdrain(integer(FHandle)));
|
||||
{$IFNDEF MSWINDOWS}
|
||||
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}
|
||||
SerialCheck(tcsendbreak(integer(FHandle), Duration));
|
||||
{$IFNDEF MSWINDOWS}
|
||||
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;
|
||||
|
|
|
|||
|
|
@ -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,18 +53,31 @@
|
|||
{$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}
|
||||
UnixUtil, Unix, BaseUnix,
|
||||
UnixUtil, Unix, BaseUnix,
|
||||
{$ELSE}
|
||||
Libc,
|
||||
Libc,
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
{$IFDEF CIL}
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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}
|
||||
{$I ssdotnet.pas}
|
||||
{$ENDIF}
|
||||
|
||||
//old Delphi does not have MSWINDOWS define.
|
||||
{$IFDEF WIN32}
|
||||
{$I sswin32.pas}
|
||||
{$ELSE}
|
||||
{$IFDEF FPC}
|
||||
{$I ssfpc.pas}
|
||||
{$ELSE}
|
||||
{$I sslinux.pas}
|
||||
{$IFNDEF MSWINDOWS}
|
||||
{$DEFINE MSWINDOWS}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF CIL}
|
||||
{$I ssdotnet.pas}
|
||||
{$ELSE}
|
||||
{$IFDEF MSWINDOWS}
|
||||
{$I sswin32.pas}
|
||||
{$ELSE}
|
||||
{$IFDEF WINCE}
|
||||
{$I sswin32.pas} //not complete yet!
|
||||
{$ELSE}
|
||||
{$IFDEF FPC}
|
||||
{$I ssfpc.pas}
|
||||
{$ELSE}
|
||||
{$I sslinux.pas}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
end.
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
Loading…
Reference in New Issue