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

unit uRODLLChannel;

{----------------------------------------------------------------------------}
{ 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, Windows, uROClient, uROClientIntf, uRODLLHelpers;

type
  TDLLProcessMessage = function(aRequest:THandle):THandle;
  TDLLRegisterEventHandler = function(const ClientId: TGuid; const Handler: IRODllEventCallback): Boolean;
  TDLLUnRegisterEventHandler = procedure(const ClientId: TGuid);
//type TDLLProcessMessage = procedure(aRequestStream, aResponseStream : TStream);

const DLLProcessMessageName = 'DLLProcessMessage';
  DLLRegisterEventHandlerName = 'DLLRegisterEventHandler';
  DLLUnRegisterEventHandlerName = 'DLLUnRegisterEventHandler';

type { TRODLLChannel }

     TDLLLoadEvent      = procedure(Sender:TObject ;DLLHandle: THandle) of object;
     TDLLUnloadEvent    = TNotifyEvent;

     TRODLLChannel = class(TROTransportChannel, IROActiveEventChannel, IRODllEventCallback)
     private
       fDLLName: string;
       fDLLHandle : Cardinal;
       fKeepDLLLoaded: boolean;
       fDLLProcessMessage : TDLLProcessMessage;
       FDLLRegisterEventHandler: TDLLRegisterEventHandler;
       fDLLUnregisterEventHandler: TDLLUnRegisterEventHandler;

       fOnDLLLoaded: TDLLLoadEvent;
       fOnDLLUnloaded: TDLLUnloadEvent;
       fSupportsActiveEvents: Boolean;
       fEventReceiver: IROEventReceiver;
       fActiveEvents: Boolean;
       fActiveClientID: TGuid;

     protected
       { IROTransport }
       function GetTransportObject : TObject; override;


       { TROTransportChannel }
       procedure IntDispatch(aRequest, aResponse : TStream); override;

       { Getters and setters }
       function  GetDLLLoaded: Boolean;


       procedure LoadDLL;
       procedure IntSetServerLocator(aServerLocator: TROServerLocator); override;
       procedure BeforeDispatch(aMessage: IROMessage); override;

       procedure UnregisterEventReceiver(aReceiver: IROEventReceiver);
       procedure RegisterEventReceiver(aReceiver: IROEventReceiver);
       procedure ProcessEvent(Data: Pointer; DataSize: Integer);
       function QueryInterface(const IID: TGUID; out Obj): HRESULT; override; stdcall;

     public
       property  DLLHandle: THandle read fDLLHandle;
       property  DLLLoaded: Boolean read GetDLLLoaded;

       property SupportsActiveEvents: Boolean read fSupportsActiveEvents;
       constructor Create(aOwner : TComponent); override;
       destructor Destroy; override;

       procedure UnloadDLL;
       procedure CheckProperties; override;
       {$IFDEF FPC}
       property ActiveClientID: TGuid read fActiveClientID write fActiveClientID;
       {$ENDIF}
     published
       property OnDLLLoaded: TDLLLoadEvent read FOnDLLLoaded write FOnDLLLoaded;
       property OnDLLUnloaded: TDLLUnloadEvent read FOnDLLUnloaded write FOnDLLUnloaded;
       property DLLName : string read fDLLName write fDLLName;
       property KeepDLLLoaded : boolean read fKeepDLLLoaded write fKeepDLLLoaded default true;
       property ActiveEvents : Boolean read fActiveEvents write fActiveEvents default true;
       {$IFNDEF FPC}
       property ActiveClientID: TGuid read fActiveClientID write fActiveClientID;
       {$ENDIF FPC}
       property ServerLocators;
       property DispatchOptions;
     end;

implementation

uses SysUtils, uROClasses;

{ TRODLLChannel }

procedure TRODLLChannel.BeforeDispatch(aMessage: IROMessage);
begin
  inherited;
  LoadDLL;
  if fActiveEvents and fSupportsActiveEvents then begin
    if IsEqualGUID(fActiveClientID, EmptyGUID) then fActiveClientID := NewGuid;
    aMessage.ClientID := ActiveClientID;
  end;
end;

procedure TRODLLChannel.CheckProperties;
begin
  inherited;
  Check(not FileExists(DLLName), 'Cannot locate %s', [DLLName]); // TODO: Move in uRORes
end;

constructor TRODLLChannel.Create(aOwner: TComponent);
begin
  inherited;
  fKeepDLLLoaded := TRUE;
  ThreadSafe := true;
  fActiveEvents := true;
end;

destructor TRODLLChannel.Destroy;
begin
  UnloadDLL;
  inherited;
end;

function TRODLLChannel.GetDLLLoaded: Boolean;
begin
  result := fDLLHandle <> 0;
end;

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

procedure TRODLLChannel.IntDispatch(aRequest, aResponse: TStream);
var lRequestHandle, lResponseHandle:THandle;
begin
  try
    lRequestHandle := StreamToHGlobal(aRequest);
    try
      lResponseHandle := fDLLProcessMessage(lRequestHandle);
      try
        HGlobalToStream(lResponseHandle,aResponse);
      finally
        GlobalFree(lResponseHandle);
      end;
    finally
      GlobalFree(lRequestHandle);
    end;
  finally
    if not KeepDLLLoaded then UnloadDLL;
  end;
end;

procedure TRODLLChannel.IntSetServerLocator(
  aServerLocator: TROServerLocator);
begin
  // Do nothing
end;

procedure TRODLLChannel.LoadDLL;
begin
  CheckProperties;
  if (fDLLHandle>0) then Exit; // Already loaded
  try
    fDLLHandle := LoadLibrary(PChar(DLLName));
    if fDLLHandle = 0 then
      RaiseLastOSError;

    @fDLLProcessMessage := GetProcAddress(fDLLHandle, PChar(DLLProcessMessageName));
    if (@fDLLProcessMessage=NIL) then begin
      fDLLHandle := 0;
      RaiseError('Not a RemObjects DLL', []); // TODO: Move in uRORes
    end;
     @FDLLRegisterEventHandler := GetProcAddress(fDLLHandle, DLLRegisterEventHandlerName);
     @FDLLUnregisterEventHandler:= GetProcAddress(fDllHandle, DLLUnRegisterEventHandlerName);
     fSupportsActiveEvents := assigned(FDLLRegisterEventHandler) and assigned(FDLLUnregisterEventHandler) and
       FDLLRegisterEventHandler(EmptyGUID, nil); // returns false if active events aren't supported by the server
  except
    if (fDLLHandle>0) then begin
      FreeLibrary(fDLLHandle);
      fDLLHandle := 0;
    end;
    @fDLLProcessMessage := NIL;
    raise;
  end;

  //toDO: make proper Trigger functions.
  if (DLLLoaded) and (Assigned(fOnDLLLoaded)) then
    fOnDLLLoaded(Self,fDLLHandle);

end;

procedure TRODLLChannel.ProcessEvent(Data: Pointer; DataSize: Integer);
var
  ms: TMemoryStream;
begin
  if fEventReceiver = nil then exit;
  ms := TMemorySTream.Create;
  try
    ms.Write(Data^, DataSize);
    ms.Position := 0;
    fEventReceiver.Dispatch(ms, nil);
  finally
    ms.Free;
  end;

end;

function TRODLLChannel.QueryInterface(const IID: TGUID; out Obj): HRESULT;
begin
  if IsEqualGUID(IID, IROActiveEventChannel) then begin
    try
      if fDLLHandle = 0 then LoadDLL;
    except
      Result := E_NOINTERFACE;
      exit;
    end;
    if fKeepDLLLoaded and fSupportsActiveEvents and fActiveEvents then
      Result := inherited QueryInterface(IID, obj)
    else
      Result := E_NOINTERFACE;
  end else Result := inherited QueryInterface(IID, obj);
end;

procedure TRODLLChannel.RegisterEventReceiver(aReceiver: IROEventReceiver);
begin
  fEventReceiver := aReceiver;
  LoadDLL;
  if fActiveEvents and fSupportsActiveEvents then begin
    if IsEqualGUID(fActiveClientID, EmptyGUID) then fActiveClientID := NewGuid;
    FDLLRegisterEventHandler(fActiveClientID, Self);
  end;
end;

procedure TRODLLChannel.UnloadDLL;
begin
  if (fDLLHandle<>0) then begin
    FreeLibrary(fDLLHandle);
    fDLLHandle := 0;
    if Assigned(fOnDLLUnloaded) then
      fOnDLLUnloaded(Self);
  end;
end;


procedure TRODLLChannel.UnregisterEventReceiver(
  aReceiver: IROEventReceiver);
begin
  if fActiveEvents and fSupportsActiveEvents and (fDLLHandle <> 0) then begin
    fDLLUnregisterEventHandler(fActiveClientID);
  end;
  fEventReceiver := nil;
end;

initialization
  RegisterTransportChannelClass(TRODLLChannel);

finalization
  UnRegisterTransportChannelClass(TRODLLChannel);

end.