Produced by Araxis Merge on 3/22/2018 8:29:09 AM Central Daylight Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.
| # | Location | File | Last Modified |
|---|---|---|---|
| 1 | Build_3_Patch_32_Jan_2018.zip\XWB\BDK32\Source | SharedRPCBroker.pas | Thu Mar 15 15:05:59 2018 UTC |
| 2 | Build_3_Patch_32_Jan_2018.zip\XWB\BDK32\Source | SharedRPCBroker.pas | Wed Mar 21 15:40:45 2018 UTC |
| Description | Between Files 1 and 2 |
|
|---|---|---|
| Text Blocks | Lines | |
| Unchanged | 2 | 1536 |
| Changed | 1 | 2 |
| Inserted | 0 | 0 |
| Removed | 0 | 0 |
| Whitespace | |
|---|---|
| Character case | Differences in character case are significant |
| Line endings | Differences in line endings (CR and LF characters) are ignored |
| CR/LF characters | Not shown in the comparison detail |
No regular expressions were active.
| 1 | { ******** ********** ********** ********** ********** ********** **** | |
| 2 | Pa ckage: XWB - Kernel RPCBroker | |
| 3 | Da te Created : Sept 18, 1997 (Ver sion 1.1) | |
| 4 | Si te Name: O akland, OI Field Off ice, Dept of Veteran Affairs | |
| 5 | De velopers: Kevin Meld rum, Travi s Hilton, Joel Ivey | |
| 6 | De scription: Describes TSharedRP CBroker cl ass. | |
| 7 | Cu rrent Rele ase: Versi on 1.1 Pat ch 50 | |
| 8 | ********** ********** ********** ********** ********** ********** *** } | |
| 9 | ||
| 10 | unit Share dRPCBroker ; | |
| 11 | ||
| 12 | interface | |
| 13 | ||
| 14 | uses | |
| 15 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dia logs, | |
| 16 | RPCShare dBrokerSes sionMgr1_T LB_SRB, Tr pcb, Activ eX, Extctr ls; | |
| 17 | // TRPCB is only u sed for da ta classes like TPar ams. There is no TRP CBroker de pendency. | |
| 18 | ||
| 19 | ||
| 20 | type | |
| 21 | TLogout = procedur e () of ob ject; | |
| 22 | ||
| 23 | TOnConne ctionDropp ed = proce dure (Conn ectionInde x: Integer ; ErrorTex t: WideStr ing) of ob ject; | |
| 24 | { | |
| 25 | TOnClien tConnected = proced ure (uniqu eClientId: Integer) of object; | |
| 26 | TOnClien tDisconnec ted = pro cedure (un iqueClient Id: Intege r) of obje ct; | |
| 27 | } | |
| 28 | ||
| 29 | // TShared BrokerData Collector is a data container class that collects all RPC ca ll paramet ers BEFORE | |
| 30 | // an RPC call is ma de. When t he actual RPC call i s made all of the pa rameters a re turned into a Wid eString | |
| 31 | // and pas sed throug h the Out- of-process COM inter face to th e TSharedB roker clas s found in VistASess ionMgr.exe . | |
| 32 | // After t he call th e results are put ba ck into Re sults whic h is a TSt rings clas s like in TRPCBroker . | |
| 33 | // The par ameters ar e stored i n a local TParams me mber just like in TR PCBroker. | |
| 34 | // All Con nections t o the back end Mumps server are done thro ugh TShare dBroker wh ich actual ly instant iates a re al | |
| 35 | // TRPCBro ker and us es it for the connec tion. | |
| 36 | ||
| 37 | // Thus th is class b ecomes a D elphi Comp onent that wraps all of the da ta and kee ps perform ance as hi gh as poss ible. | |
| 38 | // If thes e calls we re to be m oved into the VistAS essionMgr. exe then t here would be two ma jor proble ms | |
| 39 | // 1. Performan ce suffers when mars haling dat a across a n out-of-p rocess COM connectio n | |
| 40 | // 2. It is imp ossible to keeps the same Para ms and Res ults acces s interfac e that exi sts in TRP CBroker | |
| 41 | // since the COM inter face will not suppor t structur ed data. | |
| 42 | ||
| 43 | { | |
| 44 | Modified 11/27/200 1 jli to T SharedRPCB roker from TSharedBr okerDataCo llector, | |
| 45 | and chan ged as der ived from TRPCBroker instead o f TCompone nt, since other | |
| 46 | componen ts have pr operties w hich are o f Type TRP CBroker an d the | |
| 47 | TSharedB rokerDataC ollector d erived fro m TCompone nt can't b e used as a value | |
| 48 | for thos e properti es. | |
| 49 | } | |
| 50 | ||
| 51 | ||
| 52 | // TShare dBrokerDat aCollector = class(T Component) | |
| 53 | TSharedR PCBroker = class(TRP CBroker) | |
| 54 | private | |
| 55 | { FAcce ssVerifyCo des: TAcce ssVerifyCo des; | |
| 56 | FClear Parameters : Boolean; | |
| 57 | FClear Results: B oolean; | |
| 58 | FConne cted: Bool ean; | |
| 59 | FConne cting: Boo lean; | |
| 60 | FCurre ntContext: String; | |
| 61 | FDebug Mode: Bool ean; | |
| 62 | FListe nerPort: i nteger; | |
| 63 | FParam s: TParams ; | |
| 64 | FResul ts: TStrin gs; | |
| 65 | FRemot eProcedure : TRemoteP roc; | |
| 66 | FRpcVe rsion: TRp cVersion; | |
| 67 | FServe r: TServer ; | |
| 68 | FSocke t: integer ; | |
| 69 | FRPCTi meLimit : integer; //for ad justing cl ient RPC d uration ti meouts | |
| 70 | FPulse : TTimer; //P6 | |
| 71 | FKerne lLogIn : Boolean; //p13 | |
| 72 | FLogIn : TVistaLo gIn; // p13 | |
| 73 | FUser: TVistaUse r; //p13 | |
| 74 | FOnRPC BFailure: TOnRPCBFai lure; | |
| 75 | FShowE rrorMsgs: TShowError Msgs; | |
| 76 | FRPCBE rror: String; | |
| 77 | } | |
| 78 | FAllow Shared: Boolean; | |
| 79 | FVista Session: ISharedB roker; // TSharedBro ker; | |
| 80 | FCurrR PCVersion: TRpcVers ion; | |
| 81 | // FOnL ogout: TNotif yEvent; | |
| 82 | FOnLog out: TLogout; | |
| 83 | FOnCon nectionDro pped: TOnC onnectionD ropped; | |
| 84 | { | |
| 85 | FOnCli entConnect ed: TOnCli entConnect ed; | |
| 86 | FOnCli entDisconn ected: TOn ClientDisc onnected; | |
| 87 | } | |
| 88 | FSinkC ookie: Lon gInt; | |
| 89 | FKerne lLogin: Bo olean; | |
| 90 | FRPCTi meLimit: i nteger; | |
| 91 | FSocke t: Integer ; | |
| 92 | FRPCBE rror: Stri ng; | |
| 93 | FOnRPC BFailure: TOnRPCBFai lure; | |
| 94 | FLogin : TVistaLo gin; | |
| 95 | FUser: TVistaUse r; | |
| 96 | protecte d | |
| 97 | proced ure SetLog inStr(Str: string); virtual; | |
| 98 | proced ure SetUse rStr(Str: String); | |
| 99 | proced ure S etConnecte d(Value: B oolean); o verride; | |
| 100 | functi on G etConnecte d: Boolean ; | |
| 101 | proced ure S etResults( Value: TSt rings); ov erride; | |
| 102 | proced ure S etClearPar ameters(Va lue: Boole an); overr ide; | |
| 103 | proced ure S etClearRes ults(Value : Boolean) ; override ; | |
| 104 | proced ure S etRPCTimeL imit(Value : integer) ; override ; //Scree n changes to timeout . | |
| 105 | // proc edure SetOnLogo ut(EventHa ndler: TNo tifyEvent) ; | |
| 106 | proced ure S etOnLogout (EventHand ler: TLogo ut); | |
| 107 | functi on G etRpcVersi on:TRpcVer sion; | |
| 108 | proced ure S etRpcVersi on(version : TRpcVers ion); | |
| 109 | functi on Login Str: Strin g; | |
| 110 | { | |
| 111 | proced ure S etRPC(Valu e: TRemote Proc); | |
| 112 | functi on G etRPC: TRe moteProc; | |
| 113 | } | |
| 114 | public | |
| 115 | constr uctor C reate(AOwn er: TCompo nent); ove rride; | |
| 116 | destru ctor D estroy; ov erride; | |
| 117 | // proc edure OnLogoutE ventHandle rDefault(S ender: TOb ject); vir tual; | |
| 118 | proced ure O nLogoutEve ntHandlerD efault; vi rtual; | |
| 119 | proced ure O nConnectio nDroppedHa ndler(Conn ectionInde x: Integer ; ErrorTex t: WideStr ing); virt ual; | |
| 120 | functi on G etBrokerCo nnectionIn dexFromUni queClientI d(UniqueCl ientId: In teger): In teger; | |
| 121 | ||
| 122 | proper ty RPCB Error: Str ing read F RPCBError write FRPC BError; | |
| 123 | proper ty OnRP CBFailure: TOnRPCBFa ilure read FOnRPCBFa ilure writ e FOnRPCBF ailure; | |
| 124 | ||
| 125 | proper ty User: T VistaUser read FUser write FUs er; // jl i | |
| 126 | proper ty Login: TVistaLogi n read FLo gin write FLogin; / / jli | |
| 127 | proper ty OnConne ctionDropp ed: TOnCon nectionDro pped read FOnConnect ionDropped write FOn Connection Dropped; | |
| 128 | { | |
| 129 | proper ty OnClien tConnected : TOnClien tConnected read FOnC lientConne cted write FOnClient Connected; | |
| 130 | proper ty OnClien tDisconnec ted: TOnCl ientDiscon nected rea d FOnClien tDisconnec ted write FOnClientD isconnecte d; | |
| 131 | } | |
| 132 | publishe d | |
| 133 | // Cal l is he in vocation e ntry point of the RP C call. | |
| 134 | // The RPC Name, params, s erver and listener p ort must a ll be set up before | |
| 135 | // mak ing this c all | |
| 136 | proced ure C all; overr ide; | |
| 137 | ||
| 138 | // lst Call is si milar to t he method Call, but puts Resul ts in Outp utBuffer | |
| 139 | // lst Call actua lly calls Call so it is really more effi cient to u se the | |
| 140 | // Cal l method a nd get the results f rom the Re sults prop erty | |
| 141 | proced ure l stCall(Out putBuffer: TStrings) ; override ; | |
| 142 | ||
| 143 | // pch Call makes an RPC ca ll and ret urns the r esults in a PChar; | |
| 144 | // pch Call actua lly calls the Call m ethod and then conve rts the re sults | |
| 145 | // to PChar befo re returni ng. | |
| 146 | // Mak ing a call to Call a nd then us ing the Re sults prop erty to ge t | |
| 147 | // res ults is mo re efficie nt | |
| 148 | functi on p chCall: PC har; overr ide; | |
| 149 | ||
| 150 | // str Call makes an RPC ca ll and ret urns the r esults in a string; | |
| 151 | // str Call actua lly calls the Call m ethod and then conve rts the re sults | |
| 152 | // to a string b efore retu rning. | |
| 153 | // Mak ing a call to Call a nd then us ing the Re sults prop erty to ge t | |
| 154 | // res ults is mo re efficie nt | |
| 155 | functi on s trCall: st ring; over ride; | |
| 156 | ||
| 157 | // Cre ateContext sets up t he context for the R PC call on the M ser ver | |
| 158 | functi on C reateConte xt(strCont ext: strin g): boolea n; overrid e; | |
| 159 | ||
| 160 | ||
| 161 | { | |
| 162 | // Ser ver sets t he server name or di rect IP ad dress | |
| 163 | // Mus t be set B EFORE maki ng the con nection or the defau lt on the system | |
| 164 | // wil l be used | |
| 165 | proper ty S erver: TSe rver read FServer wr ite FServe r; | |
| 166 | } | |
| 167 | // All owShared a llows this connectio n to share with and existing o ne | |
| 168 | // Mus t be set B EFORE maki ng a conne ction | |
| 169 | proper ty A llowShared : Boolean read FAllo wShared wr ite FAllow Shared; | |
| 170 | { | |
| 171 | // Deb ugMode tur ns the deb ug mode on or off. | |
| 172 | // Mus t be set B EFORE maki ng an RPC Call | |
| 173 | proper ty D ebugMode: boolean re ad FDebugM ode write FDebugMode default F alse; | |
| 174 | ||
| 175 | // Lis tenerPort sets the l istener po rt on the server | |
| 176 | // Mus t be set B EFORE maki ng a conne ction | |
| 177 | proper ty L istenerPor t: integer read FLis tenerPort write FLis tenerPort; | |
| 178 | ||
| 179 | // Par am accesse s the para meters for the RPC c all. | |
| 180 | // Set them BEFO RE making the RPC ca ll | |
| 181 | proper ty P aram: TPar ams read F Params wri te FParams ; | |
| 182 | ||
| 183 | // Res ults conta ins the re sults of t he most re cent RPC c all | |
| 184 | proper ty R esults: TS trings rea d FResults write Set Results; | |
| 185 | ||
| 186 | // Rem oteProcedu re sets th e name of the RPC to be made | |
| 187 | // Set this BEFO RE making the Call | |
| 188 | proper ty R emoteProce dure: TRem oteProc re ad FRemote Procedure1 write FRe moteProced ure1; | |
| 189 | // prop erty RemotePro cedure: TR emoteProc read GetRP C write Se tRPC; | |
| 190 | ||
| 191 | // The RpcVersio n property is used t o tell the M server on the oth er end of the RPCBro ker connec tion | |
| 192 | // whi ch version of the RP C call it is expecti ng the M s erver to s ervice. Th is is for the Clien t | |
| 193 | // to specify. | |
| 194 | // Not e: This is NOT the v ersion of the RPCBro ker! | |
| 195 | proper ty R pcVersion: TRpcVersi on read Ge tRpcVersio n write Se tRpcVersio n; | |
| 196 | ||
| 197 | // Cle arParamete rs clears out the pa rams data if set to true so on e can star t over eas ily with | |
| 198 | // new parameter s | |
| 199 | proper ty C learParame ters: bool ean read F ClearParam eters writ e SetClear Parameters ; | |
| 200 | ||
| 201 | // Cle arResults clears out the Resul ts data if set to tr ue. This i s from leg acy code. In | |
| 202 | // the current i mplementat ion the Re sults from a recent call overw rite the c urrent Res ults anywa y. | |
| 203 | proper ty C learResult s: boolean read FCle arResults write SetC learResult s; | |
| 204 | } | |
| 205 | // If Connected is set to True then it makes a BrokerCon nection ca ll to the VistASessi onMgr. | |
| 206 | // prop erty Connected : boolean read FConn ected writ e SetConne cted; | |
| 207 | proper ty Connected: boolean read GetCo nnected wr ite SetCon nected def ault False ; | |
| 208 | ||
| 209 | // RPC TimeLimit allows the applicati on to chan ge the net work opera tion timeo ut prior t o a call. | |
| 210 | // Thi s may be u seful duri ng times w hen it is known that a certain RPC, by i ts nature, | |
| 211 | // can take a si gnificant amount of time to ex ecute. The value of this prope rty is an | |
| 212 | // int eger that can not be less than 30 second s nor grea ter that 3 2767 secon ds. | |
| 213 | // Car e should b e taken wh en alterin g this val ue, since the networ k operatio n will blo ck | |
| 214 | // the applicati on until t he operati on finishe s or the t imeout is triggered. | |
| 215 | proper ty R PCTimeLimi t : intege r read FRP CTimeLimit write Set RPCTimeLim it; | |
| 216 | ||
| 217 | // OnL ogout sets /gets the OnLogout e vent handl er to be c alled when ever the V istASessio nMgr | |
| 218 | // log s out. | |
| 219 | // prop erty OnLogout: TNotifyEv ent read F OnLogout w rite SetOn Logout; | |
| 220 | proper ty O nLogout: T Logout rea d FOnLogou t write Se tOnLogout; | |
| 221 | ||
| 222 | proper ty S ocket: Int eger read FSocket; | |
| 223 | ||
| 224 | proper ty KernelL ogin: Bool ean read F KernelLogi n write FK ernelLogin default T rue; // j li | |
| 225 | ||
| 226 | end; | |
| 227 | ||
| 228 | implementa tion | |
| 229 | ||
| 230 | uses ComOb j, MfunStr , SharedRP CBrokerSin k, fRPCBEr rMsg; | |
| 231 | ||
| 232 | const | |
| 233 | {Keys} | |
| 234 | REG_BROK ER = 'Soft ware\Vista \Broker'; | |
| 235 | REG_VIST A = 'Soft ware\Vista '; | |
| 236 | REG_SIGN ON = 'Soft ware\Vista \Signon'; | |
| 237 | REG_SERV ERS = 'Sof tware\Vist a\Broker\S ervers'; | |
| 238 | ||
| 239 | ||
| 240 | procedure TSharedRPC Broker.Set LoginStr(S tr: string ); | |
| 241 | ||
| 242 | functio n TorF(Val ue: String ): Boolean ; | |
| 243 | begin | |
| 244 | Resul t := False ; | |
| 245 | if Va lue = '1' then | |
| 246 | Res ult := Tru e; | |
| 247 | end; | |
| 248 | const | |
| 249 | SEP_FS = #28; | |
| 250 | SEP_GS = #29; | |
| 251 | var | |
| 252 | DivStr: String; | |
| 253 | StrFS: S tring; | |
| 254 | StrGS: S tring; | |
| 255 | ModeVal: String; | |
| 256 | I: Integ er; | |
| 257 | Division List: TStr ingList; | |
| 258 | begin | |
| 259 | StrFS := SEP_FS; | |
| 260 | StrGS := SEP_GS; | |
| 261 | with FLo gin do | |
| 262 | begin | |
| 263 | LoginH andle := P iece(Str,S trFS,1); | |
| 264 | NTToke n := Piece (Str,StrFS ,2); | |
| 265 | Access Code := Pi ece(Str,St rFS,3); | |
| 266 | Verify Code := Pi ece(Str,St rFS,4); | |
| 267 | Divisi on := Piec e(Str,StrF S,5); | |
| 268 | ModeVa l := Piece (Str,StrFS ,6); | |
| 269 | DivStr := Piece( Str,StrFS, 7); | |
| 270 | MultiD ivision := TorF(Piec e(Str,StrF S,8)); | |
| 271 | DUZ := Piece(Str ,StrFS,9); | |
| 272 | Prompt Division : = TorF(Pie ce(Str,Str FS,10)); | |
| 273 | ErrorT ext := Pie ce(Str,Str FS,11); | |
| 274 | if Mod eVal = '1' then | |
| 275 | Mode := lmAVCo des | |
| 276 | else i f ModeVal = '2' then | |
| 277 | Mode := lmAppH andle | |
| 278 | else i f ModeVal = '3' then | |
| 279 | Mode := lmNTTo ken; | |
| 280 | if Div Str <> '' then | |
| 281 | begin | |
| 282 | Divi sionList : = TStringL ist.Create ; | |
| 283 | try | |
| 284 | I := 1; | |
| 285 | wh ile Piece( DivStr,Str GS,I) <> ' ' do | |
| 286 | be gin | |
| 287 | DivisionLi st.Add(Pie ce(DivStr, StrGS,I)); | |
| 288 | Inc(I); | |
| 289 | en d; // w hile | |
| 290 | Di vList.Assi gn(Divisio nList); | |
| 291 | fina lly | |
| 292 | Di visionList .Free; | |
| 293 | end; | |
| 294 | end; | |
| 295 | end; // with | |
| 296 | end; | |
| 297 | ||
| 298 | procedure TSharedRPC Broker.Set UserStr(St r: String) ; | |
| 299 | const | |
| 300 | SEP_FS = #28; | |
| 301 | var | |
| 302 | VC: Stri ng; | |
| 303 | StrFS: S tring; | |
| 304 | begin | |
| 305 | StrFS := SEP_FS; | |
| 306 | with Us er do | |
| 307 | begin | |
| 308 | DUZ : = Piece(St r,StrFS,1) ; | |
| 309 | Name := Piece(S tr,StrFS,2 ); | |
| 310 | Stand ardName := Piece(Str ,StrFS,3); | |
| 311 | Divis ion := Pie ce(Str,Str FS,4); | |
| 312 | VC := Piece(Str ,StrFS,5); | |
| 313 | Title := Piece( Str,StrFS, 6); | |
| 314 | Servi ceSection := Piece(S tr,StrFS,7 ); | |
| 315 | Langu age := Pie ce(Str,Str FS,8); | |
| 316 | DTime := Piece( Str,StrFS, 9); | |
| 317 | if VC = '0' the n | |
| 318 | Ver ifyCodeChn gd := Fals e | |
| 319 | else if VC = '1 ' then | |
| 320 | Ver ifyCodeChn gd := True ; | |
| 321 | end; // with | |
| 322 | end; | |
| 323 | ||
| 324 | function TSharedRP CBroker.Lo ginStr: st ring; | |
| 325 | functio n TorF1(Va lue: Boole an): Strin g; | |
| 326 | begin | |
| 327 | Resul t := '0'; | |
| 328 | if Va lue then | |
| 329 | Res ult := '1' ; | |
| 330 | end; | |
| 331 | ||
| 332 | const | |
| 333 | SEP_FS = #28; | |
| 334 | SEP_GS = #29; | |
| 335 | var | |
| 336 | Str: Str ing; | |
| 337 | ModeVal: String; | |
| 338 | DivLst: String; | |
| 339 | MultiDiv : String; | |
| 340 | PromptDi v: String; | |
| 341 | StrFS, S trGS: Stri ng; | |
| 342 | begin | |
| 343 | Str := ' '; | |
| 344 | with F Login do | |
| 345 | begin | |
| 346 | StrF S := SEP_F S; | |
| 347 | StrG S := SEP_G S; | |
| 348 | Mode Val := ''; | |
| 349 | if M ode = lmAV Codes then | |
| 350 | Mo deVal := ' 1' | |
| 351 | else if Mode = lmAppHand le then | |
| 352 | Mo deVal := ' 2' | |
| 353 | else if Mode = lmNTToken then | |
| 354 | Mo deVal := ' 3'; | |
| 355 | DivL st := ''; | |
| 356 | Mult iDiv := To rF1(MultiD ivision); | |
| 357 | Prom ptDiv := T orF1(Promp tDivision) ; | |
| 358 | Str := LoginHa ndle + Str FS + NTTok en + StrFS + AccessC ode + StrF S; | |
| 359 | Str := Str + V erifyCode + StrFS + Division + StrFS + M odeVal + S trFS; | |
| 360 | Str := Str + D ivLst + St rFS + Mult iDiv + Str FS + DUZ + StrFS; | |
| 361 | Str := Str + P romptDiv + StrFS + E rrorText + StrFS; | |
| 362 | end; // with | |
| 363 | Result : = Str; | |
| 364 | end; | |
| 365 | // Const ructor and Destructo r implemen ted here | |
| 366 | constructo r TSharedR PCBroker.C reate(AOwn er: TCompo nent); | |
| 367 | const | |
| 368 | ProgID = 'RPCShare dBrokerSes sionMgr.Ap plication' ; | |
| 369 | //var | |
| 370 | // broker Error: ISh aredBroker ErrorCode; | |
| 371 | // regRes ult: WideS tring; | |
| 372 | begin | |
| 373 | inherite d Create(A Owner); | |
| 374 | FConnect ed := Fals e; | |
| 375 | DebugMod e := False ; | |
| 376 | FParams := TParams .Create(Se lf); | |
| 377 | // FResul ts := TStr ingList.Cr eate; | |
| 378 | RpcVersi on := '0'; | |
| 379 | FCurrRpc Version := '0'; | |
| 380 | FRPCTime Limit := M IN_RPCTIME LIMIT; // MI N_RPCTIMEL IMIT comes from TRPC Broker (30 seconds) | |
| 381 | // FAllow Shared := False; | |
| 382 | FOnLogou t := OnLog outEventHa ndlerDefau lt; // Su pply this one incase the appli cation doe sn't | |
| 383 | FOnConne ctionDropp ed := OnCo nnectionDr oppedHandl er; | |
| 384 | Server : = ''; | |
| 385 | Listener Port := 0; | |
| 386 | ||
| 387 | FKernelL ogin := Tr ue; // jl i | |
| 388 | FUser := TVistaUse r.Create; // jli | |
| 389 | FLogin : = TVistaLo gin.Create (Self); / / jli | |
| 390 | ||
| 391 | // CoInit ialize(nil ); | |
| 392 | { try | |
| 393 | if not (CoInitia lize(nil) = S_OK) th en | |
| 394 | Show Message('C oInitializ e Problem! '); | |
| 395 | except | |
| 396 | end; | |
| 397 | } | |
| 398 | end; | |
| 399 | ||
| 400 | destructor TSharedRP CBroker.De stroy; | |
| 401 | begin | |
| 402 | if Conne cted then // FConne cted | |
| 403 | begin | |
| 404 | Connec ted := Fal se; | |
| 405 | FConne cted := Fa lse; | |
| 406 | end; | |
| 407 | FParams. Free; | |
| 408 | FParams := nil; | |
| 409 | { | |
| 410 | FResults .Free; | |
| 411 | FResults := nil; | |
| 412 | } | |
| 413 | if FVist aSession < > nil then | |
| 414 | begin | |
| 415 | // FVis taSession. Free; | |
| 416 | FVista Session := nil; | |
| 417 | end; | |
| 418 | { | |
| 419 | FUser.Fr ee; | |
| 420 | FLogin.F ree; | |
| 421 | } | |
| 422 | inherite d; | |
| 423 | end; | |
| 424 | ||
| 425 | //procedur e TSharedR PCBroker.O nLogoutEve ntHandlerD efault(Sen der: TObje ct); | |
| 426 | procedure TSharedRPC Broker.OnL ogoutEvent HandlerDef ault; | |
| 427 | begin | |
| 428 | // This event hand ler will g et called if the app lication t hat uses | |
| 429 | // this component does not s upply one. | |
| 430 | SendMess age(Applic ation.Main Form.Handl e,WM_CLOSE ,0,0); | |
| 431 | end; | |
| 432 | ||
| 433 | procedure TSharedRPC Broker.OnC onnectionD roppedHand ler(Connec tionIndex: Integer; ErrorText: WideStrin g); | |
| 434 | var | |
| 435 | Str: Str ing; | |
| 436 | // Broker Error: EBr okerError; | |
| 437 | begin | |
| 438 | Str := E rrorText; | |
| 439 | RPCBShow ErrMsg(Err orText); | |
| 440 | // FConne cted := Fa lse; | |
| 441 | // Raisi ng an erro r here ret urns an er ror 'The S erver Thre w an excep tion' back into the server | |
| 442 | // Broker Error := E BrokerErro r.Create(S tr); | |
| 443 | // raise BrokerErro r; | |
| 444 | end; | |
| 445 | ||
| 446 | // Publish ed Methods implement ed here | |
| 447 | procedure TSharedRPC Broker.Cal l; | |
| 448 | const | |
| 449 | SEP_FS = #28; | |
| 450 | SEP_GS = #29; | |
| 451 | SEP_US = #30; | |
| 452 | SEP_RS = #31; | |
| 453 | var | |
| 454 | i, j, Er rCode: Int eger; | |
| 455 | rpcParam s, ASub, A Val: strin g; | |
| 456 | Returned Results: W ideString; | |
| 457 | AnError: EBrokerEr ror; | |
| 458 | ErrCode1 : ISharedB rokerError Code; | |
| 459 | begin | |
| 460 | try | |
| 461 | rpcParam s := ''; | |
| 462 | if not C onnected t hen Connec ted := Tru e; | |
| 463 | for i := 0 to Pred (Param.Cou nt) do | |
| 464 | begin | |
| 465 | case P aram[i].PT ype of | |
| 466 | lite ral: rpcPa rams := rp cParams + 'L' + SEP_ FS; | |
| 467 | refere nce: rpcPa rams := rp cParams + 'R' + SEP_ FS; | |
| 468 | l ist: rpcPa rams := rp cParams + 'M' + SEP_ FS; | |
| 469 | else rpcPa rams := rp cParams + 'U' + SEP_ FS; | |
| 470 | end; { case} | |
| 471 | if Par am[i].PTyp e = list t hen | |
| 472 | begin | |
| 473 | for j := 0 to Pred(Param [i].Mult.C ount) do | |
| 474 | begi n | |
| 475 | AS ub := Para m[i].Mult. Subscript( j); | |
| 476 | AV al := Para m[i].Mult[ ASub]; | |
| 477 | rp cParams := rpcParams + ASub + SEP_US + A Val + SEP_ RS; | |
| 478 | end; | |
| 479 | rpcP arams := r pcParams + SEP_GS; | |
| 480 | end el se | |
| 481 | begin | |
| 482 | rpcP arams := r pcParams + Param[i]. Value + SE P_GS; | |
| 483 | end; { if Param[i ]...else} | |
| 484 | end; {fo r i} | |
| 485 | if RpcVe rsion <> F CurrRpcVer sion then | |
| 486 | FVista Session.Se t_RPCVersi on(RPCVers ion); | |
| 487 | ||
| 488 | RPCBErro r := ''; | |
| 489 | ||
| 490 | ErrCode1 := FVista Session.Br okerCall(R emoteProce dure, rpcP arams, RPC TimeLimit, ReturnedR esults, Er rCode); | |
| 491 | ||
| 492 | if Clear Parameters = true th en | |
| 493 | Param. Clear; | |
| 494 | ||
| 495 | if ErrCo de1 = Succ ess then | |
| 496 | Result s.Text := ReturnedRe sults | |
| 497 | else | |
| 498 | begin | |
| 499 | Result s.Text := ''; | |
| 500 | RPCBEr ror := FVi staSession .RpcbError ; | |
| 501 | if Ass igned(FOnR PCBFailure ) then // p13 | |
| 502 | FOnR PCBFailure (Self) // p13 | |
| 503 | else i f ShowErro rMsgs = se mRaise the n | |
| 504 | begin | |
| 505 | AnEr ror := EBr okerError. Create(FRP CBError); | |
| 506 | rais e AnError; | |
| 507 | end | |
| 508 | else | |
| 509 | exit ; | |
| 510 | end; {if ErrCode.. .else} | |
| 511 | except | |
| 512 | on e: Exception do | |
| 513 | begin | |
| 514 | AnEr ror := EBr okerError. Create('Er ror: ' + e .Message); | |
| 515 | rais e AnError; | |
| 516 | end; | |
| 517 | end; | |
| 518 | end; | |
| 519 | ||
| 520 | function T SharedRPCB roker.Crea teContext( strContext : string): boolean; | |
| 521 | var | |
| 522 | Intval: Integer; | |
| 523 | begin | |
| 524 | // hides the RPCBr oker Creat eContext | |
| 525 | if not C onnected t hen SetCon nected(TRU E); // FC onnected | |
| 526 | ||
| 527 | Intval : = FVistaSe ssion.Brok erSetConte xt(strCont ext); | |
| 528 | Result : = Intval = 1; | |
| 529 | end; | |
| 530 | ||
| 531 | procedure TSharedRPC Broker.lst Call(Outpu tBuffer: T Strings); | |
| 532 | begin | |
| 533 | Call; | |
| 534 | OutputBu ffer.Text := Results .Text; | |
| 535 | end; | |
| 536 | ||
| 537 | function T SharedRPCB roker.pchC all: PChar ; | |
| 538 | begin | |
| 539 | Call; | |
| 540 | Result : = Results. GetText; | |
| 541 | end; | |
| 542 | ||
| 543 | function T SharedRPCB roker.strC all: strin g; | |
| 544 | begin | |
| 545 | Call; | |
| 546 | Result : = Results. Text; | |
| 547 | end; | |
| 548 | ||
| 549 | procedure TSharedRPC Broker.Set Connected( Value: Boo lean); | |
| 550 | var | |
| 551 | uniqueCl ientId: In teger; | |
| 552 | brokerEr ror: IShar edBrokerEr rorCode; | |
| 553 | regResul t: WideStr ing; | |
| 554 | CurrWind ow: HWND; | |
| 555 | AnError: EBrokerEr ror; | |
| 556 | UserStr: String; | |
| 557 | RPCError : WideStri ng; | |
| 558 | BrokerEr rorVal: EB rokerError ; | |
| 559 | ShowErrM sgs: IShar edBrokerSh owErrorMsg s; | |
| 560 | LoginStr X: WideStr ing; | |
| 561 | SBSink: TSharedRPC BrokerSink ; | |
| 562 | begin | |
| 563 | try | |
| 564 | { call c onnect met hod for Vi staSession } | |
| 565 | if Value then | |
| 566 | begin | |
| 567 | if FVi staSession = nil the n | |
| 568 | begin | |
| 569 | FVis taSession := CreateC omObject(C LASS_Share dBroker) a s ISharedB roker; // TSharedBr oker.Creat e(self); | |
| 570 | // FV istaSessio n.Connect; | |
| 571 | //No nee d to keep hold of ev ent sink. It will be destroyed | |
| 572 | //throug h interfac e referenc e counting when the client | |
| 573 | //discon nects from the serve r in the f orm's OnDe stroy even t handler | |
| 574 | SBSi nk := TSha redRPCBrok erSink.Cre ate; | |
| 575 | SBSi nk.Broker := Self; | |
| 576 | Inte rfaceConne ct(FVistaS ession, IS haredBroke rEvents, S BSink, FSi nkCookie); | |
| 577 | ||
| 578 | // Co nnectEvent s(FVistaSe ssion); | |
| 579 | { If Assigned(F OnLogout) then | |
| 580 | FV istaSessio n.OnLogout := FOnLog out; | |
| 581 | if A ssigned(FO nConnectio nDropped) then | |
| 582 | FV istaSessio n.OnConnec tionDroppe d := OnCon nectionDro ppedHandle r; | |
| 583 | } | |
| 584 | regR esult := ' '; | |
| 585 | brok erError := FVistaSes sion.ReadR egDataDefa ult(HKLM,R EG_BROKER, 'ClearPara meters','1 ',regResul t); | |
| 586 | Asse rt(brokerE rror = Suc cess); | |
| 587 | ||
| 588 | Clea rParameter s := boole an(StrToIn t(regResul t)); // F ClearParam eters | |
| 589 | ||
| 590 | brok erError := FVistaSes sion.ReadR egDataDefa ult(HKLM,R EG_BROKER, 'ClearResu lts','1',r egResult); | |
| 591 | Asse rt(brokerE rror = Suc cess); | |
| 592 | Clea rResults : = boolean( StrToInt(r egResult)) ; // FCle arResults | |
| 593 | ||
| 594 | // De bugMode := False; | |
| 595 | // FPa rams := TP arams.Crea te(Self); | |
| 596 | // FR esults := TStringLis t.Create; ??? | |
| 597 | ||
| 598 | if S erver = '' then | |
| 599 | begi n | |
| 600 | br okerError := FVistaS ession.Rea dRegDataDe fault(HKLM ,REG_BROKE R,'Server' ,'BROKERSE RVER',regR esult); | |
| 601 | As sert(broke rError = S uccess); | |
| 602 | Se rver := re gResult; | |
| 603 | end; | |
| 604 | ||
| 605 | if L istenerPor t = 0 then | |
| 606 | begi n | |
| 607 | brokerErro r := FVist aSession.R eadRegData Default(HK LM,REG_BRO KER,'Liste nerPort',' PORT ',regResul t); | |
| 608 | As sert(broke rError = S uccess); | |
| 609 | Li stenerPort := StrToI nt(regResu lt); | |
| 610 | end; | |
| 611 | ||
| 612 | RpcV ersion := '0'; // T ODO: Remov e this whe n the prop erty is re move. It i s UESLESS! | |
| 613 | ||
| 614 | // FR PCTimeLimi t := MIN_R PCTIMELIMI T; // MIN _RPCTIMELI MIT comes from TRPCB roker (30 seconds) | |
| 615 | // Al lowShared := True; | |
| 616 | end; | |
| 617 | ||
| 618 | if FCo nnected <> True then // FConn ected | |
| 619 | begin | |
| 620 | // Co nnect to t he M serve r through the COm Se rver | |
| 621 | Curr Window := GetActiveW indow; | |
| 622 | if A ccessVerif yCodes <> '' then // p13 han dle as AVC ode single signon | |
| 623 | begi n | |
| 624 | Lo gin.Access Code := Pi ece(Access VerifyCode s, ';', 1) ; | |
| 625 | Lo gin.Verify Code := Pi ece(Access VerifyCode s, ';', 2) ; | |
| 626 | Lo gin.Mode : = lmAVCode s; | |
| 627 | FK ernelLogIn := False; | |
| 628 | end; | |
| 629 | if S howErrorMs gs = semRa ise then | |
| 630 | Sh owErrMsgs := isemRai se | |
| 631 | else | |
| 632 | Sh owErrMsgs := isemQui et; | |
| 633 | Brok erError := GeneralFa ilure; | |
| 634 | Logi nStrX := W ideString( LoginStr); | |
| 635 | try | |
| 636 | br okerError := FVistaS ession.Bro kerConnect (ParamStr( 0),BrokerC lient,Serv er + ':' + IntToStr( ListenerPo rt), | |
| 637 | D ebugMode, FAllowShar ed, FKerne lLogin, Sh owErrMsgs, RPCTimeLi mit, Login StrX, uniq ueClientId , RPCError ); | |
| 638 | exce pt | |
| 639 | end; | |
| 640 | FRPC BError := RPCError; | |
| 641 | SetL oginStr(Lo ginStrX); | |
| 642 | Show Applicatio nAndFocusO K(Applicat ion); | |
| 643 | SetF oregroundW indow(Curr Window); | |
| 644 | if b rokerError = Success then | |
| 645 | begi n | |
| 646 | FC onnected : = True; / / FConnect ed | |
| 647 | FS ocket := 1 ; // temp orarily ha ndle socke t until it can be pu lled from Shared Bro ker; | |
| 648 | Us erStr := F VistaSessi on.User; | |
| 649 | Se tUserStr(U serStr); | |
| 650 | end | |
| 651 | else | |
| 652 | begi n | |
| 653 | if Assigned( FOnRPCBFai lure) then // p13 | |
| 654 | FOnRPCBF ailure(Sel f) / / p13 | |
| 655 | el se if Show ErrorMsgs = semRaise then | |
| 656 | be gin | |
| 657 | BrokerErro rVal := EB rokerError .Create(FR PCBError); | |
| 658 | raise Brok erErrorVal ; | |
| 659 | en d; | |
| 660 | end; | |
| 661 | end; | |
| 662 | ||
| 663 | end else | |
| 664 | begin | |
| 665 | if FVi staSession <>nil then | |
| 666 | begin | |
| 667 | if F Connected = true the n // FCon nected | |
| 668 | begi n | |
| 669 | // Lets make the OnLog out event handler ni l to elimi nate | |
| 670 | // circulari ty problem s before w e do the d isconnects . | |
| 671 | On Logout := nil; | |
| 672 | ||
| 673 | FV istaSessio n.BrokerDi sconnect; // Discon nect from the Broker | |
| 674 | // FVistaSess ion.Discon nect; // Disc onnect fro m the COM server | |
| 675 | FS ocket := 0 ; // tem porarily h andle sock et until i t can be p ulled from Shared Br oker | |
| 676 | end; | |
| 677 | // FV istaSessio n.Free; | |
| 678 | Inte rfaceDisco nnect(FVis taSession, ISharedBr okerEvents , FSinkCoo kie); | |
| 679 | FVis taSession := nil; | |
| 680 | end; | |
| 681 | FConne cted := Fa lse; // FC onnected | |
| 682 | end; | |
| 683 | except | |
| 684 | on e: Exception do | |
| 685 | begin | |
| 686 | AnEr ror := EBr okerError. Create('Er ror: ' + e .Message); | |
| 687 | rais e AnError; | |
| 688 | end; | |
| 689 | end; | |
| 690 | end; | |
| 691 | ||
| 692 | procedure TSharedRPC Broker.Set Results(Va lue: TStri ngs); | |
| 693 | begin | |
| 694 | Results. Assign(Val ue); // F Results | |
| 695 | end; | |
| 696 | ||
| 697 | procedure TSharedRPC Broker.Set ClearParam eters(Valu e: Boolean ); | |
| 698 | begin | |
| 699 | if Value then Para m.Clear; // FParams | |
| 700 | FClearPa rameters : = Value; // FClearP arameters | |
| 701 | end; | |
| 702 | ||
| 703 | procedure TSharedRPC Broker.Set ClearResul ts(Value: Boolean); | |
| 704 | begin | |
| 705 | if Value then Resu lts.Clear; // FResu lts | |
| 706 | FClearRe sults := V alue; // F ClearResul ts | |
| 707 | end; | |
| 708 | ||
| 709 | procedure TSharedRPC Broker.Set RPCTimeLim it(Value: integer); | |
| 710 | begin | |
| 711 | if Value <> RPCTim eLimit the n // FRPC TimeLimit | |
| 712 | if Val ue > MIN_R PCTIMELIMI T then | |
| 713 | FRPC TimeLimit := Value // FRPCTim eLimit | |
| 714 | else | |
| 715 | FRPC TimeLimit := MIN_RPC TIMELIMIT; // FRPCT imeLimit | |
| 716 | end; | |
| 717 | ||
| 718 | //procedur e TSharedR PCBroker.S etOnLogout (EventHand ler: TNoti fyEvent); | |
| 719 | procedure TSharedRPC Broker.Set OnLogout(E ventHandle r: TLogout ); | |
| 720 | begin | |
| 721 | FOnLogou t := Event Handler; | |
| 722 | // if FVi staSession <> nil th en | |
| 723 | // FVis taSession. OnLogout : = FOnLogou t; | |
| 724 | end; | |
| 725 | ||
| 726 | function TSharedRPC Broker.Get RpcVersion : TRpcVers ion; | |
| 727 | begin | |
| 728 | if FVist aSession < > nil then Result := FVistaSes sion.RPCVe rsion else Result := '0'; | |
| 729 | end; | |
| 730 | ||
| 731 | procedure TSharedRP CBroker.Se tRpcVersio n(version: TRpcVersi on); | |
| 732 | begin | |
| 733 | if FVist aSession < > nil then FVistaSes sion.RPCVe rsion:= ve rsion; | |
| 734 | end; | |
| 735 | ||
| 736 | function T SharedRPCB roker.GetC onnected: Boolean; | |
| 737 | begin | |
| 738 | Result : = FConnect ed; | |
| 739 | end; | |
| 740 | ||
| 741 | { | |
| 742 | procedure TSharedRPC Broker.Set RPC(Value: TRemotePr oc); | |
| 743 | begin | |
| 744 | RemotePr ocedure := Value; | |
| 745 | end; | |
| 746 | ||
| 747 | function T SharedRPCB roker.GetR PC: TRemot eProc; | |
| 748 | begin | |
| 749 | Result : = FRemoteP rocedure1; | |
| 750 | end; | |
| 751 | } | |
| 752 | { | |
| 753 | procedure Register; | |
| 754 | begin | |
| 755 | Register Components ('Kernel', [TSharedB rokerDataC ollector]) ; | |
| 756 | end; | |
| 757 | } | |
| 758 | ||
| 759 | function T SharedRPCB roker.GetB rokerConne ctionIndex FromUnique ClientId(U niqueClien tId: Integ er): Integ er; | |
| 760 | var | |
| 761 | Connecti onIndex: I nteger; | |
| 762 | begin | |
| 763 | Connecti onIndex := -1; | |
| 764 | if FVist aSession < > nil then | |
| 765 | FVista Session.Ge tActiveBro kerConnect ionIndexFr omUniqueCl ientId(Uni queClientI d, Connect ionIndex); | |
| 766 | Result : = Connecti onIndex; | |
| 767 | end; | |
| 768 | ||
| 769 | end. |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.