david
2824855ea7
- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10 - Recompilación en Delphi10 de todos los paquetes de DA para generar las DCU's en Lib\D10 git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@9 b6239004-a887-0f4b-9937-50029ccdca16
862 lines
25 KiB
ObjectPascal
862 lines
25 KiB
ObjectPascal
unit uROSuperTCPChannel;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ RemObjects SDK Library - Indy Library }
|
|
{ }
|
|
{ compiler: Delphi 5 and up, Kylix 2 and up }
|
|
{ platform: Win32, Linux }
|
|
{ }
|
|
{ (c)opyright RemObjects Software. all rights reserved. }
|
|
{ }
|
|
{ Using this code requires a valid license of the RemObjects SDK }
|
|
{ which can be obtained at http://www.remobjects.com. }
|
|
{----------------------------------------------------------------------------}
|
|
|
|
{$I RemObjects.inc}
|
|
|
|
interface
|
|
uses
|
|
SysUtils, Classes, uROClasses, uROClient, uROClientIntf, SyncObjs,
|
|
{$IFDEF REMOBJECTS_TRIAL}uROTrial, {$ENDIF} uROAsync,
|
|
{$IFDEF RemObjects_UseEncryption} uRoEncryption, {$ENDIF}
|
|
IdTCPConnection, IdTCPClient, {$IFDEF WIN32}Windows, {$ENDIF}uROSCHelpers, uROThreadPool;
|
|
|
|
type
|
|
TROCustomSuperTCPChannel = class;
|
|
TROSCClientWorker = class;
|
|
TROWaitingRequest = class
|
|
private
|
|
fEvent: TROEvent;
|
|
fFreeEvent: Boolean;
|
|
fId: Integer;
|
|
fResultData: TStream;
|
|
fResultErrorCode: Integer;
|
|
public
|
|
property Id: Integer read fId;
|
|
property Event: TROEvent read fEvent;
|
|
property Resultdata: TStream read fResultData write fResultData;
|
|
property ResultErrorCode: Integer read fResultErrorCode write fResultErrorCode;
|
|
|
|
constructor Create(Id: Integer); overload;
|
|
constructor Create(Id: Integer; Ev: TROEvent); overload;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
TROPooledEvent = class(TInterfacedObject, IROThreadPoolCallback)
|
|
private
|
|
fData: TStream;
|
|
fOwner: TROCustomSuperTCPChannel;
|
|
protected
|
|
procedure Callback(Caller: TROThreadPool; Thread: TThread);
|
|
public
|
|
constructor Create(aData: TStream; aOwner: TROCustomSuperTCPChannel);
|
|
destructor Destroy; override;
|
|
end;
|
|
TROSCState = (scNotConnected, scConnecting, scConnected, scReconnecting);
|
|
TROCustomSuperTcpChannel = class(TROTransportChannel, IROTransport,
|
|
IROTCPTransport, IROActiveEventChannel, IROMultiThreadAwareChannel,
|
|
IROAsyncTransportChannel, IROActiveAsyncTransportChannel, IROTransportChannelEx)
|
|
private
|
|
fRequestTimeout: Integer;
|
|
fState: TROSCState;
|
|
fHost: string;
|
|
fPort: Integer;
|
|
fConnection: TIdTCPClient;
|
|
fActive: Boolean;
|
|
fOwnsEventThreadPool: Boolean;
|
|
fEventThreadPool: TROThreadPool;
|
|
fClient: TROSCClientWorker;
|
|
fWorkerThread: TThread;
|
|
fWaitingRequests: TThreadList;
|
|
fAutoReconnect: Boolean;
|
|
fEventReceiver: IROEventReceiver;
|
|
fConnectEvent: TROEvent;
|
|
fReconnectEvent: TROEvent;
|
|
fOnDisconnected: TNotifyEvent;
|
|
fOnConnected: TNotifyEvent;
|
|
fReconnectDelay: Integer;
|
|
fStoreActive: Boolean;
|
|
fPingSecs: Integer;
|
|
fAckWaitTimeout: Integer;
|
|
fIdleTimeoutMinutes: Integer;
|
|
fSynchronizeEvents: Boolean;
|
|
fConnectionWaitTimeout: Integer;
|
|
procedure SetHost(const Value: string);
|
|
procedure SetPort(const Value: Integer);
|
|
procedure SetActive(const Value: Boolean);
|
|
procedure SetEventThreadPool(const Value: TROThreadPool);
|
|
function GetClientID: TGUID;
|
|
procedure SetClientID(const Value: TGUID);
|
|
function GetMaxPackageSize: Longint;
|
|
procedure SetMaxPackageSize(val: longint);
|
|
function GetConnected: Boolean;
|
|
function GetSkipAck: Boolean;
|
|
procedure SetSkipAck(const Value: Boolean);
|
|
procedure SetPingSecs(const Value: Integer);
|
|
protected
|
|
procedure Loaded; override;
|
|
function GetClientAddress: String;
|
|
function GetTransportObject: TObject; override;
|
|
|
|
procedure HasData(Id: Integer; aData: TStream);
|
|
procedure BeforeDispatch(aMessage: IROMessage); override;
|
|
procedure IntDispatch(aRequest, aResponse : TStream); override;
|
|
procedure IntSetServerLocator(aServerLocator: TROServerLocator); override;
|
|
procedure RegisterEventReceiver(aReceiver: IROEventReceiver);
|
|
procedure UnregisterEventReceiver(aReceiver: IROEventReceiver);
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
function InvokeRequest(aRequest: TStream; aGetResponse: Boolean = True;
|
|
aEvent: TROEvent = nil): String; overload;
|
|
function InvokeRequest(aRequest:TStream; iGetResponse:boolean=true):string; overload;
|
|
function CheckStatus(const iMessageID: String): Boolean;
|
|
procedure RetrieveResponse(const iMessageID: String;
|
|
aResponse: TStream);
|
|
public
|
|
constructor Create(aOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure WaitForActive(const Timeout: Integer);
|
|
|
|
property Host: string read fHost write SetHost;
|
|
property Port: Integer read fPort write SetPort default 8095;
|
|
property PingSecs: Integer read fPingSecs write SetPingSecs default 60;
|
|
property StoreActive: Boolean read fStoreActive write fStoreActive default True;
|
|
property Active: Boolean read fActive write SetActive stored fStoreActive default False;
|
|
property Client: TIdTCPClient read fConnection;
|
|
property RequestTimeout: Integer read fRequestTimeout write fRequestTimeout default 60000;
|
|
property EventThreadPool: TROThreadPool read fEventThreadPool write SetEventThreadPool;
|
|
property AutoReconnect: Boolean read fAutoReconnect write fAutoReconnect default False;
|
|
property ReconnectDelay: Integer read fReconnectDelay write fReconnectDelay default 500;
|
|
property ClientID: TGUID read GetClientID write SetClientID;
|
|
property OnDisconnected: TNotifyEvent read fOnDisconnected write fOnDisconnected;
|
|
property MaxPackageSize: Integer read GetMaxPackageSize write SetMaxPackageSize default 1024*1024;
|
|
property OnConnected: TNotifyEvent read fOnConnected write fOnConnected;
|
|
property AckWaitTimeout: Integer read fAckWaitTimeout write fAckWaitTimeout default 10000;
|
|
property Connected: Boolean read GetConnected;
|
|
property IdleTimeoutMinutes: Integer read fIdleTimeoutMinutes write fIdleTimeoutMinutes default 0; // minutes
|
|
property SynchronizeEvents: Boolean read fSynchronizeEvents write fSynchronizeEvents default False;
|
|
property ConnectionWaitTimeout: Integer read fConnectionWaitTimeout write fConnectionWaitTimeout default 10000;
|
|
property SkipAck: Boolean read GetSkipAck write SetSkipAck default false;
|
|
end;
|
|
|
|
TROSuperTcpChannel = class(TROCustomSuperTcpChannel)
|
|
public
|
|
published
|
|
property Host;
|
|
property Port;
|
|
property Active;
|
|
property RequestTimeout;
|
|
property AutoReconnect;
|
|
property ReconnectDelay;
|
|
property OnDisconnected;
|
|
property OnConnected;
|
|
property StoreActive;
|
|
property MaxPackageSize;
|
|
property AckWaitTimeout;
|
|
property SynchronizeEvents;
|
|
property ConnectionWaitTimeout;
|
|
published
|
|
property SynchronizedProbing;
|
|
property OnSendStream;
|
|
property OnReceiveStream;
|
|
property ServerLocators;
|
|
property DispatchOptions;
|
|
property OnServerLocatorAssignment;
|
|
property ProbeServers;
|
|
property ProbeFrequency;
|
|
property SkipAck;
|
|
property OnBeforeProbingServers;
|
|
property OnAfterProbingServers;
|
|
property OnBeforeProbingServer;
|
|
property OnAfterProbingServer;
|
|
property OnLoginNeeded;
|
|
end;
|
|
|
|
TROSCClientWorker = class(TROSuperChannelWorker)
|
|
private
|
|
fOwner: TROCustomSuperTCPChannel;
|
|
fSkipReconnect: Boolean;
|
|
protected
|
|
procedure Connected; override;
|
|
procedure Disconnected(var RestartLoop: Boolean); override;
|
|
procedure IncomingData(Id: Integer; aData: TStream); override;
|
|
procedure Idle; override;
|
|
procedure SetAckDetails(Id: Integer; Oke: Boolean; ErrorNo: Integer); override;
|
|
public
|
|
constructor Create(aOwner: TROCustomSuperTCPChannel; aConnection: TIdTCPConnection);
|
|
property Owner: TROCustomSuperTCPChannel read fOwner;
|
|
end;
|
|
|
|
implementation
|
|
|
|
type
|
|
TROClientThread = class(TThread)
|
|
private
|
|
fChannel: TROSCClientWorker;
|
|
fConnecting: Boolean;
|
|
protected
|
|
procedure Execute; override;
|
|
public
|
|
constructor Create(aChannel: TROSCClientWorker);
|
|
property Connecting: Boolean read fConnecting;
|
|
end;
|
|
|
|
{ TROCustomSuperTCPChannel }
|
|
|
|
procedure TROCustomSuperTcpChannel.BeforeDispatch(aMessage: IROMessage);
|
|
begin
|
|
inherited;
|
|
if not fConnection.Connected then
|
|
begin
|
|
SetActive(true);
|
|
end;
|
|
fReconnectEvent.SetEvent;
|
|
if fConnectEvent.WaitFor(fConnectionWaitTimeout) <> wrSignaled then raise EROException.Create('No connection available');
|
|
if aMessage <> nil then
|
|
aMessage.ClientID := fClient.ClientId;
|
|
end;
|
|
|
|
function TROCustomSuperTcpChannel.CheckStatus(
|
|
const iMessageID: String): Boolean;
|
|
var
|
|
i, id: Integer;
|
|
lList: TList;
|
|
lReq: TROWaitingRequest;
|
|
begin
|
|
Result := False;
|
|
id := StrToInt(iMessageID);
|
|
lList := fWaitingRequests.LockList;
|
|
try
|
|
for i := lList.Count -1 downto 0 do begin
|
|
lReq := TROWaitingRequest(lList[i]);
|
|
if Lreq.Id = id then
|
|
begin
|
|
Result := (lReq.Resultdata <> nil) or (lReq.ResultErrorCode <> -1);
|
|
exit;
|
|
end;
|
|
end;
|
|
finally
|
|
fWaitingRequests.UnlockList;
|
|
end;
|
|
end;
|
|
|
|
constructor TROCustomSuperTCPChannel.Create(aOwner: TComponent);
|
|
begin
|
|
inherited Create(aOwner);
|
|
fConnectEvent := TROEvent.create(nil, true, false, '');
|
|
fReconnectEvent := TROEvent.Create(nil, true, false, '');
|
|
|
|
fPingSecs := 60;
|
|
fWaitingRequests := TThreadList.Create;
|
|
fHost := 'localhost';
|
|
fPort := 8095;
|
|
fConnection := TIdTCPClient.Create(nil);
|
|
fClient := TROSCClientWorker.Create(Self, fConnection);
|
|
fRequestTimeout := 60000;
|
|
fAckWaitTimeout := 10000;
|
|
fReconnectDelay := 500;
|
|
fConnectionWaitTimeout := 10000;
|
|
fStoreActive := True;
|
|
ThreadSafe := True;
|
|
end;
|
|
|
|
|
|
destructor TROCustomSuperTCPChannel.Destroy;
|
|
begin
|
|
SetActive(False);
|
|
fClient.Free;
|
|
fConnection.Free;
|
|
fWaitingRequests.Free;
|
|
fConnectEvent.Free;
|
|
if fOwnsEventThreadPool then
|
|
begin
|
|
fEventThreadPool.Free;
|
|
end;
|
|
fEventReceiver := nil;
|
|
fReconnectEvent.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TROCustomSuperTCPChannel.GetClientAddress: String;
|
|
begin
|
|
{$IFDEF REMOBJECTS_INDY8}
|
|
if (fConnection.Binding <> nil) and (fConnection.Binding <> nil) then
|
|
Result := fConnection.Binding.PeerIP
|
|
else
|
|
Result := '';
|
|
{$ELSE}
|
|
if (fConnection.Socket <> nil) and (fConnection.Socket.Binding <> nil) then
|
|
Result := fConnection.Socket.Binding.PeerIP
|
|
else
|
|
Result := '';
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TROCustomSuperTcpChannel.GetClientID: TGUID;
|
|
begin
|
|
Result := fClient.ClientID;
|
|
end;
|
|
|
|
function TROCustomSuperTcpChannel.GetConnected: Boolean;
|
|
begin
|
|
result := fClient.IsConnected;
|
|
end;
|
|
|
|
function TROCustomSuperTcpChannel.GetMaxPackageSize: Longint;
|
|
begin
|
|
result := fClient.MaxPackageSize;
|
|
end;
|
|
|
|
function TROCustomSuperTcpChannel.GetSkipAck: Boolean;
|
|
begin
|
|
result := fClient.SkipAck;
|
|
end;
|
|
|
|
function TROCustomSuperTCPChannel.GetTransportObject: TObject;
|
|
begin
|
|
Result := self;
|
|
end;
|
|
|
|
procedure TROCustomSuperTCPChannel.HasData(Id: Integer; aData: TStream);
|
|
var
|
|
lList: TList;
|
|
i: Integer;
|
|
lReq: TROWaitingRequest;
|
|
lEvent: TROPooledEvent;
|
|
lEventIntf: IROThreadPoolCallback;
|
|
begin
|
|
if Id < 0 then // got an event
|
|
begin
|
|
if fEventThreadPool = nil then raise EROException.Create('No thread pool assigned');
|
|
lEvent := TROPooledEvent.Create(aData, Self);
|
|
lEventIntf := lEvent;
|
|
try
|
|
fEventThreadPool.QueueItem(lEventIntf);
|
|
except
|
|
lEvent.fData := nil;
|
|
raise;
|
|
end;
|
|
end else
|
|
begin
|
|
lList := fWaitingRequests.LockList;
|
|
try
|
|
lReq := nil;
|
|
for i := lList.Count -1 downto 0 do
|
|
begin
|
|
if TROWaitingRequest(lList[i]).Id = Id then
|
|
begin
|
|
lReq := TROWaitingRequest(lList[i]);
|
|
break;
|
|
end;
|
|
end;
|
|
if lReq = nil then
|
|
begin
|
|
// Don't want a response
|
|
aData.Free;
|
|
exit;
|
|
end;
|
|
lReq.Resultdata := aData;
|
|
lReq.Event.SetEvent;
|
|
finally
|
|
fWaitingRequests.UnlockList;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TROCustomSuperTCPChannel.IntDispatch(aRequest,
|
|
aResponse: TStream);
|
|
var
|
|
lId: Integer;
|
|
lReq: TROWaitingRequest;
|
|
begin
|
|
// if (not fActive) then raise EROException.Create('Not connected');
|
|
lId := fClient.GenerateId;
|
|
lReq := TROWaitingRequest.Create(lId);
|
|
fWaitingRequests.Add(lReq);
|
|
try
|
|
TROSCClientWorker.WaitForAck(fClient.SendPackage(aRequest, lId), fAckWaitTimeout);
|
|
try
|
|
lReq.Event.WaitFor(fRequestTimeout);
|
|
finally
|
|
fWaitingRequests.Remove(lReq);
|
|
end;
|
|
if lReq.Resultdata = nil then begin
|
|
case lReq.fResultErrorCode of
|
|
ScCmdNoAck_MsgTooLarge: raise EROException.Create('Message from server too large');
|
|
ScCmdNoAck_QueueFull: raise EROException.Create('Server queue full');
|
|
else raise EROTimeout.Create('Timeout waiting for response');
|
|
end;
|
|
end;
|
|
lReq.Resultdata.Seek(0, soFromBeginning);
|
|
aResponse.CopyFrom(lReq.Resultdata, lReq.Resultdata.Size);
|
|
finally
|
|
lReq.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TROCustomSuperTCPChannel.IntSetServerLocator(
|
|
aServerLocator: TROServerLocator);
|
|
begin
|
|
Host := aServerLocator.Host;
|
|
Port := aServerLocator.Port;
|
|
end;
|
|
|
|
function TROCustomSuperTcpChannel.InvokeRequest(aRequest: TStream;
|
|
aGetResponse: Boolean; aEvent: TROEvent): String;
|
|
var
|
|
lId: Integer;
|
|
lReq: TROWaitingRequest;
|
|
begin
|
|
lId := fClient.GenerateId;
|
|
if aGetResponse then begin
|
|
if aEvent = nil then
|
|
lReq := TROWaitingRequest.Create(lId)
|
|
else
|
|
lReq := TROWaitingRequest.Create(lId, aEvent);
|
|
|
|
fWaitingRequests.Add(lReq);
|
|
end;
|
|
fClient.SendPackage(aRequest, lId);
|
|
Result := IntToStr(lId);
|
|
aRequest.Free; // needs to be freed here
|
|
end;
|
|
|
|
function TROCustomSuperTcpChannel.InvokeRequest(aRequest: TStream;
|
|
iGetResponse: boolean): string;
|
|
begin
|
|
Result := InvokeRequest(aRequest, iGetResponse, nil);
|
|
end;
|
|
|
|
procedure TROCustomSuperTCPChannel.Loaded;
|
|
begin
|
|
inherited;
|
|
if fActive then
|
|
begin
|
|
fActive := false;
|
|
SetActive(true);
|
|
end;
|
|
end;
|
|
|
|
procedure TROCustomSuperTcpChannel.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
var
|
|
dummy: IROEventReceiver;
|
|
begin
|
|
if (Operation = opRemove) then
|
|
begin
|
|
if (AComponent = fEventThreadPool) then
|
|
fEventThreadPool := nil;
|
|
if Supports(aComponent, IROEventReceiver, dummy) and (dummy = fEventReceiver) then
|
|
fEventReceiver := nil;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TROCustomSuperTcpChannel.RegisterEventReceiver(
|
|
aReceiver: IROEventReceiver);
|
|
begin
|
|
if assigned(fEventReceiver) then
|
|
TComponent(fEventReceiver.GetObject).RemoveFreeNotification(Self);
|
|
fEventReceiver := aReceiver;
|
|
if assigned(fEventReceiver) then
|
|
TComponent(fEventReceiver.GetObject).FreeNotification(Self);
|
|
end;
|
|
|
|
procedure TROCustomSuperTcpChannel.RetrieveResponse(
|
|
const iMessageID: String; aResponse: TStream);
|
|
var
|
|
i, id: Integer;
|
|
lList: TList;
|
|
lReq: TROWaitingRequest;
|
|
|
|
begin
|
|
id := STrToInt(iMessageID);
|
|
lList := fWaitingRequests.LockList;
|
|
try
|
|
lReq := nil;
|
|
for i := lList.Count -1 downto 0 do begin
|
|
lReq := TROWaitingRequest(lList[i]);
|
|
if Lreq.Id = id then
|
|
break
|
|
else lReq := nil;
|
|
end;
|
|
finally
|
|
fWaitingRequests.UnlockList;
|
|
end;
|
|
if lReq = nil then
|
|
raise EROTimeout.Create('Unknown response id '+iMessageID);
|
|
|
|
try
|
|
if lReq.fEvent <> nil then
|
|
lReq.fEvent.WaitFor(fRequestTimeout);
|
|
if lReq.fResultData = nil then begin
|
|
case lReq.ResultErrorCode of
|
|
ScCmdNoAck_MsgTooLarge: raise EROException.Create('Message from server too large');
|
|
ScCmdNoAck_QueueFull: raise EROException.Create('Server queue full');
|
|
else raise EROTimeout.Create('Timeout waiting for response');
|
|
end;
|
|
end;
|
|
lREq.Resultdata.Seek(0, soFromBeginning);
|
|
{$IFDEF RemObjects_UseEncryption}
|
|
if Encryption.EncryptionMethod <> tetNone then
|
|
DoDecryption(lReq.Resultdata, aResponse)
|
|
else
|
|
{$ENDIF}
|
|
aResponse.CopyFrom(lReq.Resultdata, lReq.Resultdata.Size);
|
|
aResponse.Seek(0, soFromBeginning);
|
|
finally
|
|
fWaitingRequests.Remove(lReq);
|
|
lReq.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TROCustomSuperTCPChannel.SetActive(const Value: Boolean);
|
|
var
|
|
fw: TThread;
|
|
begin
|
|
if (fActive = value) then begin
|
|
if not fActive or (fState <> scNotConnected) then
|
|
Exit;
|
|
end;
|
|
fActive := value;
|
|
if ComponentState * [csLoading] = [] then
|
|
begin
|
|
if (fWorkerThread <> nil) then
|
|
begin
|
|
fw := fWorkerThread;
|
|
fWorkerThread := nil;
|
|
fClient.Disconnect;
|
|
TROClientThread(fw).Terminate;
|
|
fw.WaitFor;
|
|
FreeAndNil(fw);
|
|
fState := scNotConnected;
|
|
end;
|
|
if fEventThreadPool = nil then
|
|
begin
|
|
EventThreadPool := TROThreadPool.Create(nil);
|
|
fOwnsEventThreadPool := true;
|
|
end;
|
|
if fActive then
|
|
begin
|
|
fReconnectEvent.SetEvent;
|
|
fConnectEvent.ResetEvent;
|
|
fState := scConnecting;
|
|
fWorkerThread := TROClientThread.Create(fClient);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TROCustomSuperTcpChannel.SetClientID(const Value: TGUID);
|
|
begin
|
|
fClient.ClientID := Value;
|
|
end;
|
|
|
|
procedure TROCustomSuperTcpChannel.SetEventThreadPool(
|
|
const Value: TROThreadPool);
|
|
begin
|
|
if fOwnsEventThreadPool then
|
|
begin
|
|
fEventThreadPool.Free;
|
|
fOwnsEventThreadPool := false;
|
|
end;
|
|
fEventThreadPool := Value;
|
|
end;
|
|
|
|
procedure TROCustomSuperTCPChannel.SetHost(const Value: string);
|
|
begin
|
|
if fActive and (csLoading in ComponentState) then
|
|
raise Exception.Create('Client is active');
|
|
fHost := value;
|
|
end;
|
|
|
|
procedure TROCustomSuperTcpChannel.SetMaxPackageSize(val: Integer);
|
|
begin
|
|
fClient.MaxPackageSize := Val;
|
|
end;
|
|
|
|
procedure TROCustomSuperTcpChannel.SetPingSecs(const Value: Integer);
|
|
begin
|
|
if (Value < 10) or (Value > 60) then raise Exception.Create('PingSecs has to be between 10 and 60');
|
|
fPingSecs := Value;
|
|
end;
|
|
|
|
procedure TROCustomSuperTCPChannel.SetPort(const Value: Integer);
|
|
begin
|
|
if fActive and (csLoading in ComponentState) then
|
|
raise Exception.Create('Client is active');
|
|
fPort := Value;
|
|
end;
|
|
|
|
procedure TROCustomSuperTcpChannel.SetSkipAck(const Value: Boolean);
|
|
begin
|
|
fClient.SkipAck := Value;
|
|
end;
|
|
|
|
procedure TROCustomSuperTcpChannel.UnregisterEventReceiver(
|
|
aReceiver: IROEventReceiver);
|
|
begin
|
|
if assigned(fEventReceiver) then
|
|
TComponent(fEventReceiver.GetObject).RemoveFreeNotification(Self);
|
|
fEventReceiver := nil;
|
|
end;
|
|
|
|
type
|
|
TROSBEventTrigger = class(TInterfacedObject, IROThreadPoolCallback)
|
|
private
|
|
fEvent: TNotifyEvent;
|
|
fSender: TObject;
|
|
procedure Execute;
|
|
public
|
|
constructor Create(aSender: TObject; aEvent: TNotifyEvent);
|
|
procedure Callback(Caller: TROThreadPool; aThread: TThread);
|
|
end;
|
|
|
|
procedure TROCustomSuperTcpChannel.WaitForActive(const Timeout: Integer);
|
|
begin
|
|
SetActive(true);
|
|
if fConnectEvent.WaitFor(Timeout) <> wrSignaled then raise EROException.Create('No connection available');
|
|
end;
|
|
|
|
{ TROSCClientWorker }
|
|
|
|
procedure TROSCClientWorker.Connected;
|
|
begin
|
|
inherited;
|
|
fOwner.fState := scConnected;
|
|
fOwner.fConnectEvent.SetEvent;
|
|
if assigned(fOwner.fOnConnected) then begin
|
|
if fOwner.fSynchronizeEvents then
|
|
fOwner.fEventThreadPool.QueueItem(TROSBEventTrigger.Create(fOwner, fOwner.fOnconnected))
|
|
else
|
|
fOwner.fOnconnected(fOwner);
|
|
end;
|
|
end;
|
|
|
|
constructor TROSCClientWorker.Create(aOwner: TROCustomSuperTCPChannel;
|
|
aConnection: TIdTCPConnection);
|
|
begin
|
|
fOwner := aOwner;
|
|
inherited Create(aConnection);
|
|
PingFrequency := fOwner.fPingSecs;
|
|
PingTimeout := PingFrequency * 15 div 10;
|
|
end;
|
|
|
|
procedure TROSCClientWorker.Disconnected(var RestartLoop: Boolean);
|
|
// restartloop is false by default
|
|
begin
|
|
inherited;
|
|
|
|
try
|
|
fOwner.fConnection.Disconnect;
|
|
except
|
|
end;
|
|
if assigned(fOwner.fOnDisconnected) then begin
|
|
if fOwner.fSynchronizeEvents then
|
|
fOwner.fEventThreadPool.QueueItem(TROSBEventTrigger.Create(fOwner, fOwner.fOnDisconnected))
|
|
else
|
|
fOwner.fOnDisconnected(fOwner);
|
|
end;
|
|
if fOwner.fActive and fOwner.fAutoReconnect and not fSkipReconnect then
|
|
fOwner.fState := scReconnecting
|
|
else begin
|
|
fOwner.fState := scNotConnected;
|
|
fOwner.fActive := false;
|
|
fOwner.fConnectEvent.ResetEvent;
|
|
exit;
|
|
end;
|
|
|
|
fOwner.fReconnectEvent.ResetEvent;
|
|
fOwner.fConnectEvent.ResetEvent;
|
|
while fOwner.fActive and fOwner.fAutoReconnect and not fSkipReconnect do
|
|
begin
|
|
fOwner.fReconnectEvent.WaitFor(fOwner.fReconnectDelay); // don't want to create a tight loop
|
|
try
|
|
fOwner.fReconnectEvent.ResetEvent;
|
|
fOwner.fConnection.Connect;
|
|
RestartLoop := True;
|
|
Break;
|
|
except
|
|
// we failed, retry in a few
|
|
end;
|
|
end;
|
|
if RestartLoop then
|
|
fOwner.fState := scConnecting
|
|
else begin
|
|
fowner.fState := scNotConnected;
|
|
fOwner.fActive := false;
|
|
fOwner.fConnectEvent.ResetEvent;
|
|
end;
|
|
end;
|
|
|
|
procedure TROSCClientWorker.Idle;
|
|
begin
|
|
IF fOwner.IdleTimeoutMinutes > 0 then begin
|
|
if Now > LastData + ((1.0 / 24 / 60) * fOwner.IdleTimeoutMinutes) then begin
|
|
Disconnect;
|
|
fSkipReconnect := true;
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TROSCClientWorker.IncomingData(Id: Integer; aData: TStream);
|
|
begin
|
|
fOwner.HasData(id, aData);
|
|
end;
|
|
|
|
procedure TROSCClientWorker.SetAckDetails(Id: Integer; Oke: Boolean;
|
|
ErrorNo: Integer);
|
|
var
|
|
lList: TList;
|
|
i: Integer;
|
|
lReq: TROWaitingRequest;
|
|
begin
|
|
if Oke then begin
|
|
inherited;
|
|
exit;
|
|
end;
|
|
lList := FOwner.fWaitingRequests.LockList;
|
|
try
|
|
lReq := nil;
|
|
for i := lList.Count -1 downto 0 do
|
|
begin
|
|
if TROWaitingRequest(lList[i]).Id = Id then
|
|
begin
|
|
lReq := TROWaitingRequest(lList[i]);
|
|
break;
|
|
end;
|
|
end;
|
|
if lReq = nil then
|
|
inherited
|
|
else begin
|
|
lReq.fResultErrorCode := ErrorNo;
|
|
lReq.Event.SetEvent;
|
|
end;
|
|
finally
|
|
fOwner.fWaitingRequests.UnlockList;
|
|
end;
|
|
end;
|
|
|
|
{ TROClientThread }
|
|
|
|
constructor TROClientThread.Create(aChannel: TROSCClientWorker);
|
|
begin
|
|
inherited Create(True);
|
|
fChannel := aChannel;
|
|
FreeOnTerminate := false;
|
|
Resume;
|
|
end;
|
|
|
|
procedure TROClientThread.Execute;
|
|
var
|
|
lRet: Boolean;
|
|
begin
|
|
TIdTCPClient(fChannel.Connection).Host := fChannel.Owner.fHost;
|
|
TIdTCPClient(fChannel.Connection).Port := fChannel.Owner.fPort;
|
|
lRet := true;
|
|
fConnecting := True;
|
|
while lRet do begin
|
|
lRet := false;
|
|
try
|
|
TIdTCPClient(fChannel.Connection).Connect;
|
|
except
|
|
on e: Exception do begin
|
|
if fChannel.Owner.AutoReconnect then begin
|
|
lRet := true;
|
|
fChannel.fOwner.fReconnectEvent.WaitFor(fChannel.fOwner.fReconnectDelay);
|
|
end;
|
|
if assigned(fChannel.Owner.OnException) then fChannel.Owner.OnException(fChannel.Owner, e, lRet);
|
|
if not lRet then begin
|
|
fConnecting := False;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
fChannel.DoExecute;
|
|
end;
|
|
|
|
{ TROWaitingRequest }
|
|
|
|
constructor TROWaitingRequest.Create(Id: Integer);
|
|
begin
|
|
inherited Create;
|
|
fId := Id;
|
|
fEvent := TROEvent.Create(nil, true, false, '');
|
|
fFreeEvent := True;
|
|
fResultErrorCode := -1;
|
|
end;
|
|
|
|
constructor TROWaitingRequest.Create(Id: Integer; Ev: TROEvent);
|
|
begin
|
|
inherited Create;
|
|
fId := Id;
|
|
fEvent := ev;
|
|
fResultErrorCode := -1;
|
|
end;
|
|
|
|
destructor TROWaitingRequest.Destroy;
|
|
begin
|
|
fResultData.Free;
|
|
if fFreeEvent then
|
|
fEvent.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ TROPooledEvent }
|
|
|
|
procedure TROPooledEvent.Callback(Caller: TROThreadPool; Thread: TThread);
|
|
begin
|
|
if fOwner.fEventReceiver <> nil then
|
|
begin
|
|
fOwner.fEventReceiver.Dispatch(fData, Thread);
|
|
end;
|
|
end;
|
|
|
|
constructor TROPooledEvent.Create(aData: TStream;
|
|
aOwner: TROCustomSuperTCPChannel);
|
|
begin
|
|
inherited Create;
|
|
fOwner := aOwner;
|
|
fData := aData;
|
|
end;
|
|
|
|
destructor TROPooledEvent.Destroy;
|
|
begin
|
|
fData.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ TROSBEventTrigger }
|
|
|
|
procedure TROSBEventTrigger.Callback(Caller: TROThreadPool;
|
|
aThread: TThread);
|
|
begin
|
|
try
|
|
TROClientThread(aThread).Synchronize(Execute);
|
|
except
|
|
// exceptions cannot pass back to the pool
|
|
end;
|
|
end;
|
|
|
|
constructor TROSBEventTrigger.Create(aSender: TObject;
|
|
aEvent: TNotifyEvent);
|
|
begin
|
|
inherited Create;
|
|
fSender := aSender;
|
|
fEvent := aEvent;
|
|
end;
|
|
|
|
procedure TROSBEventTrigger.Execute;
|
|
begin
|
|
if assigned(fEvent) then
|
|
fEvent(fSender);
|
|
end;
|
|
|
|
initialization
|
|
RegisterTransportChannelClass(TROSuperTcpChannel);
|
|
|
|
finalization
|
|
UnRegisterTransportChannelClass(TROSuperTcpChannel);
|
|
|
|
end.
|