| 1 | { **************************************************************
 | 
|---|
| 2 |         Package: XWB - Kernel RPCBroker
 | 
|---|
| 3 |         Date Created: Sept 18, 1997 (Version 1.1)
 | 
|---|
| 4 |         Site Name: Oakland, OI Field Office, Dept of Veteran Affairs
 | 
|---|
| 5 |         Developers: Kevin Meldrum, Travis Hilton, Joel Ivey
 | 
|---|
| 6 |         Description: Provides Event Sink for 
 | 
|---|
| 7 |                      RPCSharedBrokerSessionMgr1.
 | 
|---|
| 8 |         Current Release: Version 1.1 Patch 40 (January 7, 2005))
 | 
|---|
| 9 | *************************************************************** }
 | 
|---|
| 10 | 
 | 
|---|
| 11 | unit SharedRPCBrokerSink;
 | 
|---|
| 12 | 
 | 
|---|
| 13 | interface
 | 
|---|
| 14 | uses
 | 
|---|
| 15 |   ComObj, SharedRPCBroker;
 | 
|---|
| 16 | 
 | 
|---|
| 17 | type
 | 
|---|
| 18 |   TSharedRPCBrokerSink = class(TInterfacedObject, IUnknown, IDispatch)
 | 
|---|
| 19 |   private
 | 
|---|
| 20 |     FBroker: TSharedRPCBroker;
 | 
|---|
| 21 |   public
 | 
|---|
| 22 |     //IUnknown
 | 
|---|
| 23 |     //Method resolution clause to allow QueryInterface to be redefined
 | 
|---|
| 24 |     function IUnknown.QueryInterface = QueryInterface;
 | 
|---|
| 25 |     function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
 | 
|---|
| 26 |     //IDispatch
 | 
|---|
| 27 |     function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
 | 
|---|
| 28 |     function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
 | 
