VB操作网页代码

精品文档 1欢迎下载 1 1 防止新窗口里头打开网页防止新窗口里头打开网页 代码 1 Private Sub WebBrowser1 NewWindow2 ppDisp As Object Cancel As Boolean Dim frm As Form1 Set frm New Form1 frm Visible True Set ppDisp frm WebBrowser1 object End Sub 代码 2 有这段代码 有许多网页会出错 经常提示脚本错误 可以用 silent 属性为 True 来屏蔽 不过也有些不足 PrivatePrivate SubSub WebBrowser1 NewWindow2 ppDispWebBrowser1 NewWindow2 ppDisp AsAs Object Object CancelCancel AsAs Boolean Boolean CancelCancel TrueTrue WebBrowser1 Navigate2WebBrowser1 Navigate2 WebBrowser1 Document activeElement hrefWebBrowser1 Document activeElement href EndEnd SubSub 代码 3 Private Sub WebBrowser1 NewWindow2 ppDisp As Object Cancel As Boolean On Error Resume Next Dim frmWB As Form1 Set frmWB New Form1 frmWB WebBrowser1 RegisterAsBrowser True Set ppDisp frmWB WebBrowser1 object frmWB Visible True frmWB Top Form1 Top frmWB Left Form1 Left frmWB Width Form1 Width frmWB Height Form1 Height End Sub 功能差不多 任选一个 精品文档 2欢迎下载 2 2 去掉滚动条去掉滚动条 Private Sub WebBrowser1 DocumentComplete ByVal pDisp As Object URL As Variant WebBrowser1 Document Body Scroll no End Sub 实际上上面的效果不咋地 如果懂得 HTML 知识 你可以在读取网页的时候 读取 HTML 源 码 查找替换 再写入只需在 之间插入代码 即可 其中 x 表示水平滚动条 将其改为 y 的话就可以隐藏垂直滚动条 当然也有其他方法 比如修改网页的尺寸呀 有的时候部分元素的居中改为左对齐也能 有效果 将 WebBrower 放在 PictureBox 控件中 用 PictureBox 的边框挡住 WebBrower 的边框 例如 将 WebBrowser1 放大点 将 PictureBox 变小点 PictureBox 的 appearance 设置为 0 flat 呵呵 OK 3 3 禁止鼠标右键禁止鼠标右键 Private Function M Dom oncontextmenu As Boolean Webbrowser1 Document oncontextmenu False End Function 引用 Microsoft HTML OBject Library Dim WithEvents M Dom As MSHTML HTMLDocument Private Function M Dom oncontextmenu As Boolean M Dom oncontextmenu False End Function Private Sub Webbrowser1 DownloadComplete Set M Dom Webbrowser1 Document End Sub 4 4 如何获得网页的内容如何获得网页的内容 先给个例子 精品文档 3欢迎下载 innerHTML 设置或获取位于对象起始和结束标签内的 HTML 测试一下 这是一个层 function getinnerHTML alert document getElementById d innerHTML function setinnerHTML document getElementById d innerHTML 这是一个层 嘿嘿 5 5 多框架框架页面访问多框架框架页面访问 下面两句可以访问到多框架内容 Document ParentWindow Frames Length Document ParentWindow Frames 1 Document all tags a 等待多框架网页全部加载完毕 否则出错 While Busy Or ReadyState 4 Or Document ParentWindow Frames Length 0 DoEvents Wend 6 获得浏览器信息 Private Sub Command1 Click WebBrowser1 Navigate End Sub Private Sub Command2 Click Dim oWindow 精品文档 4欢迎下载 Dim oNav Set oWindow WebBrowser1 Document parentWindow Set oNav oWindow navigator Debug Print oNav userAgent Set oWindow Nothing Set oNav Nothing End Sub 7 7 弹出弹出 WebbrowserWebbrowser 消息窗口消息窗口 Dim oWindow Set oWindow WebBrowser1 Document parentWindow oWindow confirm abcd VB 调用 webbrowser 技巧集 2 8 8 向向 WebbrowserWebbrowser 中写入中写入 HTMLHTML 内容的几内容的几 种方法种方法 向 Webbrowser 中写入 HTML 内容的几种方法 首先在 Form Load 中加入 WebBrowser1 Navigate about blank 确保 Webbrowser1 可用 方法 1 Dim s As String Dim stream As IStream s s s 精品文档 5欢迎下载 s s s s hello world s s s s WebBrowser1 Document Write s 方法 2 Dim o Set o WebBrowser1 Document selection createrange Debug Print o If Not o Is Nothing Then o pasteHTML 哈哈 Set o Nothing End If 方法 3 插入文本框 Dim o Set o WebBrowser1 Document selection createrange o execCommand InsertTextArea False xxx 9 9 控制页面滚动控制页面滚动 WebBrowser1 Document parentwindow scrollby 0 30 精品文档 6欢迎下载 1010 判断页面是否可以前进后退判断页面是否可以前进后退 Private Sub Command1 Click WebBrowser1 GoForward End Sub Private Sub Command2 Click WebBrowser1 GoBack End Sub Private Sub Form Load WebBrowser1 Navigate End Sub Private Sub WebBrowser1 CommandStateChange ByVal Command As Long ByVal Enable As Boolean If Command CSC NAVIGATEBACK Then Command2 Enabled Enable End If If Command CSC NAVIGATEFORWARD Then Command1 Enabled Enable End If End Sub 1111 如何获得网页中被选中部分的如何获得网页中被选中部分的 HTMLHTML Private Sub Command1 Click Dim objSelection Dim objTxtRange Set objSelection WebBrowser1 Document selection If Not objSelection Is Nothing Then Set objTxtRange objSelection createRange If Not objTxtRange Is Nothing Then Debug Print objTxtRange htmlText Set objTxtRange Nothing 精品文档 7欢迎下载 End If Set objSelection Nothing End If End Sub 1212 NavigateNavigate 的参数调用的参数调用 请问 在 WebBrwoser 控件里提供的 Navigate 或者 Navigate2 方法中提供了传递数据 的参数 调用方式为 WebBrowser1 Navigate2 URL Flags TargetFrameName PostData Headers 其中 PostData 参数就是一个提交参数字符串 例如 name aaa 对 showModalDialog 引起的对话框进行确定 End Sub 而 confirm 引发的对话确定框可用 confirm 替换 showModalDialog 即可 Alert 等同理 WebBrowser 取得网页源码 Private Sub Command1 Click WebBrowser1 Navigate End Sub Private Sub WebBrowser1 DownloadComplete 页面下载完毕 Dim doc objhtml Set doc WebBrowser1 Document Set objhtml doc body createtextrange If Not IsNull objhtml Then Text1 Text objhtml htmltext End If End Sub 1919 取得源码调试正常运行错误取得源码调试正常运行错误 我用 WebBrowser 取得网页源码 直接运行正常 但在编译后出错 提示 实时错误 91 Object 变量或 with 块变量没有设置 可能是没有下载完所致 Private Sub WebBrowser1 DownloadComplete if webbrowser busy false then Dim doc objhtml Set doc WebBrowser1 Document Set objhtml doc body createtextrange If Not IsNull objhtml Then Text1 Text objhtml htmltext End If end if End Sub 精品文档 13欢迎下载 2020 页面元素操作页面元素操作 1 根据标记名 tagname 的和元素名 name 来找到元素 2 给元素赋值或是执行相关的事件 例例 0 0 查看网页元素查看网页元素 dim a for each a in wbr document all text1 text text1 text this value 登录中 请稍 候 document form1 submit type submit value 登 录 For i 0 To vDoc All length 1 用 i 来判断 submit 为第几个 再点击它 例例 4 4 模拟鼠标点击来点击按钮模拟鼠标点击来点击按钮 Private Declare Function GetMessageExtraInfo Lib user32 As Long Private Declare Sub mouse event Lib user32 ByVal dwFlags As Long ByVal dx As Long ByVal dy As Long ByVal cButtons As Long ByVal dwExtraInfo As Long Private Const MOUSEEVENTF LEFTDOWN As Long var findStrings findString split for var i 0 i0 var objs findNode findString obj childNodes i if objs null return objs for var k 0 k findStrings length k var temp findStrings k split eval var temp2 obj childNodes i temp 0 if temp2 temp 1 findId false break if findId return obj childNodes i return null 例 js findNode nodeName INPUT value 资源发布 document documentElement click 注 如你打不的不是你的网站页面 可以用 VB 的 JS 函数先执行一下我写的这个 javascript findNode 函数如 js func