怎么实现：HTML 变 TXT ？

Question

function Html2Text(Str : String):String;
var
  StrL, i : Integer;
  NewStr : String;
begin
  StrL := StrLen(PChar(Str));
  i := 0;
  While i < StrL do
    begin
    Inc(i);
    if Str[i]='>' then
      begin
      While Str[i+1]<>'<' do
        begin
          Inc(i);
          if i > StrL Then Break;
          NewStr := NewStr + Str[i];
        end;//End While
      end;//End if
    end;//end While
  Result := NewStr;
end;

Answer 1

DeityFox(神狐) (  ) 同志：感谢你的算法，但是我认为这还是有些漏洞。

Answer 2

这个算法也很慢……
我用VB做了一个Html转TXT的程序，用Delphi也做了一个，并且可以批量转换，速度快，20K一个的html100个完成转换只需要20秒左右（赛扬500+128M）缺点是用于判断的代码比较长，有几百行……

Answer 3

h2yang(小青) 同志：能公开吗？

Answer 4

h2yang(小青)  同志：能公开吗？

Answer 5

h2yang(小青)    同志：能公开吗？

Answer 6

如果有源码可否发给我一份：
[email protected]

Answer 7

我觉的用execwb复制下html的所有东西，然后写到txt中，不过具体我不会

Answer 8

如果有源码可否发给我一份：
  [email protected]

Answer 9

对于html，body之间是内容，将其中的内容选出，再去掉其它标记符。

Answer 10

对，DeityFox(神狐)同志的代码应加入对“Body”以外的过滤

Answer 11

h2yang(小青)  贴出来看看!

Answer 12

h2yang(小青) 同志：不要卖弄了！

Answer 13

[email protected]
我也想要源码,谢谢

Answer 14

你可以用Delphi的blockwrite ,blockread, Move 等函数进行文件的
处理,速度会快些.

Answer 15

以下是VB代码：Html转TXTVERSION 5.00
Begin VB.Form Frmhtmtotxt 
   ClientHeight    =   4125
   ClientLeft      =   60
   ClientTop       =   360
   ClientWidth     =   5685
   LinkTopic       =   "Form1"
   ScaleHeight     =   4125
   ScaleWidth      =   5685
   StartUpPosition =   2  '屏幕中心
   Begin VB.ListBox List1 
      Height          =   2220
      Left            =   2415
      TabIndex        =   7
      Top             =   480
      Width           =   3255
   End
   Begin VB.FileListBox File1 
      Height          =   1890
      Left            =   0
      Pattern         =   "*.htm;*.html"
      TabIndex        =   6
      Top             =   2160
      Width           =   2415
   End
   Begin VB.DirListBox Dir1 
      Height          =   1350
      Left            =   0
      TabIndex        =   5
      Top             =   840
      Width           =   2415
   End
   Begin VB.DriveListBox Drive1 
      Height          =   300
      Left            =   0
      TabIndex        =   4
      Top             =   480
      Width           =   2415
   End
   Begin VB.CommandButton Command3 
      Caption         =   "返回"
      Height          =   375
      Left            =   4200
      TabIndex        =   2
      Top             =   3600
      Width           =   1215
   End
   Begin VB.CommandButton Command2 
      Caption         =   "转换"
      Height          =   375
      Left            =   2880
      TabIndex        =   1
      Top             =   3600
      Width           =   1215
   End
   Begin VB.Label Label2 
      Caption         =   "待转换的文件列表"
      Height          =   255
      Left            =   3000
      TabIndex        =   8
      Top             =   120
      Width           =   1575
   End
   Begin VB.Label Lblstatus 
      Height          =   615
      Left            =   2520
      TabIndex        =   3
      Top             =   2880
      Width           =   3135
   End
   Begin VB.Label Label1 
      Caption         =   "选择HTML文件"
      Height          =   255
      Left            =   240
      TabIndex        =   0
      Top             =   120
      Width           =   1215
   End
End
Attribute VB_Name = "Frmhtmtotxt"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Command2_Click()
    Dim i%
    If List1.List(0) = "" Then
        MsgBox "没有选择需要转换的文件！", , mymajor
    Else
        For i = 0 To List1.ListCount - 1
            StripText CStr(List1.List(i))
        Next i
    End If
    Screen.MousePointer = vbDefault
End SubPrivate Sub Command3_Click()
    Unload Me
End SubPrivate Sub Dir1_Change()
    File1.Path = Dir1.Path
End SubPrivate Sub Drive1_Change()
    On Error GoTo errorchu
    Dir1.Path = Drive1.drive
    Exit Sub
errorchu:
    MsgBox "设备不可用", vbExclamation, mymajor
End SubPrivate Sub File1_Click()
    Dim tmpfilename$, i%
    tmpfilename = folderfmat(Dir1.Path) & File1.Filename
    For i = 0 To List1.ListCount - 1
        If tmpfilename = List1.List(i) Then
            MsgBox "文件已被加入待转换列表！", , mymajor
            Exit Sub
        End If
    Next i
    List1.AddItem (tmpfilename)