|---|
| 29 |     function GetIDsOfNames(const IID: TGUID; Names: Pointer;
 | 
|---|
| 30 |       NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
 | 
|---|
| 31 |     function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
 | 
|---|
| 32 |       Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
 | 
|---|
| 33 |   public
 | 
|---|
| 34 |     property Broker: TSharedRPCBroker read FBroker write FBroker;
 | 
|---|
| 35 |   end;
 | 
|---|
| 36 | 
 | 
|---|
| 37 | implementation
 | 
|---|
| 38 | 
 | 
|---|
| 39 | uses
 | 
|---|
| 40 |   Windows, ActiveX, RPCSharedBrokerSessionMgr1_TLB_SRB;
 | 
|---|
| 41 | 
 | 
|---|
| 42 | function TSharedRPCBrokerSink.QueryInterface(const IID: TGUID; out Obj): HResult;
 | 
|---|
| 43 | begin
 | 
|---|
| 44 |   Result := E_NOINTERFACE;
 | 
|---|
| 45 |   //If events interface requested, return IDispatch
 | 
|---|
| 46 |   if IsEqualIID(IID, DIID_ISharedBrokerEvents) then
 | 
|---|
| 47 |   begin
 | 
|---|
| 48 |     if GetInterface(IDispatch, Obj) then
 | 
|---|
| 49 |       Result := S_OK
 | 
|---|
| 50 |   end
 | 
|---|
| 51 |   else
 | 
|---|
| 52 |     //Handle other interface requests normally
 | 
|---|
| 53 | 
 | 
|---|
| 54 |     if GetInterface(IID, Obj) then
 | 
|---|
| 55 |       Result := S_OK
 | 
|---|
| 56 | end;
 | 
|---|
| 57 | 
 | 
|---|
| 58 | function TSharedRPCBrokerSink.GetIDsOfNames(const IID: TGUID; Names: Pointer;
 | 
|---|
| 59 |   NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
 | 
|---|
| 60 | begin
 | 
|---|
| 61 |   Result := E_NOTIMPL
 | 
|---|
| 62 | end;
 | 
|---|
| 63 | 
 | 
|---|
| 64 | function TSharedRPCBrokerSink.GetTypeInfo(Index, LocaleID: Integer;
 | 
|---|
| 65 |   out TypeInfo): HResult;
 | 
|---|
| 66 | begin
 | 
|---|
| 67 |   Result := E_NOTIMPL
 | 
|---|
| 68 | end;
 | 
|---|
| 69 | 
 | 
|---|
| 70 | function TSharedRPCBrokerSink.GetTypeInfoCount(out Count: Integer): HResult;
 | 
|---|
| 71 | begin
 | 
|---|
| 72 |   Count := 0;
 | 
|---|
| 73 |   Result := S_OK
 | 
|---|
| 74 | end;
 | 
|---|
| 75 | 
 | 
|---|
| 76 | function TSharedRPCBrokerSink.Invoke(DispID: Integer; const IID: TGUID;
 | 
|---|
| 77 |   LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
 | 
|---|
| 78 |   ArgErr: Pointer): HResult;
 | 
|---|
| 79 | var
 | 
|---|
| 80 |   Args: PVariantArgList;
 | 
|---|
| 81 |   ASharedBroker: ISharedBroker;
 | 
|---|
| 82 |   ConnectionIndex: Integer;
 | 
|---|
| 83 |   ErrorText: WideString;
 | 
|---|
| 84 | //  UniqueClientID: Integer;
 | 
|---|
| 85 | //  BrokerConnectionType: ISharedBrokerConnection;
 | 
|---|
| 86 | begin
 | 
|---|
| 87 |   Result := S_OK;
 | 
|---|
| 88 |   ConnectionIndex := 0;
 | 
|---|
| 89 |   // UniqueClientID := -1;
 | 
|---|
| 90 | 
 | 
|---|
| 91 |   //This is called to trigger an event interface method, if implemented
 | 
|---|
| 92 |   //We need to check which one it is (by DispID) and do something sensible if we
 | 
|---|
| 93 |   //support the triggered event
 | 
|---|
| 94 | 
 | 
|---|
| 95 |   //Both event methods happen to have the same parameters,
 | 
|---|
| 96 |   //so we can extract them just once to save duplication
 | 
|---|
| 97 |   Args := TDispParams(Params).rgvarg;
 | 
|---|
| 98 |   //Params are in reverse order:
 | 
|---|
| 99 |   //Last parameter is at pos. 0
 | 
|---|
| 100 |   //First parameter is at pos. cArgs - 1
 | 
|---|
| 101 |   If DispID = 1 then
 | 
|---|
| 102 |     ASharedBroker := IUnknown(OleVariant(Args^[0])) as ISharedBroker;
 | 
|---|
| 103 |   If DispID = 3 then
 | 
|---|
| 104 |   begin
 | 
|---|
| 105 |     // UniqueClientID := OleVariant(Args^[1]);
 | 
|---|
| 106 |     // BrokerConnectionType := OleVariant(Args^[0]);
 | 
|---|
| 107 |   end;
 | 
|---|
| 108 |   if DispID = 4 then
 | 
|---|
| 109 |   begin
 | 
|---|
| 110 |     // UniqueClientID := OleVariant(Args^[0]);
 | 
|---|
| 111 |   end;
 | 
|---|
| 112 |   If DispId = 8 then
 | 
|---|
| 113 |   begin
 | 
|---|
| 114 |     ConnectionIndex := OleVariant(Args^[1]);
 | 
|---|
| 115 |     ErrorText := OleVariant(Args^[0]);
 | 
|---|
| 116 |   end;
 | 
|---|
| 117 |   //This is called to trigger an event interface method, if implemented
 | 
|---|
| 118 |   //We need to check which one it is (by DispID) and do something sensible if we
 | 
|---|
| 119 |   //support the triggered event
 | 
|---|
| 120 |     case DispID of
 | 
|---|
| 121 |       1:  if Assigned(FBroker.OnLogout) then
 | 
|---|
| 122 |             FBroker.OnLogout;
 | 
|---|
| 123 | {
 | 
|---|
| 124 |       3:  if Assigned(FBroker.OnClientConnected) then
 | 
|---|
| 125 |             FBroker.OnClientConnected(UniqueClientID);
 | 
|---|
| 126 |       4:  if Assigned(FBroker.OnClientDisconnected) then
 | 
|---|
| 127 |             FBroker.OnClientDisconnected(UniqueClientID);
 | 
|---|
| 128 | }
 | 
|---|
| 129 |       8:  if Assigned(FBroker.OnConnectionDropped) then
 | 
|---|
| 130 |             FBroker.OnConnectionDropped(ConnectionIndex, ErrorText);
 | 
|---|
| 131 |     else
 | 
|---|
| 132 |       //Ignore other events
 | 
|---|
| 133 |     end
 | 
|---|
| 134 | end;
 | 
|---|
| 135 | 
 | 
|---|
| 136 | end.
 | 
|---|