VB保存网页中的文本

Question

***************以下这段是把网页源码保存下来了*********
    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        If TextBox1.Text = "" Then
            MsgBox("请输入网址")
        Else
            Inet1.URL = TextBox1.Text '打开的网址
            richtext1.Text = Inet1.OpenURL '打开
            CommonDiaLog1.Filter = "文本文件(*.txt)|*.txt" '设置欲保存文件的格式 
            CommonDiaLog1.ShowSave()
            If CommonDiaLog1.FileName <> "" Then
                richtext1.SaveFile(CommonDiaLog1.FileName, RichTextBoxStreamType.TextTextOleObjs) '保存richtext1的内容(即网页源代码)到指定位置. 
                MsgBox("文件已经保存到" & CommonDiaLog1.FileName)
            End If
            End If
    End Sub
End Class
******************我只想保存网页中的文本.如何实现*********

Answer 1

Public Function Html2Txt(ByVal sHtml As String) As String
    Dim lBracketPos As Long      ' <位置
    Dim lBracketPos2 As Long     ' >位置，识别tag
    Dim lBlankPos As Long        ' 空格位置，识别tag
    Dim sTag As String           ' 标签
    Dim sText As String          ' 返回的Txt
    Dim lTextStart As Long       ' Txt起始位置
    Dim lTextEnd As Long         ' Txt结束位置
    Dim bComment As Boolean      ' 注释或脚本段
    lBracketPos = InStr(1, sHtml, "<")
    While lBracketPos > 0
        bComment = True
        lBracketPos2 = InStr(lBracketPos + 1, sHtml, ">")
        lBlankPos = InStr(lBracketPos + 1, sHtml, " ")
        If lBlankPos > lBracketPos2 Then lBlankPos = InStr(lBracketPos + 1, sHtml, vbCrLf)
        If lBlankPos < lBracketPos2 And lBlankPos <> 0 Then
            sTag = LCase(Mid(sHtml, lBracketPos + 1, lBlankPos - lBracketPos - 1))
        Else
            sTag = LCase(Mid(sHtml, lBracketPos + 1, lBracketPos2 - lBracketPos - 1))
        End If
        If Left(sTag, 3) = "!--" Then
            lTextEnd = InStr(lBracketPos + 1, sHtml, "-->")
        ElseIf sTag = "script" Then
            lTextEnd = InStr(lBracketPos2 + 1, sHtml, "/script>", vbTextCompare)
        ElseIf sTag = "style" Then
            lTextEnd = InStr(lBracketPos2 + 1, sHtml, "/style>", vbTextCompare)
        Else
            lTextEnd = InStr(lBracketPos2 + 1, sHtml, "<")
            bComment = False
        End If
        lTextStart = lBracketPos2 + 1
        If bComment Then
            lBracketPos = InStr(lTextEnd + 1, sHtml, "<")
        Else
            If lTextEnd = 0 Then
                lBracketPos = -1
            Else
                sText = sText & Mid(sHtml, lTextStart, lTextEnd - lTextStart)
                lBracketPos = InStr(lTextEnd + 1, sHtml, "<")
            End If
        End If
    Wend
    sText = Replace(sText, "&nbsp;", " ")
    sText = Replace(sText, vbCrLf & vbCrLf, vbCrLf)
    sText = Replace(sText, "&lt;", "<")
    sText = Replace(sText, "&gt;", ">")
    sText = Replace(sText, "<br>", vbCrLf, , , vbTextCompare)
    Html2Txt = sText
End Function

Answer 2

我找着了.
WebBrowser1.Document.Body.InnerText  
还是谢谢
楼上的

Answer 3

WebBrowser1.Document.Body.InnerText  ，需要下载整个网页，慢的很，有其他办法么？

Answer 4

好像用SERVERXMLHTTP这个东西最好，支持超时等待，支持。。
好处多多，建议楼主考虑一下