3287 lines
89 KiB
ObjectPascal
3287 lines
89 KiB
ObjectPascal
{******************************************************************************}
|
|
{ }
|
|
{ Library: Fundamentals 5.00 }
|
|
{ File name: flcTCPClient.pas }
|
|
{ File version: 5.25 }
|
|
{ Description: TCP client. }
|
|
{ }
|
|
{ Copyright: Copyright (c) 2007-2020, David J Butler }
|
|
{ All rights reserved. }
|
|
{ This file is licensed under the BSD License. }
|
|
{ See http://www.opensource.org/licenses/bsd-license.php }
|
|
{ Redistribution and use in source and binary forms, with }
|
|
{ or without modification, are permitted provided that }
|
|
{ the following conditions are met: }
|
|
{ Redistributions of source code must retain the above }
|
|
{ copyright notice, this list of conditions and the }
|
|
{ following disclaimer. }
|
|
{ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND }
|
|
{ CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED }
|
|
{ WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED }
|
|
{ WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A }
|
|
{ PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL }
|
|
{ THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, }
|
|
{ INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR }
|
|
{ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, }
|
|
{ PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF }
|
|
{ USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) }
|
|
{ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER }
|
|
{ IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING }
|
|
{ NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE }
|
|
{ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE }
|
|
{ POSSIBILITY OF SUCH DAMAGE. }
|
|
{ }
|
|
{ Github: https://github.com/fundamentalslib }
|
|
{ E-mail: fundamentals.library at gmail.com }
|
|
{ }
|
|
{ Revision history: }
|
|
{ }
|
|
{ 2008/08/15 0.01 Initial development. }
|
|
{ 2010/11/07 0.02 Revision. }
|
|
{ 2010/11/12 0.03 Refactor for asynchronous operation. }
|
|
{ 2010/12/02 0.04 TLS support. }
|
|
{ 2010/12/20 0.05 Various enhancements. }
|
|
{ 2011/04/22 0.06 Thread safe Start/Stop. }
|
|
{ 2011/06/18 0.07 IsConnected, IsConnectionClosed, etc. }
|
|
{ 2011/06/25 0.08 Improved logging. }
|
|
{ 2011/09/03 4.09 Revise for Fundamentals 4. }
|
|
{ 2011/09/10 4.10 Synchronised events option. }
|
|
{ 2011/10/06 4.11 Remove wait condition on startup. }
|
|
{ 2011/11/07 4.12 Allow client to be restarted after being stopped. }
|
|
{ Added WaitForStartup property to optionally enable }
|
|
{ waiting for thread initialisation. }
|
|
{ 2015/04/26 4.13 Blocking interface and worker thread. }
|
|
{ 2015/04/27 4.14 Options to retry failed connections. }
|
|
{ 2016/01/09 5.15 Revised for Fundamentals 5. }
|
|
{ 2018/07/19 5.16 ReconnectOnDisconnect property. }
|
|
{ 2018/08/30 5.17 Close socket before thread shutdown to prevent blocking. }
|
|
{ 2018/09/01 5.18 Handle client stopping in process thread. }
|
|
{ 2018/12/31 5.19 OnActivity events. }
|
|
{ 2019/04/10 5.20 Locking changes. }
|
|
{ 2019/04/16 5.21 Shutdown events. }
|
|
{ 2019/10/05 5.22 Select wait in Process thread. }
|
|
{ 2020/03/28 5.23 Select wait 50ms under Win32. }
|
|
{ 2020/05/02 5.24 Log exceptions raised in event handlers. }
|
|
{ 2020/05/11 5.25 TLS options. }
|
|
{ }
|
|
{ Supported compilers: }
|
|
{ }
|
|
{ Delphi 2010-10.4 Win32/Win64 5.25 2020/06/02 }
|
|
{ Delphi 10.2-10.4 Linux64 5.25 2020/06/02 }
|
|
{ Delphi 10.2-10.4 iOS32/64 5.25 2020/06/02 }
|
|
{ Delphi 10.2-10.4 OSX32/64 5.25 2020/06/02 }
|
|
{ Delphi 10.2-10.4 Android32/64 5.25 2020/06/02 }
|
|
{ FreePascal 3.0.4 Win64 5.25 2020/06/02 }
|
|
{ }
|
|
{******************************************************************************}
|
|
|
|
{$INCLUDE ../flcInclude.inc}
|
|
{$INCLUDE flcTCP.inc}
|
|
|
|
unit flcTCPClient;
|
|
|
|
interface
|
|
|
|
uses
|
|
{ System }
|
|
|
|
{$IFDEF OS_MSWIN}
|
|
Messages,
|
|
Windows,
|
|
{$ENDIF}
|
|
|
|
SysUtils,
|
|
SyncObjs,
|
|
Classes,
|
|
|
|
{ Sockets }
|
|
|
|
flcSocketLib,
|
|
flcSocket,
|
|
|
|
{ TCP }
|
|
|
|
flcTCPConnection
|
|
|
|
{ Socks }
|
|
|
|
{$IFDEF TCPCLIENT_SOCKS},
|
|
flcSocksClient
|
|
{$ENDIF}
|
|
|
|
{ TLS }
|
|
|
|
{$IFDEF TCPCLIENT_TLS},
|
|
flcTLSConsts,
|
|
flcTLSTransportTypes,
|
|
flcTLSTransportConnection,
|
|
flcTLSTransportClient
|
|
{$ENDIF}
|
|
|
|
{ WebSocket }
|
|
|
|
{$IFDEF TCPCLIENT_WEBSOCKET},
|
|
flcWebSocketUtils,
|
|
flcWebSocketConnection,
|
|
flcWebSocketClient
|
|
{$ENDIF}
|
|
;
|
|
|
|
|
|
|
|
{ }
|
|
{ TCP Client }
|
|
{ }
|
|
type
|
|
ETCPClient = class(Exception);
|
|
|
|
TTCPClientState = (
|
|
csInit, // Client initialise
|
|
csStarting, // Client starting (thread starting up)
|
|
csStarted, // Client activated (thread running)
|
|
csConnectRetry, // Client retrying connection
|
|
csResolvingLocal, // Local IP resolving
|
|
csResolvedLocal, // Local IP resolved
|
|
csBound, // Local IP bound
|
|
csResolving, // IP resolving
|
|
csResolved, // IP resolved
|
|
csConnecting, // TCP connecting
|
|
csConnected, // TCP connected
|
|
csNegotiating, // Connection proxy negotiation
|
|
csReady, // Client ready, connection negotiated and ready
|
|
csClosed, // Connection closed
|
|
//// csReadyFailed
|
|
//// csStartFailed
|
|
csStopped // Client stopped
|
|
);
|
|
|
|
TTCPClientStates = set of TTCPClientState;
|
|
|
|
TTCPClientLogType = (
|
|
cltDebug,
|
|
cltInfo,
|
|
cltError
|
|
);
|
|
|
|
TTCPClientAddressFamily = (
|
|
cafIP4,
|
|
cafIP6
|
|
);
|
|
|
|
{$IFDEF TCPCLIENT_TLS}
|
|
type
|
|
TTCPClientTLSOption = (
|
|
ctoNone
|
|
);
|
|
|
|
TTCPClientTLSOptions = set of TTCPClientTLSOption;
|
|
|
|
const
|
|
DefaultTCPClientTLSOptions = [];
|
|
|
|
type
|
|
TTCPClientTLSClientOptions = TTLSClientOptions;
|
|
TTCPClientTLSVersionOptions = TTLSVersionOptions;
|
|
TTCPClientTLSKeyExchangeOptions = TTLSKeyExchangeOptions;
|
|
TTCPClientTLSCipherOptions = TTLSCipherOptions;
|
|
TTCPClientTLSHashOptions = TTLSHashOptions;
|
|
{$ENDIF}
|
|
|
|
type
|
|
TF5TCPClient = class;
|
|
|
|
TTCPClientNotifyEvent = procedure (AClient: TF5TCPClient) of object;
|
|
TTCPClientLogEvent = procedure (AClient: TF5TCPClient; LogType: TTCPClientLogType; Msg: String; LogLevel: Integer) of object;
|
|
TTCPClientStateEvent = procedure (AClient: TF5TCPClient; AState: TTCPClientState) of object;
|
|
TTCPClientErrorEvent = procedure (AClient: TF5TCPClient; ErrorMsg: String; ErrorCode: Integer) of object;
|
|
TTCPClientWorkerExecuteEvent = procedure (AClient: TF5TCPClient; AConnection: TTCPBlockingConnection; var CloseOnExit: Boolean) of object;
|
|
|
|
TSyncProc = procedure of object;
|
|
|
|
TTCPClientProcessThread = class(TThread)
|
|
protected
|
|
FTCPClient : TF5TCPClient;
|
|
procedure Execute; override;
|
|
public
|
|
constructor Create(const ATCPClient: TF5TCPClient);
|
|
property Terminated;
|
|
end;
|
|
|
|
TF5TCPClient = class(TComponent)
|
|
protected
|
|
// parameters
|
|
FAddressFamily : TTCPClientAddressFamily;
|
|
FHost : String;
|
|
FPort : String;
|
|
FLocalHost : String;
|
|
FLocalPort : String;
|
|
|
|
FRetryFailedConnect : Boolean;
|
|
FRetryFailedConnectDelaySec : Integer;
|
|
FRetryFailedConnectMaxAttempts : Integer;
|
|
FReconnectOnDisconnect : Boolean;
|
|
|
|
{$IFDEF TCPCLIENT_SOCKS}
|
|
FSocksEnabled : Boolean;
|
|
FSocksHost : RawByteString;
|
|
FSocksPort : RawByteString;
|
|
FSocksAuth : Boolean;
|
|
FSocksUsername : RawByteString;
|
|
FSocksPassword : RawByteString;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF TCPCLIENT_TLS}
|
|
FTLSEnabled : Boolean;
|
|
FTLSOptions : TTCPClientTLSOptions;
|
|
FTLSClientOptions : TTCPClientTLSClientOptions;
|
|
FTLSVersionOptions : TTCPClientTLSVersionOptions;
|
|
FTLSKeyExchangeOptions : TTCPClientTLSKeyExchangeOptions;
|
|
FTLSCipherOptions : TTCPClientTLSCipherOptions;
|
|
FTLSHashOptions : TTCPClientTLSHashOptions;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF TCPCLIENT_WEBSOCKET}
|
|
FWebSocketEnabled : Boolean;
|
|
FWebSocketURI : RawByteString;
|
|
FWebSocketOrigin : RawByteString;
|
|
FWebSocketProtocol : RawByteString;
|
|
{$ENDIF}
|
|
|
|
FUseWorkerThread : Boolean;
|
|
|
|
FSynchronisedEvents : Boolean;
|
|
FWaitForStartup : Boolean;
|
|
|
|
FTrackLastActivityTime : Boolean;
|
|
|
|
FUserTag : NativeInt;
|
|
FUserObject : TObject;
|
|
|
|
// event handlers
|
|
FOnLog : TTCPClientLogEvent;
|
|
|
|
FOnError : TTCPClientErrorEvent;
|
|
FOnStart : TTCPClientNotifyEvent;
|
|
FOnStop : TTCPClientNotifyEvent;
|
|
FOnActive : TTCPClientNotifyEvent;
|
|
FOnInactive : TTCPClientNotifyEvent;
|
|
FOnStateChanged : TTCPClientStateEvent;
|
|
FOnStarted : TTCPClientNotifyEvent;
|
|
FOnConnected : TTCPClientNotifyEvent;
|
|
FOnConnectFailed : TTCPClientNotifyEvent;
|
|
FOnNegotiating : TTCPClientNotifyEvent;
|
|
FOnReady : TTCPClientNotifyEvent;
|
|
FOnReadShutdown : TTCPClientNotifyEvent;
|
|
FOnShutdown : TTCPClientNotifyEvent;
|
|
FOnClose : TTCPClientNotifyEvent;
|
|
FOnStopped : TTCPClientNotifyEvent;
|
|
|
|
FOnRead : TTCPClientNotifyEvent;
|
|
FOnWrite : TTCPClientNotifyEvent;
|
|
FOnReadActivity : TTCPClientNotifyEvent;
|
|
FOnWriteActivity : TTCPClientNotifyEvent;
|
|
|
|
FOnProcessThreadIdle : TTCPClientNotifyEvent;
|
|
FOnMainThreadWait : TTCPClientNotifyEvent;
|
|
FOnThreadWait : TTCPClientNotifyEvent;
|
|
FOnWorkerExecute : TTCPClientWorkerExecuteEvent;
|
|
|
|
// state
|
|
FLock : TCriticalSection;
|
|
FActive : Boolean;
|
|
//// FStarted
|
|
//// FReady
|
|
FIsStopping : Boolean;
|
|
FState : TTCPClientState;
|
|
FErrorMessage : String;
|
|
FErrorCode : Integer;
|
|
FWaitStartEvent : TSimpleEvent; ////
|
|
FWaitStartCount : Int32; ////
|
|
FProcessThread : TTCPClientProcessThread;
|
|
FActivateOnLoaded : Boolean;
|
|
FIPAddressFamily : TIPAddressFamily;
|
|
FSocket : TSysSocket;
|
|
FLocalAddr : TSocketAddr;
|
|
FConnectAddr : TSocketAddr;
|
|
FConnection : TTCPConnection;
|
|
FSyncListLog : TList; //// TList deprecated in Delphi
|
|
|
|
{$IFDEF TCPCLIENT_TLS}
|
|
FTLSProxy : TTCPConnectionProxy;
|
|
FTLSClient : TTLSClient;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF TCPCLIENT_SOCKS}
|
|
FSocksResolvedAddr : TSocketAddr;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF TCPCLIENT_WEBSOCKET}
|
|
FWebSocketProxy : TTCPConnectionProxy;
|
|
{$ENDIF}
|
|
|
|
protected
|
|
procedure Init; virtual;
|
|
procedure InitDefaults; virtual;
|
|
|
|
procedure Lock;
|
|
procedure Unlock;
|
|
|
|
procedure Synchronize(const SyncProc: TSyncProc);
|
|
|
|
procedure SyncLog;
|
|
procedure Log(const LogType: TTCPClientLogType; const Msg: String; const LogLevel: Integer = 0); overload;
|
|
procedure Log(const LogType: TTCPClientLogType; const Msg: String; const Args: array of const; const LogLevel: Integer = 0); overload;
|
|
|
|
function GetState: TTCPClientState;
|
|
function GetStateStr: String;
|
|
procedure SetState(const AState: TTCPClientState);
|
|
|
|
procedure CheckNotActive;
|
|
procedure CheckActive;
|
|
|
|
procedure SetAddressFamily(const AAddressFamily: TTCPClientAddressFamily);
|
|
procedure SetHost(const AHost: String);
|
|
procedure SetPort(const APort: String);
|
|
function GetPortInt: Integer;
|
|
procedure SetPortInt(const APortInt: Integer);
|
|
procedure SetLocalHost(const ALocalHost: String);
|
|
procedure SetLocalPort(const ALocalPort: String);
|
|
|
|
procedure SetRetryFailedConnect(const ARetryFailedConnect: Boolean);
|
|
procedure SetRetryFailedConnectDelaySec(const ARetryFailedConnectDelaySec: Integer);
|
|
procedure SetRetryFailedConnectMaxAttempts(const ARetryFailedConnectMaxAttempts: Integer);
|
|
procedure SetReconnectOnDisconnect(const AReconnectOnDisconnect: Boolean);
|
|
|
|
{$IFDEF TCPCLIENT_SOCKS}
|
|
procedure SetSocksProxy(const SocksProxy: Boolean);
|
|
procedure SetSocksHost(const SocksHost: RawByteString);
|
|
procedure SetSocksPort(const SocksPort: RawByteString);
|
|
procedure SetSocksAuth(const SocksAuth: Boolean);
|
|
procedure SetSocksUsername(const SocksUsername: RawByteString);
|
|
procedure SetSocksPassword(const SocksPassword: RawByteString);
|
|
{$ENDIF}
|
|
|
|
{$IFDEF TCPCLIENT_TLS}
|
|
procedure SetTLSEnabled(const ATLSEnabled: Boolean);
|
|
procedure SetTLSOptions(const ATLSOptions: TTCPClientTLSOptions);
|
|
procedure SetTLSClientOptions(const ATLSClientOptions: TTCPClientTLSClientOptions);
|
|
procedure SetTLSVersionOptions(const ATLSVersionOptions: TTCPClientTLSVersionOptions);
|
|
procedure SetTLSKeyExchangeOptions(const ATLSKeyExchangeOptions: TTCPClientTLSKeyExchangeOptions);
|
|
procedure SetTLSCipherOptions(const ATLSCipherOptions: TTCPClientTLSCipherOptions);
|
|
procedure SetTLSHashOptions(const ATLSHashOptions: TTCPClientTLSHashOptions);
|
|
{$ENDIF}
|
|
|
|
{$IFDEF TCPCLIENT_WEBSOCKET}
|
|
procedure SetWebSocketEnabled(const WebSocketEnabled: Boolean);
|
|
procedure SetWebSocketURI(const WebSocketURI: RawByteString);
|
|
procedure SetWebSocketOrigin(const WebSocketOrigin: RawByteString);
|
|
procedure SetWebSocketProtocol(const WebSocketProtocol: RawByteString);
|
|
{$ENDIF}
|
|
|
|
procedure SetUseWorkerThread(const AUseWorkerThread: Boolean);
|
|
|
|
procedure SetSynchronisedEvents(const ASynchronisedEvents: Boolean);
|
|
procedure SetWaitForStartup(const AWaitForStartup: Boolean);
|
|
|
|
procedure SetActive(const AActive: Boolean);
|
|
procedure Loaded; override;
|
|
|
|
procedure SyncTriggerError;
|
|
procedure SyncTriggerStateChanged;
|
|
procedure SyncTriggerStart;
|
|
procedure SyncTriggerStop;
|
|
procedure SyncTriggerActive;
|
|
procedure SyncTriggerInactive;
|
|
procedure SyncTriggerStarted;
|
|
procedure SyncTriggerConnected;
|
|
procedure SyncTriggerNegotiating;
|
|
procedure SyncTriggerConnectFailed;
|
|
procedure SyncTriggerReady;
|
|
procedure SyncTriggerReadShutdown;
|
|
procedure SyncTriggerShutdown;
|
|
procedure SyncTriggerClose;
|
|
procedure SyncTriggerStopped;
|
|
procedure SyncTriggerRead;
|
|
procedure SyncTriggerWrite;
|
|
procedure SyncTriggerReadActivity;
|
|
procedure SyncTriggerWriteActivity;
|
|
|
|
procedure TriggerError; virtual;
|
|
procedure TriggerStateChanged; virtual;
|
|
procedure TriggerStart; virtual;
|
|
procedure TriggerStop; virtual;
|
|
procedure TriggerActive; virtual;
|
|
procedure TriggerInactive; virtual;
|
|
procedure TriggerProcessThreadIdle; virtual;
|
|
procedure TriggerStarted; virtual;
|
|
procedure TriggerConnected; virtual;
|
|
procedure TriggerNegotiating; virtual;
|
|
procedure TriggerConnectFailed; virtual;
|
|
procedure TriggerReady; virtual;
|
|
procedure TriggerReadShutdown; virtual;
|
|
procedure TriggerShutdown; virtual;
|
|
procedure TriggerClose; virtual;
|
|
procedure TriggerStopped; virtual;
|
|
procedure TriggerRead; virtual;
|
|
procedure TriggerWrite; virtual;
|
|
procedure TriggerReadActivity; virtual;
|
|
procedure TriggerWriteActivity; virtual;
|
|
|
|
procedure SetError(const AErrorMsg: String; const AErrorCode: Integer);
|
|
procedure SetStarted;
|
|
procedure SetConnected;
|
|
procedure SetNegotiating;
|
|
procedure SetReady;
|
|
procedure SetClosed;
|
|
procedure SetStopped;
|
|
|
|
procedure SocketLog(Sender: TSysSocket; LogType: TSysSocketLogType; Msg: String);
|
|
|
|
procedure ConnectionLog(Sender: TTCPConnection; LogType: TTCPLogType; LogMsg: String; LogLevel: Integer);
|
|
|
|
procedure ConnectionStateChange(Sender: TTCPConnection; State: TTCPConnectionState);
|
|
procedure ConnectionReadShutdown(Sender: TTCPConnection);
|
|
procedure ConnectionShutdown(Sender: TTCPConnection);
|
|
procedure ConnectionClose(Sender: TTCPConnection);
|
|
|
|
procedure ConnectionRead(Sender: TTCPConnection);
|
|
procedure ConnectionWrite(Sender: TTCPConnection);
|
|
procedure ConnectionReadActivity(Sender: TTCPConnection);
|
|
procedure ConnectionWriteActivity(Sender: TTCPConnection);
|
|
|
|
procedure ConnectionWorkerExecute(Sender: TTCPConnection;
|
|
Connection: TTCPBlockingConnection; var CloseOnExit: Boolean);
|
|
|
|
{$IFDEF TCPCLIENT_TLS}
|
|
procedure InstallTLSProxy;
|
|
function GetTLSClient: TTLSClient;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF TCPCLIENT_SOCKS}
|
|
procedure InstallSocksProxy;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF TCPCLIENT_WEBSOCKET}
|
|
procedure InstallWebSocketProxy;
|
|
{$ENDIF}
|
|
|
|
function GetConnection: TTCPConnection;
|
|
procedure CreateConnection;
|
|
procedure FreeConnection;
|
|
|
|
function GetBlockingConnection: TTCPBlockingConnection;
|
|
|
|
procedure DoResolveLocal;
|
|
procedure DoBind;
|
|
procedure DoResolve;
|
|
procedure DoConnect;
|
|
procedure DoClose;
|
|
|
|
procedure StartProcessThread;
|
|
procedure StopProcessThread;
|
|
{$IFDEF OS_MSWIN}
|
|
function ProcessMessage(var MsgTerminated: Boolean): Boolean;
|
|
{$ENDIF}
|
|
procedure ProcessThreadExecute(const AThread: TTCPClientProcessThread);
|
|
|
|
procedure TerminateProcessThread;
|
|
procedure TerminateWorkerThread;
|
|
|
|
procedure ValidateParameters;
|
|
|
|
procedure ClientActive;
|
|
procedure ClientInactive;
|
|
|
|
procedure ClientSetActive;
|
|
procedure ClientSetInactive;
|
|
|
|
function WaitStart(const ATimeOutMs: Int32): Boolean; ////
|
|
|
|
procedure Wait; virtual;
|
|
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure Finalise;
|
|
|
|
// Parameters
|
|
property AddressFamily: TTCPClientAddressFamily read FAddressFamily write SetAddressFamily default cafIP4;
|
|
property Host: String read FHost write SetHost;
|
|
property Port: String read FPort write SetPort;
|
|
property PortInt: Integer read GetPortInt write SetPortInt;
|
|
property LocalHost: String read FLocalHost write SetLocalHost;
|
|
property LocalPort: String read FLocalPort write SetLocalPort;
|
|
|
|
property TrackLastActivityTime: Boolean read FTrackLastActivityTime write FTrackLastActivityTime default True;
|
|
|
|
// Connect retry
|
|
// If RetryFailedConnect if True, a failed connection attempt will be
|
|
// retried RetryFailedConnectMaxAttempts times after waiting
|
|
// RetryFailedConnectDelaySec seconds between retries.
|
|
// If RetryFailedConnectMaxAttempts is -1, the connection will be retried
|
|
// until the client is stopped.
|
|
// If ReconnectOnDisconnect is True, a connect will automatically be
|
|
// initiated after an established connection is disconnected.
|
|
property RetryFailedConnect: Boolean read FRetryFailedConnect write SetRetryFailedConnect default False;
|
|
property RetryFailedConnectDelaySec: Integer read FRetryFailedConnectDelaySec write SetRetryFailedConnectDelaySec default 60;
|
|
property RetryFailedConnectMaxAttempts: Integer read FRetryFailedConnectMaxAttempts write SetRetryFailedConnectMaxAttempts default -1;
|
|
property ReconnectOnDisconnect: Boolean read FReconnectOnDisconnect write SetReconnectOnDisconnect default False;
|
|
|
|
// Socks
|
|
{$IFDEF TCPCLIENT_SOCKS}
|
|
property SocksEnabled: Boolean read FSocksEnabled write SetSocksProxy default False;
|
|
property SocksHost: RawByteString read FSocksHost write SetSocksHost;
|
|
property SocksPort: RawByteString read FSocksPort write SetSocksPort;
|
|
property SocksAuth: Boolean read FSocksAuth write SetSocksAuth default False;
|
|
property SocksUsername: RawByteString read FSocksUsername write SetSocksUsername;
|
|
property SocksPassword: RawByteString read FSocksPassword write SetSocksPassword;
|
|
{$ENDIF}
|
|
|
|
// TLS
|
|
{$IFDEF TCPCLIENT_TLS}
|
|
property TLSEnabled: Boolean read FTLSEnabled write SetTLSEnabled default False;
|
|
property TLSOptions: TTCPClientTLSOptions read FTLSOptions write SetTLSOptions default DefaultTCPClientTLSOptions;
|
|
property TLSClientOptions: TTCPClientTLSClientOptions read FTLSClientOptions write SetTLSClientOptions default DefaultTLSClientOptions;
|
|
property TLSVersionOptions: TTCPClientTLSVersionOptions read FTLSVersionOptions write SetTLSVersionOptions default DefaultTLSClientVersionOptions;
|
|
property TLSKeyExchangeOptions: TTCPClientTLSKeyExchangeOptions read FTLSKeyExchangeOptions write SetTLSKeyExchangeOptions default DefaultTLSClientKeyExchangeOptions;
|
|
property TLSCipherOptions: TTCPClientTLSCipherOptions read FTLSCipherOptions write SetTLSCipherOptions default DefaultTLSClientCipherOptions;
|
|
property TLSHashOptions: TTCPClientTLSHashOptions read FTLSHashOptions write SetTLSHashOptions default DefaultTLSClientHashOptions;
|
|
{$ENDIF}
|
|
|
|
// WebSocket
|
|
{$IFDEF TCPCLIENT_WEBSOCKET}
|
|
property WebSocketEnabled: Boolean read FWebSocketEnabled write SetWebSocketEnabled default False;
|
|
property WebSocketURI: RawByteString read FWebSocketURI write SetWebSocketURI;
|
|
property WebSocketOrigin: RawByteString read FWebSocketOrigin write SetWebSocketOrigin;
|
|
property WebSocketProtocol: RawByteString read FWebSocketProtocol write SetWebSocketProtocol;
|
|
{$ENDIF}
|
|
|
|
// When SynchronisedEvents is set, events handlers are called in the main thread
|
|
// through the TThread.Synchronise mechanism.
|
|
// When SynchronisedEvents is not set, events handlers will be called from
|
|
// an external thread. In this case event handler should handle their own
|
|
// synchronisation if required.
|
|
property SynchronisedEvents: Boolean read FSynchronisedEvents write SetSynchronisedEvents default False;
|
|
|
|
property OnLog: TTCPClientLogEvent read FOnLog write FOnLog;
|
|
|
|
property OnError: TTCPClientErrorEvent read FOnError write FOnError;
|
|
property OnStart: TTCPClientNotifyEvent read FOnStart write FOnStart;
|
|
property OnStop: TTCPClientNotifyEvent read FOnStop write FOnStop;
|
|
property OnActive: TTCPClientNotifyEvent read FOnActive write FOnActive;
|
|
property OnInactive: TTCPClientNotifyEvent read FOnInactive write FOnInactive;
|
|
property OnProcessThreadIdle: TTCPClientNotifyEvent read FOnProcessThreadIdle write FOnProcessThreadIdle;
|
|
property OnStateChanged: TTCPClientStateEvent read FOnStateChanged write FOnStateChanged;
|
|
property OnStarted: TTCPClientNotifyEvent read FOnStarted write FOnStarted;
|
|
property OnConnected: TTCPClientNotifyEvent read FOnConnected write FOnConnected;
|
|
property OnConnectFailed: TTCPClientNotifyEvent read FOnConnectFailed write FOnConnectFailed;
|
|
property OnNegotiating: TTCPClientNotifyEvent read FOnNegotiating write FOnNegotiating;
|
|
property OnReady: TTCPClientNotifyEvent read FOnReady write FOnReady;
|
|
property OnReadShutdown: TTCPClientNotifyEvent read FOnReadShutdown write FOnReadShutdown;
|
|
property OnShutdown: TTCPClientNotifyEvent read FOnShutdown write FOnShutdown;
|
|
property OnClose: TTCPClientNotifyEvent read FOnClose write FOnClose;
|
|
property OnStopped: TTCPClientNotifyEvent read FOnStopped write FOnStopped;
|
|
|
|
property OnRead: TTCPClientNotifyEvent read FOnRead write FOnRead;
|
|
property OnWrite: TTCPClientNotifyEvent read FOnWrite write FOnWrite;
|
|
property OnReadActivity: TTCPClientNotifyEvent read FOnReadActivity write FOnReadActivity;
|
|
property OnWriteActivity: TTCPClientNotifyEvent read FOnWriteActivity write FOnWriteActivity;
|
|
|
|
// When WaitForStartup is set, the call to Start or Active := True will only return
|
|
// when the thread has started and the Connection property is available.
|
|
// This option is usally only needed in a non-GUI application.
|
|
// Note:
|
|
// When this is set to True in a GUI application with SynchronisedEvents True,
|
|
// the OnMainThreadWait handler must call Application.ProcessMessages otherwise
|
|
// blocking conditions may occur.
|
|
property WaitForStartup: Boolean read FWaitForStartup write SetWaitForStartup default False;
|
|
|
|
// state
|
|
property State: TTCPClientState read GetState;
|
|
property StateStr: String read GetStateStr;
|
|
property ErrorMessage: String read FErrorMessage;
|
|
property ErrorCode: Integer read FErrorCode;
|
|
|
|
function IsConnecting: Boolean;
|
|
function IsConnectingOrConnected: Boolean;
|
|
function IsConnected: Boolean;
|
|
function IsConnectionClosed: Boolean;
|
|
function IsShutdownComplete: Boolean;
|
|
function IsStopping: Boolean;
|
|
|
|
property Active: Boolean read FActive write SetActive default False;
|
|
procedure Start; //// AWaitConnectionActive
|
|
procedure Stop;
|
|
|
|
procedure Shutdown;
|
|
procedure Close;
|
|
|
|
// TLS
|
|
{$IFDEF TCPCLIENT_TLS}
|
|
property TLSClient: TTLSClient read GetTLSClient;
|
|
procedure StartTLS;
|
|
{$ENDIF}
|
|
|
|
// The Connection property is only available when the client is active,
|
|
// when not active it is nil.
|
|
property Connection: TTCPConnection read GetConnection;
|
|
|
|
// The BlockingConnection can be used in the worker thread for blocking
|
|
// operations.
|
|
// Note: These BlockingConnection should not be used from this object's
|
|
// event handlers.
|
|
property BlockingConnection: TTCPBlockingConnection read GetBlockingConnection;
|
|
|
|
// Worker thread
|
|
// When UseWorkerThread is True, the client will have a worker thread
|
|
// created when it is in the Ready state. OnWorkerExecute will
|
|
// be called where the client can use the blocking connection interface.
|
|
property UseWorkerThread: Boolean read FUseWorkerThread write SetUseWorkerThread default False;
|
|
property OnWorkerExecute: TTCPClientWorkerExecuteEvent read FOnWorkerExecute write FOnWorkerExecute;
|
|
|
|
// Wait events
|
|
// Called by wait loops in this class (WaitForStartup, WaitForState)
|
|
// When blocking occurs in the main thread, OnMainThreadWait is called.
|
|
// When blocking occurs in another thread, OnThreadWait is called.
|
|
// Usually the handler for OnMainThreadWait calls Application.ProcessMessages.
|
|
property OnMainThreadWait: TTCPClientNotifyEvent read FOnMainThreadWait write FOnMainThreadWait;
|
|
property OnThreadWait: TTCPClientNotifyEvent read FOnThreadWait write FOnThreadWait;
|
|
|
|
// Blocking helpers
|
|
// These functions will block until a result is available or timeout expires.
|
|
// If TimeOut is set to -1 the function may wait indefinetely for result.
|
|
// Note: These functions should not be called from this object's event handlers.
|
|
function WaitForState(const AStates: TTCPClientStates; const ATimeOutMs: Integer): TTCPClientState;
|
|
function WaitForConnect(const ATimeOutMs: Integer): Boolean;
|
|
function WaitForClose(const ATimeOutMs: Integer): Boolean;
|
|
|
|
// User defined values
|
|
property UserTag: NativeInt read FUserTag write FUserTag;
|
|
property UserObject: TObject read FUserObject write FUserObject;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ Component }
|
|
{ }
|
|
type
|
|
TfclTCPClient = class(TF5TCPClient)
|
|
published
|
|
property Active;
|
|
property AddressFamily;
|
|
property Host;
|
|
property Port;
|
|
property LocalHost;
|
|
property LocalPort;
|
|
|
|
property RetryFailedConnect;
|
|
property RetryFailedConnectDelaySec;
|
|
property RetryFailedConnectMaxAttempts;
|
|
property ReconnectOnDisconnect;
|
|
|
|
{$IFDEF TCPCLIENT_SOCKS}
|
|
property SocksHost;
|
|
property SocksPort;
|
|
property SocksAuth;
|
|
property SocksUsername;
|
|
property SocksPassword;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF TCPCLIENT_TLS}
|
|
property TLSEnabled;
|
|
property TLSOptions;
|
|
property TLSClientOptions;
|
|
property TLSVersionOptions;
|
|
property TLSKeyExchangeOptions;
|
|
property TLSCipherOptions;
|
|
property TLSHashOptions;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF TCPCLIENT_WEBSOCKET}
|
|
property WebSocketEnabled;
|
|
property WebSocketURI;
|
|
property WebSocketOrigin;
|
|
property WebSocketProtocol;
|
|
{$ENDIF}
|
|
|
|
property SynchronisedEvents;
|
|
property WaitForStartup;
|
|
|
|
property OnLog;
|
|
property OnError;
|
|
property OnStart;
|
|
property OnStop;
|
|
property OnActive;
|
|
property OnInactive;
|
|
property OnProcessThreadIdle;
|
|
property OnStateChanged;
|
|
property OnStarted;
|
|
property OnConnected;
|
|
property OnConnectFailed;
|
|
property OnNegotiating;
|
|
property OnReady;
|
|
property OnRead;
|
|
property OnWrite;
|
|
property OnReadShutdown;
|
|
property OnShutdown;
|
|
property OnClose;
|
|
property OnStopped;
|
|
|
|
property UseWorkerThread;
|
|
property OnWorkerExecute;
|
|
|
|
property OnThreadWait;
|
|
property OnMainThreadWait;
|
|
|
|
property UserTag;
|
|
property UserObject;
|
|
end;
|
|
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
{ Utils }
|
|
|
|
flcStdTypes,
|
|
|
|
{ TCP }
|
|
|
|
flcTCPUtils;
|
|
|
|
|
|
|
|
{ }
|
|
{ Error and debug strings }
|
|
{ }
|
|
const
|
|
SError_NotAllowedWhileActive = 'Operation not allowed while active';
|
|
SError_NotAllowedWhileInactive = 'Operation not allowed while inactive';
|
|
SError_TLSNotActive = 'TLS not active';
|
|
SError_ProxyNotReady = 'Proxy not ready';
|
|
SError_InvalidParameter = 'Invalid parameter';
|
|
SError_StartupFailed = 'Startup failed';
|
|
SError_HostNotSpecified = 'Host not specified';
|
|
SError_PortNotSpecified = 'Port not specified';
|
|
SError_Terminated = 'Terminated';
|
|
SError_TimedOut = 'Timed out';
|
|
|
|
SClientState : array[TTCPClientState] of String = (
|
|
'Initialise',
|
|
'Starting',
|
|
'Started',
|
|
'Connect retry',
|
|
'Resolving local',
|
|
'Resolved local',
|
|
'Bound',
|
|
'Resolving',
|
|
'Resolved',
|
|
'Connecting',
|
|
'Connected',
|
|
'Negotiating proxy',
|
|
'Ready',
|
|
'Closed',
|
|
'Stopped');
|
|
|
|
|
|
|
|
{ }
|
|
{ TCP Client State }
|
|
{ }
|
|
const
|
|
TCPClientStates_All = [
|
|
csInit,
|
|
csStarting,
|
|
csStarted,
|
|
csConnectRetry,
|
|
csResolvingLocal,
|
|
csResolvedLocal,
|
|
csBound,
|
|
csResolving,
|
|
csResolved,
|
|
csConnecting,
|
|
csConnected,
|
|
csNegotiating,
|
|
csReady,
|
|
csClosed,
|
|
csStopped
|
|
];
|
|
|
|
TCPClientStates_Connecting = [
|
|
csStarting,
|
|
csStarted,
|
|
csConnectRetry,
|
|
csResolvingLocal,
|
|
csResolvedLocal,
|
|
csBound,
|
|
csResolving,
|
|
csResolved,
|
|
csConnecting,
|
|
csConnected,
|
|
csNegotiating
|
|
];
|
|
|
|
TCPClientStates_ConnectingOrConnected =
|
|
TCPClientStates_Connecting + [
|
|
csReady
|
|
];
|
|
|
|
TCPClientStates_Connected = [
|
|
csReady
|
|
];
|
|
|
|
TCPClientStates_Closed = [
|
|
csInit,
|
|
csClosed,
|
|
csStopped
|
|
];
|
|
|
|
|
|
|
|
{ }
|
|
{ TCP Client Socks Connection Proxy }
|
|
{ }
|
|
{$IFDEF TCPCLIENT_SOCKS}
|
|
type
|
|
TTCPClientSocksConnectionProxy = class(TTCPConnectionProxy)
|
|
private
|
|
FTCPClient : TF5TCPClient;
|
|
FSocksClient : TSocksClient;
|
|
|
|
procedure SocksClientClientWrite(const Client: TSocksClient; const Buf; const BufSize: Integer);
|
|
|
|
public
|
|
class function ProxyName: String; override;
|
|
|
|
constructor Create(const TCPClient: TF5TCPClient);
|
|
destructor Destroy; override;
|
|
|
|
procedure ProxyStart; override;
|
|
procedure ProcessReadData(const Buf; const BufSize: Integer); override;
|
|
procedure ProcessWriteData(const Buf; const BufSize: Integer); override;
|
|
end;
|
|
|
|
class function TTCPClientSocksConnectionProxy.ProxyName: String;
|
|
begin
|
|
Result := 'Socks';
|
|
end;
|
|
|
|
constructor TTCPClientSocksConnectionProxy.Create(const TCPClient: TF5TCPClient);
|
|
begin
|
|
Assert(Assigned(TCPClient));
|
|
inherited Create(TCPClient.Connection);
|
|
FTCPClient := TCPClient;
|
|
FSocksClient := TSocksClient.Create;
|
|
FSocksClient.OnClientWrite := SocksClientClientWrite;
|
|
end;
|
|
|
|
destructor TTCPClientSocksConnectionProxy.Destroy;
|
|
begin
|
|
FreeAndNil(FSocksClient);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TTCPClientSocksConnectionProxy.ProxyStart;
|
|
begin
|
|
SetState(prsNegotiating);
|
|
// initialise socks client parameters
|
|
FSocksClient.SocksVersion := scvSocks5;
|
|
case FTCPClient.FSocksResolvedAddr.AddrFamily of
|
|
iaIP4 :
|
|
begin
|
|
FSocksClient.AddrType := scaIP4;
|
|
FSocksClient.AddrIP4 := FTCPClient.FSocksResolvedAddr.AddrIP4;
|
|
end;
|
|
iaIP6 :
|
|
begin
|
|
FSocksClient.AddrType := scaIP6;
|
|
FSocksClient.AddrIP6 := FTCPClient.FSocksResolvedAddr.AddrIP6;
|
|
end;
|
|
else
|
|
raise ETCPClient.Create(SError_InvalidParameter);
|
|
end;
|
|
FSocksClient.AddrPort := FTCPClient.FSocksResolvedAddr.Port;
|
|
if FTCPClient.SocksAuth then
|
|
begin
|
|
FSocksClient.AuthMethod := scamSocks5UserPass;
|
|
FSocksClient.UserID := FTCPClient.FSocksUsername;
|
|
FSocksClient.Password := FTCPClient.FSocksPassword;
|
|
end
|
|
else
|
|
FSocksClient.AuthMethod := scamNone;
|
|
// connect
|
|
FSocksClient.Connect;
|
|
end;
|
|
|
|
procedure TTCPClientSocksConnectionProxy.SocksClientClientWrite(const Client: TSocksClient; const Buf; const BufSize: Integer);
|
|
begin
|
|
ConnectionPutWriteData(Buf, BufSize);
|
|
end;
|
|
|
|
procedure TTCPClientSocksConnectionProxy.ProcessReadData(const Buf; const BufSize: Integer);
|
|
begin
|
|
// check if negotiation completed previously
|
|
case FSocksClient.ReqState of
|
|
scrsSuccess : ConnectionPutReadData(Buf, BufSize); // pass data to connection
|
|
scrsFailed : ;
|
|
else
|
|
// pass data to socks client
|
|
FSocksClient.ClientData(Buf, BufSize);
|
|
// check completion
|
|
case FSocksClient.ReqState of
|
|
scrsSuccess : SetState(prsFinished);
|
|
scrsFailed : SetState(prsError);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TTCPClientSocksConnectionProxy.ProcessWriteData(const Buf; const BufSize: Integer);
|
|
begin
|
|
if FSocksClient.ReqState <> scrsSuccess then
|
|
raise ETCPClient.Create(SError_ProxyNotReady);
|
|
ConnectionPutWriteData(Buf, BufSize);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
{ }
|
|
{ TCP Client TLS Connection Proxy }
|
|
{ }
|
|
{$IFDEF TCPCLIENT_TLS}
|
|
type
|
|
TTCPClientTLSConnectionProxy = class(TTCPConnectionProxy)
|
|
private
|
|
FTCPClient : TF5TCPClient;
|
|
FTLSClient : TTLSClient;
|
|
|
|
procedure TLSClientTransportLayerSendProc(const Sender: TTLSConnection; const Buffer; const Size: Integer);
|
|
procedure TLSClientLog(Sender: TTLSConnection; LogType: TTLSLogType; LogMsg: String; LogLevel: Integer);
|
|
procedure TLSClientStateChange(Sender: TTLSConnection; State: TTLSConnectionState);
|
|
|
|
public
|
|
class function ProxyName: String; override;
|
|
|
|
constructor Create(const ATCPClient: TF5TCPClient);
|
|
destructor Destroy; override;
|
|
|
|
procedure ProxyStart; override;
|
|
procedure ProcessReadData(const Buf; const BufSize: Integer); override;
|
|
procedure ProcessWriteData(const Buf; const BufSize: Integer); override;
|
|
end;
|
|
|
|
class function TTCPClientTLSConnectionProxy.ProxyName: String;
|
|
begin
|
|
Result := 'TLS';
|
|
end;
|
|
|
|
constructor TTCPClientTLSConnectionProxy.Create(const ATCPClient: TF5TCPClient);
|
|
begin
|
|
Assert(Assigned(ATCPClient));
|
|
|
|
inherited Create;
|
|
|
|
FTCPClient := ATCPClient;
|
|
|
|
FTLSClient := TTLSClient.Create(TLSClientTransportLayerSendProc);
|
|
|
|
FTLSClient.OnLog := TLSClientLog;
|
|
FTLSClient.OnStateChange := TLSClientStateChange;
|
|
FTLSClient.ClientOptions := FTCPClient.TLSClientOptions;
|
|
|
|
FTLSClient.VersionOptions := FTCPClient.TLSVersionOptions;
|
|
FTLSClient.KeyExchangeOptions := FTCPClient.TLSKeyExchangeOptions;
|
|
FTLSClient.CipherOptions := FTCPClient.TLSCipherOptions;
|
|
FTLSClient.HashOptions := FTCPClient.TLSHashOptions;
|
|
end;
|
|
|
|
destructor TTCPClientTLSConnectionProxy.Destroy;
|
|
begin
|
|
FreeAndNil(FTLSClient);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TTCPClientTLSConnectionProxy.ProxyStart;
|
|
begin
|
|
SetState(prsNegotiating);
|
|
FTLSClient.Start;
|
|
end;
|
|
|
|
procedure TTCPClientTLSConnectionProxy.TLSClientTransportLayerSendProc(const Sender: TTLSConnection; const Buffer; const Size: Integer);
|
|
begin
|
|
ConnectionPutWriteData(Buffer, Size);
|
|
end;
|
|
|
|
procedure TTCPClientTLSConnectionProxy.TLSClientLog(Sender: TTLSConnection; LogType: TTLSLogType; LogMsg: String; LogLevel: Integer);
|
|
begin
|
|
{$IFDEF TCP_DEBUG_TLS}
|
|
Log(tlDebug, 'TLS:%s', [LogMsg], LogLevel + 1);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TTCPClientTLSConnectionProxy.TLSClientStateChange(Sender: TTLSConnection; State: TTLSConnectionState);
|
|
begin
|
|
case State of
|
|
tlscoApplicationData : SetState(prsFiltering);
|
|
tlscoCancelled,
|
|
tlscoErrorBadProtocol :
|
|
begin
|
|
ConnectionClose;
|
|
FErrorMessage := Sender.ConnectionErrorMessage;
|
|
SetState(prsError);
|
|
end;
|
|
tlscoClosed :
|
|
begin
|
|
ConnectionClose;
|
|
SetState(prsClosed);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TTCPClientTLSConnectionProxy.ProcessReadData(const Buf; const BufSize: Integer);
|
|
const
|
|
ReadBufSize = TLS_PLAINTEXT_FRAGMENT_MAXSIZE * 2;
|
|
var
|
|
ReadBuf : array[0..ReadBufSize - 1] of Byte;
|
|
L : Integer;
|
|
begin
|
|
{$IFDEF TCP_DEBUG_DATA}
|
|
Log(tlDebug, 'ProcessReadData:%db', [BufSize]);
|
|
{$ENDIF}
|
|
|
|
FTLSClient.ProcessTransportLayerReceivedData(Buf, BufSize);
|
|
repeat
|
|
L := FTLSClient.AvailableToRead;
|
|
if L > ReadBufSize then
|
|
L := ReadBufSize;
|
|
if L > 0 then
|
|
begin
|
|
L := FTLSClient.Read(ReadBuf, L);
|
|
if L > 0 then
|
|
ConnectionPutReadData(ReadBuf, L);
|
|
end;
|
|
until L <= 0;
|
|
end;
|
|
|
|
procedure TTCPClientTLSConnectionProxy.ProcessWriteData(const Buf; const BufSize: Integer);
|
|
begin
|
|
{$IFDEF TCP_DEBUG_DATA}
|
|
Log(tlDebug, 'ProcessWriteData:%db', [BufSize]);
|
|
{$ENDIF}
|
|
|
|
FTLSClient.Write(Buf, BufSize);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
{ }
|
|
{ TCP Client WebSocket Connection Proxy }
|
|
{ }
|
|
{$IFDEF TCPCLIENT_WEBSOCKET}
|
|
type
|
|
TTCPClientWebSocketConnectionProxy = class(TTCPConnectionProxy)
|
|
private
|
|
FTCPClient : TF5TCPClient;
|
|
FWebSocketClient : TWebSocketClient;
|
|
|
|
procedure WebSocketConnectionTransportLayerSendProc(const Sender: TWebSocketConnection; const Buffer; const Size: Integer);
|
|
procedure WebSocketClientLog(Sender: TWebSocketConnection; LogType: TWebSocketLogType; LogMsg: String; LogLevel: Integer);
|
|
|
|
public
|
|
class function ProxyName: String; override;
|
|
|
|
constructor Create(const TCPClient: TF5TCPClient);
|
|
destructor Destroy; override;
|
|
|
|
procedure ProxyStart; override;
|
|
procedure ProcessReadData(const Buf; const BufSize: Integer); override;
|
|
procedure ProcessWriteData(const Buf; const BufSize: Integer); override;
|
|
end;
|
|
|
|
class function TTCPClientWebSocketConnectionProxy.ProxyName: String;
|
|
begin
|
|
Result := 'WebSocket';
|
|
end;
|
|
|
|
constructor TTCPClientWebSocketConnectionProxy.Create(const TCPClient: TF5TCPClient);
|
|
begin
|
|
Assert(Assigned(TCPClient));
|
|
|
|
inherited Create(TCPClient.FConnection);
|
|
FTCPClient := TCPClient;
|
|
FWebSocketClient := TWebSocketClient.Create(WebSocketConnectionTransportLayerSendProc);
|
|
FWebSocketClient.OnLog := WebSocketClientLog;
|
|
end;
|
|
|
|
destructor TTCPClientWebSocketConnectionProxy.Destroy;
|
|
begin
|
|
FreeAndNil(FWebSocketClient);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TTCPClientWebSocketConnectionProxy.WebSocketConnectionTransportLayerSendProc(const Sender: TWebSocketConnection; const Buffer; const Size: Integer);
|
|
begin
|
|
ConnectionPutWriteData(Buffer, Size);
|
|
end;
|
|
|
|
procedure TTCPClientWebSocketConnectionProxy.WebSocketClientLog(Sender: TWebSocketConnection; LogType: TWebSocketLogType; LogMsg: String; LogLevel: Integer);
|
|
begin
|
|
{$IFDEF TCP_DEBUG_WEBSOCKET}
|
|
Log(tlDebug, 'WebSocket:%s', [LogMsg], LogLevel + 1);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TTCPClientWebSocketConnectionProxy.ProxyStart;
|
|
begin
|
|
SetState(prsNegotiating);
|
|
FWebSocketClient.Host := FTCPClient.FHost;
|
|
FWebSocketClient.URI := FTCPClient.FWebSocketURI;
|
|
FWebSocketClient.Origin := FTCPClient.FWebSocketOrigin;
|
|
FWebSocketClient.WebSocketProtocol := FTCPClient.FWebSocketProtocol;
|
|
FWebSocketClient.Start;
|
|
end;
|
|
|
|
procedure TTCPClientWebSocketConnectionProxy.ProcessReadData(const Buf; const BufSize: Integer);
|
|
const
|
|
ReadBufSize = 65536;
|
|
var
|
|
ReadBuf : array[0..ReadBufSize - 1] of Byte;
|
|
L : Integer;
|
|
begin
|
|
{$IFDEF TCP_DEBUG_DATA}
|
|
Log(tlDebug, 'ProcessReadData:%db', [BufSize]);
|
|
{$ENDIF}
|
|
FWebSocketClient.ProcessTransportLayerReceivedData(Buf, BufSize);
|
|
repeat
|
|
L := FWebSocketClient.AvailableToRead;
|
|
if L > ReadBufSize then
|
|
L := ReadBufSize;
|
|
if L > 0 then
|
|
begin
|
|
L := FWebSocketClient.Read(ReadBuf, L);
|
|
if L > 0 then
|
|
ConnectionPutReadData(ReadBuf, L);
|
|
end;
|
|
until L <= 0;
|
|
end;
|
|
|
|
procedure TTCPClientWebSocketConnectionProxy.ProcessWriteData(const Buf; const BufSize: Integer);
|
|
begin
|
|
{$IFDEF TCP_DEBUG_DATA}
|
|
Log(tlDebug, 'ProcessWriteData:%db', [BufSize]);
|
|
{$ENDIF}
|
|
FWebSocketClient.Write(Buf, BufSize);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
{ }
|
|
{ TTCPClientProcessThread }
|
|
{ }
|
|
constructor TTCPClientProcessThread.Create(const ATCPClient: TF5TCPClient);
|
|
begin
|
|
Assert(Assigned(ATCPClient));
|
|
FTCPClient := ATCPClient;
|
|
FreeOnTerminate := False;
|
|
inherited Create(False);
|
|
end;
|
|
|
|
procedure TTCPClientProcessThread.Execute;
|
|
var
|
|
C : TF5TCPClient;
|
|
begin
|
|
C := FTCPClient;
|
|
Assert(Assigned(C));
|
|
if Terminated then
|
|
exit;
|
|
C.ProcessThreadExecute(self);
|
|
FTCPClient := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TTCPClientSyncLogData }
|
|
{ }
|
|
type
|
|
TTCPClientSyncLogData = record
|
|
LogType : TTCPClientLogType;
|
|
LogMsg : String;
|
|
LogLevel : Integer;
|
|
end;
|
|
PTCPClientSyncLogData = ^TTCPClientSyncLogData;
|
|
|
|
|
|
|
|
{ }
|
|
{ TTCPClient }
|
|
{ }
|
|
constructor TF5TCPClient.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
|
|
Init;
|
|
end;
|
|
|
|
procedure TF5TCPClient.Init;
|
|
begin
|
|
FState := csInit;
|
|
FActivateOnLoaded := False;
|
|
FLock := TCriticalSection.Create;
|
|
|
|
InitDefaults;
|
|
end;
|
|
|
|
procedure TF5TCPClient.InitDefaults;
|
|
begin
|
|
FActive := False;
|
|
FAddressFamily := cafIP4;
|
|
FRetryFailedConnect := False;
|
|
FRetryFailedConnectDelaySec := 60;
|
|
FRetryFailedConnectMaxAttempts := -1;
|
|
FReconnectOnDisconnect := False;
|
|
|
|
{$IFDEF TCPCLIENT_SOCKS}
|
|
FSocksEnabled := False;
|
|
FSocksAuth := False;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF TCPCLIENT_TLS}
|
|
FTLSEnabled := False;
|
|
FTLSOptions := DefaultTCPClientTLSOptions;
|
|
FTLSClientOptions := DefaultTLSClientOptions;
|
|
FTLSVersionOptions := DefaultTLSClientVersionOptions;
|
|
FTLSKeyExchangeOptions := DefaultTLSClientKeyExchangeOptions;
|
|
FTLSCipherOptions := DefaultTLSClientCipherOptions;
|
|
FTLSHashOptions := DefaultTLSClientHashOptions;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF TCPCLIENT_WEBSOCKET}
|
|
FWebSocketEnabled := False;
|
|
FWebSocketURI := '/';
|
|
{$ENDIF}
|
|
|
|
FSynchronisedEvents := False;
|
|
FWaitForStartup := False;
|
|
FTrackLastActivityTime := True;
|
|
FUseWorkerThread := False;
|
|
end;
|
|
|
|
destructor TF5TCPClient.Destroy;
|
|
var
|
|
I : Integer;
|
|
begin
|
|
if Assigned(FLock) then
|
|
FLock.Acquire;
|
|
if Assigned(FWaitStartEvent) and (FWaitStartCount > 0) then
|
|
FWaitStartEvent.SetEvent;
|
|
if Assigned(FLock) then
|
|
FLock.Release;
|
|
|
|
if Assigned(FSyncListLog) then
|
|
for I := FSyncListLog.Count - 1 downto 0 do
|
|
Dispose(PTCPClientSyncLogData(FSyncListLog.Items[I]));
|
|
FreeAndNil(FSyncListLog);
|
|
|
|
if Assigned(FProcessThread) then
|
|
try
|
|
if not FProcessThread.Terminated then
|
|
FProcessThread.Terminate;
|
|
FProcessThread.WaitFor;
|
|
except
|
|
end;
|
|
FreeAndNil(FProcessThread);
|
|
|
|
FreeAndNil(FConnection);
|
|
FreeAndNil(FSocket);
|
|
|
|
//FreeAndNil(FWaitStartEvent);
|
|
FreeAndNil(FLock);
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TF5TCPClient.Finalise;
|
|
begin
|
|
if Assigned(FConnection) then
|
|
FConnection.Finalise;
|
|
end;
|
|
|
|
{ Lock }
|
|
|
|
procedure TF5TCPClient.Lock;
|
|
begin
|
|
Assert(Assigned(FLock));
|
|
FLock.Acquire;
|
|
end;
|
|
|
|
procedure TF5TCPClient.Unlock;
|
|
begin
|
|
Assert(Assigned(FLock));
|
|
FLock.Release;
|
|
end;
|
|
|
|
{ Synchronize }
|
|
|
|
procedure TF5TCPClient.Synchronize(const SyncProc: TSyncProc);
|
|
begin
|
|
{$IFDEF DELPHI6_DOWN}
|
|
{$IFDEF OS_MSWIN}
|
|
if GetCurrentThreadID = MainThreadID then
|
|
SyncProc
|
|
else
|
|
{$ENDIF}
|
|
if Assigned(FProcessThread) then
|
|
FProcessThread.Synchronize(SyncProc);
|
|
{$ELSE}
|
|
TThread.Synchronize(nil, SyncProc);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{ Log }
|
|
|
|
procedure TF5TCPClient.SyncLog;
|
|
var
|
|
SyncRec : PTCPClientSyncLogData;
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
exit;
|
|
Lock;
|
|
try
|
|
Assert(Assigned(FSyncListLog));
|
|
Assert(FSyncListLog.Count > 0);
|
|
SyncRec := FSyncListLog.Items[0];
|
|
FSyncListLog.Delete(0);
|
|
finally
|
|
Unlock;
|
|
end;
|
|
if Assigned(FOnLog) then
|
|
FOnLog(self, SyncRec.LogType, SyncRec.LogMsg, SyncRec.LogLevel);
|
|
Dispose(SyncRec);
|
|
end;
|
|
|
|
procedure TF5TCPClient.Log(const LogType: TTCPClientLogType; const Msg: String; const LogLevel: Integer);
|
|
var
|
|
SyncRec : PTCPClientSyncLogData;
|
|
begin
|
|
if Assigned(FOnLog) then
|
|
if FSynchronisedEvents {$IFDEF OS_MSWIN}and (GetCurrentThreadID <> MainThreadID){$ENDIF} then
|
|
begin
|
|
New(SyncRec);
|
|
SyncRec.LogType := LogType;
|
|
SyncRec.LogMsg := Msg;
|
|
SyncRec.LogLevel := LogLevel;
|
|
Lock;
|
|
try
|
|
if not Assigned(FSyncListLog) then
|
|
FSyncListLog := TList.Create;
|
|
FSyncListLog.Add(SyncRec);
|
|
finally
|
|
Unlock;
|
|
end;
|
|
Synchronize(SyncLog);
|
|
end
|
|
else
|
|
FOnLog(Self, LogType, Msg, LogLevel);
|
|
end;
|
|
|
|
procedure TF5TCPClient.Log(const LogType: TTCPClientLogType; const Msg: String;
|
|
const Args: array of const; const LogLevel: Integer);
|
|
begin
|
|
Log(LogType, Format(Msg, Args), LogLevel);
|
|
end;
|
|
|
|
{ State }
|
|
|
|
function TF5TCPClient.GetState: TTCPClientState;
|
|
begin
|
|
Lock;
|
|
try
|
|
Result := FState;
|
|
finally
|
|
Unlock;
|
|
end;
|
|
end;
|
|
|
|
function TF5TCPClient.GetStateStr: String;
|
|
begin
|
|
Result := SClientState[GetState];
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetState(const AState: TTCPClientState);
|
|
begin
|
|
Lock;
|
|
try
|
|
Assert(AState <> FState);
|
|
FState := AState;
|
|
finally
|
|
Unlock;
|
|
end;
|
|
TriggerStateChanged;
|
|
end;
|
|
|
|
procedure TF5TCPClient.CheckNotActive;
|
|
begin
|
|
if not (csDesigning in ComponentState) then
|
|
if FActive then
|
|
raise ETCPClient.Create(SError_NotAllowedWhileActive);
|
|
end;
|
|
|
|
procedure TF5TCPClient.CheckActive;
|
|
begin
|
|
if not FActive then
|
|
raise ETCPClient.Create(SError_NotAllowedWhileInactive);
|
|
end;
|
|
|
|
{ Property setters }
|
|
|
|
procedure TF5TCPClient.SetAddressFamily(const AAddressFamily: TTCPClientAddressFamily);
|
|
begin
|
|
if AAddressFamily = FAddressFamily then
|
|
exit;
|
|
CheckNotActive;
|
|
FAddressFamily := AAddressFamily;
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetHost(const AHost: String);
|
|
begin
|
|
if AHost = FHost then
|
|
exit;
|
|
CheckNotActive;
|
|
FHost := AHost;
|
|
|
|
{$IFDEF TCP_DEBUG}
|
|
Log(cltDebug, 'Host:%s', [AHost]);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetPort(const APort: String);
|
|
begin
|
|
if APort = FPort then
|
|
exit;
|
|
CheckNotActive;
|
|
FPort := APort;
|
|
|
|
{$IFDEF TCP_DEBUG}
|
|
Log(cltDebug, 'Port:%s', [APort]);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TF5TCPClient.GetPortInt: Integer;
|
|
begin
|
|
Result := StrToIntDef(FPort, -1)
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetPortInt(const APortInt: Integer);
|
|
begin
|
|
SetPort(IntToStr(APortInt));
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetLocalHost(const ALocalHost: String);
|
|
begin
|
|
if ALocalHost = FLocalHost then
|
|
exit;
|
|
CheckNotActive;
|
|
FLocalHost := ALocalHost;
|
|
|
|
{$IFDEF TCP_DEBUG}
|
|
Log(cltDebug, 'LocalHost:%s', [ALocalHost]);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetLocalPort(const ALocalPort: String);
|
|
begin
|
|
if ALocalPort = FLocalPort then
|
|
exit;
|
|
CheckNotActive;
|
|
FLocalPort := ALocalPort;
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetRetryFailedConnect(const ARetryFailedConnect: Boolean);
|
|
begin
|
|
if ARetryFailedConnect = FRetryFailedConnect then
|
|
exit;
|
|
CheckNotActive;
|
|
FRetryFailedConnect := ARetryFailedConnect;
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetRetryFailedConnectDelaySec(const ARetryFailedConnectDelaySec: Integer);
|
|
begin
|
|
if ARetryFailedConnectDelaySec = FRetryFailedConnectDelaySec then
|
|
exit;
|
|
CheckNotActive;
|
|
FRetryFailedConnectDelaySec := ARetryFailedConnectDelaySec;
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetRetryFailedConnectMaxAttempts(const ARetryFailedConnectMaxAttempts: Integer);
|
|
begin
|
|
if ARetryFailedConnectMaxAttempts = FRetryFailedConnectMaxAttempts then
|
|
exit;
|
|
CheckNotActive;
|
|
FRetryFailedConnectMaxAttempts := ARetryFailedConnectMaxAttempts;
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetReconnectOnDisconnect(const AReconnectOnDisconnect: Boolean);
|
|
begin
|
|
if AReconnectOnDisconnect = FReconnectOnDisconnect then
|
|
exit;
|
|
CheckNotActive;
|
|
FReconnectOnDisconnect := AReconnectOnDisconnect;
|
|
end;
|
|
|
|
{$IFDEF TCPCLIENT_SOCKS}
|
|
procedure TF5TCPClient.SetSocksProxy(const SocksProxy: Boolean);
|
|
begin
|
|
if SocksProxy = FSocksEnabled then
|
|
exit;
|
|
CheckNotActive;
|
|
FSocksEnabled := SocksProxy;
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetSocksHost(const SocksHost: RawByteString);
|
|
begin
|
|
if SocksHost = FSocksHost then
|
|
exit;
|
|
CheckNotActive;
|
|
FSocksHost := SocksHost;
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetSocksPort(const SocksPort: RawByteString);
|
|
begin
|
|
if SocksPort = FSocksPort then
|
|
exit;
|
|
CheckNotActive;
|
|
FSocksHost := SocksHost;
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetSocksAuth(const SocksAuth: Boolean);
|
|
begin
|
|
if SocksAuth = FSocksAuth then
|
|
exit;
|
|
CheckNotActive;
|
|
FSocksAuth := SocksAuth;
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetSocksUsername(const SocksUsername: RawByteString);
|
|
begin
|
|
if SocksUsername = FSocksUsername then
|
|
exit;
|
|
CheckNotActive;
|
|
FSocksUsername := SocksUsername;
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetSocksPassword(const SocksPassword: RawByteString);
|
|
begin
|
|
if SocksPassword = FSocksPassword then
|
|
exit;
|
|
CheckNotActive;
|
|
FSocksPassword := SocksPassword;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF TCPCLIENT_TLS}
|
|
procedure TF5TCPClient.SetTLSEnabled(const ATLSEnabled: Boolean);
|
|
begin
|
|
if ATLSEnabled = FTLSEnabled then
|
|
exit;
|
|
CheckNotActive;
|
|
FTLSEnabled := ATLSEnabled;
|
|
|
|
{$IFDEF TCP_DEBUG_TLS}
|
|
Log(cltDebug, 'TLSEnabled:%d', [Ord(ATLSEnabled)]);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetTLSOptions(const ATLSOptions: TTCPClientTLSOptions);
|
|
begin
|
|
if ATLSOptions = FTLSOptions then
|
|
exit;
|
|
CheckNotActive;
|
|
FTLSOptions := ATLSOptions;
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetTLSClientOptions(const ATLSClientOptions: TTCPClientTLSClientOptions);
|
|
begin
|
|
if ATLSClientOptions = FTLSClientOptions then
|
|
exit;
|
|
CheckNotActive;
|
|
FTLSClientOptions := ATLSClientOptions;
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetTLSVersionOptions(const ATLSVersionOptions: TTCPClientTLSVersionOptions);
|
|
begin
|
|
if ATLSVersionOptions = FTLSVersionOptions then
|
|
exit;
|
|
CheckNotActive;
|
|
FTLSVersionOptions := ATLSVersionOptions;
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetTLSKeyExchangeOptions(const ATLSKeyExchangeOptions: TTCPClientTLSKeyExchangeOptions);
|
|
begin
|
|
if ATLSKeyExchangeOptions = FTLSKeyExchangeOptions then
|
|
exit;
|
|
CheckNotActive;
|
|
FTLSKeyExchangeOptions := ATLSKeyExchangeOptions;
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetTLSCipherOptions(const ATLSCipherOptions: TTCPClientTLSCipherOptions);
|
|
begin
|
|
if ATLSCipherOptions = FTLSCipherOptions then
|
|
exit;
|
|
CheckNotActive;
|
|
FTLSCipherOptions := ATLSCipherOptions;
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetTLSHashOptions(const ATLSHashOptions: TTCPClientTLSHashOptions);
|
|
begin
|
|
if ATLSHashOptions = FTLSHashOptions then
|
|
exit;
|
|
CheckNotActive;
|
|
FTLSHashOptions := ATLSHashOptions;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF TCPCLIENT_WEBSOCKET}
|
|
procedure TF5TCPClient.SetWebSocketEnabled(const WebSocketEnabled: Boolean);
|
|
begin
|
|
if WebSocketEnabled = FWebSocketEnabled then
|
|
exit;
|
|
CheckNotActive;
|
|
FWebSocketEnabled := WebSocketEnabled;
|
|
|
|
{$IFDEF TCP_DEBUG_WEBSOCKET}
|
|
Log(cltDebug, 'WebSocketEnabled:%d', [Ord(WebSocketEnabled)]);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetWebSocketURI(const WebSocketURI: RawByteString);
|
|
begin
|
|
if WebSocketURI = FWebSocketURI then
|
|
exit;
|
|
CheckNotActive;
|
|
FWebSocketURI := WebSocketURI;
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetWebSocketOrigin(const WebSocketOrigin: RawByteString);
|
|
begin
|
|
if WebSocketOrigin = FWebSocketOrigin then
|
|
exit;
|
|
CheckNotActive;
|
|
FWebSocketOrigin := WebSocketOrigin;
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetWebSocketProtocol(const WebSocketProtocol: RawByteString);
|
|
begin
|
|
if WebSocketProtocol = FWebSocketProtocol then
|
|
exit;
|
|
CheckNotActive;
|
|
FWebSocketProtocol := WebSocketProtocol;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TF5TCPClient.SetUseWorkerThread(const AUseWorkerThread: Boolean);
|
|
begin
|
|
if AUseWorkerThread = FUseWorkerThread then
|
|
exit;
|
|
CheckNotActive;
|
|
FUseWorkerThread := AUseWorkerThread;
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetSynchronisedEvents(const ASynchronisedEvents: Boolean);
|
|
begin
|
|
if ASynchronisedEvents = FSynchronisedEvents then
|
|
exit;
|
|
CheckNotActive;
|
|
FSynchronisedEvents := ASynchronisedEvents;
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetWaitForStartup(const AWaitForStartup: Boolean);
|
|
begin
|
|
if AWaitForStartup = FWaitForStartup then
|
|
exit;
|
|
CheckNotActive;
|
|
FWaitForStartup := AWaitForStartup;
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetActive(const AActive: Boolean);
|
|
begin
|
|
if csDesigning in ComponentState then
|
|
FActive := AActive else
|
|
if csLoading in ComponentState then
|
|
FActivateOnLoaded := AActive
|
|
else
|
|
if AActive then
|
|
ClientSetActive
|
|
else
|
|
ClientSetInactive;
|
|
end;
|
|
|
|
procedure TF5TCPClient.Loaded;
|
|
begin
|
|
inherited Loaded;
|
|
|
|
if FActivateOnLoaded then
|
|
ClientSetActive;
|
|
end;
|
|
|
|
{ SyncTrigger }
|
|
|
|
procedure TF5TCPClient.SyncTriggerError;
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
exit;
|
|
if Assigned(FOnError) then
|
|
FOnError(self, FErrorMessage, FErrorCode);
|
|
end;
|
|
|
|
procedure TF5TCPClient.SyncTriggerStateChanged;
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
exit;
|
|
if Assigned(FOnStateChanged) then
|
|
FOnStateChanged(self, FState);
|
|
end;
|
|
|
|
procedure TF5TCPClient.SyncTriggerStart;
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
exit;
|
|
if Assigned(FOnStart) then
|
|
FOnStart(self);
|
|
end;
|
|
|
|
procedure TF5TCPClient.SyncTriggerStop;
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
exit;
|
|
if Assigned(FOnStop) then
|
|
FOnStop(self);
|
|
end;
|
|
|
|
procedure TF5TCPClient.SyncTriggerActive;
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
exit;
|
|
if Assigned(FOnActive) then
|
|
FOnActive(self);
|
|
end;
|
|
|
|
procedure TF5TCPClient.SyncTriggerInactive;
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
exit;
|
|
if Assigned(FOnInactive) then
|
|
FOnInactive(self);
|
|
end;
|
|
|
|
procedure TF5TCPClient.SyncTriggerStarted;
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
exit;
|
|
if Assigned(FOnStarted) then
|
|
FOnStarted(self);
|
|
end;
|
|
|
|
procedure TF5TCPClient.SyncTriggerConnected;
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
exit;
|
|
if Assigned(FOnConnected) then
|
|
FOnConnected(self);
|
|
end;
|
|
|
|
procedure TF5TCPClient.SyncTriggerNegotiating;
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
exit;
|
|
if Assigned(FOnNegotiating) then
|
|
FOnNegotiating(self);
|
|
end;
|
|
|
|
procedure TF5TCPClient.SyncTriggerConnectFailed;
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
exit;
|
|
if Assigned(FOnConnectFailed) then
|
|
FOnConnectFailed(self);
|
|
end;
|
|
|
|
procedure TF5TCPClient.SyncTriggerReady;
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
exit;
|
|
if Assigned(FOnReady) then
|
|
FOnReady(self);
|
|
end;
|
|
|
|
procedure TF5TCPClient.SyncTriggerReadShutdown;
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
exit;
|
|
if Assigned(FOnReadShutdown) then
|
|
FOnReadShutdown(self);
|
|
end;
|
|
|
|
procedure TF5TCPClient.SyncTriggerShutdown;
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
exit;
|
|
if Assigned(FOnShutdown) then
|
|
FOnShutdown(self);
|
|
end;
|
|
|
|
procedure TF5TCPClient.SyncTriggerClose;
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
exit;
|
|
if Assigned(FOnClose) then
|
|
FOnClose(self);
|
|
end;
|
|
|
|
procedure TF5TCPClient.SyncTriggerStopped;
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
exit;
|
|
if Assigned(FOnStopped) then
|
|
FOnStopped(self);
|
|
end;
|
|
|
|
procedure TF5TCPClient.SyncTriggerRead;
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
exit;
|
|
if Assigned(FOnRead) then
|
|
FOnRead(self);
|
|
end;
|
|
|
|
procedure TF5TCPClient.SyncTriggerWrite;
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
exit;
|
|
if Assigned(FOnWrite) then
|
|
FOnWrite(self);
|
|
end;
|
|
|
|
procedure TF5TCPClient.SyncTriggerReadActivity;
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
exit;
|
|
if Assigned(FOnReadActivity) then
|
|
FOnReadActivity(self);
|
|
end;
|
|
|
|
procedure TF5TCPClient.SyncTriggerWriteActivity;
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
exit;
|
|
if Assigned(FOnWriteActivity) then
|
|
FOnWriteActivity(self);
|
|
end;
|
|
|
|
{ Trigger }
|
|
|
|
procedure TF5TCPClient.TriggerError;
|
|
begin
|
|
Log(cltError, 'Error:%d:%s', [FErrorCode, FErrorMessage]);
|
|
if Assigned(FOnError) then
|
|
try
|
|
if FSynchronisedEvents then
|
|
Synchronize(SyncTriggerError)
|
|
else
|
|
FOnError(self, FErrorMessage, FErrorCode);
|
|
except
|
|
on E : Exception do
|
|
Log(cltError, 'TriggerError.Error:Error=%s[%s]', [E.ClassName, E.Message]);
|
|
end;
|
|
end;
|
|
|
|
procedure TF5TCPClient.TriggerStateChanged;
|
|
begin
|
|
{$IFDEF TCP_DEBUG}
|
|
Log(cltDebug, 'State:%s', [GetStateStr]);
|
|
{$ENDIF}
|
|
|
|
if Assigned(FOnStateChanged) then
|
|
try
|
|
if FSynchronisedEvents then
|
|
Synchronize(SyncTriggerStateChanged)
|
|
else
|
|
FOnStateChanged(self, FState);
|
|
except
|
|
on E : Exception do
|
|
Log(cltError, 'TriggerStateChanged.Error:Error=%s[%s]', [E.ClassName, E.Message]);
|
|
end;
|
|
end;
|
|
|
|
procedure TF5TCPClient.TriggerStart;
|
|
begin
|
|
{$IFDEF TCP_DEBUG}
|
|
Log(cltDebug, 'Start');
|
|
{$ENDIF}
|
|
|
|
if Assigned(FOnStart) then
|
|
try
|
|
if FSynchronisedEvents then
|
|
Synchronize(SyncTriggerStart)
|
|
else
|
|
FOnStart(self);
|
|
except
|
|
on E : Exception do
|
|
Log(cltError, 'TriggerStart.Error:Error=%s[%s]', [E.ClassName, E.Message]);
|
|
end;
|
|
end;
|
|
|
|
procedure TF5TCPClient.TriggerStop;
|
|
begin
|
|
{$IFDEF TCP_DEBUG}
|
|
Log(cltDebug, 'Stop');
|
|
{$ENDIF}
|
|
|
|
if Assigned(FOnStop) then
|
|
try
|
|
if FSynchronisedEvents then
|
|
Synchronize(SyncTriggerStop)
|
|
else
|
|
FOnStop(self);
|
|
except
|
|
on E : Exception do
|
|
Log(cltError, 'TriggerStop.Error:Error=%s[%s]', [E.ClassName, E.Message]);
|
|
end;
|
|
end;
|
|
|
|
procedure TF5TCPClient.TriggerActive;
|
|
begin
|
|
{$IFDEF TCP_DEBUG}
|
|
Log(cltDebug, 'Active');
|
|
{$ENDIF}
|
|
|
|
if Assigned(FOnActive) then
|
|
try
|
|
if FSynchronisedEvents then
|
|
Synchronize(SyncTriggerActive)
|
|
else
|
|
FOnActive(self);
|
|
except
|
|
on E : Exception do
|
|
Log(cltError, 'TriggerActive.Error:Error=%s[%s]', [E.ClassName, E.Message]);
|
|
end;
|
|
end;
|
|
|
|
procedure TF5TCPClient.TriggerInactive;
|
|
begin
|
|
{$IFDEF TCP_DEBUG}
|
|
Log(cltDebug, 'Inactive');
|
|
{$ENDIF}
|
|
|
|
if Assigned(FOnInactive) then
|
|
try
|
|
if FSynchronisedEvents then
|
|
Synchronize(SyncTriggerInactive)
|
|
else
|
|
FOnInactive(self);
|
|
except
|
|
on E : Exception do
|
|
Log(cltError, 'TriggerInactive.Error:Error=%s[%s]', [E.ClassName, E.Message]);
|
|
end;
|
|
end;
|
|
|
|
procedure TF5TCPClient.TriggerProcessThreadIdle;
|
|
begin
|
|
if Assigned(FOnProcessThreadIdle) then
|
|
FOnProcessThreadIdle(self);
|
|
Sleep(1);
|
|
end;
|
|
|
|
procedure TF5TCPClient.TriggerStarted;
|
|
begin
|
|
{$IFDEF TCP_DEBUG}
|
|
Log(cltDebug, 'Started');
|
|
{$ENDIF}
|
|
|
|
if Assigned(FOnStarted) then
|
|
try
|
|
if FSynchronisedEvents then
|
|
Synchronize(SyncTriggerStarted)
|
|
else
|
|
FOnStarted(self);
|
|
except
|
|
on E : Exception do
|
|
Log(cltError, 'TriggerStarted.Error:Error=%s[%s]', [E.ClassName, E.Message]);
|
|
end;
|
|
end;
|
|
|
|
procedure TF5TCPClient.TriggerConnected;
|
|
begin
|
|
{$IFDEF TCP_DEBUG}
|
|
Log(cltDebug, 'Connected');
|
|
{$ENDIF}
|
|
|
|
if Assigned(FOnConnected) then
|
|
try
|
|
if FSynchronisedEvents then
|
|
Synchronize(SyncTriggerConnected)
|
|
else
|
|
FOnConnected(self);
|
|
except
|
|
on E : Exception do
|
|
Log(cltError, 'TriggerConnected.Error:Error=%s[%s]', [E.ClassName, E.Message]);
|
|
end;
|
|
end;
|
|
|
|
procedure TF5TCPClient.TriggerNegotiating;
|
|
begin
|
|
{$IFDEF TCP_DEBUG}
|
|
Log(cltDebug, 'Negotiating');
|
|
{$ENDIF}
|
|
|
|
if Assigned(FOnNegotiating) then
|
|
if FSynchronisedEvents then
|
|
Synchronize(SyncTriggerNegotiating)
|
|
else
|
|
FOnNegotiating(self);
|
|
end;
|
|
|
|
procedure TF5TCPClient.TriggerConnectFailed;
|
|
begin
|
|
{$IFDEF TCP_DEBUG}
|
|
Log(cltDebug, 'ConnectFailed');
|
|
{$ENDIF}
|
|
|
|
if Assigned(FOnConnectFailed) then
|
|
try
|
|
if FSynchronisedEvents then
|
|
Synchronize(SyncTriggerConnectFailed)
|
|
else
|
|
FOnConnectFailed(self);
|
|
except
|
|
on E : Exception do
|
|
Log(cltError, 'TriggerConnectFailed.Error:Error=%s[%s]', [E.ClassName, E.Message]);
|
|
end;
|
|
end;
|
|
|
|
procedure TF5TCPClient.TriggerReady;
|
|
begin
|
|
{$IFDEF TCP_DEBUG}
|
|
Log(cltDebug, 'Ready');
|
|
{$ENDIF}
|
|
|
|
if Assigned(FOnReady) then
|
|
try
|
|
if FSynchronisedEvents then
|
|
Synchronize(SyncTriggerReady)
|
|
else
|
|
FOnReady(self);
|
|
except
|
|
on E : Exception do
|
|
Log(cltError, 'TriggerReady.Error:Error=%s[%s]', [E.ClassName, E.Message]);
|
|
end;
|
|
end;
|
|
|
|
procedure TF5TCPClient.TriggerShutdown;
|
|
begin
|
|
{$IFDEF TCP_DEBUG}
|
|
Log(cltDebug, 'Shutdown');
|
|
{$ENDIF}
|
|
|
|
if Assigned(FOnShutdown) then
|
|
try
|
|
if FSynchronisedEvents then
|
|
Synchronize(SyncTriggerShutdown)
|
|
else
|
|
FOnShutdown(self);
|
|
except
|
|
on E : Exception do
|
|
Log(cltError, 'TriggerShutdown.Error:Error=%s[%s]', [E.ClassName, E.Message]);
|
|
end;
|
|
end;
|
|
|
|
procedure TF5TCPClient.TriggerReadShutdown;
|
|
begin
|
|
{$IFDEF TCP_DEBUG}
|
|
Log(cltDebug, 'ReadShutdown');
|
|
{$ENDIF}
|
|
|
|
if Assigned(FOnReadShutdown) then
|
|
try
|
|
if FSynchronisedEvents then
|
|
Synchronize(SyncTriggerReadShutdown)
|
|
else
|
|
FOnReadShutdown(self);
|
|
except
|
|
on E : Exception do
|
|
Log(cltError, 'TriggerReadShutdown.Error:Error=%s[%s]', [E.ClassName, E.Message]);
|
|
end;
|
|
end;
|
|
|
|
procedure TF5TCPClient.TriggerClose;
|
|
begin
|
|
{$IFDEF TCP_DEBUG}
|
|
Log(cltDebug, 'Close');
|
|
{$ENDIF}
|
|
|
|
if Assigned(FOnClose) then
|
|
try
|
|
if FSynchronisedEvents then
|
|
Synchronize(SyncTriggerClose)
|
|
else
|
|
FOnClose(self);
|
|
except
|
|
on E : Exception do
|
|
Log(cltError, 'TriggerClose.Error:Error=%s[%s]', [E.ClassName, E.Message]);
|
|
end;
|
|
end;
|
|
|
|
procedure TF5TCPClient.TriggerStopped;
|
|
begin
|
|
{$IFDEF TCP_DEBUG}
|
|
Log(cltDebug, 'Stopped');
|
|
{$ENDIF}
|
|
|
|
if Assigned(FOnStopped) then
|
|
try
|
|
if FSynchronisedEvents then
|
|
Synchronize(SyncTriggerStopped)
|
|
else
|
|
FOnStopped(self);
|
|
except
|
|
on E : Exception do
|
|
Log(cltError, 'TriggerStopped.Error:Error=%s[%s]', [E.ClassName, E.Message]);
|
|
end;
|
|
end;
|
|
|
|
procedure TF5TCPClient.TriggerRead;
|
|
begin
|
|
{$IFDEF TCP_DEBUG_DATA}
|
|
Log(cltDebug, 'Read');
|
|
{$ENDIF}
|
|
|
|
if Assigned(FOnRead) then
|
|
try
|
|
if FSynchronisedEvents then
|
|
Synchronize(SyncTriggerRead)
|
|
else
|
|
FOnRead(self);
|
|
except
|
|
on E : Exception do
|
|
Log(cltError, 'TriggerRead.Error:Error=%s[%s]', [E.ClassName, E.Message]);
|
|
end;
|
|
end;
|
|
|
|
procedure TF5TCPClient.TriggerWrite;
|
|
begin
|
|
{$IFDEF TCP_DEBUG_DATA}
|
|
Log(cltDebug, 'Write');
|
|
{$ENDIF}
|
|
|
|
if Assigned(FOnWrite) then
|
|
try
|
|
if FSynchronisedEvents then
|
|
Synchronize(SyncTriggerWrite)
|
|
else
|
|
FOnWrite(self);
|
|
except
|
|
on E : Exception do
|
|
Log(cltError, 'TriggerWrite.Error:Error=%s[%s]', [E.ClassName, E.Message]);
|
|
end;
|
|
end;
|
|
|
|
procedure TF5TCPClient.TriggerReadActivity;
|
|
begin
|
|
{$IFDEF TCP_DEBUG_DATA}
|
|
Log(cltDebug, 'Activity');
|
|
{$ENDIF}
|
|
|
|
if Assigned(FOnReadActivity) then
|
|
try
|
|
if FSynchronisedEvents then
|
|
Synchronize(SyncTriggerReadActivity)
|
|
else
|
|
FOnReadActivity(self);
|
|
except
|
|
on E : Exception do
|
|
Log(cltError, 'TriggerReadActivity.Error:Error=%s[%s]', [E.ClassName, E.Message]);
|
|
end;
|
|
end;
|
|
|
|
procedure TF5TCPClient.TriggerWriteActivity;
|
|
begin
|
|
{$IFDEF TCP_DEBUG_DATA}
|
|
Log(cltDebug, 'Activity');
|
|
{$ENDIF}
|
|
|
|
if Assigned(FOnWriteActivity) then
|
|
try
|
|
if FSynchronisedEvents then
|
|
Synchronize(SyncTriggerWriteActivity)
|
|
else
|
|
FOnWriteActivity(self);
|
|
except
|
|
on E : Exception do
|
|
Log(cltError, 'TriggerWriteActivity.Error:Error=%s[%s]', [E.ClassName, E.Message]);
|
|
end;
|
|
end;
|
|
|
|
{ SetStates }
|
|
|
|
procedure TF5TCPClient.SetError(const AErrorMsg: String; const AErrorCode: Integer);
|
|
begin
|
|
{$IFDEF TCP_DEBUG}
|
|
Log(cltDebug, 'Error:%d:%s', [ErrorCode, ErrorMsg]);
|
|
{$ENDIF}
|
|
|
|
FErrorMessage := AErrorMsg;
|
|
FErrorCode := AErrorCode;
|
|
TriggerError;
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetStarted;
|
|
begin
|
|
SetState(csStarted);
|
|
TriggerStarted;
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetConnected;
|
|
begin
|
|
SetState(csConnected);
|
|
TriggerConnected;
|
|
FConnection.Start;
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetNegotiating;
|
|
begin
|
|
SetState(csNegotiating);
|
|
TriggerNegotiating;
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetReady;
|
|
begin
|
|
SetState(csReady);
|
|
TriggerReady;
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetClosed;
|
|
begin
|
|
Lock;
|
|
try
|
|
if FState in [csInit, csClosed, csStopped] then
|
|
exit;
|
|
FState := csClosed;
|
|
finally
|
|
Unlock;
|
|
end;
|
|
TriggerStateChanged;
|
|
TriggerClose;
|
|
end;
|
|
|
|
procedure TF5TCPClient.SetStopped;
|
|
begin
|
|
SetState(csStopped);
|
|
TriggerStopped;
|
|
end;
|
|
|
|
{ Socket }
|
|
|
|
procedure TF5TCPClient.SocketLog(Sender: TSysSocket; LogType: TSysSocketLogType; Msg: String);
|
|
begin
|
|
{$IFDEF TCP_DEBUG_SOCKET}
|
|
Log(cltDebug, 'Socket:%s', [Msg], 10);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{ Connection events }
|
|
|
|
procedure TF5TCPClient.ConnectionLog(Sender: TTCPConnection; LogType: TTCPLogType; LogMsg: String; LogLevel: Integer);
|
|
begin
|
|
{$IFDEF TCP_DEBUG_CONNECTION}
|
|
Log(cltDebug, 'Connection:%s', [LogMsg], LogLevel + 1);
|
|
{$ELSE}
|
|
if LogType = tlError then
|
|
Log(cltError, 'Connection:%s', [LogMsg], LogLevel + 1);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TF5TCPClient.ConnectionStateChange(Sender: TTCPConnection; State: TTCPConnectionState);
|
|
begin
|
|
{$IFDEF TCP_DEBUG_CONNECTION}
|
|
Log(cltDebug, 'Connection_StateChange:%s', [Sender.StateStr]);
|
|
{$ENDIF}
|
|
|
|
case State of
|
|
cnsProxyNegotiation : SetNegotiating;
|
|
cnsConnected : SetReady;
|
|
end;
|
|
end;
|
|
|
|
procedure TF5TCPClient.ConnectionReadShutdown(Sender: TTCPConnection);
|
|
begin
|
|
{$IFDEF TCP_DEBUG_CONNECTION}
|
|
Log(cltDebug, 'Connection_ReadShutdown');
|
|
{$ENDIF}
|
|
|
|
TriggerReadShutdown;
|
|
end;
|
|
|
|
procedure TF5TCPClient.ConnectionShutdown(Sender: TTCPConnection);
|
|
begin
|
|
{$IFDEF TCP_DEBUG_CONNECTION}
|
|
Log(cltDebug, 'Connection_Shutdown');
|
|
{$ENDIF}
|
|
|
|
TriggerShutdown;
|
|
end;
|
|
|
|
procedure TF5TCPClient.ConnectionClose(Sender: TTCPConnection);
|
|
begin
|
|
{$IFDEF TCP_DEBUG_CONNECTION}
|
|
Log(cltDebug, 'Connection_Close');
|
|
{$ENDIF}
|
|
|
|
SetClosed;
|
|
end;
|
|
|
|
procedure TF5TCPClient.ConnectionRead(Sender: TTCPConnection);
|
|
begin
|
|
{$IFDEF TCP_DEBUG_DATA}
|
|
Log(cltDebug, 'Connection_Read');
|
|
{$ENDIF}
|
|
|
|
TriggerRead;
|
|
end;
|
|
|
|
procedure TF5TCPClient.ConnectionWrite(Sender: TTCPConnection);
|
|
begin
|
|
{$IFDEF TCP_DEBUG_DATA}
|
|
Log(cltDebug, 'Connection_Write');
|
|
{$ENDIF}
|
|
|
|
TriggerWrite;
|
|
end;
|
|
|
|
procedure TF5TCPClient.ConnectionReadActivity(Sender: TTCPConnection);
|
|
begin
|
|
{$IFDEF TCP_DEBUG_DATA}
|
|
Log(cltDebug, 'Connection_ReadActivity');
|
|
{$ENDIF}
|
|
|
|
TriggerReadActivity;
|
|
end;
|
|
|
|
procedure TF5TCPClient.ConnectionWriteActivity(Sender: TTCPConnection);
|
|
begin
|
|
{$IFDEF TCP_DEBUG_DATA}
|
|
Log(cltDebug, 'Connection_WriteActivity');
|
|
{$ENDIF}
|
|
|
|
TriggerWriteActivity;
|
|
end;
|
|
|
|
procedure TF5TCPClient.ConnectionWorkerExecute(
|
|
Sender: TTCPConnection;
|
|
Connection: TTCPBlockingConnection;
|
|
var CloseOnExit: Boolean);
|
|
begin
|
|
if Assigned(FOnWorkerExecute) then
|
|
FOnWorkerExecute(self, Connection, CloseOnExit);
|
|
end;
|
|
|
|
{ Proxies }
|
|
|
|
{$IFDEF TCPCLIENT_TLS}
|
|
procedure TF5TCPClient.InstallTLSProxy;
|
|
var
|
|
Proxy : TTCPClientTLSConnectionProxy;
|
|
begin
|
|
{$IFDEF TCP_DEBUG_TLS}
|
|
Log(cltDebug, 'InstallTLSProxy');
|
|
{$ENDIF}
|
|
|
|
Proxy := TTCPClientTLSConnectionProxy.Create(self);
|
|
FTLSProxy := Proxy;
|
|
FTLSClient := Proxy.FTLSClient;
|
|
FConnection.AddProxy(Proxy);
|
|
end;
|
|
|
|
function TF5TCPClient.GetTLSClient: TTLSClient;
|
|
var C : TTLSClient;
|
|
begin
|
|
C := FTLSClient;
|
|
if not Assigned(C) then
|
|
raise ETCPClient.Create(SError_TLSNotActive);
|
|
Result := C;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF TCPCLIENT_SOCKS}
|
|
procedure TF5TCPClient.InstallSocksProxy;
|
|
begin
|
|
{$IFDEF TCP_DEBUG}
|
|
Log(cltDebug, 'InstallSocksProxy');
|
|
{$ENDIF}
|
|
|
|
FConnection.AddProxy(TTCPClientSocksConnectionProxy.Create(self));
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF TCPCLIENT_WEBSOCKET}
|
|
procedure TF5TCPClient.InstallWebSocketProxy;
|
|
begin
|
|
{$IFDEF TCP_DEBUG}
|
|
Log(cltDebug, 'InstallWebSocketProxy');
|
|
{$ENDIF}
|
|
|
|
FConnection.AddProxy(TTCPClientWebSocketConnectionProxy.Create(self));
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{ Connection }
|
|
|
|
function TF5TCPClient.GetConnection: TTCPConnection;
|
|
begin
|
|
Result := FConnection;
|
|
end;
|
|
|
|
procedure TF5TCPClient.CreateConnection;
|
|
var
|
|
AF : TIPAddressFamily;
|
|
begin
|
|
Lock;
|
|
try
|
|
Assert(FActive);
|
|
Assert(FState = csStarting);
|
|
Assert(not Assigned(FSocket));
|
|
Assert(not Assigned(FConnection));
|
|
|
|
case FAddressFamily of
|
|
cafIP4 : AF := iaIP4;
|
|
cafIP6 : AF := iaIP6;
|
|
else
|
|
raise ETCPClient.Create('Invalid address family');
|
|
end;
|
|
FIPAddressFamily := AF;
|
|
|
|
FSocket := TSysSocket.Create(AF, ipTCP, False, INVALID_SOCKETHANDLE);
|
|
{$IFDEF TCP_DEBUG}
|
|
FSocket.OnLog := SocketLog;
|
|
{$ENDIF}
|
|
|
|
FConnection := TTCPConnection.Create(FSocket);
|
|
FConnection.OnLog := ConnectionLog;
|
|
FConnection.OnStateChange := ConnectionStateChange;
|
|
FConnection.OnReadShutdown := ConnectionReadShutdown;
|
|
FConnection.OnShutdown := ConnectionShutdown;
|
|
FConnection.OnClose := ConnectionClose;
|
|
FConnection.OnWorkerExecute := ConnectionWorkerExecute;
|
|
|
|
if Assigned(FOnRead) then
|
|
FConnection.OnRead := ConnectionRead;
|
|
if Assigned(FOnWrite) then
|
|
FConnection.OnWrite := ConnectionWrite;
|
|
if Assigned(FOnReadActivity) then
|
|
FConnection.OnReadActivity := ConnectionReadActivity;
|
|
if Assigned(FOnWriteActivity) then
|
|
FConnection.OnWriteActivity := ConnectionWriteActivity;
|
|
|
|
FConnection.UseWorkerThread := FUseWorkerThread;
|
|
FConnection.TrackLastActivityTime := FTrackLastActivityTime;
|
|
finally
|
|
Unlock;
|
|
end;
|
|
end;
|
|
|
|
procedure TF5TCPClient.FreeConnection;
|
|
begin
|
|
if Assigned(FConnection) then
|
|
begin
|
|
FConnection.Finalise;
|
|
FreeAndNil(FConnection);
|
|
end;
|
|
FreeAndNil(FSocket);
|
|
end;
|
|
|
|
function TF5TCPClient.GetBlockingConnection: TTCPBlockingConnection;
|
|
begin
|
|
Lock;
|
|
try
|
|
if Assigned(FConnection) then
|
|
Result := FConnection.BlockingConnection
|
|
else
|
|
Result := nil;
|
|
finally
|
|
Unlock;
|
|
end;
|
|
end;
|
|
|
|
{ Resolve }
|
|
|
|
procedure TF5TCPClient.DoResolveLocal;
|
|
var
|
|
LocAddr : TSocketAddr;
|
|
begin
|
|
Assert(FActive);
|
|
Assert(FState in [csStarted, csConnectRetry, csClosed]);
|
|
Assert(FHost <> '');
|
|
{$IFDEF TCP_DEBUG}
|
|
Log(cltDebug, 'DoResolveLocal');
|
|
{$ENDIF}
|
|
|
|
SetState(csResolvingLocal);
|
|
LocAddr := flcSocketLib.Resolve(FLocalHost, FLocalPort, FIPAddressFamily, ipTCP);
|
|
Lock;
|
|
try
|
|
FLocalAddr := LocAddr;
|
|
finally
|
|
Unlock;
|
|
end;
|
|
SetState(csResolvedLocal);
|
|
end;
|
|
|
|
procedure TF5TCPClient.DoBind;
|
|
begin
|
|
Assert(FActive);
|
|
Assert(FState in [csResolvedLocal, csClosed]);
|
|
Assert(Assigned(FSocket));
|
|
{$IFDEF TCP_DEBUG}
|
|
Log(cltDebug, 'DoBind');
|
|
{$ENDIF}
|
|
|
|
if GetState = csClosed then
|
|
raise ETCPClient.Create('Closed');
|
|
FSocket.Bind(FLocalAddr);
|
|
SetState(csBound);
|
|
end;
|
|
|
|
procedure TF5TCPClient.DoResolve;
|
|
var
|
|
ConAddr : TSocketAddr;
|
|
begin
|
|
Assert(FActive);
|
|
Assert(FState in [csBound, csConnectRetry, csClosed]);
|
|
Assert(FHost <> '');
|
|
{$IFDEF TCP_DEBUG}
|
|
Log(cltDebug, 'DoResolve');
|
|
{$ENDIF}
|
|
|
|
if GetState = csClosed then
|
|
raise ETCPClient.Create('Closed');
|
|
SetState(csResolving);
|
|
ConAddr := flcSocketLib.Resolve(FHost, FPort, FIPAddressFamily, ipTCP);
|
|
|
|
Lock;
|
|
try
|
|
{$IFDEF TCPCLIENT_SOCKS}
|
|
if FState = csClosed then
|
|
raise ETCPClient.Create('Closed');
|
|
if FSocksEnabled then
|
|
begin
|
|
FSocksResolvedAddr := ConAddr;
|
|
ConAddr := flcSocketLib.ResolveA(FSocksHost, FSocksPort, FIPAddressFamily, ipTCP);
|
|
end
|
|
else
|
|
InitSocketAddrNone(FSocksResolvedAddr);
|
|
{$ENDIF}
|
|
FConnectAddr := ConAddr;
|
|
finally
|
|
Unlock;
|
|
end;
|
|
SetState(csResolved);
|
|
end;
|
|
|
|
{ Connect / Close }
|
|
|
|
procedure TF5TCPClient.DoConnect;
|
|
begin
|
|
Assert(FActive);
|
|
Assert(FState in [csResolved, csClosed, csStopped]);
|
|
Assert(Assigned(FSocket));
|
|
{$IFDEF TCP_DEBUG}
|
|
Log(cltDebug, 'DoConnect');
|
|
{$ENDIF}
|
|
|
|
if GetState = csClosed then
|
|
raise ETCPClient.Create('Closed');
|
|
SetState(csConnecting);
|
|
FSocket.SetBlocking(True);
|
|
FSocket.Connect(FConnectAddr);
|
|
FSocket.SetBlocking(False);
|
|
SetConnected;
|
|
end;
|
|
|
|
procedure TF5TCPClient.DoClose;
|
|
begin
|
|
Assert(Assigned(FSocket));
|
|
Assert(Assigned(FConnection));
|
|
{$IFDEF TCP_DEBUG}
|
|
Log(cltDebug, 'DoClose');
|
|
{$ENDIF}
|
|
|
|
FConnection.Close;
|
|
SetClosed;
|
|
end;
|
|
|
|
{ Thread }
|
|
|
|
procedure TF5TCPClient.StartProcessThread;
|
|
begin
|
|
{$IFDEF TCP_DEBUG_THREAD}
|
|
Log(cltDebug, 'StartProcessThread');
|
|
{$ENDIF}
|
|
|
|
FProcessThread := TTCPClientProcessThread.Create(self);
|
|
end;
|
|
|
|
procedure TF5TCPClient.StopProcessThread;
|
|
begin
|
|
if not Assigned(FProcessThread) then
|
|
exit;
|
|
{$IFDEF TCP_DEBUG_THREAD}
|
|
Log(cltDebug, 'StopProcessThread');
|
|
{$ENDIF}
|
|
|
|
FProcessThread.Terminate;
|
|
FProcessThread.WaitFor;
|
|
FreeAndNil(FProcessThread);
|
|
end;
|
|
|
|
{$IFDEF OS_MSWIN}
|
|
function TF5TCPClient.ProcessMessage(var MsgTerminated: Boolean): Boolean;
|
|
var Msg : TMsg;
|
|
begin
|
|
Result := PeekMessage(Msg, 0, 0, 0, PM_REMOVE);
|
|
if not Result then
|
|
exit;
|
|
if Msg.Message = WM_QUIT then
|
|
begin
|
|
MsgTerminated := True;
|
|
exit;
|
|
end;
|
|
TranslateMessage(Msg);
|
|
DispatchMessage(Msg);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
// The client thread is responsible for connecting and processing the socket.
|
|
// Events are dispatches from this thread.
|
|
procedure TF5TCPClient.ProcessThreadExecute(const AThread: TTCPClientProcessThread);
|
|
|
|
function IsTerminated: Boolean;
|
|
begin
|
|
Result := AThread.Terminated;
|
|
if Result then
|
|
exit;
|
|
Result := IsStopping;
|
|
end;
|
|
|
|
procedure SetErrorFromException(const E: Exception);
|
|
begin
|
|
if E is ESocketLib then
|
|
SetError(E.Message, ESocketLib(E).ErrorCode)
|
|
else
|
|
SetError(E.Message, -1);
|
|
end;
|
|
|
|
function WaitSec(const NSec: Integer): Boolean;
|
|
var
|
|
T : Word32;
|
|
MS : Word32;
|
|
begin
|
|
Result := True;
|
|
if NSec <= 0 then
|
|
exit;
|
|
MS := Word32(NSec) * 1000;
|
|
T := 0;
|
|
repeat
|
|
if IsTerminated then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
Sleep(50);
|
|
Inc(T, 50);
|
|
until T >= MS;
|
|
end;
|
|
|
|
var
|
|
IsIdle, ConIdle, ConTerminated : Boolean;
|
|
{$IFDEF OS_MSWIN}
|
|
MsgProcessed, MsgTerminated : Boolean;
|
|
{$ENDIF}
|
|
ConnRetry : Boolean;
|
|
ConnAttempt : Integer;
|
|
Reconnect : Boolean;
|
|
RS, WS, ES : Boolean;
|
|
{$IFDEF OS_WIN32}
|
|
SelCnt : Integer;
|
|
{$ENDIF}
|
|
|
|
begin
|
|
Assert(Assigned(AThread));
|
|
{$IFDEF TCP_DEBUG_THREAD}
|
|
Log(cltDebug, 'ThreadExecute');
|
|
{$ENDIF}
|
|
|
|
// startup
|
|
try
|
|
try
|
|
if IsTerminated then
|
|
exit;
|
|
// connection setup
|
|
CreateConnection;
|
|
if IsTerminated then
|
|
exit;
|
|
SetStarted;
|
|
{$IFDEF TCPCLIENT_SOCKS}
|
|
if FSocksEnabled then
|
|
InstallSocksProxy;
|
|
{$ENDIF}
|
|
{$IFDEF TCPCLIENT_TLS}
|
|
if FTLSEnabled then
|
|
InstallTLSProxy;
|
|
{$ENDIF}
|
|
{$IFDEF TCPCLIENT_WEBSOCKET}
|
|
if FWebSocketEnabled then
|
|
InstallWebSocketProxy;
|
|
{$ENDIF}
|
|
except
|
|
on E : Exception do
|
|
begin
|
|
if not IsTerminated then
|
|
begin
|
|
SetErrorFromException(E);
|
|
TriggerConnectFailed;
|
|
end;
|
|
exit;
|
|
end;
|
|
end;
|
|
Lock;
|
|
try
|
|
if Assigned(FWaitStartEvent) then
|
|
FWaitStartEvent.SetEvent;
|
|
finally
|
|
Unlock;
|
|
end;
|
|
|
|
Reconnect := False;
|
|
repeat
|
|
try
|
|
if Reconnect then
|
|
begin
|
|
// re-allocate socket handle
|
|
DoClose;
|
|
FSocket.AllocateSocketHandle;
|
|
end;
|
|
FSocket.SetBlocking(True);
|
|
if IsTerminated then
|
|
exit;
|
|
// resolve local
|
|
DoResolveLocal;
|
|
if IsTerminated then
|
|
exit;
|
|
// bind
|
|
DoBind;
|
|
if IsTerminated then
|
|
exit;
|
|
except
|
|
on E : Exception do
|
|
begin
|
|
if not IsTerminated then
|
|
begin
|
|
SetErrorFromException(E);
|
|
TriggerConnectFailed;
|
|
end;
|
|
{$IFDEF TCP_DEBUG_THREAD}
|
|
Log(cltDebug, 'ThreadExit:Local bind failed:%s', [E.Message]);
|
|
{$ENDIF}
|
|
exit;
|
|
end;
|
|
end;
|
|
// resolve and connect
|
|
ConnAttempt := 1;
|
|
repeat
|
|
ConnRetry := False;
|
|
try
|
|
// resolve
|
|
if IsTerminated then
|
|
exit;
|
|
DoResolve;
|
|
if IsTerminated then
|
|
exit;
|
|
// connect
|
|
DoConnect;
|
|
if IsTerminated then
|
|
exit;
|
|
// success
|
|
except
|
|
on E : Exception do
|
|
begin
|
|
// retry
|
|
if not IsTerminated and FRetryFailedConnect then
|
|
if (FRetryFailedConnectMaxAttempts < 0) or
|
|
(ConnAttempt < FRetryFailedConnectMaxAttempts) then
|
|
begin
|
|
if not WaitSec(FRetryFailedConnectDelaySec) then
|
|
exit;
|
|
Inc(ConnAttempt);
|
|
ConnRetry := True;
|
|
SetState(csConnectRetry);
|
|
if IsTerminated then
|
|
exit;
|
|
end;
|
|
if not ConnRetry then
|
|
begin
|
|
if not IsTerminated then
|
|
begin
|
|
SetErrorFromException(E);
|
|
TriggerConnectFailed;
|
|
end;
|
|
{$IFDEF TCP_DEBUG_THREAD}
|
|
Log(cltDebug, 'ThreadExit:Connection failed:%s', [E.Message]);
|
|
{$ENDIF}
|
|
exit;
|
|
end;
|
|
{$IFDEF TCP_DEBUG}
|
|
if ConnRetry then
|
|
Log(cltDebug, 'ConnRetry');
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
until not ConnRetry;
|
|
// set socket option
|
|
try
|
|
FSocket.TcpNoDelayEnabled := True;
|
|
except
|
|
end;
|
|
// poll loop
|
|
try
|
|
{$IFDEF OS_MSWIN}
|
|
MsgTerminated := False;
|
|
{$ENDIF}
|
|
while not IsTerminated do
|
|
begin
|
|
// wait for socket activity
|
|
try
|
|
{$IFDEF OS_WIN32}
|
|
// under Win32, WinSock blocks Socket.Write() if Socket.Select() is active
|
|
for SelCnt := 1 to 10 do
|
|
begin
|
|
RS := True;
|
|
WS := True;
|
|
ES := False;
|
|
FConnection.GetEventsToPoll(WS);
|
|
FConnection.Socket.Select(50000, RS, WS, ES); // 50,000 microseconds / 50 milliseconds
|
|
if RS or WS or ES or IsTerminated then
|
|
break;
|
|
end;
|
|
{$ELSE}
|
|
RS := True;
|
|
WS := True;
|
|
ES := False;
|
|
FConnection.GetEventsToPoll(WS);
|
|
FConnection.Socket.Select(100000, RS, WS, ES); // 100,000 microseconds / 100 milliseconds
|
|
{$ENDIF}
|
|
IsIdle := False;
|
|
except
|
|
IsIdle := True;
|
|
end;
|
|
if IsTerminated then
|
|
break;
|
|
|
|
FConnection.ProcessSocket(RS, WS, Now, ConIdle, ConTerminated);
|
|
if ConTerminated then
|
|
begin
|
|
{$IFDEF TCP_DEBUG_THREAD}
|
|
Log(cltDebug, 'ThreadTerminate:ConnectionTerminated');
|
|
{$ENDIF}
|
|
break;
|
|
end
|
|
else
|
|
begin
|
|
if not ConIdle then
|
|
IsIdle := False;
|
|
{$IFDEF OS_MSWIN}
|
|
MsgProcessed := ProcessMessage(MsgTerminated);
|
|
if MsgTerminated then
|
|
begin
|
|
AThread.Terminate;
|
|
{$IFDEF TCP_DEBUG_THREAD}
|
|
Log(cltDebug, 'ThreadTerminate:MsgTerminated');
|
|
{$ENDIF}
|
|
end;
|
|
if MsgProcessed then
|
|
IsIdle := False;
|
|
{$ENDIF}
|
|
if IsIdle then
|
|
TriggerProcessThreadIdle;
|
|
end;
|
|
end;
|
|
except
|
|
on E : Exception do
|
|
if not IsTerminated then
|
|
begin
|
|
{$IFDEF TCP_DEBUG_THREAD}
|
|
Log(cltDebug, 'PollLoop:Error:%s', [E.Message]);
|
|
{$ENDIF}
|
|
SetErrorFromException(E);
|
|
end;
|
|
end;
|
|
Reconnect := not IsTerminated and FReconnectOnDisconnect;
|
|
until not Reconnect;
|
|
finally
|
|
if not IsTerminated then
|
|
SetClosed;
|
|
end;
|
|
|
|
{$IFDEF TCP_DEBUG_THREAD}
|
|
Log(cltDebug, 'ThreadTerminate:Terminated=%d', [Ord(IsTerminated)]);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TF5TCPClient.TerminateProcessThread;
|
|
begin
|
|
if Assigned(FProcessThread) then
|
|
FProcessThread.Terminate;
|
|
end;
|
|
|
|
procedure TF5TCPClient.TerminateWorkerThread;
|
|
begin
|
|
if Assigned(FConnection) then
|
|
FConnection.TerminateWorkerThread;
|
|
end;
|
|
|
|
{ Start / Stop }
|
|
|
|
procedure TF5TCPClient.ValidateParameters;
|
|
begin
|
|
if FHost = '' then
|
|
raise ETCPClient.Create(SError_HostNotSpecified);
|
|
if FPort = '' then
|
|
raise ETCPClient.Create(SError_PortNotSpecified);
|
|
end;
|
|
|
|
const
|
|
// milliseconds to wait for thread to startup,
|
|
// this usually happens within 1 ms but could pause for a few seconds if the
|
|
// system is busy
|
|
ThreadStartupTimeOut = 30000; // 30 seconds
|
|
|
|
procedure TF5TCPClient.ClientActive;
|
|
begin
|
|
end;
|
|
|
|
procedure TF5TCPClient.ClientInactive;
|
|
begin
|
|
end;
|
|
|
|
procedure TF5TCPClient.ClientSetActive;
|
|
var
|
|
IsAlreadyStarting : Boolean;
|
|
WaitForStart : Boolean;
|
|
begin
|
|
// ensure only one thread is doing DoSetActive
|
|
Lock;
|
|
try
|
|
if FActive then
|
|
exit;
|
|
ValidateParameters;
|
|
// check if already starting
|
|
IsAlreadyStarting := FState = csStarting;
|
|
if not IsAlreadyStarting then
|
|
SetState(csStarting);
|
|
WaitForStart := FWaitForStartup;
|
|
finally
|
|
Unlock;
|
|
end;
|
|
if IsAlreadyStarting then
|
|
begin
|
|
// this thread is not doing startup,
|
|
// wait for other thread to complete startup
|
|
if WaitForStart then
|
|
if WaitForState(TCPClientStates_All - [csStarting], ThreadStartupTimeOut) = csStarting then
|
|
raise ETCPClient.Create(SError_StartupFailed); // timed out waiting for startup
|
|
exit;
|
|
end;
|
|
// start
|
|
Assert(not FActive);
|
|
// notify start
|
|
TriggerStart;
|
|
// initialise active state
|
|
Lock;
|
|
try
|
|
InitSocketAddrNone(FLocalAddr);
|
|
InitSocketAddrNone(FConnectAddr);
|
|
FErrorMessage := '';
|
|
FErrorCode := 0;
|
|
FActive := True;
|
|
finally
|
|
Unlock;
|
|
end;
|
|
// start thread
|
|
StartProcessThread;
|
|
// wait for thread to complete startup
|
|
if WaitForStart then
|
|
if WaitForState(TCPClientStates_All - [csStarting], ThreadStartupTimeOut) = csStarting then
|
|
raise ETCPClient.Create(SError_StartupFailed); // timed out waiting for thread
|
|
// connection object initialised
|
|
// started
|
|
TriggerActive;
|
|
end;
|
|
|
|
const
|
|
ClientStopTimeOut = 30000; // 30 seconds
|
|
|
|
procedure TF5TCPClient.ClientSetInactive;
|
|
var
|
|
IsAlreadyStopping : Boolean;
|
|
begin
|
|
// ensure only one thread is doing DoStop
|
|
Lock;
|
|
try
|
|
if not FActive then
|
|
exit;
|
|
IsAlreadyStopping := FIsStopping;
|
|
if not IsAlreadyStopping then
|
|
FIsStopping := True;
|
|
finally
|
|
Unlock;
|
|
end;
|
|
if IsAlreadyStopping then
|
|
begin
|
|
// this thread is not doing stop,
|
|
// wait for other thread to complete stop
|
|
WaitForState([csStopped], ClientStopTimeOut);
|
|
exit;
|
|
end;
|
|
// stop
|
|
try
|
|
TriggerStop;
|
|
// terminate threads and close socket before waiting for threads to terminate
|
|
TerminateWorkerThread;
|
|
TerminateProcessThread;
|
|
DoClose;
|
|
StopProcessThread;
|
|
FConnection.WaitForWorkerThread;
|
|
FActive := False;
|
|
TriggerInactive;
|
|
SetStopped;
|
|
FreeConnection;
|
|
finally
|
|
Lock;
|
|
try
|
|
FIsStopping := False;
|
|
finally
|
|
Unlock;
|
|
end;
|
|
end;
|
|
// stopped
|
|
end;
|
|
|
|
function TF5TCPClient.WaitStart(const ATimeOutMs: Int32): Boolean; ////
|
|
var
|
|
DoWait : Boolean;
|
|
WaitEv : TSimpleEvent;
|
|
begin
|
|
DoWait := False;
|
|
WaitEv := nil;
|
|
|
|
Lock;
|
|
try
|
|
if not FActive then
|
|
Result := False
|
|
else
|
|
if FState in [csStopped] then
|
|
Result := False
|
|
else
|
|
if FState in [csInit, csStarting] then
|
|
begin
|
|
WaitEv := FWaitStartEvent;
|
|
if not Assigned(WaitEv) then
|
|
begin
|
|
WaitEv := TSimpleEvent.Create;
|
|
FWaitStartEvent := WaitEv;
|
|
end;
|
|
Inc(FWaitStartCount);
|
|
DoWait := True;
|
|
Result := False;
|
|
end
|
|
else
|
|
Result := True;
|
|
finally
|
|
Unlock;
|
|
end;
|
|
|
|
if DoWait then
|
|
begin
|
|
Result := WaitEv.WaitFor(ATimeOutMs) = wrSignaled;
|
|
Lock;
|
|
try
|
|
Dec(FWaitStartCount);
|
|
if FWaitStartCount = 0 then
|
|
begin
|
|
FWaitStartEvent := nil;
|
|
WaitEv.Free;
|
|
end;
|
|
|
|
Result := Result and
|
|
FActive and
|
|
not (FState in [csInit, csStarting, csStopped]);
|
|
finally
|
|
Unlock;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TF5TCPClient.Start;
|
|
begin
|
|
ClientSetActive;
|
|
end;
|
|
|
|
procedure TF5TCPClient.Stop;
|
|
begin
|
|
ClientSetInactive;
|
|
end;
|
|
|
|
procedure TF5TCPClient.Shutdown;
|
|
begin
|
|
Lock;
|
|
try
|
|
if not FActive or FIsStopping then
|
|
exit;
|
|
if FState in [csInit, csClosed, csStopped] then
|
|
exit;
|
|
finally
|
|
Unlock;
|
|
end;
|
|
FConnection.Shutdown;
|
|
end;
|
|
|
|
procedure TF5TCPClient.Close;
|
|
begin
|
|
Lock;
|
|
try
|
|
if not FActive or FIsStopping then
|
|
exit;
|
|
if FState in [csInit, csClosed, csStopped] then
|
|
exit;
|
|
finally
|
|
Unlock;
|
|
end;
|
|
DoClose;
|
|
end;
|
|
|
|
{ Connect state }
|
|
|
|
function TF5TCPClient.IsConnecting: Boolean;
|
|
begin
|
|
Result := GetState in TCPClientStates_Connecting;
|
|
end;
|
|
|
|
function TF5TCPClient.IsConnectingOrConnected: Boolean;
|
|
begin
|
|
Result := GetState in TCPClientStates_ConnectingOrConnected;
|
|
end;
|
|
|
|
function TF5TCPClient.IsConnected: Boolean;
|
|
begin
|
|
Result := GetState in TCPClientStates_Connected;
|
|
end;
|
|
|
|
function TF5TCPClient.IsConnectionClosed: Boolean;
|
|
begin
|
|
Result := GetState in TCPClientStates_Closed;
|
|
end;
|
|
|
|
function TF5TCPClient.IsShutdownComplete: Boolean;
|
|
begin
|
|
Lock;
|
|
try
|
|
Result :=
|
|
(FState in [csClosed, csStopped]) or
|
|
(FActive and FConnection.IsShutdownComplete);
|
|
finally
|
|
Unlock;
|
|
end;
|
|
end;
|
|
|
|
function TF5TCPClient.IsStopping: Boolean;
|
|
begin
|
|
Lock;
|
|
try
|
|
Result := FIsStopping;
|
|
finally
|
|
Unlock;
|
|
end;
|
|
end;
|
|
|
|
{ TLS }
|
|
|
|
{$IFDEF TCPCLIENT_TLS}
|
|
procedure TF5TCPClient.StartTLS;
|
|
begin
|
|
CheckActive;
|
|
if FTLSEnabled then // TLS proxy already installed on activation
|
|
exit;
|
|
InstallTLSProxy;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{ Wait }
|
|
|
|
procedure TF5TCPClient.Wait;
|
|
begin
|
|
{$IFDEF OS_MSWIN}
|
|
if GetCurrentThreadID = MainThreadID then
|
|
begin
|
|
if Assigned(OnMainThreadWait) then
|
|
FOnMainThreadWait(self);
|
|
end
|
|
else
|
|
begin
|
|
if Assigned(FOnThreadWait) then
|
|
FOnThreadWait(self);
|
|
end;
|
|
{$ELSE}
|
|
if Assigned(FOnThreadWait) then
|
|
FOnThreadWait(self);
|
|
{$ENDIF}
|
|
Sleep(5);
|
|
end;
|
|
|
|
// Wait until one of the States or time out
|
|
function TF5TCPClient.WaitForState(const AStates: TTCPClientStates; const ATimeOutMs: Integer): TTCPClientState;
|
|
var T : Word64;
|
|
S : TTCPClientState;
|
|
begin
|
|
CheckActive;
|
|
T := TCPGetTick;
|
|
repeat
|
|
S := GetState;
|
|
if S in AStates then
|
|
break;
|
|
if ATimeOutMs >= 0 then
|
|
if TCPTickDelta(T, TCPGetTick) >= ATimeOutMs then
|
|
break;
|
|
Wait;
|
|
until False;
|
|
Result := S;
|
|
end;
|
|
|
|
// Wait until connected (ready), closed or time out
|
|
function TF5TCPClient.WaitForConnect(const ATimeOutMs: Integer): Boolean;
|
|
begin
|
|
Result := WaitForState([csReady, csClosed, csStopped], ATimeOutMs) = csReady;
|
|
end;
|
|
|
|
// Wait until socket is closed or time out
|
|
function TF5TCPClient.WaitForClose(const ATimeOutMs: Integer): Boolean;
|
|
begin
|
|
Result := WaitForState([csClosed, csStopped], ATimeOutMs) = csClosed;
|
|
end;
|
|
|
|
|
|
|
|
end.
|
|
|