striptxt.bas

又一个将HTML文件转换成文本文件的程序

Option Explicit

Sub Main ()
   
   ' If a command line file was specified, we open that file
   ' and strip it instead of showing the dialog
   If Command$ <> "" Then
      If FileExists%(Command$) Then
         frmMain.Show
         StripText Command$
         End
      Else
         Beep
         MsgBox "File not found: " & Command$
      End If
      End
   Else
      frmMain.Show
      ' Start the browser automatically
      frmMain!cmdBrowse.Value = True
   End If

End Sub

Sub StripText (Filename$)

' Description
'     Removes any HTML-format tags from a file, preserving the text
'
' Parameters
'     Name                 Type     Value
'     ------------------------------------------------------------------------
'     Filename$            String   The file where the tags are to be removed
'
' Returns
'     Nothing
'
' Last updated by Jens Balchen 21.11.95



Dim f%, ff%, t$
Dim percent&, total&
Dim is_tag%, write2file$, i%

   On Error GoTo Err_Handler

   ' Opens the file, reads the data and saves the lines
   ' that are text.

   ' Set the mousepointer to hourglass
   Screen.MousePointer = 11

   ' Get a free file handle
   f% = FreeFile
   ' Open the HTML file in read mode
   Open Filename$ For Input As #f%
   ' Get a free file handle
   ff% = FreeFile
   ' Open the output file name, which is the old filename
   ' + "txt"
   Open Left$(Filename$, InStr(Filename$, ".")) & "TXT" For Output As #ff%
      ' Find the total number of bytes to read
      total& = LOF(f%)
      ' Loop through the entire file
      Do While Not EOF(f%)
         ' Read one line
         Line Input #f%, t$
         ' Count the number of bytes read (including CR + LF)
         percent& = percent& + Len(t$) + 2
         ' Calculate the percent and show it in the status label
         If CInt(percent& * 100 / total&) Mod 10 = 0 Then
            frmMain!lblStatus = "Reading " & CInt(percent& * 100 / total&) & "%"
            ' Refresh it to make it update on the screen
            frmMain!lblStatus.Refresh
         End If
         ' Now scan the entire string to find the "<"'s and the ">"'s.
         write2file$ = ""
         For i% = 1 To Len(t$)
            Select Case Mid$(t$, i%, 1)
               Case "<"
                  is_tag% = True
               Case ">"
                  is_tag% = False
               Case Else
                  If Not is_tag% Then write2file$ = write2file$ & Mid$(t$, i%, 1)
            End Select
         Next
         ' Write the line to the file
         Print #ff%, write2file$
      ' Next line
      Loop
   ' Update label with status
   frmMain!lblStatus = "Wrote " & Left$(Filename$, InStr(Filename$, ".")) & "TXT"

Exit_Sub:
   ' CLose both file
   Close #f%
   Close #ff%
   ' Reset mousepointer
   Screen.MousePointer = 0
   ' Exit
   Exit Sub

Err_Handler:
   ' if there was an error, display it in the status
   ' label
   frmMain!lblStatus = "Error: " & Error$(Err)
   ' Then exit
   Resume Exit_Sub

End Sub