Option Explicit

Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type

‘相关 API 函数声明
Private Declare Function SendMessageByString Lib “user32″ Alias “SendMessageA” (ByVal hwnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As String) As Long
Private Declare Function FindWindow Lib “user32″ Alias “FindWindowA” (ByVal lpClassName As String,ByVal lpWindowName As String) As Long
Private Declare Function RegisterWindowMessage Lib “user32″ Alias “RegisterWindowMessageA” (ByVal lpString As String) As Long
Private Declare Function SendMessageTimeout Lib “user32″ Alias “SendMessageTimeoutA” (ByVal hwnd As Long,ByVal msg As Long,ByVal lParam As Long,ByVal fuFlags As Long,ByVal uTimeout As Long,lpdwResult As Long) As Long
Private Declare Function FindWindowEx Lib “user32″ Alias “FindWindowExA” (ByVal hWnd1 As Long,ByVal hWnd2 As Long,ByVal lpsz1 As String,ByVal lpsz2 As String) As Long
Private Const SMTO_ABORTIFHUNG = &H2
Private Declare Function ObjectFromLresult Lib “oleacc” (ByVal lResult As Long,riid As GUID,ppvObject As Any) As Long

Private Declare Function EnumWindows Lib “user32″ (ByVal lpEnumFunc As Any,ByVal lParam As Long) As Long’枚举窗口列表中的所有父窗口（顶级和被所有窗口）
Private Declare Function GetWindowText Lib “user32″ Alias “GetWindowTextA” (ByVal hwnd As Long,ByVal lpString As String,ByVal cch As Long) As Long ‘取得指定窗口的司法题
Private Declare Function GetClassName Lib “user32″ Alias “GetClassNameA” (ByVal hwnd As Long,ByVal lpClassName As String,ByVal nMaxCount As Long) As Long ‘为指定的窗口取得类名
Private Declare Function GetWindow Lib “user32″ (ByVal hwnd As Long,ByVal wCmd As Long) As Long’取得窗口句柄
Private Declare Function SendMessage Lib “user32″ Alias “SendMessageA” (ByVal hwnd As Long,lParam As Any) As Long ‘发送消息
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE

Private strIEAddress As String

Public Function GetAllIEAddress() As String
strIEAddress = “”

EnumWindows AddressOf EnumProc,0

‘If strIEAddress <> “” Then
‘GetIEAddress = “”
‘GetIEAddress = GetIEAddress & “<Data>”
‘GetIEAddress = GetIEAddress & “<DateTime>” & Format(Now,“yyyy-MM-dd HH:mm:ss”) & “</DateTime>”
‘GetIEAddress = GetIEAddress & “<TypeID>2</TypeID>”
‘GetIEAddress = GetIEAddress & “<Title>” & ReplaceXMLIn(strIEAddress) & “</Title>”
‘GetIEAddress = GetIEAddress & “</Data>”
‘Else
‘GetIEAddress = “”
‘End If

End Function

‘遍查主窗口
Private Function EnumProc(ByVal app_hwnd As Long,ByVal lParam As Long) As Boolean
Dim buf As String * 1024
Dim Length As Long
Dim title As String

‘得到窗体标题，这里没有用上
‘Length = GetWindowText(app_hwnd,buf,Len(buf))
‘title = Trim(StripTerminator(buf))

Dim strClassName As String * 1024
Length = GetClassName(app_hwnd,strClassName,Len(strClassName))
strClassName = Trim(StripTerminator(LCase(strClassName)))

‘判断是否为 IE 浏览器窗口
If InStr(1,“ieframe”) > 0 Then
GetSubWin app_hwnd,“IEFrame”,“Internet Explorer_Server”
End If

EnumProc = 1
End Function

‘递归遍查子窗口
Private Function GetSubWin(window_hwnd As Long,ByVal WinClassName As String,ByVal SubWinClassName As String) As String
On Error GoTo ErrHandler
Dim buf As String
Dim buflen As Long
Dim child_hwnd As Long
Dim children() As Long
Dim num_children As Integer
Dim i As Integer
buflen = 256
buf = Space$(buflen – 1)
buflen = GetClassName(window_hwnd,buflen)
buf = Left$(buf,buflen) ‘取得子窗口的类名

If SubWinClassName = “Internet Explorer_Server” Then
If LCase(Right(buf,Len(SubWinClassName))) = LCase(SubWinClassName) Then
If InStr(1,LCase(WinClassName),“ieframe”) > 0 Then
GetIEAddress window_hwnd
End If
End If
End If

num_children = 0
child_hwnd = GetWindow(window_hwnd,GW_CHILD) ‘取得第 1 个子窗口的句柄

