VB提取网页源文件的函数

 

推荐函数1: 提取网页源码. 使用了XMLHTTP. 不用控件, 当你再次打开时, 就因为有IE的缓存..所以速度更快.

推荐函数2: 提取网页内容. 使用了do loop. . 通用性很高了.. 提取基金信息,股息信息,或是其它网页源码中的内容.

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

Private Sub Command1_Click()
Dim a$, i&, burl$(), bname$(), bbz$(), bbb$()
a = HtmlStr(”http://tieba.baidu.com/f?ct=318767104&tn=bdSecondClassIndex&rs1=6&lm=29&word=%CD%F8%C2%E7%D3%CE%CF%B7&word1=%D3%CE%CF%B7&pn=0&rn=500″)
a = FindStrMulti(a, “<strong>网络游戏</strong>”, “</table>”, “”)
burl = Split(FindStrMulti(a, “<a href=” & Chr(34), Chr(34) & ” target=_blank>”, vbCrLf), vbCrLf)
bname = Split(FindStrMulti(a, “target=_blank>”, “</a></td>”, vbCrLf), vbCrLf)
ReDim bbz(UBound(burl)), bbb(UBound(burl))
Text1 = Text1 & vbCrLf & “俺正在分析……”
Text1 = Text1 & vbCrLf & “俺发现有” & UBound(burl) & “个游戏类的贴吧…”
Text1 = Text1 & vbCrLf
Text1 = Text1 & vbCrLf & “俺在继续分析ing…”
Text1 = Text1 & vbCrLf
For i = 0 To UBound(burl)
a = HtmlStr(”http://tieba.baidu.com” & burl(i))
a = FindStrMulti(a, “>吧主</a>”, “</table>”, “,”)
bbz(i) = FindStrMulti(a, “target=_blank>”, “</a>”, “,”)
bbb(i) = bname(i) & “: ” & bbz(i)
Next
Text1 = Text1 & vbCrLf & “结果出来了呀! 在下面:      *^&^*   ←←← VB妮可” & vbCrLf
Text1 = Text1 & vbCrLf & String(60, “=”) & vbCrLf
Text1 = Text1 & vbCrLf & Join(bbb, vbCrLf)
End Sub

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

Function FindStrMulti$(Strall$, FirstStr$, EndStr$, SplitStr$) ‘提取网页中所有指定资源
Dim i&, j&
j = 1
Do
i = InStr(j, Strall, FirstStr)
If i = 0 Then Exit Do
i = i + Len(FirstStr)
j = InStr(i, Strall, EndStr)
If j > 0 Then FindStrMulti = IIf(Len(FindStrMulti) > 0, FindStrMulti & SplitStr, “”) & Mid(Strall, i, j - i) Else Exit Do
Loop
End Function

Private Sub Form_Load()
Me.Move Screen.Width / 2 - 3000, Screen.Height / 2 - 2000, 6000, 4000
Text1 = “”
Me.Caption = “百度游戏吧主提取程序”
End Sub

Private Sub Form_Resize()
Text1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight - 600
Command1.Move Me.ScaleWidth / 2 - 450, Me.ScaleHeight - 500, 900, 400
End Sub