ewbacc.pas

Delphi VCL Component Pack

//**************************************************************
//                                                             *
//                               EwbAcc                        *                                                      *
//                 For Delphi 5, 6, 7, 2005, 2006              *
//                            by bsalsa                        *
//                    based on a code by Per Larsen            *
//                                                             *
//  Updated versions:                                          *
//               http://www.bsalsa.com                         *
//**************************************************************

{*******************************************************************************}
{LICENSE:
THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND,
EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED
WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE
AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE
AND DOCUMENTATION. [YOUR NAME] DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE
OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED
OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS,
INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR
OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS,
AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. VSOFT SPECIFICALLY
DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE.

You may use, change or modify the component under 3 conditions:
1. In your website, add a link to "http://www.bsalsa.com"
2. In your application, add credits to "Embedded Web Browser"
3. Mail me  ([e-mail]) any code change in the unit
   for the benefit of the other users.
{*******************************************************************************}

unit EwbAcc;

interface

{$I EWB.inc}

  uses
   Activex, SysUtils, ShlObj, Windows, Urlmon;

const //TGUID
   CGID_DocHostCommandHandler: TGUID = (D1: $F38BC242; D2: $B950; D3: $11D1; D4: ($89, $18, $00, $C0, $4F, $C2, $C8, $36));
   CLSID_CUrlHistory: TGUID = '{3C374A40-BAE4-11CF-BF7D-00AA006946EE}';
   CLSID_ShellUIHelper: TGUID = '{64AB4BB7-111E-11D1-8F79-00C04FC2FBE1}';
   CLSID_WebBrowser: TGUID = '{ED016940-BD5B-11cf-BA4E-00C04FD70816}'; //when you add new Command IDs
   CMDSETID_Forms3: TGUID = '{DE4BA900-59CA-11CF-9592-444553540000}';
   GUID_TriEditCommandGroup: TGUID = '{2582F1C0-084E-11d1-9A0E-006097C9B344}';
   IID_IACList: TGUID = '{77A130B0-94FD-11D0-A544-00C04FD7d062}';
   IID_IACList2: TGUID = '{470141a0-5186-11d2-bbb6-0060977b464c}';
   IID_ICustomDoc: TGUID='{425B5AF0-65F1-11D1-9611-0000F81E0D0D}';
   IID_IDocHostShowUI: TGUID = '{c4d244b0-d43e-11cf-893b-00aa00bdce1a}';
   IID_IDocHostUIHandler: TGUID = '{bd3f23c0-d43e-11cf-893b-00aa00bdce1a}';
   IID_IDocHostUIHandler2: TGUID = '{3050f6d0-98b5-11cf-bb82-00aa00bdce0b}';
   IID_IDownloadManager: TGUID = (D1: $988934A4; D2: $064B; D3: $11D3; D4: ($BB, $80, $0, $10, $4B, $35, $E7, $F9));
   IID_IEnumStatUrl: TGUID = (D1: $3C374A42; D2: $BAE4; D3: $11CF; D4: ($BF, $7D, $00, $AA, $00, $69, $46, $EE));
   IID_IHTMLOMWindowServices: TGUID = '{3050F5FC-98B5-11CF-BB82-00AA00BDCE0B}';
   IID_IInternetHostSecurityManager: TGUID = '{3af280b6-cb3f-11d0-891e-00c04fb6bfc4}';
   IID_IInternetSecurityManager: TGUID = '{79eac9ee-baf9-11ce-8c82-00aa004ba90b}';
   IID_IInternetSecurityMgrSite: TGUID = '{79eac9ed-baf9-11ce-8c82-00aa004ba90b}';
   IID_IInternetSession: TGUID = '{79eac9e7-baf9-11ce-8c82-00aa004ba90b}';
   IID_IInternetZoneManager: TGUID = '{79eac9ef-baf9-11ce-8c82-00aa004ba90b}';
   IID_INewWindowManager: TGUID = '{D2BC4C84-3F72-4a52-A604-7BCBF3982CBB}';
   IID_IQueryInfo: TGUID = (D1: $00021500; D2: $0000; D3: $0000; D4: ($C0, $00, $00, $00, $00, $00, $00, $46));
   IID_IUniformResourceLocatorA: TGUID = (D1: $FBF23B80; D2: $E3F0; D3: $101B; D4: ($84, $88, $00, $AA, $00, $3E, $56, $F8));
   IID_IUniformResourceLocatorW: TGUID = (D1: $CABB0DA0; D2: $DA57; D3: $11CF; D4: ($99, $74, $00, $20, $AF, $D7, $97, $62));
   IID_IUrlHistoryNotify: TGUID = (D1: $BC40BEC1; D2: $C493; D3: $11D0; D4: ($83, $1B, $00, $C0, $4F, $D5, $AE, $38));
   IID_IUrlHistoryStg: TGUID = (D1: $3C374A41; D2: $BAE4; D3: $11CF; D4: ($BF, $7D, $00, $AA, $00, $69, $46, $EE));
   IID_IUrlHistoryStg2: TGUID = (D1: $AFA0DC11; D2: $C313; D3: $831A; D4: ($83, $1A, $00, $C0, $4F, $D5, $AE, $38));
   SID_IHTMLOMWindowServices = '{3050F5FC-98B5-11CF-BB82-00AA00BDCE0B}';
   SID_IInternetHostSecurityManager: TGUID = '{3af280b6-cb3f-11d0-891e-00c04fb6bfc4}';
   SID_IInternetSecurityManager: TGUID = '{79eac9ee-baf9-11ce-8c82-00aa004ba90b}';
{$IFDEF UNICODE}
   IID_IUniformResourceLocator: TGUID = (D1: $CABB0DA0; D2: $DA57; D3: $11CF; D4: ($99, $74, $00, $20, $AF, $D7, $97, $62));
{$ELSE}
   IID_IUniformResourceLocator: TGUID = (D1: $FBF23B80; D2: $E3F0; D3: $101B; D4: ($84, $88, $00, $AA, $00, $3E, $56, $F8));
{$ENDIF}
   CLSID_InternetShortCut: TGUID = (d1: $FBF23B40; D2: $E3F0; D3: $101B; D4: ($84, $88, $00, $AA, $00, $3E, $56, $F8));
   SID_IUniformResourceLocatorA = '{FBF23B80-E3F0-101B-8488-00AA003E56F8}';
   SID_IUniformResourceLocatorW = '{CABB0DA0-DA57-11CF-9974-0020AFD79762}';
{$IFDEF UNICODE}
   SID_IUniformResourceLocator = SID_IUniformResourceLocatorW;
{$ELSE}
   SID_IUniformResourceLocator = SID_IUniformResourceLocatorA;
{$ENDIF}



type
   BrowserNavConstants = TOleEnum;

   STATURL = record
      cbSize: DWORD;
      pwcsUrl: DWORD;
      pwcsTitle: DWORD;
      ftLastVisited: FILETIME;
      ftLastUpdated: FILETIME;
      ftExpires: FILETIME;
      dwFlags: DWORD;
   end;

   IDownloadManager = interface(IUnknown)
      ['{988934A4-064B-11D3-BB80-00104B35E7F9}']
      function Download(
         pmk: IMoniker; // Identifies the object to be downloaded
         pbc: IBindCtx; // Stores information used by the moniker to bind
         dwBindVerb: DWORD; // The action to be performed during the bind
         grfBINDF: DWORD; // Determines the use of URL encoding during the bind
         pBindInfo: PBindInfo; // Used to implement IBindStatusCallback::GetBindInfo
         pszHeaders: PWidechar; // Additional headers to use with IHttpNegotiate
         pszRedir: PWidechar; // The URL that the moniker is redirected to
         uiCP: UINT // The code page of the object's display name
         ): HRESULT; stdcall;
   end;

   IEnumSTATURL = interface(IUnknown)
      ['{3C374A42-BAE4-11CF-BF7D-00AA006946EE}']
      function Next(celt: Integer; out elt; pceltFetched: PLongint): HRESULT; stdcall;
      function Skip(celt: Longint): HRESULT; stdcall;
      function Reset: HResult; stdcall;
      function Clone(out ppenum: IEnumSTATURL): HResult; stdcall;
      function SetFilter(poszFilter: PWideChar; dwFlags: DWORD): HResult; stdcall;
   end;

   IUrlHistoryStg = interface(IUnknown)
      ['{3C374A41-BAE4-11CF-BF7D-00AA006946EE}']
      function AddUrl(pocsUrl: PWideChar; pocsTitle: PWideChar; dwFlags: Integer): HResult; stdcall;
      function DeleteUrl(pocsUrl: PWideChar; dwFlags: Integer): HResult; stdcall;
      function QueryUrl(pocsUrl: PWideChar; dwFlags: Integer; var lpSTATURL: STATURL): HResult; stdcall;
      function BindToObject(pocsUrl: PWideChar; var riid: TIID; out ppvOut: Pointer): HResult; stdcall;
      function EnumUrls(out ppenum: IEnumSTATURL): HResult; stdcall;
   end;

   IUrlHistoryStg2 = interface(IUrlHistoryStg)
      ['{AFA0DC11-C313-11D0-831A-00C04FD5AE38}']
      function AddUrlAndNotify(pocsUrl: PWideChar; pocsTitle: PWideChar; dwFlags: Integer;
         fWriteHistory: Integer; var poctNotify: Pointer;
         const punkISFolder: IUnknown): HResult; stdcall;
      function ClearHistory: HResult; stdcall;
   end;

   IUrlHistoryNotify = interface(IOleCommandTarget)
      ['{BC40BEC1-C493-11d0-831B-00C04FD5AE38}']
   end;

   PDOCHOSTUIINFO = ^TDOCHOSTUIINFO;
   TDOCHOSTUIINFO = record
      cbSize: ULONG;
      dwFlags: DWORD;
      dwDoubleClick: DWORD;
      chHostCss: POLESTR;
      chHostNS: POLESTR;
   end;

  type
  INewWindowManager = interface (IUnknown) //Serge
  ['{D2BC4C84-3F72-4a52-A604-7BCBF3982CBB}']
     function EvaluateNewWindow(pszUrl, pszName, pszUrlContext, pszFeatures: LPCWSTR;
      fReplace: BOOL; dwFlags, dwUserActionTime: DWORD): HRESULT; stdcall;
  end;

   IDocHostShowUI = interface(IUnknown)
      ['{c4d244b0-d43e-11cf-893b-00aa00bdce1a}']
      function ShowMessage(hwnd: THandle; lpstrText: POLESTR; lpstrCaption: POLESTR;
         dwType: longint; lpstrHelpFile: POLESTR; dwHelpContext: longint;
         var plResult: LRESULT): HRESULT; stdcall;
      function ShowHelp(hwnd: THandle; pszHelpFile: POLESTR; uCommand: integer;
         dwData: longint; ptMouse: TPoint;
         var pDispatchObjectHit: IDispatch): HRESULT; stdcall;
   end; // IDocHostShowUI


   IDocHostUIHandler = interface(IUnknown)
      ['{bd3f23c0-d43e-11cf-893b-00aa00bdce1a}']
      function ShowContextMenu(const dwID: DWORD; const ppt: PPOINT;
         const pcmdtReserved: IUnknown; const pdispReserved: IDispatch): HRESULT; stdcall;
      function GetHostInfo(var pInfo: TDOCHOSTUIINFO): HRESULT; stdcall;
      function ShowUI(const dwID: DWORD; const pActiveObject: IOleInPlaceActiveObject;
         const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
         const pDoc: IOleInPlaceUIWindow): HRESULT; stdcall;
      function HideUI: HRESULT; stdcall;
      function UpdateUI: HRESULT; stdcall;
      function EnableModeless(const fEnable: BOOL): HRESULT; stdcall;
      function OnDocWindowActivate(const fActivate: BOOL): HRESULT; stdcall;
      function OnFrameWindowActivate(const fActivate: BOOL): HRESULT; stdcall;
      function ResizeBorder(const prcBorder: PRECT;
         const pUIWindow: IOleInPlaceUIWindow;
         const fRameWindow: BOOL): HRESULT; stdcall;
      function TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup: PGUID;
         const nCmdID: DWORD): HRESULT; stdcall;
      function GetOptionKeyPath(var pchKey: POLESTR; const dw: DWORD): HRESULT; stdcall;
      function GetDropTarget(const pDropTarget: IDropTarget;
         out ppDropTarget: IDropTarget): HRESULT; stdcall;
      function GetExternal(out ppDispatch: IDispatch): HRESULT; stdcall;
      function TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POLESTR;
         var ppchURLOut: POLESTR): HRESULT; stdcall;
      function FilterDataObject(const pDO: IDataObject;
         out ppDORet: IDataObject): HRESULT; stdcall;
   end; // IDocHostUIHandler

   IDocHostUIHandler2 = interface(IDocHostUIHandler)
      ['{3050f6d0-98b5-11cf-bb82-00aa00bdce0b}']
      function GetOverrideKeyPath(pchKey: POLESTR; dw: DWORD): HRESULT; stdcall;
   end;

   IProtectFocus = interface(IDocHostUIHandler)
     ['{D81F90A3-8156-44F7-AD28-5ABB87003274}']
     function AllowFocusChange(const pfAllow : Boolean): HRESULT; stdcall;
   end;

   ICustomDoc = interface(IUnknown)
       ['{3050f3f0-98b5-11cf-bb82-00aa00bdce0b}']
       function SetUIHandler (const pUIHandler : IDocHostUIHandler) : HRESULT; stdcall;
      end; // ICustomDoc

   IHTMLOMWindowServices = interface(IUnknown)
      ['{3050f5fc-98b5-11cf-bb82-00aa00bdce0b}']
      function moveTo(const x, y: Integer): HRESULT; stdcall;
      function moveBy(const x, y: Integer): HRESULT; stdcall;
      function resizeTo(const x, y: Integer): HRESULT; stdcall;
      function resizeBy(const x, y: Integer): HRESULT; stdcall;
   end;


