| 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: Describes TSharedRPCBroker class.
 | 
|---|
| 7 |         Current Release: Version 1.1 Patch 40 (January 7, 2005))
 | 
|---|
| 8 | *************************************************************** }
 | 
|---|
| 9 | 
 | 
|---|
| 10 | unit SharedRPCBroker;
 | 
|---|
| 11 | 
 | 
|---|
| 12 | interface
 | 
|---|
| 13 | 
 | 
|---|
| 14 | uses
 | 
|---|
| 15 |   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 | 
|---|
| 16 |   RPCSharedBrokerSessionMgr1_TLB_SRB, Trpcb, ActiveX, Extctrls;
 | 
|---|
| 17 |   // TRPCB is only used for data classes like TParams. There is no TRPCBroker dependency.
 | 
|---|
| 18 | 
 | 
|---|
| 19 | 
 | 
|---|
| 20 | type
 | 
|---|
| 21 |   TLogout = procedure () of object;
 | 
|---|
| 22 | 
 | 
|---|
| 23 |   TOnConnectionDropped = procedure (ConnectionIndex: Integer; ErrorText: WideString) of object;
 | 
|---|
| 24 | {
 | 
|---|
| 25 |   TOnClientConnected =  procedure (uniqueClientId: Integer) of object;
 | 
|---|
| 26 |   TOnClientDisconnected =  procedure (uniqueClientId: Integer) of object;
 | 
|---|
| 27 | }
 | 
|---|
| 28 | 
 | 
|---|
| 29 | // TSharedBrokerDataCollector is a data container class that collects all RPC call parameters BEFORE
 | 
|---|
| 30 | // an RPC call is made. When the actual RPC call is made all of the parameters are turned into a WideString
 | 
|---|
| 31 | // and passed through the Out-of-process COM interface to the TSharedBroker class found in VistASessionMgr.exe.
 | 
|---|
| 32 | // After the call the results are put back into Results which is a TStrings class like in TRPCBroker.
 | 
|---|
| 33 | // The parameters are stored in a local TParams member just like in TRPCBroker.
 | 
|---|
| 34 | // All Connections to the backend Mumps server are done through TSharedBroker which actually instantiates a real
 | 
|---|
| 35 | // TRPCBroker and uses it for the connection.
 | 
|---|
| 36 | 
 | 
|---|
| 37 | // Thus this class becomes a Delphi Component that wraps all of the data and keeps performance as high as possible.
 | 
|---|
| 38 | // If these calls were to be moved into the VistASessionMgr.exe then there would be two major problems
 | 
|---|
| 39 | //      1. Performance suffers when marshaling data across an out-of-process COM connection
 | 
|---|
| 40 | //      2. It is impossible to keeps the same Params and Results access interface that exists in TRPCBroker
 | 
|---|
| 41 | //         since the COM interface will not support structured data.
 | 
|---|
| 42 | 
 | 
|---|
| 43 | {
 | 
|---|
| 44 |   Modified 11/27/2001 jli to TSharedRPCBroker from TSharedBrokerDataCollector,
 | 
|---|
| 45 |   and changed as derived from TRPCBroker instead of TComponent, since other
 | 
|---|
| 46 |   components have properties which are of Type TRPCBroker and the
 | 
|---|
| 47 |   TSharedBrokerDataCollector derived from TComponent can't be used as a value
 | 
|---|
| 48 |   for those properties.
 | 
|---|
| 49 | }
 | 
|---|
| 50 | 
 | 
|---|
| 51 | 
 | 
|---|
| 52 | //  TSharedBrokerDataCollector = class(TComponent)
 | 
|---|
| 53 |   TSharedRPCBroker = class(TRPCBroker)
 | 
|---|
| 54 |   private
 | 
|---|
| 55 | {    FAccessVerifyCodes: TAccessVerifyCodes;
 | 
|---|
| 56 |     FClearParameters: Boolean;
 | 
|---|
| 57 |     FClearResults: Boolean;
 | 
|---|
| 58 |     FConnected: Boolean;
 | 
|---|
| 59 |     FConnecting: Boolean;
 | 
|---|
| 60 |     FCurrentContext: String;
 | 
|---|
| 61 |     FDebugMode: Boolean;
 | 
|---|
| 62 |     FListenerPort: integer;
 | 
|---|
| 63 |     FParams: TParams;
 | 
|---|
| 64 |     FResults: TStrings;
 | 
|---|
| 65 |     FRemoteProcedure: TRemoteProc;
 | 
|---|
| 66 |     FRpcVersion: TRpcVersion;
 | 
|---|
| 67 |     FServer: TServer;
 | 
|---|
| 68 |     FSocket: integer;
 | 
|---|
| 69 |     FRPCTimeLimit : integer;    //for adjusting client RPC duration timeouts
 | 
|---|
| 70 |     FPulse        : TTimer;     //P6
 | 
|---|
| 71 |     FKernelLogIn  : Boolean;    //p13
 | 
|---|
| 72 |     FLogIn: TVistaLogIn;    //p13
 | 
|---|
| 73 |     FUser: TVistaUser; //p13
 | 
|---|
| 74 |     FOnRPCBFailure: TOnRPCBFailure;
 | 
|---|
| 75 |     FShowErrorMsgs: TShowErrorMsgs;
 | 
|---|
| 76 |     FRPCBError:     String;
 | 
|---|
| 77 | }
 | 
|---|
| 78 |     FAllowShared:     Boolean;
 | 
|---|
| 79 |     FVistaSession:    ISharedBroker; // TSharedBroker;
 | 
|---|
| 80 |     FCurrRPCVersion:  TRpcVersion;
 | 
|---|
| 81 | //    FOnLogout:        TNotifyEvent;
 | 
|---|
| 82 |     FOnLogout:        TLogout;
 | 
|---|
| 83 |     FOnConnectionDropped: TOnConnectionDropped;
 | 
|---|
| 84 | {
 | 
|---|
| 85 |     FOnClientConnected: TOnClientConnected;
 | 
|---|
| 86 |     FOnClientDisconnected: TOnClientDisconnected;
 | 
|---|
| 87 | }
 | 
|---|
| 88 |     FSinkCookie: LongInt;
 | 
|---|
| 89 |     FKernelLogin: Boolean;
 | 
|---|
| 90 |     FRPCTimeLimit: integer;
 | 
|---|
| 91 |     FSocket: Integer;
 | 
|---|
| 92 |     FRPCBError: String;
 | 
|---|
| 93 |     FOnRPCBFailure: TOnRPCBFailure;
 | 
|---|
| 94 |     FLogin: TVistaLogin;
 | 
