Produced by Araxis Merge on 10/18/2017 11:37:29 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 | Rpcnet.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 | Rpcnet.pas | Tue Oct 17 19:58:08 2017 UTC |
| Description | Between Files 1 and 2 |
|
|---|---|---|
| Text Blocks | Lines | |
| Unchanged | 2 | 798 |
| 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, PII, PII | |
| 6 | De scription: Contains TRPCBroker and relat ed compone nts. | |
| 7 | Unit: Rp cnet winso ck utiliti es. | |
| 8 | Cu rrent Rele ase: Versi on 1.1 Pat ch 65 | |
| 9 | ********** ********** ********** ********** ********** ********** *** } | |
| 10 | ||
| 11 | { ******** ********** ********** ********** ********** ** | |
| 12 | Changes in v1.1.65 (HGW 08/0 5/2015) XW B*1.1*65 | |
| 13 | 1. None. | |
| 14 | ||
| 15 | Changes in v1.1.60 (HGW 07/1 6/2013) XW B*1.1*60 | |
| 16 | 1. Symbo l 'StrDisp ose' is de precated i n Delphi X E4, moved to the Ans iStrings u nit. | |
| 17 | 2. Symbo l 'StrPas' is deprec ated in De lphi XE4, moved to t he AnsiStr ings unit. | |
| 18 | 3. Upgra ded from W inSock 1.1 to WinSoc k 2.2 | |
| 19 | 4. //TOD O - Replac e uses win sock with uses winso ck2 and fi x errors. | |
| 20 | 5. //TOD O - IPv6 c hanges req uired by M icrosoft: | |
| 21 | a. Re place geth ostbyname function c alls with calls to o ne of the new getadd rinfo | |
| 22 | Wi ndows Sock ets functi ons. The g etaddrinfo function with suppo rt for the IPv6 | |
| 23 | pr otocol is available on Windows XP and la ter. The I Pv6 protoc ol is also supported | |
| 24 | on Windows 2 000 when t he IPv6 Te chnology P review for Windows 2 000 is ins talled. | |
| 25 | ||
| 26 | Changes in v1.1.13 (JLI 08/2 3/2000) XW B*1.1*13 | |
| 27 | 1. Made changes to cursor de pendent on current c ursor bein g crDefaul t | |
| 28 | so th at the app lication c an set it to a diffe rent curso r for long or | |
| 29 | repea ted proces ses withou t the curs or 'flashi ng' repeat edly. | |
| 30 | ********** ********** ********** ********** ********** } | |
| 31 | unit Rpcne t ; | |
| 32 | ||
| 33 | interface | |
| 34 | ||
| 35 | uses | |
| 36 | {System} | |
| 37 | AnsiStri ngs, SysUt ils, Class es, | |
| 38 | {WinApi} | |
| 39 | WinTypes , WinProcs , Messages , Winsock, | |
| 40 | {Vcl} | |
| 41 | Graphics , Controls , Forms, D ialogs; | |
| 42 | ||
| 43 | Const XWB_ GHIP = WM_ USER + 100 00; | |
| 44 | ||
| 45 | //Upgrade from WinSo ck 1.1 to WinSock 2. 2 | |
| 46 | //Const Wi nSockVer = $0101; | |
| 47 | Const WinS ockVer = $ 0202; | |
| 48 | Const PF_I NET = 2; | |
| 49 | Const SOCK _STREAM = 1; | |
| 50 | Const IPPR OTO_TCP = 6; | |
| 51 | Const INVA LID_SOCKET = -1; | |
| 52 | Const SOCK ET_ERROR = -1; | |
| 53 | Const FION READ = $40 04667F; | |
| 54 | Const Acti veConnecti on: boolea n = False; | |
| 55 | ||
| 56 | type Echat Error = cl ass(Except ion); | |
| 57 | ||
| 58 | type | |
| 59 | TRPCFRM1 = class(T Form) | |
| 60 | private | |
| 61 | { Priv ate declar ations } | |
| 62 | public | |
| 63 | { Publ ic declara tions } | |
| 64 | proced ure XWBGHI P(var msgS ock: TMess age); | |
| 65 | //proc edure xwbS elect(var msgSock: T Message); //P14 | |
| 66 | proced ure WndPro c(var Mess age : TMes sage); rei ntroduce; //P14 | |
| 67 | end; | |
| 68 | ||
| 69 | type | |
| 70 | WinTaskR ec = recor d | |
| 71 | InUse : boolean; | |
| 72 | pTCPR esult: Poi nter; | |
| 73 | strTe mp: string ; {generic output st ring for a sync calls } | |
| 74 | chrTe mp: PAnsiC har; {gene ric out PC har for as ync calls} // JLI 0 90804 | |
| 75 | hTCP: THandle; {pseudo ha ndle for a sync calls } | |
| 76 | hWin: hWnd; {ha ndle for o wner windo w} | |
| 77 | CallW ait: boole an; | |
| 78 | CallA bort: bool ean; | |
| 79 | RPCFR M1: TRPCFR M1; | |
| 80 | end; | |
| 81 | ||
| 82 | var | |
| 83 | WRec: a rray[1..12 8] of WinT askRec; | |
| 84 | Hash: a rray[0..15 9] of char ; | |
| 85 | ||
| 86 | {Windows O S abstract ion functi ons. Shou ld be take n over by VA Kernel} | |
| 87 | ||
| 88 | function l ibGetCurre ntProcess: word; | |
| 89 | ||
| 90 | {Socket fu nctions us ing librar y RPCLIB.D LL, in thi s case cal led locall y} | |
| 91 | ||
| 92 | function libGetHost IP1(inst: integer; H ostName: P AnsiChar; // JLI 09 0804 | |
| 93 | var outcom e: PAnsiCh ar): integ er; export ; // JLI 090804 | |
| 94 | function libGetLoca lIP(inst: integer; v ar outcome : PAnsiCha r): intege r; export; // JLI 0 90804 | |
| 95 | procedure libClose(i nst: integ er); expor t; | |
| 96 | function libOpen:in teger; exp ort; | |
| 97 | ||
| 98 | function G etTCPError :string; | |
| 99 | ||
| 100 | {Secure Ha sh Algorit hm functio ns, librar y SHA.DLL and local interfaces } | |
| 101 | ||
| 102 | function l ibGetLocal Module: PC har; expor t; | |
| 103 | function G etFileHash (fn: PAnsi Char): lon gint; expo rt; // JL I 090804 | |
| 104 | ||
| 105 | implementa tion | |
| 106 | ||
| 107 | uses | |
| 108 | {VA} | |
| 109 | Rpcconf1 ; | |
| 110 | ||
| 111 | {$R *.DFM} | |
| 112 | ||
| 113 | ||
| 114 | ||
| 115 | function l ibGetCurre ntProcess: word; | |
| 116 | begin | |
| 117 | Result : = GetCurre ntProcess; | |
| 118 | end; | |
| 119 | ||
| 120 | function l ibGetLocal IP(inst: i nteger; va r outcome: PAnsiChar ): integer ; | |
| 121 | var | |
| 122 | local: PAnsiChar; | |
| 123 | begin | |
| 124 | local := PAnsiC har(StrAll oc(255)); | |
| 125 | getho stname( lo cal, 255); | |
| 126 | Resul t := libGe tHostIP1(i nst, local , outcome) ; | |
| 127 | AnsiS trings.Str Dispose(lo cal); //p60 | |
| 128 | end; | |
| 129 | ||
| 130 | function l ibGetLocal Module: PC har; | |
| 131 | var | |
| 132 | tsk: TH andle; | |
| 133 | name: P Char; | |
| 134 | begin | |
| 135 | tsk : = GetCurre ntProcess; | |
| 136 | name := StrAllo c(1024); | |
| 137 | GetMo duleFilena me(tsk, na me, 1024); | |
| 138 | Resul t := name; | |
| 139 | ||
| 140 | end; | |
| 141 | ||
| 142 | function G etFileHash (fn: PAnsi Char): lon gint; | |
| 143 | var | |
| 144 | hFn: in teger; | |
| 145 | finfo: TOFSTRUCT; | |
| 146 | bytesRe ad, status : longint; | |
| 147 | tBuf: P Char; | |
| 148 | ||
| 149 | begin | |
| 150 | tBuf := StrAllo c(160); | |
| 151 | hFn : = OpenFile (fn, finfo , OF_READ) ; | |
| 152 | bytes Read := 0; | |
| 153 | statu s := _lrea d(hFn, tBu f, sizeof( tBuf)); | |
| 154 | while status <> 0 do | |
| 155 | begin | |
| 156 | status := _lread(hFn , tBuf, si zeof(tBuf) ); | |
| 157 | inc(bytesR ead,status ); | |
| 158 | end; | |
| 159 | _lclo se(hFn); | |
| 160 | StrDi spose(tBuf ); | |
| 161 | Resul t := bytes Read; | |
| 162 | end; | |
| 163 | ||
| 164 | function l ibOpen:int eger; | |
| 165 | var | |
| 166 | inst: i nteger; | |
| 167 | WSData: TWSADATA; | |
| 168 | RPCFRM1 : TRPCFRM1 ; | |
| 169 | begin | |
| 170 | inst := 1; {in this case, no DLL so instance is always 1} | |
| 171 | RPCFR M1 := TRPC FRM1.Creat e(nil); //P14 | |
| 172 | with WRec[inst] do | |
| 173 | begin | |
| 174 | hWin := Allocat eHWnd(RPCF RM1.wndpro c); | |
| 175 | ||
| 176 | WSASt artUp(WinS ockVer, WS Data); | |
| 177 | WSAUn hookBlocki ngHook; | |
| 178 | ||
| 179 | Resul t := inst; | |
| 180 | InUse := True; | |
| 181 | end; | |
| 182 | RPCFR M1.Release ; //P14 | |
| 183 | end; | |
| 184 | ||
| 185 | procedure libClose(i nst: integ er); | |
| 186 | begin | |
| 187 | ||
| 188 | with WRec[inst] do | |
| 189 | begin | |
| 190 | In Use := Fal se; | |
| 191 | WS ACleanup; | |
| 192 | De allocateHW nd(hWin); | |
| 193 | end; | |
| 194 | end; | |
| 195 | ||
| 196 | function l ibGetHostI P1(inst: i nteger; Ho stName: PA nsiChar; | |
| 197 | v ar outcome : PAnsiCha r): intege r; | |
| 198 | var | |
| 199 | ChangeC ursor: Boo lean; | |
| 200 | ||
| 201 | begin | |
| 202 | ||
| 203 | outcome [0] := #0; | |
| 204 | ||
| 205 | if Scre en.Cursor = crDefaul t then | |
| 206 | Chang eCursor := True | |
| 207 | else | |
| 208 | Chang eCursor := False; | |
| 209 | if Chan geCursor t hen | |
| 210 | Scree n.Cursor : = crHourGl ass; | |
| 211 | ||
| 212 | with WR ec[inst] d o | |
| 213 | begin | |
| 214 | ||
| 215 | if Host Name[0] = #0 then | |
| 216 | begin | |
| 217 | An siStrings. StrCat(out come,'No N ame to Res olve!'); //p60 | |
| 218 | Re sult := -1 ; | |
| 219 | ex it; | |
| 220 | end; | |
| 221 | ||
| 222 | if Call Wait = Tru e then | |
| 223 | begin | |
| 224 | ou tcome[0] : = #0; | |
| 225 | An siStrings. StrCat(out come, 'Cal l in Progr ess'); //p60 | |
| 226 | Re sult := -1 ; | |
| 227 | ex it; | |
| 228 | end; | |
| 229 | ||
| 230 | if inet _addr(Host Name) > IN ADDR_ANY t hen | |
| 231 | begin | |
| 232 | ou tcome := H ostname; | |
| 233 | Re sult := 0; | |
| 234 | if ChangeCur sor then | |
| 235 | Screen.Cur sor := crD efault; | |
| 236 | WS ACleanup; | |
| 237 | ex it; | |
| 238 | end; | |
| 239 | ||
| 240 | GetMem( pTCPResult , MAXGETHO STSTRUCT+1 ); | |
| 241 | try | |
| 242 | begi n | |
| 243 | CallWait := True; | |
| 244 | CallAbort := False; | |
| 245 | PHostEnt( pTCPResult )^.h_name := nil; | |
| 246 | //TODO - R eplace get hostbyname function calls with calls to one of the new getad drinfo Win dows Socke ts functio ns. | |
| 247 | hTCP := W SAAsyncGet HostByName (hWin, XWB _GHIP, Hos tName, | |
| 248 | pTCP Result, MA XGETHOSTST RUCT ); | |
| 249 | { loop wh ile CallWa it is True } | |
| 250 | CallAbort := False; | |
| 251 | while Cal lWait = Tr ue do | |
| 252 | App lication.P rocessMess ages; | |
| 253 | end; | |
| 254 | except on EInVali dPointer d o | |
| 255 | begin | |
| 256 | An siStrings. StrCat(out come,'Erro r in GetHo stByName') ; / /p60 | |
| 257 | if ChangeCur sor then | |
| 258 | Screen.Cur sor := crD efault; | |
| 259 | end; | |
| 260 | ||
| 261 | end; | |
| 262 | ||
| 263 | FreeMem (pTCPResul t, MAXGETH OSTSTRUCT+ 1); | |
| 264 | AnsiStr ings.StrCo py(outcome ,chrTemp); //p60 | |
| 265 | Result := 0; | |
| 266 | if Chan geCursor t hen | |
| 267 | Scree n.Cursor : = crDefaul t; | |
| 268 | end; | |
| 269 | end; | |
| 270 | ||
| 271 | procedure TRPCFRM1.W ndProc(var Message : TMessage) ; | |
| 272 | begin | |
| 273 | with Mes sage do | |
| 274 | cas e Msg of | |
| 275 | {XWB_SEL ECT : xwbS elect(Mess age);} //P14 | |
| 276 | XWB_GHIP : xwbghip( Message); | |
| 277 | els e | |
| 278 | DefWindow Proc(WRec[ 1].hWin, M sg, wParam , lParam); | |
| 279 | {Inherite d WndProc( Message);} | |
| 280 | end ; | |
| 281 | end; | |
| 282 | ||
| 283 | procedure TRPCFRM1.X WBGHIP(var msgSock: TMessage); | |
| 284 | var | |
| 285 | TCPResu lt: PHostE nt; | |
| 286 | WSAErro r: integer ; | |
| 287 | HostAdd r: TSockad dr; | |
| 288 | inst: i nteger; | |
| 289 | ||
| 290 | begin | |
| 291 | inst := 1; {local case is a lways 1} | |
| 292 | ||
| 293 | ||
| 294 | with WR ec[inst] d o | |
| 295 | begin | |
| 296 | ||
| 297 | hTCP := msgSock.W Param; | |
| 298 | ||
| 299 | chrTemp := PAnsiC har(StrAll oc(512)); // JLI 09 0804 | |
| 300 | ||
| 301 | CallWai t := False ; | |
| 302 | If Call Abort = Tr ue then { User abor ted call } | |
| 303 | begin | |
| 304 | An siStrings. StrCopy(Ch rTemp,'Abo rt!'); //p60 | |
| 305 | ex it; | |
| 306 | end; | |
| 307 | ||
| 308 | WSAErro r := WSAGe tAsyncErro r(hTCP); { in case a sync call failed } | |
| 309 | If WSA Error < 0 then | |
| 310 | begin | |
| 311 | An siStrings. StrPCopy(c hrTemp,Int ToStr(WSAE rror)); //p60 | |
| 312 | ex it; | |
| 313 | end; | |
| 314 | ||
| 315 | try | |
| 316 | begin | |
| 317 | TCPR esult := P HostEnt(pT CPResult); | |
| 318 | StrT emp := ''; | |
| 319 | if TCPResult^ .h_name = nil then | |
| 320 | b egin | |
| 321 | AnsiSt rings.StrC opy(chrTem p, 'Unknow n!'); / /p60 | |
| 322 | if rpc config <> nil then | |
| 323 | rpcc onfig.pnlA ddress.Cap tion := An siStrings. StrPas(chr Temp); / /p60 | |
| 324 | exit; | |
| 325 | e nd; | |
| 326 | {suc cess, retu rn resolve d address} | |
| 327 | Host Addr.sin_a ddr.S_addr := longin t(plongint (TCPResult ^.h_addr_l ist^)^); | |
| 328 | chrT emp := ine t_ntoa(Hos tAddr.sin_ addr); | |
| 329 | end; | |
| 330 | except on EInVali dPointer d o AnsiStri ngs.StrCat (chrTemp, 'Error in GetHostByN ame'); //p60 | |
| 331 | end; | |
| 332 | end; | |
| 333 | end; | |
| 334 | ||
| 335 | //TODO -- Can this b e replaced with a ca ll to simi lar functi on in Wsoc kc.pas? | |
| 336 | function G etTCPError :string; | |
| 337 | var | |
| 338 | x: stri ng; | |
| 339 | r: inte ger; | |
| 340 | ||
| 341 | begin | |
| 342 | r := WSAGetLas tError; | |
| 343 | Case r of | |
| 344 | WS AEINTR : x := 'WSAEI NTR'; | |
| 345 | WS AEBADF : x := 'WSAEI NTR'; | |
| 346 | WS AEFAULT : x := 'WSAEF AULT'; | |
| 347 | WS AEINVAL : x := 'WSAEI NVAL'; | |
| 348 | WS AEMFILE : x := 'WSAEM FILE'; | |
| 349 | WS AEWOULDBLO CK : x := 'WSAEW OULDBLOCK' ; | |
| 350 | WS AEINPROGRE SS : x := 'WSAEI NPROGRESS' ; | |
| 351 | WS AEALREADY : x := 'WSAEA LREADY'; | |
| 352 | WS AENOTSOCK : x := 'WSAEN OTSOCK'; | |
| 353 | WS AEDESTADDR REQ : x := 'WSAED ESTADDRREQ '; | |
| 354 | WS AEMSGSIZE : x := 'WSAEM SGSIZE'; | |
| 355 | WS AEPROTOTYP E : x := 'WSAEP ROTOTYPE'; | |
| 356 | WS AENOPROTOO PT : x := 'WSAEN OPROTOOPT' ; | |
| 357 | WS AEPROTONOS UPPORT : x := 'WSAEP ROTONOSUPP ORT'; | |
| 358 | WS AESOCKTNOS UPPORT : x := 'WSAES OCKTNOSUPP ORT'; | |
| 359 | WS AEOPNOTSUP P : x := 'WSAEO PNOTSUPP'; | |
| 360 | WS AEPFNOSUPP ORT : x := 'WSAEP FNOSUPPORT '; | |
| 361 | WS AEAFNOSUPP ORT : x := 'WSAEA FNOSUPPORT '; | |
| 362 | WS AEADDRINUS E : x := 'WSAEA DDRINUSE'; | |
| 363 | WS AEADDRNOTA VAIL : x := 'WSAEA DDRNOTAVAI L'; | |
| 364 | WS AENETDOWN : x := 'WSAEN ETDOWN'; | |
| 365 | WS AENETUNREA CH : x := 'WSAEN ETUNREACH' ; | |
| 366 | WS AENETRESET : x := 'WSAEN ETRESET'; | |
| 367 | WS AECONNABOR TED : x := 'WSAEC ONNABORTED '; | |
| 368 | WS AECONNRESE T : x := 'WSAEC ONNRESET'; | |
| 369 | WS AENOBUFS : x := 'WSAEN OBUFS'; | |
| 370 | WS AEISCONN : x := 'WSAEI SCONN'; | |
| 371 | WS AENOTCONN : x := 'WSAEN OTCONN'; | |
| 372 | WS AESHUTDOWN : x := 'WSAES HUTDOWN'; | |
| 373 | WS AETOOMANYR EFS : x := 'WSAET OOMANYREFS '; | |
| 374 | WS AETIMEDOUT : x := 'WSAET IMEDOUT'; | |
| 375 | WS AECONNREFU SED : x := 'WSAEC ONNREFUSED '; | |
| 376 | WS AELOOP : x := 'WSAEL OOP'; | |
| 377 | WS AENAMETOOL ONG : x := 'WSAEN AMETOOLONG '; | |
| 378 | WS AEHOSTDOWN : x := 'WSAEH OSTDOWN'; | |
| 379 | WS AEHOSTUNRE ACH : x := 'WSAEH OSTUNREACH '; | |
| 380 | WS AENOTEMPTY : x := 'WSAEN OTEMPTY'; | |
| 381 | WS AEPROCLIM : x := 'WSAEP ROCLIM'; | |
| 382 | WS AEUSERS : x := 'WSAEU SERS'; | |
| 383 | WS AEDQUOT : x := 'WSAED QUOT'; | |
| 384 | WS AESTALE : x := 'WSAES TALE'; | |
| 385 | WS AEREMOTE : x := 'WSAER EMOTE'; | |
| 386 | WS ASYSNOTREA DY : x := 'WSASY SNOTREADY' ; | |
| 387 | WS AVERNOTSUP PORTED : x := 'WSAVE RNOTSUPPOR TED'; | |
| 388 | WS ANOTINITIA LISED : x := 'WSANO TINITIALIS ED'; | |
| 389 | WS AHOST_NOT_ FOUND : x := 'WSAHO ST_NOT_FOU ND'; | |
| 390 | WS ATRY_AGAIN : x := 'WSATR Y_AGAIN'; | |
| 391 | WS ANO_RECOVE RY : x := 'WSANO _RECOVERY' ; | |
| 392 | WS ANO_DATA : x := 'WSANO _DATA'; | |
| 393 | ||
| 394 | el se x := 'U nknown Err or'; | |
| 395 | end; | |
| 396 | Result : = x + ' (' + IntToSt r(r) + ')' ; | |
| 397 | end; | |
| 398 | ||
| 399 | ||
| 400 | end. |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.