Produced by Araxis Merge on 3/22/2018 8:25:51 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\Components | uROR_Broker.pas | Thu Mar 15 14:55:21 2018 UTC |
| 2 | Build_3_Patch_32_Jan_2018.zip\Components | uROR_Broker.pas | Mon Mar 19 14:04:02 2018 UTC |
| Description | Between Files 1 and 2 |
|
|---|---|---|
| Text Blocks | Lines | |
| Unchanged | 2 | 1954 |
| 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 | { Package: Clin ical Case Registries Custom Co mponents } | |
| 3 | { Date Cre ated: Janu ary 26, 20 07 } | |
| 4 | { Site Nam e: Hine s OIFO } | |
| 5 | { Develope rs: Serg ey Gavrilo v } | |
| 6 | { Descript ion: Wrap per for a VistA RPC Broker. } | |
| 7 | { Note: } | |
| 8 | {********* ********** ********** ********** ********** ********** ********** *********} | |
| 9 | ||
| 10 | unit uROR_ Broker; | |
| 11 | ||
| 12 | {$I Compon ents.inc} | |
| 13 | ||
| 14 | interface | |
| 15 | ||
| 16 | uses | |
| 17 | SysUtils , Classes, Forms, Di alogs, Co ntnrs, Con trols, TRP CB,CCOWRPC Broker, | |
| 18 | uROR_Cus tomContext or, uROR_C mdLinePara ms, uROR_C ustomBroke r; | |
| 19 | ||
| 20 | type | |
| 21 | TCCRVist ABrokerSta te = class ; | |
| 22 | ||
| 23 | {======= ========== ========== ====== TCC RBroker == ========== ========== ========== | |
| 24 | Overvi ew: Wr apper for the VistA RPC Broker . | |
| 25 | Descri ption: | |
| 26 | TCCR Broker is a wrapper for the Vi stA RPC Br oker. It e ncapsulate s broker | |
| 27 | impl emetation details an d provides mechanism s for erro r processi ng and | |
| 28 | repo rting, deb ug logging , and appl ication co mmand-line parameter s | |
| 29 | proc essing. | |
| 30 | } | |
| 31 | TCCRBrok er = class (TCCRCusto mBroker) | |
| 32 | private | |
| 33 | ||
| 34 | fConte xtor: TCCRCusto mContextor ; | |
| 35 | fConte xtStack: TStack; | |
| 36 | fDefau ltResults: TStringLi st; | |
| 37 | fListe nerPort: Integer; | |
| 38 | fRPCBr oker: TRPCBroke r; | |
| 39 | fRPCon text: String; | |
| 40 | fSaved State: TCCRVistA BrokerStat e; | |
| 41 | fServe r: String; | |
| 42 | ||
| 43 | functi on GetCmd LineParams : TCCRCmdL ineParams; | |
| 44 | proced ure SetCon textor(aVa lue: TCCRC ustomConte xtor); | |
| 45 | proced ure SetCmd LineParams (aValue: T CCRCmdLine Params); | |
| 46 | proced ure SetLis tenerPort( const aVal ue: Intege r); | |
| 47 | proced ure SetRPC Broker(aVa lue: TRPCB roker); | |
| 48 | proced ure SetRPC ontext(con st aName: String); | |
| 49 | proced ure SetSer ver(const aValue: St ring); | |
| 50 | ||
| 51 | protecte d | |
| 52 | ||
| 53 | {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | |
| 54 | Over view: Checks com mand-line parameters and modif ies broker | |
| 55 | properties according ly. | |
| 56 | SeeA lso: TCCRBroker .CmdLinePa rams | |
| 57 | Keyw ords: CheckCmdLi neParams,T CCRBroker | |
| 58 | Desc ription: | |
| 59 | If the CmdLi neParams p roperty re ferences a descendan t of | |
| 60 | TC CRCustomCm dLineParam s, the Che ckCmdLineP arams meth od analyse s | |
| 61 | th e applicat ion's comm and-line p arameters specified by a user and | |
| 62 | mo difies val ues of bro ker proper ties accor dingly. | |
| 63 | <p > | |
| 64 | As implement ed in TCCR Broker, Ch eckCmdLine Params upd ates the | |
| 65 | Li stenerPort and Serve r properti es. | |
| 66 | } | |
| 67 | proced ure CheckC mdLinePara ms; overri de; | |
| 68 | ||
| 69 | {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | |
| 70 | Over view: Protected implementa tion of th e CheckPro cError met hod. | |
| 71 | SeeA lso: TCCRCustom Broker.Che ckProcErro r; | |
| 72 | TCCRCustom Broker.DoC heckProcEr ror; | |
| 73 | TCCRCustom Broker.OnC heckProcEr ror | |
| 74 | Keyw ords: DoCheckPro cError,TCC RBroker | |
| 75 | Desc ription: | |
| 76 | TC CRBroker o verrides D oCheckProc Error to i mplement t he error p rocessing | |
| 77 | an d reportin g used by the CCR re mote proce dures. Inf ormation a bout the | |
| 78 | re mote proce dure call and its re sults are passed via the <i>Ca llInfo</i> | |
| 79 | pa rameter. | |
| 80 | <P > | |
| 81 | A negative v alue of th e first "^ "-piece of the Resul ts[0] indi cates that | |
| 82 | an error occ urred duri ng the exe cution of the remote procedure . In this | |
| 83 | ca se, the se cond piece of the Re sults[0] c ontains nu mber of er ror | |
| 84 | de scriptors returned i n the subs equent ele ments of t he Results array. | |
| 85 | <p > | |
| 86 | Su bsequent R esults ele ments stor e error co de, error message, a nd error | |
| 87 | lo cation sep arated by "^". They are return ed in reve rse chrono logical | |
| 88 | or der (most recent err or first). | |
| 89 | <p > | |
| 90 | As implement ed in TCCR Broker, Do CheckProcE rror analy zes the re sults and | |
| 91 | ad ds error d escriptors to the in ternal err ros list ( Errros pro perty of | |
| 92 | th e <i>CallI nfo</i>). It also as signs the primary er ror code ( value of | |
| 93 | th e first "^ "-piece of the Resul s[0]) to t he ErrorCo de propert y of the | |
| 94 | <i >CallInfo< /i>. At th e same tim e, rpeProc edure is a ssigned to the | |
| 95 | Er rorType. | |
| 96 | } | |
| 97 | proced ure DoChec kProcError (CallInfo: TCCRBroke rCallInfo) ; override ; | |
| 98 | ||
| 99 | {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | |
| 100 | Over view: Protected implementa tion of th e Connect method. | |
| 101 | SeeA lso: TCCRCustom Broker.Cmd LineParams ; TCCRCust omBroker.C onnect; | |
| 102 | TCCRCustom Broker.DoC onnect; TC CRBroker.R PCBroker | |
| 103 | Keyw ords: DoConnect, TCCRBroker | |
| 104 | Desc ription: | |
| 105 | Do not call DoConnect directly; override i t to estab lish a con nection | |
| 106 | to a main ap plication server. If the conne ction is s uccesfully open, | |
| 107 | th is method should ret urn True. Otherwise, False sho uld be ret urned. | |
| 108 | <p > | |
| 109 | As implement ed in TCCR Broker, If the conne ction poin t (the Lis tenerPort | |
| 110 | an d Server p roperties) is not sp ecified, t he DoConne ct calls t he | |
| 111 | Ge tServerInf o procedur e to get t he server name/IP ad dress and port | |
| 112 | nu mber or le t the user select th em. | |
| 113 | <p > | |
| 114 | If an existi ng VistA R PC broker has not be en assigne d to the R PCBroker | |
| 115 | pr operty, th e wrapper creates a new instan ce of the TCCOWRPCBr oker and | |
| 116 | in itializes its proper ties. | |
| 117 | <p > | |
| 118 | If the compo nents are compiled w ith the CC RDEBUG sym bol, then an | |
| 119 | ad ditional ' -av' comma nd-line pa rameters i s supporte d. It allo ws to | |
| 120 | sp ecify acce ss and ver ify codes separated by semicol on. <u>Thi s | |
| 121 | pa rameter is indended for debugg ing only ( specify th e paramete r on the | |
| 122 | Ru n Paramete rs dialog box); you must not d istribute applicatio ns | |
| 123 | co mpiled lik e this!</u > | |
| 124 | <p > | |
| 125 | Th en, DoConn ect tries to connect the RPC b roker to t he server. If an | |
| 126 | er ror occurs , this met hod displa ys an appr oriate err or message and | |
| 127 | re turns Fals e. Otherwi se, True i s returned . | |
| 128 | } | |
| 129 | functi on DoConne ct: Boolea n; overrid e; | |
| 130 | ||
| 131 | {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | |
| 132 | Over view: Protected implementa tion of th e Disconne ct method. | |
| 133 | SeeA lso: TCCRCustom Broker.Dis connect; T CCRCustomB roker.DoDi sconnect; | |
| 134 | TCCRBroker .RPCBroker | |
| 135 | Keyw ords: DoDisconne ct,TCCRBro ker | |
| 136 | Desc ription: | |
| 137 | Do not call DoDisconne ct directl y; overrid e it to cl ose a conn ection to | |
| 138 | a main appli cation ser ver. As im plemented in TCCRBro ker, DoDis connect | |
| 139 | di sconnects the VistA RPC broker reference d by the R PCBroker p roperty | |
| 140 | fr om the ser ver. | |
| 141 | } | |
| 142 | proced ure DoDisc onnect; ov erride; | |
| 143 | ||
| 144 | {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | |
| 145 | Over view: Returns th e value of the Conne cted prope rty. | |
| 146 | SeeA lso: TCCRCustom Broker.Con nected; TC CRCustomBr oker.GetCo nnected; | |
| 147 | TCCRBroker .RPCBroker | |
| 148 | Keyw ords: GetConnect ed,TCCRBro ker | |
| 149 | Desc ription: | |
| 150 | If the RPCBr oker prope rty is not nil, GetC onnected r eturns the value of | |
| 151 | th e Connecte d property of the re ferenced V istA RPC b roker. Oth erwise, | |
| 152 | Fa lse is ret urned. | |
| 153 | } | |
| 154 | functi on GetConn ected: Boo lean; over ride; | |
| 155 | ||
| 156 | {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | |
| 157 | Over view: Returns th e value of the Resul ts propert y. | |
| 158 | SeeA lso: TCCRCustom Broker.Cre ateResults ; TCCRCust omBroker.G etResults; | |
| 159 | TCCRCustom Broker.Res ults | |
| 160 | Keyw ords: GetResults ,TCCRBroke r | |
| 161 | Desc ription: | |
| 162 | As implement ed in TCCR Broker, Ge tResults c alls the i nherited m ethod and | |
| 163 | re turns its resul if i t is not n il (a buff er from th e top of t he buffer | |
| 164 | st ack). Othe rwise, the default i nternal bu ffer is re turned. | |
| 165 | } | |
| 166 | functi on GetResu lts: TStri ngs; overr ide; | |
| 167 | ||
| 168 | {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | |
| 169 | Over view: Responds t o notifica tions that component s are bein g created | |
| 170 | or destroy ed. | |
| 171 | SeeA lso: TCCRCustom Broker.Not ification | |
| 172 | Keyw ords: Notificati on,TCCRBro ker | |
| 173 | Desc ription: | |
| 174 | Do not call the Notifi cation met hod in an applicatio n. Notifi cation is | |
| 175 | ca lled autom atically w hen the co mponent sp ecified by <i>aCompo nent</i> | |
| 176 | is about to be inserte d or remov ed, as spe cified by <i>Operati on</i>. | |
| 177 | <p > | |
| 178 | TC CRBroker o verrides t his method in order to update its Contex tor and | |
| 179 | RP CBroker pr operties w hen contro ls they re fer to are destroyed . | |
| 180 | } | |
| 181 | proced ure Notifi cation(aCo mponent: T Component; | |
| 182 | Oper ation: TOp eration); override; | |
| 183 | ||
| 184 | public | |
| 185 | ||
| 186 | {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | |
| 187 | Over view: Creates an d initiali zes an ins tance of T CCRBroker. | |
| 188 | SeeA lso: TCCRCustom Broker.Cre ate | |
| 189 | Keyw ords: Create,TCC RBroker | |
| 190 | Desc ription: | |
| 191 | Cr eate initi alizes an instance o f the TCCR Broker. <i >anOwner</ i> is the | |
| 192 | co mponent, t ypically a form, tha t is respo nsible for freeing t he broker. | |
| 193 | } | |
| 194 | constr uctor Crea te(anOwner : TCompone nt); overr ide; | |
| 195 | ||
| 196 | {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | |
| 197 | Over view: Destroys a n instance of TCCRBr oker. | |
| 198 | SeeA lso: TCCRCustom Broker.Des troy; TObj ect.Free | |
| 199 | Keyw ords: Destroy,TC CRBroker | |
| 200 | Desc ription: | |
| 201 | Do not call Destroy di rectly in an applica tion. Inst ead, call Free. | |
| 202 | Fr ee verifie s that the component is not ni l, and onl y then cal ls Destroy . | |
| 203 | <p > | |
| 204 | Ap plications should on ly free co mponents e xplicitly when the c onstructor | |
| 205 | wa s called w ithout ass igning an owner to t he compone nt. | |
| 206 | } | |
| 207 | destru ctor Destr oy; overri de; | |
| 208 | ||
| 209 | {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | |
| 210 | Over view: Calls a re mote proce dure. | |
| 211 | SeeA lso: TCCRCustom Broker.Cal lProc; TCC RCustomBro ker.DebugL og; | |
| 212 | TCCRCustom Broker.Def aultProcMo de; TCCRBr oker.Resul ts | |
| 213 | Keyw ords: CallProc,T CCRBroker | |
| 214 | Desc ription: | |
| 215 | Th is overloa ded versio n of CallP roc execut es a remot e procedur e specifie d | |
| 216 | by the Proce dureName p roperty of the <i>Ca llInfo</i> with stri ng values | |
| 217 | pa ssed in th e <i>Param eters</i> array and content of the optio nal | |
| 218 | <i >MultList< /i> string list as p arameters. | |
| 219 | <p > | |
| 220 | Th e ProcMode property of the <i> CallInfo</ i> specifi es flags t hat | |
| 221 | co ntrol the execution and error processing . If it in cludes rpc Default, | |
| 222 | th en the val ue of the DefaultPro cMode prop erty of th e broker i s assigned | |
| 223 | to it before calling t he procedu re. | |
| 224 | <p > | |
| 225 | Pr ocedure re sults are returned i nto a TStr ings insta nce (usual ly a | |
| 226 | TS tringList) reference d by the R esults pro perty of t he <i>Call Info</i>. | |
| 227 | If it is nil , a buffer reference d by the R esults pro perty of t he broker | |
| 228 | is assigned to the it before cal ling the p rocedure. | |
| 229 | <p > | |
| 230 | As implement ed in TCCR Broker, Ca llProc tra nslates pa rameters i nto VistA | |
| 231 | RP C broker's format, d elegates t he procedu re call to the VistA RPC | |
| 232 | br oker refer enced by t he RPCBrok er propert y, and pro cesses the errors if | |
| 233 | th ey occur. | |
| 234 | <p > | |
| 235 | St ring value s from the <i>Parame ters</i> a rray are a dded to th e Param | |
| 236 | ar ray of the VistA RPO C broker ( starting f rom 0 and in the sam e order). | |
| 237 | If a value s tarts from "@", it i s consider ed as vara ble name a nd added | |
| 238 | to the Param array not as 'Liter al' but as 'Referenc e'. | |
| 239 | <p > | |
| 240 | If an option al <i>Mult List</i> p arameter i s specifie d and not empty, | |
| 241 | th en its val ues are ad ded to the 'List' pa rameter th at is auto matically | |
| 242 | ad ded to the Param arr ay. String indexes i n the list starts fr om '1' | |
| 243 | (i .e. MultLi st[0] -> P aram[i].Mu lt['1'], M ultList[1] -> Param[ i].Mult['2 '], | |
| 244 | an d so on). Indexes in the RPC b roker Mult parameter starts fr om 1 to | |
| 245 | al low pass t he array o n the serv er side in to FileMan APIs, whi ch often | |
| 246 | ig nore the 0 subscript or treat it in a sp ecial way. | |
| 247 | <p > | |
| 248 | If logging i s enabled (see the D ebugLog pr operty), t hen proced ure | |
| 249 | pa rameters a nd/or resu lts are re corded int o a debug log (see t he | |
| 250 | TC CRCustomDe bugLog). | |
| 251 | } | |
| 252 | functi on CallPro c(CallInfo : TCCRBrok erCallInfo ; | |
| 253 | cons t Paramete rs: array of String; | |
| 254 | Mult List: TStr ingList = nil): Bool ean; overr ide; | |
| 255 | ||
| 256 | {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | |
| 257 | Over view: Restores a saved Vis tA RPC bro ker contex t. | |
| 258 | SeeA lso: TCCRBroker .PushRPCon text; TCCR Broker.RPC ontext | |
| 259 | Desc ription: | |
| 260 | Re stores the topmost V istA RPC b roker cont ext previo usly saved by the | |
| 261 | Pu shRPContex t in the i nternal st ack. If th e stack is empty, th is method | |
| 262 | do es nothing . | |
| 263 | } | |
| 264 | proced ure PopRPC ontext; | |
| 265 | ||
| 266 | {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | |
| 267 | Over view: Saves the current Vi stA RPC br oker conte xt and cre ates a | |
| 268 | new one. | |
| 269 | SeeA lso: TCCRBroker .PopRPCont ext; TCCRB roker.RPCo ntext | |
| 270 | Desc ription: | |
| 271 | Pu shRPContex t tries to create a new contex t specifie d by the < i>aName</i > | |
| 272 | pa rameter. I f the atte mpt is suc cessful, t hen the pr evious Vsi tA RPC | |
| 273 | br oker conte xt (value of the RPC ontext pro perty) is saved in t he | |
| 274 | in ternal sta ck. It can be later restored b y PopConte xt. | |
| 275 | } | |
| 276 | functi on PushRPC ontext(con st aName: String): B oolean; | |
| 277 | ||
| 278 | publishe d | |
| 279 | ||
| 280 | {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | |
| 281 | } | |
| 282 | proper ty DebugLo g; // TCCRCu stomBroker | |
| 283 | proper ty Default ProcMode; // TCCRCu stomBroker | |
| 284 | proper ty OnCheck ProcError; // TCCRCu stomBroker | |
| 285 | ||
| 286 | {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | |
| 287 | Over view: Reference to a comma nd-line pa rameters o bject. | |
| 288 | SeeA lso: TCCRBroker .CheckCmdL ineParams | |
| 289 | Desc ription: | |
| 290 | If a referen ce to a co mmand-line parameter s object i s assigned to this | |
| 291 | pr operty, th en broker properties are autom atically m odified ac cording | |
| 292 | to the comma nd line pa rameters s pecified b y the user . See the | |
| 293 | Ch eckCmdLine Params met hod for mo re details . | |
| 294 | } | |
| 295 | proper ty CmdLine Params: TC CRCmdLineP arams | |
| 296 | read GetCmdLin eParams w rite SetCm dLineParam s; | |
| 297 | ||
| 298 | {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | |
| 299 | Over view: Clinical c ontextor ( CCOW). | |
| 300 | SeeA lso: TCCRCustom Broker.Cmd LineParams | |
| 301 | Keyw ords: Contextor, TCCRBroker | |
| 302 | Desc ription: | |
| 303 | As sign an in stance of a CCR clin ical conte xtor wrapp er to the Contextor | |
| 304 | pr operty bef ore connec ting to a server if you you wa nt the bro ker | |
| 305 | ha ndle user context ch anges. If this prope rty is nil , or CmdLi neParams | |
| 306 | is not nil a nd its NoU serContext property is True, t hen the us er context | |
| 307 | fu nctionalit y is disab led. | |
| 308 | } | |
| 309 | proper ty Context or: TCCRCu stomContex tor | |
| 310 | read fContexto r write S etContexto r; | |
| 311 | ||
| 312 | {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | |
| 313 | Over view: Port numbe r used by a VistA RP C broker l istener. | |
| 314 | SeeA lso: TCCRCustom Broker.Cmd LineParams ; TCCRCust omBroker.C onnect; | |
| 315 | TRPCBroker .ListenerP ort | |
| 316 | Keyw ords: ListenerPo rt,TCCRBro ker | |
| 317 | Desc ription: | |
| 318 | Th e Listener Port desig n-time pro perty give s the deve loper the ability to | |
| 319 | se lect the L istener po rt on the VistA M Se rver. | |
| 320 | <p > | |
| 321 | If CmdLinePa rams is no t nil and a user spe cified the 'port' pa rameter, | |
| 322 | th en the val ue of this parameter is automa tically as signed to the | |
| 323 | Li stenerPort property. | |
| 324 | <p > | |
| 325 | If the value of this p roperty is 0 at the moment whe n a connec tion | |
| 326 | at tempt is m ade, the G etServerIn fo method of the Vis tA RPC Bro ker is | |
| 327 | ca lled (it m ay display a modal d ialog box for server selection ). | |
| 328 | <p > | |
| 329 | Ch anging the port numb er while t he TCCRBro ker compon ent is con nected | |
| 330 | ha s no effec t (the pro perty keep s its old value). | |
| 331 | } | |
| 332 | proper ty Listene rPort: Int eger | |
| 333 | read fListener Port writ e SetListe nerPort d efault 0; | |
| 334 | ||
| 335 | {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | |
| 336 | Over view: VistA RPC broker tha t is used to perform procedure call. | |
| 337 | SeeA lso: TComponent .Owner | |
| 338 | Keyw ords: RPCBroker, TCCRBroker | |
| 339 | Desc ription: | |
| 340 | RP CBroker re ferences a VistA RPC broker th at actuall y performs remote | |
| 341 | pr ocedure ca lls. | |
| 342 | <p > | |
| 343 | Yo u can eith er assign an instanc e of a des cendant of the TRPCB roker to | |
| 344 | th is propert y or leave the nil v alue. In t he latter case, an i sntance | |
| 345 | of the TCCOW RPCBroker will be cr eated auto matically (just befo re | |
| 346 | co nnecting t o the serv er) and as signed to the RPCBro ker. The n ew object | |
| 347 | wi ll have th e same own er as the TCCRBroker wrapper. | |
| 348 | <p > | |
| 349 | If a broker that is be ing assign ed to this property is already | |
| 350 | co nnected to a server, the DoCon nect metho d is not c alled and some | |
| 351 | pr operties o f the Vsit A RPC brok er are sav ed in an i nternally created | |
| 352 | TC CRVistABro kerInstanc e. When th e value of the RPCBr oker prope rty is | |
| 353 | mo dified or the wrappe r is destr oyed, thos e properti es of the VistA RPC | |
| 354 | br oker are r estored. S ee the TCC RVistABrok erInstance .Assign fo r the | |
| 355 | af fected lis t of prope rties. | |
| 356 | } | |
| 357 | proper ty RPCBrok er: TRPCBr oker read fRPCBroke r write S etRPCBroke r; | |
| 358 | ||
| 359 | {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | |
| 360 | Over view: Current co ntext for the VistA RPC broker . | |
| 361 | SeeA lso: TCCRBroker .PopRPCont ext; TCCRB roker.Push RPContext | |
| 362 | Desc ription: | |
| 363 | Us e RPContex t to get o r set the current co ntext for the VistA RPC | |
| 364 | br oker. You can also u se the Pus hRPContext and PopRP Context to | |
| 365 | sa ve and res tore the c urrent con text. | |
| 366 | } | |
| 367 | proper ty RPConte xt: String read fRP Context w rite SetRP Context; | |
| 368 | ||
| 369 | {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | |
| 370 | Over view: Server nam e or IP ad dress. | |
| 371 | Keyw ords: Server,TCC RBroker | |
| 372 | Desc ription: | |
| 373 | Th e Server d esign-time property contains t he name or Internet Protocol | |
| 374 | (I P) address of the Vi stA M Serv er system. If the na me is used instead | |
| 375 | of the IP ad dress, Mic rosoft Win dows Winso ck should be able to resolve | |
| 376 | it . Winsock can resolv e a name t o an IP ad dress eith er through the | |
| 377 | Do main Name Service (D NS) or by looking it up in the HOSTS fil e on the | |
| 378 | cl ient works tation. In the case where the same name exists in the DNS | |
| 379 | an d in the H OSTS file, the HOSTS file entr y takes pr ecedence. | |
| 380 | <p > | |
| 381 | If CmdLinePa rams is no t nil and a user spe cified the 'server' parameter, | |
| 382 | th en the val ue of this parameter is automa tically as signed to the | |
| 383 | Se rver prope rty. | |
| 384 | <p > | |
| 385 | If this prop erty is em pty at the moment wh en a conne ction atte mpt is | |
| 386 | ma de, the Ge tServerInf o method o f the Vist A RPC Brok er is call ed (it | |
| 387 | ma y display a modal di alog box f or server selection) . | |
| 388 | <p > | |
| 389 | Ch anging the name of t he server while the TCCRBroker component is | |
| 390 | co nnected ha s no effec t (the pro perty keep s its old value). | |
| 391 | } | |
| 392 | proper ty Server: String r ead fServe r write S etServer; | |
| 393 | ||
| 394 | end; | |
| 395 | ||
| 396 | {======= ========== ========== = TCCRVist ABrokerSta te ======= ========== ========== | |
| 397 | Overvi ew: St orage for a RPC Brok er state. | |
| 398 | Descri ption: | |
| 399 | Use TCCRVistAB rokerState to save a nd restore a current state of a | |
| 400 | TRPC Broker ins tance. | |
| 401 | } | |
| 402 | TCCRVist ABrokerSta te = class (TPersiste nt) | |
| 403 | private | |
| 404 | ||
| 405 | fClear Parameters : Boolean; | |
| 406 | fClear Results: Boolean; | |
| 407 | fCurre ntContext: String; | |
| 408 | fOnRPC BFailure: TOnRPCBF ailure; | |
| 409 | fParam : TParams; | |
| 410 | fRemot eProcedure : String; | |
| 411 | fResul ts: TStrings ; | |
| 412 | fRPCVe rsion: String; | |
| 413 | fShowE rrorMsgs: TShowErr orMsgs; | |
| 414 | ||
| 415 | protecte d | |
| 416 | ||
| 417 | {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | |
| 418 | Over view: Copies the propertie s of an ob ject to a destinatio n object. | |
| 419 | SeeA lso: TCCRVistAB rokerState .Assign; T Persistent .AssignTo | |
| 420 | Keyw ords: AssignTo,T CCRVistABr okerState | |
| 421 | Desc ription: | |
| 422 | Ov erride the AssignTo method to extend the functiona lity of th e Assign | |
| 423 | me thod of de stination objects so that they handle ne wly create d object | |
| 424 | cl asses. | |
| 425 | <p > | |
| 426 | If the <i>De st</i> is a TRPCBrok er instanc e, Assign copies val ues of the | |
| 427 | Cl earParamet ers, Clear Results, C urrentCont ext, Param , RemotePr ocedure, | |
| 428 | Re sults, RPC Version, a nd ShowErr orMsgs pro perties. | |
| 429 | } | |
| 430 | proced ure Assign To(Dest: T Persistent ); overrid e; | |
| 431 | ||
| 432 | public | |
| 433 | ||
| 434 | {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | |
| 435 | Over view: Constructs an object and initi alizes its data befo re the | |
| 436 | object is first used . | |
| 437 | SeeA lso: TObject.Cr eate | |
| 438 | Keyw ords: Create,TCC RVistABrok erState | |
| 439 | Desc ription: | |
| 440 | Cr eate const ructs an o bject. | |
| 441 | } | |
| 442 | constr uctor Crea te; | |
| 443 | ||
| 444 | {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | |
| 445 | Over view: Destroys t he TCCRVis tABrokerSt ate instan ce and fre es its | |
| 446 | memory. | |
| 447 | SeeA lso: TObject.Fr ee; TPersi stent.Dest roy | |
| 448 | Keyw ords: Destroy,TC CRVistABro kerState | |
| 449 | Desc ription: | |
| 450 | Do not call Destroy di rectly. Ca ll Free in stead. Fre e checks t hat the | |
| 451 | ob ject refer ence is no t nil befo re calling Destroy. | |
| 452 | } | |
| 453 | destru ctor Destr oy; overri de; | |
| 454 | ||
| 455 | {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | |
| 456 | Over view: Copies the contents of another , similar object. | |
| 457 | SeeA lso: TCCRVistAB rokerState .AssignTo; TPersiste nt.Assign | |
| 458 | Keyw ords: Assign,TCC RVistABrok erState | |
| 459 | Desc ription: | |
| 460 | Ca ll Assign to copy th e properti es or othe r attribut es of one object | |
| 461 | fr om another . | |
| 462 | <p > | |
| 463 | If the <i>So urce</i> i s a TRPCBr oker insta nce, Assig n copies v alues of | |
| 464 | th e ClearPar ameters, C learResult s, Current Context, P aram, Remo teProcedur e, | |
| 465 | Re sults, RPC Version, a nd ShowErr orMsgs pro perties. | |
| 466 | } | |
| 467 | proced ure Assign (Source: T Persistent ); overrid e; | |
| 468 | ||
| 469 | end; | |
| 470 | ||
| 471 | ////////// ////////// ////////// /// Implem entation \ \\\\\\\\\\ \\\\\\\\\\ \\\\\\\\\\ | |
| 472 | ||
| 473 | implementa tion | |
| 474 | ||
| 475 | uses | |
| 476 | Math, Rp cConf1, Rp cbErr, uRO R_Utilitie s, uROR_De bug, uROR_ Resources | |
| 477 | {$IFDEF RP CLOG} | |
| 478 | , fZZ_Ev entLog, uZ Z_RPCEvent | |
| 479 | {$ENDIF} | |
| 480 | ; | |
| 481 | ||
| 482 | ////////// ////////// ////////// //// TCCRB roker \\\\ \\\\\\\\\\ \\\\\\\\\\ \\\\\\\\\\ | |
| 483 | ||
| 484 | constructo r TCCRBrok er.Create( anOwner: T Component) ; | |
| 485 | begin | |
| 486 | inherite d; | |
| 487 | fDefault Results := TStringLi st.Create; | |
| 488 | fContext Stack := T Stack.Crea te; | |
| 489 | fListene rPort := 0 ; | |
| 490 | fServer := ''; | |
| 491 | end; | |
| 492 | ||
| 493 | destructor TCCRBroke r.Destroy; | |
| 494 | begin | |
| 495 | RPCBroke r := nil; | |
| 496 | FreeAndN il(fContex tStack); | |
| 497 | FreeAndN il(fDefaul tResults); | |
| 498 | inherite d; | |
| 499 | end; | |
| 500 | ||
| 501 | function T CCRBroker. CallProc(C allInfo: T CCRBrokerC allInfo; | |
| 502 | const Pa rameters: array of S tring; Mul tList: TSt ringList = nil): Boo lean; | |
| 503 | var | |
| 504 | ip, j, n : Integer; | |
| 505 | idt: ICC RDebugTrac e; | |
| 506 | {$IFDEF RP CLOG} | |
| 507 | aStart,a Stop: TDat eTime; | |
| 508 | anEvent: TRPCEvent Item; | |
| 509 | {$ENDIF} | |
| 510 | ||
| 511 | procedur e broker_e rror(const ErrMsg: S tring); | |
| 512 | begin | |
| 513 | if Deb ugLog.Enab led and De bugLog.Bro kerErrors then | |
| 514 | idt. Write('ERR OR: ''%s'' ', [ErrMsg ]); | |
| 515 | ||
| 516 | if not (rpcSilen t in CallI nfo.ProcMo de) then | |
| 517 | Mess ageDlg508( RSC0051, | |
| 518 | Fo rmat(RSC00 50, [Serve r, Listene rPort, Cal lInfo.Proc edureName, ErrMsg]), | |
| 519 | mt Error, [mb OK], 0); | |
| 520 | ||
| 521 | with C allInfo do | |
| 522 | begi n | |
| 523 | Re sults.Clea r; | |
| 524 | Er rorCode := CCRBEC_RP CEXCEPTION ; | |
| 525 | Er rorType := rpeProced ure; | |
| 526 | end; | |
| 527 | end; | |
| 528 | ||
| 529 | begin | |
| 530 | if not A ssigned(Ca llInfo.Res ults) then | |
| 531 | CallIn fo.Results := Self.R esults; | |
| 532 | CallInfo .Results.C lear; | |
| 533 | ||
| 534 | with RPC Broker do | |
| 535 | if Con nected the n | |
| 536 | begi n | |
| 537 | if DebugLog. Enabled th en | |
| 538 | idt := TCC RDebugTrac e.Create(' RPC: ' + C allInfo.Pr ocedureNam e); | |
| 539 | ||
| 540 | Pa ram.Clear; | |
| 541 | Re moteProced ure := Cal lInfo.Proc edureName; | |
| 542 | ||
| 543 | if rpcDefaul t in CallI nfo.ProcMo de then | |
| 544 | CallInfo.P rocMode := DefaultPr ocMode; | |
| 545 | n := High(Pa rameters); | |
| 546 | ||
| 547 | if DebugLog. Enabled an d DebugLog .Parameter s then | |
| 548 | for j:=0 t o n do | |
| 549 | idt.Writ e('PRM[%03 d]: ''%s'' ', [j,Para meters[j]] ); | |
| 550 | ||
| 551 | ip := 0; | |
| 552 | wh ile ip <= n do | |
| 553 | begin | |
| 554 | if (Copy (Parameter s[ip], 1, 1) = '@') and (Param eters[ip] <> '@') th en | |
| 555 | begin | |
| 556 | Para m[ip].Valu e := Copy( Parameters [ip], 2, L ength(Para meters[ip] )); | |
| 557 | Para m[ip].PTyp e := Refer ence; | |
| 558 | end | |
| 559 | else | |
| 560 | begin | |
| 561 | Para m[ip].Valu e := Param eters[ip]; | |
| 562 | Para m[ip].PTyp e := Liter al; | |
| 563 | end; | |
| 564 | Inc(ip); | |
| 565 | end; | |
| 566 | ||
| 567 | if Assigned( MultList) and (MultL ist.Count > 0) then | |
| 568 | begin | |
| 569 | if Debug Log.Enable d and Debu gLog.Param eters then | |
| 570 | begin | |
| 571 | if D ebugLog.Li mitParams > 0 then | |
| 572 | n := Min(Mul tList.Coun t, DebugLo g.LimitPar ams) - 1 | |
| 573 | else | |
| 574 | n := MultLis t.Count - 1; | |
| 575 | for j:=0 to n do | |
| 576 | id t.Write('M LT[%03d]: ''%s''', [ j,MultList [j]]); | |
| 577 | if n < (MultLi st.Count-1 ) then | |
| 578 | id t.Write('. ..'); | |
| 579 | end; | |
| 580 | for j:=1 to MultLi st.Count d o | |
| 581 | Param[ ip].Mult[I ntToStr(j) ] := MultL ist[j-1]; | |
| 582 | Param[ip ].PType := List; | |
| 583 | end; | |
| 584 | ||
| 585 | tr y | |
| 586 | Result := True; | |
| 587 | {$IFDEF RP CLOG} | |
| 588 | aStart : = Now; | |
| 589 | anEvent := getTRPC BEventItem (RPCBroker ); | |
| 590 | {$ENDIF} | |
| 591 | lstCall(Ca llInfo.Res ults); | |
| 592 | {$IFDEF RP CLOG} | |
| 593 | aStop := Now; | |
| 594 | anEvent. AppendResu lts(CallIn fo.Results ,aStart,aS top); | |
| 595 | addRPCEv ent(anEven t); | |
| 596 | {$ENDIF} | |
| 597 | if (ShowEr rorMsgs = semQuiet) and (RPCBE rror <> '' ) then | |
| 598 | begin | |
| 599 | broker _error(RPC BError); | |
| 600 | Result := False; | |
| 601 | end | |
| 602 | else if no t (rpcNoEr rorCheck i n CallInfo .ProcMode) then | |
| 603 | Result : = not Chec kProcError (CallInfo) ; | |
| 604 | ex cept | |
| 605 | on e: EBro kerError d o | |
| 606 | begin | |
| 607 | broker _error(e.M essage); | |
| 608 | Result := False; | |
| 609 | end; | |
| 610 | else | |
| 611 | raise; | |
| 612 | en d; | |
| 613 | ||
| 614 | if DebugLog. Enabled an d DebugLog .Results t hen | |
| 615 | begin | |
| 616 | if Debug Log.LimitR esults > 0 then | |
| 617 | n := M in(CallInf o.Results. Count, Deb ugLog.Limi tResults) - 1 | |
| 618 | else | |
| 619 | n := C allInfo.Re sults.Coun t - 1; | |
| 620 | for j:=0 to n do | |
| 621 | idt.Wr ite('RES[% 03d]: ''%s ''', | |
| 622 | [j,C allInfo.Re sults[j]]) ; | |
| 623 | if n < ( CallInfo.R esults.Cou nt-1) then | |
| 624 | idt.Wr ite('...') ; | |
| 625 | end; | |
| 626 | end | |
| 627 | else | |
| 628 | Resu lt := Fals e; | |
| 629 | end; | |
| 630 | ||
| 631 | procedure TCCRBroker .CheckCmdL ineParams; | |
| 632 | begin | |
| 633 | inherite d; | |
| 634 | if Assig ned(CmdLin eParams) t hen | |
| 635 | begin | |
| 636 | SetL istenerPor t(Listener Port); | |
| 637 | SetS erver(Serv er); | |
| 638 | end; | |
| 639 | end; | |
| 640 | ||
| 641 | procedure TCCRBroker .DoCheckPr ocError(Ca llInfo: TC CRBrokerCa llInfo); | |
| 642 | var | |
| 643 | iErr, ir , numErr: Integer; | |
| 644 | buf, err Loc, errMs g: String; | |
| 645 | errCode: Integer; | |
| 646 | errDetai ls: TStrin gList; | |
| 647 | begin | |
| 648 | with Cal lInfo do | |
| 649 | begin | |
| 650 | Erro rCode := S trToIntDef (Piece(Res ults[0], ' ^'), 0); | |
| 651 | ||
| 652 | if E rrorCode > = 0 then | |
| 653 | be gin | |
| 654 | ErrorCode := 0; | |
| 655 | ErrorType := rpeNone ; | |
| 656 | en d | |
| 657 | else if not (r pcSilent i n ProcMode ) then | |
| 658 | be gin | |
| 659 | ErrorType := rpeProc edure; | |
| 660 | numErr := StrToIntDe f(Piece(Re sults[0], '^', 2), 0 ); | |
| 661 | buf := For mat(RSC004 1, [ErrorC ode, Proce dureName]) ; | |
| 662 | if numErr > 0 then | |
| 663 | begin | |
| 664 | buf := buf + RSC 0042; | |
| 665 | if num Err > 1 th en | |
| 666 | buf := buf + R SC0043 | |
| 667 | else | |
| 668 | buf := buf + R SC0044; | |
| 669 | AddErr or(buf); | |
| 670 | ||
| 671 | errDet ails := ni l; | |
| 672 | ir := 1; | |
| 673 | for iE rr := 1 to numErr do | |
| 674 | begi n | |
| 675 | if ir >= Res ults.Count then | |
| 676 | Break; | |
| 677 | ||
| 678 | bu f := Resul ts[ir]; | |
| 679 | er rCode := S trToIntDef (Piece(buf , '^'), 0) ; | |
| 680 | er rMsg := Pi ece(buf, ' ^', 2); | |
| 681 | er rLoc := St ringReplac e(Piece(bu f, '^', 3) , '~', '^' , []); | |
| 682 | ||
| 683 | wh ile True d o | |
| 684 | begin | |
| 685 | Inc(ir); | |
| 686 | if ir >= Results.C ount then | |
| 687 | Break; | |
| 688 | buf := R esults[ir] ; | |
| 689 | if Piece (buf, '^') <> '' the n | |
| 690 | Break; | |
| 691 | if not A ssigned(er rDetails) then | |
| 692 | errDet ails := TS tringList. Create; | |
| 693 | errDetai ls.Add(Pie ce(buf, '^ ', 2)); | |
| 694 | end; | |
| 695 | ||
| 696 | Ad dError(err Msg, errCo de, errLoc , errDetai ls); | |
| 697 | er rDetails : = nil; | |
| 698 | end; | |
| 699 | end | |
| 700 | else | |
| 701 | AddError (buf); | |
| 702 | en d; | |
| 703 | end; | |
| 704 | end; | |
| 705 | ||
| 706 | function T CCRBroker. DoConnect: Boolean; | |
| 707 | var | |
| 708 | srv, por t: String; | |
| 709 | ||
| 710 | procedur e SignOnEr ror(RPCB: TRPCBroker ; const er rMsg: Stri ng); | |
| 711 | begin | |
| 712 | Messag eDlg508('' , Format(R SC0049, [R PCB.Server , RPCB.Lis tenerPort, errMsg]), | |
| 713 | mtEr ror, [mbOK ], 0); | |
| 714 | end; | |
| 715 | ||
| 716 | begin | |
| 717 | Result : = False; | |
| 718 | ||
| 719 | if (List enerPort = 0) or (Se rver = '') then | |
| 720 | if Get ServerInfo (srv, port ) = mrOK t hen | |
| 721 | begi n | |
| 722 | ListenerPo rt := StrT oIntDef(po rt, PORT ); | |
| 723 | Se rver := sr v; | |
| 724 | end | |
| 725 | else | |
| 726 | begi n | |
| 727 | Me ssageDlg50 8('', RSC0 047, mtInf ormation, [mbok], 0) ; | |
| 728 | Ex it; | |
| 729 | end; | |
| 730 | ||
| 731 | if not A ssigned(RP CBroker) t hen | |
| 732 | RPCBro ker := TCC OWRPCBroke r.Create(O wner); | |
| 733 | ||
| 734 | if RPCBr oker is TC COWRPCBrok er then | |
| 735 | if not Assigned( Contextor) or | |
| 736 | (Ass igned(CmdL ineParams) and CmdLi neParams.N oUserConte xt) then | |
| 737 | TC COWRPCBrok er(RPCBrok er).Contex tor := nil | |
| 738 | else | |
| 739 | TCCO WRPCBroker (RPCBroker ).Contexto r := Conte xtor.Conte xtor; | |
| 740 | ||
| 741 | RPCBroke r.Listener Port := Li stenerPort ; | |
| 742 | RPCBroke r.Server : = Server; | |
| 743 | {$IFDEF CCRDEBUG} | |
| 744 | if Assig ned(CmdLin eParams) a nd (CmdLin eParams.AV Codes <> ' ') then | |
| 745 | RPCBro ker.Access VerifyCode s := CmdLi neParams.A VCodes; | |
| 746 | {$ENDIF} | |
| 747 | ||
| 748 | try | |
| 749 | RPCBro ker.Connec ted := Tru e; | |
| 750 | ||
| 751 | // Wor karound fo r a Broker bug (it a lways show s the main form) | |
| 752 | if Ass igned(Appl ication.Ma inForm) an d not Appl ication.Sh owMainForm then | |
| 753 | with Applicati on do | |
| 754 | be gin | |
| 755 | BringToFro nt; | |
| 756 | MainForm.V isible := False; | |
| 757 | en d; | |
| 758 | ||
| 759 | if RPC Broker.Con nected the n | |
| 760 | begi n | |
| 761 | Ap plication. ProcessMes sages; | |
| 762 | if (RPContex t <> '') a nd not RPC Broker.Cre ateContext (RPContext ) then | |
| 763 | begin | |
| 764 | SignOnEr ror(RPCBro ker, Forma t(RSC0048, [RPContex t])); | |
| 765 | RPCBroke r.Connecte d := False ; | |
| 766 | end | |
| 767 | el se if not inherited DoConnect then | |
| 768 | RPCBroker. Connected := False; | |
| 769 | end; | |
| 770 | except | |
| 771 | on E: EBrokerErr or do | |
| 772 | begi n | |
| 773 | if E.Code <> XWB_BadSi gnOn then | |
| 774 | SignOnErro r(RPCBroke r, E.Messa ge); | |
| 775 | end; | |
| 776 | else | |
| 777 | rais e; | |
| 778 | end; | |
| 779 | ||
| 780 | Result : = RPCBroke r.Connecte d; | |
| 781 | end; | |
| 782 | ||
| 783 | procedure TCCRBroker .DoDisconn ect; | |
| 784 | begin | |
| 785 | if Assig ned(RPCBro ker) then | |
| 786 | RPCBro ker.Connec ted := Fal se; | |
| 787 | inherite d; | |
| 788 | end; | |
| 789 | ||
| 790 | function T CCRBroker. GetCmdLine Params: TC CRCmdLineP arams; | |
| 791 | begin | |
| 792 | Result : = TCCRCmdL ineParams( inherited CmdLinePar ams); | |
| 793 | end; | |
| 794 | ||
| 795 | function T CCRBroker. GetConnect ed: Boolea n; | |
| 796 | begin | |
| 797 | if Assig ned(RPCBro ker) then | |
| 798 | Result := RPCBro ker.Connec ted | |
| 799 | else | |
| 800 | Result := False; | |
| 801 | end; | |
| 802 | ||
| 803 | function T CCRBroker. GetResults : TStrings ; | |
| 804 | begin | |
| 805 | Result : = inherite d GetResul ts; | |
| 806 | if not A ssigned(Re sult) then | |
| 807 | Result := fDefau ltResults; | |
| 808 | end; | |
| 809 | ||
| 810 | procedure TCCRBroker .Notificat ion(aCompo nent: TCom ponent; | |
| 811 | Operatio n: TOperat ion); | |
| 812 | begin | |
| 813 | inherite d; | |
| 814 | if Opera tion = opR emove then | |
| 815 | begin | |
| 816 | if a Component = Contexto r then | |
| 817 | Co ntextor := nil | |
| 818 | else if aCompo nent = RPC Broker the n | |
| 819 | RP CBroker := nil; | |
| 820 | end; | |
| 821 | end; | |
| 822 | ||
| 823 | procedure TCCRBroker .PopRPCont ext; | |
| 824 | begin | |
| 825 | if fCont extStack.C ount > 0 t hen | |
| 826 | RPCont ext := Str ing(fConte xtStack.Po p); | |
| 827 | end; | |
| 828 | ||
| 829 | function T CCRBroker. PushRPCont ext(const aName: Str ing): Bool ean; | |
| 830 | var | |
| 831 | ctx: Str ing; | |
| 832 | begin | |
| 833 | Result : = False; | |
| 834 | ctx := R PContext; | |
| 835 | RPContex t := aName ; | |
| 836 | if RPCon text = aNa me then | |
| 837 | begin | |
| 838 | fCon textStack. Push(Point er(ctx)); | |
| 839 | Resu lt := True ; | |
| 840 | end; | |
| 841 | end; | |
| 842 | ||
| 843 | procedure TCCRBroker .SetCmdLin eParams(aV alue: TCCR CmdLinePar ams); | |
| 844 | begin | |
| 845 | inherite d CmdLineP arams := a Value; | |
| 846 | end; | |
| 847 | ||
| 848 | procedure TCCRBroker .SetContex tor(aValue : TCCRCust omContexto r); | |
| 849 | begin | |
| 850 | if aValu e <> fCont extor then | |
| 851 | begin | |
| 852 | if A ssigned(fC ontextor) then | |
| 853 | fC ontextor.R emoveFreeN otificatio n(Self); | |
| 854 | ||
| 855 | fCon textor := aValue; | |
| 856 | ||
| 857 | if A ssigned(fC ontextor) then | |
| 858 | fC ontextor.F reeNotific ation(Self ); | |
| 859 | end; | |
| 860 | end; | |
| 861 | ||
| 862 | procedure TCCRBroker .SetListen erPort(con st aValue: Integer); | |
| 863 | begin | |
| 864 | if Assig ned(CmdLin eParams) a nd (CmdLin eParams.Br okerPort < > 0) and | |
| 865 | not (c sDesigning in Compon entState) then | |
| 866 | fLis tenerPort := CmdLine Params.Bro kerPort | |
| 867 | else if not Connec ted or (cs Designing in Compone ntState) t hen | |
| 868 | fListe nerPort := aValue; | |
| 869 | end; | |
| 870 | ||
| 871 | procedure TCCRBroker .SetRPCBro ker(aValue : TRPCBrok er); | |
| 872 | begin | |
| 873 | if aValu e <> fRPCB roker then | |
| 874 | begin | |
| 875 | if A ssigned(fR PCBroker) then | |
| 876 | be gin | |
| 877 | fRPCBroker .RemoveFre eNotificat ion(Self); | |
| 878 | //--- Rest ore origin al broker state (if it was sav ed) | |
| 879 | if not (cs Designing in Compone ntState) a nd Assigne d(fSavedSt ate) then | |
| 880 | begin | |
| 881 | fRPCBr oker.Assig n(fSavedSt ate); | |
| 882 | FreeAn dNil(fSave dState); | |
| 883 | end; | |
| 884 | en d; | |
| 885 | ||
| 886 | fRPC Broker := aValue; | |
| 887 | ||
| 888 | if A ssigned(fR PCBroker) then | |
| 889 | be gin | |
| 890 | fRPCBroker .FreeNotif ication(Se lf); | |
| 891 | //--- Save current b roker stat e | |
| 892 | if not (cs Designing in Compone ntState) a nd fRPCBro ker.Connec ted then | |
| 893 | begin | |
| 894 | fSaved State := T CCRVistABr okerState. Create; | |
| 895 | fSaved State.Assi gn(fRPCBro ker); | |
| 896 | end; | |
| 897 | en d; | |
| 898 | end; | |
| 899 | end; | |
| 900 | ||
| 901 | procedure TCCRBroker .SetRPCont ext(const aName: Str ing); | |
| 902 | begin | |
| 903 | if aName <> fRPCon text then | |
| 904 | begin | |
| 905 | if n ot (Assign ed(RPCBrok er) and RP CBroker.Co nnected) t hen | |
| 906 | fR PContext : = aName | |
| 907 | else if RPCBro ker.Create Context(aN ame) then | |
| 908 | fR PContext : = aName; | |
| 909 | end; | |
| 910 | end; | |
| 911 | ||
| 912 | procedure TCCRBroker .SetServer (const aVa lue: Strin g); | |
| 913 | begin | |
| 914 | if Assig ned(CmdLin eParams) a nd (CmdLin eParams.Br okerServer <> '') an d | |
| 915 | not (c sDesigning in Compon entState) then | |
| 916 | fSer ver := Cmd LineParams .BrokerSer ver | |
| 917 | else if not Connec ted or (cs Designing in Compone ntState) t hen | |
| 918 | fServe r := aValu e; | |
| 919 | end; | |
| 920 | ||
| 921 | ////////// ////////// ///////// TCCRVistAB rokerState \\\\\\\\\ \\\\\\\\\\ \\\\\\\\\\ | |
| 922 | ||
| 923 | constructo r TCCRVist ABrokerSta te.Create; | |
| 924 | begin | |
| 925 | inherite d; | |
| 926 | fParam := TParam s.Create(n il); | |
| 927 | fResults := TStrin gList.Crea te; | |
| 928 | end; | |
| 929 | ||
| 930 | destructor TCCRVistA BrokerStat e.Destroy; | |
| 931 | begin | |
| 932 | FreeAndN il(fResult s); | |
| 933 | FreeAndN il(fParam) ; | |
| 934 | inherite d; | |
| 935 | end; | |
| 936 | ||
| 937 | procedure TCCRVistAB rokerState .AssignTo( Dest: TPer sistent); | |
| 938 | begin | |
| 939 | if Dest is TRPCBro ker then | |
| 940 | with T RPCBroker( Dest) do | |
| 941 | begi n | |
| 942 | Cl earParamet ers := fCl earParamet ers; | |
| 943 | Cl earResults := fCl earResults ; | |
| 944 | On RPCBFailur e := fOn RPCBFailur e; | |
| 945 | Re moteProced ure := fRe moteProced ure; | |
| 946 | RP CVersion := fRP CVersion; | |
| 947 | Sh owErrorMsg s := fSh owErrorMsg s; | |
| 948 | ||
| 949 | Cr eateContex t(fCurrent Context); | |
| 950 | ||
| 951 | Pa ram.Assign (fParam); | |
| 952 | Re sults.Assi gn(fResult s); | |
| 953 | end | |
| 954 | else | |
| 955 | inheri ted; | |
| 956 | end; | |
| 957 | ||
| 958 | procedure TCCRVistAB rokerState .Assign(So urce: TPer sistent); | |
| 959 | begin | |
| 960 | if Sourc e is TRPCB roker then | |
| 961 | with T RPCBroker( Source) do | |
| 962 | begi n | |
| 963 | fC learParame ters := Cl earParamet ers; | |
| 964 | fC learResult s := Cl earResults ; | |
| 965 | fC urrentCont ext := Cu rrentConte xt; | |
| 966 | fO nRPCBFailu re := On RPCBFailur e; | |
| 967 | fR emoteProce dure := Re moteProced ure; | |
| 968 | fR PCVersion := RP CVersion; | |
| 969 | fS howErrorMs gs := Sh owErrorMsg s; | |
| 970 | ||
| 971 | fP aram.Assig n(Param); | |
| 972 | fR esults.Ass ign(Result s); | |
| 973 | end | |
| 974 | else | |
| 975 | inheri ted; | |
| 976 | end; | |
| 977 | ||
| 978 | end. |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.