|---|
| 95 |     FUser: TVistaUser;
 | 
|---|
| 96 |   protected
 | 
|---|
| 97 |     procedure SetLoginStr(Str: string); virtual;
 | 
|---|
| 98 |     procedure SetUserStr(Str: String);
 | 
|---|
| 99 |     procedure      SetConnected(Value: Boolean); override;
 | 
|---|
| 100 |     function       GetConnected: Boolean;
 | 
|---|
| 101 |     procedure      SetResults(Value: TStrings); override;
 | 
|---|
| 102 |     procedure      SetClearParameters(Value: Boolean); override;
 | 
|---|
| 103 |     procedure      SetClearResults(Value: Boolean); override;
 | 
|---|
| 104 |     procedure      SetRPCTimeLimit(Value: integer); override;  //Screen changes to timeout.
 | 
|---|
| 105 | //    procedure      SetOnLogout(EventHandler: TNotifyEvent);
 | 
|---|
| 106 |     procedure      SetOnLogout(EventHandler: TLogout);
 | 
|---|
| 107 |     function       GetRpcVersion:TRpcVersion;
 | 
|---|
| 108 |     procedure      SetRpcVersion(version: TRpcVersion);
 | 
|---|
| 109 |     function   LoginStr: String;
 | 
|---|
| 110 | {
 | 
|---|
| 111 |     procedure      SetRPC(Value: TRemoteProc);
 | 
|---|
| 112 |     function       GetRPC: TRemoteProc;
 | 
|---|
| 113 | }
 | 
|---|
| 114 |   public
 | 
|---|
| 115 |     constructor    Create(AOwner: TComponent); override;
 | 
|---|
| 116 |     destructor     Destroy; override;
 | 
|---|
| 117 | //    procedure      OnLogoutEventHandlerDefault(Sender: TObject); virtual;
 | 
|---|
| 118 |     procedure      OnLogoutEventHandlerDefault; virtual;
 | 
|---|
| 119 |     procedure      OnConnectionDroppedHandler(ConnectionIndex: Integer; ErrorText: WideString); virtual;
 | 
|---|
| 120 |     function       GetBrokerConnectionIndexFromUniqueClientId(UniqueClientId: Integer): Integer;
 | 
|---|
| 121 | 
 | 
|---|
| 122 |     property    RPCBError: String read FRPCBError write FRPCBError;
 | 
|---|
| 123 |     property    OnRPCBFailure: TOnRPCBFailure read FOnRPCBFailure write FOnRPCBFailure;
 | 
|---|
| 124 | 
 | 
|---|
| 125 |     property User: TVistaUser read FUser write FUser;  // jli
 | 
|---|
| 126 |     property Login: TVistaLogin read FLogin write FLogin;  // jli
 | 
|---|
| 127 |     property OnConnectionDropped: TOnConnectionDropped read FOnConnectionDropped write FOnConnectionDropped;
 | 
|---|
| 128 | {
 | 
|---|
| 129 |     property OnClientConnected: TOnClientConnected read FOnClientConnected write FOnClientConnected;
 | 
|---|
| 130 |     property OnClientDisconnected: TOnClientDisconnected read FOnClientDisconnected write FOnClientDisconnected;
 | 
|---|
| 131 | }
 | 
|---|
| 132 |   published
 | 
|---|
| 133 |     // Call is he invocation entry point of the RPC call.
 | 
|---|
| 134 |     // The RPC Name, params, server and listener port must all be set up before
 | 
|---|
| 135 |     // making this call
 | 
|---|
| 136 |     procedure      Call; override;
 | 
|---|
| 137 | 
 | 
|---|
| 138 |     // lstCall is similar to the method Call, but puts Results in OutputBuffer
 | 
|---|
| 139 |     // lstCall actually calls Call so it is really more efficient to use the
 | 
|---|
| 140 |     // Call method and get the results from the Results property
 | 
|---|
| 141 |     procedure      lstCall(OutputBuffer: TStrings); override;
 | 
|---|
| 142 | 
 | 
|---|
| 143 |     // pchCall makes an RPC call and returns the results in a PChar;
 | 
|---|
| 144 |     // pchCall actually calls the Call method and then converts the results
 | 
|---|
| 145 |     // to PChar before returning.
 | 
|---|
| 146 |     // Making a call to Call and then using the Results property to get
 | 
|---|
| 147 |     // results is more efficient
 | 
|---|
| 148 |     function       pchCall: PChar; override;
 | 
|---|
| 149 | 
 | 
|---|
| 150 |     // strCall makes an RPC call and returns the results in a string;
 | 
|---|
| 151 |     // strCall actually calls the Call method and then converts the results
 | 
|---|
| 152 |     // to a string before returning.
 | 
|---|
| 153 |     // Making a call to Call and then using the Results property to get
 | 
|---|
| 154 |     // results is more efficient
 | 
|---|
| 155 |     function       strCall: string; override;
 | 
|---|
| 156 | 
 | 
|---|
| 157 |     // CreateContext sets up the context for the RPC call on the M server
 | 
|---|
| 158 |     function       CreateContext(strContext: string): boolean; override;
 | 
|---|
| 159 | 
 | 
|---|
| 160 | 
 | 
|---|
| 161 | {
 | 
|---|
| 162 |     // Server sets the server name or direct IP address
 | 
|---|
| 163 |     // Must be set BEFORE making the connection or the default on the system
 | 
|---|
| 164 |     // will be used
 | 
|---|
| 165 |     property       Server: TServer read FServer write FServer;
 | 
|---|
| 166 | }
 | 
|---|
| 167 |     // AllowShared allows this connection to share with and existing one
 | 
|---|
| 168 |     // Must be set BEFORE making a connection
 | 
|---|
| 169 |     property       AllowShared: Boolean read FAllowShared write FAllowShared;
 | 
