| [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: 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.
 | 
|---|