管大源:在程序中执行浏览器脚本
来源:百度文库 编辑:中财网 时间:2024/05/03 07:36:35
procedure ExecuteScript(aWebBrowser: TWebBrowser; lScript: TStrings; language: String = 'javascript');
var
HTDoc: IHTMLDocument2;
begin
HTDoc := (aWebBrowser.Document as IHTMLDocument2);
if (HTDoc <> nil) then
begin
if HTDoc.parentWindow <> nil then
HTDoc.parentWindow.ExecScript(lScript.Text, Olevariant(language)) ;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if FileExists('js.txt') then
begin
Memo1.Lines.LoadFromFile('js.txt');
// 执行 Memo1 中的脚本(默认为javascript)
ExecuteScript(WebBrowser1.Document as IHTMLDocument2, Memo1.Lines);
end;
end;
js.txt内容为
// 这是“执行脚本”按钮的演示代码
function testjs() {
alert("Hello World!");
}
testjs();
使用ExecScript执行脚本,脚本内容是程序外的,不是HTMLDocument加载的,当然可以在脚本里再执行HTMLDocument已加载的的脚本
。还有ExecScript虽然有返回参数,但是值永远是空的,也就是使用ExecScript执行脚本永远得不到返回值。
在.net中IHTMLDocument接口提供了InvokeScript函数可以执行脚本并返回结果,但是mshtml中并没有提供啊,那就看看.net是怎么
实现的吧,看代码:
在System.Windows.Forms.HtmlDocument中
public: Object __gc* InvokeScript(String __gc* scriptName, Object __gc* args __gc [])
{
Object __gc* obj2 = 0;
tagDISPPARAMS __gc* pDispParams = __gc new tagDISPPARAMS();
pDispParams->rgvarg = IntPtr::Zero;
try
{
IDispatch __gc* script = (this->NativeHtmlDocument2->GetScript() as IDispatch);
if (script == 0)
{
return obj2;
}
Guid __gc* empty = Guid::Empty;
String __gc* rgszNames __gc [] = __gc new String __gc*[1] {
scriptName};
Int32 __gc* rgDispId __gc [] = __gc new Int32 __gc*[1] {
-1};
if (!NativeMethods::Succeeded(script->GetIDsOfNames(ref empty, rgszNames, 1,
SafeNativeMethods::GetThreadLCID(), rgDispId)) || (rgDispId[0] == -1))
{
return obj2;
}
if (args != 0)
{
Array::Reverse(args);
}
pDispParams->rgvarg = ((args == 0) ? IntPtr::Zero : HtmlDocument::ArrayToVARIANTVector(args));
pDispParams->cArgs = ((args == 0) ? 0 : args->Length);
pDispParams->rgdispidNamedArgs = IntPtr::Zero;
pDispParams->cNamedArgs = 0;
Object __gc* pVarResult __gc [] = __gc new Object __gc*[1];
if (script->Invoke(rgDispId[0], ref empty, SafeNativeMethods::GetThreadLCID(), 1, pDispParams, pVarResult,
__gc new tagEXCEPINFO(), 0) == 0)
{
obj2 = pVarResult[0];
}
}
catch (Exception __gc* exception)
{
if (ClientUtils::IsSecurityOrCriticalException(exception))
{
throw;
}
}
finally
{
if (pDispParams->rgvarg != IntPtr::Zero)
{
HtmlDocument::FreeVARIANTVector(pDispParams->rgvarg, args->Length);
}
}
return obj2;
}
.net就是好啊,所有代码都可以反汇编看到,那就仿照写一个InvokeScript了。
function InvokeScript( Doc: IHTMLDocument2;aName,aParam:String):Variant;
var
Disp: IDispatch;
Member: WideString;
TheDispId: Integer;
DispParams: TDispParams;
VariantArg: TVariantArg;
Args: WideString;
begin
//IHTMLDocument.Script接口是指向脚本执行引擎的,
//看MSDN Address of a pointer to a variable of type IDispatch interface that receives a handle to the script engine.
Disp:=(Doc as IHTMLDocument).Script;
if Assigned(Disp)
then begin
Member := aName;
if (Disp.GetIDsOfNames(GUID_NULL, @Member, 1,
LOCALE_SYSTEM_DEFAULT, @TheDispId)) = S_OK
then begin
FillChar(DispParams, SizeOf(DispParams), 0);
FillChar(VariantArg, SizeOf(VariantArg), 0);
DispParams.cArgs := 1; // 1 argument
DispParams.rgvarg := @VariantArg;
VariantArg.vt := VT_BSTR;
Args := aParam;
VariantArg.bstrVal := pointer(Args);
OleCheck(Disp.Invoke(TheDispId, GUID_NULL, 0, DISPATCH_METHOD,
DispParams, @Result, nil, nil));
end;
end;
end;
调用示例:
procedure TForm1.Button5Click(Sender: TObject);
var
Doc: IHTMLDocument2;
begin
if Supports(WebBrowser1.Document, IHTMLDocument2, Doc) then
begin
Memo1.Lines.Add ( InvokeScript( doc,'testjs',''));
end;
end;
这里介绍一下rxlib里的rxOle2Auto单元,对接口调用进行了很好的封装,像上面的InvokeScript可以直接这样
procedure TForm1.Button4Click(Sender: TObject);
var
a: TOleController;
doc: IHTMLDocument2;
begin
a:= TOleController.Create ;
doc := WebBrowser1.Document as IHTMLDocument2;
a.AssignIDispatch( doc.script );
memo1.Lines.Add ( a.CallFunction('Test',[''])^);
a.Free ;
end;
还有一个想法:脚本可以执行了,并得到了返回值,可是我想得到脚本的内容怎么办?
好办,微软给我们提供了IHTMLDocument2.scripts方法,遍历得到IHTMLScriptElement接口就可以了,继续看代码:
procedure TForm1.Button6Click(Sender: TObject);
var
Doc: IHTMLDocument2;
Script: IHTMLScriptElement;
i:integer;
begin
if Supports(form1.WebBrowser1.Document, IHTMLDocument2, Doc) then
for i:=0 to Doc.scripts.length-1 do
begin
Script:=Doc.scripts.item(i,i) as IHTMLScriptElement ;
Memo1.Lines.Add (Script.text );
end;
end;
终于贴完代码了,这是这几天受伤休息在家捣鼓的,水平有限难免有错,欢迎指正。
有兴趣的再看看这个How to call Delphi code from scripts running in a TWebBrowser
http://www.delphidabbler.com/articles?article=22&part=1