|---|
| 170 | {
 | 
|---|
| 171 |     // DebugMode turns the debug mode on or off.
 | 
|---|
| 172 |     // Must be set BEFORE making an RPC Call
 | 
|---|
| 173 |     property       DebugMode: boolean read FDebugMode write FDebugMode default False;
 | 
|---|
| 174 | 
 | 
|---|
| 175 |     // ListenerPort sets the listener port on the server
 | 
|---|
| 176 |     // Must be set BEFORE making a connection
 | 
|---|
| 177 |     property       ListenerPort: integer read FListenerPort write FListenerPort;
 | 
|---|
| 178 | 
 | 
|---|
| 179 |     // Param accesses the parameters for the RPC call.
 | 
|---|
| 180 |     // Set them BEFORE making the RPC call
 | 
|---|
| 181 |     property       Param: TParams read FParams write FParams;
 | 
|---|
| 182 | 
 | 
|---|
| 183 |     // Results contains the results of the most recent RPC call
 | 
|---|
| 184 |     property       Results: TStrings read FResults write SetResults;
 | 
|---|
| 185 | 
 | 
|---|
| 186 |     // RemoteProcedure sets the name of the RPC to be made
 | 
|---|
| 187 |     // Set this BEFORE making the Call
 | 
|---|
| 188 |     property       RemoteProcedure: TRemoteProc read FRemoteProcedure1 write FRemoteProcedure1;
 | 
|---|
| 189 | //    property       RemoteProcedure: TRemoteProc read GetRPC write SetRPC;
 | 
|---|
| 190 | 
 | 
|---|
| 191 |     // The RpcVersion property is used to tell the M server on the other end of the RPCBroker connection
 | 
|---|
| 192 |     // which version of the RPC call it is expecting the M server to service. This is for the  Client
 | 
|---|
| 193 |     // to specify.
 | 
|---|
| 194 |     // Note: This is NOT the version of the RPCBroker!
 | 
|---|
| 195 |     property       RpcVersion: TRpcVersion read GetRpcVersion write SetRpcVersion;
 | 
|---|
| 196 | 
 | 
|---|
| 197 |     // ClearParameters clears out the params data if set to true so one can start over easily with
 | 
|---|
| 198 |     // new parameters
 | 
|---|
| 199 |     property       ClearParameters: boolean read FClearParameters write SetClearParameters;
 | 
|---|
| 200 | 
 | 
|---|
| 201 |     // ClearResults clears out the Results data if set to true. This is from legacy code. In
 | 
|---|
| 202 |     // the current implementation the Results from a recent call overwrite the current Results anyway.
 | 
|---|
| 203 |     property       ClearResults: boolean read FClearResults write SetClearResults;
 | 
|---|
| 204 | }
 | 
|---|
| 205 |     // If Connected is set to True then it makes a BrokerConnection call to the VistASessionMgr.
 | 
|---|
| 206 | //    property       Connected: boolean read FConnected write SetConnected;
 | 
|---|
| 207 |     property        Connected: boolean  read GetConnected write SetConnected default False;
 | 
|---|
| 208 | 
 | 
|---|
| 209 |     // RPCTimeLimit allows the application to change the network operation timeout prior to a call.
 | 
|---|
| 210 |     // This may be useful during times when it is known that a certain RPC, by its nature,
 | 
|---|
| 211 |     // can take a significant amount of time to execute. The value of this property is an
 | 
|---|
| 212 |     // integer that can not be less than 30 seconds nor greater that 32767 seconds.
 | 
|---|
| 213 |     // Care should be taken when altering this value, since the network operation will block
 | 
|---|
| 214 |     // the application until the operation finishes or the timeout is triggered.
 | 
|---|
| 215 |     property       RPCTimeLimit : integer read FRPCTimeLimit write SetRPCTimeLimit;
 | 
|---|
| 216 | 
 | 
|---|
| 217 |     // OnLogout sets/gets the OnLogout event handler to be called whenever the VistASessionMgr
 | 
|---|
| 218 |     // logs out.
 | 
|---|
| 219 | //    property       OnLogout: TNotifyEvent read FOnLogout write SetOnLogout;
 | 
|---|
| 220 |     property       OnLogout: TLogout read FOnLogout write SetOnLogout;
 | 
|---|
| 221 | 
 | 
|---|
| 222 |     property       Socket: Integer  read FSocket;
 | 
|---|
| 223 | 
 | 
|---|
| 224 |     property KernelLogin: Boolean read FKernelLogin write FKernelLogin default True;  // jli
 | 
|---|
| 225 | 
 | 
|---|
| 226 |   end;
 | 
|---|
| 227 | 
 | 
|---|
| 228 | implementation
 | 
|---|
| 229 | 
 | 
|---|
| 230 | uses ComObj, MfunStr, SharedRPCBrokerSink, fRPCBErrMsg;
 | 
|---|
| 231 | 
 | 
|---|
| 232 | const
 | 
|---|
| 233 |   {Keys}
 | 
|---|
| 234 |   REG_BROKER = 'Software\Vista\Broker';
 | 
|---|
| 235 |   REG_VISTA  = 'Software\Vista';
 | 
|---|
| 236 |   REG_SIGNON = 'Software\Vista\Signon';
 | 
|---|
| 237 |   REG_SERVERS = 'Software\Vista\Broker\Servers';
 | 
|---|
| 238 | 
 | 
|---|
| 239 | 
 | 
|---|
| 240 | procedure TSharedRPCBroker.SetLoginStr(Str: string);
 | 
|---|
| 241 | 
 | 
|---|
| 242 |    function TorF(Value: String): Boolean;
 | 
|---|
| 243 |    begin
 | 
|---|
| 244 |      Result := False;
 | 
|---|
| 245 |      if Value = '1' then
 | 
|---|
| 246 |        Result := True;
 | 
|---|
| 247 |    end;
 | 
|---|
| 248 | const
 | 
|---|
| 249 |   SEP_FS = #28;
 | 
|---|
| 250 |   SEP_GS = #29;
 | 
|---|
| 251 | var
 | 
|---|
| 252 |   DivStr: String;
 | 
|---|
| 253 |   StrFS: String;
 | 
|---|
| 254 |   StrGS: String;
 | 
|---|
| 255 |   ModeVal: String;
 | 
|---|
| 256 |   I: Integer;
 | 
|---|
| 257 |   DivisionList: TStringList;
 | 
|---|
| 258 | begin
 | 
|---|
| 259 |   StrFS := SEP_FS;
 | 
|---|
| 260 |   StrGS := SEP_GS;
 | 
|---|
| 261 |   with FLogin do
 | 
|---|
| 262 |   begin
 | 
|---|
| 263 |     LoginHandle := Piece(Str,StrFS,1);
 | 
|---|
| 264 |     NTToken := Piece(Str,StrFS,2);
 | 
|---|
| 265 |     AccessCode := Piece(Str,StrFS,3);
 | 
|---|
| 266 |     VerifyCode := Piece(Str,StrFS,4);
 | 
|---|
| 267 |     Division := Piece(Str,StrFS,5);
 | 
|---|
| 268 |     ModeVal := Piece(Str,StrFS,6);
 | 
|---|
| 269 |     DivStr := Piece(Str,StrFS,7);
 | 
|---|
| 270 |     MultiDivision := TorF(Piece(Str,StrFS,8));
 | 
