unit DemoFrm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, SHDocVw, StdCtrls;
type
TDemoForm =
class(TForm)
Button: TButton;
procedure ButtonClick(Sender: TObject);
procedure BeforeNavigate2(Sender: TObject;
const pDisp: IDispatch;
var URL, Flags, TargetFrameName, PostData,
Headers: OleVariant;
var Cancel: WordBool);
private
ActiveUrl:
string;
end;
var
DemoForm: TDemoForm;
implementation
{$R *.dfm}
uses
MSHTML;
procedure TDemoForm.ButtonClick(Sender: TObject);
const
url = '
http://www.google.de';
var
wb: TWebBrowser;
body, doc, frm: OleVariant;
begin
wb := TWebBrowser.Create(
nil);
wb.ParentWindow := HWND(HWND_MESSAGE);
wb.OnBeforeNavigate2 := BeforeNavigate2;
wb.Navigate(
url);
repeat
Sleep(50);
Application.ProcessMessages;
until wb.ReadyState >= READYSTATE_COMPLETE;
doc := wb.OleObject.Document;
body := doc.body;
frm := doc.Forms.Item(0);
frm.Elements.Item('
q').Value := '
onyx';
frm.Elements.Item('
btnG').Click;
repeat
Sleep(50);
Application.ProcessMessages;
until wb.ReadyState >= READYSTATE_COMPLETE;
wb.Free;
ShowMessage(StringReplace(ActiveUrl, '
&', '
&&', [rfReplaceAll]));
end;
procedure TDemoForm.BeforeNavigate2(Sender: TObject;
const pDisp: IDispatch;
var URL, Flags, TargetFrameName, PostData,
Headers: OleVariant;
var Cancel: WordBool);
begin
with Sender
as TWebBrowser
do
if pDisp = DefaultInterface
then
ActiveUrl :=
URL;
end;
end.