拜各位高手帮我看下这段代码.关于vb取网页源码中<p>和<p/>之间文字的

Question

本帖最后由 clintonus 于 2010-10-07 10:58:21 编辑

Answer 1

zhengmenghua兄说得是。对不起，是我粗心把代码中</p>写成了"<p/>",有两个地方，改正如下：
pEnd = InStr(p0, Text1.Text, "</p>") '找到新闻的结束位置
    
  
  p1 = InStr(p0, Text1.Text, "</p>") '"<p/>"出现就标志这条新闻结束改正后是可以取得一条新闻的，只是只能取到一条,没办法得到所有的各条.可能是我那个loop语句 使得Text2.Text = news只保留最后得到的一条(?但好像又不是“最后的一条”). 具体要怎么得到所有的各条,这个我又不会了,太菜。请高手们再指点。

Answer 2

    a = Text1.Text
    a = Split(a, "</p>")
    If UBound(a) = 0 Then Exit Sub
    For i = 0 To UBound(a)
        text2.text = text2.text & Mid(a(i), InStr(1, a(i), "<p>") + 3, Len(a(i)))
    Next i

Answer 3

 你的逻辑很混乱。 Dim p0 As Long, p1 As Long
  Dim news As String 'news用于存储新闻  Inet1.Protocol = icHTTP
  Text1.Text = Inet1.OpenURL("http://www.chinadaily.com.cn") '把源文件放在text1.text中
  
  p0 = 1  
  Text2 = ""  Do      p0 = InStr(p0, Text1.Text, )   
  If p0 = 0 Then Exit Do '未找到"<p>"，退出循环
    
  p0 = p0 + 3 '偏移<p>本身的3个位置
  p1 = InStr(p0, Text1.Text, "</p>") '"</p>"出现就标志这条新闻结束
  If p1 = 0 Then Exit Do '未找到"</p>"，退出循环  news = Mid(Text1.Text, p0, p1 - p0) '取出开始和结束位置之间的字符
  Text2 = Text2 & news & vbCrLf  p0 = p1 + 4
  If p0 > Len(Text1) Exit Do 
  Loop

Answer 4

谢谢of123，大美女哦？说的是,我是个大外行我试过了您的代码，貌似不行，text2.text里面什么也没有
(另外vb提示了几个语法错误,我改了：
p0 = InStr(p0, Text1.Text, )              这里的最后一个，要去掉
Text2 = Text2 & news & vbCrLf             这里的text2应该是text2.text?)
--------------------------------
lxq19851204兄的方法貌似不行,谢过!

Answer 5

Dim a
Dim i As Integer
Dim b    Text1.Text = "<p>The winner of the country's third largest "
    Text1.Text = Text1.Text & "lottery jackpot, 258 million yuan ($38.5 million), had yet to come forward by late Wednesday.</p>"
    Text1.Text = Text1.Text & " <!--end 848400-159283-1-->"
    Text1.Text = Text1.Text & "  </div>"
    Text1.Text = Text1.Text & "<p>A rocket attack in the Yemeni "
    Text1.Text = Text1.Text & "capital Sanaa on Wednesday targeted a vehicle carrying the deputy chief of the British mission in Yemen and a gunman opened fire at an Austrian oil and gas firm, killing a Frenchman.</p>"
    a = Text1.Text
    a = Split(a, "</p>")
    If UBound(a) = 0 Then Exit Sub
    For i = 0 To UBound(a)
        b = b & Mid(a(i), InStr(1, a(i), "<p>") + 3, Len(a(i)))
        Debug.Print b
    Next i在我电脑上可以取出<p>..</p>之间的内容

Answer 6

p0 = InStr(p0, Text1.Text, "<p>") 复制时漏掉了。.Text 是 TextBox 的缺省属性，可以省略。下面是测试过的：Private Sub Command1_Click()
Dim p0 As Long, p1 As Long
  Dim news As String 'news用于存储新闻
  p1 = 1
  Text2 = ""  Do  p0 = InStr(p1, Text1.Text, "<p>")
  If p0 = 0 Then Exit Do '未找到"<p>"，退出循环
    
  p0 = p0 + 3 '偏移<p>本身的3个位置
  p1 = InStr(p0, Text1.Text, "</p>") '"</p>"出现就标志这条新闻结束
  If p1 = 0 Then Exit Do '未找到"</p>"，退出循环  news = Mid(Text1.Text, p0, p1 - p0) '取出开始和结束位置之间的字符
  Text2 = Text2 & news & vbCrLf & vbCrLf  If p0 > Len(Text1) Then Exit Do
  LoopEnd SubPrivate Sub Form_Load()
  Inet1.Protocol = icHTTP
  Text1.Text = Inet1.OpenURL("http://www.chinadaily.com.cn") '把源文件放在text1.text中
End Sub

Answer 7

Private Function StrFormat(s As String) As String
On Error Resume Next
Dim Buf As String
Dim StrTemp As String
Dim c As String
Dim i As Long
Dim j As Long
Dim k As Long
Dim L As Long
    Buf = s
    Do
        L = InStr(1, Buf, "<style", vbTextCompare)
        If L > 0 Then
            k = InStr(L + 6, Buf, "</style>", vbTextCompare)
            If k > 0 Then
                Buf = Left(Buf, L - 1) + Mid(Buf, k + 8)
            Else
                Buf = Left(Buf, L - 1)
                Exit Do
            End If
        Else
            Exit Do
        End If
    Loop
    Do
        L = InStr(1, Buf, "<script", vbTextCompare)
        If L > 0 Then
            k = InStr(L + 7, Buf, "</script>", vbTextCompare)
            If k > 0 Then
                Buf = Left(Buf, L - 1) + Mid(Buf, k + 9)
            Else
                Buf = Left(Buf, L - 1)
                Exit Do
            End If
        Else
            Exit Do
        End If
    Loop
    Buf = Replace(Buf, "&amp;", "&")
    Buf = Replace(Buf, "&quot;", Chr(34)) '替换成双引号
    Buf = Replace(Buf, "&lt;", "<")
    Buf = Replace(Buf, "&gt;", ">")
    Buf = Replace(Buf, " ", "")
    Buf = Replace(Buf, "<", " <")
    Buf = Replace(Buf, ">", "> ")
    Buf = Replace(Buf, "&nbsp;", "")
    Buf = Replace(Buf, Chr(26), " ")
    Buf = Replace(Buf, Chr(10), " ")
    Buf = Replace(Buf, Chr(9), " ")
    Buf = Replace(Buf, Chr(13), " ")
    Buf = LTrim(Buf)
    Buf = RTrim(Buf)
    '您可加入其他替换
    StrTemp = ""
    For i = 1 To Len(Buf)
        c = Mid(Buf, i, 1)
        Select Case c
            Case "<"
                If i <> 1 Then
                    StrTemp = StrTemp & Mid(Buf, j + 1, i - j - 1)
                End If
            Case ">"
                j = i
        End Select
    Next i
    L = Len(StrTemp)
    Do
        Buf = Replace(StrTemp, "  ", " ")
        i = Len(Buf)
        If i = L Then Exit Do
        L = i
        StrTemp = Buf
    Loop
    StrFormat = Buf
End Function