|---|
| 271 |     DUZ := Piece(Str,StrFS,9);
 | 
|---|
| 272 |     PromptDivision := TorF(Piece(Str,StrFS,10));
 | 
|---|
| 273 |     ErrorText := Piece(Str,StrFS,11);
 | 
|---|
| 274 |     if ModeVal = '1' then
 | 
|---|
| 275 |       Mode := lmAVCodes
 | 
|---|
| 276 |     else if ModeVal = '2' then
 | 
|---|
| 277 |       Mode := lmAppHandle
 | 
|---|
| 278 |     else if ModeVal = '3' then
 | 
|---|
| 279 |       Mode := lmNTToken;
 | 
|---|
| 280 |     if DivStr <> '' then
 | 
|---|
| 281 |     begin
 | 
|---|
| 282 |       DivisionList := TStringList.Create;
 | 
|---|
| 283 |       try
 | 
|---|
| 284 |         I := 1;
 | 
|---|
| 285 |         while Piece(DivStr,StrGS,I) <> '' do
 | 
|---|
| 286 |         begin
 | 
|---|
| 287 |           DivisionList.Add(Piece(DivStr,StrGS,I));
 | 
|---|
| 288 |           Inc(I);
 | 
|---|
| 289 |         end;    // while
 | 
|---|
| 290 |         DivList.Assign(DivisionList);
 | 
|---|
| 291 |       finally
 | 
|---|
| 292 |         DivisionList.Free;
 | 
|---|
| 293 |       end;
 | 
|---|
| 294 |     end;
 | 
|---|
| 295 |   end;  // with
 | 
|---|
| 296 | end;
 | 
|---|
| 297 | 
 | 
|---|
| 298 | procedure TSharedRPCBroker.SetUserStr(Str: String);
 | 
|---|
| 299 | const
 | 
|---|
| 300 |   SEP_FS = #28;
 | 
|---|
| 301 | var
 | 
|---|
| 302 |   VC: String;
 | 
|---|
| 303 |   StrFS: String;
 | 
|---|
| 304 | begin
 | 
|---|
| 305 |   StrFS := SEP_FS;
 | 
|---|
| 306 |    with User do
 | 
|---|
| 307 |    begin
 | 
|---|
| 308 |      DUZ := Piece(Str,StrFS,1);
 | 
|---|
| 309 |      Name := Piece(Str,StrFS,2);
 | 
|---|
| 310 |      StandardName := Piece(Str,StrFS,3);
 | 
|---|
| 311 |      Division := Piece(Str,StrFS,4);
 | 
|---|
| 312 |      VC := Piece(Str,StrFS,5);
 | 
|---|
| 313 |      Title := Piece(Str,StrFS,6);
 | 
|---|
| 314 |      ServiceSection := Piece(Str,StrFS,7);
 | 
|---|
| 315 |      Language := Piece(Str,StrFS,8);
 | 
|---|
| 316 |      DTime := Piece(Str,StrFS,9);
 | 
|---|
| 317 |      if VC = '0' then
 | 
|---|
| 318 |        VerifyCodeChngd := False
 | 
|---|
| 319 |      else if VC = '1' then
 | 
|---|
| 320 |        VerifyCodeChngd := True;
 | 
|---|
| 321 |    end;    // with
 | 
|---|
| 322 | end;
 | 
|---|
| 323 |   
 | 
|---|
| 324 | function   TSharedRPCBroker.LoginStr: string;
 | 
|---|
| 325 |    function TorF1(Value: Boolean): String;
 | 
|---|
| 326 |    begin
 | 
|---|
| 327 |      Result := '0';
 | 
|---|
| 328 |      if Value then
 | 
|---|
| 329 |        Result := '1';
 | 
|---|
| 330 |    end;
 | 
|---|
| 331 |    
 | 
|---|
| 332 | const
 | 
|---|
| 333 |   SEP_FS = #28;
 | 
|---|
| 334 |   SEP_GS = #29;
 | 
|---|
| 335 | var
 | 
|---|
| 336 |   Str: String;
 | 
|---|
| 337 |   ModeVal: String;
 | 
|---|
| 338 |   DivLst: String;
 | 
|---|
| 339 |   MultiDiv: String;
 | 
|---|
| 340 |   PromptDiv: String;
 | 
|---|
| 341 |   StrFS, StrGS: String;
 | 
|---|
| 342 | begin
 | 
|---|
| 343 |   Str := '';
 | 
|---|
| 344 |     with FLogin do
 | 
|---|
| 345 |     begin
 | 
|---|
| 346 |       StrFS := SEP_FS;
 | 
|---|
| 347 |       StrGS := SEP_GS;
 | 
|---|
| 348 |       ModeVal := '';
 | 
|---|
| 349 |       if Mode = lmAVCodes then
 | 
|---|
| 350 |         ModeVal := '1'
 | 
|---|
| 351 |       else if Mode = lmAppHandle then
 | 
|---|
| 352 |         ModeVal := '2'
 | 
|---|
| 353 |       else if Mode = lmNTToken then
 | 
|---|
| 354 |         ModeVal := '3';
 | 
|---|
| 355 |       DivLst := '';
 | 
|---|
| 356 |       MultiDiv := TorF1(MultiDivision);
 | 
|---|
| 357 |       PromptDiv := TorF1(PromptDivision);
 | 
|---|
| 358 |       Str := LoginHandle + StrFS + NTToken + StrFS + AccessCode + StrFS;
 | 
|---|
| 359 |       Str := Str + VerifyCode + StrFS + Division + StrFS + ModeVal + StrFS;
 | 
|---|
| 360 |       Str := Str + DivLst + StrFS + MultiDiv + StrFS + DUZ + StrFS;
 | 
|---|
| 361 |       Str := Str + PromptDiv + StrFS + ErrorText + StrFS;
 | 
|---|
| 362 |     end;  // with
 | 
|---|
| 363 |   Result := Str;
 | 
|---|
| 364 | end;
 | 
|---|
| 365 |   // Constructor and Destructor implemented here
 | 
|---|
| 366 | constructor TSharedRPCBroker.Create(AOwner: TComponent);
 | 
|---|
| 367 | const
 | 
|---|
| 368 |   ProgID = 'RPCSharedBrokerSessionMgr.Application';
 | 
|---|
| 369 | //var
 | 
|---|
| 370 | //  brokerError: ISharedBrokerErrorCode;
 | 
|---|
| 371 | //  regResult: WideString;
 | 
|---|
| 372 | begin
 | 
|---|
| 373 |   inherited Create(AOwner);
 | 
