• WebBrowser 操作记要


    WebBrowser 操作记要
    WebBrowser1.GoHome; //到浏览器默认主页
    WebBrowser1.Refresh; //刷新
    WebBrowser1.GoBack; //后退
    WebBrowser1.GoForward; //前进
    WebBrowser1.Navigate('...'); //打开指定页面
    WebBrowser1.Navigate('about:blank'); //打开空页面
    ________________________________________

    //打开空页面, 并写入...

    WebBrowser1.Navigate('about: <head> <title>标题> </title> <body>页面内容 </body>');
    ________________________________________

    //读取网页脚本中的变量:

    procedure TForm1.Button1Click(Sender: TObject);
    var
    s: string;
    i: Integer;
    begin
    s := WebBrowser1.OleObject.document.Script.str;
    i := WebBrowser1.OleObject.document.Script.num;
    ShowMessage(s); //Hello
    ShowMessage(IntToStr(i)); //99

    //也可以这样读:
    s := WebBrowser1.OleObject.document.parentWindow.str;
    i := WebBrowser1.OleObject.document.parentWindow.num;
    ShowMessage(s); //Hello
    ShowMessage(IntToStr(i)); //99
    end;

    &amp;lt;br&amp;gt;假如网页中有这样的语句:&amp;lt;br&amp;gt;&amp;amp;amp;lt;script&amp;amp;amp;gt;&amp;lt;br&amp;gt;var&amp;lt;br&amp;gt; str = "Hello";&amp;lt;br&amp;gt; i = 99;&amp;lt;br&amp;gt;&amp;amp;amp;lt;/script&amp;amp;amp;gt;
    ________________________________________
    //调用网页脚本中的函数:

    procedure TForm1.Button1Click(Sender: TObject);
    begin
    WebBrowser1.OleObject.document.parentWindow.MB(); //HTML-Js

    //如需指定脚本语言, 需要:
    WebBrowser1.OleObject.document.parentWindow.execScript('MB()','JavaScript'); //HTML-Js
    end;

    &amp;lt;br&amp;gt;假如有这样的脚本:&amp;lt;br&amp;gt;&amp;amp;amp;lt;script&amp;amp;amp;gt;&amp;lt;br&amp;gt;function MB(){ &amp;lt;br&amp;gt; alert('HTML-Js');&amp;lt;br&amp;gt;}&amp;lt;br&amp;gt;&amp;amp;amp;lt;/script&amp;amp;amp;gt;
    ________________________________________
    //判断网页及内部框架网页是否全部下载完毕

    procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
    const pDisp: IDispatch; var URL: OleVariant);
    begin
    if WebBrowser1.Application = pDisp then
    begin
    Text := '网页下载完毕!';
    end;
    end;

    ________________________________________
    //改变背景色或背景图片:
    WebBrowser1.OleObject.document.body.bgcolor := '#FF0000';
    WebBrowser1.OleObject.document.body.background := '...图片地址';
    ________________________________________

    //操作有 ID 标签的对象:
    var
    s: string;
    begin
    s := WebBrowser1.OleObject.document.getElementByID('span1').innerText;
    ShowMessage(s); //这是 span1 标签中的内容

    //或者:
    s := WebBrowser1.OleObject.document.parentWindow.span1.innerText;
    ShowMessage(s); //这是 span1 标签中的内容

    //隐藏它:
    WebBrowser1.OleObject.document.parentWindow.span1.style.display := 'none';
    end;

    &amp;lt;br&amp;gt;假如网页中有这样的内容:&amp;lt;br&amp;gt;&amp;amp;amp;lt;span id=span1&amp;amp;amp;gt;这是 span1 标签中的内容&amp;amp;amp;lt;/span&amp;amp;amp;gt;&amp;lt;br&amp;gt;
    ________________________________________
    //获取网页源代码
    var
    s: string;
    begin
    s := WebBrowser1.OleObject.document.body.innerHTML; //body内的所有代码
    s := WebBrowser1.OleObject.document.body.outerHTML; //body内的所有代码, 包含body标签
    s := WebBrowser1.OleObject.document.documentElement.innerHTML; //html内的所有代码
    end;

    //获取网页全部源代码
    uses ActiveX;
    var
    ms: TMemoryStream;
    begin
    if not Assigned(WebBrowser1.Document) then Exit;
    ms := TMemoryStream.Create;
    (WebBrowser1.Document as IPersistStreamInit).Save(TStreamAdapter.Create(ms), True);
    ms.Position := 0;
    Memo1.Lines.LoadFromStream(ms, TEncoding.UTF8);
    // Memo1.Lines.LoadFromStream(ms, TEncoding.Default); {GB2312 等双字节}
    ms.Free;
    end;
    ________________________________________

    //WebBrowser 中的右键菜单

    //先要添加ApplicationEvents1,指定其Message事件

    //屏蔽右键菜单
    procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
    begin
    with Msg do
    begin
    if not IsChild(WebBrowser1.Handle, hWnd) then Exit;
    Handled := (message = WM_RBUTTONDOWN) or (message = WM_RBUTTONUP) or (message = WM_CONTEXTMENU);
    end;
    end;

    //替换右键菜单
    procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
    var mPoint: TPoint;
    begin
    if IsChild(WebBrowser1.Handle, Msg.Hwnd) and
    ((Msg.Message = WM_RBUTTONDOWN) or (Msg.Message = WM_RBUTTONUP)) then
    begin
    GetCursorPos(mPoint); //得到光标位置
    PopupMenu1.Popup(mPoint.X, mPoint.Y); //弹出popupmenu1的菜单
    Handled:=True;
    end;
    end;
    ________________________________________

    //新页面写入
    begin
    WebBrowser1.Navigate('about:blank');
    WebBrowser1.OleObject.Document.Writeln('ok');
    end;

    //从流中写入:
    var
    ms: TMemoryStream;
    begin
    ms := TMemoryStream.Create;
    Memo1.Lines.SaveToStream(ms);
    ms.Position := 0;
    (WebBrowser1.Document as IPersistStreamInit).Load(TStreamAdapter.Create(ms));
    ms.Free;
    end;

    //禁止提示脚步错误
    procedure TForm1.WebBrowser1NavigateComplete2(ASender: TObject;
    const pDisp: IDispatch; var URL: OleVariant);
    begin
    WebBrowser1.Silent := True;
    end;

    //禁止弹出窗口
    procedure TForm1.WebBrowser1NewWindow2(ASender: TObject; var ppDisp: IDispatch;
    var Cancel: WordBool);
    begin
    Cancel := True;
    end;
    ________________________________________

    procedure TMainFrm.btnTestClick(Sender: TObject);
    var
    HtmlDoc:IHTMLDocument2;
    myitem:Olevariant;
    i:integer;
    str:string;
    begin

    myitem:= Web.Document;

    if myitem.frames.length <>0 then
    myitem:=myitem.frames.item(2).document;
    for i := 0 to myitem.all.length - 1 do
    begin
    if myitem.all.item(i).tagName = 'SELECT' then // 下拉框选择
    begin

    myitem.all.item(i).selectedindex:= myitem.all.item(i).options.length-1;
    if strtoint(myitem.all.item(i).value) <0 then myitem.all.item(i).value:=0;
    end;

    if myitem.all.item(i).tagName = 'INPUT' then
    begin

    if Uppercase(myitem.all.item(i).type)='SUBMIT' then//提交表单
    myitem.all.item(i).click;

    end;
    end;


    end;
     

  • 相关阅读:
    Wiki开源软件 介绍
    实时股票获取API
    .net 下动态加载自定义控件后传值及函数调用方法
    vim(gvim)相关插件整理
    CPPUnit 测试宏
    .bash_profile和.bashrc
    Linux下SSH配合SecureCRT的密匙完美使用方法(图)
    Windows下编译gdal使其支持proj
    收藏:解析#pragma指令
    Windows 2003中打开DirectX加速
  • 原文地址:https://www.cnblogs.com/hackpig/p/1668559.html
Copyright © 2020-2023  润新知