How can I avoid refresh with TWebBrowser

问题

I have a TWebBrowser component that show a Google maps page. The problem is that when user press F5 the page refresh and page reloads. This cause javascript variables to reinitialize and get out of sync with Delphi and a scripting error dialog appear, 'undefined' is null or not an object.

I want to stop refresh from the user.

I tried this event for OnBeforeNavigate2:

procedure TNewOrganizationForm.mapAddressBeforeNavigate2(ASender: TObject;
  const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
begin
  inherited;
  Cancel := Assigned(fMapEngine) and not fMapEngine.Loading;
end;

But when I set a breakpoint it is not even called. Is there another way ?

回答1:

Ronald you can use the IHTMLDocument2.onkeydown event to intercept and block a key.

to assign an event handler first you must create a procedure type using the IHTMLEventObj as parameter.

  THTMLProcEvent = procedure(Sender: TObject; Event: IHTMLEventObj) of object;

then you must create an class descendent from InterfacedObject and IDispatch to pass and process the events .

finally you can process the intercepted key in the onkeydown event in this way

Var
  HTMLDocument2 : IHTMLDocument2;
begin
    if Not Assigned(WebBrowser1.Document) then  Exit;
    HTMLDocument2:=(WebBrowser1.Document AS IHTMLDocument2);
    if HTMLDocument2.parentWindow.event.keyCode=VK_F5 then //compare the key
    begin
     HTMLDocument2.parentWindow.event.cancelBubble:=True; //cancel the key
     HTMLDocument2.parentWindow.event.keyCode     :=0;
    end;
end;

//check the full source code

unit Unit55;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, SHDocVw, MSHTML;

type
  //Create the procedure type to assign the event
  THTMLProcEvent = procedure(Sender: TObject; Event: IHTMLEventObj) of object;

  //Create a  new class for manage the event from the twebbrowser
  THTMLEventLink = class(TInterfacedObject, IDispatch)
  private
    FOnEvent: THTMLProcEvent;
  private
    constructor Create(Handler: THTMLProcEvent);
    function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
    function GetIDsOfNames(const IID: TGUID; Names: Pointer;
      NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
  public
    property OnEvent: THTMLProcEvent read FOnEvent write FOnEvent;
  end;

  TForm55 = class(TForm)
    WebBrowser1: TWebBrowser;
    procedure FormShow(Sender: TObject);
    procedure WebBrowser1NavigateComplete2(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    FOnKeyDownConnector:  THTMLEventLink; //pointer to the event handler
    procedure WebBrowser1OnKeyDown(Sender: TObject; EventObjIfc: IHTMLEventObj);//the event handler 
  public
    { Public declarations }
  end;

var
  Form55: TForm55;

implementation

{$R *.dfm}


constructor THTMLEventLink.Create(Handler: THTMLProcEvent);
begin
  inherited Create;
  _AddRef;
  FOnEvent := Handler;
end;


function THTMLEventLink.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
  Result := E_NOTIMPL;
end;


function THTMLEventLink.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult;
begin
  Result := E_NOTIMPL;
end;


function THTMLEventLink.GetTypeInfoCount(out Count: Integer): HResult;
begin
  Result := E_NOTIMPL;
end;


function THTMLEventLink.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
var
  HTMLEventObjIfc: IHTMLEventObj;
begin
  Result := S_OK;
  if Assigned(FOnEvent) then FOnEvent(Self, HTMLEventObjIfc);
end;



procedure TForm55.FormCreate(Sender: TObject);
begin
  FOnKeyDownConnector := THTMLEventLink.Create(WebBrowser1OnKeyDown); //assign the address of the event handler
end;


procedure TForm55.WebBrowser1NavigateComplete2(ASender: TObject;  const pDisp: IDispatch; var URL: OleVariant);
var
  HTMLDocument2      : IHTMLDocument2;
begin
  HTMLDocument2:=(WebBrowser1.Document AS IHTMLDocument2);
  HTMLDocument2.onkeydown := FOnKeyDownConnector as IDispatch; //assign the event handler
end;

procedure TForm55.WebBrowser1OnKeyDown(Sender: TObject; EventObjIfc: IHTMLEventObj);
Var
  HTMLDocument2 : IHTMLDocument2;
begin
    //finally do your stuff here, in this case we will intercept and block the F5 key.
    if Not Assigned(WebBrowser1.Document) then  Exit;
    HTMLDocument2:=(WebBrowser1.Document AS IHTMLDocument2);
    if HTMLDocument2.parentWindow.event.keyCode=VK_F5 then
    begin
     HTMLDocument2.parentWindow.event.cancelBubble:=True;
     HTMLDocument2.parentWindow.event.keyCode     :=0;
    end;
end;



procedure TForm55.FormShow(Sender: TObject);
begin
WebBrowser1.Navigate('www.google.com'); 
end;



end.

回答2:

I did not find an easy way to do this. I could not find any event or anything similar on TWebBrowser, that would dissable refresh. Maybe you should check TEmbededWB as it has more events and is more capable than the default TWebBrowser. Otherwise they are very similar.

But I found a way to prevent refresh. Now it is funny that even with KeyPreview set to "True" on the main form I could not recieve key notifications. It seems that TWebBrowser eats them up somehow. But this worked:

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnMessage := OnAppMessage;
end;

procedure TForm1.OnAppMessage(var Msg: TMsg; var Handled: Boolean);
begin
  if Msg.message = WM_KEYDOWN then
    if Msg.wParam = VK_F5 then
      Handled := True;
end;

Not the most elegant way but at least it works. I have not found a better solution yet.

来源：https://stackoverflow.com/questions/3446440/how-can-i-avoid-refresh-with-twebbrowser