ewbacc.pas

Delphi VCL Component Pack

// Gets a named custom policy associated with a zone;
// e.g. the Java VM settings can be defined with a unique key such as 'Java'.
// Custom policy support is intended to allow extensibility from the predefined
// set of policies that IE4 has built in.
//
// pwszKey is the string name designating the custom policy.  Components are
//   responsible for having unique names.
// ppPolicy is the callee allocated buffer for the policy byte blob; caller is
//   responsible for freeing this buffer eventually.
// pcbPolicy is the size of the byte blob returned.
// dwRegFlags determines how registry is accessed (see above).
// Returns S_OK if key is found and buffer allocated; ??? if key is not found (no buffer alloced).
// Sets a named custom policy associated with a zone;
// e.g. the Java VM settings can be defined with a unique key such as 'Java'.
// Custom policy support is intended to allow extensibility from the predefined
// set of policies that IE4 has built in.
//
// pwszKey is the string name designating the custom policy.  Components are
//   responsible for having unique names.
// ppPolicy is the caller allocated buffer for the policy byte blob.
// pcbPolicy is the size of the byte blob to be set.
// dwRegFlags determines if HTCU or HKLM is set.
// Returns S_OK or ??? if failed to write the zone custom policy.
// Gets action policy associated with a zone, the builtin, fixed-length policies info.

// dwAction is the action code for the action as defined above.
// pPolicy is the caller allocated buffer for the policy data.
// cbPolicy is the size of the caller allocated buffer.
// dwRegFlags determines how registry is accessed (see above).
// Returns S_OK if action is valid; ??? if action is not valid.

type
{$EXTERNALSYM IInternetZoneManager}
   IInternetZoneManager = interface
      ['{79eac9ef-baf9-11ce-8c82-00aa004ba90b}']

    // Gets the zone attributes (information in registry other than actual security
    // policies associated with the zone).  Zone attributes are fixed as:
      function GetZoneAttributes(dwZone: DWORD;
         var ZoneAttributes: TZoneAttributes): HResult; stdcall;

    // Sets the zone attributes (information in registry other than actual security
    // policies associated with the zone).  Zone attributes as above.
    // Returns S_OK or ??? if failed to write the zone attributes.
      function SetZoneAttributes(dwZone: DWORD;
         const ZoneAttributes: TZoneAttributes): HResult; stdcall;
      function GetZoneCustomPolicy(dwZone: DWORD; const guidKey: TGUID; out pPolicy: Pointer;
         out cbPolicy: DWORD; urlZoneReg: TUrlZoneReg): HResult; stdcall;
      function SetZoneCustomPolicy(dwZone: DWORD; const guidKey: TGUID; pPolicy: Pointer;
         cbPolicy: DWORD; urlZoneReg: TUrlZoneReg): HResult; stdcall;
      function GetZoneActionPolicy(dwZone, dwAction: DWORD; pPolicy: Pointer;
         cbPolicy: DWORD; urlZoneReg: TUrlZoneReg): HResult; stdcall;
      function SetZoneActionPolicy(dwZone, dwAction: DWORD; pPolicy: Pointer;
         cbPolicy: DWORD; urlZoneReg: TUrlZoneReg): HResult; stdcall;
      function PromptAction(dwAction: DWORD; hwndParent: HWnd; pwszUrl, pwszText: LPCWSTR;
         dwPromptFlags: DWORD): HResult; stdcall;
      function LogAction(dwAction: DWORD; pwszUrl, pwszText: LPCWSTR;
         dwLogFlags: DWORD): HResult; stdcall;
      function CreateZoneEnumerator(out dwEnum, dwCount: DWORD;
         dwFlags: DWORD): HResult; stdcall;
      function GetZoneAt(dwEnum, dwIndex: DWORD; out dwZone: DWORD): HResult; stdcall;
      function DestroyZoneEnumerator(dwEnum: DWORD): HResult; stdcall;
      function CopyTemplatePoliciesToZone(dwTemplate, dwZone, dwReserved: DWORD): HResult; stdcall;
   end;

