Produced by Araxis Merge on 10/18/2017 11:37:30 AM Eastern 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 | OSCIF_CPRS v32 Phase 2 Build 2OR3.0405_August_2017.zip\OR_30_405V36_SRC.zip\XE8\Broker\Source | XWBSSOi.pas | Wed Oct 11 20:08:07 2017 UTC |
| 2 | OSCIF_CPRS v32 Phase 2 Build 2OR3.0405_August_2017.zip\OR_30_405V36_SRC.zip\XE8\Broker\Source | XWBSSOi.pas | Tue Oct 17 19:58:09 2017 UTC |
| Description | Between Files 1 and 2 |
|
|---|---|---|
| Text Blocks | Lines | |
| Unchanged | 2 | 920 |
| 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: PII | |
| 6 | De scription: Contains the TXWBSS OiToken co mponent. | |
| 7 | Unit: XW BSSOi cont ains a sim ple TWebBr owser to ' POST' a SO AP message to | |
| 8 | IAM to obtain a SAML token . | |
| 9 | Cu rrent Rele ase: Versi on 1.1 Pat ch 65 | |
| 10 | ********** ********** ********** ********** ********** ********** *** } | |
| 11 | ||
| 12 | { ******** ********** ********** ********** ********** ** | |
| 13 | Changes in v1.1.65 (HGW 11/2 2/2016) XW B*1.1*65 | |
| 14 | 1. Creat ed unit XW BSSOi to e xchange PI V Card cre dentials f or a Secur e Token | |
| 15 | Servi ce (STS) t oken to be used for user authe ntication and identi fication. | |
| 16 | 2. New c lass TXWBS SOiToken | |
| 17 | 3. New p roperties SSOiToken, SSOiSECID , SSOiADUP N, SSOiLog onName | |
| 18 | ******** ********** ********** ********** ********** ** } | |
| 19 | unit XWBSS Oi; | |
| 20 | ||
| 21 | { | |
| 22 | Copyright 2016 Depar tment of V eterans Af fairs | |
| 23 | ||
| 24 | Licensed u nder the A pache Lice nse, Versi on 2.0 (th e "License "); | |
| 25 | you may no t use this file exce pt in comp liance wit h the Lice nse. | |
| 26 | You may ob tain a cop y of the L icense at | |
| 27 | ||
| 28 | http:/ /www.apach e.org/lice nses/LICEN SE-2.0 | |
| 29 | ||
| 30 | Unless req uired by a pplicable law or agr eed to in writing, s oftware | |
| 31 | distribute d under th e License is distrib uted on an "AS IS" B ASIS, | |
| 32 | WITHOUT WA RRANTIES O R CONDITIO NS OF ANY KIND, eith er express or implie d. | |
| 33 | See the Li cense for the specif ic languag e governin g permissi ons and | |
| 34 | limitation s under th e License. | |
| 35 | } | |
| 36 | ||
| 37 | { | |
| 38 | You’ ve got a c lient on a VA deploy ed Microso ft Windows workstati on that is | |
| 39 | part of the VA forest an d you want to obtain a SAML to ken from t he IAM STS | |
| 40 | serv ice. Subm it a SOAP request to ken messag e using mu tual TLS, where | |
| 41 | the client cer tificate i dentifies the user m aking the request. | |
| 42 | ||
| 43 | Sinc e VA works tation sec urity bloc ks most AP I attempts to 'POST' data to | |
| 44 | a we b site whe re you are not alrea dy authent icated, th e choices of a | |
| 45 | work ing API ar e limited. The use w ithin this unit of t he ActiveX | |
| 46 | TWeb Browser (s tripped do wn Interne t Explorer ) represen ts the onl y known | |
| 47 | work ing method of sendin g an https 'POST' to a web sit e using st andard | |
| 48 | Wind ows APIs a nd TLS mut ual authen tication ( PIV card) after the data is | |
| 49 | sent . | |
| 50 | } | |
| 51 | ||
| 52 | interface | |
| 53 | ||
| 54 | {$I IISBas e.inc} | |
| 55 | ||
| 56 | uses | |
| 57 | {Winapi} | |
| 58 | Winapi.M essages, | |
| 59 | Winapi.W indows, | |
| 60 | {System} | |
| 61 | System.C lasses, | |
| 62 | System.S ysUtils, | |
| 63 | System.V ariants, | |
| 64 | {Vcl} | |
| 65 | Vcl.Cont rols, | |
| 66 | Vcl.Dial ogs, | |
| 67 | Vcl.Form s, | |
| 68 | Vcl.Grap hics, | |
| 69 | Vcl.OleC trls, | |
| 70 | Vcl.StdC trls, | |
| 71 | {Utiliti es} | |
| 72 | MSHTML, | |
| 73 | SHDocVw, | |
| 74 | {VA} | |
| 75 | MFunStr, | |
| 76 | XWBut1; | |
| 77 | ||
| 78 | type | |
| 79 | {------ TX WBSSOiToke n ------} | |
| 80 | {:This com ponent def ines and o btains the STS SAML token used to authen ticate | |
| 81 | and identi fy the use r} | |
| 82 | TXWBSSOiTo ken = clas s(TCompone nt) | |
| 83 | private | |
| 84 | FSSOiTok enValue: S tring; | |
| 85 | FSSOiADU PNValue: S tring; | |
| 86 | FSSOiLog onNameValu e: String; | |
| 87 | FSSOiSEC IDValue: S tring; | |
| 88 | procedur e FSSOiTok en(Value: String); | |
| 89 | procedur e FSSOiADU PN(Value: String); | |
| 90 | procedur e FSSOiLog onName(Val ue: String ); | |
| 91 | procedur e FSSOiSEC ID(Value: String); | |
| 92 | protected | |
| 93 | public | |
| 94 | construc tor Create (AOwner: T Component) ; override ; | |
| 95 | destruct or Destroy ; override ; | |
| 96 | published | |
| 97 | property SSOiToken : String r ead FSSOiT okenValue write FSSO iToken; | |
| 98 | property SSOiADUPN : String r ead FSSOiA DUPNValue write FSSO iADUPN; | |
| 99 | property SSOiLogon Name: Stri ng read FS SOiLogonNa meValue wr ite FSSOiL ogonName; | |
| 100 | property SSOiSECID : String r ead FSSOiS ECIDValue write FSSO iSECID; | |
| 101 | end; | |
| 102 | ||
| 103 | TXWBSSOiFr m = class( TForm) | |
| 104 | WebBro wser1: TWe bBrowser; | |
| 105 | Label1 : TLabel; | |
| 106 | functi on CreateP ost(S: Str ing): OleV ariant; | |
| 107 | functi on GetLoca lComputerN ame: Strin g; | |
| 108 | functi on GetSTSS erver: Str ing; | |
| 109 | functi on GetMyTo ken: Strin g; | |
| 110 | proced ure WebBro wser1Navig ateComplet e2(ASender : TObject; | |
| 111 | cons t pDisp: I Dispatch; const URL: OleVarian t); | |
| 112 | proced ure WebBro wser1Docum entComplet e(ASender: TObject; | |
| 113 | cons t pDisp: I Dispatch; const URL: OleVarian t); | |
| 114 | proced ure FormCr eate(Sende r: TObject ); | |
| 115 | proced ure FormCl ose(Sender : TObject; var Actio n: TCloseA ction); | |
| 116 | proced ure WebBro wser1Befor eNavigate2 (ASender: TObject; | |
| 117 | cons t pDisp: I Dispatch; const URL, Flags, Ta rgetFrameN ame, PostD ata, | |
| 118 | Head ers: OleVa riant; var Cancel: W ordBool); | |
| 119 | proced ure WebBro wser1Navig ateError(A Sender: TO bject; con st pDisp: IDispatch; | |
| 120 | cons t URL, Fra me, Status Code: OleV ariant; va r Cancel: WordBool); | |
| 121 | private | |
| 122 | { Priv ate declar ations } | |
| 123 | FDispa tch: IDisp atch; | |
| 124 | FDocLo aded: Bool ean; | |
| 125 | public | |
| 126 | { Publ ic declara tions } | |
| 127 | end; | |
| 128 | ||
| 129 | var | |
| 130 | XWBSSOiF rm: TXWBSS OiFrm; | |
| 131 | myToken: String; / /used to p ass the va lue of the token bet ween form and compon ent | |
| 132 | ||
| 133 | implementa tion | |
| 134 | ||
| 135 | {$R *.dfm} | |
| 136 | ||
| 137 | //Note: In clude file contains SOAP messa ge and IAM server lo cation | |
| 138 | {$I IAMBas e.inc} | |
| 139 | ||
| 140 | {--------- ---------- -- TXWBSSO iToken.Cre ate ------ ---------- ------ | |
| 141 | This const ructor cre ates and o btains a S SOiToken, and sets t he value | |
| 142 | of the FSS OiTokenVal ue propert y to the t oken. It a lso sets t he | |
| 143 | remaining property v alues. Whe n the TXWB SSOiToken component is placed | |
| 144 | on a form, this will run autom atically w hen the fo rm is crea ted. | |
| 145 | ---------- ---------- ---------- ---------- ---------- ---------- ------} | |
| 146 | constructo r TXWBSSOi Token.Crea te(AOwner: TComponen t); | |
| 147 | begin | |
| 148 | inherite d Create(A Owner); | |
| 149 | FSSOiTok en(''); | |
| 150 | FSSOiADU PN(''); | |
| 151 | FSSOiLog onName('') ; | |
| 152 | FSSOiSEC ID(''); | |
| 153 | myToken := ''; | |
| 154 | end; //con structor T XWBSSOiTok en.Create | |
| 155 | ||
| 156 | ||
| 157 | {--------- ---------- -- TXWBSSO iToken.Des troy ----- ---------- ------ | |
| 158 | This destr uctor remo ves a SSOi Token. | |
| 159 | ---------- ---------- ---------- ---------- ---------- ---------- ------} | |
| 160 | destructor TXWBSSOiT oken.Destr oy; | |
| 161 | begin | |
| 162 | FSSOiTok enValue := ''; | |
| 163 | inherite d Destroy; | |
| 164 | end; //des tructor TX WBSSOiToke n.Destroy | |
| 165 | ||
| 166 | ||
| 167 | {--------- ---------- ------ TXW BSSOiToken .FSSOiToke n -------- ------ | |
| 168 | This proce dure looks at FSSOiT okenValue, and if nu ll then it does a SO AP | |
| 169 | request to the STS s erver for a new toke n. | |
| 170 | ---------- ---------- ---------- ---------- ---------- ---------- ------} | |
| 171 | procedure TXWBSSOiTo ken.FSSOiT oken(Value : String); | |
| 172 | begin | |
| 173 | if (FSSO iTokenValu e = '') th en | |
| 174 | begin | |
| 175 | try | |
| 176 | XWBS SOiFrm := TXWBSSOiFr m.Create(A pplication ); | |
| 177 | finall y | |
| 178 | FSSO iTokenValu e := myTok en; | |
| 179 | XWBS SOiFrm.Fre e; | |
| 180 | end; | |
| 181 | end; | |
| 182 | end; //pro cedure TXW BSSOiToken .FSSOiToke n | |
| 183 | ||
| 184 | ||
| 185 | {--------- ---------- ------ TXW BSSOiToken .FSSOiADUP N -------- ------ | |
| 186 | Returns th e ADUPN as signed to the user b y Identity and Acces s Manageme nt by | |
| 187 | examining the SAML t oken. If t here is no token sto red, retur ns null. | |
| 188 | ---------- ---------- ---------- ---------- ---------- ---------- ------} | |
| 189 | procedure TXWBSSOiTo ken.FSSOiA DUPN(Value : String); | |
| 190 | var | |
| 191 | myAdUpn: String; | |
| 192 | delimite r: String; | |
| 193 | begin | |
| 194 | myAdUpn := ''; | |
| 195 | if (FSSO iTokenValu e <> '') t hen | |
| 196 | begin | |
| 197 | delimi ter := '<s aml:Attrib ute Name=" upn"'; | |
| 198 | myAdUp n := Piece (FSSOiToke nValue, de limiter, 2 ); | |
| 199 | delimi ter := '</ saml:Attri buteValue> '; | |
| 200 | myAdUp n := Piece (myAdUpn, delimiter, 1); | |
| 201 | delimi ter := '<s aml:Attrib uteValue>' ; | |
| 202 | myAdUp n := Piece (myAdUpn, delimiter, 2); | |
| 203 | end; | |
| 204 | FSSOiADU PNValue := myAdUpn; | |
| 205 | end; //pro cedure TXW BSSOiToken .FSSOiADUP N | |
| 206 | ||
| 207 | ||
| 208 | {--------- ---------- ------ TXW BSSOiToken .FSSOiLogo nName ---- ------ | |
| 209 | Returns th e SECID as signed to the user b y Identity and Acces s Manageme nt by | |
| 210 | examining the SAML t oken. If t here is no token sto red, retur ns null. | |
| 211 | ---------- ---------- ---------- ---------- ---------- ---------- ------} | |
| 212 | procedure TXWBSSOiTo ken.FSSOiL ogonName(V alue: Stri ng); | |
| 213 | var | |
| 214 | myUserNa me: String ; | |
| 215 | delimite r: String; | |
| 216 | begin | |
| 217 | myUserNa me := ''; | |
| 218 | if (FSSO iTokenValu e <> '') t hen | |
| 219 | begin | |
| 220 | delimi ter := 'ur n:oasis:na mes:tc:xsp a:1.0:subj ect:subjec t-id'; | |
| 221 | myUser Name := Pi ece(FSSOiT okenValue, delimiter , 2); | |
| 222 | delimi ter := '</ saml:Attri buteValue> '; | |
| 223 | myUser Name := Pi ece(myUser Name, deli miter, 1); | |
| 224 | delimi ter := '<s aml:Attrib uteValue>' ; | |
| 225 | myUser Name := Pi ece(myUser Name, deli miter, 2); | |
| 226 | end; | |
| 227 | FSSOiLog onNameValu e := myUse rName; | |
| 228 | end; //pro cedure TXW BSSOiToken .FSSOiLogo nName | |
| 229 | ||
| 230 | ||
| 231 | {--------- ---------- ------ TXW BSSOiToken .FSSOiSECI D -------- ------ | |
| 232 | Returns th e SECID as signed to the user b y Identity and Acces s Manageme nt by | |
| 233 | examining the SAML t oken. If t here is no token sto red, retur ns null. | |
| 234 | ---------- ---------- ---------- ---------- ---------- ---------- ------} | |
| 235 | procedure TXWBSSOiTo ken.FSSOiS ECID(Value : String); | |
| 236 | var | |
| 237 | mySecID: String; | |
| 238 | delimite r: String; | |
| 239 | begin | |
| 240 | mySecID := ''; | |
| 241 | if (FSSO iTokenValu e <> '') t hen | |
| 242 | begin | |
| 243 | delimi ter := 'ur n:va:vrm:i am:secid'; | |
| 244 | mySecI D := Piece (FSSOiToke nValue, de limiter, 2 ); | |
| 245 | delimi ter := '</ saml:Attri buteValue> '; | |
| 246 | mySecI D := Piece (mySecID, delimiter, 1); | |
| 247 | delimi ter := '<s aml:Attrib uteValue>' ; | |
| 248 | mySecI D := Piece (mySecID, delimiter, 2); | |
| 249 | end; | |
| 250 | FSSOiSEC IDValue := mySecID; | |
| 251 | end; //pro cedure TXW BSSOiToken .FSSOiSECI D | |
| 252 | ||
| 253 | ||
| 254 | {--------- ---------- -- TXWBSSO iFrm.GetMy Token ---- ---------- ------ | |
| 255 | This funct ion is whe re all of the heavy lifting oc curs. It o pens the | |
| 256 | web browse r and send s a 'POST' to IAM, a nd sets th e return v alue to | |
| 257 | the variab le 'myToke n'. | |
| 258 | ---------- ---------- ---------- ---------- ---------- ---------- ------} | |
| 259 | function T XWBSSOiFrm .GetMyToke n: String; | |
| 260 | var | |
| 261 | Doc: IHT MLDocument 2; | |
| 262 | iamURL: String; | |
| 263 | iamMessa ge: String ; | |
| 264 | Computer Name: Stri ng; | |
| 265 | AppName: String; | |
| 266 | EmptyPar am: OleVar iant; | |
| 267 | Flags: O leVariant; | |
| 268 | Post: Ol eVariant; | |
| 269 | Header: OleVariant ; | |
| 270 | ovDocume nt: OleVar iant; | |
| 271 | rcvdToke n: String; | |
| 272 | begin | |
| 273 | FDispatc h := nil; | |
| 274 | rcvdToke n := ''; | |
| 275 | myToken := ''; | |
| 276 | EmptyPar am := 0; | |
| 277 | iamURL : = GetSTSSe rver; | |
| 278 | if (iamU RL <> '') then | |
| 279 | begin | |
| 280 | Comput erName := GetLocalCo mputerName ; | |
| 281 | AppNam e := Extra ctFileName (Applicati on.ExeName ); | |
| 282 | Flags := NavNoHi story + Na vNoReadFro mCache + N avNoWriteT oCache; | |
| 283 | //Doc := WebBrow ser1.Docum ent as IHT MLDocument 2; | |
| 284 | Doc := WebBrowse r1.Default Interface. Document a s IHTMLDoc ument2; | |
| 285 | WebBro wser1.Visi ble := Fal se; //Pe r MSDN, On DocumentCo mplete eve nt will no t trigger if Visible property is not Tru e. | |
| 286 | iamMes sage := ia mMessagePa rt1 +'http s://'+Comp uterName+' /Delphi_RP C_Broker/' +AppName + iamMessag ePart2; | |
| 287 | Header := 'Conte nt-Type: t ext/plain' + #10#13; | |
| 288 | Post : = CreatePo st(iamMess age); | |
| 289 | try | |
| 290 | //Au thenticate with PIV and 'POST' Soap mess age to obt ain SAML | |
| 291 | WebB rowser1.Na vigate(iam URL, Flags , EmptyPar am, Post, Header); | |
| 292 | whil e WebBrows er1.ReadyS tate < REA DYSTATE_IN TERACTIVE do | |
| 293 | Ap plication. ProcessMes sages; | |
| 294 | //On DocumentCo mplete eve nt should set myToke n, but doe sn't alway s trigger | |
| 295 | if m yToken <> '' then | |
| 296 | rc vdToken := myToken | |
| 297 | else | |
| 298 | tr y | |
| 299 | ovDocument := WebBro wser1.Docu ment; | |
| 300 | rcvdToken := ovDocum ent.XMLDoc ument.XML; | |
| 301 | ex cept | |
| 302 | rcvdToken := ''; //An err or above r eturns nul l string. | |
| 303 | en d; | |
| 304 | finall y | |
| 305 | end; | |
| 306 | WebBro wser1.Navi gate('abou t:blank'); | |
| 307 | WebBro wser1.Free ; | |
| 308 | end; | |
| 309 | Result : = RemoveCR LF(rcvdTok en); | |
| 310 | end; //fun ction TXWB SSOiFrm.Ge tMyToken | |
| 311 | ||
| 312 | ||
| 313 | ||
| 314 | {--------- ---------- -- TXWBSSO iFrm.Creat ePost ---- ---------- ------ | |
| 315 | This funct ion conver ts a strin g value in to an OleV ariant val ue, | |
| 316 | which is t he require d format f or data se nt in a TW ebBrowser 'POST'. | |
| 317 | ---------- ---------- ---------- ---------- ---------- ---------- ------} | |
| 318 | function T XWBSSOiFrm .CreatePos t(S: Strin g): OleVar iant; | |
| 319 | var | |
| 320 | Temp: Ol eVariant; | |
| 321 | I: Integ er; | |
| 322 | begin | |
| 323 | // The p ost must b e an array , but with out null t erminator (-1) | |
| 324 | Temp := VarArrayCr eate([0, L ength(S) - 1], varBy te); | |
| 325 | // Put p ost in arr ay | |
| 326 | for I := 1 to Leng th(S) do | |
| 327 | Temp[I - 1] := O rd(S[I]); | |
| 328 | Result : = Temp; | |
| 329 | end; //fun ction TXWB SSOiFrm.Cr eatePost | |
| 330 | ||
| 331 | ||
| 332 | {--------- ---------- -- TXWBSSO iFrm.FormC lose ----- ---------- ------ | |
| 333 | This proce dure runs when XWBCa llIamFrm F orm is clo sed. | |
| 334 | ---------- ---------- ---------- ---------- ---------- ---------- ------} | |
| 335 | procedure TXWBSSOiFr m.FormClos e(Sender: TObject; v ar Action: TCloseAct ion); | |
| 336 | begin | |
| 337 | WindowSt ate := wsN ormal; | |
| 338 | end; //pro cedure TXW BSSOiFrm.F ormClose | |
| 339 | ||
| 340 | ||
| 341 | {--------- ---------- -- TXWBSSO iFrm.FormC reate ---- ---------- ------ | |
| 342 | This proce dure insta ntiates XW BCallIamFr m Form. | |
| 343 | ---------- ---------- ---------- ---------- ---------- ---------- ------} | |
| 344 | procedure TXWBSSOiFr m.FormCrea te(Sender: TObject); | |
| 345 | begin | |
| 346 | myToken := ''; | |
| 347 | WindowSt ate := wsN ormal; //Token s eems to be truncated if this i s run mini mized | |
| 348 | myToken := GetMyTo ken; | |
| 349 | end; //pro cedure TXW BSSOiFrm.F ormCreate | |
| 350 | ||
| 351 | ||
| 352 | {--------- ---------- -- TXWBSSO iFrm.GetLo calCompute rName ---- ------ | |
| 353 | This funct ion obtain s the loca l computer name to b e sent in the | |
| 354 | TWebBrowse r 'POST' s o that the local com puter is i dentified in | |
| 355 | the return ed STS SAM L token (u seful data for VistA authentic ation). | |
| 356 | ---------- ---------- ---------- ---------- ---------- ---------- ------} | |
| 357 | function T XWBSSOiFrm .GetLocalC omputerNam e: String; | |
| 358 | var | |
| 359 | c1: dwor d; | |
| 360 | arrCh: a rray[0..MA X_PATH] of char; | |
| 361 | begin | |
| 362 | c1 := MA X_PATH; | |
| 363 | GetCompu terNameEx( ComputerNa meDnsFully Qualified, arrCh, c1 ); //Re trieves DN S name (FQ DN) of the local com puter | |
| 364 | if c1 > 0 then | |
| 365 | Result := arrCh | |
| 366 | else | |
| 367 | Result := ''; | |
| 368 | end; //fun ction TXWB SSOiFrm.Ge tLocalComp uterName | |
| 369 | ||
| 370 | ||
| 371 | {--------- ---------- -- TXWBSSO iFrm.GetST SServer -- ---------- ------ | |
| 372 | This funct ion gets t he address for the I dentity an d Access M anagement (IAM) | |
| 373 | Secure Tok en Service (STS) fro m the Wind ows HKLM R egistry. | |
| 374 | ---------- ---------- ---------- ---------- ---------- ---------- ------} | |
| 375 | function T XWBSSOiFrm .GetSTSSer ver: Strin g; | |
| 376 | var | |
| 377 | serverLi st : TStri ngList; | |
| 378 | serverVa lue : Stri ng; | |
| 379 | begin | |
| 380 | try | |
| 381 | //Read Windows R egistry (l ocal machi ne) for UR L of IAM s erver | |
| 382 | server List := TS tringList. Create; | |
| 383 | ReadRe gValues(HK LM, REG_IA M, serverL ist); | |
| 384 | //Assu me only (D efault) se rver in re gistry | |
| 385 | server Value := P iece(serve rList[0], '=', 2); | |
| 386 | finally | |
| 387 | if ser verValue = '' then | |
| 388 | begin | |
| 389 | serv erValue := IAM_Serve r_URL; // From 'incl ude' file IAMBase.in c | |
| 390 | end; | |
| 391 | end; | |
| 392 | Result : = serverVa lue; | |
| 393 | end; | |
| 394 | //function TXWBSSOiF rm.GetSTSS erver | |
| 395 | ||
| 396 | ||
| 397 | {--------- ------- TX WBSSOiFrm. WebBrowser 1BeforeNav igate2 --- ------ | |
| 398 | This proce dure is us ed to set event vari ables prio r to makin g a | |
| 399 | call to IA M. | |
| 400 | ---------- ---------- ---------- ---------- ---------- ---------- ------} | |
| 401 | procedure TXWBSSOiFr m.WebBrows er1BeforeN avigate2(A Sender: TO bject; | |
| 402 | const pD isp: IDisp atch; cons t URL, Fla gs, Target FrameName, PostData, | |
| 403 | Headers: OleVarian t; var Can cel: WordB ool); | |
| 404 | begin | |
| 405 | FDispatc h := nil; | |
| 406 | FDocLoad ed := Fals e; | |
| 407 | end; //pro cedure TXW BSSOiFrm.W ebBrowser1 BeforeNavi gate2 | |
| 408 | ||
| 409 | ||
| 410 | {--------- ------- TX WBSSOiFrm. WebBrowser 1DocumentC omplete -- ------ | |
| 411 | This proce dure is us ed to capt ure the ra w data (to ken) as it is | |
| 412 | received f rom IAM, a s we want the unalte red token, and not t he | |
| 413 | parsed tok en that is displayed in the we b browser. | |
| 414 | ---------- ---------- ---------- ---------- ---------- ---------- ------} | |
| 415 | procedure TXWBSSOiFr m.WebBrows er1Documen tComplete( ASender: T Object; | |
| 416 | const pD isp: IDisp atch; cons t URL: Ole Variant); | |
| 417 | var | |
| 418 | ovDocume nt: OleVar iant; | |
| 419 | rcvdToke n: String; | |
| 420 | begin | |
| 421 | if pDisp = FDispat ch then | |
| 422 | begin | |
| 423 | ovDocu ment := We bBrowser1. Document; | |
| 424 | try | |
| 425 | rcvd Token := o vDocument. XMLDocumen t.XML; | |
| 426 | except | |
| 427 | rcvd Token := ' '; | |
| 428 | end; | |
| 429 | myToke n := Remov eCRLF(rcvd Token); | |
| 430 | FDocLo aded := Tr ue; | |
| 431 | FDispa tch := nil ; | |
| 432 | end; | |
| 433 | end; //pro cedure TXW BSSOiFrm.W ebBrowser1 DocumentCo mplete | |
| 434 | ||
| 435 | ||
| 436 | {--------- ---- TXWBS SOiFrm.Web Browser1Na vigateComp lete2 ---- ------ | |
| 437 | This proce dure sets a flag whe n navigati on to the web site i s | |
| 438 | completed. The flag is used to monitor w eb browser activity. | |
| 439 | ---------- ---------- ---------- ---------- ---------- ---------- ------} | |
| 440 | procedure TXWBSSOiFr m.WebBrows er1Navigat eComplete2 (ASender: TObject; | |
| 441 | const pD isp: IDisp atch; cons t URL: Ole Variant); | |
| 442 | begin | |
| 443 | if FDisp atch = nil then | |
| 444 | FDispa tch := pDi sp; | |
| 445 | end; //pro cedure TXW BSSOiFrm.W ebBrowser1 NavigateCo mplete2 | |
| 446 | ||
| 447 | ||
| 448 | {--------- ---- TXWBS SOiFrm.Web Browser1Na vigateErro r -------- -- | |
| 449 | This proce dure sets a flag whe n navigati on to the web site g enerates | |
| 450 | an error. The flag i s used to monitor we b browser activity. | |
| 451 | ---------- ---------- ---------- ---------- ---------- ---------- ------} | |
| 452 | procedure TXWBSSOiFr m.WebBrows er1Navigat eError(ASe nder: TObj ect; | |
| 453 | const pD isp: IDisp atch; cons t URL, Fra me, Status Code: OleV ariant; | |
| 454 | var Canc el: WordBo ol); | |
| 455 | begin | |
| 456 | if FDisp atch = nil then | |
| 457 | FDispa tch := pDi sp; | |
| 458 | WebBrows er1.Naviga te('about: blank'); | |
| 459 | end; //pro cedure TXW BSSOiFrm.W ebBrowser1 NavigateEr ror | |
| 460 | ||
| 461 | end. |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.