Do While child_hwnd <> 0 ‘如果有子窗口
num_children = num_children + 1
ReDim Preserve children(1 To num_children)
children(num_children) = child_hwnd
child_hwnd = GetWindow(child_hwnd,GW_HWNDNEXT) ‘取得下一个兄弟窗口的句柄
Loop

For i = 1 To num_children
Dim strRet As String
strRet = GetSubWin(children(i),WinClassName,SubWinClassName)
If strRet <> “” Then Exit For
Next i

ErrHandler:

End Function

Private Sub GetIEAddress(IEWid As Long)

Dim hwId As Long
‘hwId = FindWindow(“IEFrame”,vbNullString)
‘hwId = FindWindowEx(hwId,“Shell DocObject View”,vbNullString)
‘hwId = FindWindowEx(IEWid,“Internet Explorer_Server”,vbNullString)

Dim lMsg As Long
lMsg = RegisterWindowMessage(“WM_HTML_GETOBJECT”)
Dim lRes As Long

SendMessageTimeout IEWid,lMsg,SMTO_ABORTIFHUNG,1000,lRes

Dim IID_IHTMLDocument As GUID

IID_IHTMLDocument.Data1 = &H626FC520
IID_IHTMLDocument.Data2 = &HA41E
IID_IHTMLDocument.Data3 = &H11CF

IID_IHTMLDocument.Data4(0) = &HA7
IID_IHTMLDocument.Data4(1) = &H31
IID_IHTMLDocument.Data4(2) = &H0
IID_IHTMLDocument.Data4(3) = &HA0
IID_IHTMLDocument.Data4(4) = &HC9
IID_IHTMLDocument.Data4(5) = &H8
IID_IHTMLDocument.Data4(6) = &H26
IID_IHTMLDocument.Data4(7) = &H37

Dim myInstance As MSHTML.IHTMLDocument5

ObjectFromLresult lRes,IID_IHTMLDocument,myInstance

If Not (myInstance Is Nothing) Then
Debug.Print myInstance.url
Debug.Print myInstance.nameProp
‘Debug.Print myInstance.documentElement.outerHTML
‘DebugChildren myInstance
End If

End Sub

‘去除非vb字符。
Public Function StripTerminator(ByVal strString As String) As String
Dim intZeroPos As Integer
intZeroPos = InStr(strString,Chr$(0))
If intZeroPos > 0 Then
StripTerminator = Left$(strString,intZeroPos – 1)
Else
StripTerminator = strString
End If
End Function

7.””””””””””””””””
‘这里可以debug到它的全部html源码，呵呵，独家珍藏
Option Explicit

Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type

Private Declare Function SendMessageByString Lib “user32″ Alias “SendMessageA” (ByVal hwnd As Long,ppvObject As Any) As Long

‘Form1.frm 文件
‘————–

Private Sub Command1_Click()

Dim hwId As Long

hwId = FindWindow(“IEFrame”,vbNullString)
hwId = FindWindowEx(hwId,vbNullString)

Dim lMsg As Long
lMsg = RegisterWindowMessage(“WM_HTML_GETOBJECT”)
Dim lRes As Long

SendMessageTimeout hwId,lRes

Dim IID_IHTMLDocument As GUID

IID_IHTMLDocument.Data1 = &H626FC520
IID_IHTMLDocument.Data2 = &HA41E
IID_IHTMLDocument.Data3 = &H11CF

IID_IHTMLDocument.Data4(0) = &HA7
IID_IHTMLDocument.Data4(1) = &H31
IID_IHTMLDocument.Data4(2) = &H0
IID_IHTMLDocument.Data4(3) = &HA0
IID_IHTMLDocument.Data4(4) = &HC9
IID_IHTMLDocument.Data4(5) = &H8
IID_IHTMLDocument.Data4(6) = &H26
IID_IHTMLDocument.Data4(7) = &H37

‘Debug.Print “{626FC520-A41E-11CF-A731-00A0C9082637}”’IHTMLDocument

‘IID_IHTMLDocument.Data4 = “626FC520-A41E-11CF-A731-00A0C9082637″
Dim myInstance As MSHTML.IHTMLDocument5

ObjectFromLresult lRes,myInstance

If Not (myInstance Is Nothing) Then
‘Debug.Print myInstance.body.children.length
Debug.Print myInstance.url
Text1.Text = myInstance.documentElement.outerHTML
‘DebugChildren myInstance

End If

End Sub

8.获取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”,vbNullString,0)
If lgSession Then
lgInternet = InternetOpenUrl(lgSession,stUrl,_
0,INTERNET_FLAG_NO_CACHE_WRITE,0)
If lgInternet Then
Do
inRes = InternetReadFile(lgInternet,stBuf,1024,lgRet)
stTotal = stTotal & Mid$(stBuf,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文件中如果这个网页中含有框架那么要对框加进行处理。

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