type
   TMoveResizeByEvent = procedure(Sender: TObject; cx, cy: Integer) of object;
   TMoveEvent = procedure(Sender: TObject; X, Y: Integer) of object;
   TResizeEvent = procedure(Sender: TObject; Width, Height: Integer) of object;


   PUrlInvokeCommandInfoA = ^TUrlInvokeCommandInfoA;
   TUrlInvokeCommandInfoA = record
      dwcbSize: DWORD; // Size of structure
      dwFlags: DWORD; // Bit field of IURL_INVOKECOMMAND_FLAGS
      hwndParent: HWND; // Parent window.  Valid only if IURL_INVOKECOMMAND_FL_ALLOW_UI is set.
      pcszVerb: LPCSTR; // Verb to invoke.  Ignored if IURL_INVOKECOMMAND_FL_USE_DEFAULT_VERB is set.
   end;

   PUrlInvokeCommandInfoW = ^TUrlInvokeCommandInfoW;
   TUrlInvokeCommandInfoW = record
      dwcbSize: DWORD; // Size of structure
      dwFlags: DWORD; // Bit field of IURL_INVOKECOMMAND_FLAGS
      hwndParent: HWND; // Parent window.  Valid only if IURL_INVOKECOMMAND_FL_ALLOW_UI is set.
      pcszVerb: LPCWSTR; // Verb to invoke.  Ignored if IURL_INVOKECOMMAND_FL_USE_DEFAULT_VERB is set.
   end;

