徐冬冬被包:在程序中执行浏览器脚本

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