Mar
23
подмена оконной процедуры TWebBrowser
18:08unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, SHDocVw;
type
TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
procedure WebBrowser1BeforeNavigate2(Sender: TObject;
const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
Headers: OleVariant; var Cancel: WordBool);
procedure FormCreate(Sender: TObject);
procedure WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FNewWndProc, FOldWndProc: Pointer;
h: HWND;
def:boolean;
procedure NewWndProc(var Message: TMessage);
procedure DefineWndProc;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.DefineWndProc;
begin
h := GetWindow(GetWindow(WebBrowser1.Handle, GW_CHILD), GW_CHILD); // This was level 1
FNewWndProc := Classes.MakeObjectInstance(NewWndProc);
FOldWndProc := Pointer(GetWindowLong(h, GWL_WNDPROC));
SetWindowLong(h, GWL_WNDPROC, Longint(FNewWndProc));
def:=true;
end;
procedure TForm1.NewWndProc(var Message: TMessage);
var
Doc,elem: oleVariant;
begin
case Message.Msg of
WM_LBUTTONDOWN: begin
Doc := WebBrowser1.OleObject.document;
try
elem := Doc.elementFromPoint(Message.LParamLo, Message.LParamHi);
if elem.tagName='A' then
caption:=elem.href;
//exit;
except
end;
end;
end;
Message.Result := CallWindowProc(FOldWndProc, h, Message.Msg,
Message.WParam, Message.LParam);
end;
procedure TForm1.WebBrowser1BeforeNavigate2(Sender: TObject;
const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
Headers: OleVariant; var Cancel: WordBool);
begin
if def then
SetWindowLong(h, GWL_WNDPROC, Longint(FOldWndProc));
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser1.Navigate('http://yandex.ru');
end;
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
DefineWndProc;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if def then
SetWindowLong(h, GWL_WNDPROC, Longint(FOldWndProc));
end;
end.