| [453] | 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.
 | 
|---|