|---|
| 374 |   FConnected := False;
 | 
|---|
| 375 |   DebugMode := False;
 | 
|---|
| 376 |   FParams := TParams.Create(Self);
 | 
|---|
| 377 | //  FResults := TStringList.Create;
 | 
|---|
| 378 |   RpcVersion := '0';
 | 
|---|
| 379 |   FCurrRpcVersion := '0';
 | 
|---|
| 380 |   FRPCTimeLimit := MIN_RPCTIMELIMIT;                   // MIN_RPCTIMELIMIT comes from TRPCBroker (30 seconds)
 | 
|---|
| 381 | //  FAllowShared := False;
 | 
|---|
| 382 |   FOnLogout := OnLogoutEventHandlerDefault;            // Supply this one incase the application doesn't
 | 
|---|
| 383 |   FOnConnectionDropped := OnConnectionDroppedHandler;
 | 
|---|
| 384 |   Server := '';
 | 
|---|
| 385 |   ListenerPort := 0;
 | 
|---|
| 386 | 
 | 
|---|
| 387 |   FKernelLogin := True;            // jli
 | 
|---|
| 388 |   FUser := TVistaUser.Create;  // jli
 | 
|---|
| 389 |   FLogin := TVistaLogin.Create(Self);  // jli
 | 
|---|
| 390 | 
 | 
|---|
| 391 | //  CoInitialize(nil);
 | 
|---|
| 392 | {  try
 | 
|---|
| 393 |     if not (CoInitialize(nil) = S_OK) then
 | 
|---|
| 394 |       ShowMessage('CoInitialize Problem!');
 | 
|---|
| 395 |   except
 | 
|---|
| 396 |   end;
 | 
|---|
| 397 | }
 | 
|---|
| 398 | end;
 | 
|---|
| 399 | 
 | 
|---|
| 400 | destructor TSharedRPCBroker.Destroy;
 | 
|---|
| 401 | begin
 | 
|---|
| 402 |   if Connected then  // FConnected
 | 
|---|
| 403 |   begin
 | 
|---|
| 404 |     Connected := False;
 | 
|---|
| 405 |     FConnected := False;
 | 
|---|
| 406 |   end;
 | 
|---|
| 407 |   FParams.Free;
 | 
|---|
| 408 |   FParams := nil;
 | 
|---|
| 409 | {
 | 
|---|
| 410 |   FResults.Free;
 | 
|---|
| 411 |   FResults := nil;
 | 
|---|
| 412 | }
 | 
|---|
| 413 |   if FVistaSession <> nil then
 | 
|---|
| 414 |   begin
 | 
|---|
| 415 | //    FVistaSession.Free;
 | 
|---|
| 416 |     FVistaSession := nil;
 | 
|---|
| 417 |   end;
 | 
|---|
| 418 | {
 | 
|---|
| 419 |   FUser.Free;
 | 
|---|
| 420 |   FLogin.Free;
 | 
|---|
| 421 | }
 | 
|---|
| 422 |   inherited;
 | 
|---|
| 423 | end;
 | 
|---|
| 424 | 
 | 
|---|
| 425 | //procedure TSharedRPCBroker.OnLogoutEventHandlerDefault(Sender: TObject);
 | 
|---|
| 426 | procedure TSharedRPCBroker.OnLogoutEventHandlerDefault;
 | 
|---|
| 427 | begin
 | 
|---|
| 428 |   // This event handler will get called if the application that uses
 | 
|---|
| 429 |   // this component does not supply one.
 | 
|---|
| 430 |   SendMessage(Application.MainForm.Handle,WM_CLOSE,0,0);
 | 
|---|
| 431 | end;
 | 
|---|
| 432 | 
 | 
|---|
| 433 | procedure TSharedRPCBroker.OnConnectionDroppedHandler(ConnectionIndex: Integer; ErrorText: WideString);
 | 
|---|
| 434 | var
 | 
|---|
| 435 |   Str: String;
 | 
|---|
| 436 | //  BrokerError: EBrokerError;
 | 
|---|
| 437 | begin
 | 
|---|
| 438 |   Str := ErrorText;
 | 
|---|
| 439 |   RPCBShowErrMsg(ErrorText);
 | 
|---|
| 440 | //  FConnected := False;
 | 
|---|
| 441 |   // Raising an error here returns an error 'The Server Threw an exception' back into the server
 | 
|---|
| 442 | //  BrokerError := EBrokerError.Create(Str);
 | 
|---|
| 443 | //  raise BrokerError;
 | 
|---|
| 444 | end;
 | 
|---|
| 445 | 
 | 
|---|
| 446 | // Published Methods implemented here
 | 
|---|
| 447 | procedure TSharedRPCBroker.Call;
 | 
|---|
| 448 | const
 | 
|---|
| 449 |   SEP_FS = #28;
 | 
|---|
| 450 |   SEP_GS = #29;
 | 
|---|
| 451 |   SEP_US = #30;
 | 
|---|
| 452 |   SEP_RS = #31;
 | 
|---|
| 453 | var
 | 
|---|
| 454 |   i, j, ErrCode: Integer;
 | 
|---|
| 455 |   rpcParams, ASub, AVal: string;
 | 
|---|
| 456 |   ReturnedResults: WideString;
 | 
|---|
| 457 |   AnError: EBrokerError;
 | 
|---|
| 458 |   ErrCode1: ISharedBrokerErrorCode;
 | 
|---|
| 459 | begin
 | 
|---|
| 460 |   try
 | 
|---|
| 461 |   rpcParams := '';
 | 
|---|
| 462 |   if not Connected then Connected := True;
 | 
|---|
| 463 |   for i := 0 to Pred(Param.Count) do
 | 
|---|
| 464 |   begin
 | 
|---|
| 465 |     case Param[i].PType of
 | 
|---|
| 466 |       literal: rpcParams := rpcParams + 'L' + SEP_FS;
 | 
|---|
| 467 |     reference: rpcParams := rpcParams + 'R' + SEP_FS;
 | 
|---|
| 468 |          list: rpcParams := rpcParams + 'M' + SEP_FS;
 | 
|---|
| 469 |     else       rpcParams := rpcParams + 'U' + SEP_FS;
 | 
|---|
| 470 |     end; {case}
 | 
|---|
| 471 |     if Param[i].PType = list then
 | 
|---|
| 472 |     begin
 | 
|---|
| 473 |       for j := 0 to Pred(Param[i].Mult.Count) do
 | 
|---|
| 474 |       begin
 | 
|---|
| 475 |         ASub := Param[i].Mult.Subscript(j);
 | 
