study139comvb网页功能操作

Public Function HtmlStr URL 提取网页源码函数 Dim XmlHttp Set XmlHttp CreateObject Microsoft XMLHTTP XmlHttp Open GET URL False XmlHttp Send If XmlHttp ReadyState 4 Then HtmlStr StrConv XmlHttp Responsebody vbUnicode End Function 2 函数调用 Dim strweb1 As String strweb1 HtmlStr 二 获取二 获取 WebBrowser 控件中网页源代码控件中网页源代码 1 函数代码 Public Function WebDaima WebBrowser BuFen 获取 WebBrowser 控件中网页源代码 Select Case BuFen Case Body 只获取与之间的代码 WebDaima WebBrowser Document body innerhtml Case All 获取整个网页源代码 WebDaima WebBrowser Document documentelement outerhtml Case Else WebDaima WebBrowser Document documentelement outerhtml End Select End Function 2 调用 Dim strweb As String strweb WebDaima frmIndex WebBrowser1 All 获取整个网页源代码 strweb WebDaima frmIndex WebBrowser1 Body 只获取 body 中源代码 三 提取字符串或网页源代码中指定的资源 可利用这一函数做文章采集器 三 提取字符串或网页源代码中指定的资源 可利用这一函数做文章采集器 1 函数代码 Public Function FindStrMulti Strall FirstStr EndStr SplitStr 提取字符串或网页源代码中所有指定 代码 参数 总文本 起始字符串 终止字符串 分隔符 Dim i 文章列表 比目鱼博客文章列表 文坛张望 谁会拿下 2010 年的诺贝尔文学奖 2010 10 01 22 38 视觉训练 书法练习二幅 2010 09 29 01 51 文坛张望 骆以军对话董启章 2010 09 21 17 15 视觉训练 夜临古画 六 2010 09 17 01 46 我也读书 Jennifer Egan 的 A Visit From the Goon Squad 2010 09 07 02 30 我也读书 当我们谈论电子书的时候我们在谈论电子书阅读器 2010 08 27 16 51 IT 互联网 读写人 和 比目鱼 网站的手机版 2010 08 24 02 04 1 2 3 4 5 6 7 8 从以上代码中获取与之间所有文章的标题链接 实现方法如下 Dim strWeb As String Dim i As Integer Dim strListArea As String Dim strLink 定义存放列表文章链接的数组 strWeb WebDaima Me WebBrowser1 Body 获取网页 body 代码 具体查看 WebDaima 函数 strListArea FindStrMulti strWeb 比目鱼博客文章列表 截列表区域代码 获取列表区域中文章链接 并存在在数组 strLink 中 strLink Split FindStrMulti strListArea href Chr 34 Chr 34 vbCrLf vbCrLf For i 0 To UBound strLink 循环输出链接 Text1 Text Text1 Text strLink i vbCrLf Next i 四 中文汉字转化为四 中文汉字转化为 URL 编码编码 函数代码 以下两个函数用于将文字转化为 UTF8 或 GBK 编码 如在百度中搜索内容时 百度先将搜索词转化为 UTF8 的编码 再传送给服务器 调用 KeyWordUtf UTF8EncodeURI KeyWord 或 KeyWordUtf GBKEncodeURI KeyWord Public Function UTF8EncodeURI szInput Dim wch uch szRet Dim X Dim nAsc nAsc2 nAsc3 If szInput Then UTF8EncodeURI szInput Exit Function End If For X 1 To Len szInput wch Mid szInput X 1 nAsc AscW wch If nAsc 0 Then Set CtrlRange WebBrowser Document body createControlRange CtrlRange Add x CtrlRange execCommand Copy Debug Print Copy Img Picture Clipboard GetData End If End If Next End Function 函数调用 如获取网页 中的验证码图片代码如下 获取验证码函数调用如下 Call GetImg Form1 WebBrowser1 Form1 Image1 VerifyCode Login aspx 六 六 WebBrowser 控件中网页按钮的点击控件中网页按钮的点击 查询 此按钮的点击方法 WebBrowser1 Document getelementsbytagname BUTTON WordSearchBtn Click 七 七 WebBrowser 控件中网页文本框的赋值控件中网页文本框的赋值 文本框代码 WebBrowser1 Document getelementsbytagname input WordInput Value 要在文本框输入的文字 此处 WordInput 为文本框的 ID 或 Name 属性值 八 八 WebBrowser 控件中网页列表控件中网页列表 菜单表单选项的选取菜单表单选项的选取 函数代码 Public Function SelectXq WebBrowser SelectName SelectValue 参数 WebBrowser WebBrowser 控件名称 SelectName 网页中 列表 菜单 表单名称或 ID 值 SelectValue 选中值 WebBrowser doc All Item SelectName Value SelectValue End Function 函数调用方法 WebBrowser 中网页 Select 表单代码如下 我就读的第一所学校的名称 我最 喜欢的休闲运动是什么 我最喜欢的运动员是谁 我最喜欢的物品的名称 我最喜欢的歌曲 我最喜欢 的食物 我最爱的人的名字 我最爱的电影 我妈妈的生日 让列表表单选中选项值为 我最爱的人的名字 的选项 Call SelectXq Form1 WebBrowser1 ctl00 ContentPlaceHolder1 DropDownList1 我最爱的人的名字 八 自动填写注册表单并提交八 自动填写注册表单并提交 网页表单代码 请填写下面表单注册 项为必添项 姓名 男 女 昵称 兴趣爱好 计算机 游戏 逛街 电子邮件 密码 填写表单并提交操作代码 Private Sub Form Load WebBrowser1 Navigate2 App Path test htm End Sub Private Sub WebBrowser1 DocumentComplete ByVal pDisp As Object URL As Variant Dim vDoc vTag Dim i As Integer Set vDoc WebBrowser1 Document List1 Clear For i 0 To vDoc All length 1 If UCase vDoc All i tagName INPUT Or UCase vDoc All i tagName SELECT Then Set vTag vDoc All i If vTag Type text Or vTag Type password Or vTag Type radio Or vTag Name aihao Then List1 AddItem vTag Name Select Case vTag Name Case Name vTag Value IMGod Case R2 vTag Checked True Case NickName vTag Value IMGod Case aihao vTag Value 逛街 Case Password vTag Value IMGodpass Case EMail vTag Value IMGod End Select ElseIf vTag Type submit Then vTag Click End If End If Next i End Sub 九 限制九 限制 WebBrowser 控件中网页的所有链接在同一个窗口打开控件中网页的所有链接在同一个窗口打开 Private Sub Form Load WebBrowser1 Navigate End Sub Private Sub WebBrowser1 NewWindow2 ppDisp As Object Cancel As Boolean Cancel True WebBrowser1 Navigate WebBrowser1 Document activeelement href End Sub 十 控件十 控件 WebBrowser 控件中网页弹窗或新窗口打开的链接在另一个控件中网页弹窗或新窗口打开的链接在另一个 WebBrowser 控件中打开控件中打开 Private Sub WebBrowser1 NewWindow2 ppDisp As Object Cancel As Boolean Set ppDisp WebPageAd Object End Sub 十一 禁止十一 禁止 WebBrowser 控件中网页弹窗控件中网页弹窗 Private Sub WebBrowser1 NewWindow2 ppDisp As Object Cancel As Boolean Cancel True End Sub 窗体透明控件不透明 Private Declare Function GetWindowLong Lib user32 Alias GetWindowLongA ByVal hwnd As Long ByVal nIndex As Long As Long Private Declare Function SetWindowLong Lib user32 Alias SetWindowLongA ByVal hwnd As Long ByVal nIndex As Long ByVal dwNewLong As Long As Long Private Declare Function SetLayeredWindowAttributes Lib user32 ByVal hwnd As Long ByVal crKey As Long ByVal bAlpha As Byte ByVal dwFlags As Long As Long Private Const GWL STYLE 16 Private Const GWL EXSTYLE 20 Private Const WS EX LAYERED H80000 Private Const LWA COLORKEY H1 Private Const LWA ALPHA H2 Private Sub Form Load Me BackColor vbCyan SetWindowLong Me hwnd GWL EXSTYLE GetWindowLong Me hwnd GWL EXSTYLE Or WS EX LAYERED SetLayeredWindowAttributes Me hwnd vbCyan 0 LWA COLORKEY End Sub 图标提取 Private Declare Function ExtractIcon Lib shell32 dll Alias ExtractIconA ByVal hInst As Long ByVal lpszExeFileName As String ByVal nIconIndex As Long As