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.