获取webbrowser控件 网页的源码(收藏)

我在网上找到使用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文件中如果这个网页中含有框架那么要对框加进行处理。

=======================================================================================================================


 
WebbrowserEx模仿IE实例源码 Private WithEvents mobjWebDoc As MSHTML.HTMLDocument Private WithEvents MouseEvent As CMouseHook Private WithEvents KeyboardEvent As CKeyboardHook Private WithEvents frmTopParent As VB.Form Private m_Documents As Collection 'HTML Documents collection Private m_Frames As Collection 'HTML Frames collection '------------------------------------------------------------------------------- ' Webbrowser naviagtion events '------------------------------------------------------------------------------- ' Event IntializeBeforeGoHome(Cancel As Boolean) Event StatusTextChange(ByVal Text As String) Event TitleChange(ByVal Text As String) Event NewDocumentStart(ByVal WebDoc As HTMLDocument, ByVal URL As String, ByVal IsTargetedToFrame As Boolean, ByVal TargetFrameName As String, Cancel As Boolean) Event NewDocumentComplete(ByVal WebDoc As HTMLDocument, ByVal URL As String, ByVal IsTargetedToFrame As Boolean, ByVal TargetFrameName As String) Event BeforeNavigate2(ByVal WebDoc As HTMLDocument, ByVal URL As String, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean) Event NavigateComplete2(ByVal WebDoc As HTMLDocument, ByVal URL As String) Event DocumentComplete(ByVal WebDoc As HTMLDocument, ByVal URL As String) Event BeforeNewWindow2(ByVal URL As String, NewBrowser As Object, Cancel As Boolean) '------------------------------------------------------------------------------- ' User control-wide mouse events '------------------------------------------------------------------------------- ' Event UserControlMouseUp(ByVal Control As Object, ByVal HWnd As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, Cancel As Boolean) Event UserControlMouseMove(ByVal Control As Object, ByVal HWnd As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, Cancel As Boolean) Event UserControlMouseDown(ByVal Control As Object, ByVal HWnd As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, Cancel As Boolean) '------------------------------------------------------------------------------- ' WebBrowser mouse events '------------------------------------------------------------------------------- ' Event WebBrowserDblClick(Cancel As Boolean) Event WebBrowserMouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single, Cancel As Boolean) Event WebBrowserMouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single, Cancel As Boolean) Event WebBrowserMouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single, Cancel As Boolean) Event WebBrowserMouseDownContextMenu(ByVal IsMouseOnLink As Boolean, ByVal URL As String, ByVal SelText As String, Cancel As Boolean) Event WebBrowserMouseUpContextMenu(ByVal IsMouseOnLink As Boolean, ByVal URL As String, ByVal SelText As String, Cancel As Boolean) '------------------------------------------------------------------------------- ' WebBrowser keyboard events '------------------------------------------------------------------------------- ' Event WebBrowserKeyDown(KeyCode As Integer, Shift As Integer) Event WebBrowserKeyUp(KeyCode As Integer, Shift As Integer) '------------------------------------------------------------------------------- ' Go button keyboard events '------------------------------------------------------------------------------- ' Event GoButtonKeyDown(KeyCode As Integer, Shift As Integer) Event GoButtonKeyUp(KeyCode As Integer, Shift As Integer) '------------------------------------------------------------------------------- ' Address bar keyboard events (combo box) '------------------------------------------------------------------------------- ' Event AddressBarContextMenu(Cancel As Boolean) Event AddressBarKeyDown(KeyCode As Integer, Shift As Integer) Event AddressBarKeyUp(KeyCode As Integer, Shift As Integer) '------------------------------------------------------------------------------- ' Statusbar keyboard events '------------------------------------------------------------------------------- ' Event StatusBarKeyDown(KeyCode As Integer, Shift As Integer) Event StatusBarKeyUp(KeyCode As Integer, Shift As Integer) '------------------------------------------------------------------------------- ' Statusbar mouse events '------------------------------------------------------------------------------- ' Event StatusBarPanelClick(Panel As MSComctlLib.Panel) Event StatusBarPanelDblClick(Panel As MSComctlLib.Panel) Event StatusBarMouseMove(Panel As MSComctlLib.Panel, Button As Integer, Shift As Integer, X As Single, Y As Single) Event StatusBarMouseDown(Panel As MSComctlLib.Panel, Button As Integer, Shift As Integer, X As Single, Y As Single) Event StatusBarMouseUp(Panel As MSComctlLib.Panel, Button As Integer, Shift As Integer, X As Single, Y As Single) Private mstrStatusText As String 'Webrrowser status text Private mlngWBHwnd As Long 'Webbrowser handle Private mHwndComboEdit As Long 'Combo edit box handle Private mobjTopParent As VB.Form 'Reference to Top parent form Private mbRunMode As Boolean 'Run/Develope mode detection variable Private newX As Single 'Variables that contained the converted x, y coordinates Private newY As Single Private mhwndTopParent As Long 'Top parent form handle Private mstrClickedLinkURL As String 'Click-on url Private mstrNavigate2URL As String 'Navigation start url Private mstrNavigatedURL As String 'Navigated url Private mstrTargetFrameName As String 'Naviation target frame Const m_def_PopupWindowAllowed = True Const m_def_OpenHomePageAtStart = True Const m_def_AddressBarVisible = True Const m_def_StatusBarVisible = True Const m_def_MouseEventEnabled = True Const m_def_KeyboardEventEnabled = True Private m_AddressBarVisible As Boolean Private m_PopupWindowAllowed As Boolean Private m_OpenHomePageAtStart As Boolean Private m_StatusBarVisible As Boolean Private m_MouseEventEnabled As Boolean Private m_KeyboardEventEnabled As Boolean '------------------------------------------------------------------------------- ' TopParent '------------------------------------------------------------------------------- ' Get the top parent form of the user control Public Property Get TopParent() As Object On Error Resume Next If mobjTopParent Is Nothing Then Dim objParent As Object Set objParent = UserControl.Parent Do While Not TypeOf objParent Is VB.Form Set objParent = objParent.Parent Loop Set mobjTopParent = objParent Set objParent = Nothing End If Set TopParent = mobjTopParent End Property
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

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

抵扣说明:

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

余额充值