获取webbrowser控件网页的源码

162 篇文章 1 订阅
100 篇文章 0 订阅
我在网上找到使用rft控件保存webbrowse文本 txtHtml是RichTextBox
txtHTML.Text = WebBrowser1.document.body.innerText
'flag :rsftext 保存为txt文件,strtmp文件路径
txtHTML.saveFile strtmp, rtfText


将其name属性设置为web

Private Sub Command1_Click()
web.Navigate "www.google.com"
End Sub

Private Sub web_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Set doc = web.Document
For Each i In doc.All
msgbox typename(i)
Text1.Text = Text1.text & vbclrf & i.innertext
Next
End sub

转载

'引用 Microsoft HTML Object Library

Dim oDoc As HTMLDocument
Dim oElement As Object
Dim oTxtRgn As Object
Dim sSelectedText As String

Set oDoc = WebBrowser1.Document '获得文档对象
Set oElement = oDoc.getElementById("T1") '获得ID="T1"的对象
Set oTxtRgn = oDoc.selection.createRange '获得文档当前正选择的区域对象

sSelectedText = oTxtRgn.Text '选择区域文本赋值

oElement.Focus '"T1"对象获得焦点

oElement.Select '全选对象"T1"

Debug.Print "你选择了文本:" & sSelectedText


上面这段儿还附送了其他功能,呵呵。精简一下是这样:
Dim oDoc As Object
Dim oTxtRgn As Object
Dim sSelectedHTML As String

Set oDoc = WebBrowser1.Document '获得文档对象
Set oTxtRgn = oDoc.selection.createRange '获得文档当前正选择的区域对象

sSelectedHTML = oTxtRgn.htmlText '选择区域文本赋值

Text1.Text=sSelectedHTML '文本框显示抓取得HTML源码
......'或者继续分析源码


我用WebBrowser取得网页源码,直接运行正常,但在编译后出错
Private Sub Command1_Click()
WebBrowser1.Navigate "http://www.sdqx.gov.cn/sdcity.php"
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

我用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

你要得网页源码用 xmlhttp比较好

先引用 msxml

Dim x As New MSXML2.XMLHTTP
x.open "get", "http://www.sina.com", False
x.send

MsgBox StrConv(x.responseBody, vbUnicode)


我在网上找到使用rft控件保存webbrowse文本 txtHtml是RichTextBox
txtHTML.Text = WebBrowser1.document.body.innerText
'flag :rsftext 保存为txt文件,strtmp文件路径
txtHTML.saveFile strtmp, rtfText


Private Sub WebBrowser1_DownloadComplete()
Dim objHtml As Object '下载完成时状态栏显示“Link Finished”
Set objHtml = Me.WebBrowser1.Document.Body.Createtextrange()
  If Not IsNull(objHtml) Then
   Text1.Text = objHtml.htmltext
End If
End Sub

使用inet控件

Source1 = Inet1.OpenURL("www.csdn.net")
If Source1 <> "" Then
  RichTextBox1.Text = Source1
    Me.Inet1.Cancel
Else
   Source = MsgBox("Source code is not available.", vbInformation, "Source Code")
End If

Private Sub Command1_Click()
   Text1.Text = WebBrowser1.Document.body.innerHTML
End Sub


加入timer,commandbutton,text
private sub command1_click()
webbrowser1.navigate http://www.sohu.com/
timer1.enabled=true
end sub

private sub timer1_timer()
dim doc,objhtml as object
dim i as integer
dim strhtml as string

if not webbrowser1.busy then
  set doc=webbrowser1.document
     i=0
    set objhtml=doc.body.createtextrange()
 if not isnull(objhtml) then
  text1.text=objhtml.htmltext
   end if
   timer1.enabled=false
   end if
end sub


Dim doc, objhtml As Object
If Not webbrowser1.Busy Then
Set doc = webbrowser1.Document
 Set objhtml = doc.body.createtextrange()
  If Not IsNull(objhtml) Then
     text1.text=objhtml.htmltext
  End If
 Set doc = Nothing
Set objhtml = Nothing

End If


或者试试用InternetReadFile,效果也可以:
Option Explicit

Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" ( _
  ByVal sAgent As String, ByVal lAccessType As Long, _
  ByVal sProxyName As String, ByVal sProxyBypass As String, _
  ByVal lFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" ( _
  ByVal hInternetSession As Long, ByVal sUrl As String, _
  ByVal sHeaders As String, ByVal lHeadersLength As Long, _
  ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetReadFile Lib "wininet.dll" ( _
  ByVal hFile As Long, ByVal sBuffer As String, _
  ByVal lNumBytesToRead As Long, _
  lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetCloseHandle Lib "wininet.dll" ( _
  ByVal hInet As Long) As Integer
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
  Dim s

Private Function GetUrlFile(stUrl As String) As String
Dim lgInternet As Long, lgSession As Long
Dim stBuf As String * 1024
Dim inRes As Integer
Dim lgRet As Long
Dim stTotal As String
   stTotal = vbNullString
    lgSession = InternetOpen("VBTagEdit", 1, vbNullString, vbNullString, 0)
      If lgSession Then
        lgInternet = InternetOpenUrl(lgSession, stUrl, vbNullString, _
          0, INTERNET_FLAG_NO_CACHE_WRITE, 0)
        If lgInternet Then
Do
    inRes = InternetReadFile(lgInternet, stBuf, 1024, lgRet)
    stTotal = stTotal & Mid$(stBuf, 1, lgRet)
    Loop While (lgRet <> 0)
      End If
     inRes = InternetCloseHandle(lgInternet)
   End If
    GetUrlFile = stTotal
End Function

Private Sub Command1_Click()
   Text1.Text = GetUrlFile("http://adsl.tsee.net/teleplay/view.asp?id=143")
End Sub

Set vDoc = WebBrowser1.Document '获取网页的源码
For Each o In vDoc.All
DoEvents
htmlpage = htmlpage & o.innerHTML
Next

然后用写二进制文件的方法将htmlpage的内容写入到.html文件中如果这个网页中含有框架那么要对框加进行处理。
 from
评论 3
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值