{$IFDEF UNICODE}
   PURLInvokeCommandInfo = ^TUrlInvokeCommandInfoW;
   TUrlInvokeCommandInfo = TUrlInvokeCOmmandInfoW;
{$ELSE}
   PURLInvokeCommandInfo = ^TUrlInvokeCommandInfoA;
   TUrlInvokeCommandInfo = TUrlInvokeCOmmandInfoA;
{$ENDIF}

   IUniformResourceLocatorA = interface(IUnknown)
      [SID_IUniformResourceLocatorA]
      function SetURL(pcszURL: LpcStr; dwInFlags: DWORD): HRESULT; stdcall;
      function GetURL(ppszURL: LpStr): HRESULT; stdcall;
      function InvokeCommand(purlici: PURLINVOKECOMMANDINFOA): HRESULT; stdcall;

   end;

   IUniformResourceLocatorW = interface(IUnknown)
      [SID_IUniformResourceLocatorW]
      function SetURL(pcszURL: LpcWStr; dwInFlags: DWORD): HRESULT; stdcall;
      function GetURL(ppszURL: LpWStr): HRESULT; stdcall;
      function InvokeCommand(purlici: PURLINVOKECOMMANDINFOW): HRESULT; stdcall;
   end;

{$IFDEF UNICODE}
   IUniformResourceLocator = IUniformResourceLocatorW;
{$ELSE}
   IUniformResourceLocator = IUniformResourceLocatorA;
{$ENDIF}

function TranslateURLA(pcszURL: LPCSTR;
   dwInFlags: DWORD;
   ppszTranslatedURL: LPSTR): HRESULT; stdcall;

function TranslateURLW(pcszURL: LPCWSTR;
   dwInFlags: DWORD;
   ppszTranslatedURL: LPWSTR): HRESULT; stdcall;

{$IFDEF UNICODE}
function TranslateURL(pcszURL: LPCWSTR;
   dwInFlags: DWORD;
   ppszTranslatedURL: LPWSTR): HRESULT; stdcall;
{$ELSE}
function TranslateURL(pcszURL: LPCSTR;
   dwInFlags: DWORD;
   ppszTranslatedURL: LPSTR): HRESULT; stdcall;
{$ENDIF}

function URLAssociationDialogA(hwndParent: HWND;
   dwInFlags: DWORD;