Componentes.Terceros.RemObjects/official/5.0.35.741/RemObjects SDK for Delphi/Source/uROAsyncSCHelpers.pas

unit uROAsyncSCHelpers;
{----------------------------------------------------------------------------}
{ RemObjects SDK Library - Core 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,
  uROServer {$IFDEF MSWINDOWS}, 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;
  IROAbstractTCPConnection = interface;
  TROAsyncCallback = procedure (const Sender: IROAbstractTCPConnection) of object;
  IROAbstractTCPConnection = interface
    ['{17BDEB8C-4C92-40FB-9727-DC9F2FA26E8C}']
    procedure BeginReceive(aData: Pointer; aSize: Integer; aCallback: TROAsyncCallback);
    procedure BeginSend(aData: Pointer; aSize: Integer; aCallback: TROAsyncCallback);

    function EndReceive: Integer;
    function EndSend: Integer;

    procedure BeginDisconnect(aForce: Boolean; aCallback: TROAsyncCallback);
    procedure EndDisconnect;

    procedure BeginConnect(const aAdress: string; aPort: Integer; aCallback: TROAsyncCallback);
    function EndConnect: Boolean;

    procedure SetOnDisconnected(aCallback: TROAsyncCallback);
    function GetOnDisconnected: TROAsyncCallback;

    property OnDisconnected: TROAsyncCallback read GetOnDisconnected write SetOnDisconnected;

    procedure SetOnHaveIncompleteData(aCallback: TROAsyncCallback);
    function GetOnHaveIncompleteData: TROAsyncCallback;

    property OnHaveIncompleteData: TROAsyncCallback read GetOnHaveIncompleteData write SetOnHaveIncompleteData;
  end;
  TByteArray = array of Byte;
  TROAsyncSuperChannelWorker = class(TObject, IUnknown, IROTransport)
  private
    fRefCount: Integer;
    fMaxPackageSize: Integer;
    fIsServer: Boolean;
    fConnection: IROAbstractTCPConnection;
    fClientID: TGUID;
    fLastId: Integer;
    fRunning, fConnected: Boolean;
    fLastData: TDateTime;
    fStateData: Integer;

    fOtherSideMaxPackageLen: Integer;
    fWaitingAckList: TInterfaceList;
    fRemoteSupportsOptions, fRemoteSkipAck, fSkipAck: Boolean;
    fPingFrequency,
    fPingTimeout: Integer;
    fWriteQueue: TThreadList;
    fServerExpectAck: Integer;
    fWorkBuffer: TByteArray;
    procedure SetSkipAck(const Value: Boolean);
    procedure AsyncWrite(aData: TByteArray);
    procedure AsyncDisconnected(const Sender: IROAbstractTCPConnection); 
    procedure AsyncHaveIncompleteData(const aSender: IROAbstractTCPConnection);
    procedure cbAsyncWrite(const Sender: IROAbstractTCPConnection);
    procedure cbServerWelcome(const Sender: IROAbstractTCPConnection);
    procedure cbClientWelcome(const Sender: IROAbstractTCPConnection);
    procedure cbServerWelcomeDone(const Sender: IROAbstractTCPConnection);
    procedure cbClientWelcomeDone(const Sender: IROAbstractTCPConnection);
    procedure cbErrorDone(const Sender: IROAbstractTCPConnection);
    procedure cbMainRead(const Sender: IROAbstractTCPConnection);
    procedure cbTimer(Sender: TObject);
    procedure cbNoAckReply(const Sender: IROAbstractTCPConnection);
    procedure cbOptionsReply(const Sender: IROAbstractTCPConnection);
    procedure SetupMainLoop;
    procedure cbPackageLength(const Sender: IROAbstractTCPConnection);
    procedure cbPackage(const Sender: IROAbstractTCPConnection);
    class procedure cbInternalTimer(CurrentTickCount : cardinal);
  protected
    { IUnkown methods }
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;

    { IROTransport }
    function GetTransportObject : TObject;

    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 Connected; virtual;
    procedure HaveGuid; virtual;
    procedure SupportsOptions;
    procedure ProcessOption(Data: TByteArray);
    procedure Disconnected(var RestartLoop: Boolean); virtual;
    procedure IncomingData(Id: Integer; aData: TByteArray); virtual; abstract;
    function IntSendData(Id: Integer; aData: TStream): IROPackageAck;
    procedure SetAckDetails(Id: Integer; Oke: Boolean; ErrorNo: Integer); virtual;
    procedure SendOptions(aData: UTF8String);
    function GetDefaultResponse: string; virtual; 
  public
    constructor Create(aConnection: IROAbstractTCPConnection);
    destructor Destroy; override;

    property ClientID: TGuid read fClientID write fClientID;
    property Connection: IROAbstractTCPConnection read fConnection;

    procedure DoSetup;

    procedure Disconnect;

    // Thread safe method
    procedure SendError(Id: Integer; Error: Byte);
    function SendPackage(aData: TStream; Id: Integer = 0): IROPackageAck;
    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 :AnsiString = '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: TROAsyncSuperChannelWorker;
  public
    function GetEvent: TROEvent;
    function GetAckNo: Integer;
    function GetNoAckError: Integer;
    procedure SetNoAckError(I: Integer);
    function GetAckState: TROAckState;
    procedure SetAckState(I: TROAckState);

    constructor Create(aOwner: TROAsyncSuperChannelWorker; aId: Integer);
    destructor Destroy; override;

    procedure RemoveFromList;
  end;


  
var
  fTimer: TROThreadTimer;
  fTimerList: TThreadList;

class procedure TROAsyncSuperChannelWorker.cbInternalTimer(CurrentTickCount: cardinal);
var
  lList: TList;
  i: Integer;
begin
  lList := fTimerList.LockList;
  try
    for i := lList.Count -1 downto 0 do
      TROAsyncSuperChannelWorker(lList[i]).cbTimer(nil);
  finally
    fTimerList.UnlockList;
  end;
end;



procedure AddTimer(aCb: TROAsyncSuperChannelWorker);
var
  i: Integer;
  lList: TList;
begin
  lList := fTimerList.LockList;
  try
    fTimer := TROThreadTimer.Create(TROAsyncSuperChannelWorker.cbInternalTimer, 30000, false);
    i := lList.IndexOf(aCb);
    if i <> -1 then exit;
    i := lList.IndexOf(nil);
    if i <> -1 then
      lList[i] := aCb
    else
      lList.Add(aCb);
  finally
    fTimerList.UnlockList;
  end;
end;

procedure RemoveTimer(aCb: TROAsyncSuperChannelWorker);
var
  i: Integer;
  lList: TList;
begin
  lList := fTimerList.LockList;
  try
    i := lList.IndexOf(aCb);
    if i <> -1 then lList[i] := nil;
  finally
    fTimerList.UnlockList;
  end;
end;


{ TROPackageAck }

constructor TROPackageAck.Create(aOwner: TROAsyncSuperChannelWorker; 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;

{$ifndef fpc}
function InterlockedExchangePointer(var Target: Pointer; Value: Pointer): Pointer;
begin
  Result := Pointer(InterlockedExchange(Integer(Target), Integer(Value)));
end;
{$else}
function InterlockedExchangePointer(var Target: Pointer; Value: Pointer): Pointer;
begin
  {$IFDEF CPU64}
  result := Pointer(InterlockedExchange64(PtrInt(target), PtrInt(value)));
  {$ELSE}
  result := Pointer(InterlockedExchange(PtrInt(target), PtrInt(value)));
  {$ENDIF}
end;
{$endif}

procedure TROPackageAck.RemoveFromList;
var
  lOwner: TROAsyncSuperChannelWorker;
begin
  lOwner := InterlockedExchangePointer(Pointer(FOwner), nil);
  if lOwner <> nil then lOwner.fWaitingAckList.Remove(self as IROPackageAck);
end;

procedure TROPackageAck.SetAckState(I: TROAckState);
begin
  FAckState := I;
end;

procedure TROPackageAck.SetNoAckError(I: Integer);
begin
  FAckNoError := i;
end;

type
  TWriteItem = class
  public
    Data: TByteArray;
  end;

{ TROAsyncSuperChannelWorker }

procedure TROAsyncSuperChannelWorker.AsyncWrite(aData: TByteArray);
var
  lList: TList;
  p: TWriteItem;
begin
  lList := fWriteQueue.LockList;
  try
    p := TwriteItem.Create;
    p.Data := aData;
    lList.Add(p);
    if lList.Count <= 1 then begin
      fConnection.BeginSend(@p.Data[0], Length(p.Data), cbAsyncWrite);
    end;
  finally
    fWriteQueue.UnlockList;
  end;
end;

procedure TROAsyncSuperChannelWorker.cbAsyncWrite(
  const Sender: IROAbstractTCPConnection);
var
  lList: TList;
  p: TWriteItem;
begin
  fConnection.EndSend;
  lList := fWriteQueue.LockList;
  try
    if lList.Count = 0 then exit;
    p := lList[0];
    lList.Delete(0);
    p.Free;
    if lList.Count > 0 then begin
      p := lList[0];
      fConnection.BeginSend(@p.Data[0], Length(p.Data), cbAsyncWrite);
    end;
  finally
    fWriteQueue.UnlockList;
  end;
end;

procedure TROAsyncSuperChannelWorker.Connected;
begin
  // do nothing
end;

constructor TROAsyncSuperChannelWorker.Create(
  aConnection: IROAbstractTCPConnection);
begin
  inherited Create;
  fPingFrequency := 60;
  fPingTimeout := 90;
  fConnection := aConnection;
  fMaxPackageSize := 10*1024 * 1024; // 10mb
  fWaitingAckList:= TInterfaceList.Create;
  fWriteQueue := TThreadList.Create;
end;

destructor TROAsyncSuperChannelWorker.Destroy;
var
  i: Integer;
  pb: TWriteItem;
  lItems: TList;
begin
  RemoveTimer(self);
  fWaitingAckList.Lock;
  try
    for i := fWaitingAckList.Count -1 downto 0 do
      IROPackageAck(fWaitingAckList[i]).RemoveFromList;
  finally
    fWaitingAckList.Unlock;
  end;
  lItems := fWriteQueue.LockList;
  try
    while lItems.Count > 0 do begin
      pb := lItems[0];
      lItems.Delete(0);
      pb.Free;
    end;
  finally
    fWriteQueue.UnlockList;
  end;
  fWriteQueue.Free;
  fWaitingAckList.Free;
  fConnection.OnDisconnected := nil;
  fConnection.OnHaveIncompleteData := nil;
  fConnection := nil;
  inherited Destroy;
end;

procedure TROAsyncSuperChannelWorker.Disconnected(
  var RestartLoop: Boolean);
begin
  RestartLoop := false;
  // Do nothing
end;

function TROAsyncSuperChannelWorker.GenerateId: Integer;
begin
  fWriteQueue.LockList;
  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
    fWriteQueue.UnlockList;
  end;
end;

function TROAsyncSuperChannelWorker.GetTransportObject: TObject;
begin
  Result := Self;
end;

procedure TROAsyncSuperChannelWorker.SupportsOptions;
begin
  if fSkipAck then SendOptions('SKIPACK'#13'ON');
  fRemoteSupportsOptions := true;
end;

function TROAsyncSuperChannelWorker.IntSendData(Id: Integer;
  aData: TStream): IROPackageAck;
var
  Buffer: TByteArray;
  len: Integer;
begin
  fLastData := Now;
  Result := TROPackageAck.Create(Self, Id);
  fWaitingAckList.Add(Result);
  SetLength(Buffer, (4 + 4 + 1) + aData.Size);
  Buffer[0] := ScCmdPackage;
  Move(Id, Buffer[1], 4);
  Len := aData.Size;
  Move(Len, Buffer[5], 4);

  aData.Seek(0, soFromBeginning);
  aData.Read(Buffer[9], aData.Size);
  AsyncWrite(Buffer);
end;

procedure TROAsyncSuperChannelWorker.ProcessOption(Data: TByteArray);
var
  lCmd, lData: UTF8String;
  lPos: Integer;
begin
  SetLength(lData, Length(Data));
  Move(Data[0], lData[1], Length(lData));
  lPos := Pos(AnsiChar(#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;


function TROAsyncSuperChannelWorker.QueryInterface(const IID: TGUID;
  out Obj): HResult;
begin
  if GetInterface(IID, Obj) then
    Result := 0
  else
    Result := E_NOINTERFACE;
end;

procedure TROAsyncSuperChannelWorker.SendError(Id: Integer; Error: Byte);
var
  Buffer: TByteArray;
begin
  SetLength(Buffer, 6);
  buffer[0] := ScCmdNoAck;
  Move(ID, Buffer[1], 4);
  Buffer[5] := Error;
  AsyncWrite(Buffer);
end;

procedure TROAsyncSuperChannelWorker.SendOptions(aData: UTF8String);
var
  Buffer: TByteArray;
  Len: Integer;
begin
  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));
  AsyncWrite(Buffer);
end;

function TROAsyncSuperChannelWorker.SendPackage(aData: TStream;
  Id: Integer): IROPackageAck;
begin
  if fOtherSideMaxPackageLen < aData.Size then begin
    raise EROException.Create('Package too large');
  end
  else begin
    if Id = 0 then
    begin
      id := GenerateId;
    end;
    Result := IntSendData(Id, aData);
  end;  
end;

procedure TROAsyncSuperChannelWorker.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 TROAsyncSuperChannelWorker.SetSkipAck(const Value: Boolean);
begin
  fSkipAck := Value;
end;

class procedure TROAsyncSuperChannelWorker.WaitForAck(pkg: IROPackageAck;
  Timeout: Integer);
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;

function TROAsyncSuperChannelWorker._AddRef: Integer;
begin
  Result := InterlockedIncrement(fRefCount);
end;

function TROAsyncSuperChannelWorker._Release: Integer;
begin
  Result := InterlockedDecrement(fRefCount);
end;

procedure TROAsyncSuperChannelWorker.DoSetup;
var
  lWrite: TList;
  i: Integer;
  lData: TByteArray;
begin
  fRunning := true;
  fRemoteSupportsOptions := false;
  fRemoteSkipAck := false;
  fServerExpectAck := 0;
  lWrite := fWriteQueue.LockList;
  try
    for i:= 0 to lWRite.Count -1 do begin
      Pointer(lData) := lWrite[i];
      lData := nil;
    end;
    lWrite.Clear;
  finally
    fWriteQueue.UnlockList;
  end;
  fLastData := now;
  fConnection.OnDisconnected := AsyncDisconnected;
  fConnection.OnHaveIncompleteData := AsyncHaveIncompleteData;

  if fIsServer then begin
    SetLength(lData, 26);
    fWorkBuffer := lData;
    fConnection.BeginReceive(@lData[0], 26, cbServerWelcome);
  end else begin
    SetLength(lData, 26);
    fWorkBuffer := lData;
    Move(ScWelcome[1], lData[0], Length(ScWelcome));
    Move(fClientId, lData[6], 16);
    Move(fMaxPackageSize, lData[22], 4);
    fConnection.BeginSend(@lData[0], 26, cbClientWelcome);
  end;
end;



procedure TROAsyncSuperChannelWorker.cbClientWelcome(
  const Sender: IROAbstractTCPConnection);
begin
  fConnection.EndSend;
  fConnection.BeginReceive(@fWorkBuffer[0], 26, cbClientWelcomeDone);
end;

procedure TROAsyncSuperChannelWorker.cbServerWelcome(
  const Sender: IROAbstractTCPConnection);
var
  lData: Ansistring;
begin
  if fConnection.EndReceive <> 26 then fWorkBuffer := nil;

  if (fWorkBuffer = nil) or (fWorkBuffer[0] <> byte(scWelcome[1]))
    or (fWorkBuffer[1] <> byte(scWelcome[2]))
    or (fWorkBuffer[2] <> byte(scWelcome[3]))
    or (fWorkBuffer[3] <> byte(scWelcome[4]))
    or (fWorkBuffer[4] <> byte(scWelcome[5]))
    or (fWorkBuffer[5] <> byte(scWelcome[6])) then begin
    lData :={$IFDEF UNICODE}WideStringToAnsiString{$ENDIF} (GetDefaultResponse);
    SetLength(fWorkBuffer, Length(lData));
    move(lData[1], fWorkBuffer[0], Length(lData));
    fConnection.BeginSend(@fWorkBuffer[0], Length(fWorkBuffer), cbErrorDone);
    exit;
  end;
  Move(fWorkBuffer[6], fClientID, 16);
  Move(fWorkBuffer[22], fOtherSideMaxPackageLen, 4);
  if IsEqualGUID(fClientID, EmptyGUID) then
    fClientID := NewGuid;
  Move(fClientID, fWorkBuffer[6], 16);

  Move(fMaxPackageSize, fWorkBuffer[22], 4);

  fConnection.BeginSend(@fWorkBuffer[0], 26, cbServerWelcomeDone);
  HaveGuid;
end;

procedure TROAsyncSuperChannelWorker.cbClientWelcomeDone(
  const Sender: IROAbstractTCPConnection);
var
  lData: Ansistring;
begin
  if fConnection.EndReceive <> 26 then fWorkBuffer := nil;
  if (fWorkBuffer = nil) or (fWorkBuffer[0] <> Byte(scWelcome[1]))
    or (fWorkBuffer[1] <> Byte(scWelcome[2]))
    or (fWorkBuffer[2] <> Byte(scWelcome[3]))
    or (fWorkBuffer[3] <> Byte(scWelcome[4]))
    or (fWorkBuffer[4] <> Byte(scWelcome[5]))
    or (fWorkBuffer[5] <> Byte(scWelcome[6])) then begin
    lData := {$IFDEF UNICODE}WideStringToAnsiString{$ENDIF}(GetDefaultResponse);
    SetLength(fWorkBuffer, Length(lData));
    move(lData[1], fWorkBuffer[0], Length(lData));
    fConnection.BeginSend(@fWorkBuffer[0], Length(fWorkBuffer), cbErrorDone);
    exit;
  end;

  Move(fWorkBuffer[6], fClientID, 16);
  Move(fWorkBuffer[22], fOtherSideMaxPackageLen, 4);
  HaveGuid;

  SetupMainLoop;
end;

procedure TROAsyncSuperChannelWorker.cbServerWelcomeDone(
  const Sender: IROAbstractTCPConnection);
begin
  fConnection.EndSend;
  SetupMainLoop;
end;

procedure TROAsyncSuperChannelWorker.cbErrorDone(
  const Sender: IROAbstractTCPConnection);
begin
  fConnection.EndSend;
  fConnection.BeginDisconnect(True, nil);
  AsyncDisconnected(Sender);
end;

procedure TROAsyncSuperChannelWorker.AsyncHaveIncompleteData(
  const aSender: IROAbstractTCPConnection);
begin
  fLastData := Now;
end;


procedure TROAsyncSuperChannelWorker.HaveGuid;
begin
  Connected;
end;

procedure TROAsyncSuperChannelWorker.SetupMainLoop;
begin
  SetLength(fWorkBuffer, 6);
  fWorkbuffer[0] := ScCmdNoAck;
  fWorkBuffer[1] := 0;
  fWorkBuffer[2] := 0;
  fWorkBuffer[3] := 0;
  fWorkBuffer[4] := 0;
  fWorkBuffer[5] := ScCmdNoAck_SupportsOptions;
  AsyncWrite(fWorkBuffer);
  setlength(fWorkBuffer, 5);
  fConnection.BeginReceive(@fWorkBuffer[0], 5, cbMainRead);
  AddTimer(self);
end;

procedure TROAsyncSuperChannelWorker.AsyncDisconnected (const Sender: IROAbstractTCPConnection);
begin
  RemoveTimer(self);
  fRunning := False;
  Disconnected(fRunning);
  if fRunning then DoSetup;
end;

procedure TROAsyncSuperChannelWorker.Disconnect;
begin
  fConnection.BeginDisconnect(true, nil);
  AsyncDisconnected(fConnection);
end;



procedure TROAsyncSuperChannelWorker.cbTimer(Sender: TObject);
var
  lData: TByteArray;
begin
  if fIsServer then begin
    if ((Now - fLastData) * (60 * 60 * 24)) > fPingTimeout then begin
      fConnection.BeginDisconnect(true, nil);
      AsyncDisconnected(fConnection);
    end;
  end else begin
    if fServerExpectAck <> 0 then begin
      if ((Now - fLastData) * (60 * 60 * 24)) > fPingTimeout then begin
        fConnection.BeginDisconnect(true, nil);
        AsyncDisconnected(fConnection);
      end;
    end else begin
      fServerExpectAck := Trunc(Now * 24 * 60 * 60 * 7);
      if fServerExpectAck = 0 then fServerExpectAck := 1;
      SetLength(lData, 5);
      lData[0] := ScCmdPing;
      Move(fSErverExpectAck, lData[1], 4);
      AsyncWrite(lData);
    end;
  end;
end;

procedure TROAsyncSuperChannelWorker.cbNoAckReply(const Sender: IROAbstractTCPConnection);
begin
  fConnection.EndReceive;
  if fWorkBuffer[0] = ScCmdNoAck_SupportsOptions then
    SupportsOptions
  else
    SetAckDetails(fStateData, false, fWorkBuffer[0]);
  fConnection.BeginReceive(@fWorkBuffer[0], 5, cbMainRead);
end;
procedure TROAsyncSuperChannelWorker.cbOptionsReply(const Sender: IROAbstractTCPConnection);
begin
  fConnection.EndReceive;
  ProcessOption(fWorkBuffer);
  SetLength(fWorkBuffer, 5);
  fConnection.BeginReceive(@fWorkBuffer[0], 5, cbMainRead);
end;

procedure TROAsyncSuperChannelWorker.cbPackageLength(const Sender: IROAbstractTCPConnection);
var
  lLen: Integer;
begin
  fConnection.EndREceive;
  Move(FWorkBuffer[0], lLen, 4);
  if (lLen < 0) or (lLen > fMaxPackageSize) then begin
    fConnection.BeginDisconnect(true, nil);
    AsyncDisconnected(fConnection);
    exit;
  end;
  SetLength(fWorkBuffer, lLen);
  fConnection.BeginReceive(@fWorkBuffer[0], lLen, cbPackage);
end;

procedure TROAsyncSuperChannelWorker.cbPackage(const Sender: IROAbstractTCPConnection);
var
  lData: TByteArray;
begin
  fConnection.EndReceive;
  try
    IncomingData(fStateData, fWorkBuffer);
    if not fRemoteSkipAck then begin
      SetLength(lData, 5);
      lData[0] := ScCmdAck;
      Move(fStateData, lData[1], 4);
      AsyncWrite(lData);
    end;
  except
    SendError(fStateData, ScCmdNoAck_QueueFull);
  end;
  SetLength(fWorkBuffer, 5);
  fConnection.BeginReceive(@fWorkBuffer[0], 5, cbMainRead);
end;


procedure TROAsyncSuperChannelWorker.cbMainRead(const Sender: IROAbstractTCPConnection);
var
  lTemp: TByteArray;
begin
  fLastData := Now;
  lTemp := nil;
  fConnection.EndReceive;
  case fWorkBuffer[0] of
    ScCmdPong:
      begin
        if Integer((@fWorkBuffer[1])^) = fServerExpectAck then fServerExpectAck := 0;
        fConnection.BeginReceive(@fWorkBuffer[0], 5, cbMainRead);
      end;
    ScCmdPing:
      begin
        fWorkBuffer[0] := ScCmdPong;
        AsyncWrite(fWorkBuffer);
        fWorkBuffer := nil;
        SetLength(fWorkBuffer, 5);
        fConnection.BeginReceive(@fWorkBuffer[0], 5, cbMainRead);
      end;
    ScCmdAck:
      begin
        SetAckDetails(Integer((@fWorkBuffer[1])^), true, 0);
        fConnection.BeginReceive(@fWorkBuffer[0], 5, cbMainRead);
      end;
    ScCmdNoAck:
      begin
        Move(fWorkBuffer[1], fStateData, 4);
        fConnection.BeginReceive(@fWorkBuffer[0], 1, cbNoAckReply);
      end;
    ScCmdOptions:
      begin
        Move(fWorkBuffer[1], fStateData, 4);
        if fStateData > fMaxPackageSize then begin
          fConnection.BeginDisconnect(true, nil);
          AsyncDisconnected(fConnection);
          exit;
        end;
        SetLength(fWorkBuffer, fStateData);
        fConnection.BeginReceive(@fWorkBuffer[0], fStateData, cbOptionsReply);
      end;
    ScCmdPackage:
      begin
        Move(fWorkBuffer[1], fStateData, 4);
        fConnection.BeginReceive(@fWorkBuffer[0], 4, cbPackageLength);
      end;
    else begin
      fConnection.BeginDisconnect(true, nil);
      AsyncDisconnected(fConnection);
    end;
  end;
end;

function TROAsyncSuperChannelWorker.GetDefaultResponse: string;
begin
  Result := 'ROSC:Invalid connection string';
end;

initialization
  fTimerList := TThreadList.Create;
finalization
  fTimer.Free;
  fTimerList.Free;
end.