|---|
| 476 |         AVal := Param[i].Mult[ASub];
 | 
|---|
| 477 |         rpcParams := rpcParams + ASub + SEP_US + AVal + SEP_RS;
 | 
|---|
| 478 |       end;
 | 
|---|
| 479 |       rpcParams := rpcParams + SEP_GS;
 | 
|---|
| 480 |     end else
 | 
|---|
| 481 |     begin
 | 
|---|
| 482 |       rpcParams := rpcParams + Param[i].Value + SEP_GS;
 | 
|---|
| 483 |     end; {if Param[i]...else}
 | 
|---|
| 484 |   end; {for i}
 | 
|---|
| 485 |   if RpcVersion <> FCurrRpcVersion then
 | 
|---|
| 486 |     FVistaSession.Set_RPCVersion(RPCVersion);
 | 
|---|
| 487 | 
 | 
|---|
| 488 |   RPCBError := '';
 | 
|---|
| 489 |   
 | 
|---|
| 490 |   ErrCode1 := FVistaSession.BrokerCall(RemoteProcedure, rpcParams, RPCTimeLimit, ReturnedResults, ErrCode);
 | 
|---|
| 491 | 
 | 
|---|
| 492 |   if ClearParameters = true then
 | 
|---|
| 493 |     Param.Clear;
 | 
|---|
| 494 | 
 | 
|---|
| 495 |   if ErrCode1 = Success then
 | 
|---|
| 496 |     Results.Text := ReturnedResults
 | 
|---|
| 497 |   else
 | 
|---|
| 498 |   begin
 | 
|---|
| 499 |     Results.Text := '';
 | 
|---|
| 500 |     RPCBError := FVistaSession.RpcbError;
 | 
|---|
| 501 |     if Assigned(FOnRPCBFailure) then       // p13
 | 
|---|
| 502 |       FOnRPCBFailure(Self)                 // p13
 | 
|---|
| 503 |     else if ShowErrorMsgs = semRaise then
 | 
|---|
| 504 |     begin
 | 
|---|
| 505 |       AnError := EBrokerError.Create(FRPCBError);
 | 
|---|
| 506 |       raise AnError;
 | 
|---|
| 507 |     end
 | 
|---|
| 508 |     else
 | 
|---|
| 509 |       exit;
 | 
|---|
| 510 |   end; {if ErrCode...else}
 | 
|---|
| 511 |   except
 | 
|---|
| 512 |     on e: Exception do
 | 
|---|
| 513 |     begin
 | 
|---|
| 514 |       AnError := EBrokerError.Create('Error: ' + e.Message);
 | 
|---|
| 515 |       raise AnError;
 | 
|---|
| 516 |     end;
 | 
|---|
| 517 |   end;
 | 
|---|
| 518 | end;
 | 
|---|
| 519 | 
 | 
|---|
| 520 | function TSharedRPCBroker.CreateContext(strContext: string): boolean;
 | 
|---|
| 521 | var
 | 
|---|
| 522 |   Intval: Integer;
 | 
|---|
| 523 | begin
 | 
|---|
| 524 |   // hides the RPCBroker CreateContext
 | 
|---|
| 525 |   if not Connected then SetConnected(TRUE);  // FConnected
 | 
|---|
| 526 | 
 | 
|---|
| 527 |   Intval := FVistaSession.BrokerSetContext(strContext);
 | 
|---|
| 528 |   Result := Intval = 1;
 | 
|---|
| 529 | end;
 | 
|---|
| 530 | 
 | 
|---|
| 531 | procedure TSharedRPCBroker.lstCall(OutputBuffer: TStrings);
 | 
|---|
| 532 | begin
 | 
|---|
| 533 |   Call;
 | 
|---|
| 534 |   OutputBuffer.Text := Results.Text;
 | 
|---|
| 535 | end;
 | 
|---|
| 536 | 
 | 
|---|
| 537 | function TSharedRPCBroker.pchCall: PChar;
 | 
|---|
| 538 | begin
 | 
|---|
| 539 |   Call;
 | 
|---|
| 540 |   Result := Results.GetText;
 | 
|---|
| 541 | end;
 | 
|---|
| 542 | 
 | 
|---|
| 543 | function TSharedRPCBroker.strCall: string;
 | 
|---|
| 544 | begin
 | 
|---|
| 545 |   Call;
 | 
|---|
| 546 |   Result := Results.Text;
 | 
|---|
| 547 | end;
 | 
|---|
| 548 | 
 | 
|---|
| 549 | procedure TSharedRPCBroker.SetConnected(Value: Boolean);
 | 
|---|
| 550 | var
 | 
|---|
| 551 |   uniqueClientId: Integer;
 | 
|---|
| 552 |   brokerError: ISharedBrokerErrorCode;
 | 
|---|
| 553 |   regResult: WideString;
 | 
|---|
| 554 |   CurrWindow: HWND;
 | 
|---|
| 555 |   AnError: EBrokerError;
 | 
|---|
| 556 |   UserStr: String;
 | 
|---|
| 557 |   RPCError: WideString;
 | 
|---|
| 558 |   BrokerErrorVal: EBrokerError;
 | 
|---|
| 559 |   ShowErrMsgs: ISharedBrokerShowErrorMsgs;
 | 
|---|
| 560 |   LoginStrX: WideString;
 | 
|---|
| 561 |   SBSink: TSharedRPCBrokerSink;
 | 
|---|
| 562 | begin
 | 
|---|
| 563 |   try
 | 
|---|
| 564 |   { call connect method for VistaSession }
 | 
|---|
| 565 |   if Value then
 | 
|---|
| 566 |   begin
 | 
|---|
| 567 |     if FVistaSession = nil then
 | 
|---|
| 568 |     begin
 | 
|---|
| 569 |       FVistaSession := CreateComObject(CLASS_SharedBroker) as ISharedBroker;  // TSharedBroker.Create(self);
 | 
|---|
| 570 | //      FVistaSession.Connect;
 | 
|---|
| 571 |   //No need to keep hold of event sink. It will be destroyed
 | 
|---|
| 572 |   //through interface reference counting when the client
 | 
|---|
| 573 |   //disconnects from the server in the form's OnDestroy event handler
 | 
|---|
| 574 |       SBSink := TSharedRPCBrokerSink.Create;
 | 
|---|
| 575 |       SBSink.Broker := Self;
 | 
|---|
| 576 |       InterfaceConnect(FVistaSession, ISharedBrokerEvents, SBSink, FSinkCookie);
 | 
|---|
| 577 | 
 | 
