Produced by Araxis Merge on 11/6/2017 12:10:31 PM Central Standard 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 | ccre.zip\ccre\EmbedWB\Source | EwbUrl.pas | Thu Nov 2 15:29:46 2017 UTC |
| 2 | ccre.zip\ccre\EmbedWB\Source | EwbUrl.pas | Mon Nov 6 16:02:13 2017 UTC |
| Description | Between Files 1 and 2 |
|
|---|---|---|
| Text Blocks | Lines | |
| Unchanged | 3 | 1656 |
| Changed | 2 | 6 |
| 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 | // URL Tools * | |
| 3 | // (U niform Res ource iden tifier) * | |
| 4 | // * | |
| 5 | // For Bor land Delph i * | |
| 6 | // Freew are Unit * | |
| 7 | // b y Eran Bod ankin - bs alsa - bsa lsa@gmail. com * | |
| 8 | // * | |
| 9 | // QueryUrl f unction is based on Indy algor ithm * | |
| 10 | // from: http://ww w.indyproj ect.org/ * | |
| 11 | // * | |
| 12 | // Documen tation and updated v ersions: * | |
| 13 | // http://www .bsalsa.co m * | |
| 14 | //******** ********** ********** ********** ********** ********** * | |
| 15 | ||
| 16 | {********* ********** ********** ********** ********** ********** ********** ********** } | |
| 17 | {LICENSE: | |
| 18 | THIS SOFTW ARE IS PRO VIDED TO Y OU "AS IS" WITHOUT W ARRANTY OF ANY KIND, | |
| 19 | EITHER EXP RESSED OR IMPLIED IN CLUDING BU T NOT LIMI TED TO THE APPLIED | |
| 20 | WARRANTIES OF MERCHA NTABILITY AND/OR FIT NESS FOR A PARTICULA R PURPOSE. | |
| 21 | YOU ASSUME THE ENTIR E RISK AS TO THE ACC URACY AND THE USE OF THE SOFTW ARE | |
| 22 | AND ALL OT HER RISK A RISING OUT OF THE US E OR PERFO RMANCE OF THIS SOFTW ARE | |
| 23 | AND DOCUME NTATION. B SALSA PROD UCTIONS DO ES NOT WAR RANT THAT THE SOFTWA RE IS ERRO R-FREE | |
| 24 | OR WILL OP ERATE WITH OUT INTERR UPTION. TH E SOFTWARE IS NOT DE SIGNED, IN TENDED | |
| 25 | OR LICENSE D FOR USE IN HAZARDO US ENVIRON MENTS REQU IRING FAIL -SAFE CONT ROLS, | |
| 26 | INCLUDING WITHOUT LI MITATION, THE DESIGN , CONSTRUC TION, MAIN TENANCE OR | |
| 27 | OPERATION OF NUCLEAR FACILITIE S, AIRCRAF T NAVIGATI ON OR COMM UNICATION SYSTEMS, | |
| 28 | AIR TRAFFI C CONTROL, AND LIFE SUPPORT OR WEAPONS S YSTEMS. BS ALSA PRODU CTIONS SPE CIFICALLY | |
| 29 | DISCLAIMS ANY EXPRES S OR IMPLI ED WARRANT Y OF FITNE SS FOR SUC H PURPOSE. | |
| 30 | ||
| 31 | You may us e, change or modify the compon ent under 4 conditio ns: | |
| 32 | 1. In your website, add a link to "http: //www.bsal sa.com" | |
| 33 | 2. In your applicati on, add cr edits to " Embedded W eb Browser " | |
| 34 | 3. Mail me (bsalsa@g mail.com) any code c hange in t he unit | |
| 35 | for the benefit o f the othe r users. | |
| 36 | 4. Please, consider donation i n our web site! | |
| 37 | {********* ********** ********** ********** ********** ********** ********** ********** } | |
| 38 | //$Id: Ewb Url.pas,v 1 2007/02/ 15 21:01:4 2 bsalsa E xp $ | |
| 39 | { | |
| 40 | QueryUrl S tructure: | |
| 41 | Protocol + :// + U serName + : + Passwo rd + HostN ame + Port + Path + | |
| 42 | Document + Paramet ers+ Bookm ark | |
| 43 | ||
| 44 | CrackUrl S tructure: | |
| 45 | <Scheme>:/ /<UserName >:<Passwor d>@<HostNa me>:<PortN umber>/<Ur lPath><Ext raInfo> | |
| 46 | Note by M S: | |
| 47 | (Some fiel ds are opt ional.) Fo r example, consider this URL: | |
| 48 | http:// USER_NAME : PW @www.micro soft.com:8 0/visualc/ stuff.htm# contents | |
| 49 | ||
| 50 | CrackUrl p arses it a s follows: | |
| 51 | * Scheme: "http" or ATL_URL_SC HEME_HTTP | |
| 52 | * UserName : " USER_NAME " | |
| 53 | * Password : " PW " | |
| 54 | * HostName : "www.mic rosoft.com " | |
| 55 | * PortNumb er: 80 | |
| 56 | * UrlPath: "visualc/ stuff.htm" | |
| 57 | * ExtraInf o: "#conte nts" | |
| 58 | ||
| 59 | URL_COMPON ENTS = rec ord that c ontains: | |
| 60 | dwStru ctSize: DW ORD; = size of this stru cture. Use d in versi on check | |
| 61 | lpszSc heme: LPST R; = pointer to scheme name | |
| 62 | dwSche meLength: DWORD; = length of scheme name | |
| 63 | nSchem e: TIntern etScheme; = enumera ted scheme type (if known) | |
| 64 | lpszHo stName: LP STR; = pointer to host n ame | |
| 65 | dwHost NameLength : DWORD; = length of host na me | |
| 66 | nPort: INTERNET_ PORT; = convert ed port nu mber | |
| 67 | pad: W ORD; = force c orrect all ignment re gardless o f comp. fl ags | |
| 68 | lpszUs erName: LP STR; = pointer to user n ame | |
| 69 | dwUser NameLength : DWORD; = length of user na me | |
| 70 | lpszPa ssword: LP STR; = pointer to passwo rd | |
| 71 | dwPass wordLength : DWORD; = length of passwor d | |
| 72 | lpszUr lPath: LPS TR; = pointer to URL-pa th | |
| 73 | dwUrlP athLength: DWORD; = length of URL-pat h | |
| 74 | lpszEx traInfo: L PSTR; = pointer to extra informatio n (e.g. ?f oo or #foo ) | |
| 75 | dwExtr aInfoLengt h: DWORD; = length of extra i nformation | |
| 76 | ||
| 77 | URL_COMPON ENTS on MS DN: | |
| 78 | http://msd n2.microso ft.com/en- us/library /aa385420. aspx | |
| 79 | ||
| 80 | CoInternet QueryInfo Function f ags: | |
| 81 | http://msd n.microsof t.com/libr ary/defaul t.asp?url= /workshop/ networking /moniker/r eference/e nums/query option.asp | |
| 82 | } | |
| 83 | ||
| 84 | unit EwbUr l; | |
| 85 | ||
| 86 | {$I EWB.in c} | |
| 87 | ||
| 88 | {$DEFINE U SE_DebugSt ring} | |
| 89 | ||
| 90 | interface | |
| 91 | ||
| 92 | uses | |
| 93 | Dialogs, Windows, WinInet; | |
| 94 | ||
| 95 | const | |
| 96 | TEMP_SIZ E = 1024; | |
| 97 | MAX_BUFF ER = 256; | |
| 98 | WebDelim = '/'; | |
| 99 | Protocol Delim = ': //'; | |
| 100 | QueryDel im = '?'; | |
| 101 | Bookmark Delim = '# '; | |
| 102 | EqualDel im = '='; | |
| 103 | DriveDel im = ':'; //I know i t's in Sys Utils alre ady but, n ot in D5. | |
| 104 | type | |
| 105 | TQueryOp tion = ULO NG; | |
| 106 | TCoInter netQueryIn fo = funct ion(pwzUrl : LPCWSTR; QueryOpti ons: TQuer yOption; d wQueryFlag s: DWORD; | |
| 107 | pvBuff er: Pointe r; cbBuffe r: DWORD; var pcbBuf fer: DWORD ; dwReserv ed: DWORD) : HResult; stdcall; | |
| 108 | ||
| 109 | type | |
| 110 | TOnError = procedu re(Sender: TObject; ErrorCode: integer; ErrMessage : string) of object; | |
| 111 | type | |
| 112 | TUrl = c lass | |
| 113 | private | |
| 114 | FDocum ent: strin g; | |
| 115 | FProto col: strin g; | |
| 116 | FUrl: string; | |
| 117 | FPort: Integer; | |
| 118 | FUrlPa th: string ; | |
| 119 | FHostN ame: strin g; | |
| 120 | FExtra Info: stri ng; | |
| 121 | FUserN ame: strin g; | |
| 122 | FPassw ord: strin g; | |
| 123 | FBookm ark: strin g; | |
| 124 | FOnErr or: TOnErr or; | |
| 125 | FParam eters: str ing; | |
| 126 | FUrlCo mponent: U RL_COMPONE NTS; | |
| 127 | CoInte rnetQueryI nfo: TCoIn ternetQuer yInfo; | |
| 128 | functi on initCoI nternetQue ryInfo: bo olean; | |
| 129 | protecte d | |
| 130 | proced ure SetUrl (const Val ue: string ); | |
| 131 | proced ure FillUr lComponent ; | |
| 132 | public | |
| 133 | functi on FixUrl( Url: strin g): string ; | |
| 134 | functi on BuildUr l: WideStr ing; | |
| 135 | functi on Canonic alizeUrl(c onst Url: string; dw Flags: int eger): Wid eString; | |
| 136 | functi on Combine Url(const BaseUrl, R elativaUrl : string; dwFlags: D Word): Wid eString; | |
| 137 | functi on Compare Url(const pwzUrl1, p wzUrl2: Wi deString): HResult; | |
| 138 | functi on CrackUr l(const Ur l: string; dwFlags: DWord): Wi deString; | |
| 139 | functi on CreateU rl(const d wFlags: DW ord): Wide String; | |
| 140 | functi on EncodeU rl(const I nputStr: s tring; con st bQueryS tr: Boolea n): string ; | |
| 141 | functi on DecodeU rl(const I nputStr: s tring): st ring; | |
| 142 | functi on IsUrlVa lid(const Url: strin g): boolea n; | |
| 143 | functi on IsUrlCa ched(const Url: stri ng): boole an; | |
| 144 | functi on GetUrlS ize(const Url: strin g): string ; | |
| 145 | functi on GetUrlT ype(const Url: strin g): string ; | |
| 146 | functi on GetUrlP rotocolVer sion(const Url: stri ng): strin g; | |
| 147 | functi on GetUrlS erverDetai ls(const U rl: string ): string; | |
| 148 | functi on GetUrlC harSet(con st Url: st ring): str ing; | |
| 149 | functi on GetUrlS erver(cons t Url: str ing): stri ng; | |
| 150 | functi on GetUrlL astModifie d(const Ur l: string) : string; | |
| 151 | functi on GetUrlD ate(const Url: strin g): string ; | |
| 152 | functi on GetUrlS tatusCode( const Url: string): string; | |
| 153 | functi on GetUrlE ntityTag(c onst Url: string): s tring; | |
| 154 | functi on QueryIn fo(const U rl: string ; dwInfoFl ag: Intege r): string ; | |
| 155 | functi on CoInetQ ueryInfo(c onst Url: WideString ; QueryOpt ions: Card inal): Boo lean; | |
| 156 | functi on ReadFil e(const UR L: string; TimeOut: LongWord): string; | |
| 157 | proced ure Clear; | |
| 158 | proced ure ClearU rlComponen t; | |
| 159 | proced ure QueryU rl(Url: st ring); | |
| 160 | constr uctor Crea te(const U rl: string ); overloa d; | |
| 161 | public | |
| 162 | proper ty Bookmar k: string read FBook mark write FBookmark ; | |
| 163 | proper ty Documen t: string read FDocu ment write FDocument ; | |
| 164 | proper ty ExtraIn fo: string read FExt raInfo wri te FExtraI nfo; | |
| 165 | proper ty HostNam e: string read FHost Name write FHostName ; | |
| 166 | proper ty Paramet ers: strin g read FPa rameters w rite FPara meters; | |
| 167 | proper ty Passwor d: string read FPass word write FPassword ; | |
| 168 | proper ty Port: I nteger rea d FPort wr ite FPort; | |
| 169 | proper ty Protoco l: string read FProt ocol write FProtocol ; | |
| 170 | proper ty OnError : TOnError read FOnE rror write FOnError; | |
| 171 | proper ty Url: st ring read FUrl write SetUrl; | |
| 172 | proper ty UrlComp onent: URL _COMPONENT S read FUr lComponent write FUr lComponent ; | |
| 173 | proper ty UrlPath : string r ead FUrlPa th write F UrlPath; | |
| 174 | proper ty UserNam e: string read FUser Name write FUserName ; | |
| 175 | end; | |
| 176 | ||
| 177 | implementa tion | |
| 178 | ||
| 179 | uses | |
| 180 | EwbCoreT ools, SysU tils, Form s, EWB.IEC onst; | |
| 181 | ||
| 182 | constructo r TUrl.Cre ate(const Url: strin g); | |
| 183 | begin | |
| 184 | if Lengt h(Url) > 0 then | |
| 185 | FUrl : = Url; | |
| 186 | end; | |
| 187 | ||
| 188 | procedure TUrl.SetUr l(const Va lue: strin g); | |
| 189 | begin | |
| 190 | if Lengt h(Value) > 0 then | |
| 191 | QueryU rl(Value); | |
| 192 | end; | |
| 193 | ||
| 194 | //======== ========== ========== ========== ========== ========== ========== ========== | |
| 195 | ||
| 196 | procedure TUrl.Clear ; | |
| 197 | begin | |
| 198 | FBookmar k := ''; | |
| 199 | FHostNam e := ''; | |
| 200 | FProtoco l := ''; | |
| 201 | FUrlPath := ''; | |
| 202 | FDocumen t := ''; | |
| 203 | FPort := 80; | |
| 204 | FExtraIn fo := ''; | |
| 205 | FUserNam e := ''; | |
| 206 | FPasswor d := ''; | |
| 207 | FParamet ers := ''; | |
| 208 | ClearUrl Component; | |
| 209 | end; | |
| 210 | ||
| 211 | procedure TUrl.Clear UrlCompone nt; | |
| 212 | begin | |
| 213 | with FUr lComponent do | |
| 214 | begin | |
| 215 | lpszSc heme := ni l; | |
| 216 | lpszHo stName := nil; | |
| 217 | lpszUr lPath := n il; | |
| 218 | lpszUs erName := nil; | |
| 219 | lpszPa ssword := nil; | |
| 220 | lpszEx traInfo := nil; | |
| 221 | end; | |
| 222 | end; | |
| 223 | ||
| 224 | procedure TUrl.FillU rlComponen t; | |
| 225 | begin | |
| 226 | ClearUrl Component; | |
| 227 | with FUr lComponent do | |
| 228 | begin | |
| 229 | dwStru ctSize := SizeOf(URL _COMPONENT S); | |
| 230 | if FPr otocol <> '' then | |
| 231 | begin | |
| 232 | lpsz Scheme := PChar(FPro tocol); | |
| 233 | dwSc hemeLength := Length (FProtocol ); | |
| 234 | end | |
| 235 | else | |
| 236 | lpsz Scheme := nil; | |
| 237 | if FHo stName <> '' then | |
| 238 | begin | |
| 239 | lpsz HostName : = PChar(FH ostName); | |
| 240 | dwHo stNameLeng th := Leng th(PChar(F HostName)) ; | |
| 241 | end | |
| 242 | else | |
| 243 | lpsz HostName : = nil; | |
| 244 | if FUr lPath <> ' ' then | |
| 245 | begin | |
| 246 | lpsz UrlPath := PChar(FUr lPath); | |
| 247 | dwUr lPathLengt h := Lengt h(FUrlPath ); | |
| 248 | end | |
| 249 | else | |
| 250 | lpsz UrlPath := nil; | |
| 251 | if FUs erName <> '' then | |
| 252 | begin | |
| 253 | lpsz UserName : = PChar(FU serName); | |
| 254 | dwUs erNameLeng th := Leng th(FUserNa me); | |
| 255 | end | |
| 256 | else | |
| 257 | lpsz UserName : = nil; | |
| 258 | if FPa ssword <> '' then | |
| 259 | begin | |
| 260 | lpsz Password : = PChar(FP assword); | |
| 261 | dwPa sswordLeng th := Leng th(FPasswo rd); | |
| 262 | end | |
| 263 | else | |
| 264 | lpsz Password : = nil; | |
| 265 | if FEx traInfo = '' then | |
| 266 | FExt raInfo := FDocument + FParamet ers; | |
| 267 | if FBo okmark <> '' then | |
| 268 | FExt raInfo := FExtraInfo + Bookmar kDelim + F Bookmark; | |
| 269 | if FEx traInfo <> '' then | |
| 270 | begin | |
| 271 | lpsz ExtraInfo := PChar(F ExtraInfo) ; | |
| 272 | dwEx traInfoLen gth := Len gth(FExtra Info); | |
| 273 | end | |
| 274 | else | |
| 275 | lpsz ExtraInfo := nil; | |
| 276 | if (FP ort = 0) t hen | |
| 277 | nPor t := FPort ; | |
| 278 | {$IFDEF DE LPHI6_UP} | |
| 279 | //pad := 1; //fo rce correc t allignme nt regardl ess of com p. flags | |
| 280 | {$ENDIF} | |
| 281 | end; | |
| 282 | end; | |
| 283 | ||
| 284 | function T Url.initCo InternetQu eryInfo: b oolean; | |
| 285 | var | |
| 286 | lh: HMOD ULE; | |
| 287 | begin | |
| 288 | Result : = False; | |
| 289 | CoIntern etQueryInf o := nil; | |
| 290 | lh := lo adlibrary( 'URLMON.DL L'); | |
| 291 | if lh = 0 then | |
| 292 | Exit; | |
| 293 | CoIntern etQueryInf o := GetPr ocAddress( lh, 'CoInt ernetQuery Info'); | |
| 294 | Result : = (@CoInte rnetQueryI nfo) <> ni l; | |
| 295 | end; | |
| 296 | ||
| 297 | procedure TUrl.Query Url(Url: s tring); | |
| 298 | var | |
| 299 | TmpStr: string; | |
| 300 | IdxPos, CharPos: I nteger; | |
| 301 | begin | |
| 302 | Clear; | |
| 303 | Url := F ixUrl(Url) ; | |
| 304 | FormatPa th(Url); | |
| 305 | IdxPos : = AnsiPos( ProtocolDe lim, Url); | |
| 306 | if IdxPo s > 0 then | |
| 307 | begin | |
| 308 | FProto col := Cop y(Url, 1, IdxPos - 1 ); | |
| 309 | Delete (Url, 1, I dxPos + 2) ; | |
| 310 | TmpStr := CutStr ing(Url, W ebDelim, T rue); | |
| 311 | IdxPos := AnsiPo s('@', Tmp Str); | |
| 312 | FPassw ord := Cop y(TmpStr, 1, IdxPos - 1); | |
| 313 | if Idx Pos > 0 th en | |
| 314 | Dele te(TmpStr, 1, IdxPos ); | |
| 315 | FUserN ame := Cut String(FPa ssword, Dr iveDelim, True); | |
| 316 | if Len gth(FUserN ame) = 0 t hen | |
| 317 | begin | |
| 318 | FPas sword := ' '; | |
| 319 | end; | |
| 320 | if (An siPos('[', TmpStr) > 0) and (A nsiPos(']' , TmpStr) > AnsiPos( '[', TmpSt r)) then | |
| 321 | begin | |
| 322 | FHos tName := C utString(T mpStr, ']' ); | |
| 323 | CutS tring(FHos tName, '[' ); | |
| 324 | CutS tring(TmpS tr, DriveD elim); | |
| 325 | end | |
| 326 | else | |
| 327 | begin | |
| 328 | FHos tName := C utString(T mpStr, Dri veDelim, T rue); | |
| 329 | end; | |
| 330 | FPort := StrToIn tDef(TmpSt r, 80); | |
| 331 | CharPo s := AnsiP os(QueryDe lim, Url); | |
| 332 | if Cha rPos > 0 t hen | |
| 333 | begin | |
| 334 | IdxP os := GetP os(WebDeli m, Url, Ch arPos); | |
| 335 | end | |
| 336 | else | |
| 337 | begin | |
| 338 | Char Pos := Ans iPos(Equal Delim, Url ); | |
| 339 | if C harPos > 0 then | |
| 340 | begi n | |
| 341 | Id xPos := Ge tPos(WebDe lim, Url, CharPos); | |
| 342 | end | |
| 343 | else | |
| 344 | begi n | |
| 345 | Id xPos := Ge tPos(WebDe lim, Url, -1); | |
| 346 | end; | |
| 347 | end; | |
| 348 | FUrlPa th := WebD elim + Cop y(Url, 1, IdxPos); | |
| 349 | if Cha rPos > 0 t hen | |
| 350 | begin | |
| 351 | FDoc ument := C opy(Url, 1 , CharPos - 1); | |
| 352 | Dele te(Url, 1, CharPos - 1); | |
| 353 | FPar ameters := Url; | |
| 354 | end | |
| 355 | else | |
| 356 | FDoc ument := U rl; | |
| 357 | Delete (FDocument , 1, IdxPo s); | |
| 358 | FBookm ark := FDo cument; | |
| 359 | FDocum ent := Cut String(FBo okmark, Bo okmarkDeli m); | |
| 360 | end | |
| 361 | else | |
| 362 | begin | |
| 363 | CharPo s := AnsiP os(QueryDe lim, Url); | |
| 364 | if Cha rPos > 0 t hen | |
| 365 | begin | |
| 366 | IdxP os := GetP os(WebDeli m, Url, Ch arPos); | |
| 367 | end | |
| 368 | else | |
| 369 | begin | |
| 370 | Char Pos := Ans iPos(Equal Delim, Url ); | |
| 371 | if C harPos > 0 then | |
| 372 | begi n | |
| 373 | Id xPos := Ge tPos(WebDe lim, Url, CharPos); | |
| 374 | end | |
| 375 | else | |
| 376 | begi n | |
| 377 | Id xPos := Ge tPos(WebDe lim, Url, -1); | |
| 378 | end; | |
| 379 | end; | |
| 380 | FUrlPa th := Copy (Url, 1, I dxPos); | |
| 381 | if Cha rPos > 0 t hen | |
| 382 | begin | |
| 383 | FDoc ument := C opy(Url, 1 , CharPos - 1); | |
| 384 | Dele te(Url, 1, CharPos - 1); | |
| 385 | FPar ameters := Url; | |
| 386 | end | |
| 387 | else | |
| 388 | begin | |
| 389 | FDoc ument := U rl; | |
| 390 | end; | |
| 391 | Delete (FDocument , 1, IdxPo s); | |
| 392 | end; | |
| 393 | if FBook mark = '' then | |
| 394 | begin | |
| 395 | FBookm ark := FPa rameters; | |
| 396 | FParam eters := C utString(F Bookmark, BookmarkDe lim); | |
| 397 | end; | |
| 398 | FillUrlC omponent; | |
| 399 | end; | |
| 400 | ||
| 401 | function T Url.CrackU rl(const U rl: string ; dwFlags: DWord): W ideString; | |
| 402 | var | |
| 403 | Buffers: array[0.. 5, 0..MAX_ BUFFER - 1 ] of Char; | |
| 404 | bResult: boolean; | |
| 405 | begin | |
| 406 | Clear; | |
| 407 | FUrl := FixUrl(Url ); | |
| 408 | ZeroMemo ry(@FUrlCo mponent, S izeOf(URL_ COMPONENTS )); | |
| 409 | with FUr lComponent do | |
| 410 | begin | |
| 411 | dwStru ctSize := SizeOf(URL _COMPONENT S); | |
| 412 | dwSche meLength : = INTERNET _MAX_SCHEM E_LENGTH; | |
| 413 | lpszSc heme := Bu ffers[0]; | |
| 414 | dwHost NameLength := INTERN ET_MAX_HOS T_NAME_LEN GTH; | |
| 415 | lpszHo stName := Buffers[1] ; | |
| 416 | dwUser NameLength := INTERN ET_MAX_USE R_NAME_LEN GTH; | |
| 417 | lpszUs erName := Buffers[2] ; | |
| 418 | dwPass wordLength := INTERN ET_MAX_PAS SWORD_LENG TH; | |
| 419 | lpszPa ssword := Buffers[3] ; | |
| 420 | dwUrlP athLength := INTERNE T_MAX_PATH _LENGTH; | |
| 421 | lpszUr lPath := B uffers[4]; | |
| 422 | dwExtr aInfoLengt h := INTER NET_MAX_UR L_LENGTH; | |
| 423 | lpszEx traInfo := Buffers[5 ]; | |
| 424 | end; | |
| 425 | bResult := Interne tCrackURL( PChar(Url) , 0, dwFla gs, FUrlCo mponent); | |
| 426 | if bResu lt then | |
| 427 | begin | |
| 428 | with F UrlCompone nt do | |
| 429 | begin | |
| 430 | FHos tName := l pszHostNam e; | |
| 431 | FPro tocol := l pszScheme; | |
| 432 | FUrl Path := lp szUrlPath; | |
| 433 | FPor t := nPort ; | |
| 434 | FExt raInfo := lpszExtraI nfo; | |
| 435 | FUse rName := l pszUserNam e; | |
| 436 | FPas sword := l pszPasswor d; | |
| 437 | Resu lt := Url; | |
| 438 | end; | |
| 439 | end | |
| 440 | else | |
| 441 | begin | |
| 442 | Clear; | |
| 443 | if Ass igned(FOnE rror) then | |
| 444 | FOnE rror(Self, GetLastEr ror, SysEr rorMessage (GetLastEr ror)); | |
| 445 | {$IFDEF US E_DebugStr ing} | |
| 446 | Output DebugStrin g(PChar(Sy sErrorMess age(GetLas tError))); | |
| 447 | {$ENDIF} | |
| 448 | Result := ''; | |
| 449 | end; | |
| 450 | end; | |
| 451 | ||
| 452 | function T Url.Combin eUrl(const BaseUrl, RelativaUr l: string; dwFlags: DWord): Wi deString; | |
| 453 | var | |
| 454 | Buffer: array[0..2 55] of Cha r; | |
| 455 | Size: DW ORD; | |
| 456 | bResult: boolean; | |
| 457 | begin | |
| 458 | Size := SizeOf(Buf fer); | |
| 459 | bResult := Interne tCombineUr l(PChar(Ba seUrl), PC har(Relati vaUrl), | |
| 460 | Buffer , Size, dw Flags); | |
| 461 | if bResu lt then | |
| 462 | begin | |
| 463 | Result := Buffer ; | |
| 464 | FUrl : = Result; | |
| 465 | end | |
| 466 | else | |
| 467 | begin | |
| 468 | if Ass igned(FOnE rror) then | |
| 469 | FOnE rror(Self, GetLastEr ror, SysEr rorMessage (GetLastEr ror)); | |
| 470 | {$IFDEF US E_DebugStr ing} | |
| 471 | Output DebugStrin g(PChar(Sy sErrorMess age(GetLas tError))); | |
| 472 | {$ENDIF} | |
| 473 | Result := ''; | |
| 474 | end; | |
| 475 | ||
| 476 | end; | |
| 477 | ||
| 478 | function T Url.Canoni calizeUrl( const Url: string; d wFlags: in teger): Wi deString; | |
| 479 | var | |
| 480 | Buffer: array[0..2 55] of Cha r; | |
| 481 | Size: DW ORD; | |
| 482 | bResult: boolean; | |
| 483 | begin | |
| 484 | Size := SizeOf(Buf fer); | |
| 485 | bResult := Interne tCanonical izeUrl(PCh ar(Url), B uffer, Siz e, dwFlags ); | |
| 486 | if bResu lt then | |
| 487 | begin | |
| 488 | Result := Buffer ; | |
| 489 | FUrl : = Result; | |
| 490 | end | |
| 491 | else | |
| 492 | begin | |
| 493 | if Ass igned(FOnE rror) then | |
| 494 | FOnE rror(Self, GetLastEr ror, SysEr rorMessage (GetLastEr ror)); | |
| 495 | {$IFDEF US E_DebugStr ing} | |
| 496 | Output DebugStrin g(PChar(Sy sErrorMess age(GetLas tError))); | |
| 497 | {$ENDIF} | |
| 498 | Result := ''; | |
| 499 | end; | |
| 500 | end; | |
| 501 | ||
| 502 | function T Url.Create Url(const dwFlags: D Word): Wid eString; | |
| 503 | var | |
| 504 | Size: DW ORD; | |
| 505 | Buffer: array[0..5 11] of Cha r; | |
| 506 | bResult: boolean; | |
| 507 | begin | |
| 508 | FillUrlC omponent; | |
| 509 | Size := FUrlCompon ent.dwStru ctSize; | |
| 510 | bResult := Interne tCreateUrl (FUrlCompo nent, dwFl ags, Buffe r, Size); | |
| 511 | if bResu lt then | |
| 512 | begin | |
| 513 | Result := Buffer ; | |
| 514 | FUrl : = Result; | |
| 515 | end | |
| 516 | else | |
| 517 | begin | |
| 518 | {$IFDEF US E_DebugStr ing} | |
| 519 | Output DebugStrin g(PChar(Sy sErrorMess age(GetLas tError))); | |
| 520 | {$ENDIF} | |
| 521 | if Ass igned(FOnE rror) then | |
| 522 | FOnE rror(Self, GetLastEr ror, SysEr rorMessage (GetLastEr ror)); | |
| 523 | end; | |
| 524 | end; | |
| 525 | ||
| 526 | function T Url.FixUrl (Url: stri ng): strin g; | |
| 527 | ||
| 528 | function AnsiEndsS tr(const A SubText, A Text: stri ng): Boole an; | |
| 529 | var | |
| 530 | SubTex tLocation: Integer; | |
| 531 | begin | |
| 532 | SubTex tLocation := Length( AText) - L ength(ASub Text) + 1; | |
| 533 | if (Su bTextLocat ion > 0) a nd (ASubTe xt <> '') and | |
| 534 | (Byt eType(ATex t, SubText Location) <> mbTrail Byte) then | |
| 535 | Resu lt := Ansi StrComp((P Char(ASubT ext)), Poi nter(@ATex t[SubTextL ocation])) = 0 | |
| 536 | else | |
| 537 | Resu lt := Fals e; | |
| 538 | end; | |
| 539 | var | |
| 540 | DotPos, ipos: Inte ger; | |
| 541 | begin | |
| 542 | Result : = Url; | |
| 543 | if not A nsiEndsStr ('/', Url) then | |
| 544 | begin | |
| 545 | ipos : = LastDeli miter('/', Url); | |
| 546 | DotPos := LastDe limiter('. ', Url); | |
| 547 | if Dot Pos < ipos then | |
| 548 | Resu lt := Url + '/'; | |
| 549 | end; | |
| 550 | end; | |
| 551 | ||
| 552 | function T Url.Encode URL(const InputStr: string; co nst bQuery Str: Boole an): strin g; | |
| 553 | var | |
| 554 | Idx: Int eger; | |
| 555 | begin | |
| 556 | Result : = ''; | |
| 557 | for Idx := 1 to Le ngth(Input Str) do | |
| 558 | begin | |
| 559 | case I nputStr[Id x] of | |
| 560 | 'A'. .'Z', 'a'. .'z', '0'. .'9', '-', '_', '.': | |
| 561 | Re sult := Re sult + Inp utStr[Idx] ; | |
| 562 | ' ': | |
| 563 | if bQueryStr then | |
| 564 | Result := Result + ' +' | |
| 565 | el se | |
| 566 | Result := Result + ' %20'; | |
| 567 | else | |
| 568 | Resu lt := Resu lt + '%' + SysUtils. IntToHex(O rd(InputSt r[Idx]), 2 ); | |
| 569 | end; | |
| 570 | end; | |
| 571 | end; | |
| 572 | ||
| 573 | function T Url.Decode Url(const InputStr: string): s tring; | |
| 574 | var | |
| 575 | Idx: Int eger; | |
| 576 | Hex: str ing; | |
| 577 | Code: In teger; | |
| 578 | begin | |
| 579 | Result : = ''; | |
| 580 | Idx := 1 ; | |
| 581 | while Id x <= Lengt h(InputStr ) do | |
| 582 | begin | |
| 583 | case I nputStr[Id x] of | |
| 584 | '%': | |
| 585 | be gin | |
| 586 | if Idx <= Length(Inp utStr) - 2 then | |
| 587 | begin | |
| 588 | Hex := I nputStr[Id x + 1] + I nputStr[Id x + 2]; | |
| 589 | Code := SysUtils.S trToIntDef ('$' + Hex , -1); | |
| 590 | Inc(Idx, 2); | |
| 591 | end | |
| 592 | else | |
| 593 | Code := -1; | |
| 594 | if Code = -1 then | |
| 595 | raise Sy sUtils.ECo nvertError .Create('I nvalid hex digit in URL'); | |
| 596 | Result := Result + C hr(Code); | |
| 597 | en d; | |
| 598 | '+': | |
| 599 | Re sult := Re sult + ' ' | |
| 600 | else | |
| 601 | Resu lt := Resu lt + Input Str[Idx]; | |
| 602 | end; | |
| 603 | Inc(Id x); | |
| 604 | end; | |
| 605 | end; | |
| 606 | ||
| 607 | function T Url.BuildU rl: WideSt ring; | |
| 608 | begin | |
| 609 | FillUrlC omponent; | |
| 610 | if (FPro tocol = '' ) or (FHos tName = '' ) then | |
| 611 | begin | |
| 612 | if Ass igned(FOnE rror) then | |
| 613 | FOnE rror(Self, 0, 'Can n ot Create Url. Proto col or Hos tName are not valid! '); | |
| 614 | {$IFDEF US E_DebugStr ing} | |
| 615 | Output DebugStrin g('Can not Create Ur l. Protoco l or HostN ame are no t valid!') ; | |
| 616 | {$ENDIF} | |
| 617 | Exit; | |
| 618 | end; | |
| 619 | Result : = FProtoco l + Protoc olDelim; | |
| 620 | if (FUse rName <> ' ') then | |
| 621 | begin | |
| 622 | Result := Result + FUserNa me; | |
| 623 | if FPa ssword <> '' then | |
| 624 | begin | |
| 625 | Resu lt := Resu lt + Drive Delim + FP assword; | |
| 626 | end; | |
| 627 | Result := Result + '@'; | |
| 628 | end; | |
| 629 | Result : = Result + FHostName ; | |
| 630 | if (FPor t <> 0) an d (FPort < > 80) then | |
| 631 | begin | |
| 632 | Result := Result + DriveDe lim + IntT oStr(FPort ); | |
| 633 | end; | |
| 634 | Result : = Result + FUrlPath + FDocumen t + FParam eters; | |
| 635 | if (FBoo kmark <> ' ') then | |
| 636 | begin | |
| 637 | Result := Result + Bookmar kDelim + F Bookmark; | |
| 638 | end; | |
| 639 | end; | |
| 640 | ||
| 641 | function T Url.Compar eUrl(const pwzUrl1, pwzUrl2: W ideString) : HResult; | |
| 642 | begin | |
| 643 | if (pwzU rl1 = '') or (pwzUrl 2 = '') th en | |
| 644 | begin | |
| 645 | {$IFDEF US E_DebugStr ing} | |
| 646 | Output DebugStrin g('Can not Compare U rl. pwzUrl 1 or pwzU rl2 are em pty!'); | |
| 647 | {$ENDIF} | |
| 648 | if Ass igned(FOnE rror) then | |
| 649 | FOnE rror(Self, 0, 'Can n ot Compare Url. pwzU rl1 or pw zUrl2 are empty!'); | |
| 650 | end; | |
| 651 | Result : = AnsiComp areText(pw zUrl1, pwz Url2); | |
| 652 | end; | |
| 653 | ||
| 654 | function T Url.CoInet QueryInfo( const Url: WideStrin g; QueryOp tions: Car dinal): bo olean; | |
| 655 | var | |
| 656 | pcbBuffe r: DWORD; | |
| 657 | dwCached : DWORD; | |
| 658 | begin | |
| 659 | if not i nitCoInter netQueryIn fo then | |
| 660 | begin | |
| 661 | Result := False; | |
| 662 | Exit; | |
| 663 | end; | |
| 664 | pcbBuffe r := SizeO f(dwCached ); | |
| 665 | if CoInt ernetQuery Info(PWide Char(Url), QueryOpti ons, 0, @d wCached, | |
| 666 | SizeOf (dwCached) , pcbBuffe r, 0) <> S _OK then | |
| 667 | begin | |
| 668 | if Ass igned(FOnE rror) then | |
| 669 | FOnE rror(Self, GetLastEr ror, SysEr rorMessage (GetLastEr ror)); | |
| 670 | {$IFDEF US E_DebugStr ing} | |
| 671 | Output DebugStrin g(PChar(Sy sErrorMess age(GetLas tError))); | |
| 672 | {$ENDIF} | |
| 673 | end; | |
| 674 | Result : = dwCached <> 0; | |
| 675 | end; | |
| 676 | ||
| 677 | function T Url.QueryI nfo(const Url: strin g; dwInfoF lag: Integ er): strin g; | |
| 678 | var | |
| 679 | hInet: H INTERNET; | |
| 680 | hConnect : HINTERNE T; | |
| 681 | infoBuff er: array[ 0..512] of char; | |
| 682 | dummy: D WORD; | |
| 683 | bufLen: DWORD; | |
| 684 | ok: Long Bool; | |
| 685 | begin | |
| 686 | hInet := InternetO pen(PChar( Forms.Appl ication.Ti tle), | |
| 687 | INTERN ET_OPEN_TY PE_PRECONF IG_WITH_NO _AUTOPROXY , nil, nil , 0); | |
| 688 | hConnect := Intern etOpenUrl( hInet, PCh ar(Url), n il, 0, INT ERNET_FLAG _NO_UI, 0) ; | |
| 689 | if not A ssigned(hC onnect) th en | |
| 690 | begin | |
| 691 | if Ass igned(FOnE rror) then | |
| 692 | FOnE rror(Self, GetLastEr ror, SysEr rorMessage (GetLastEr ror)); | |
| 693 | {$IFDEF US E_DebugStr ing} | |
| 694 | Output DebugStrin g(PChar(Sy sErrorMess age(GetLas tError))); | |
| 695 | {$ENDIF} | |
| 696 | Result := ''; | |
| 697 | end | |
| 698 | else | |
| 699 | begin | |
| 700 | dummy := 0; | |
| 701 | bufLen := Length (infoBuffe r); | |
| 702 | ok := HttpQueryI nfo(hConne ct, dwInfo Flag, @inf oBuffer[0] , bufLen, dummy); | |
| 703 | if ok then | |
| 704 | Resu lt := info Buffer | |
| 705 | else | |
| 706 | Resu lt := ''; | |
| 707 | Intern etCloseHan dle(hConne ct); | |
| 708 | end; | |
| 709 | Internet CloseHandl e(hInet); | |
| 710 | end; | |
| 711 | ||
| 712 | function T Url.ReadFi le(const U RL: string ; TimeOut: LongWord) : string; | |
| 713 | var | |
| 714 | hInet: H Internet; | |
| 715 | hConnect : HInterne t; | |
| 716 | infoBuff er: array[ 0..TEMP_SI ZE - 1] of Char; | |
| 717 | iRead, i TimeOut: D WORD; | |
| 718 | strRead: string; | |
| 719 | begin | |
| 720 | strRead := ''; | |
| 721 | hInet := InternetO pen(PChar( Forms.Appl ication.Ti tle), INTE RNET_OPEN_ TYPE_PRECO NFIG, nil, nil, INTE RNET_FLAG_ NO_CACHE_W RITE); | |
| 722 | if Assig ned(hInet) then | |
| 723 | begin | |
| 724 | Intern etQueryOpt ion(hInet, INTERNET_ OPTION_CON NECT_TIMEO UT, @iTime Out, iRead ); | |
| 725 | iTimeO ut := Time Out; | |
| 726 | Intern etSetOptio n(hInet, I NTERNET_OP TION_CONNE CT_TIMEOUT , @iTimeOu t, iRead); | |
| 727 | try | |
| 728 | hCon nect := In ternetOpen URL(hInet, PChar(Url ), nil, 0, 0, 0); | |
| 729 | if A ssigned(hC onnect) th en | |
| 730 | try | |
| 731 | re peat | |
| 732 | FillChar(i nfoBuffer, SizeOf(in foBuffer), #0); | |
| 733 | InternetRe adFile(hCo nnect, @in foBuffer, sizeof(inf oBuffer), iRead); | |
| 734 | strRead := strRead + string(in foBuffer); | |
| 735 | un til iRead < TEMP_SIZ E; | |
| 736 | fina lly | |
| 737 | In ternetClos eHandle(hC onnect); | |
| 738 | end | |
| 739 | else | |
| 740 | begi n | |
| 741 | if Assigned( FOnError) then | |
| 742 | FOnError(S elf, GetLa stError, S ysErrorMes sage(GetLa stError)); | |
| 743 | {$IFDEF US E_DebugStr ing} | |
| 744 | Ou tputDebugS tring(PCha r(SysError Message(Ge tLastError ))); | |
| 745 | {$ENDIF} | |
| 746 | Re sult := '' ; | |
| 747 | end; | |
| 748 | finall y | |
| 749 | Inte rnetCloseH andle(hIne t); | |
| 750 | end; | |
| 751 | Result := strRea d; | |
| 752 | end | |
| 753 | else | |
| 754 | begin | |
| 755 | if Ass igned(FOnE rror) then | |
| 756 | FOnE rror(Self, GetLastEr ror, SysEr rorMessage (GetLastEr ror)); | |
| 757 | {$IFDEF US E_DebugStr ing} | |
| 758 | Output DebugStrin g(PChar(Sy sErrorMess age(GetLas tError))); | |
| 759 | {$ENDIF} | |
| 760 | Result := ''; | |
| 761 | end; | |
| 762 | end; | |
| 763 | ||
| 764 | function T Url.IsUrlV alid(const Url: stri ng): boole an; | |
| 765 | var | |
| 766 | Reply: s tring; | |
| 767 | begin | |
| 768 | Reply := QueryInfo (Url, HTTP _QUERY_STA TUS_CODE); | |
| 769 | if (Repl y = '200') or (Reply = '401') then | |
| 770 | Result := True | |
| 771 | else | |
| 772 | Result := False; | |
| 773 | end; | |
| 774 | ||
| 775 | function T Url.GetUrl Size(const Url: stri ng): strin g; | |
| 776 | begin | |
| 777 | Result : = QueryInf o(Url, HTT P_QUERY_CO NTENT_LENG TH); | |
| 778 | end; | |
| 779 | ||
| 780 | function T Url.GetUrl Type(const Url: stri ng): strin g; | |
| 781 | begin | |
| 782 | Result : = QueryInf o(Url, HTT P_QUERY_CO NTENT_TYPE ); | |
| 783 | end; | |
| 784 | ||
| 785 | function T Url.GetUrl Date(const Url: stri ng): strin g; | |
| 786 | begin | |
| 787 | Result : = QueryInf o(Url, HTT P_QUERY_DA TE); | |
| 788 | end; | |
| 789 | ||
| 790 | function T Url.GetUrl LastModifi ed(const U rl: string ): string; | |
| 791 | begin | |
| 792 | Result : = QueryInf o(Url, HTT P_QUERY_LA ST_MODIFIE D); | |
| 793 | end; | |
| 794 | ||
| 795 | function T Url.GetUrl StatusCode (const Url : string): string; | |
| 796 | begin | |
| 797 | Result : = QueryInf o(Url, HTT P_QUERY_ST ATUS_CODE) ; | |
| 798 | end; | |
| 799 | ||
| 800 | function T Url.GetUrl Server(con st Url: st ring): str ing; | |
| 801 | begin | |
| 802 | Result : = QueryInf o(Url, HTT P_QUERY_SE RVER); | |
| 803 | end; | |
| 804 | ||
| 805 | function T Url.GetUrl EntityTag( const Url: string): string; | |
| 806 | begin | |
| 807 | Result : = QueryInf o(Url, HTT P_QUERY_ET AG); | |
| 808 | end; | |
| 809 | ||
| 810 | function T Url.GetUrl Charset(co nst Url: s tring): st ring; | |
| 811 | begin | |
| 812 | Result : = QueryInf o(Url, HTT P_QUERY_AC CEPT_CHARS ET); | |
| 813 | end; | |
| 814 | ||
| 815 | function T Url.GetUrl ServerDeta ils(const Url: strin g): string ; | |
| 816 | begin | |
| 817 | Result : = QueryInf o(Url, HTT P_QUERY_RA W_HEADERS_ CRLF); | |
| 818 | end; | |
| 819 | ||
| 820 | function T Url.GetUrl ProtocolVe rsion(cons t Url: str ing): stri ng; | |
| 821 | begin | |
| 822 | Result : = QueryInf o(Url, HTT P_QUERY_VE RSION); | |
| 823 | end; | |
| 824 | ||
| 825 | function T Url.IsUrlC ached(cons t Url: str ing): bool ean; | |
| 826 | begin | |
| 827 | Result : = CoInetQu eryInfo(Ur l, QUERY_I S_CACHED); | |
| 828 | end; | |
| 829 | {========= ========== ========== ========== ========== ========== ========== ========== ======} | |
| 830 | ||
| 831 | end. |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.