Link to home
Start Free TrialLog in
Avatar of RickAtCanadadotcom
RickAtCanadadotcom

asked on

Editing text files with put-get

Hi,

I want to edit a text file and strip out blocks of code, but all I can do is create a new file. I don't want a new file, I want to edit the one I have.

VB6 has an example in dealing with records using Put and Get but is no good to me.

I want to go from this:
<html>
<script language="javascript" blah blah..
         code here
</script>
<script language="javascript" blah blah..
         more code here
</script>
<body>
   this is OK
</body>
</html>

To this:
<html>
<body>
   this is OK
</body>
</html>

This is my code:
Dim textline
Open "C:\test.htm" For Input As #1    ' Open file.
Do While Not EOF(1)    ' Loop until end of file.
    'Line Input #1, textline    ' Read the line.
    Line Input #1, textline  ' Read the line.
    If Left(Trim(textline), 7) = "<script" Then
        Line Input #1, textline
        ' keep skipping until you see the closing tag.
        Do While Left(Trim(textline), 8) <> "</script"
            Line Input #1, textline
        Loop
    ElseIf Left(Trim(textline), 10) = "<noscript>" Then
        Line Input #1, textline
        ' keep skipping untile you see the closing tag.
        Do While Left(Trim(textline), 11) <> "</noscript>"
            Line Input #1, textline
        Loop
    Else
        Debug.Print textline
    End If
Loop
Close #1    ' Close file.

Any direction would be much appreciated.
Avatar of supunr
supunr

how about using a RichTextbox to do the hardwork.  Here is a sample code.

Private Sub StripCode()
    Dim FileName As String
    Dim StartScriptAt As Long
    Dim EndScriptAt As Long
   
    With RichTextBox1
        FileName = "C:\Test.txt"
       
        .LoadFile FileName, rtfText
        StartScriptAt = 0
       
        Do
            StartScriptAt = .Find("<script")
            If (StartScriptAt <= 0) Then Exit Do
            EndScriptAt = .Find("</script")
            ' end script command not found, delete till end of the file
            If (EndScriptAt <= 0) Then
                EndScriptAt = Len(.Text)
            End If
            .SelStart = StartScriptAt
            .SelLength = EndScriptAt - StartScriptAt + 8
            .SelText = 0
        Loop
       
        .SaveFile FileName, rtfText
    End With
End Sub

Good Luck!
little modification to your program....

Dim textline as string
Dim ignoreLines as boolean

Open "C:\test.htm" For Input As #1    ' Open file.
ignoreLines = false
Do While Not EOF(1)    ' Loop until end of file.
ReadNextLine:
   Line Input #1, textline  ' Read the line.
   If (LCase(Left(Trim(textline), 7)) = "<script") Then
       ignoreLines = true
   Elseif (LCase(Left(Trim(textline), 8)) = "</script") then
       ignoreLines = false
   ElseIf (LCase(Left(Trim(textline), 10)) = "<noscript>") Then
       goto ReadNextLine
   ElseIf (LCase(Left(Trim(textline), 10)) = "</noscript>") Then
       goto ReadNextLine
   End If
   if (Not ignoreLines)
      debug.Print textLine
   end if
Loop
Close #1    ' Close file.
again....

Private Sub RemoveCodes(FileName as String)
    On Error goto RemErr
    Dim textline As String
    Dim ignoreLines As Boolean
   
'    Open "C:\test.htm" For Input As #1    ' Open file.
    Open FileName For Input As #1    ' Open file.

    ignoreLines = False
    Do While Not EOF(1)    ' Loop until end of file.
ReadNextLine:
        Line Input #1, textline  ' Read the line.
        If (LCase(Left(Trim(textline), 7)) = "<script") Then
            ignoreLines = True
            GoTo ReadNextLine
        ElseIf (LCase(Left(Trim(textline), 8)) = "</script") Then
            ignoreLines = False
            GoTo ReadNextLine
        ElseIf (LCase(Left(Trim(textline), 10)) = "<noscript>") Then
            GoTo ReadNextLine
        ElseIf (LCase(Left(Trim(textline), 10)) = "</noscript>") Then
            GoTo ReadNextLine
        End If
        If (Not ignoreLines) Then
            Debug.Print textline
        End If
    Loop
    Close #1    ' Close file.
    Exit Sub

RemErr:
    msgbox Err.Number & ": " & err.Description
    Reset ' close any open files
    On Error goto 0
End Sub

Good Luck!
ASKER CERTIFIED SOLUTION
Avatar of robertlees
robertlees

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
K, I got your question now....another updated version....

Private Sub RemoveCodes(FileName as String)
   On Error goto RemErr
   Dim textline As String
   Dim ignoreLines As Boolean
   
'    Open "C:\test.htm" For Input As #1    ' Open file.
   Open FileName For Input As #1    ' Open file.
   Open FileName & ".Bak" For Output As #2    ' Open file.

   ignoreLines = False
   Do While Not EOF(1)    ' Loop until end of file.
ReadNextLine:
       Line Input #1, textline  ' Read the line.
       If (LCase(Left(Trim(textline), 7)) = "<script") Then
           ignoreLines = True
           GoTo ReadNextLine
       ElseIf (LCase(Left(Trim(textline), 8)) = "</script") Then
           ignoreLines = False
           GoTo ReadNextLine
       ElseIf (LCase(Left(Trim(textline), 10)) = "<noscript>") Then
           GoTo ReadNextLine
       ElseIf (LCase(Left(Trim(textline), 10)) = "</noscript>") Then
           GoTo ReadNextLine
       End If
       If (Not ignoreLines) Then
           Print #2, textline
       End If
   Loop
   Close #1    ' Close file.
   Close #2    ' Close file.
   if (Dir(FileName & ".bak") <> "") then
       Kill FileName
       Name FileName & ".bak" As FileName
   end if

   Exit Sub

RemErr:
   msgbox Err.Number & ": " & err.Description
   Reset ' close any open files
   On Error goto 0
End Sub