Componentes.Terceros.RemObjects/internal/5.0.23.613/1/RemObjects SDK for Delphi/Source/uRODLLServer.pas

unit uRODLLServer;

{----------------------------------------------------------------------------}
{ 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 Classes, uROClientIntf, uROClient, uROServer, uRODLLHelpers, uROEventRepository;

type { TRODLLServer }
     TRODLLServer = class(TROServer, IROTransport)
     private
       fActiveEventRepository: TROEventRepository;
     protected
       { IROTransport }
       function GetTransportObject : TObject;

       procedure IntSetActive(const Value: boolean); override;
       function IntGetActive : boolean; override;

     public
       property ActiveEventRepository: TROEventRepository read fActiveEventRepository write fActiveEventRepository;
     end;

{ Call this to add a dispatcher to the DLLServer }
procedure RegisterMessage(aMessage : TROMessage);

{ Use this singleton if you need to hook to the server instance }
function DLLServer : TRODLLServer;

{ EXPORTED (for external user only): Main DLL entry point for message processing }
function DLLProcessMessage(aRequest:THandle):THandle;
function DLLRegisterEventHandler(const ClientId: TGuid; const Handler: IRODllEventCallback): Boolean;
procedure DLLUnRegisterEventHandler(const ClientId: TGuid);

implementation

uses Windows, uRODLLChannel, uROServerIntf;

var fDLLServer: TRODLLServer;

type
  TCallbackWrapper = class(TInterfacedObject, IROActiveEventServer)
  private
    FDll: IRODllEventCallback;
  public
    procedure DispatchEvent(anEventDataItem: TROEventData;
      aSessionReference: TGUID; aSender: TObject);
    procedure EventsRegistered(aSender: TObject; aClient: TGUID);
    constructor Create(aDll: IRODllEventCallback);
  end;

procedure RegisterMessage(aMessage : TROMessage);
begin
  with TROMessageDispatcher(fDLLServer.Dispatchers.Add) do begin
    Message := aMessage;
  end;
end;

function DLLServer : TRODLLServer;
begin
  result := fDLLServer;
end;

{procedure DLLProcessMessage(aRequestStream,
                            aResponseStream : TStream);
var transport : IROTransport;
begin
  fDLLServer.QueryInterface(IROTransport, transport);
  fDLLServer.DispatchMessage(transport, aRequestStream, aResponseStream);
  //fDLLServer.DispatchMessage((fDLLServer as IROTransport), aRequestStream, aResponseStream);
end;}


{ EXPORTED (for external user only): Main DLL entry point for message processing }

function DLLProcessMessage(aRequest:THandle):THandle;
var lTransport : IROTransport;
var lRequestStream, lResponseStream:TMemoryStream;
begin
  lRequestStream := TMemoryStream.Create();
  try
   lResponseStream := TMemoryStream.Create();
    try

      HGlobalToStream(aRequest,lRequestStream);
      fDLLServer.QueryInterface(IROTransport, lTransport);
      fDLLServer.DispatchMessage(lTransport, lRequestStream, lResponseStream);
      Result := StreamToHGlobal(lResponseStream);

    finally
      lResponseStream.Free();
    end;
  finally
    lRequestStream.Free();
  end;
end;

exports DLLProcessMessage name DLLProcessMessageName,
  DLLRegisterEventHandler name DLLRegisterEventHandlerName,
  DLLUnRegisterEventHandler name DLLUnRegisterEventHandlerName;


{ TRODLLServer }

function TRODLLServer.GetTransportObject: TObject;
begin
  result := Self;
end;

function TRODLLServer.IntGetActive: boolean;
begin
  result := TRUE;
end;

procedure TRODLLServer.IntSetActive(const Value: boolean);
begin
  // not required in this case. Always active
end;

function DLLRegisterEventHandler(const ClientId: TGuid; const Handler: IRODllEventCallback): Boolean;
begin
  if fDLLServer.ActiveEventRepository = nil then begin
    result := false;
    exit;
  end;
  if Handler <> nil then
    fDLLServer.ActiveEventRepository.AddSession(ClientID, TCallbackWrapper.Create(Handler));
  Result := TRue;
end;

procedure DLLUnRegisterEventHandler(const ClientId: TGuid);
begin
  if fDLLServer.ActiveEventRepository = nil then begin
    exit;
  end;
  fDLLServer.ActiveEventRepository.RemoveSession(ClientId);
end;



{ TCallbackWrapper }

constructor TCallbackWrapper.Create(aDll: IRODllEventCallback);
begin
  inherited Create;
  FDll := aDll;
end;

procedure TCallbackWrapper.DispatchEvent(anEventDataItem: TROEventData;
  aSessionReference: TGUID; aSender: TObject);
begin
  FDll.ProcessEvent(TMemoryStream(anEventDataItem.Data).Memory, TMemoryStream(anEventDataItem.Data).Size);
end;

procedure TCallbackWrapper.EventsRegistered(aSender: TObject;
  aClient: TGUID);
begin
 // do nothing.
end;

initialization
  fDLLServer := TRODLLServer.Create(NIL);

finalization
  fDLLServer.Free;

end.