unit DemoFrm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, OleCtrls, SHDocVw;
type
TDemoForm =
class(TForm)
WebBrowser: TWebBrowser;
Panel: TPanel;
Button: TButton;
procedure FormCreate(Sender: TObject);
procedure ButtonClick(Sender: TObject);
end;
var
DemoForm: TDemoForm;
implementation
{$R *.dfm}
uses
ActiveX,
MSHTML;
resourcestring
HTML
= '
<HTML> <HEAD> <TITLE>Evaluate</TITLE> '
+ '
<SCRIPT> function evaluate(x) {'
+ '
alert("hello");'
+ '
return eval(42);'
+ '
} </SCRIPT> </HEAD> <BODY> TEST </BODY> </HTML>'
;
procedure LoadDocument(doc: OleVariant; s:
string);
begin
doc.Clear;
doc.
Write(s);
doc.Close;
end;
procedure TDemoForm.FormCreate(Sender: TObject);
begin
WebBrowser.Navigate('
about:blank');
LoadDocument(WebBrowser.Document,
HTML);
end;
procedure TDemoForm.ButtonClick(Sender: TObject);
var
doc: IHTMLDocument2;
dScript: IDispatch;
vResult: OleVariant;
wsMethod: WideString;
id: TDispId;
hr: HRESULT;
params: TDispParams;
begin
FillChar(params, SizeOf(params), 0);
doc := WebBrowser.Document
as IHTMLDocument2;
if Assigned(doc)
then
begin
dScript := doc.Script;
if Assigned(dScript)
then
begin
wsMethod := '
evaluate';
if Succeeded(dScript.GetIDsOfNames(GUID_NULL, @wsMethod, 1, 0, @id))
then
begin
dScript.Invoke(id, GUID_NULL, 0, DISPATCH_METHOD, params, @vResult,
nil,
nil);
ShowMessage(IntToStr(vResult));
end;
end;
end;
end;
end.