I have a this code:
for i:=0 to Memo1.Lines.Count-1 do
begin
while WebBrowser1.Busy do Application.ProcessMessages;
WebBrowser1.OleObject.Document.Links.item(cat[i]).click;
subcatList;
end;
but WebBrowser1 run several times in spite of the expectations of the procedure. How do I start WebBrowser1 not in the background or what is the solution?
You need to implement 3 events of TWebBrowser, BeforeNavigate2, DocumentComplete and NavigateComplete2
TForm1 = class(TForm)
private
CurDispatch: IDispatch;
FDocLoaded: Boolean;
....
procedure TForm1.WebBrowser1BeforeNavigate2(ASender: TObject; const pDisp: IDispatch;
const URL, Flags, TargetFrameName, PostData, Headers: OleVariant;
var Cancel: WordBool);
begin
CurDispatch := nil;
FDocLoaded := False;
end;
procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject; const pDisp: IDispatch;
const URL: OleVariant);
begin
if (pDisp = CurDispatch) then
begin
FDocLoaded := True;
CurDispatch := nil;
end;
end;
procedure TForm1.WebBrowser1NavigateComplete2(ASender: TObject; const pDisp: IDispatch;
const URL: OleVariant);
begin
if CurDispatch = nil then
CurDispatch := pDisp;
end;
And now you can use FDocLoaded variable to know if the page is loaded into the WebBrowser
WebBrowser1.Navigate('www.stackoverflow.com');
repeat Application.ProcessMessage until FDocLoaded;
Regards
Related
We have HTML with:
<A target="_blank" href="http://blabla.com">
When the link is clicked the OnNewWindow2 is fired:
procedure TForm1.WebBrowser1NewWindow2(Sender: TObject;
var ppDisp: IDispatch; var Cancel: WordBool);
begin
Cancel := True;
// open in default browser
end;
I want to open the link in the default browser:
Opening TWebBrowser link in default browser
But no BeforeNavigate2is fired in my case.
How can I know the intended URL in a TWebBrowser OnNewWindow2 event?
EDIT: In newer versions of Delphi there is a OnNewWindow3 event which provides the URL I need. currently I'm really struggling to begin to understand how to implement this event into an existing TWebBrowser.
If anyone has done this, it would be great to get some help.
You can override the InvokeEvent method of the browser and wait there for the DISPID_NEWWINDOW3 dispatch identifier. For an interposer class such OnNewWindow3 event could be implemented like this:
uses
ActiveX, OleCtrls, SHDocVw;
const
DISPID_NEWWINDOW3 = 273;
type
TWebBrowserNewWindow3 = procedure(ASender: TObject; var ppDisp: IDispatch; var Cancel: WordBool;
dwFlags: Longint; const bstrUrlContext: WideString; const bstrUrl: WideString) of object;
TWebBrowser = class(SHDocVw.TWebBrowser)
private
FOnNewWindow3: TWebBrowserNewWindow3;
protected
procedure InvokeEvent(ADispID: TDispID; var AParams: TDispParams); override;
public
property OnNewWindow3: TWebBrowserNewWindow3 read FOnNewWindow3 write FOnNewWindow3;
end;
implementation
procedure TWebBrowser.InvokeEvent(ADispID: TDispID; var AParams: TDispParams);
begin
if (ADispID = DISPID_NEWWINDOW3) and Assigned(FOnNewWindow3) then
begin
FOnNewWindow3(Self, AParams.rgvarg^[4].pdispVal^, AParams.rgvarg^[3].pbool^,
AParams.rgvarg^[2].lVal, WideString(AParams.rgvarg^[1].bstrVal), WideString(AParams.rgvarg^[0].bstrVal));
end
else
inherited;
end;
How can I know the intended URL in a TWebBrowser OnNewWindow2 event?
You can use DOM's getAttribute method. But before you should load needed page and after this done replace particular events with your own. See code below:
uses
...
SHDocVw, MSHTML;
type
TForm1 = class(TForm)
...
// Your auto-generated event handler
procedure WebBrowser1DocumentComplete(ASender: TObject;
const pDisp: IDispatch; const URL: OleVariant);
private
// Your self-written event handlers
procedure New_BeforeNavigate2(ASender: TObject;
const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData, Headers: OleVariant;
var Cancel: WordBool);
procedure New_NewWindow2(ASender: TObject; var ppDisp: IDispatch; var Cancel: WordBool);
end;
...
// Assign event handler in design-time
procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject; const pDisp: IDispatch;
const URL: OleVariant);
begin
(ASender as TWebBrowser).OnBeforeNavigate2 := New_BeforeNavigate2;
(ASender as TWebBrowser).OnNewWindow2 := New_NewWindow2;
end;
procedure TForm1.New_BeforeNavigate2(ASender: TObject; const pDisp: IDispatch;
const URL, Flags, TargetFrameName, PostData, Headers: OleVariant;
var Cancel: WordBool);
begin
ShowMessage('New URL will be: ' + URL);
Cancel := true;
end;
procedure TForm1.New_NewWindow2(ASender: TObject; var ppDisp: IDispatch; var Cancel: WordBool);
var
S: String;
begin
S := ((TWebBrowser(ASender).Document as IHTMLDocument2).ActiveElement as IHTMLElement).GetAttribute('href', 0);
ShowMessage('New window''s URL is: ' + S);
Cancel := true;
end;
Now you can get URL even with OnNewWindow2 event. For the case target="_self" there is also OnBeforeNavigate2 event handler. It should work if I correctly got your question.
I'm using TChromium and I need to navigate to a specific page and save a specific image of this page to a file.
I know how to navigate and extract the HTML source to get the image's address, but I don't know how to save the image to my local filesystem.
How can I do it using some TChromium method ?
I don't want to use another component (such TIdHTTP) to do it because the site requires login and the image relies on the active session.
Thanks in advance !
From CEF forums:
"CEF does not currently support the extraction of cached resources.
You can identify the request that originally returned the content by
overriding CefRequestHandler::OnBeforeResourceLoad() and then execute
the request yourself using CefWebURLRequest the retrieve and save the
contents."
Another approach is to add a context menu as asked here - TChromium how to add "Save Picture" item in Context Menu? and where TLama has made a code snippet:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtDlgs, IdHTTP, cefvcl, ceflib;
const
MENU_ID_SAVE_IMAGE_AS = Ord(MENU_ID_USER_FIRST) + 1;
type
TDownloader = class(TThread)
private
FURL: string;
FFileName: string;
protected
procedure Execute; override;
public
constructor Create(const URL, FileName: string); reintroduce;
end;
type
TForm1 = class(TForm)
Button1: TButton;
Chromium1: TChromium;
SavePictureDialog1: TSavePictureDialog;
procedure FormCreate(Sender: TObject);
procedure Chromium1BeforeContextMenu(Sender: TObject; const browser: ICefBrowser;
const frame: ICefFrame; const params: ICefContextMenuParams; const model: ICefMenuModel);
procedure Chromium1ContextMenuCommand(Sender: TObject; const browser: ICefBrowser;
const frame: ICefFrame; const params: ICefContextMenuParams; commandId: Integer;
eventFlags: TCefEventFlags; out Result: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TDownloader }
constructor TDownloader.Create(const URL, FileName: string);
begin
inherited Create(False);
FreeOnTerminate := True;
FURL := URL;
FFileName := FileName;
end;
procedure TDownloader.Execute;
var
HTTPClient: TIdHTTP;
FileStream: TFileStream;
begin
try
HTTPClient := TIdHTTP.Create;
try
FileStream := TFileStream.Create(FFileName, fmCreate);
try
HTTPClient.Get(FURL, FileStream);
finally
FileStream.Free;
end;
finally
HTTPClient.Free;
end;
except
// error handling ignored for this example
end;
end;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
Chromium1.Load('http://www.google.com/');
end;
procedure TForm1.Chromium1BeforeContextMenu(Sender: TObject; const browser: ICefBrowser;
const frame: ICefFrame; const params: ICefContextMenuParams; const model: ICefMenuModel);
begin
if (CM_TYPEFLAG_MEDIA in params.TypeFlags) and (params.MediaType = CM_MEDIATYPE_IMAGE) then
model.AddItem(MENU_ID_SAVE_IMAGE_AS, 'Save image as...');
end;
procedure TForm1.Chromium1ContextMenuCommand(Sender: TObject; const browser: ICefBrowser;
const frame: ICefFrame; const params: ICefContextMenuParams; commandId: Integer;
eventFlags: TCefEventFlags; out Result: Boolean);
var
SaveDialog: TSavePictureDialog;
begin
if (commandId = MENU_ID_SAVE_IMAGE_AS) then
begin
SaveDialog := TSavePictureDialog.Create(nil);
try
// SaveDialog.FileName := <here you can extract file name from params.SourceUrl>;
// SaveDialog.DefaultExt := <here you can extract file ext from params.SourceUrl>;
if SaveDialog.Execute then
TDownloader.Create(params.SourceUrl, SaveDialog.FileName);
finally
SaveDialog.Free;
end;
end;
end;
end.
Another approach is to identify all the images from the page (take a look at How can I use Javascript to get a list of all picture URLs available on a site?) and download the image link by using CefBrowserHost.StartDownload.
Add to Form1:
public
var file_download_finished : boolean;
procedure TForm1.Chromium1BeforeDownload(Sender: TObject;
const browser: ICefBrowser; const downloadItem: ICefDownloadItem;
const suggestedName: ustring; const callback: ICefBeforeDownloadCallback);
begin
callback.Cont('FileName.jpg', false);
end;
procedure TForm1.Chromium1DownloadUpdated(Sender: TObject;
const browser: ICefBrowser; const downloadItem: ICefDownloadItem;
const callback: ICefDownloadItemCallback);
var i : nativeint;
begin
if downloadItem.IsComplete then
file_download_finished := true
else
i := downloadItem.PercentComplete;
end;
procedure TForm1.Button1Click(Sender: TObject);
var M: TMsg;
begin
file_download_finished := false;
Chromium1.Browser.Host.StartDownload('https://www.gravatar.com/avatar/7ffbdc105c382c0070cdd29d073725b5?s=48&d=identicon&r=PG&f=1');
repeat // wait until download is finished
while PeekMessage(M, 0, 0, 0, pm_Remove) do
begin
TranslateMessage(M);
DispatchMessage(M);
end;
until file_download_finished;
end;
I am trying to enumerate DOM nodes using the following code (under XE2).
I have borrowed most of this from answers given here in SO, but for some reason it's not doing anything.
IOW, ProcessDOM() is not ever getting called.
And, I am at my wits end.
Could someone show me what I am doing wrong here.
Thanks in advance.
procedure ProcessNode(ANode: ICefDomNode);
var
Node1: ICefDomNode;
begin
if Assigned(ANode) then begin
Node1 := ANode.FirstChild;
while Assigned(Node1) do begin
{Do stuff with node}
ProcessNode(Node1);
Node1 := Node1.NextSibling;
end;
end;
end;
procedure ProcessDOM(const ADocument: ICefDomDocument);
begin
ProcessNode(ADocument.Body);
end;
procedure TMainForm.Chrome1LoadEnd(Sender: TObject; const ABrowser: ICefABrowser; const AFrame: ICefAFrame; AStatus: Integer);
begin
if Assigned(AFrame) then AFrame.VisitDomProc(ProcessDOM);
end;
I had the same problem and I used the demo guiclient it comes with dcef3. With the following it works.
type TCustomRenderProcessHandler = class(TCefRenderProcessHandlerOwn)
protected
function OnProcessMessageReceived(const browser: ICefBrowser; sourceProcess: TCefProcessId; const message: ICefProcessMessage): Boolean; override;
end;
Chromium1.browser.SendProcessMessage(PID_RENDERER, TCefProcessMessageRef.New('visitdom'));
function TCustomRenderProcessHandler.OnProcessMessageReceived(browser: ICefBrowser; sourceProcess: TCefProcessId; message: ICefProcessMessage): Boolean;
begin
if (message.Name = 'visitdom') then begin
browser.MainFrame.VisitDomProc(
procedure(const doc: ICefDomDocument)
begin
ProcessNode(Doc.Body);
end);
Result := True;
end;
end;
initialization
CefRenderProcessHandler := TCustomRenderProcessHandler.Create;
You need to add a procedure to the handler.
procedure ProcessNode(ANode: ICefDomNode);
Read this: 1
As this blog point out, The main difficulty when accessing a rendered page's DOM is that you can only do so in the same process as the associated renderer for that page.
You can't access dom from browser thread, you have to do it in renderer thread.
First, Forward a message (like visitdom) from browser process to rendering process
procedure TMainForm.crmLoadEnd(Sender: TObject; const browser: ICefBrowser;
const frame: ICefFrame; httpStatusCode: Integer);
var
msg : ICefProcessMessage;
begin
if IsMain(browser, frame) then
FLoading := False;
msg := TCefProcessMessageRef.New('visitdom');
browser.SendProcessMessage(PID_RENDERER, msg);
end;
Second, create a TCustomRenderProcessHandler to handle the message, send the result back to the browser processs.
function TCustomRenderProcessHandler.OnProcessMessageReceived(
const browser: ICefBrowser; sourceProcess: TCefProcessId;
const message: ICefProcessMessage): Boolean;
begin
Result := False;
if (message.Name = 'visitdom') then
begin
browser.MainFrame.VisitDomProc(
procedure(const doc: ICefDomDocument)
function ProcessNode(ANode: ICefDomNode) : String;
var
Node: ICefDomNode;
begin
Result := 'Not Found';
if Assigned(ANode) then
begin
Node := ANode.FirstChild;
while Assigned(Node) do
begin
if Node.ElementTagName='DIV' then
begin
if Node.GetElementAttribute('class')='tv-panels' then
begin
Result := 'Found';
Exit;
end;
end;
ProcessNode(Node);
Node := Node.NextSibling;
end;
end;
end;
var msg : ICefProcessMessage;
begin
msg := TCefProcessMessageRef.New('visitdom');
msg.ArgumentList.SetString(0, processNode(doc.Body));
browser.SendProcessMessage(PID_BROWSER, msg);
end);
Result := True;
end;
end;
Third, On browser process, create an handler to process the messenage sent back from render process.
procedure TMainForm.crmProcessMessageReceived(Sender: TObject;
const browser: ICefBrowser; sourceProcess: TCefProcessId;
const message: ICefProcessMessage; out Result: Boolean);
begin
Result := False;
if (message.Name = 'visitdom') then
begin
StatusBar.SimpleText := message.ArgumentList.GetString(0);
Result := True;
end;
end;
Be careful, while debuging, placing a breakpoint in rendering process never work. It will never reached there.
What I'm trying:
I need a TWebBrowser which is always zoomed in (~140%) AND keeps all links in the same webbrowser (ie. _BLANK links should be opened in the same browser control).
How I'm doing that:
I have set the FEATURE_BROWSER_EMULATION in registry to 9999, so the webpages are rendered with IE9. I have confirmed that this is working. Furthermore, I'm running the compiled program on a fresh install of Windows 7 with IE9, fully updated through Windows Update.
Zoom:
procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
ZoomFac: OLEVariant;
begin
ZoomFac := 140;
WebBrowser1.ExecWB(OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, ZoomFac);
end;
This works perfectly.
Open new windows in the same browser control:
By default, TWebBrowser opens a new IE, when it encounters a link set to be opened in a new window. I need it to stay in my program/webbrowser.
I have tried many things here. This works for me:
procedure TFormWeb.WebBrowser1NewWindow3(ASender: TObject;
var ppDisp: IDispatch; var Cancel: WordBool; dwFlags: Cardinal;
const bstrUrlContext, bstrUrl: WideString);
begin
Cancel := True;
WebBrowser1.Navigate(bstrUrl);
end;
I cancel the new window, and instead just navigate to the same URL.
Other sources on various pages on the Internet suggests that I don't cancel and instead set ppDisp to various things such as WebBrowser1.DefaultDispath or WebBrowser1.Application and variations of them. This does not work for me. When I click a _BLANK link, nothing happens. This is tested on two computers (both Win7 and IE9). I don't know why it doesn't work, because this seems to be working for other people on the Internet. Maybe this will solve the problem?
Now the problem:
When I combine these 2 pieces of code, it breaks!
procedure TForm1.Button1Click(Sender: TObject);
begin
WebBrowser1.Navigate('http://wbm.dk/test.htm');
// This is a test page, that I created. It just contains a normal link to google.com
end;
procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
ZoomFac: OLEVariant;
begin
ZoomFac := 140;
WebBrowser1.ExecWB(OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, ZoomFac);
end;
procedure TForm1.WebBrowser1NewWindow3(ASender: TObject; var ppDisp: IDispatch;
var Cancel: WordBool; dwFlags: Cardinal; const bstrUrlContext,
bstrUrl: WideString);
begin
Cancel := True;
WebBrowser1.Navigate(bstrUrl);
end;
When clicking a link (no matter if it is normal or _BLANK) in the webbrowser at runtime, it produces this error:
First chance exception at $75F1B9BC. Exception class EOleException with message 'Unspecified error'. Process Project1.exe (3288)
If I remove either part of the code, it works (without the removed code, obviously).
Can anybody help me get both things working at the same time?
Thanks for your time!
Update:
This is now a matter of correctly trapping the new window and keep it in the same browser control. The zooming code in OnDocumentComplete has, as far as I can tell, nothing to do with it. It's the zoom in general. If the WebBrowser control has been zoomed (once is enough), the code in NewWindow3 will fail with "Unspecified error". Resetting the zoom level to 100% doesn't help.
By using the zoom code (ExecWB) something changes "forever" in the WebBrowser, which makes it incompatible with the code in NewWindow3.
Can anybody figure it out?
New code:
procedure TForm1.Button1Click(Sender: TObject);
var
ZoomFac: OLEVariant;
begin
ZoomFac := 140;
WebBrowser1.ExecWB(OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, ZoomFac);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser1.Navigate('http://www.wbm.dk/test.htm');
end;
procedure TForm1.WebBrowser1NewWindow3(ASender: TObject; var ppDisp: IDispatch;
var Cancel: WordBool; dwFlags: Cardinal; const bstrUrlContext,
bstrUrl: WideString);
begin
Cancel := True;
WebBrowser1.Navigate(bstrUrl);
end;
Try clicking the link both before and after clicking Button1. After zooming it fails.
You can set ppDisp to a new instance of IWebBrowser2 in the OnNewWindow2 event e.g:
procedure TForm1.Button1Click(Sender: TObject);
begin
WebBrowser1.Navigate('http://wbm.dk/test.htm');
end;
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
ZoomFac: OleVariant;
begin
// the top-level browser
if pDisp = TWebBrowser(Sender).ControlInterface then
begin
ZoomFac := 140;
TWebBrowser(Sender).ExecWB(OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, ZoomFac);
end;
end;
procedure TForm1.WebBrowser1NewWindow2(Sender: TObject;
var ppDisp: IDispatch; var Cancel: WordBool);
var
NewWindow: TForm1;
begin
// ppDisp is nil; this will create a new instance of TForm1:
NewWindow := TForm1.Create(self);
NewWindow.Show;
ppDisp := NewWindow.Webbrowser1.DefaultDispatch;
end;
It is also suggested by Microsoft to set RegisterAsBrowser to true.
You could change this code to open a TWebBrowser in a new tab inside a Page control.
We can not set ppDisp to the current instance of the TWebBrowser - so using this simple code:
ppDisp := WebBrowser1.DefaultDispatch; dose not work.
We need to "recreate" the current/active TWebBrowser, if we want to maintain the UI flow - note that in the following example the TWebBrowser is created on the fly e.g.:
const
CM_WB_DESTROY = WM_USER + 1;
OLECMDID_OPTICAL_ZOOM = 63;
type
TForm1 = class(TForm)
Button1: TButton;
Panel1: TPanel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
function CreateWebBrowser: TWebBrowser;
procedure WebBrowserDocumentComplete(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant);
procedure WebBrowserNewWindow2(Sender: TObject; var ppDisp: IDispatch; var Cancel: WordBool);
procedure CMWebBrowserDestroy(var Message: TMessage); message CM_WB_DESTROY;
public
WebBrowser: TWebBrowser;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser := CreateWebBrowser;
end;
function TForm1.CreateWebBrowser: TWebBrowser;
begin
Result := TWebBrowser.Create(Self);
TWinControl(Result).Parent := Panel1;
Result.Align := alClient;
Result.OnDocumentComplete := WebBrowserDocumentComplete;
Result.OnNewWindow2 := WebBrowserNewWindow2;
Result.RegisterAsBrowser := True;
end;
procedure TForm1.WebBrowserDocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
ZoomFac: OleVariant;
begin
// the top-level browser
if pDisp = TWebBrowser(Sender).ControlInterface then
begin
ZoomFac := 140;
TWebBrowser(Sender).ExecWB(OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, ZoomFac);
end;
end;
procedure TForm1.WebBrowserNewWindow2(Sender: TObject; var ppDisp: IDispatch; var Cancel: WordBool);
var
NewWB: TWebBrowser;
begin
NewWB := CreateWebBrowser;
ppDisp := NewWB.DefaultDispatch;
WebBrowser := NewWB;
// just in case...
TWebBrowser(Sender).Stop;
TWebBrowser(Sender).OnDocumentComplete := nil;
TWebBrowser(Sender).OnNewWindow2 := nil;
// post a delayed message to destory the current TWebBrowser
PostMessage(Self.Handle, CM_WB_DESTROY, Integer(TWebBrowser(Sender)), 0);
end;
procedure TForm1.CMWebBrowserDestroy(var Message: TMessage);
var
Sender: TObject;
begin
Sender := TObject(Message.WParam);
if Assigned(Sender) and (Sender is TWebBrowser) then
TWebBrowser(Sender).Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
WebBrowser.Navigate('http://wbm.dk/test.htm');
end;
I think the problem is that sometimes OnDocumentComplete can fire multiple times on document load (pages with frames).
Here is the way to implement it properly.
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 ?
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.
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.