// Creates the security manager object. The first argument is the Service provider
// to allow for delegation
{$EXTERNALSYM CoInternetCreateSecurityManager}
function CoInternetCreateSecurityManager(SP: IServiceProvider; var SM: IInternetSecurityManager;
   dwReserved: DWORD): HResult; stdcall;
{$EXTERNALSYM CoInternetCreateZoneManager}
function CoInternetCreateZoneManager(SP: IServiceProvider; var ZM: IInternetZoneManager;
   dwReserved: DWORD): HResult; stdcall;

{$ENDIF}

var
   ShellModule: THandle;
   ComCtlModule: THandle;
   HHCtrlModule: THandle;

function SHLockShared(Handle: THandle; DW: DWORD): Pointer; stdcall;
function SHUnlockShared(Pnt: Pointer): BOOL; stdcall;
function SHFreeShared(Handle: THandle; DW: DWORD): Pointer; stdcall;
function _Free(Pidl: PItemIDList): BOOL; stdcall;
function HtmlHelp(hwndCaller: HWND; pszFile: PChar; uCommand: Integer;
   dwData: DWORD): HWND; stdcall;

implementation

const
   urldll = 'url.dll';

function InetIsOffline; external urldll name 'InetIsOffline';

function MIMEAssociationDialogW; external urldll name 'MIMEAssociationDialogW';
function MIMEAssociationDialogA; external urldll name 'MIMEAssociationDialogA';
{$IFDEF UNICODE}
function MIMEAssociationDialog; external urldll name 'MIMEAssociationDialogW';
{$ELSE}
function MIMEAssociationDialog; external urldll name 'MIMEAssociationDialogA';
{$ENDIF}

function URLAssociationDialogW; external urldll name 'URLAssociationDialogW';
function URLAssociationDialogA; external urldll name 'URLAssociationDialogA';
{$IFDEF UNICODE}
function URLAssociationDialog; external urldll name 'URLAssociationDialogW';
{$ELSE}
function URLAssociationDialog; external urldll name 'URLAssociationDialogA';
{$ENDIF}

function TranslateURLA; external urldll name 'TranslateURLA';
function TranslateURLW; external urldll name 'TranslateURLW';
{$IFDEF UNICODE}
function TranslateURL; external urldll name 'TranslateURLW';
{$ELSE}
function TranslateURL; external urldll name 'TranslateURLA';
{$ENDIF}

{$IFDEF VER120}
const
   UrlMonLib = 'URLMON.DLL';
function CoInternetGetSession; external UrlMonLib name 'CoInternetGetSession';
function CoInternetCreateSecurityManager; external UrlMonLib name 'CoInternetCreateSecurityManager';
function CoInternetCreateZoneManager; external UrlMonLib name 'CoInternetCreateZoneManager';
{$ENDIF}

const
   Shell32 = 'shell32.dll';
   comctl32 = 'comctl32.dll';
   hhctrl = 'hhctrl.ocx';
   SHLockShared_Index = 521;
   SHUnlockShared_Index = 522;
   SHFreeShared_Index = 523;
   Free_Index = 73;

function GetShellModule: THandle;
begin
   if ShellModule = 0 then
      begin
         ShellModule := {$IFDEF VER120}LoadLibrary(Shell32){$ELSE}SafeLoadLibrary(Shell32){$ENDIF};
         if ShellModule <= HINSTANCE_ERROR then
            ShellModule := 0;
      end;
   Result := ShellModule;
end;

function GetHHctrlModule: THandle;
begin
   if HHCtrlModule = 0 then
      begin
         HHCtrlModule := {$IFDEF VER120}LoadLibrary(HHCtrl){$ELSE}SafeLoadLibrary(HHCtrl){$ENDIF};
         if HHCtrlModule <= HINSTANCE_ERROR then
            HHCtrlModule := 0;
      end;
   Result := HHCtrlModule;
end;

