首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 开发语言 > VB >

求:vb6,一个webbrowser如何(用循环语句)打开多个网页

2012-03-09 
求:vb6,一个webbrowser怎么(用循环语句)打开多个网页?我想实现自动拷贝一个论坛里的精华帖,它帖子页有很多

求:vb6,一个webbrowser怎么(用循环语句)打开多个网页?
我想实现自动拷贝一个论坛里的精华帖,它帖子页有很多,但网址是很有规律的比如"http://bbs.fobshanghai.com/viewthread.php?tid=3268999&extra=&page=1"(改一下最末位的那个page= 中的数字就是不同的帖子页的网址)

比如有20页,我试图用循环语句 
for i= 1 to 20
WebBrowser2.Navigate "http://bbs.fobshanghai.com/viewthread.php?tid=3268999&extra=&page=" & i

让webbrowser2循环打开这些帖子页然后用 Document.Body.InnerText将它复制出来

但我试了下不行,webbrowser并没有给我循环打开网页,而是好像直接给我打开最后一页就完事了.webbrowser要怎么样才能打开多个网页呢?多谢!!
----------------------------------------
Private Sub Form_Load()
Text5 = "http://bbs.fobshanghai.com/viewthread.php?tid=3268999&extra=&page="
Text4 = 20

WebBrowser1.Silent = True 
WebBrowser1.Navigate "http://bbs.fobshanghai.com/logging.php?action=login"
End Sub

Private Sub WebBrowser1_DownloadComplete()'先登录论坛,登录完毕再打开帖子

Dim ie
Set ie = WebBrowser1.Document
On Error Resume Next
ie.getElementById("username").Value = "11111111111111111111111"
On Error Resume Next
ie.getElementById("password").Value = "111111111111111111111111"
On Error Resume Next
ie.getElementById("loginsubmit").Click

Dim i As Integer
For i = 1 To Text4 '首页到末页
WebBrowser2.Navigate Text5 & i 'text5为帖子网址去掉最后一个数字,如"http://bbs.fobshanghai.com/viewthread.php?tid=3268999&extra=&page=6"
Text1 = WebBrowser2.Document.Body.InnerText & text1

next i
end sub
--------------------------
多谢!!




[解决办法]

VB code
For i = 1 To 50    URL = "http://148.36.19.209:81/exam/ExamPaperByStep.aspx?paper_id=173&mark_id=62227&ptype=0&Str_XuHao=" & i    strData = getHtmlStr(URL)    Set reg = CreateObject("vbscript.regExp")    reg.Global = True    reg.IgnoreCase = True    reg.MultiLine = True    reg.Pattern = "(?:<.*?>|&nbsp;)"    Print #1, reg.Replace(strData, "")NextPublic Function getHtmlStr(ByVal strUrl As String) As String    Dim XmlHttp As Object    Set XmlHttp = CreateObject("Microsoft.XMLHTTP")        XmlHttp.Open "GET", strUrl, False    On Error GoTo Err_net    XmlHttp.send        getHtmlStr = BytesToBstr(XmlHttp.ResponseBody, "UTF-8")        Set XmlHttp = NothingErr_net:End FunctionPrivate Function BytesToBstr(strBody, codeBase) As String    Dim objStream As Object    Set objStream = CreateObject("Adodb.Stream")    objStream.Type = 1    objStream.Mode = 3    objStream.Open    objStream.Write strBody    objStream.position = 0    objStream.Type = 2    objStream.Charset = codeBase    BytesToBstr = objStream.ReadText    objStream.Close    Set objStream = NothingEnd Function 

热点排行