- Recompilación de RO para poner RemObjects_Core_D10 como paquete de runtime/designtime. git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@3 b6239004-a887-0f4b-9937-50029ccdca16
155 lines
5.0 KiB
ObjectPascal
155 lines
5.0 KiB
ObjectPascal
unit DispatchNotifierService_Impl;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ This unit was automatically generated by the RemObjects SDK after reading }
|
|
{ the RODL file associated with this project . }
|
|
{ }
|
|
{ This is where you are supposed to code the implementation of your objects. }
|
|
{----------------------------------------------------------------------------}
|
|
|
|
interface
|
|
|
|
uses
|
|
{vcl:} Classes, SysUtils,
|
|
{RemObjects:} uROClientIntf, uROTypes, uROServer, uROServerIntf, uROSessions,
|
|
{Generated:} DispatchNotifierLibrary_Intf;
|
|
|
|
{
|
|
This example shows how to customize message dispatching.
|
|
IRODispatchNotifier is a special interface that TROInvoker classes know and look for.
|
|
If your server side object implements it, the IRODispatchNotifier.GetDispatchInfo
|
|
method will be called before the target method is invoked.
|
|
|
|
See TROInvoker.CustomHandleMessage in uROServer.pas
|
|
|
|
The TMyInvoker class shows how to enhance the interception mechanism by providing
|
|
support to a custom interface called ITestInterface.
|
|
|
|
Note how TROClassFactory.Create has been changed to use TMyInvoker.
|
|
}
|
|
|
|
type
|
|
{ ITestInvokeInterface }
|
|
ITestInvokeInterface = interface
|
|
['{CE51FFEF-D552-4712-B86D-166CEC29B737}']
|
|
procedure DoThis;
|
|
procedure DoThat;
|
|
end;
|
|
|
|
{ TDispatchNotifierService }
|
|
TDispatchNotifierService = class(TRORemotable, IDispatchNotifierService, IRODispatchNotifier, ITestInvokeInterface)
|
|
private
|
|
protected
|
|
{ IRODispatchNotifier }
|
|
procedure GetDispatchInfo(const aTransport: IROTransport; const aMessage: IROMessage);
|
|
|
|
{ ITestInvokeInterface }
|
|
procedure DoThis;
|
|
procedure DoThat;
|
|
|
|
{ IDispatchNotifierService methods }
|
|
procedure SendMessage(const aMessage: string);
|
|
end;
|
|
|
|
implementation
|
|
uses
|
|
{Generated:} DispatchNotifierLibrary_Invk, DispatchNotifierServerMain;
|
|
|
|
procedure Create_DispatchNotifierService(out anInstance: IUnknown);
|
|
begin
|
|
anInstance := TDispatchNotifierService.Create;
|
|
end;
|
|
|
|
type
|
|
TMyInvoker = class(TDispatchNotifierService_Invoker)
|
|
protected
|
|
procedure BeforeInvoke(aMethodPtr: TMessageInvokeMethod;
|
|
const anInstance: IInterface;
|
|
const aFactory: IROClassFactory;
|
|
const aMessage: IROMessage;
|
|
const aTransport: IROTransport); override;
|
|
|
|
procedure AfterInvoke(aMethodPtr: TMessageInvokeMethod;
|
|
const anInstance: IInterface;
|
|
const aFactory: IROClassFactory;
|
|
const aMessage: IROMessage;
|
|
const aTransport: IROTransport;
|
|
anException: Exception); override;
|
|
end;
|
|
|
|
{ TMyInvoker }
|
|
|
|
procedure TMyInvoker.AfterInvoke(aMethodPtr: TMessageInvokeMethod;
|
|
const anInstance: IInterface; const aFactory: IROClassFactory;
|
|
const aMessage: IROMessage; const aTransport: IROTransport;
|
|
anException: Exception);
|
|
var
|
|
itestintf: ITestInvokeInterface;
|
|
begin
|
|
inherited;
|
|
|
|
if Supports(anInstance, ITestInvokeInterface, itestintf) then itestintf.DoThis;
|
|
end;
|
|
|
|
procedure TMyInvoker.BeforeInvoke(aMethodPtr: TMessageInvokeMethod;
|
|
const anInstance: IInterface; const aFactory: IROClassFactory;
|
|
const aMessage: IROMessage; const aTransport: IROTransport);
|
|
var
|
|
itestintf: ITestInvokeInterface;
|
|
begin
|
|
inherited;
|
|
|
|
if Supports(anInstance, ITestInvokeInterface, itestintf) then itestintf.DoThat;
|
|
end;
|
|
|
|
{ DispatchNotifierService }
|
|
|
|
procedure TDispatchNotifierService.DoThat;
|
|
begin
|
|
DispatchNotifierServerMainForm.Log('Do that...');
|
|
end;
|
|
|
|
procedure TDispatchNotifierService.DoThis;
|
|
begin
|
|
DispatchNotifierServerMainForm.Log('Do this...');
|
|
end;
|
|
|
|
procedure TDispatchNotifierService.GetDispatchInfo(
|
|
const aTransport: IROTransport; const aMessage: IROMessage);
|
|
var
|
|
tcpinfo: IROTCPTransport;
|
|
textmessage: string;
|
|
streamaccess: IROStreamAccess;
|
|
begin
|
|
if Supports(aTransport, IROTCPtransport, tcpinfo) then DispatchNotifierServerMainForm.Log('Client ' + tcpinfo.GetClientAddress + ' connected!');
|
|
|
|
with aTransport do
|
|
DispatchNotifierServerMainForm.Log('Got a reference to a ' + GetTransportObject.ClassName);
|
|
|
|
with aMessage do begin
|
|
DispatchNotifierServerMainForm.Log('About to invoke ' + InterfaceName + '.' + MessageName);
|
|
|
|
if (MessageName = 'SendMessage') then begin
|
|
aMessage.Read('aMessage', TypeInfo(string), textmessage, []);
|
|
DispatchNotifierServerMainForm.Log('The text message was "' + textmessage + '"');
|
|
|
|
{ New RemObjects 4.0: now you can reset the position of the message stream }
|
|
if Supports(aMessage, IROStreamAccess, streamaccess) then streamaccess.Stream.Position := 0;
|
|
end;
|
|
end;
|
|
|
|
DispatchNotifierServerMainForm.Log('');
|
|
end;
|
|
|
|
procedure TDispatchNotifierService.SendMessage(const aMessage: string);
|
|
begin
|
|
DispatchNotifierServerMainForm.Log('Received message "' + aMessage + '"');
|
|
end;
|
|
|
|
initialization
|
|
TROClassFactory.Create('DispatchNotifierService', Create_DispatchNotifierService, TMyInvoker);
|
|
finalization
|
|
|
|
end.
|
|
|