|---|
| 578 | //      ConnectEvents(FVistaSession);
 | 
|---|
| 579 | {      If Assigned(FOnLogout) then
 | 
|---|
| 580 |         FVistaSession.OnLogout := FOnLogout;
 | 
|---|
| 581 |       if Assigned(FOnConnectionDropped) then
 | 
|---|
| 582 |         FVistaSession.OnConnectionDropped := OnConnectionDroppedHandler;
 | 
|---|
| 583 | }
 | 
|---|
| 584 |       regResult := '';
 | 
|---|
| 585 |       brokerError := FVistaSession.ReadRegDataDefault(HKLM,REG_BROKER,'ClearParameters','1',regResult);
 | 
|---|
| 586 |       Assert(brokerError = Success);
 | 
|---|
| 587 | 
 | 
|---|
| 588 |       ClearParameters := boolean(StrToInt(regResult));  // FClearParameters
 | 
|---|
| 589 | 
 | 
|---|
| 590 |       brokerError := FVistaSession.ReadRegDataDefault(HKLM,REG_BROKER,'ClearResults','1',regResult);
 | 
|---|
| 591 |       Assert(brokerError = Success);
 | 
|---|
| 592 |       ClearResults := boolean(StrToInt(regResult));  // FClearResults
 | 
|---|
| 593 | 
 | 
|---|
| 594 | //      DebugMode := False;
 | 
|---|
| 595 | //     FParams := TParams.Create(Self);
 | 
|---|
| 596 | //      FResults := TStringList.Create;  ???
 | 
|---|
| 597 | 
 | 
|---|
| 598 |       if Server = '' then
 | 
|---|
| 599 |       begin
 | 
|---|
| 600 |         brokerError := FVistaSession.ReadRegDataDefault(HKLM,REG_BROKER,'Server','BROKERSERVER',regResult);
 | 
|---|
| 601 |         Assert(brokerError = Success);
 | 
|---|
| 602 |         Server := regResult;
 | 
|---|
| 603 |       end;
 | 
|---|
| 604 | 
 | 
|---|
| 605 |       if ListenerPort = 0 then
 | 
|---|
| 606 |       begin
 | 
|---|
| 607 |         brokerError := FVistaSession.ReadRegDataDefault(HKLM,REG_BROKER,'ListenerPort','9000',regResult);
 | 
|---|
| 608 |         Assert(brokerError = Success);
 | 
|---|
| 609 |         ListenerPort := StrToInt(regResult);
 | 
|---|
| 610 |       end;
 | 
|---|
| 611 | 
 | 
|---|
| 612 |       RpcVersion := '0';  // TODO: Remove this when the property is remove. It is UESLESS!
 | 
|---|
| 613 | 
 | 
|---|
| 614 | //      FRPCTimeLimit := MIN_RPCTIMELIMIT; //  MIN_RPCTIMELIMIT comes from TRPCBroker (30 seconds)
 | 
|---|
| 615 | //      AllowShared := True;
 | 
|---|
| 616 |     end;
 | 
|---|
| 617 | 
 | 
|---|
| 618 |     if FConnected <> True then  // FConnected
 | 
|---|
| 619 |     begin
 | 
|---|
| 620 |      // Connect to the M server through the COm Server
 | 
|---|
| 621 |       CurrWindow := GetActiveWindow;
 | 
|---|
| 622 |       if AccessVerifyCodes <> '' then   // p13 handle as AVCode single signon
 | 
|---|
| 623 |       begin
 | 
|---|
| 624 |         Login.AccessCode := Piece(AccessVerifyCodes, ';', 1);
 | 
|---|
| 625 |         Login.VerifyCode := Piece(AccessVerifyCodes, ';', 2);
 | 
|---|
| 626 |         Login.Mode := lmAVCodes;
 | 
|---|
| 627 |         FKernelLogIn := False;
 | 
|---|
| 628 |       end;
 | 
|---|
| 629 |       if ShowErrorMsgs = semRaise then
 | 
|---|
| 630 |         ShowErrMsgs := isemRaise
 | 
|---|
| 631 |       else
 | 
|---|
| 632 |         ShowErrMsgs := isemQuiet;
 | 
|---|
| 633 |       BrokerError := GeneralFailure;
 | 
|---|
| 634 |       LoginStrX := WideString(LoginStr);
 | 
|---|
| 635 |       try
 | 
|---|
| 636 |         brokerError := FVistaSession.BrokerConnect(ParamStr(0),BrokerClient,Server + ':' + IntToStr(ListenerPort),
 | 
|---|
| 637 |                                                  DebugMode, FAllowShared, FKernelLogin, ShowErrMsgs, RPCTimeLimit, LoginStrX, uniqueClientId, RPCError);
 | 
|---|
| 638 |       except
 | 
|---|
| 639 |       end;
 | 
|---|
| 640 |       FRPCBError := RPCError;
 | 
|---|
| 641 |       SetLoginStr(LoginStrX);
 | 
|---|
| 642 |       ShowApplicationAndFocusOK(Application);
 | 
|---|
| 643 |       SetForegroundWindow(CurrWindow);
 | 
|---|
| 644 |       if brokerError = Success then
 | 
|---|
| 645 |       begin
 | 
|---|
| 646 |         FConnected := True;  // FConnected
 | 
|---|
| 647 |         FSocket := 1;  // temporarily handle socket until it can be pulled from Shared Broker;
 | 
|---|
| 648 |         UserStr := FVistaSession.User;
 | 
|---|
| 649 |         SetUserStr(UserStr);
 | 
|---|
| 650 |       end
 | 
|---|
| 651 |       else
 | 
|---|
| 652 |       begin
 | 
|---|
| 653 |         if Assigned(FOnRPCBFailure) then       // p13
 | 
|---|
| 654 |             FOnRPCBFailure(Self)                 // p13
 | 
|---|
| 655 |         else if ShowErrorMsgs = semRaise then
 | 
|---|
| 656 |         begin
 | 
|---|
| 657 |           BrokerErrorVal := EBrokerError.Create(FRPCBError);
 | 
|---|
| 658 |           raise BrokerErrorVal;
 | 
|---|
| 659 |         end;
 | 
|---|
| 660 |       end;
 | 
|---|
| 661 |     end;
 | 
|---|
| 662 | 
 | 
|---|
| 663 |   end else
 | 
|---|
| 664 |   begin
 | 
|---|
| 665 |     if FVistaSession<>nil then
 | 
|---|
| 666 |     begin
 | 
|---|
| 667 |       if FConnected = true then  // FConnected
 | 
|---|
| 668 |       begin
 | 
