office交流網(wǎng)--QQ交流群號及微信交流群

Access培訓(xùn)群:792054000         Excel免費(fèi)交流群群:686050929          Outlook交流群:221378704    

Word交流群:218156588             PPT交流群:324131555

微信交流群(請用微信掃碼)

        

VB及VBA獲取網(wǎng)頁內(nèi)容、下載進(jìn)度條及亂碼問題解決

2017-09-18 21:45:00
網(wǎng)絡(luò)未知
轉(zhuǎn)貼
6376
VB及VBA獲取網(wǎng)頁內(nèi)容、下載進(jìn)度條及亂碼問題解決

在用vb做“天氣預(yù)報(bào)自動更新系統(tǒng)”的時(shí)候,需要從中 國氣象網(wǎng)、百度天氣搜索等網(wǎng)站提取天氣信息,因而對用vb提取網(wǎng)頁內(nèi)容進(jìn)行了一番研究,重點(diǎn)在于解決亂碼問題和字符串提取。
1.下面是一個(gè)利用INET控件獲取網(wǎng)頁內(nèi)容以及顯示進(jìn)度條的例子。
Private Sub Command1_Click()
Dim strURL As String, m_lDocSize As Long, strBuffer As String
Dim lngArrivedDataSize As Long, strArrivedData As String
strURL = “http://zhidao.baidu.com/question/68055519.html”
Inet1.Execute strURL, “GET” ‘發(fā)出請求
Do While Inet1.StillExecuting ‘等待請求結(jié)束
DoEvents
Loop
If Len(Inet1.GetHeader(“Content-Length”)) > 0 Then ‘獲取文件頭信息
m_lDocSize = CLng(Inet1.GetHeader(“Content-Length”))
End If
With ProgressBar1 ‘初始化進(jìn)度條
.Max = m_lDocSize – Len(Inet1.GetHeader)
.Min = 0
Do  ‘開始獲取數(shù)據(jù)
DoEvents
strBuffer = Inet1.GetChunk(512)
strArrivedData = strArrivedData & strBuffer
lngArrivedDataSize = Len(strArrivedData)
.Value = lngArrivedDataSize ‘進(jìn)度顯示
Loop Until Len(strBuffer) = 0
.Value = .Max
End With
MsgBox “下載完畢!”
End Sub
2.下面是一個(gè)用xmlhttp獲取網(wǎng)頁,能夠解決一些亂碼問題
Private Sub Command1_Click()
Dim a As String
a = RichTextBox1.Text
RichTextBox1.Text = GetBody(a)
End Sub
Public Function GetBody(ByVal URL$, Optional ByVal Coding$ = “GB2312″)
Dim ObjXML
On Error Resume Next
Set ObjXML = CreateObject(“Microsoft.XMLHTTP”)
With ObjXML
.Open “Get”, URL, False, “”, “”
.setRequestHeader “If-Modified-Since”, “0″
.SEnd
GetBody = .ResponseBody
End With
GetBody = BytesToBstr(GetBody, Coding)
Set ObjXML = Nothing
End Function
Public Function BytesToBstr(strBody, CodeBase)
Dim ObjStream
Set ObjStream = CreateObject(“Adodb.Stream”)
With ObjStream
.Type = 1
.Mode = 3
.Open
.Write strBody
.Position = 0
.Type = 2
.Charset = CodeBase
BytesToBstr = .ReadText
.Close
End With
Set ObjStream = Nothing
End Function
分享
文章分類
聯(lián)系我們
聯(lián)系人: 王先生
Email: 18449932@qq.com
QQ: 18449932
微博: officecn01
移動訪問