End Sub
Private Sub File1_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
    Dim tmpfilename$, i%, j%, panduan As Boolean
    If Button = 2 Then
        For j = 0 To File1.ListCount - 1
            tmpfilename = folderfmat(Dir1.Path) & File1.List(j)
            panduan = False
            For i = 0 To List1.ListCount - 1
                If tmpfilename = List1.List(i) Then
                    MsgBox "文件已被加入待转换列表！", , mymajor
                    panduan = True
                    i = List1.ListCount
                End If
            Next i
            If panduan = False Then List1.AddItem (tmpfilename)
        Next j
    End If
End SubPrivate Sub Form_Load()
    Me.Caption = "HTML转换TXT -" & mymajor
    Frmhtmtotxt.Icon = LoadResPicture(101, 1)
End SubPrivate Sub List1_Click()
    List1.RemoveItem (List1.ListIndex)
End SubPrivate Sub Form_Unload(Cancel As Integer)
    jiancazuce
    Frmhhyset.Show
End SubSub StripText(Filename$)
    Dim f%, xiansi As Boolean, tebiehansu As Boolean
    Dim b() As Byte, c() As Byte
    Dim sourcefilelength&, i&, j&
    On Error GoTo Err_Handler
    Screen.MousePointer = 11
    
    f% = FreeFile
    sourcefilelength = FileLen(Filename$)
    ReDim c(1 To sourcefilelength)
    ReDim b(1 To sourcefilelength)
    Open Filename$ For Binary As #f%
    Get #f%, , b()
    Close #f%
    tebiehansu = False
    j = 1
    For i = 1 To sourcefilelength
        Select Case b(i)
            Case 60
                If i + 8 < sourcefilelength Then
                    If UCase(Chr(b(i + 1)) & Chr(b(i + 2)) & Chr(b(i + 3)) & Chr(b(i + 4)) & Chr(b(i + 5)) & Chr(b(i + 6)) & Chr(b(i + 7)) & Chr(b(i + 8))) = "/SCRIPT>" Then
                        xiansi = True
                        tebiehansu = False
                    End If
                End If
                If i + 6 < sourcefilelength Then
                    If UCase(Chr(b(i + 1)) & Chr(b(i + 2)) & Chr(b(i + 3)) & Chr(b(i + 4)) & Chr(b(i + 5)) & Chr(b(i + 6))) = "/HEAD>" Then
                        xiansi = True
                        j = 1
                        i = i + 6
                    End If
                    If UCase(Chr(b(i + 1)) & Chr(b(i + 2)) & Chr(b(i + 3)) & Chr(b(i + 4)) & Chr(b(i + 5)) & Chr(b(i + 6))) = "/STYLE" Then
                        xiansi = True
                        tebiehansu = False
                    End If
                    If UCase(Chr(b(i + 1)) & Chr(b(i + 2)) & Chr(b(i + 3)) & Chr(b(i + 4)) & Chr(b(i + 5)) & Chr(b(i + 6))) = "SCRIPT" Then
                        xiansi = False
                        tebiehansu = True
                    End If
                End If
                If i + 3 < sourcefilelength Then
                    If UCase(Chr(b(i + 1)) & Chr(b(i + 2)) & Chr(b(i + 3))) = "/P>" Or UCase(Chr(b(i + 1)) & Chr(b(i + 2)) & Chr(b(i + 3))) = "BR>" Then
                        c(j) = 13
                        c(j + 1) = 10
                        j = j + 2
                        i = i + 3
                        xiansi = True
                    Else
                        xiansi = False
                    End If
                Else
                    xiansi = False
                End If
                If i + 5 < sourcefilelength Then
                    If UCase(Chr(b(i + 1)) & Chr(b(i + 2)) & Chr(b(i + 3)) & Chr(b(i + 4)) & Chr(b(i + 5))) = "STYLE" Then
                        xiansi = False
                        tebiehansu = True
                    End If
                End If
            Case 62
                xiansi = True
            Case 13
                If b(i + 1) = 10 Then i = i + 1
            Case Else
                If xiansi = True And tebiehansu = False Then
                    c(j) = b(i)
                    j = j + 1
                End If
        End Select
    Next i
    ReDim Preserve c(1 To j - 1)
    f% = FreeFile
    Open Left$(Filename$, InStr(Filename$, ".")) & "TXT" For Binary As #f%
    Put #f%, , c()
    Close #f%
    Lblstatus.Caption = "成功转换了" & Filename$
    Exit Sub
    
Exit_Sub:
   Close #f%
   Screen.MousePointer = 0
   Exit Sub
Err_Handler:
   Lblstatus.Caption = "Error: " & Error$(Err)
End Sub

Answer 16

VB部分已经做成了一个工具软件：红钻1.1的一个模块，Delphi部分做成了红钻1.2的一个模块，但长度更长一些。

Answer 17

HTML 是 XML的子集，可以用DELPHI操作XML的的方法操作