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
27 KiB
ObjectPascal
862 lines
27 KiB
ObjectPascal
unit uROSCHelpers;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ 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,
|
|
{$IFDEF RemObjects_INDY10}IdIOHandler, IdGlobal,{$ENDIF}
|
|
{$IFDEF REMOBJECTS_TRIAL}uROTrial, {$ENDIF}
|
|
IdTCPConnection, uROServer {$IFDEF WIN32}, Windows {$ENDIF}, SyncObjs;
|
|
|
|
type
|
|
EROTimeout = class(EROException);
|
|
TROAckState = (rNone, rAck, rNoAck);
|
|
IROPackageAck = interface
|
|
['{89ABD257-42CB-4B4B-9BA6-3E5CED10605B}']
|
|
function GetEvent: TROEvent;
|
|
function GetAckNo: Integer;
|
|
function GetNoAckError: Integer;
|
|
procedure SetNoAckError(I: Integer);
|
|
function GetAckState: TROAckState;
|
|
procedure SetAckState(I: TROAckState);
|
|
|
|
property Event: TROEvent read GetEvent;
|
|
property AckNo: Integer read GetAckNo;
|
|
property NoAckError: Integer read GetNoAckError write SetNoAckError;
|
|
property AckState: TROAckState read GetAckState write SetAckState;
|
|
|
|
procedure RemoveFromList;
|
|
end;
|
|
TROSuperChannelWorker = class
|
|
private
|
|
fMaxPackageSize: Integer;
|
|
fIsServer: Boolean;
|
|
fConnection: TIdTCPConnection;
|
|
fWriteLock,
|
|
fInternalWriteLock: TCriticalSection;
|
|
fClientID: TGUID;
|
|
fLastId: Integer;
|
|
fConnected: Boolean;
|
|
fLastData: TDateTime;
|
|
|
|
// fAckWaitTimeout: Integer;
|
|
fOtherSideMaxPackageLen: Integer;
|
|
fWaitingAckList: TInterfaceList;
|
|
fRemoteSupportsOptions, fRemoteSkipAck, fSkipAck: Boolean;
|
|
fPingFrequency,
|
|
fPingTimeout: Integer;
|
|
procedure SetSkipAck(const Value: Boolean);
|
|
protected
|
|
property PingFrequency: Integer read fPingFrequency write fPingFrequency;
|
|
property PingTimeout: Integer read fPingTimeout write fPingTimeout;
|
|
property LastData: TDateTime read FLastData;
|
|
property IsServer: Boolean read fIsServer write fIsServer;
|
|
procedure Idle; virtual;
|
|
procedure Connected; virtual;
|
|
procedure SupportsOptions;
|
|
procedure ProcessOption(Data: TStream);
|
|
procedure Disconnected(var RestartLoop: Boolean); virtual;
|
|
procedure IncomingData(Id: Integer; aData: TStream); virtual; abstract;
|
|
function IntSendData(Id: Integer; aData: TStream): IROPackageAck;
|
|
procedure SetAckDetails(Id: Integer; Oke: Boolean; ErrorNo: Integer); virtual;
|
|
procedure SendOptions(aData: UTF8String);
|
|
public
|
|
constructor Create(aConnection: TIdTCPConnection);
|
|
destructor Destroy; override;
|
|
|
|
property ClientID: TGuid read fClientID write fClientID;
|
|
property Connection: TIdTCPConnection read fConnection;
|
|
|
|
// to be called from a thread; will stay checking until disconnected
|
|
procedure DoExecute;
|
|
|
|
procedure Disconnect;
|
|
|
|
// Thread safe method
|
|
procedure SendError(Id: Integer; Error: Byte);
|
|
procedure BeginWriteLock;
|
|
function SendPackage(aData: TStream; Id: Integer = 0): IROPackageAck;
|
|
procedure EndWriteLock;
|
|
class procedure WaitForAck(pkg: IROPackageAck; Timeout: Integer = 60000);
|
|
function GenerateId: Integer;
|
|
|
|
// properties
|
|
property MaxPackageSize: Integer read fMaxPackageSize write fMaxPackageSize;
|
|
property IsConnected: Boolean read fConnected write fConnected;
|
|
property SkipAck: Boolean read fSkipAck write SetSkipAck;
|
|
end;
|
|
|
|
const
|
|
ScCmdNoAck_MsgTooLarge = 0;
|
|
ScCmdNoAck_Timeout = 1;
|
|
scCmdNoAck_UnknownCommand = 2;
|
|
ScCmdNoAck_QueueFull = 3;
|
|
ScCmdNoAck_SupportsOptions = 255;
|
|
|
|
|
|
implementation
|
|
const
|
|
ScWelcome = 'ROSC10';
|
|
|
|
ScCmdHello = 0;
|
|
{
|
|
Client:
|
|
'ROSC10'
|
|
[MyGuid] or [NullGuid]
|
|
MaxPackageLength: Int32;
|
|
Server:
|
|
'ROSC10'
|
|
[YourGuid] or [NewGuid]
|
|
MaxPackageLength: Int32;
|
|
}
|
|
ScCmdPackage = 1;
|
|
{
|
|
Request or Event Id: Int32; (Event < 0; Request/Response > 0)
|
|
Length: Int32;
|
|
Data: [...]
|
|
}
|
|
ScCmdAck = 2;
|
|
{
|
|
Id: Integer;
|
|
}
|
|
ScCmdNoAck = 3;
|
|
{
|
|
Id: Integer;
|
|
Error:
|
|
0 = Message too large
|
|
1 = Timeout
|
|
}
|
|
|
|
ScCmdPing = 4;
|
|
{ Should be sent every 60 seconds by the client
|
|
RandomNumber: Integer;
|
|
}
|
|
ScCmdPong = 5;
|
|
{ Reply to ping
|
|
OriginalRandomNumber: Integer;
|
|
}
|
|
ScCmdOptions = 6;
|
|
{
|
|
Length: Longint
|
|
Data: array of 0..Length -1 of byte
|
|
UTF8 encoded, seperated by #13
|
|
}
|
|
|
|
|
|
|
|
type
|
|
TROPackageAck = class(TInterfacedObject, IROPackageAck)
|
|
private
|
|
fEvent: TROEvent;
|
|
fAckNo,
|
|
FAckNoError: Integer;
|
|
FAckState: TROAckState;
|
|
FOwner: TROSuperChannelWorker;
|
|
public
|
|
function GetEvent: TROEvent;
|
|
function GetAckNo: Integer;
|
|
function GetNoAckError: Integer;
|
|
procedure SetNoAckError(I: Integer);
|
|
function GetAckState: TROAckState;
|
|
procedure SetAckState(I: TROAckState);
|
|
|
|
constructor Create(aOwner: TROSuperChannelWorker; aId: Integer);
|
|
destructor Destroy; override;
|
|
|
|
procedure RemoveFromList;
|
|
end;
|
|
|
|
{ TROSuperChannelWorker }
|
|
|
|
constructor TROSuperChannelWorker.Create(aConnection: TIdTCPConnection);
|
|
begin
|
|
inherited Create;
|
|
fPingFrequency := 60;
|
|
fPingTimeout := 90;
|
|
fConnection := aConnection;
|
|
fWriteLock := TCriticalSection.Create;
|
|
fInternalWriteLock := TCriticalSection.Create;
|
|
fMaxPackageSize := 1024 * 1024; // 1mb
|
|
fWaitingAckList:= TInterfaceList.Create;
|
|
|
|
end;
|
|
|
|
destructor TROSuperChannelWorker.Destroy;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
fWaitingAckList.Lock;
|
|
try
|
|
for i := fWaitingAckList.Count -1 downto 0 do
|
|
IROPackageAck(fWaitingAckList[i]).RemoveFromList;
|
|
finally
|
|
fWaitingAckList.Unlock;
|
|
end;
|
|
fWaitingAckList.Free;
|
|
fInternalWriteLock.Free;
|
|
fWriteLock.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TROSuperChannelWorker.Disconnect;
|
|
begin
|
|
{$IFDEF RemOBjects_INDY8}
|
|
fConnection.Binding.CloseSocket();
|
|
{$ELSE}
|
|
{$IFDEF RemObjects_INDY10}
|
|
if assigned(fConnection.Socket) and (fConnection.Socket.Connected) then
|
|
fConnection.Socket.Close;
|
|
{$ELSE}
|
|
fConnection.DisconnectSocket;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$IFDEF RemObjects_INDY10}
|
|
type
|
|
TIndy10IOHandlerHack = class(TIdIOHandler)
|
|
public
|
|
function ReadFromStack(ARaiseExceptionIfDisconnected: Boolean = True;
|
|
ATimeout: Integer = IdTimeoutDefault;
|
|
ARaiseExceptionOnTimeout: Boolean = True): Integer;
|
|
end;
|
|
|
|
function TIndy10IOHandlerHack.ReadFromStack(ARaiseExceptionIfDisconnected: Boolean = True;
|
|
ATimeout: Integer = IdTimeoutDefault;
|
|
ARaiseExceptionOnTimeout: Boolean = True): Integer;
|
|
begin
|
|
Result := ReadFromSource(ARaiseExceptionIfDisconnected, ATimeout, ARaiseExceptionOnTimeout)
|
|
end;
|
|
|
|
procedure Indy10ReadBuffer(aConnection: TIdTCPConnection; var Data; Len: Longint);
|
|
var
|
|
LBytes: TidBytes;
|
|
begin
|
|
aConnection.IOHandler.ReadBytes(LBytes, Len, False);
|
|
if Length(lBytes) <> len then raise exception.Create('Not enough data available');
|
|
Move(lBytes[0], Data, Len);
|
|
end;
|
|
procedure Indy10WriteBuffer(aConnection: TIdTCPConnection; const Data; Len: Longint);
|
|
var
|
|
lBytes: TidBytes;
|
|
begin
|
|
SetLength(lBytes, Len);
|
|
move(Data, lBytes[0], Len);
|
|
aConnection.IOHandler.Write(lBytes);
|
|
end;
|
|
|
|
{$IFDEF RemObjects_INDY10A}
|
|
procedure Indy10AReadStream(aConnection: TIdTcpConnection; aStream: TStream; len: Longint);
|
|
var
|
|
Buffer: array[0..2048-1] of byte;
|
|
cl: Integer;
|
|
begin
|
|
while len > 0 do
|
|
begin
|
|
if len > sizeof(Buffer) then cl := sizeof(Buffer) else cl := len;
|
|
Indy10ReadBuffer(aConnection, Buffer, cl);
|
|
aStream.Write(Buffer, cl);
|
|
len := len - cl;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
procedure TROSuperChannelWorker.Connected;
|
|
var
|
|
b: array[0..6] of byte;
|
|
begin
|
|
fConnected := True;
|
|
b[0] := ScCmdNoAck;
|
|
b[1] := 0;
|
|
b[2] := 0;
|
|
b[3] := 0;
|
|
b[4] := 0;
|
|
b[5] := ScCmdNoAck_SupportsOptions;
|
|
{$IFDEF RemObjects_INDY10}
|
|
Indy10WriteBuffer(fConnection, b, sizeof(b));
|
|
{$ELSE}
|
|
fConnection.WriteBuffer(b, sizeof(b));
|
|
{$ENDIF}
|
|
end;
|
|
|
|
|
|
procedure TROSuperChannelWorker.Disconnected(var RestartLoop: Boolean);
|
|
begin
|
|
fConnected := False;
|
|
end;
|
|
|
|
procedure TROSuperChannelWorker.DoExecute;
|
|
var
|
|
fLastPackage: DateTime;
|
|
lServerExpectAck: Integer;
|
|
lTmpId,
|
|
lTmpLen: Integer;
|
|
cmd: Byte;
|
|
Bl: array[0..5] of Byte;
|
|
lData: TMemoryStream;
|
|
lRetry: Boolean;
|
|
begin
|
|
{$IFDEF RemObjects_INDY10}
|
|
fConnection.Socket.UseNagle := False;
|
|
{$ELSE}
|
|
lTmpId := 1; // Indy 8 and 9 have the UseNagle property too, but it doesn't do anything.
|
|
fConnection.{$IFDEF RemObjects_INDY9}Socket.{$ENDIF}Binding.SetSockOpt(6, 1, @lTmpId, 4);
|
|
{$ENDIF}
|
|
repeat
|
|
fRemoteSkipAck := false;
|
|
fRemoteSupportsOptions := false;
|
|
lServerExpectAck := 0;
|
|
try
|
|
if IsServer then
|
|
begin
|
|
|
|
if fConnection.{$IFDEF RemObjects_INDY10}IOHandler.{$ENDIF}ReadString(6) <> ScWelcome then
|
|
begin
|
|
fConnection.{$IFDEF RemObjects_INDY10}IOHandler.{$ENDIF}Write('ROSC: Invalid connection string');
|
|
fConnection.Disconnect;
|
|
exit;
|
|
end;
|
|
{$IFDEF RemObjects_INDY10}
|
|
Indy10ReadBuffer(fConnection, fClientID, Sizeof(fClientID));
|
|
{$ELSE}
|
|
fConnection.ReadBuffer(fClientID, Sizeof(fClientID));
|
|
{$ENDIF}
|
|
if IsEqualGUID(fClientID, EmptyGUID) then
|
|
fClientID := NewGuid;
|
|
fOtherSideMaxPackageLen := fConnection.{$IFDEF RemObjects_INDY10}IOHandler.{$ENDIF}{$IFDEF FPC}ReadLongInt{$ELSE}ReadInteger{$ENDIF}(false);
|
|
fConnection.{$IFDEF RemObjects_INDY10}IOHandler.{$ENDIF}Write(ScWelcome);
|
|
{$IFDEF RemObjects_INDY10}
|
|
Indy10WriteBuffer(fConnection, fClientID, sizeof(FClientID));
|
|
{$ELSE}
|
|
fConnection.WriteBuffer(fClientID, sizeof(fClientID));
|
|
{$ENDIF}
|
|
fConnection.{$IFDEF RemObjects_INDY10}IOHandler.Write{$ELSE}WriteInteger{$ENDIF}(fMaxPackageSize, false);
|
|
end else begin
|
|
fConnection.{$IFDEF RemObjects_INDY10}IOHandler.{$ENDIF}Write(ScWelcome);
|
|
{$IFDEF RemObjects_INDY10}
|
|
Indy10WriteBuffer(fConnection, fClientID, sizeof(FClientID));
|
|
{$ELSE}
|
|
fConnection.WriteBuffer(fClientID, sizeof(fClientID));
|
|
{$ENDIF}
|
|
fConnection.{$IFDEF RemObjects_INDY10}IOHandler.Write{$ELSE}WriteInteger{$ENDIF}(fMaxPackageSize, false);
|
|
|
|
if fConnection.{$IFDEF RemObjects_INDY10}IOHandler.{$ENDIF}ReadString(6) <> ScWelcome then
|
|
begin
|
|
fConnection.{$IFDEF RemObjects_INDY10}IOHandler.{$ENDIF}Write('ROSC: Invalid connection string');
|
|
fConnection.Disconnect;
|
|
exit;
|
|
end;
|
|
{$IFDEF RemObjects_INDY10}
|
|
Indy10ReadBuffer(fConnection, fClientID, Sizeof(fClientID));
|
|
{$ELSE}
|
|
fConnection.ReadBuffer(fClientID, Sizeof(fClientID));
|
|
{$ENDIF}
|
|
fOtherSideMaxPackageLen := fConnection.{$IFDEF RemObjects_INDY10}IOHandler.{$ENDIF}{$IFDEF FPC}ReadLongInt{$ELSE}ReadInteger{$ENDIF}(false);
|
|
end;
|
|
fLastPackage := Now;
|
|
Connected;
|
|
|
|
while fConnection.Connected do
|
|
begin
|
|
if fConnection.{$IFDEF RemObjects_INDY10}IOHandler.{$ENDIF}
|
|
{$IFDEF RemObjects_INDY8}CurrentReadBufferSize{$ELSE}InputBuffer.Size{$ENDIF} = 0 then // check for data
|
|
{$IFDEF RemObjects_INDY10}TIndy10IOHandlerHack(fConnection.IOHandler).ReadFromStack{$ELSE}fConnection.ReadFromStack{$ENDIF}(false, (fPingFrequency * 10 div 25) * 1000, {$IFDEF RemObjects_INDY8}true{$ELSE}false{$ENDIF});
|
|
if fConnection.{$IFDEF RemObjects_INDY10}IOHandler.{$ENDIF}
|
|
{$IFDEF RemObjects_INDY8}CurrentReadBufferSize{$ELSE}InputBuffer.Size{$ENDIF} > 0 then begin // we got data
|
|
fLastPackage := Now;
|
|
{$IFDEF RemObjects_INDY8}
|
|
fConnection.ReadBuffer(cmd, 1);
|
|
{$ELSE}
|
|
cmd := ord(fConnection.{$IFDEF RemObjects_INDY10}IOHandler.{$ENDIF}ReadChar);
|
|
{$ENDIF}
|
|
case cmd of
|
|
ScCmdPong:
|
|
begin
|
|
if fConnection.{$IFDEF RemObjects_INDY10}IOHandler.{$ENDIF}{$IFDEF FPC}ReadLongInt{$ELSE}ReadInteger{$ENDIF}(false) = lServerExpectAck then
|
|
begin
|
|
lServerExpectAck := 0;
|
|
end;
|
|
end;
|
|
ScCmdPing:
|
|
begin
|
|
Bl[0] := ScCmdPong;
|
|
lTmpId := fConnection.{$IFDEF RemObjects_INDY10}IOHandler.{$ENDIF}{$IFDEF FPC}ReadLongInt{$ELSE}ReadInteger{$ENDIF}(false);
|
|
Move(ltmpId, bl[1], 4);
|
|
fInternalWriteLock.Acquire;
|
|
try
|
|
{$IFDEF RemObjects_INDY10}
|
|
Indy10WriteBuffer(fConnection, Bl, 5);
|
|
{$ELSE}
|
|
fConnection.WriteBuffer(Bl, 5);
|
|
{$ENDIF}
|
|
finally
|
|
fInternalWriteLock.Release;
|
|
end;
|
|
end;
|
|
ScCmdAck:
|
|
begin
|
|
lTmpId := fConnection.{$IFDEF RemObjects_INDY10}IOHandler.{$ENDIF}{$IFDEF FPC}ReadLongInt{$ELSE}ReadInteger{$ENDIF}(false);
|
|
SetAckDetails(lTmpId, true, 0);
|
|
end;
|
|
ScCmdNoAck:
|
|
begin
|
|
lTmpId := fConnection.{$IFDEF RemObjects_INDY10}IOHandler.{$ENDIF}{$IFDEF FPC}ReadLongInt{$ELSE}ReadInteger{$ENDIF}(false);
|
|
{$IFDEF RemObjects_INDY8}
|
|
fConnection.ReadBuffer(cmd, 1);
|
|
{$ELSE}
|
|
cmd := byte(fConnection.{$IFDEF RemObjects_INDY10}IOHandler.{$ENDIF}ReadChar);
|
|
{$ENDIF}
|
|
if cmd = ScCmdNoAck_SupportsOptions then
|
|
SupportsOptions
|
|
else
|
|
SetAckDetails(lTmpId, false, cmd);
|
|
end;
|
|
ScCmdOptions:
|
|
begin
|
|
lTmpLen := fConnection.{$IFDEF RemObjects_INDY10}IOHandler.{$ENDIF}{$IFDEF FPC}ReadLongInt{$ELSE}ReadInteger{$ENDIF}(false);
|
|
if lTmpLen > fMaxPackageSize then
|
|
begin
|
|
fInternalWriteLock.Acquire;
|
|
try
|
|
fConnection.{$IFDEF RemObjects_INDY10}IOHandler.{$ENDIF}Write(Chr(ScCmdNoAck)+#0#0#0#0+chr(ScCmdNoAck_MsgTooLarge));
|
|
finally
|
|
fInternalWriteLock.Release;
|
|
end;
|
|
fConnection.Disconnect;
|
|
exit;
|
|
end else begin
|
|
lData := TMemoryStream.Create;
|
|
try
|
|
{$IFDEF RemObjects_INDY10A}
|
|
Indy10AReadStream(fConnection, lData, lTmpLen);
|
|
{$ELSE}
|
|
fConnection.{$IFDEF RemObjects_INDY10}IOHandler.{$ENDIF}ReadStream(lData, lTmpLen, False);
|
|
{$ENDIF}
|
|
ProcessOption(lData);
|
|
finally
|
|
lData.Free; // only free when we failed to send the data to the queue
|
|
end;
|
|
fLastPackage := Now; // for packages that might take longer.
|
|
end;
|
|
end;
|
|
ScCmdPackage:
|
|
begin
|
|
fLastData := Now;
|
|
lTmpId := fConnection.{$IFDEF RemObjects_INDY10}IOHandler.{$ENDIF}{$IFDEF FPC}ReadLongInt{$ELSE}ReadInteger{$ENDIF}(false);
|
|
lTmpLen := fConnection.{$IFDEF RemObjects_INDY10}IOHandler.{$ENDIF}{$IFDEF FPC}ReadLongInt{$ELSE}ReadInteger{$ENDIF}(false);
|
|
if lTmpLen < 0 then
|
|
begin
|
|
fInternalWriteLock.Acquire;
|
|
try
|
|
fConnection.{$IFDEF RemObjects_INDY10}IOHandler.{$ENDIF}Write(Chr(ScCmdNoAck)+#0#0#0#0+chr(scCmdNoAck_UnknownCommand));
|
|
finally
|
|
fInternalWriteLock.Release;
|
|
end;
|
|
fConnection.Disconnect;
|
|
exit;
|
|
end;
|
|
if lTmpLen > fMaxPackageSize then
|
|
begin
|
|
fInternalWriteLock.Acquire;
|
|
try
|
|
fConnection.{$IFDEF RemObjects_INDY10}IOHandler.{$ENDIF}Write(Chr(ScCmdNoAck)+#0#0#0#0+chr(ScCmdNoAck_MsgTooLarge));
|
|
finally
|
|
fInternalWriteLock.Release;
|
|
end;
|
|
fConnection.Disconnect;
|
|
exit;
|
|
end else begin
|
|
lData := TMemoryStream.Create;
|
|
try
|
|
{$IFDEF RemObjects_INDY10A}
|
|
Indy10AReadStream(fConnection, lData, lTmpLen);
|
|
{$ELSE}
|
|
fConnection.{$IFDEF RemObjects_INDY10}IOHandler.{$ENDIF}ReadStream(lData, lTmpLen, False);
|
|
{$ENDIF}
|
|
lData.Seek(0, soFromBeginning);
|
|
Self.IncomingData(lTmpId, lData);
|
|
except
|
|
lData.Free; // only free when we failed to send the data to the queue
|
|
fInternalWriteLock.Acquire;
|
|
try
|
|
fConnection.{$IFDEF RemObjects_INDY10}IOHandler.{$ENDIF}Write(Chr(ScCmdNoAck));
|
|
{$IFDEF RemObjects_INDY10}
|
|
fConnection.IOHandler.Write(lTmpId, false);
|
|
{$ELSE}
|
|
fConnection.WriteInteger(lTmpId, false);
|
|
{$ENDIF}
|
|
fConnection.{$IFDEF RemObjects_INDY10}IOHandler.{$ENDIF}Write(Chr(ScCmdNoAck_QueueFull));
|
|
finally
|
|
fInternalWriteLock.Release;
|
|
end;
|
|
end;
|
|
if not fRemoteSkipAck then begin
|
|
fInternalWriteLock.Acquire;
|
|
try
|
|
bl[0] := ScCmdAck;
|
|
Move(lTmpId, bl[1], 4);
|
|
{$IFDEF RemObjects_INDY10}
|
|
Indy10WriteBuffer(fConnection, Bl, 5);
|
|
{$ELSE}
|
|
fConnection.WriteBuffer(Bl, 5);
|
|
{$ENDIF}
|
|
finally
|
|
fInternalWriteLock.Release;
|
|
end;
|
|
end;
|
|
fLastPackage := Now; // for packages that might take longer.
|
|
end;
|
|
end;
|
|
end;
|
|
end else begin
|
|
Idle;
|
|
if IsServer then
|
|
begin
|
|
if ((Now - fLastPackage) > (PingTimeout * (1.0 / (24 * 60 * 60)))) and (fConnection.Connected) then
|
|
begin
|
|
fInternalWriteLock.Acquire;
|
|
try
|
|
fConnection.{$IFDEF RemObjects_INDY10}IOHandler.{$ENDIF}Write(Chr(ScCmdNoAck)+#0#0#0#0+chr(ScCmdNoAck_Timeout));
|
|
fConnection.Disconnect;
|
|
finally
|
|
fInternalWriteLock.Release;
|
|
end;
|
|
exit;
|
|
end;
|
|
end else
|
|
begin
|
|
if (lServerExpectAck <> 0) and (fConnection.Connected) then
|
|
begin
|
|
if (Now - fLastPackage) > (PingTimeout * (1.0 / (24 * 60 * 60))) then
|
|
begin
|
|
fInternalWriteLock.Acquire;
|
|
try
|
|
fConnection.{$IFDEF RemObjects_INDY10}IOHandler.{$ENDIF}Write(Chr(ScCmdNoAck)+#0#0#0#0+chr(ScCmdNoAck_Timeout));
|
|
fConnection.Disconnect;
|
|
finally
|
|
fInternalWriteLock.Release;
|
|
end;
|
|
exit;
|
|
end;
|
|
end else begin
|
|
if (Now - fLastPackage) > (PingFrequency * (1.0 / (24 * 60 * 60))) then begin
|
|
lServerExpectAck := GetTickCount;
|
|
if lServerExpectAck = 0 then lServerExpectAck := 1;
|
|
bl[0] := ScCmdPing;
|
|
Move(lServerExpectAck, bl[1], 4);
|
|
fInternalWriteLock.Acquire;
|
|
try
|
|
{$IFDEF RemObjects_INDY10}
|
|
Indy10WriteBuffer(fConnection, Bl, 5);
|
|
{$ELSE}
|
|
fConnection.WriteBuffer(bl, 5);
|
|
{$ENDIF}
|
|
finally
|
|
fInternalWriteLock.Release;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
except
|
|
end;
|
|
lRetry := false;
|
|
try
|
|
Disconnect;
|
|
except
|
|
end;
|
|
Disconnected(lRetry);
|
|
until not lRetry;
|
|
end;
|
|
|
|
function TROSuperChannelWorker.GenerateId: Integer;
|
|
begin
|
|
fWriteLock.Acquire;
|
|
try
|
|
if IsServer then
|
|
begin
|
|
fLastId := fLastId - 1;
|
|
if fLastId > -1 then fLastId := -1;
|
|
end
|
|
else
|
|
begin
|
|
fLastId := fLastId + 1;
|
|
if fLastId < 1 then fLastId := 1;
|
|
end;
|
|
Result := fLastId;
|
|
finally
|
|
fWriteLock.Release;
|
|
end;
|
|
end;
|
|
|
|
procedure TROSuperChannelWorker.Idle;
|
|
begin
|
|
|
|
end;
|
|
|
|
function TROSuperChannelWorker.IntSendData(Id: Integer; aData: TStream): IROPackageAck;
|
|
var
|
|
Buffer: array[0.. 2047] of byte;
|
|
Len: Integer;
|
|
begin
|
|
fLastData := Now;
|
|
Result := TROPackageAck.Create(Self, Id);
|
|
fWaitingAckList.Add(Result);
|
|
Buffer[0] := ScCmdPackage;
|
|
Move(Id, Buffer[1], 4);
|
|
Len := aData.Size;
|
|
Move(Len, Buffer[5], 4);
|
|
|
|
aData.Seek(0, soFromBeginning);
|
|
|
|
fInternalWriteLock.Acquire;
|
|
try
|
|
Len := aData.Read(Buffer[9], sizeof(Buffer) - 9);
|
|
{$IFDEF RemObjects_INDY10}
|
|
Indy10WriteBuffer(fConnection, Buffer, Len + 9);
|
|
{$ELSE}
|
|
fConnection.WriteBuffer(Buffer, Len + 9);
|
|
{$ENDIF}
|
|
if Len > 0 then begin
|
|
repeat
|
|
Len := aData.Read(Buffer[0], Sizeof(Buffer));
|
|
{$IFDEF RemObjects_INDY10}
|
|
Indy10WriteBuffer(fConnection, Buffer, Len);
|
|
{$ELSE}
|
|
fConnection.WriteBuffer(Buffer[0], Len);
|
|
{$ENDIF}
|
|
until Len = 0;
|
|
end;
|
|
finally
|
|
fInternalWriteLock.Release;
|
|
end;
|
|
end;
|
|
|
|
procedure TROSuperChannelWorker.ProcessOption(Data: TStream);
|
|
var
|
|
lCmd, lData: UTF8String;
|
|
lPos: Integer;
|
|
begin
|
|
SetLength(lData, Data.Size);
|
|
Data.Position := 0;
|
|
Data.Read(lData[1], Length(lData));
|
|
lPos := Pos(#13, lData);
|
|
if lPos = 0 then begin
|
|
lCmd := lData;
|
|
lData := '';
|
|
end else begin
|
|
lCmd := copy(lData, 1, lPos-1);
|
|
Delete(lData, 1, lPos);
|
|
end;
|
|
if lCmd = 'SKIPACK' then begin
|
|
fRemoteSkipAck := lData <> 'OFF';
|
|
end;
|
|
end;
|
|
|
|
procedure TROSuperChannelWorker.SendError(Id: Integer; Error: Byte);
|
|
var
|
|
Buffer: array[0..5] of Byte;
|
|
begin
|
|
buffer[0] := ScCmdNoAck;
|
|
Move(ID, Buffer[1], 4);
|
|
Buffer[5] := Error;
|
|
fInternalWriteLock.Acquire;
|
|
try
|
|
{$IFDEF RemObjects_INDY10}
|
|
Indy10WriteBuffer(fConnection, Buffer, 6);
|
|
{$ELSE}
|
|
fConnection.WriteBuffer(Buffer, 6);
|
|
{$ENDIF}
|
|
finally
|
|
fInternalWriteLock.Release;
|
|
end;
|
|
end;
|
|
|
|
procedure TROSuperChannelWorker.SendOptions(aData: UTF8String);
|
|
var
|
|
Buffer: array of byte;
|
|
Len: Integer;
|
|
begin
|
|
fWriteLock.Acquire;
|
|
try
|
|
fLastData := Now;
|
|
SetLength(Buffer, Length(aData)+5);
|
|
Buffer[0] := ScCmdOptions;
|
|
Len := Length(aData);
|
|
Move(Len, Buffer[1], 4);
|
|
Move(aData[1], Buffer[5], Length(aDAta));
|
|
|
|
fInternalWriteLock.Acquire;
|
|
try
|
|
{$IFDEF RemObjects_INDY10}
|
|
Indy10WriteBuffer(fConnection, Buffer[0], Length(Buffer));
|
|
{$ELSE}
|
|
fConnection.WriteBuffer(Buffer[0], Length(Buffer));
|
|
{$ENDIF}
|
|
finally
|
|
fInternalWriteLock.Release;
|
|
end;
|
|
|
|
finally
|
|
fWriteLock.Release;
|
|
end;
|
|
end;
|
|
|
|
function TROSuperChannelWorker.SendPackage(aData: TStream; Id: Integer = 0): IROPackageAck;
|
|
begin
|
|
fWriteLock.Acquire;
|
|
try
|
|
if Id = 0 then
|
|
begin
|
|
id := GenerateId;
|
|
end;
|
|
Result := IntSendData(Id, aData);
|
|
finally
|
|
fWriteLock.Release;
|
|
end;
|
|
end;
|
|
|
|
procedure TROSuperChannelWorker.SetAckDetails(Id: Integer; Oke: Boolean;
|
|
ErrorNo: Integer);
|
|
var
|
|
i: Integer;
|
|
rp: IROPackageAck;
|
|
begin
|
|
fWaitingAckList.Lock;
|
|
try
|
|
for i := fWaitingAckList.Count -1 downto 0 do
|
|
begin
|
|
if IROPackageAck(fWaitingAckList[i]).AckNo = Id then
|
|
begin
|
|
rp := IROPackageAck(fWaitingAckList[i]);
|
|
rp.RemoveFromList;
|
|
|
|
rp.NoAckError := ErrorNo;
|
|
if Oke then
|
|
rp.AckState := rAck
|
|
else
|
|
rp.AckState := rNoAck;
|
|
rp.Event.SetEvent;
|
|
exit;
|
|
end;
|
|
end;
|
|
finally
|
|
fWaitingAckList.Unlock;
|
|
end;
|
|
end;
|
|
|
|
procedure TROSuperChannelWorker.SetSkipAck(const Value: Boolean);
|
|
begin
|
|
fSkipAck := Value;
|
|
end;
|
|
|
|
procedure TROSuperChannelWorker.SupportsOptions;
|
|
begin
|
|
if fSkipAck then SendOptions('SKIPACK'#13'ON');
|
|
fRemoteSupportsOptions := true;
|
|
end;
|
|
|
|
class procedure TROSuperChannelWorker.WaitForAck(pkg: IROPackageAck; Timeout: Integer = 60000);
|
|
begin
|
|
try
|
|
if pkg.Event = nil then exit; // skipack
|
|
|
|
if pkg.Event.WaitFor(Timeout) <> wrSignaled then
|
|
raise EROTimeout.Create('Timeout');
|
|
if pkg.AckState <> rAck then
|
|
begin
|
|
case pkg.NoAckError of
|
|
ScCmdNoAck_MsgTooLarge: raise eROMessageTooLarge.Create('Message too large');
|
|
else
|
|
raise EROException.Create('Unknown error');
|
|
end;
|
|
end;
|
|
finally
|
|
pkg.RemoveFromList;
|
|
end;
|
|
end;
|
|
|
|
procedure TROSuperChannelWorker.BeginWriteLock;
|
|
begin
|
|
fWriteLock.Acquire;
|
|
end;
|
|
|
|
procedure TROSuperChannelWorker.EndWriteLock;
|
|
begin
|
|
fWriteLock.Release;
|
|
end;
|
|
|
|
{ TROPackageAck }
|
|
|
|
constructor TROPackageAck.Create(aOwner: TROSuperChannelWorker; aId: Integer);
|
|
begin
|
|
inherited Create;
|
|
if not (aOwner.fSkipAck and aOwner.fRemoteSupportsOptions) then
|
|
fEvent := TROEvent.Create(nil, true, false, '');
|
|
fAckNo := aId;
|
|
FOwner := aOwner;
|
|
// if FOwner <> nil then FOwner.fWaitingAckList.Add(Self as IROPackageAck);
|
|
end;
|
|
|
|
destructor TROPackageAck.Destroy;
|
|
begin
|
|
fEvent.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TROPackageAck.GetAckNo: Integer;
|
|
begin
|
|
result := fAckNo;
|
|
end;
|
|
|
|
function TROPackageAck.GetAckState: TROAckState;
|
|
begin
|
|
Result := FAckState;
|
|
end;
|
|
|
|
function TROPackageAck.GetEvent: TROEvent;
|
|
begin
|
|
Result := fEvent;
|
|
end;
|
|
|
|
function TROPackageAck.GetNoAckError: Integer;
|
|
begin
|
|
Result := FAckNoError;
|
|
end;
|
|
|
|
procedure TROPackageAck.RemoveFromList;
|
|
begin
|
|
if FOwner <> nil then
|
|
begin
|
|
FOwner.fWaitingAckList.Remove(self as IROPackageAck);
|
|
FOwner := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TROPackageAck.SetAckState(I: TROAckState);
|
|
begin
|
|
FAckState := I;
|
|
end;
|
|
|
|
procedure TROPackageAck.SetNoAckError(I: Integer);
|
|
begin
|
|
FAckNoError := i;
|
|
end;
|
|
|
|
end.
|