source: cprs/branches/tmg-cprs/CPRS-Chart/TMG_Extra/HTMLEdit/EwbAcc.pas@ 1561

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

TMG Ver 1.1 Added HTML Support, better demographics editing
File size: 28.3 KB
Line 
1//**************************************************************
2// *
3// EwbAcc * *
4// For Delphi *
5// by bsalsa *
6// bsalsa@gmail.com *
7// Updated versions: *
8// http://www.bsalsa.com *
9//**************************************************************
10
11{*******************************************************************************}
12{LICENSE:
13THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND,
14EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED
15WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
16YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE
17AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE
18AND DOCUMENTATION. BSALSA PRODUCTIONS DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE
19OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED
20OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS,
21INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR
22OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS,
23AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. BSALSA PRODUCTIONS SPECIFICALLY
24DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE.
25
26You may use, change or modify the component under 4 conditions:
271. In your website, add a link to "http://www.bsalsa.com"
282. In your application, add credits to "Embedded Web Browser"
293. Mail me (bsalsa@gmail.com) any code change in the unit
30 for the benefit of the other users.
314. Please, consider donation in our web site!
32{*******************************************************************************}
33
34
35unit EwbAcc;
36
37interface
38
39{$I EWB.inc}
40
41uses
42 ActiveX, SysUtils, ShlObj, Windows, UrlMon, IEConst;
43
44type
45 IObjectIdentity = interface
46 ['{CA04B7E6-0D21-11d1-8CC5-00C04FC2B085}']
47 function IsEqualObject(unk: IUnknown): HRESULT; stdcall;
48 end;
49
50 INTERNET_PER_CONN_OPTION = record
51 dwOption: DWORD;
52 Value: record
53 case Integer of
54 1: (dwValue: DWORD);
55 2: (pszValue: PAnsiChar);
56 3: (ftValue: TFileTime);
57 end;
58 end;
59 LPINTERNET_PER_CONN_OPTION = ^INTERNET_PER_CONN_OPTION;
60 INTERNET_PER_CONN_OPTION_LIST = record
61 dwSize: DWORD;
62 pszConnection: LPTSTR;
63 dwOptionCount: DWORD;
64 dwOptionError: DWORD;
65 pOptions: LPINTERNET_PER_CONN_OPTION;
66 end;
67 LPINTERNET_PER_CONN_OPTION_LIST = ^INTERNET_PER_CONN_OPTION_LIST;
68
69type
70 BrowserNavConstants = TOleEnum;
71 STATURL = record
72 cbSize: DWORD;
73 pwcsUrl: DWORD;
74 pwcsTitle: DWORD;
75 ftLastVisited: FILETIME;
76 ftLastUpdated: FILETIME;
77 ftExpires: FILETIME;
78 dwFlags: DWORD;
79 end;
80
81 OSVERSIONINFOEX = packed record
82 dwOSVersionInfoSize: DWORD;
83 dwMajorVersion: DWORD;
84 dwMinorVersion: DWORD;
85 dwBuildNumber: DWORD;
86 dwPlatformId: DWORD;
87 szCSDVersion: array[0..127] of Char;
88 wServicePackMajor: WORD;
89 wServicePackMinor: WORD;
90 wSuiteMask: WORD;
91 wProductType: Byte;
92 wReserved: Byte;
93 end;
94 TOSVersionInfoEx = OSVERSIONINFOEX;
95 POSVersionInfoEx = ^TOSVersionInfoEx;
96
97 IZoomEvents = interface(IUnknown)
98 ['{41B68150-904C-4E17-A0BA-A438182E359D}']
99 function OnZoomPercentChanged(const ulZoomPercent: ulong): HRESULT; stdcall;
100 end;
101
102 IHLinkFrame = interface(IUnknown)
103 ['{79EAC9C5-BAF9-11CE-8C82-00AA004BA90B}']
104 {Some functions are not supported any more?}
105 //function SetBrowseContext(ppihlbc: IHlinkBrowseContext): HRESULT; stdcall;
106 //function GetBrowseContext(out ppihlbc: IHlinkBrowseContext): HRESULT; stdcall;
107 //function Navigate(grfHLNF: DWORD; pbc: IBindCtx; pibsc: IBindStatusCallback; pihlNavigate: IHLink): HRESULT; stdcall;
108 function OnNavigate(grfHLNF: DWORD; pimkTarget: IMoniker; pwzLocation,
109 pwzFriendlyName: PWideChar; dwreserved: DWORD): HRESULT; stdcall;
110 function UpdateHlink(uHLID: ULONG; pimkTarget: IMoniker; pwzLocation,
111 pwzFriendlyName: PWideChar): HRESULT; stdcall;
112 end;
113
114 IDownloadManager = interface(IUnknown)
115 ['{988934A4-064B-11D3-BB80-00104B35E7F9}']
116 function Download(
117 pmk: IMoniker; // Identifies the object to be downloaded
118 pbc: IBindCtx; // Stores information used by the moniker to bind
119 dwBindVerb: DWORD; // The action to be performed during the bind
120 grfBINDF: DWORD; // Determines the use of URL encoding during the bind
121 pBindInfo: PBindInfo; // Used to implement IBindStatusCallback::GetBindInfo
122 pszHeaders: PWideChar; // Additional headers to use with IHttpNegotiate
123 pszRedir: PWideChar; // The URL that the moniker is redirected to
124 uiCP: UINT // The code page of the object's display name
125 ): HRESULT; stdcall;
126 end;
127
128 IEnumSTATURL = interface(IUnknown)
129 ['{3C374A42-BAE4-11CF-BF7D-00AA006946EE}']
130 function Next(celt: Integer; out elt; pceltFetched: PLongint): HRESULT;
131 stdcall;
132 function Skip(celt: Longint): HRESULT; stdcall;
133 function Reset: HRESULT; stdcall;
134 function Clone(out ppenum: IEnumSTATURL): HRESULT; stdcall;
135 function SetFilter(poszFilter: PWideChar; dwFlags: DWORD): HRESULT; stdcall;
136 end;
137
138type
139 TSTATURL = record
140 cbSize: DWORD;
141 pwcsUrl: DWORD;
142 pwcsTitle: DWORD;
143 ftLastVisited: FILETIME;
144 ftLastUpdated: FILETIME;
145 ftExpires: FILETIME;
146 dwFlags: DWORD;
147 end;
148
149 PEntry = ^TEntry;
150 TEntry = record
151 Url: string;
152 Title: string;
153 LastVisited,
154 LastUpdated,
155 Expires: TDateTime;
156 end;
157
158 IUrlHistoryStg = interface(IUnknown)
159 ['{3C374A41-BAE4-11CF-BF7D-00AA006946EE}']
160 function AddUrl(pocsUrl: PWideChar; pocsTitle: PWideChar; dwFlags: Integer): HRESULT; stdcall;
161 function DeleteUrl(pocsUrl: PWideChar; dwFlags: Integer): HRESULT; stdcall;
162 function QueryUrl(pocsUrl: PWideChar; dwFlags: Integer; var lpSTATURL: TSTATURL): HRESULT; stdcall;
163 function BindToObject(pocsUrl: PWideChar; var riid: TIID; out ppvOut: Pointer): HRESULT; stdcall;
164 function EnumUrls(out ppenum: IEnumSTATURL): HRESULT; stdcall;
165 end;
166
167
168 IUrlHistoryStg2 = interface(IUrlHistoryStg)
169 ['{AFA0DC11-C313-11D0-831A-00C04FD5AE38}']
170 function AddUrlAndNotify(pocsUrl: PWideChar; pocsTitle: PWideChar; dwFlags: Integer;
171 FWriteHistory: Integer; var poctNotify: Pointer;
172 const punkISFolder: IUnknown): HRESULT; stdcall;
173 function ClearHistory: HRESULT; stdcall;
174 end;
175
176 IUrlHistoryNotify = interface(IOleCommandTarget)
177 ['{BC40BEC1-C493-11d0-831B-00C04FD5AE38}']
178 end;
179
180 PDOCHOSTUIINFO = ^TDOCHOSTUIINFO;
181 TDOCHOSTUIINFO = record
182 cbSize: ULONG;
183 dwFlags: DWORD;
184 dwDoubleClick: DWORD;
185 chHostCss: POleStr;
186 chHostNS: POleStr;
187 end;
188
189type
190 INewWindowManager = interface(IUnknown)
191 ['{D2BC4C84-3F72-4a52-A604-7BCBF3982CBB}']
192 function EvaluateNewWindow(pszUrl, pszName, pszUrlContext, pszFeatures:
193 LPCWSTR;
194 fReplace: BOOL; dwFlags, dwUserActionTime: DWORD): HRESULT; stdcall;
195 end;
196
197 IDocHostShowUI = interface(IUnknown)
198 ['{c4d244b0-d43e-11cf-893b-00aa00bdce1a}']
199 function ShowMessage(hwnd: THandle; lpstrText: POleStr; lpstrCaption: POleStr;
200 dwType: longint; lpstrHelpFile: POleStr; dwHelpContext: longint;
201 var plResult: LRESULT): HRESULT; stdcall;
202 function ShowHelp(hwnd: THandle; pszHelpFile: POleStr; uCommand: integer;
203 dwData: longint; ptMouse: TPoint;
204 var pDispatchObjectHit: IDispatch): HRESULT; stdcall;
205 end;
206
207 IDocHostUIHandler = interface(IUnknown)
208 ['{bd3f23c0-d43e-11cf-893b-00aa00bdce1a}']
209 function ShowContextMenu(const dwID: DWORD; const ppt: PPOINT;
210 const CommandTarget: IUnknown; const Context: IDispatch): HRESULT;
211 stdcall;
212 function GetHostInfo(var pInfo: TDOCHOSTUIINFO): HRESULT; stdcall;
213 function ShowUI(const dwID: DWORD; const pActiveObject:
214 IOleInPlaceActiveObject;
215 const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
216 const pDoc: IOleInPlaceUIWindow): HRESULT; stdcall;
217 function HideUI: HRESULT; stdcall;
218 function UpdateUI: HRESULT; stdcall;
219 function EnableModeless(const fEnable: BOOL): HRESULT; stdcall;
220 function OnDocWindowActivate(const fActivate: BOOL): HRESULT; stdcall;
221 function OnFrameWindowActivate(const fActivate: BOOL): HRESULT; stdcall;
222 function ResizeBorder(const prcBorder: PRECT;
223 const pUIWindow: IOleInPlaceUIWindow;
224 const fRameWindow: BOOL): HRESULT; stdcall;
225 function TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup: PGUID;
226 const nCmdID: DWORD): HRESULT; stdcall;
227 function GetOptionKeyPath(out pchKey: POleStr; const dw: DWORD): HRESULT;
228 stdcall;
229 function GetDropTarget(const pDropTarget: IDropTarget;
230 out ppDropTarget: IDropTarget): HRESULT; stdcall;
231 function GetExternal(out ppDispatch: IDispatch): HRESULT; stdcall;
232 function TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POleStr;
233 out ppchURLOut: POleStr): HRESULT; stdcall;
234 function FilterDataObject(const pDO: IDataObject;
235 out ppDORet: IDataObject): HRESULT; stdcall;
236 end;
237
238 IDocHostUIHandler2 = interface(IDocHostUIHandler)
239 ['{3050f6d0-98b5-11cf-bb82-00aa00bdce0b}']
240 function GetOverrideKeyPath(out pchKey: POleStr; dw: DWORD): HRESULT;
241 stdcall;
242 end;
243
244 IProtectFocus = interface
245 ['{D81F90A3-8156-44F7-AD28-5ABB87003274}']
246 function AllowFocusChange(out pfAllow: BOOL): HRESULT; stdcall;
247 end;
248
249 ICustomDoc = interface(IUnknown)
250 ['{3050f3f0-98b5-11cf-bb82-00aa00bdce0b}']
251 function SetUIHandler(const pUIHandler: IDocHostUIHandler): HRESULT;
252 stdcall;
253 end;
254
255 IHTMLOMWindowServices = interface(IUnknown)
256 ['{3050f5fc-98b5-11cf-bb82-00aa00bdce0b}']
257 function moveTo(const x, y: Integer): HRESULT; stdcall;
258 function moveBy(const x, y: Integer): HRESULT; stdcall;
259 function resizeTo(const x, y: Integer): HRESULT; stdcall;
260 function resizeBy(const x, y: Integer): HRESULT; stdcall;
261 end;
262
263type
264 ITravelLogEntry = interface(IUnknown)
265 ['{7EBFDD87-AD18-11d3-A4C5-00C04F72D6B8}']
266 function GetTitle(var ppszTitle: POleStr): HRESULT; stdcall;
267 function GetUrl(var ppszURL: POleStr): HRESULT; stdcall;
268 end;
269
270 IEnumTravelLogEntry = interface(IUnknown)
271 ['{7EBFDD85-AD18-11d3-A4C5-00C04F72D6B8}']
272 function Next(cElt: ULONG; out rgElt: ITravelLogEntry; out pcEltFetched: ULONG): HRESULT; stdcall;
273 function Skip(cElt: ULONG): HRESULT; stdcall;
274 function Reset: HRESULT; stdcall;
275 function Clone(out ppEnum: IEnumTravelLogEntry): HRESULT; stdcall;
276 end;
277
278 ITravelLogStg = interface(IUnknown)
279 ['{7EBFDD80-AD18-11d3-A4C5-00C04F72D6B8}']
280 function CreateEntry(pszURL, pszTitle: POleStr; ptleRelativeTo: ITravelLogEntry;
281 fPrepend: BOOL; out pptle: ITravelLogEntry): HRESULT; stdcall;
282 function TravelTo(ptle: ITravelLogEntry): HRESULT; stdcall;
283 function EnumEntries(Flags: DWORD; out ppenum: IEnumTravellogEntry): HRESULT; stdcall;
284 function FindEntries(Flags: DWORD; pszURL: POleStr; out ppenum: IEnumTravelLogEntry): HRESULT; stdcall;
285 function GetCount(Flags: DWORD; out pcEntries: DWORD): HRESULT; stdcall;
286 function RemoveEntry(ptle: ITravelLogEntry): HRESULT; stdcall;
287 function GetRelativeEntry(iOffset: Integer; out ptle: ITravelLogEntry): HRESULT; stdcall;
288 end;
289
290 PUrlInvokeCommandInfoA = ^TUrlInvokeCommandInfoA;
291 TUrlInvokeCommandInfoA = record
292 dwcbSize: DWORD; // Size of structure
293 dwFlags: DWORD; // Bit field of IURL_INVOKECOMMAND_FLAGS
294 hwndParent: HWND;
295 // Parent window. Valid only if IURL_INVOKECOMMAND_FL_ALLOW_UI is set.
296 pcszVerb: LPCSTR;
297 // Verb to invoke. Ignored if IURL_INVOKECOMMAND_FL_USE_DEFAULT_VERB is set.
298 end;
299
300 PUrlInvokeCommandInfoW = ^TUrlInvokeCommandInfoW;
301 TUrlInvokeCommandInfoW = record
302 dwcbSize: DWORD; // Size of structure
303 dwFlags: DWORD; // Bit field of IURL_INVOKECOMMAND_FLAGS
304 hwndParent: HWND;
305 // Parent window. Valid only if IURL_INVOKECOMMAND_FL_ALLOW_UI is set.
306 pcszVerb: LPCWSTR;
307 // Verb to invoke. Ignored if IURL_INVOKECOMMAND_FL_USE_DEFAULT_VERB is set.
308 end;
309
310{$IFDEF UNICODE}
311 PURLInvokeCommandInfo = ^TUrlInvokeCommandInfoW;
312 TUrlInvokeCommandInfo = TUrlInvokeCOmmandInfoW;
313{$ELSE}
314 PURLInvokeCommandInfo = ^TUrlInvokeCommandInfoA;
315 TUrlInvokeCommandInfo = TUrlInvokeCOmmandInfoA;
316{$ENDIF}
317
318 IUniformResourceLocatorA = interface(IUnknown)
319 [SID_IUniformResourceLocatorA]
320 function SetURL(pcszURL: LpcStr; dwInFlags: DWORD): HRESULT; stdcall;
321 function GetURL(ppszURL: LpStr): HRESULT; stdcall;
322 function InvokeCommand(purlici: PURLINVOKECOMMANDINFOA): HRESULT; stdcall;
323
324 end;
325
326 IUniformResourceLocatorW = interface(IUnknown)
327 [SID_IUniformResourceLocatorW]
328 function SetURL(pcszURL: LpcWStr; dwInFlags: DWORD): HRESULT; stdcall;
329 function GetURL(ppszURL: LpWStr): HRESULT; stdcall;
330 function InvokeCommand(purlici: PURLINVOKECOMMANDINFOW): HRESULT; stdcall;
331 end;
332
333{$IFDEF UNICODE}
334 IUniformResourceLocator = IUniformResourceLocatorW;
335{$ELSE}
336 IUniformResourceLocator = IUniformResourceLocatorA;
337{$ENDIF}
338
339function TranslateURLA(pcszURL: LPCSTR;
340 dwInFlags: DWORD;
341 ppszTranslatedURL: LPSTR): HRESULT; stdcall;
342
343function TranslateURLW(pcszURL: LPCWSTR;
344 dwInFlags: DWORD;
345 ppszTranslatedURL: LPWSTR): HRESULT; stdcall;
346
347{$IFDEF UNICODE}
348function TranslateURL(pcszURL: LPCWSTR;
349 dwInFlags: DWORD;
350 ppszTranslatedURL: LPWSTR): HRESULT; stdcall;
351{$ELSE}
352function TranslateURL(pcszURL: LPCSTR;
353 dwInFlags: DWORD;
354 ppszTranslatedURL: LPSTR): HRESULT; stdcall;
355{$ENDIF}
356
357function URLAssociationDialogA(hwndParent: HWND;
358 dwInFlags: DWORD;
359 pcszFile: LPCSTR;
360 pcszURL: LPCSTR;
361 pszAppBuf: LPSTR;
362 ucAppBufLen: UINT): HRESULT; stdcall;
363
364function URLAssociationDialogW(hwndParent: HWND;
365 dwInFlags: DWORD;
366 pcszFile: LPCWSTR;
367 pcszURL: LPCWSTR;
368 pszAppBuf: LPWSTR;
369 ucAppBufLen: UINT): HRESULT; stdcall;
370
371{$IFDEF UNICODE}
372function URLAssociationDialog(hwndParent: HWND;
373 dwInFlags: DWORD;
374 pcszFile: LPCWSTR;
375 pcszURL: LPCWSTR;
376 pszAppBuf: LPWSTR;
377 ucAppBufLen: UINT): HRESULT; stdcall;
378{$ELSE}
379function URLAssociationDialog(hwndParent: HWND;
380 dwInFlags: DWORD;
381 pcszFile: LPCSTR;
382 pcszURL: LPCSTR;
383 pszAppBuf: LPSTR;
384 ucAppBufLen: UINT): HRESULT; stdcall;
385{$ENDIF}
386
387function MIMEAssociationDialogA(hwndParent: HWND;
388 dwInFlags: DWORD;
389 pcszFile: LPCSTR;
390 pcszMIMEContentType: LPCSTR;
391 pszAppBuf: LPSTR;
392 ucAppBufLen: UINT): HRESULT; stdcall;
393
394function MIMEAssociationDialogW(hwndParent: HWND;
395 dwInFlags: DWORD;
396 pcszFile: LPCWSTR;
397 pcszMIMEContentType: LPCWSTR;
398 pszAppBuf: LPWSTR;
399 ucAppBufLen: UINT): HRESULT; stdcall;
400
401{$IFDEF UNICODE}
402function MIMEAssociationDialog(hwndParent: HWND;
403 dwInFlags: DWORD;
404 pcszFile: LPCWSTR;
405 pcszMIMEContentType: LPCWSTR;
406 pszAppBuf: LPWSTR;
407 ucAppBufLen: UINT): HRESULT; stdcall;
408{$ELSE}
409function MIMEAssociationDialog(hwndParent: HWND;
410 dwInFlags: DWORD;
411 pcszFile: LPCSTR;
412 pcszMIMEContentType: LPCSTR;
413 pszAppBuf: LPSTR;
414 ucAppBufLen: UINT): HRESULT; stdcall;
415{$ENDIF}
416
417function InetIsOffline(dwFlags: DWORD): BOOL; stdcall;
418
419//Serge
420{$IFDEF DELPHI6_UP}
421type
422{$EXTERNALSYM _tagINTERNETFEATURELIST}
423 _tagINTERNETFEATURELIST = (
424 FEATURE_OBJECT_CACHING = 0,
425 FEATURE_ZONE_ELEVATION = 1,
426 FEATURE_MIME_HANDLING = 2,
427 FEATURE_MIME_SNIFFING = 3,
428 FEATURE_WINDOW_RESTRICTIONS = 4,
429 FEATURE_WEBOC_POPUPMANAGEMENT = 5,
430 FEATURE_BEHAVIORS = 6,
431 FEATURE_DISABLE_MK_PROTOCOL = 7,
432 FEATURE_LOCALMACHINE_LOCKDOWN = 8,
433 FEATURE_SECURITYBAND = 9,
434 FEATURE_RESTRICT_ACTIVEXINSTALL = 10,
435 FEATURE_VALIDATE_NAVIGATE_URL = 11,
436 FEATURE_RESTRICT_FILEDOWNLOAD = 12,
437 FEATURE_ADDON_MANAGEMENT = 13,
438 FEATURE_PROTOCOL_LOCKDOWN = 14,
439 FEATURE_HTTP_USERNAME_PASSWORD_DISABLE = 15,
440 FEATURE_SAFE_BINDTOOBJECT = 16,
441 FEATURE_UNC_SAVEDFILECHECK = 17,
442 FEATURE_GET_URL_DOM_FILEPATH_UNENCODED = 18,
443 FEATURE_TABBED_BROWSING = 19,
444 FEATURE_SSLUX = 20,
445 FEATURE_DISABLE_NAVIGATION_SOUNDS = 21,
446 FEATURE_DISABLE_LEGACY_COMPRESSION = 22,
447 FEATURE_FORCE_ADDR_AND_STATUS = 23,
448 FEATURE_XMLHTTP = 24,
449 FEATURE_DISABLE_TELNET_PROTOCOL = 25,
450 FEATURE_FEEDS = 26,
451 FEATURE_BLOCK_INPUT_PROMPTS = 27,
452 FEATURE_ENTRY_COUNT = 28
453 );
454 TInternetFeature = _tagINTERNETFEATURELIST;
455{$ELSE}
456type
457 _tagINTERNETFEATURELIST = (
458 FEATURE_OBJECT_CACHING,
459 FEATURE_ZONE_ELEVATION,
460 FEATURE_MIME_HANDLING,
461 FEATURE_MIME_SNIFFING,
462 FEATURE_WINDOW_RESTRICTIONS,
463 FEATURE_WEBOC_POPUPMANAGEMEN,
464 FEATURE_BEHAVIORS,
465 FEATURE_DISABLE_MK_PROTOCOL,
466 FEATURE_LOCALMACHINE_LOCKDOWN,
467 FEATURE_SECURITYBAND,
468 FEATURE_RESTRICT_ACTIVEXINSTALL,
469 FEATURE_VALIDATE_NAVIGATE_URL,
470 FEATURE_RESTRICT_FILEDOWNLOAD,
471 FEATURE_ADDON_MANAGEMENT,
472 FEATURE_PROTOCOL_LOCKDOWN,
473 FEATURE_HTTP_USERNAME_PASSWORD_DISABLE,
474 FEATURE_SAFE_BINDTOOBJECT,
475 FEATURE_UNC_SAVEDFILECHECK,
476 FEATURE_GET_URL_DOM_FILEPATH_UNENCODED,
477 FEATURE_TABBED_BROWSING,
478 FEATURE_SSLUX,
479 FEATURE_DISABLE_NAVIGATION_SOUNDS,
480 FEATURE_DISABLE_LEGACY_COMPRESSION,
481 FEATURE_FORCE_ADDR_AND_STATUS,
482 FEATURE_XMLHTTP,
483 FEATURE_DISABLE_TELNET_PROTOCOL,
484 FEATURE_FEEDS,
485 FEATURE_BLOCK_INPUT_PROMPTS,
486 FEATURE_ENTRY_COUNT);
487 TInternetFeature = _tagINTERNETFEATURELIST;
488{$ENDIF}
489
490
491function CoInternetSetFeatureEnabled(aFeature: TInternetFeature;
492 dwFlags: DWORD; fEnable: Boolean): HRESULT;
493function CoInternetIsFeatureEnabled(aFeature: TInternetFeature;
494 dwFlags: DWORD): HRESULT;
495function CoInternetIsFeatureEnabledForUrl(aFeature: TInternetFeature;
496 dwFlags: DWORD; szUrl: LPCWSTR; pSecMgr: IInternetSecurityManager): HRESULT;
497
498function CoInternetIsFeatureZoneElevationEnabled(
499 szFromURL, szToURL: LPCWSTR; pSecMgr: IInternetSecurityManager;
500 dwFlags: DWORD): HRESULT;
501
502var
503 ShellModule: THandle;
504 ComCtlModule: THandle;
505 HHCtrlModule: THandle;
506 URLMonModule: THandle;
507
508function SHLockShared(Handle: THandle; DW: DWORD): Pointer; stdcall;
509function SHUnlockShared(Pnt: Pointer): BOOL; stdcall;
510function SHFreeShared(Handle: THandle; DW: DWORD): Pointer; stdcall;
511function _Free(Pidl: PItemIDList): BOOL; stdcall;
512function HtmlHelp(hwndCaller: HWND; pszFile: PChar; uCommand: Integer;
513 dwData: DWORD): HWND; stdcall;
514
515function GetSHDOCLCModule: THandle;
516
517{events}
518type
519 OnQueryInterfaceEvent = procedure(Sender: TObject; const IID: TGUID; var Obj; Rezult: HRESULT) of object;
520
521 {IDispatch Interface}
522 TGetTypeInfoCountEvent = procedure(Sender: TObject; var Count: Integer; var
523 Rezult: HRESULT) of object;
524 TGetTypeInfoEvent = procedure(Sender: TObject; Index, LocaleID: Integer; var
525 TypeInfo: ITypeInfo; var Rezult: HRESULT) of object;
526 TGetIDsOfNamesEvent = procedure(Sender: TObject; const IID: TGUID; Names:
527 Pointer;
528 NameCount, LocaleID: Integer; DispIDs: Pointer; var Rezult: HRESULT) of
529 object;
530 TInvokeEvent = procedure(Sender: TObject; DispID: Integer; const IID: TGUID;
531 LocaleID: Integer;
532 Flags: Word; var Params: TDispParams; VarResult, ExcepInfo, ArgErr: Pointer;
533 var Rezult: HRESULT) of object;
534 {IDropTarget Interface}
535 TOnDropEvent = procedure(Sender: TObject; const dataObj: IDataObject;
536 grfKeyState: Longint; pt: TPoint;
537 var dwEffect: Longint; var Rezult: HRESULT) of object;
538 TOnDragEnterEvent = procedure(Sender: TObject; const dataObj: IDataObject;
539 grfKeyState: Longint;
540 pt: TPoint; var dwEffect: Longint; var Rezult: HRESULT) of object;
541 TOnDragOverEvent = procedure(Sender: TObject; grfKeyState: Longint; pt:
542 TPoint; var dwEffect: Longint;
543 var Rezult: HRESULT) of object;
544 {IOLECommandTarget Interface}
545 TComTargetExecEvent = procedure(Sender: TObject; CmdGroup: PGUID; nCmdID,
546 nCmdexecopt: DWORD;
547 const vaIn: OleVariant; var vaOut: OleVariant; var Rezult: HRESULT) of
548 object;
549 {IServiceProvider Interface}
550 TQueryServiceEvent = procedure(Sender: TObject; const rsid, iid: TGUID; var
551 Obj: IUnknown) of object;
552
553implementation
554
555function InetIsOffline; external urldll name 'InetIsOffline';
556
557function MIMEAssociationDialogW; external urldll name 'MIMEAssociationDialogW';
558function MIMEAssociationDialogA; external urldll name 'MIMEAssociationDialogA';
559{$IFDEF UNICODE}
560function MIMEAssociationDialog; external urldll name 'MIMEAssociationDialogW';
561{$ELSE}
562function MIMEAssociationDialog; external urldll name 'MIMEAssociationDialogA';
563{$ENDIF}
564
565function URLAssociationDialogW; external urldll name 'URLAssociationDialogW';
566function URLAssociationDialogA; external urldll name 'URLAssociationDialogA';
567{$IFDEF UNICODE}
568function URLAssociationDialog; external urldll name 'URLAssociationDialogW';
569{$ELSE}
570function URLAssociationDialog; external urldll name 'URLAssociationDialogA';
571{$ENDIF}
572
573function TranslateURLA; external urldll name 'TranslateURLA';
574function TranslateURLW; external urldll name 'TranslateURLW';
575{$IFDEF UNICODE}
576function TranslateURL; external urldll name 'TranslateURLW';
577{$ELSE}
578function TranslateURL; external urldll name 'TranslateURLA';
579{$ENDIF}
580
581
582function GetShellModule: THandle;
583begin
584 if ShellModule = 0 then
585 begin
586 ShellModule := SafeLoadLibrary(Shell32);
587 if ShellModule <= HINSTANCE_ERROR then
588 ShellModule := 0;
589 end;
590 Result := ShellModule;
591end;
592
593function GetHHctrlModule: THandle;
594begin
595 if HHCtrlModule = 0 then
596 begin
597 HHCtrlModule := SafeLoadLibrary(HHCtrl);
598 if HHCtrlModule <= HINSTANCE_ERROR then
599 HHCtrlModule := 0;
600 end;
601 Result := HHCtrlModule;
602end;
603
604function GetComctlModule: THandle;
605begin
606 if ComctlModule = 0 then
607 begin
608 ComctlModule := SafeLoadLibrary(comctl32);
609 if ComctlModule <= HINSTANCE_ERROR then
610 ComctlModule := 0;
611 end;
612 Result := ComctlModule;
613end;
614
615function HtmlHelp(hwndCaller: HWND; pszFile: PChar; uCommand: Integer;
616 dwData: DWORD): HWND; stdcall;
617type
618 TheFunctionType = function(hwndCaller: HWND; pszFile: PChar; uCommand: Integer;
619 dwData: DWORD): HWND; stdcall;
620var
621 TheFunction: TheFunctionType;
622begin
623 Result := 0;
624 if HHCtrlModule = 0 then
625 HHCtrlModule := GetHHCtrlModule;
626 if HHCtrlModule <> 0 then
627 begin
628{$IFDEF UNICODE}
629 TheFunction := GetProcAddress(HHCtrlModule, 'HtlmHelpW');
630{$ELSE}
631 TheFunction := GetProcAddress(HHCtrlModule, 'HtlmHelpA');
632{$ENDIF UNICODE}
633 if (Assigned(TheFunction)) then
634 Result := TheFunction(hwndCaller, pszFile, uCommand, dwdata);
635 end;
636end;
637
638function _Free(Pidl: PItemIDList): BOOL; stdcall;
639type
640 TheFunctionType = function(Pidl: PItemIDList): BOOL; stdcall;
641var
642 TheFunction: TheFunctionType;
643begin
644 Result := False;
645 if ComctlModule = 0 then
646 ComctlModule := GetComctlModule;
647 if ComctlModule <> 0 then
648 begin
649 TheFunction := GetProcAddress(ComctlModule, PChar(Free_Index));
650 if (Assigned(TheFunction)) then
651 Result := TheFunction(Pidl);
652 end;
653end;
654
655function SHLockShared(Handle: THandle; DW: DWORD): Pointer; stdcall;
656type
657 TheFunctionType = function(Handle: THandle; DW: DWORD): Pointer; stdcall;
658var
659 TheFunction: TheFunctionType;
660begin
661 Result := nil;
662 if ShellModule = 0 then
663 ShellModule := GetShellModule;
664 if ShellModule <> 0 then
665 begin
666 TheFunction := GetProcAddress(ShellModule, PChar(SHLockShared_Index));
667 if (Assigned(TheFunction)) then
668 Result := TheFunction(Handle, DW);
669 end;
670end;
671
672function SHUnLockShared(pnt: Pointer): BOOL; stdcall;
673type
674 TheFunctionType = function(pnt: Pointer): BOOL; stdcall;
675var
676 TheFunction: TheFunctionType;
677begin
678 Result := FALSE;
679 if ShellModule = 0 then
680 ShellModule := GetShellModule;
681 if ShellModule <> 0 then
682 begin
683 TheFunction := GetProcAddress(ShellModule, PChar(SHUnLockShared_Index));
684 if (Assigned(TheFunction)) then
685 Result := TheFunction(pnt);
686 end;
687end;
688
689function SHFreeShared(Handle: THandle; DW: DWORD): Pointer; stdcall;
690type
691 TheFunctionType = function(Handle: THandle; DW: DWORD): Pointer; stdcall;
692var
693 TheFunction: TheFunctionType;
694begin
695 Result := nil;
696 if ShellModule = 0 then
697 ShellModule := GetShellModule;
698 if ShellModule <> 0 then
699 begin
700 TheFunction := GetProcAddress(ShellModule, PChar(SHFreeShared_Index));
701 if (Assigned(TheFunction)) then
702 Result := TheFunction(Handle, DW);
703 end;
704end;
705
706function CheckURLMonModule: Boolean;
707begin
708 if URLMonModule = 0 then
709 URLMonModule := SafeLoadLibrary(UrlMonLib);
710 Result := URLMonModule > HINSTANCE_ERROR;
711end;
712
713function CheckURLMonModuleFunc(const Name: string; var ptr: Pointer): Boolean;
714begin
715 Result := CheckURLMonModule;
716 if Result then
717 begin
718 ptr := GetProcAddress(URLMonModule, PChar(Name));
719 Result := Assigned(ptr);
720 if not Result then
721 ptr := Pointer(1); // ???
722 end;
723end;
724
725type
726 TCoInternetSetFeatureEnabled = function(aFeature: DWORD;
727 dwFlags: DWORD; fEnable: BOOL): HRESULT; stdcall;
728 TCoInternetIsFeatureEnabled = function(aFeature: DWORD;
729 dwFlags: DWORD): HRESULT; stdcall;
730 TCoInternetIsFeatureEnabledForUrl = function(aFeature: DWORD;
731 dwFlags: DWORD; szUrl: LPCWSTR; pSecMgr: IInternetSecurityManager): HRESULT;
732 stdcall;
733 TCoInternetIsFeatureZoneElevationEnabled = function(szFromURL, szToURL:
734 LPCWSTR; pSecMgr: IInternetSecurityManager;
735 dwFlags: DWORD): HRESULT; stdcall;
736
737var
738 CoInternetIsFeatureZoneElevationEnabledPtr: Pointer;
739
740 CoInternetSetFeatureEnabledPtr: Pointer;
741 CoInternetIsFeatureEnablePtr: Pointer;
742 CoInternetIsFeatureEnabledForUrlPtr: Pointer;
743
744function CoInternetSetFeatureEnabled(aFeature: TInternetFeature;
745 dwFlags: DWORD; fEnable: Boolean): HRESULT;
746begin
747 if (Integer(CoInternetSetFeatureEnabledPtr) > 1) or
748 CheckURLMonModuleFunc('CoInternetSetFeatureEnabled',
749 CoInternetSetFeatureEnabledPtr) then
750 Result := TCoInternetSetFeatureEnabled(CoInternetSetFeatureEnabledPtr)(
751 DWORD(aFeature), dwFlags, fEnable)
752 else
753 Result := E_NOTIMPL;
754end;
755
756function CoInternetIsFeatureEnabled(aFeature: TInternetFeature;
757 dwFlags: DWORD): HRESULT;
758begin
759 if (Integer(CoInternetIsFeatureEnablePtr) > 1) or
760 CheckURLMonModuleFunc('CoInternetIsFeatureEnabled',
761 CoInternetIsFeatureEnablePtr) then
762 Result := TCoInternetIsFeatureEnabled(CoInternetIsFeatureEnablePtr)(
763 DWORD(aFeature), dwFlags)
764 else
765 Result := E_NOTIMPL;
766end;
767
768function CoInternetIsFeatureEnabledForUrl(aFeature: TInternetFeature;
769 dwFlags: DWORD; szUrl: LPCWSTR; pSecMgr: IInternetSecurityManager): HRESULT;
770begin
771 if (Integer(CoInternetIsFeatureEnabledForUrlPtr) > 1) or
772 CheckURLMonModuleFunc('CoInternetIsFeatureEnabledForUrl',
773 CoInternetIsFeatureEnabledForUrlPtr) then
774 Result :=
775 TCoInternetIsFeatureEnabledForUrl(CoInternetIsFeatureEnabledForUrlPtr)(
776 DWORD(aFeature), dwFlags, szUrl, pSecMgr)
777 else
778 Result := E_NOTIMPL;
779end;
780
781
782function CoInternetIsFeatureZoneElevationEnabled(
783 szFromURL, szToURL: LPCWSTR; pSecMgr: IInternetSecurityManager;
784 dwFlags: DWORD): HRESULT;
785begin
786 if (Integer(CoInternetIsFeatureZoneElevationEnabledPtr) > 1) or
787 CheckURLMonModuleFunc('CoInternetIsFeatureZoneElevationEnabled',
788 CoInternetIsFeatureZoneElevationEnabledPtr) then
789 Result :=
790 TCoInternetIsFeatureZoneElevationEnabled(CoInternetIsFeatureZoneElevationEnabledPtr)(
791 szFromURL, szToURL, pSecMgr, dwFlags)
792 else
793 Result := E_NOTIMPL;
794end;
795
796var
797 HSHDOCLCModule: THandle;
798
799function GetSHDOCLCModule: THandle;
800begin
801 if HSHDOCLCModule = 0 then
802 begin
803 HSHDOCLCModule := GetModuleHandle('SHDOCLC.DLL');
804 if HSHDOCLCModule = 0 then
805 HSHDOCLCModule := SafeLoadLibrary('SHDOCLC.DLL');
806 if HSHDOCLCModule <= HINSTANCE_ERROR then
807 HSHDOCLCModule := 0;
808 end;
809 Result := HSHDOCLCModule;
810end;
811
812
813initialization
814
815finalization
816 if ShellModule <> 0 then
817 FreeLibrary(ShellModule);
818 if ComctlModule <> 0 then
819 FreeLibrary(ComctlModule);
820 if HHCtrlModule <> 0 then
821 FreeLibrary(HHCtrlModule);
822 if URLMonModule <> 0 then
823 FreeLibrary(URLMonModule);
824end.
Note: See TracBrowser for help on using the repository browser.