Как избежать обновления с помощью TWebBrowser

У меня есть компонент TWebBrowser, который показывает страницу карт Google. Проблема в том, что когда пользователь нажимает F5, страница обновляется и перезагружается. Это приводит к повторной инициализации переменных javascript и рассинхронизации с Delphi, а также к появлению диалогового окна ошибки сценария, 'undefined' имеет значение null или не является объектом.

Я хочу остановить обновление от пользователя.

Я попробовал это событие для 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;

Но когда я устанавливаю точку останова, она даже не вызывается. Есть ли другой способ?


person Roland Bengtsson    schedule 10.08.2010    source источник


Ответы (2)


Рональд, вы можете использовать событие IHTMLDocument2.onkeydown. перехватить и заблокировать ключ.

чтобы сначала назначить обработчик событий, вы должны создать тип процедуры, используя IHTMLEventObj в качестве параметра.

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

затем вы должны создать класс-потомок от InterfacedObject и IDispatch для передачи и обработки событий.

наконец, вы можете обработать перехваченный ключ в событии onkeydown таким образом

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;

//проверяем полный исходный код

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.
person RRUZ    schedule 10.08.2010
comment
У меня еще нет времени проверить это, но выглядит хорошо, и вы получаете галочку :) - person Roland Bengtsson; 12.08.2010
comment
Я попробовал приведенный выше код RRUZ и связал его с профилировщиком памяти FastMM4. Мои тесты показывают, что существует утечка памяти, связанная с THTMLEventLink. Однако я не могу определить, чего не хватает в коде RRUZ, что необходимо добавить для устранения утечки памяти. Кто-нибудь может помочь? - person user1527613; 12.09.2013
comment
В THTMLEventLink.Create есть лишний _AddRef и это приведет к утечке памяти. - person Dalija Prasnikar; 08.04.2021
comment
Кроме того, проблема с утечкой памяти возникает из-за того, что FOnKeyDownConnector объявлен как THTMLEventLink, а не IDispatch, который позаботится о правильном подсчете ссылок. - person Dalija Prasnikar; 08.04.2021

Я не нашел простой способ сделать это. Я не смог найти какое-либо событие или что-то подобное в TWebBrowser, которое отключило бы обновление. Возможно, вам следует проверить TEmbededWB, так как в нем больше событий и больше возможностей, чем в TWebBrowser по умолчанию. В остальном они очень похожи.

Но я нашел способ предотвратить обновление. Забавно, что даже если для параметра KeyPreview установлено значение «True» в главной форме, я не могу получать уведомления о ключах. Такое впечатление, что TWebBrowser их как-то съедает. Но это сработало:

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;

Не самый элегантный способ, но, по крайней мере, он работает. Я еще не нашел лучшего решения.

person Runner    schedule 10.08.2010