unit uROBaseSuperHttpChannel;

{----------------------------------------------------------------------------}
{ RemObjects SDK Library - Core Components                                   }
{                                                                            }
{ 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
  {$IFDEF MSWINDOWS}Windows,{$ENDIF}
  Classes, SysUtils, uROClient, uROClientIntf, uROAsync, uROClasses, SyncObjs,
  {$IFDEF RemObjects_UseEncryption} uRoEncryption, {$ENDIF}uROThreadPool;

type
  TDynByteArray = array of byte;
  TROHTTPWaitingRequest = class
  private
    fEvent: TROEvent;
    fFreeEvent: Boolean;
    fId: Integer;
    fResultData: TDynByteArray;
    fResultErrorCode: Integer;
  public
    property Id: Integer read fId;
    property Event: TROEvent read fEvent;
    property Resultdata: TDynByteArray 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;
  EROSuperHTTPChannelException = class(EROException);
  TROOnInvalidClientIdHandler = procedure(Sender: TObject; var aReconnect: Boolean) of object;
  TROBaseSuperHTTPChannel = class(TROTransportChannel, IROTransport,
    IROActiveEventChannel, IROMultiThreadAwareChannel,
    IROAsyncTransportChannel, IROActiveAsyncTransportChannel, IROTransportChannelEx, IROHTTPTransport)
  private
    fConnectWait: TROEvent;
    fActive, fConnected: Boolean;
    fSessionId, fConnectionId: TGuid;
    fRemoteMaxPackageSize,
    fMaxPackageSize: Integer;
    fWaitingRequest: TThreadList;
    fPackageCounter: Integer;
    fOwnsThreadPool: Boolean;
    fEventThreadPool: TROThreadPool;
    fDispatchLock: TCriticalSection;
    fWaitingThread: TThread;
    fEventReceiver: IROEventReceiver;
    fRequestTimeout: Integer;
    fConnectTimeout: Integer;
    fHTTPRequestTimeout: Integer;
    fOnInvalidClientID: TROOnInvalidClientIdHandler;
    procedure SetActive(const Value: Boolean);
    procedure ProcessEvent(aId: Integer; aData: TDynByteArray);
    procedure SetEventThreadPool(const Value: TROThreadPool);
    function GetEventThreadPool: TROThreadPool;
  protected
  { IROTransport }
    function GetTransportObject : TObject; override;
  { IROHTTPTransport }
    function GetClientAddress : string; virtual; abstract;
    procedure SetHeaders(const aName, aValue : string); virtual; abstract;
    function GetHeaders(const aName : string) : string; virtual; abstract;
    function GetContentType : string; virtual; abstract;
    procedure SetContentType(const aValue : string); virtual; abstract;
    function GetUserAgent : string; virtual; abstract;
    procedure SetUserAgent(const aValue : string); virtual; abstract;
    function GetTargetURL : string; virtual; abstract;
    procedure SetTargetURL(const aValue : string); virtual; abstract;
    procedure SetPathInfo (const aValue : string); virtual; abstract;
    function GetPathInfo : string; virtual; abstract;
    function GetQueryString : string; virtual; abstract;
    function GetLocation : string; virtual; abstract;
    function GetQueryParameter(const aName: string): string; virtual; abstract;
  protected
    procedure IntDispatch(aRequest: TStream; aResponse: TStream); override;
    function CheckStatus(const iMessageID: String): Boolean;
    procedure RetrieveResponse(const iMessageID: String;
      aResponse: TStream);
    procedure BeforeDispatch(aMessage: IROMessage); override;
    procedure RegisterEventReceiver(aReceiver: IROEventReceiver);
    procedure UnregisterEventReceiver(aReceiver: IROEventReceiver);
    function InvokeRequest(aRequest:TStream; iGetResponse:boolean=true):string; overload;
    function InvokeRequest(aRequest:TStream; aGetResponse:boolean=true; aEvent: TROEvent=nil):string; overload;

    procedure CancelRequest(aWaitingThread: Boolean); virtual; abstract;
    procedure DispatchHTTPRequest(aWaitingThread: Boolean; aRequest: TDynByteArray; out aResponse: TDynByteArray); virtual; abstract;

  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
    procedure Assign(aSource : TPersistent); override;
    property EventThreadPool :TROThreadPool read GetEventThreadPool write SetEventThreadPool;
    property ConnectionId: TGUID read fConnectionId write fConnectionId;
    {$IFDEF FPC}
    property SessionId: TGuid read fSessionId write fSessionId;
    {$ENDIF FPC}
    property Connected: Boolean read fConnected;
  published
    property OnInvalidCientID: TROOnInvalidClientIdHandler read fOnInvalidClientID write fOnInvalidClientID;
    property OnInvalidClientID: TROOnInvalidClientIdHandler read fOnInvalidClientID write fOnInvalidClientID;
    // from TROBaseSuperHTTPChannel
    {$IFNDEF FPC}
    property SessionId: TGuid read fSessionId write fSessionId;
    {$ENDIF}
    property Active: Boolean read fActive write SetActive;
    property MaxPackageSize: Integer read fMaxPackageSize write fMaxPackageSize default 10*1024 * 1024;
    property RequestTimeout: Integer read fRequestTimeout write fRequestTimeout default 60000;
    property ConnectTimeout: Integer read fConnectTimeout write fConnectTimeout default 10000;
    property HTTPRequestTimeout: Integer read fHTTPRequestTimeout write fHTTPRequestTimeout default 10000;
  published
    // from TROTransportChannel
    property DispatchOptions;
    //property OnAfterProbingServer;
    //property OnAfterProbingServers;
    //property OnBeforeProbingServer;
    //property OnBeforeProbingServers;
    //property OnLoginNeeded;
    //property OnProgress;
    //property OnReceiveStream;
    //property OnSendStream;
    property OnServerLocatorAssignment;
    //property ProbeFrequency;
    //property ProbeServers;
    property ServerLocators;
    //property SynchronizedProbing;
  end;

const
  ShHello = 0;
  ShGoodbye = 1;
  ShPackage = 2;
  ShError = 3;
  ShError_InvalidClientId = 0;
  ShError_QueueFull = 1;
  ShError_UnknownOption = 2;
  ShOptions = 4;
  ShAsyncWait = 5;
implementation

// uses Math;

type
  TROSuperHTTPThread = class(TROInitializedThread)
  private
    fOwner: TROBaseSuperHTTPChannel;
  public
    constructor Create(aOwner: TROBaseSuperHTTPChannel);
    procedure Execute; override;
  end;

{ TROHTTPWaitingRequest }

constructor TROHTTPWaitingRequest.Create(Id: Integer);
begin
  fId := Id;
  fEvent := TROEvent.Create(nil, true, false, '');
  fFreeEvent := true;
end;

constructor TROHTTPWaitingRequest.Create(Id: Integer; Ev: TROEvent);
begin
  fEvent := Ev;
  if Fevent = nil then begin
    fEvent := TROEvent.Create(nil, true, false, '');
    fFreeEvent := true;
  end;
  fId := Id;
end;

destructor TROHTTPWaitingRequest.Destroy;
begin
  if fFreeEvent then fEvent.Free;
  inherited;
end;

{ TROBaseSuperHTTPChannel }

procedure TROBaseSuperHTTPChannel.Assign(aSource: TPersistent);
var
  lSource: TROBaseSuperHTTPChannel;
begin
  inherited;
  if aSource is TROBaseSuperHTTPChannel then begin
    lSource := TROBaseSuperHTTPChannel(aSource);
    Active := False;
    ConnectTimeout := lSource.ConnectTimeout;
    HTTPRequestTimeout := lSource.HTTPRequestTimeout;
    MaxPackageSize := lSource.MaxPackageSize;
    OnInvalidClientID := lSource.OnInvalidClientID;
    RequestTimeout := lSource.RequestTimeout;
    SessionId := lSource.SessionId;
    Active := lSource.Active;
  end;
end;

procedure TROBaseSuperHTTPChannel.BeforeDispatch(aMessage: IROMessage);
begin
  if not fConnected then begin
    Active := true;
    if (fConnectWait.WaitFor(fConnectTimeout) <> wrSignaled) or not fConnected then begin
      Active:=False;
      raise EROSuperHTTPChannelException.Create('Timeout connecting');
    end;  
  end;
  if aMessage <> nil then 
    aMessage.ClientID := fSessionId;
  inherited;
end;

constructor TROBaseSuperHTTPChannel.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  fMaxPackageSize := 10 * 1024 * 1024;
  fRequestTimeout := 60000;
  fConnectTimeout := 10000;
  fHTTPRequestTimeout := 10000;
  fConnectWait := TROEvent.Create(nil, true, false, '');
  fWaitingRequest := TThreadList.Create;
  ThreadSafe := true;
  fDispatchLock := TCriticalSection.Create;
end;

destructor TROBaseSuperHTTPChannel.Destroy;
var
  i: Integer;
  lList: TList;
begin
  if fOwnsThreadPool then fEventThreadPool.Free;
  Active := False;
  fConnectWait.Free;
  lList := fWaitingRequest.LockList;
  try
    for i := 0 to lList.Count -1 do begin
      TROHTTPWaitingRequest(lList[i]).Free;
    end;
  finally
    fWaitingRequest.UnlockList;
  end;
  fWaitingRequest.Free;
  fDispatchLock.Free;
  inherited;
end;

procedure TROBaseSuperHTTPChannel.IntDispatch(aRequest,
  aResponse: TStream);
var
  lRequest, lResponse: TDynByteArray;
  lList:TList;
  lId: Integer;
  lReq: TROHTTPWaitingRequest;
begin
  if aRequest.Size > fRemoteMaxPackageSize then raise EROSuperHTTPChannelException.Create('Package too large');
  SetLength(lRequest, 16 + 1 + 4 + aRequest.Size);
  aRequest.Position := 0;

  Move(fConnectionId, lRequest[0], 16);
  lRequest[16] := ShPackage;
  aRequest.Read(lRequest[21], aRequest.Size);
  lList := fWaitingRequest.LockList;
  try
    inc(fPackageCounter);
    if fPackageCounter < 0 then fPackageCounter := 1;
    lId := fPackageCounter;
    lReq := TROHTTPWaitingRequest.Create(lId);
    lList.Add(lReq);
  finally
    fWaitingRequest.UnlockList;
  end;
  try
    lRequest[17] := lId;
    lRequest[18] := lId shr 8;
    lRequest[19] := lId shr 16;
    lRequest[20] := lId shr 24;
    fDispatchLock.Enter;
    try
      DispatchHTTPRequest(false, lRequest, lResponse);
      if Length(lResponse) >= 6 then begin
        if lResponse[0] = shError then begin
          case lResponse[5] of
            ShError_InvalidClientId: raise EROSuperHTTPChannelException.Create('Invalid client id');
            ShError_QueueFull: raise EROSuperHTTPChannelException.Create('Queue full');
          else
            raise EROSuperHTTPChannelException.Create('Unknown error');
          end;
        end;
      end;
    finally
      fDispatchLock.Release;
    end;
    if lReq.Event.WaitFor(fRequestTimeout) <> wrSignaled then
      raise EROSuperHTTPChannelException.Create('Timeout');

    if Length(lReq.fResultData) <> 0 then begin
      aResponse.Write(lReq.fResultData[0], length(lReq.fResultData))
    end else begin
      case lReq.fResultErrorCode of
        ShError_InvalidClientId: raise EROSuperHTTPChannelException.Create('Invalid client id');
        ShError_QueueFull: raise EROSuperHTTPChannelException.Create('Queue full');
      else
        raise EROSuperHTTPChannelException.Create('Unknown error');
      end;
    end;
  finally
    lList := fWaitingRequest.LockList;
    lList.Remove(lReq);
    fWaitingRequest.UnlockList;
    lReq.Free;
  end;
end;

procedure TROBaseSuperHTTPChannel.SetActive(const Value: Boolean);
begin
  if fActive = Value then exit;
  fActive := Value;
  if fActive then begin
    GetEventThreadPool;
    fConnectWait.ResetEvent;
    if fWaitingThread <> nil then fWaitingThread.Free;
    fWaitingThread := TROSuperHTTPThread.Create(self);
  end else begin
    fWaitingThread.Terminate;
    CancelRequest(true);
    fWaitingThread.Free;
    fwaitingThread := nil;
  end;
end;

procedure TROBaseSuperHTTPChannel.SetEventThreadPool(
  const Value: TROThreadPool);
begin
  if fOwnsThreadPool and (fEventThreadPool <> nil) then fEventThreadPool.Free;
  fEventThreadPool := Value;
  fOwnsThreadPool := false;
end;

procedure TROBaseSuperHTTPChannel.RegisterEventReceiver(
  aReceiver: IROEventReceiver);
begin
  fEventReceiver := aReceiver;
end;

procedure TROBaseSuperHTTPChannel.UnregisterEventReceiver(
  aReceiver: IROEventReceiver);
begin
  if fEventReceiver = aReceiver then fEventReceiver := nil;
end;


function FindWaitingRequest(aList: TList; aId: Integer): TROHTTPWaitingRequest;
var
  i: Integer;
begin
  for i := aList.count -1 downto 0 do begin
    result := TROHTTPWaitingRequest(aList[i]);
    if result.fId = aId then exit;
  end;
  result := nil;
end;

function TROBaseSuperHTTPChannel.CheckStatus(
  const iMessageID: String): Boolean;
var
  lList: TList;
  wr: TROHTTPWaitingRequest;
begin
  lList := fWaitingRequest.LockList;
  try
    wr := FindWaitingRequest(lList, StrToInt(iMessageId));
    if wr = nil then
      result := true
    else
      result := (Length(wr.Resultdata) <> 0) or (wr.ResultErrorCode <> 0);
  finally
    fWaitingRequest.UnlockList;
  end;
end;

procedure TROBaseSuperHTTPChannel.RetrieveResponse(
  const iMessageID: String; aResponse: TStream);

  procedure WriteDataToStream(wr: TROHTTPWaitingRequest;AStream: TStream);
  begin
    AStream.Write(wr.fresultData[0], Length(wr.fresultData));
    AStream.Position := 0;
  end;

var
  lList: TList;
  wr: TROHTTPWaitingRequest;
begin
  lList := fWaitingRequest.LockList;
  try
    wr := FindWaitingRequest(lList, StrToInt(iMessageId));
  finally
    fWaitingRequest.UnlockList;
  end;
  if wr = nil then raise EROSuperHTTPChannelException.Create('Invalid request id');
  try
    if wr.fEvent.WaitFor(fRequestTimeout) <> wrSignaled then raise EROSuperHTTPChannelException.Create('Timeout');
    if Length(wr.fResultData) > 0 then begin
      WriteDataToStream(wr,aResponse);
      aResponse.Position := 0;
      {$IFDEF RemObjects_UseEncryption}
      if Encryption.EncryptionMethod <> tetNone then DoDecryption2(aResponse);
      {$ENDIF}
    end else begin
      case wr.fResultErrorCode of
        ShError_InvalidClientId: raise EROSuperHTTPChannelException.Create('Invalid client id');
        ShError_QueueFull: raise EROSuperHTTPChannelException.Create('Queue full');
      else
        raise EROSuperHTTPChannelException.Create('Unknown error');
      end;
    end;
  finally
    lList := fWaitingRequest.LockList;
    try
      lList.Remove(wr);
      wr.Free;
    finally
      fWaitingRequest.UnlockList;
    end;
  end;

end;

function TROBaseSuperHTTPChannel.InvokeRequest(aRequest: TStream;
  iGetResponse: boolean): string;
begin
  result := InvokeRequest(aRequest, iGetResponse, nil);
end;

function TROBaseSuperHTTPChannel.InvokeRequest(aRequest: TStream;
  aGetResponse: boolean; aEvent: TROEvent): string;
var
  lRequest, lResponse: TDynByteArray;
  lList:TList;
  lId: Integer;
  lReq: TROHTTPWaitingRequest;
begin
  try
    {$IFDEF RemObjects_UseEncryption}
    if Encryption.EncryptionMethod <> tetNone then DoEncryption2(aRequest);
    {$ENDIF}
    if aRequest.Size > fRemoteMaxPackageSize then raise EROSuperHTTPChannelException.Create('Package too large');
    SetLength(lRequest, 16 + 1 + 4 + aRequest.Size);
    {$IFDEF FPC}
    if aEvent = nil then aRequest.Position := 0 else // for preventing warning in FPC
    {$ENDIF}
    aRequest.Position := 0;

    Move(fConnectionId, lRequest[0], 16);
    lRequest[16] := ShPackage;
    aRequest.Read(lRequest[21], aRequest.Size);
    lList := fWaitingRequest.LockList;
    try
      inc(fPackageCounter);
      if fPackageCounter < 0 then fPackageCounter := 1;
      lId := fPackageCounter;
      if aGetResponse then begin
        lReq := TROHTTPWaitingRequest.Create(lId);
        lList.Add(lReq);
      end else
        lReq := nil;
    finally
      fWaitingRequest.UnlockList;
    end;
    try
      lRequest[17] := lId;
      lRequest[18] := lId shr 8;
      lRequest[19] := lId shr 16;
      lRequest[20] := lId shr 24;
      fDispatchLock.Enter;
      try
        DispatchHTTPRequest(false, lRequest, lResponse);
        if Length(lResponse) >= 6 then begin
          if lResponse[0] = shError then begin
            case lResponse[5] of
              ShError_InvalidClientId: raise EROSuperHTTPChannelException.Create('Invalid client id');
              ShError_QueueFull: raise EROSuperHTTPChannelException.Create('Queue full');
            else
              raise EROSuperHTTPChannelException.Create('Unknown error');
            end;
          end;
        end;
      finally
        fDispatchLock.Release;
      end;
      result := inttostr(lId);
    except
      lList := fWaitingRequest.LockList;
      lList.Remove(lReq);
      fWaitingRequest.UnlockList;
      lReq.Free;
      raise;
    end;
  finally
    aRequest.Free;
  end;
end;

type
  TROSuperEventCallback = class(TInterfacedObject, IROThreadPoolCallback)
  private
    fData: TDynByteArray;
    fOwner: TROBaseSuperHTTPChannel;
  public
    procedure Callback(Caller: TROThreadPool; aThread: TThread);
  end;

procedure TROBaseSuperHTTPChannel.ProcessEvent(aId: Integer;
  aData: TDynByteArray);
var
  lCb: TROSuperEventCallback;
begin
  {$IFDEF FPC}
  if aID = 0 then lCb := TROSuperEventCallback.Create else // for preventing warning in FPC
  {$ENDIF}
  lCb := TROSuperEventCallback.Create;
  lCb.fOwner := self;
  lCb.fData := aData;
  fEventThreadPool.QueueItem(lCb);
end;

function TROBaseSuperHTTPChannel.GetEventThreadPool: TROThreadPool;
begin
  if fEventThreadPool = nil then begin
    fOwnsThreadPool := true;
    fEventThreadPool := TROThreadPool.Create(nil);
  end;
  Result := fEventThreadPool;
end;

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

{ TROSuperHTTPThread }

constructor TROSuperHTTPThread.Create(aOwner: TROBaseSuperHTTPChannel);
begin
  {$IFNDEF FPC}
  inherited Create(False);
  {$ELSE}
  inherited Create(True);
  {$ENDIF}
  fOwner := aOwner;
  {$IFDEF FPC}
  Resume;
  {$ENDIF}
end;

procedure TROSuperHTTPThread.Execute;
var
  lRequest,
  lTmpData,
  lResponse: TDynByteArray;
  lList: TList;
  lPackageId: Integer;
  wr: TROHTTPWaitingRequest;
  lReconnect: Boolean;
begin
  lReconnect := True;
  while lReconnect do begin
    lReconnect := false;
    try
      if IsEqualGuid(fOwner.fConnectionId, Emptyguid) then fOwner.fConnectionId := NewGuid;
      SetLength(lRequest, 16 + 1 +8 + 4 + 16);
      Move(fOwner.fConnectionId, lRequest[0], 16);
      lRequest[16] := shHello;
      lRequest[17] := ord('R');
      lRequest[18] := ord('O');
      lRequest[19] := ord('S');
      lRequest[20] := ord('H');
      lRequest[21] := ord('1');
      lRequest[22] := ord('0');
      lRequest[23] := ord('0');
      lRequest[24] := ord('0');
      lRequest[25] := fOwner.fMaxPackageSize;
      lRequest[26] := fOwner.fMaxPackageSize shr 8;
      lRequest[27] := fOwner.fMaxPackageSize shr 16;
      lRequest[28] := fOwner.fMaxPackageSize shr 16;
      Move(fOwner.fSessionId, lRequest[29], 16);
      fOwner.fDispatchLock.Enter;
      try
        fOwner.DispatchHTTPRequest(false, lRequest, lResponse);
      finally
        fOwner.fDispatchLock.Leave;
      end;
      if Length(lResponse) <> (16 + 8 + 4) then
        raise EROSuperHTTPChannelException.Create('Invalid response from server for connection initiation command');

      if (lResponse[0] <> ord('R')) or (lResponse[1] <> ord('O')) or (lResponse[2] <> ord('S')) or (lResponse[3] <> ord('H')) then
        raise EROSuperHTTPChannelException.Create('Invalid response from server for connection initiation command');
      fOwner.fRemoteMaxPackageSize := Integer(lResponse[8]) or (Integer(lResponse[9]) shl 8)
       or (Integer(lResponse[10]) shl 16) or (Integer(lResponse[11]) shl 24);
      move(lResponse[12], fOwner.fSessionId, 16);
      fOwner.fConnected := true;
      fOwner.fConnectWait.SetEvent;
      SetLength(lRequest, 17);
      move(fOwner.fConnectionId, lRequest[0], 16);
      lRequest[16] := ShAsyncWait;
      while not Terminated do begin
        try
          fOwner.DispatchHTTPRequest(true, lRequest, lResponse);
        except
          Continue;
        end;
        if Length(lResponse) <> 0 then begin
          case lResponse[0] of
            ShError: begin
              if Length(lResponse) < 5 then continue;
              if lResponse[5] = ShError_InvalidClientId then begin // means we've got disconnected
                if assigned(fOwner.fOnInvalidClientID) then
                  fOwner.fOnInvalidClientID(fOwner, lReconnect);
                break;
              end;
              lPackageId := Integer(lResponse[1]) or (Integer(lResponse[2]) shl 8)
              or (Integer(lResponse[3]) shl 16) or (Integer(lResponse[4]) shl 24);
              lList := fOwner.fWaitingRequest.LockList;
              try
                wr := FindWaitingRequest(lList, lPackageId);
                if wr <> nil then begin
                 wr.fResultErrorCode := lResponse[4];
                 wr.fEvent.SetEvent;
                end;
              finally
                fOwner.fWaitingRequest.UnlockList;
              end;
            end;
            shPackage: begin
              if Length(lResponse) < 5 then continue;
              lPackageId := Integer(lResponse[1]) or (Integer(lResponse[2]) shl 8)
              or (Integer(lResponse[3]) shl 16) or (Integer(lResponse[4]) shl 24);
              setLength(lTmpData, Length(lResponse) -5);
              Move(lResponse[5], lTmpData[0], Length(lTmpData));
              if lPackageId < 0 then
                fOwner.ProcessEvent(lPackageId, lTmpData)
              else begin
                lList := fOwner.fWaitingRequest.LockList;
                try
                  wr := FindWaitingRequest(lList, lPackageId);
                  if wr <> nil then begin
                   wr.fResultData := lTmpData;
                   wr.fEvent.SetEvent;
                  end;
                finally
                  fOwner.fWaitingRequest.UnlockList;
                end;
              end;
            end;
          end;
        end;
      end;
      lRequest[16] := shGoodbye;
      fOwner.fDispatchLock.Enter;
      try
        fOwner.DispatchHTTPRequest(false, lRequest, lResponse);
      finally
        fOwner.fDispatchLock.Leave;
        if not lReconnect then fOwner.fConnected :=False;
      end;
    except
      // cannot let exceptions escape here
    end;
  end;
end;

{ TROSuperEventCallback }

procedure TROSuperEventCallback.Callback(Caller: TROThreadPool;
  aThread: TThread);
var
  lData: TMemoryStream;
begin
  if fOwner.fEventReceiver <> nil then begin
    lData := TMemoryStream.Create;
    try
      lData.Write(fData[0], length(fData));
      fOwner.DecodeEventStream(lData);
      {$IFDEF FPC}
      if Caller <> nil then lData.Position := 0 else // for preventing warning in FPC
      {$ENDIF}
      lData.Position := 0;
      fOwner.fEventReceiver.Dispatch(lData, aThread);
    finally
       lData.Free;
    end;
  end;
end;

end.