source: cprs/branches/tmg-cprs/CPRS-Chart/TMG_Extra/HTMLEdit/IEDownloadTools.pas@ 1359

Last change on this file since 1359 was 541, checked in by Kevin Toppenberg, 15 years ago

TMG Ver 1.1 Added HTML Support, better demographics editing
File size: 25.0 KB
RevLine 
[541]1//*************************************************************************
2// *
3// IEDownload Tools *
4// For Delphi *
5// *
6// Freeware Unit *
7// by *
8// Eran Bodankin -bsalsa(bsalsa@gmail.com) *
9// *
10// *
11// Updated versions: *
12// http://www.bsalsa.com *
13//*************************************************************************
14{LICENSE:
15THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND,
16EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED
17WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
18YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE
19AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE
20AND DOCUMENTATION. BSALSA PRODUCTIONS DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE
21OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED
22OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS,
23INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR
24OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS,
25AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. BSALSA PRODUCTIONS SPECIFICALLY
26DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE.
27
28You may use, change or modify the component under 4 conditions:
291. In your website, add a link to "http://www.bsalsa.com"
302. In your application, add credits to "Embedded Web Browser"
313. Mail me (bsalsa@gmail.com) any code change in the unit
32 for the benefit of the other users.
334. Please, consider donation in our web site!
34{*******************************************************************************}
35
36unit IEDownloadTools;
37
38interface
39
40uses
41 Windows, IeConst, SysUtils, ActiveX;
42
43function ResponseCodeToStr(dwResponse: Integer): string;
44function FormatSize(Byte: Double): string;
45function FormatTickToTime(TickCount: Cardinal): string;
46function IsValidURL(const URL: Widestring): Boolean;
47function WideStringToLPOLESTR(const Source: Widestring): POleStr;
48function WideStringToWideChar(const inString: WideString): PWideChar;
49function CodeInstallProblemToStr(ulStatusCode: Integer): string;
50function DataAvalibleToStr(Code: Integer): string;
51function SecToStr(const Seconds: LongInt): string;
52procedure FreeWideChar(var inString: PWideChar);
53function StrToCase(StringOf: string; CasesList: array of string): Integer;
54function QueryRemoteFileInfo(const Url: string; dwInfoFlag: Integer): string;
55function GetInfoByMimeType(const ContentType: string): boolean;
56function StrContain(SubString: string; Str: string): boolean;
57function IncludeTrailingPathDelimiter(const S: string): string;
58function CharReplace(const Source: string; OldChar, NewChar: Char): string;
59
60
61implementation
62
63uses
64 WinInet, UrlMon, Registry;
65
66// Some constatants are missing in previous delphi versions.
67// That's why they are declared here.
68const
69{$EXTERNALSYM BINDSTATUS_COOKIE_SENT}
70 BINDSTATUS_COOKIE_SENT = BINDSTATUS_ACCEPTRANGES + 1;
71{$EXTERNALSYM BINDSTATUS_COMPACT_POLICY_RECEIVED}
72 BINDSTATUS_COMPACT_POLICY_RECEIVED = BINDSTATUS_COOKIE_SENT + 1;
73{$EXTERNALSYM BINDSTATUS_COOKIE_SUPPRESSED}
74 BINDSTATUS_COOKIE_SUPPRESSED = BINDSTATUS_COMPACT_POLICY_RECEIVED + 1;
75{$EXTERNALSYM BINDSTATUS_COOKIE_STATE_UNKNOWN}
76 BINDSTATUS_COOKIE_STATE_UNKNOWN = BINDSTATUS_COOKIE_SUPPRESSED + 1;
77{$EXTERNALSYM BINDSTATUS_COOKIE_STATE_ACCEPT}
78 BINDSTATUS_COOKIE_STATE_ACCEPT = BINDSTATUS_COOKIE_STATE_UNKNOWN + 1;
79{$EXTERNALSYM BINDSTATUS_COOKIE_STATE_REJECT}
80 BINDSTATUS_COOKIE_STATE_REJECT = BINDSTATUS_COOKIE_STATE_ACCEPT + 1;
81{$EXTERNALSYM BINDSTATUS_COOKIE_STATE_PROMPT}
82 BINDSTATUS_COOKIE_STATE_PROMPT = BINDSTATUS_COOKIE_STATE_REJECT + 1;
83{$EXTERNALSYM BINDSTATUS_COOKIE_STATE_LEASH}
84 BINDSTATUS_COOKIE_STATE_LEASH = BINDSTATUS_COOKIE_STATE_PROMPT + 1;
85{$EXTERNALSYM BINDSTATUS_COOKIE_STATE_DOWNGRADE}
86 BINDSTATUS_COOKIE_STATE_DOWNGRADE = BINDSTATUS_COOKIE_STATE_LEASH + 1;
87{$EXTERNALSYM BINDSTATUS_POLICY_HREF}
88 BINDSTATUS_POLICY_HREF = BINDSTATUS_COOKIE_STATE_DOWNGRADE + 1;
89{$EXTERNALSYM BINDSTATUS_P3P_HEADER}
90 BINDSTATUS_P3P_HEADER = BINDSTATUS_POLICY_HREF + 1;
91{$EXTERNALSYM BINDSTATUS_SESSION_COOKIE_RECEIVED}
92 BINDSTATUS_SESSION_COOKIE_RECEIVED = BINDSTATUS_P3P_HEADER + 1;
93{$EXTERNALSYM BINDSTATUS_PERSISTENT_COOKIE_RECEIVED}
94 BINDSTATUS_PERSISTENT_COOKIE_RECEIVED = BINDSTATUS_SESSION_COOKIE_RECEIVED +
95 1;
96
97function CodeInstallProblemToStr(ulStatusCode: Integer): string;
98begin
99 case ulStatusCode of
100 CIP_DISK_FULL: Result := 'Destination can accept no more data.';
101 CIP_ACCESS_DENIED: Result := 'Permissions problem.';
102 CIP_NEWER_VERSION_EXISTS: Result :=
103 'Destination contains a newer version than the source.';
104 CIP_OLDER_VERSION_EXISTS: Result :=
105 'Destination contains an older version than the source.';
106 CIP_NAME_CONFLICT: Result :=
107 'Destination does not allow the naming convention used by the source.';
108 CIP_TRUST_VERIFICATION_COMPONENT_MISSING: Result :=
109 'Destination cannot verify the source.';
110 CIP_EXE_SELF_REGISTERATION_TIMEOUT: Result := 'Timeout has occurred. ';
111 CIP_UNSAFE_TO_ABORT: Result :=
112 'Installation or download should not be aborted.';
113 CIP_NEED_REBOOT: Result := 'Destination machine requires rebooting.';
114 CIP_NEED_REBOOT_UI_PERMISSION: Result :=
115 'Destination machine should reboot without user interface (UI).';
116 else
117 Result := ResponseCodeToStr(ulStatusCode)
118 end;
119end;
120
121function DataAvalibleToStr(Code: Integer): string;
122begin
123 case Code of
124 BSCF_FIRSTDATANOTIFICATION: Result :=
125 'Identifed the first call to OnDataAvailable.';
126 BSCF_INTERMEDIATEDATANOTIFICATION: Result :=
127 'Identifed the intermediate call to OnDataAvailable.';
128 BSCF_LASTDATANOTIFICATION: Result :=
129 'Identifed the last call to OnDataAvailable.';
130 BSCF_DATAFULLYAVAILABLE: Result :=
131 'All of the requested data is available.';
132 BSCF_AVAILABLEDATASIZEUNKNOWN: Result :=
133 'Size of the data available is unknown.';
134 // BSCF_SKIPDRAINDATAFORFILEURLS: Result := 'Bypass cache downloads.';
135 else
136 Result := ResponseCodeToStr(Code)
137 end;
138end;
139
140function ResponseCodeToStr(dwResponse: Integer): string;
141begin
142 case dwResponse of
143 100: Result := 'Continue';
144 101: Result := 'Switching Protocols';
145 200: Result := 'OK';
146 201: Result := 'Created';
147 202: Result := 'Accepted';
148 203: Result := 'Non-Authoritative Information';
149 204: Result := 'No Content';
150 205: Result := 'Reset Content';
151 206: Result := 'Partial Content';
152 300: Result := 'Multiple Choices';
153 301: Result := 'Moved Permanently';
154 302: Result := 'Moved Temporarily';
155 303: Result := 'See Other';
156 304: Result := 'Not Modified';
157 305: Result := 'Use Proxy';
158 400: Result := 'Bad Request';
159 401: Result := 'Unauthorized';
160 402: Result := 'Payment Required';
161 403: Result := 'Forbidden';
162 404: Result := 'Not Found';
163 405: Result := 'Method Not Allowed';
164 406: Result := 'None Acceptable';
165 407: Result := 'Proxy Authentication Required';
166 408: Result := 'Request Timeout';
167 409: Result := 'Conflict';
168 410: Result := 'Gone';
169 411: Result := 'Length Required';
170 412: Result := 'Precondition Failed';
171 413: Result := 'Request Entity Too Large';
172 414: Result := 'Request-URI Too Long';
173 415: Result := 'Unsupported Media Type';
174 416: Result := 'Requested Range Not Satisfiable';
175 417: Result := 'Expectation Failed';
176 500: Result := 'Internal Server Error';
177 501: Result := 'Not Implemented';
178 502: Result := 'Bad Gateway';
179 503: Result := 'Service Unavailable';
180 504: Result := 'Gateway Timeout';
181 505: Result := 'HTTP Version Not Supported';
182 BINDSTATUS_FINDINGRESOURCE: Result := 'Finding resource...';
183 BINDSTATUS_CONNECTING: Result := 'Connecting...';
184 BINDSTATUS_REDIRECTING: Result := 'Server redirecting client...';
185 BINDSTATUS_BEGINDOWNLOADDATA: Result := 'Beginning to download data...';
186 BINDSTATUS_DOWNLOADINGDATA: Result := 'Downloading data...';
187 BINDSTATUS_ENDDOWNLOADDATA: Result := 'Ending data download...';
188 BINDSTATUS_BEGINDOWNLOADCOMPONENTS: Result :=
189 'Beginning to download components...';
190 BINDSTATUS_INSTALLINGCOMPONENTS: Result := 'Installing components...';
191 BINDSTATUS_ENDDOWNLOADCOMPONENTS: Result := 'Ending component download...';
192 BINDSTATUS_USINGCACHEDCOPY: Result := 'Using cached copy...';
193 BINDSTATUS_SENDINGREQUEST: Result := 'Sending request...';
194 BINDSTATUS_CLASSIDAVAILABLE: Result := 'CLSID available...'; //***
195 BINDSTATUS_MIMETYPEAVAILABLE: Result := 'MIME type available...';
196 BINDSTATUS_CACHEFILENAMEAVAILABLE: Result := 'Cache file name available...';
197 BINDSTATUS_BEGINSYNCOPERATION: Result :=
198 'Synchronous operation has started...';
199 BINDSTATUS_ENDSYNCOPERATION: Result := 'Ending synchronous operation...';
200 BINDSTATUS_BEGINUPLOADDATA: Result := 'Beginning to upload data...';
201 BINDSTATUS_UPLOADINGDATA: Result := 'Uploading data...';
202 BINDSTATUS_ENDUPLOADDATA: Result := 'Ending data upload...';
203 BINDSTATUS_PROTOCOLCLASSID: Result :=
204 'Protocol handler CLSID is available...';
205 BINDSTATUS_ENCODING: Result := 'Encoding data...';
206 BINDSTATUS_VERIFIEDMIMETYPEAVAILABLE: Result :=
207 'Verified MIME type is available...';
208 BINDSTATUS_CLASSINSTALLLOCATION: Result :=
209 'Class install location is available...';
210 BINDSTATUS_DECODING: Result := 'Decoding data...';
211 BINDSTATUS_LOADINGMIMEHANDLER: Result :=
212 'Pluggable MIME handler is being loaded...';
213 BINDSTATUS_CONTENTDISPOSITIONATTACH: Result :=
214 'Content-Disposition resource is an attachment...';
215 BINDSTATUS_FILTERREPORTMIMETYPE: Result :=
216 'New MIME type available for resource...';
217 BINDSTATUS_CLSIDCANINSTANTIATE: Result :=
218 'CLSID to return on BindToObject...';
219 BINDSTATUS_IUNKNOWNAVAILABLE: Result :=
220 'IUnknown interface has been released...';
221 BINDSTATUS_DIRECTBIND: Result :=
222 'Connected directly to the pluggable protocol handler...';
223 BINDSTATUS_RAWMIMETYPE: Result := 'Raw MIME type...';
224 BINDSTATUS_PROXYDETECTING: Result := 'Proxy server has been detected...';
225 BINDSTATUS_ACCEPTRANGES: Result := 'Valid types of range requests...';
226 BINDSTATUS_COOKIE_SENT: Result := 'A cookie was sent';
227 BINDSTATUS_COMPACT_POLICY_RECEIVED: Result :=
228 'A Platform for Privacy Preferences was received.';
229 BINDSTATUS_COOKIE_SUPPRESSED: Result :=
230 'A cookie was suppressed from being sent to the web server.';
231 BINDSTATUS_COOKIE_STATE_UNKNOWN: Result :=
232 'A a cookie has been initialized. ';
233 BINDSTATUS_COOKIE_STATE_ACCEPT: Result :=
234 'A cookie sent by the server was accepted.';
235 BINDSTATUS_COOKIE_STATE_REJECT: Result :=
236 'A cookie sent by the server was rejected.';
237 BINDSTATUS_COOKIE_STATE_PROMPT: Result :=
238 'User settings require a prompt before performing a cookie operation.';
239 BINDSTATUS_COOKIE_STATE_LEASH: Result := 'A cookie is a leashed cookie.';
240 BINDSTATUS_COOKIE_STATE_DOWNGRADE: Result :=
241 'A cookie is a downgraded cookie.';
242 BINDSTATUS_POLICY_HREF: Result :=
243 'HTTP headers contain a link to the full privacy policy';
244 BINDSTATUS_P3P_HEADER: Result :=
245 'HTTP response from the server contains the P3P privacy header';
246 BINDSTATUS_SESSION_COOKIE_RECEIVED: Result :=
247 'A session cookie was received.';
248 BINDSTATUS_PERSISTENT_COOKIE_RECEIVED: Result :=
249 'A persistent cookie was received. ';
250 BINDSTATUS_SESSION_COOKIES_ALLOWED: Result :=
251 'The session cookies are allowed.';
252 BINDSTATUS_CACHECONTROL: Result :=
253 'A response from the server was written to memory only.'; //IE7
254 BINDSTATUS_CONTENTDISPOSITIONFILENAME: Result :=
255 'The Content-Disposition header contains a file name.';
256 BINDSTATUS_MIMETEXTPLAINMISMATCH: Result :=
257 'The reported Content-Type of the file does not match the content. ';
258 BINDSTATUS_PUBLISHERAVAILABLE: Result :=
259 'The publisher name is being downloaded and is available.';
260 BINDSTATUS_DISPLAYNAMEAVAILABLE: Result :=
261 'The display name being downloaded and is available.';
262 BINDSTATUS_SSLUX_NAVBLOCKED: Result := 'A problem with the SSL certificate.';
263 BINDSTATUS_SERVER_MIMETYPEAVAILABLE: Result :=
264 'Server''s authoritative MIME type reported'; //IE8 - Attention: This documentation is preliminary and is subject to change
265 BINDSTATUS_SNIFFED_CLASSIDAVAILABLE: Result :=
266 'Class identifier (CLSID) generated from authoritative Content-Type HTTP response header'; //IE8 - Attention: This documentation is preliminary and is subject to change
267 BINDSTATUS_64BIT_PROGRESS: Result :=
268 'Download progress values are above the maximum 32-bit file size limit.'; //IE8 - Attention: This documentation is preliminary and is subject to change
269 // E_PENDING: Result := 'The data necessary to complete this operation is not yet available';
270 E_UNEXPECTED: Result := 'Catastrophic failure';
271 E_FAIL: Result := 'Failed';
272 E_NOINTERFACE: Result := 'No such interface supported';
273 E_NOTIMPL: Result := 'Not implemented';
274 E_ABORT: Result := 'Operation Aborted.';
275 E_ACCESSDENIED: Result := 'Access Denied.';
276 E_INVALIDARG: Result := 'One or more parameters are invalid.';
277 E_OUTOFMEMORY: Result := 'There was insufficient memory ...';
278 ERROR_HTTP_REDIRECT_NEEDS_CONFIRMATION: Result :=
279 'The redirection requires user confirmation.';
280 ERROR_INTERNET_CHG_POST_IS_NON_SECURE: Result :=
281 'The application is posting and attempting to change multiple lines of text on a server that is not secure.';
282 ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED: Result :=
283 'The server is requesting client authentication.';
284 ERROR_INTERNET_CLIENT_AUTH_NOT_SETUP: Result :=
285 'Client authorization is not set up on this computer.';
286 ERROR_INTERNET_FORTEZZA_LOGIN_NEEDED: Result :=
287 'The requested resource requires Fortezza authentication.';
288 ERROR_INTERNET_HTTP_TO_HTTPS_ON_REDIR: Result :=
289 'The application is moving from a non-SSL to an SSL connection because of a redirect.';
290 ERROR_INTERNET_HTTPS_TO_HTTP_ON_REDIR: Result :=
291 'The application is moving from an SSL to an non-SSL connection because of a redirect.';
292 ERROR_INTERNET_INVALID_CA: Result :=
293 'The function is unfamiliar with the Certificate Authority that generated the server''s certificate.';
294 ERROR_INTERNET_MIXED_SECURITY: Result :=
295 'The content is not entirely secure. Some of the content being viewed may have come from unsecured servers.';
296 ERROR_INTERNET_POST_IS_NON_SECURE: Result :=
297 'The application is posting data to a server that is not secure.';
298 ERROR_INTERNET_SEC_CERT_CN_INVALID: Result :=
299 'SSL certificate common name (host name field) is incorrect???for example, if you entered www.server.com and the common name on the certificate says www.different.com.';
300 ERROR_INTERNET_SEC_CERT_DATE_INVALID: Result :=
301 'SSL certificate date that was received from the server is bad. The certificate is expired.';
302 ERROR_INTERNET_SEC_CERT_REVOKED: Result := 'SSL certificate was revoked.';
303 INET_E_AUTHENTICATION_REQUIRED: Result :=
304 'Authentication is needed to access the object.';
305 INET_E_CANNOT_CONNECT: Result :=
306 'The attempt to connect to the Internet has failed.';
307 INET_E_CANNOT_INSTANTIATE_OBJECT: Result := 'CoCreateInstance failed.';
308 INET_E_CANNOT_LOAD_DATA: Result := 'The object could not be loaded.';
309 INET_E_CANNOT_LOCK_REQUEST: Result :=
310 'The requested resource could not be locked.';
311 INET_E_CANNOT_REPLACE_SFP_FILE: Result :=
312 'Cannot replace a protected System File Protection (SFP) file.';
313 INET_E_CODE_DOWNLOAD_DECLINED: Result :=
314 'Permission to download is declined.';
315 INET_E_CONNECTION_TIMEOUT: Result :=
316 'The Internet connection has timed out.';
317 INET_E_DATA_NOT_AVAILABLE: Result :=
318 'An Internet connection was established, but the data cannot be retrieved.';
319 INET_E_DEFAULT_ACTION: Result := 'Use the default action.';
320 INET_E_DOWNLOAD_FAILURE: Result :=
321 'The download has failed (the connection was interrupted).';
322 INET_E_INVALID_REQUEST: Result := 'The request was invalid.';
323 INET_E_INVALID_URL: Result := 'The URL could not be parsed.';
324 INET_E_NO_SESSION: Result := 'No Internet session was established.';
325 INET_E_NO_VALID_MEDIA: Result :=
326 'The object is not in one of the acceptable MIME types.';
327 INET_E_OBJECT_NOT_FOUND: Result := 'The object was not found.';
328 INET_E_QUERYOPTION_UNKNOWN: Result := 'The requested option is unknown.';
329 INET_E_REDIRECT_TO_DIR: Result :=
330 'The request is being redirected to a directory.';
331 INET_E_REDIRECTING: Result := 'The request is being redirected.';
332 INET_E_RESOURCE_NOT_FOUND: Result := 'The server or proxy was not found.';
333 INET_E_RESULT_DISPATCHED: Result := 'Result is dispatched.';
334 INET_E_SECURITY_PROBLEM: Result := 'A security problem was encountered.';
335 INET_E_TERMINATED_BIND: Result := 'Binding is terminated.';
336 INET_E_UNKNOWN_PROTOCOL: Result :=
337 'The protocol is not known and no pluggable protocols have been entered that match.';
338 //INET_E_USE_DEFAULT_PROTOCOLHANDLER: Result := 'Use the default protocol handler.';
339 INET_E_USE_EXTEND_BINDING: Result :=
340 'Re-issue request with extended Binding.';
341 INET_E_USE_DEFAULT_SETTING: Result := 'Use the default settings.';
342 MK_E_CANTOPENFILE: Result := 'Moniker cannot open file.';
343 MK_E_CONNECTMANUALLY: Result :=
344 'The operation was unable to connect to the storage, possibly because a network device could not be connected to. For more information, see IMoniker::BindToObject.';
345 MK_E_ENUMERATION_FAILED: Result := 'Moniker could not be enumerated';
346 MK_E_EXCEEDEDDEADLINE: Result :=
347 'The operation could not be completed within the time limit specified by the bind context''s BIND_OPTS structure.';
348 MK_E_INTERMEDIATEINTERFACENOTSUPPORTED: Result :=
349 'An intermediate object was found but it did not support an interface required for an operation. For example, an item moniker returns this value if its container does not support the IOleItemContainer interface.';
350 MK_E_INVALIDEXTENSION: Result := 'Bad extension for file.';
351 MK_E_MUSTBOTHERUSER: Result :=
352 'User input required for operation to succeed.';
353 MK_E_NEEDGENERIC: Result := 'Moniker needs to be generic.';
354 MK_E_NOINVERSE: Result := 'Moniker class has no inverse.';
355 MK_E_NOOBJECT: Result := 'No object for moniker.';
356 MK_E_NOPREFIX: Result := 'No common prefix.';
357 MK_E_NOSTORAGE: Result :=
358 'The object identified by the moniker does not have its own storage.';
359 MK_E_NOTBINDABLE: Result := 'Moniker is not bindable.';
360 MK_E_NOTBOUND: Result := 'Moniker is not bound.';
361 MK_E_SYNTAX: Result :=
362 'A moniker could not be created because of invalid URL syntax.';
363 MK_E_UNAVAILABLE: Result := 'Operation unavailable.';
364 S_OK: Result := 'The operation was successful';
365 STG_E_ACCESSDENIED: Result := 'Unable to access the storage object.';
366 MK_S_ASYNCHRONOUS: Result := 'Asynchronous mode.';
367 else
368 Result := 'Unknown Response: ' + IntToStr(dwResponse) + ' ' +
369 SysErrorMessage(dwResponse)
370 end;
371end;
372
373function WideStringToLPOLESTR(const Source: Widestring): POleStr;
374var
375 Len: Integer;
376begin
377 Len := Length(Source) * SizeOf(WideChar);
378 Result := CoTaskMemAlloc(Len + 2);
379 FillChar(Result^, Len + 2, 0);
380 Move(Result^, PWideString(Source)^, Len);
381end;
382
383function SecToStr(const Seconds: LongInt): string;
384var
385 H: Integer;
386 M: Integer;
387 S: Integer;
388begin
389 h := (Seconds div 60) div 60 mod 60;
390 m := (Seconds div 60) mod 60;
391 s := Seconds mod 60;
392 Result := Format('%2.2d:%2.2d:%2.2d', (.H, M, S.));
393end;
394
395function FormatTickToTime(TickCount: Cardinal): string;
396var
397 Hours, Minutes, Seconds, MSecs: Cardinal;
398 S_HUR, S_MIN, S_SEC, S_MSC: string;
399begin
400 S_MSC := '000';
401 S_SEC := '00';
402 S_MIN := '00';
403 S_HUR := '00';
404 try
405 if (TickCount > 0) then
406 begin
407 MSecs := TickCount mod MSecsPerSec;
408 TickCount := TickCount div MSecsPerSec;
409 S_MSC := Format('%.3d', [MSecs]);
410 Seconds := TickCount mod SecsPerMin;
411 TickCount := TickCount div SecsPerMin;
412 S_SEC := Format('%.2d', [Seconds]);
413 Minutes := TickCount mod MinsPerHour;
414 TickCount := TickCount div MinsPerHour;
415 S_MIN := Format('%.2d', [Minutes]);
416 Hours := TickCount mod HoursPerDay;
417 S_HUR := Format('%.2d', [Hours]);
418 end;
419 finally
420 if S_HUR = '00' then
421 Result := S_MIN + 'm :' + S_SEC + 's :' + S_MSC + 'ms';
422 if (S_HUR = '00') and (S_MIN = '00') then
423 Result := S_SEC + 's :' + S_MSC + 'ms';
424 if S_HUR <> '00' then
425 Result := S_HUR + 'h :' + S_MIN + 'm :' + S_SEC + 's :' + S_MSC + 'ms';
426 end;
427end;
428
429
430function StrToCase(StringOf: string; CasesList: array of string): Integer;
431var
432 Idx: integer;
433begin
434 Result := -1;
435 for Idx := 0 to Length(CasesList) - 1 do
436 begin
437 if CompareText(StringOf, CasesList[Idx]) = 0 then
438 begin
439 Result := Idx;
440 Break;
441 end;
442 end;
443end;
444
445function FormatSize(Byte: Double): string;
446begin
447 if (Byte > 0) then
448 begin
449 if (Byte < 1024) then
450 Result := Format('%.2n b', [Byte])
451 else
452 if (Byte > 1024) then
453 begin
454 Byte := (Byte / 1024);
455 if (Byte < 1024) then
456 Result := Format('%.2n Kb', [Byte])
457 else
458 begin
459 Byte := (Byte / 1024);
460 Result := Format('%.2n Mb', [Byte]);
461 end;
462 end;
463 end;
464end;
465
466function IsValidURL(const URL: Widestring): Boolean;
467begin
468 Result := UrlMon.IsValidURL(nil, PWideChar(URL), 0) = S_OK;
469end;
470
471
472function WideStringToWideChar(const inString: WideString): PWideChar;
473begin
474 Result := CoTaskMemAlloc((Length(inString) + 1) * SizeOf(WideChar));
475 Move(inString, Result, (Length(inString) + 1) * SizeOf(WideChar));
476end;
477
478procedure FreeWideChar(var inString: PWideChar);
479begin
480 if Assigned(inString) then
481 begin
482 CoTaskMemFree(inString);
483 inString := nil;
484 end;
485end;
486
487function QueryRemoteFileInfo(const Url: string; dwInfoFlag: Integer): string;
488var
489 hInet: HINTERNET;
490 hConnect: HINTERNET;
491 infoBuffer: array[0..512] of char;
492 dummy: DWORD;
493 bufLen: DWORD;
494 lbResult: LongBool;
495begin
496 hInet := InternetOpen(PChar('TIDownload'),
497 INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY, nil, nil, 0);
498 hConnect := InternetOpenUrl(hInet, PChar(Url), nil, 0, INTERNET_FLAG_NO_UI, 0);
499 if not Assigned(hConnect) then
500 begin
501 Result := '';
502 end
503 else
504 begin
505 dummy := 0;
506 bufLen := Length(infoBuffer);
507 lbResult := HttpQueryInfo(hConnect, dwInfoFlag, @infoBuffer[0], bufLen, dummy);
508 if lbResult then
509 Result := infoBuffer
510 else
511 Result := '';
512 InternetCloseHandle(hConnect);
513 end;
514 InternetCloseHandle(hInet);
515end;
516
517function GetInfoByMimeType(const ContentType: string): boolean;
518var
519 Reg: TRegistry;
520 CLSID: string;
521begin
522 Result := FALSE;
523
524 Reg := TRegistry.Create(KEY_READ);
525 try
526 with Reg do
527 begin
528 RootKey := HKEY_CLASSES_ROOT;
529 if OpenKeyReadOnly('MIME\Database\Content Type\' + ContentType) then
530 begin
531 if ValueExists('CLSID') then
532 begin
533 CLSID := ReadString('CLSID');
534 if CLSID <> '' then
535 begin
536 if OpenKeyReadOnly('\CLSID\' + CLSID) then
537 begin
538 if KeyExists('Control') then
539 begin
540 if KeyExists('EnableFullPage') then
541 begin
542 Result := TRUE;
543 end;
544 end;
545 end;
546 end;
547 end;
548 end;
549 CloseKey;
550 end;
551 finally
552 Reg.Free;
553 end;
554end;
555
556function StrContain(SubString: string; Str: string): boolean;
557begin
558 Result := AnsiPos(AnsiLowerCase(SubString), AnsiLowerCase(Str)) > 0;
559end;
560
561function IncludeTrailingPathDelimiter(const S: string): string;
562begin
563 Result := S;
564 if not IsPathDelimiter(Result, Length(Result)) then
565 Result := Result + PathDelim;
566end;
567
568function CharReplace(const Source: string; OldChar, NewChar: Char): string;
569var
570 i: Integer;
571begin
572 Result := Source;
573 for i := 1 to Length(Result) do
574 if Result[i] = OldChar then
575 Result[i] := NewChar
576end;
577
578end.
Note: See TracBrowser for help on using the repository browser.