function GetComctlModule: THandle;
begin
   if ComctlModule = 0 then
      begin
         ComctlModule := {$IFDEF VER120}LoadLibrary(comctl32){$ELSE}SafeLoadLibrary(comctl32){$ENDIF};
         if ComctlModule <= HINSTANCE_ERROR then
            ComctlModule := 0;
      end;
   Result := ComctlModule;
end;

function HtmlHelp(hwndCaller: HWND; pszFile: PChar; uCommand: Integer;
   dwData: DWORD): HWND; stdcall;
type
   TheFunctionType = function(hwndCaller: HWND; pszFile: PChar; uCommand: Integer;
      dwData: DWORD): HWND; stdcall;
var
   TheFunction: TheFunctionType;
begin
   Result := 0;
   if HHCtrlModule = 0 then
      HHCtrlModule := GetHHCtrlModule;
   if HHCtrlModule <> 0 then
      begin
         TheFunction := GetProcAddress(HHCtrlModule, PChar('HtlmHelpA'));
         if (Assigned(TheFunction)) then
            Result := TheFunction(hwndCaller, pszFile, uCommand, dwdata);
      end;
end;

function _Free(Pidl: PItemIDList): BOOL; stdcall;
type
   TheFunctionType = function(Pidl: PItemIDList): BOOL; stdcall;
var
   TheFunction: TheFunctionType;
begin
   Result := False;
   if ComctlModule = 0 then
      ComctlModule := GetComctlModule;
   if ComctlModule <> 0 then
      begin
         TheFunction := GetProcAddress(ComctlModule, PChar(Free_Index));
         if (Assigned(TheFunction)) then
            Result := TheFunction(Pidl);
      end;
end;

function SHLockShared(Handle: THandle; DW: DWORD): Pointer; stdcall;
type
   TheFunctionType = function(Handle: THandle; DW: DWORD): Pointer; stdcall;
var
   TheFunction: TheFunctionType;
begin
   Result := nil;
   if ShellModule = 0 then
      ShellModule := GetShellModule;
   if ShellModule <> 0 then
      begin
         TheFunction := GetProcAddress(ShellModule, PChar(SHLockShared_Index));
         if (Assigned(TheFunction)) then
            Result := TheFunction(Handle, DW);
      end;
end;

function SHUnLockShared(pnt: Pointer): BOOL; stdcall;
type
   TheFunctionType = function(pnt: Pointer): BOOL; stdcall;
var
   TheFunction: TheFunctionType;
begin
   Result := FALSE;
   if ShellModule = 0 then
      ShellModule := GetShellModule;
   if ShellModule <> 0 then
      begin
         TheFunction := GetProcAddress(ShellModule, PChar(SHUnLockShared_Index));
         if (Assigned(TheFunction)) then
            Result := TheFunction(pnt);
      end;
end;

function SHFreeShared(Handle: THandle; DW: DWORD): Pointer; stdcall;
type
   TheFunctionType = function(Handle: THandle; DW: DWORD): Pointer; stdcall;
var
   TheFunction: TheFunctionType;
begin
   Result := nil;
   if ShellModule = 0 then
      ShellModule := GetShellModule;
   if ShellModule <> 0 then
      begin
         TheFunction := GetProcAddress(ShellModule, PChar(SHFreeShared_Index));
         if (Assigned(TheFunction)) then
            Result := TheFunction(Handle, DW);
      end;
end;
{IDataObject
IDispatch
IHlinkFrame
IOleCommandTarget
IOleControl
IOleObject
IOleWindow
IPersist
IPersistStreamInit
IProvideClassInfo
IProvideClassInfo2
IServiceProvider
ITargetFrame
ITargetFrame2
ITargetNotify
IUnknown
IViewObject2
IWebBrowser
IWebBrowser2
IWebBrowserPriv
IHlinkFrame
IHTMLWindow2
IProfferService
IShellBrowser
ITargetFrame
ITargetFrame2}
 
initialization

finalization
   if ShellModule <> 0 then
      FreeLibrary(ShellModule);
   if ComctlModule <> 0 then
      FreeLibrary(ComctlModule);
   if HHCtrlModule <> 0 then
      FreeLibrary(HHCtrlModule);

end.