|---|
| 669 |         // Lets make the OnLogout event handler nil to eliminate
 | 
|---|
| 670 |         // circularity problems before we do the disconnects.
 | 
|---|
| 671 |         OnLogout := nil;
 | 
|---|
| 672 | 
 | 
|---|
| 673 |         FVistaSession.BrokerDisconnect;  // Disconnect from the Broker
 | 
|---|
| 674 | //        FVistaSession.Disconnect;        // Disconnect from the COM server
 | 
|---|
| 675 |         FSocket := 0;   // temporarily handle socket until it can be pulled from Shared Broker
 | 
|---|
| 676 |       end;
 | 
|---|
| 677 | //      FVistaSession.Free;
 | 
|---|
| 678 |       InterfaceDisconnect(FVistaSession, ISharedBrokerEvents, FSinkCookie);
 | 
|---|
| 679 |       FVistaSession := nil;
 | 
|---|
| 680 |     end;
 | 
|---|
| 681 |     FConnected := False; // FConnected
 | 
|---|
| 682 |   end;
 | 
|---|
| 683 |   except
 | 
|---|
| 684 |     on e: Exception do
 | 
|---|
| 685 |     begin
 | 
|---|
| 686 |       AnError := EBrokerError.Create('Error: ' + e.Message);
 | 
|---|
| 687 |       raise AnError;
 | 
|---|
| 688 |     end;
 | 
|---|
| 689 |   end;
 | 
|---|
| 690 | end;
 | 
|---|
| 691 | 
 | 
|---|
| 692 | procedure TSharedRPCBroker.SetResults(Value: TStrings);
 | 
|---|
| 693 | begin
 | 
|---|
| 694 |   Results.Assign(Value);  // FResults
 | 
|---|
| 695 | end;
 | 
|---|
| 696 | 
 | 
|---|
| 697 | procedure TSharedRPCBroker.SetClearParameters(Value: Boolean);
 | 
|---|
| 698 | begin
 | 
|---|
| 699 |   if Value then Param.Clear;  // FParams
 | 
|---|
| 700 |   FClearParameters := Value;  // FClearParameters
 | 
|---|
| 701 | end;
 | 
|---|
| 702 | 
 | 
|---|
| 703 | procedure TSharedRPCBroker.SetClearResults(Value: Boolean);
 | 
|---|
| 704 | begin
 | 
|---|
| 705 |   if Value then Results.Clear;  // FResults
 | 
|---|
| 706 |   FClearResults := Value; // FClearResults
 | 
|---|
| 707 | end;
 | 
|---|
| 708 | 
 | 
|---|
| 709 | procedure TSharedRPCBroker.SetRPCTimeLimit(Value: integer);
 | 
|---|
| 710 | begin
 | 
|---|
| 711 |   if Value <> RPCTimeLimit then  // FRPCTimeLimit
 | 
|---|
| 712 |     if Value > MIN_RPCTIMELIMIT then
 | 
|---|
| 713 |       FRPCTimeLimit := Value  // FRPCTimeLimit
 | 
|---|
| 714 |     else
 | 
|---|
| 715 |       FRPCTimeLimit := MIN_RPCTIMELIMIT;  // FRPCTimeLimit
 | 
|---|
| 716 | end;
 | 
|---|
| 717 | 
 | 
|---|
| 718 | //procedure TSharedRPCBroker.SetOnLogout(EventHandler: TNotifyEvent);
 | 
|---|
| 719 | procedure TSharedRPCBroker.SetOnLogout(EventHandler: TLogout);
 | 
|---|
| 720 | begin
 | 
|---|
| 721 |   FOnLogout := EventHandler;
 | 
|---|
| 722 | //  if FVistaSession <> nil then
 | 
|---|
| 723 | //    FVistaSession.OnLogout := FOnLogout;
 | 
|---|
| 724 | end;
 | 
|---|
| 725 | 
 | 
|---|
| 726 | function  TSharedRPCBroker.GetRpcVersion: TRpcVersion;
 | 
|---|
| 727 | begin
 | 
|---|
| 728 |   if FVistaSession <> nil then Result := FVistaSession.RPCVersion else Result := '0';
 | 
|---|
| 729 | end;
 | 
|---|
| 730 | 
 | 
|---|
| 731 | procedure  TSharedRPCBroker.SetRpcVersion(version: TRpcVersion);
 | 
|---|
| 732 | begin
 | 
|---|
| 733 |   if FVistaSession <> nil then FVistaSession.RPCVersion:= version;
 | 
|---|
| 734 | end;
 | 
|---|
| 735 | 
 | 
|---|
| 736 | function TSharedRPCBroker.GetConnected: Boolean;
 | 
|---|
| 737 | begin
 | 
|---|
| 738 |   Result := FConnected;
 | 
|---|
| 739 | end;
 | 
|---|
| 740 | 
 | 
|---|
| 741 | {
 | 
|---|
| 742 | procedure TSharedRPCBroker.SetRPC(Value: TRemoteProc);
 | 
|---|
| 743 | begin
 | 
|---|
| 744 |   RemoteProcedure := Value;
 | 
|---|
| 745 | end;
 | 
|---|
| 746 | 
 | 
|---|
| 747 | function TSharedRPCBroker.GetRPC: TRemoteProc;
 | 
|---|
| 748 | begin
 | 
|---|
| 749 |   Result := FRemoteProcedure1;
 | 
|---|
| 750 | end;
 | 
|---|
| 751 | }
 | 
|---|
| 752 | {
 | 
|---|
| 753 | procedure Register;
 | 
|---|
| 754 | begin
 | 
|---|
| 755 |   RegisterComponents('Kernel', [TSharedBrokerDataCollector]);
 | 
|---|
| 756 | end;
 | 
|---|
| 757 | }
 | 
|---|
| 758 | 
 | 
|---|
| 759 | function TSharedRPCBroker.GetBrokerConnectionIndexFromUniqueClientId(UniqueClientId: Integer): Integer;
 | 
|---|
| 760 | var
 | 
|---|
| 761 |   ConnectionIndex: Integer;
 | 
|---|
| 762 | begin
 | 
|---|
| 763 |   ConnectionIndex := -1;
 | 
|---|
| 764 |   if FVistaSession <> nil then
 | 
|---|
| 765 |     FVistaSession.GetActiveBrokerConnectionIndexFromUniqueClientId(UniqueClientId, ConnectionIndex);
 | 
|---|
| 766 |   Result := ConnectionIndex;
 | 
|---|
| 767 | end;
 | 
|---|
| 768 | 
 | 
|---|
| 769 | end.
 | 
|---|