[RESOLVED] using FSO to delete a specific line in a textfile

[Adebiyi24]

I always use this function to delete a specific line in a textfile by means of FileSystemObject:
I want to use c.FSO of RC6 to do the same thing.
Can an expert tell me how to do?
I tried on my own but I was unable to do so.

Function DeleteLine(strFile, strKey, LineNumber, CheckCase)

    Const ForReading = 1
    Const ForWriting = 2

    Dim objFSO, objFile, Count, strLine, strLineCase, strNewFile

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.OpenTextFile(strFile, ForReading)

    Do Until objFile.AtEndOfStream
       strLine = objFile.ReadLine

       If CheckCase = 0 Then strLineCase = UCase(strLine): strKey = UCase(strKey)
       If LineNumber = objFile.Line - 1 Or LineNumber = 0 Then
          If InStr(strLine, strKey) Or InStr(strLineCase, strKey) Or strKey = "" Then
             strNewFile = strNewFile
          Else
             strNewFile = strNewFile & strLine & vbCrLf
          End If
       Else
          strNewFile = strNewFile & strLine & vbCrLf
       End If

    Loop
    objFile.Close

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.OpenTextFile(strFile, ForWriting)

    objFile.Write strNewFile
    objFile.Close
 End Function

DeleteLine Mypath & "\Myfile.txt", lvw.ListItems.Item(i), 0, 0

[dz32]

Do you mean to do it with only native vb functions?

Fso = filesystemobject which you are already using.

[BenJones]

Whould it not be simple to store the text file into a string array then delete the array element and write back to the file. or just loop tho the text file and only write the stuff that does not match the index to delete. that how I whould do it. just an idea

just come accross this link duno if it helps.
https://stackoverflow.com/questions/...he-line-number

[Adebiyi24]

Do you mean to do it with only native vb functions?

Fso = filesystemobject which you are already using.

Sorry I missed this point

I don't want to make reference to Microsoft scripting runtime

I 'm using RC6.

i tried this doesn't but it seem not supported.

New_c.FSO.OpenTextFile(strFile, ForReading)

[Adebiyi24]

Whould it not be simple to store the text file into a string array then delete the array element and write back to the file. or just loop tho the text file and only write the stuff that does not match the index to delete. that how I whould do it. just an idea

just come accross this link duno if it helps.
https://stackoverflow.com/questions/...he-line-number

Thank you
I think the code in the the link is looking for a specific line and delete it.
My case is looking for a string then delete the line which include this string.

[BenJones]

Thank you
I think the code in the the link is looking for a specific line and delete it.
My case is looking for a string then delete the line which include this string.

Then check the line for the string and delete the line with the above code or the other way I said.

[Adebiyi24]

Then check the line for the string and delete the line with the above code or the other way I said.

I want to use RC6 which seems incompatible with the code above













i

[BenJones]

what about this https://stackoverflow.com/questions/...ns-some-string

[dz32]

you can just use the native vb file functions

 'deletes line number X if it contains optional strkey. optionally can be case specific
 'returns -1 for error, 0 for not found, 1 if deleted
 'line numbers are 0 based
 'make sure line endings are CR LF
 Function DeleteLine(fpath As String, LineNumber As Long, Optional strKey As String, Optional CheckCase As Boolean = False) As Long
    
    On Error GoTo hell
    
    Dim f As Long, f2 As Long, i As Long, tmp As String, sLine As String
    Dim deletes As Long, t As VbCompareMethod
    
    If Dir(fpath) = "" Then GoTo hell

    t = IIf(CheckCase, vbBinaryCompare, vbTextCompare)
    
    tmp = Environ("temp") & "\" & Int(Rnd() * 9 + 1) & Int(Rnd() * 9 + 1) & Int(Rnd() * 9 + 1) & Int(Rnd() * 9 + 1) & ".txt"
    If Dir(tmp) <> "" Then Kill tmp
    Debug.Print "tmp: " & tmp
    
    f = FreeFile
    Open fpath For Input As f
    
    f2 = FreeFile
    Open tmp For Output As f2
    
    Do While Not EOF(f)
      
       Line Input #f, sLine

       If LineNumber = i Then
          If Len(strKey) = 0 Then
            'line hit, no key specified always delete
            deletes = deletes + 1
          ElseIf InStr(1, sLine, strKey, t) > 0 Then
            'line hit, and contains specified key
            deletes = deletes + 1
          Else
             Print #f2, sLine
          End If
      Else
          Print #f2, sLine
      End If

       i = i + 1 '0 based line numbers
    Loop
    
    Close f
    Close f2
    
    If deletes > 0 Then
        Kill fpath
        Name tmp As fpath
    End If
    
    Kill tmp
    DeleteLine = deletes
    
    Exit Function
    
hell:
    On Error Resume Next
    Close f
    Close f2
    DeleteLine = -1
    
End Function
 
Private Sub Form_Load()
    
    Dim f As Long, tmp As String, n As Long, data As String
    
    f = FreeFile
    tmp = Environ("temp") & "\test.txt"
    If Dir(tmp) <> "" Then Kill tmp
    
    Open tmp For Output As f
    Print #f, Replace("the\nwolf\nate\na\nfat\nsmall\nchild\nin\nthe\nwoods", "\n", vbCrLf)
    Close f
    
    n = DeleteLine(tmp, 4) 'fat
    Debug.Print n
    
    n = DeleteLine(tmp, 4, "SMALL", False)
    Debug.Print n
    
    f = FreeFile
    Open tmp For Binary As #f
    data = Input(FileLen(tmp), #f) ' Get entire Files data
    Close #f
    
    Kill tmp
    Debug.Print "data: " & vbCrLf & data
    
    End
    
End Sub

[Adebiyi24]

you can just use the native vb file functions

 'deletes line number X if it contains optional strkey. optionally can be case specific
 'returns -1 for error, 0 for not found, 1 if deleted
 'line numbers are 0 based
 'make sure line endings are CR LF
 Function DeleteLine(fpath As String, LineNumber As Long, Optional strKey As String, Optional CheckCase As Boolean = False) As Long
    
    On Error GoTo hell
    
    Dim f As Long, f2 As Long, i As Long, tmp As String, sLine As String
    Dim deletes As Long, t As VbCompareMethod
    
    If Dir(fpath) = "" Then GoTo hell

    t = IIf(CheckCase, vbBinaryCompare, vbTextCompare)
    
    tmp = Environ("temp") & "\" & Int(Rnd() * 9 + 1) & Int(Rnd() * 9 + 1) & Int(Rnd() * 9 + 1) & Int(Rnd() * 9 + 1) & ".txt"
    If Dir(tmp) <> "" Then Kill tmp
    Debug.Print "tmp: " & tmp
    
    f = FreeFile
    Open fpath For Input As f
    
    f2 = FreeFile
    Open tmp For Output As f2
    
    Do While Not EOF(f)
      
       Line Input #f, sLine

       If LineNumber = i Then
          If Len(strKey) = 0 Then
            'line hit, no key specified always delete
            deletes = deletes + 1
          ElseIf InStr(1, sLine, strKey, t) > 0 Then
            'line hit, and contains specified key
            deletes = deletes + 1
          Else
             Print #f2, sLine
          End If
      Else
          Print #f2, sLine
      End If

       i = i + 1 '0 based line numbers
    Loop
    
    Close f
    Close f2
    
    If deletes > 0 Then
        Kill fpath
        Name tmp As fpath
    End If
    
    Kill tmp
    DeleteLine = deletes
    
    Exit Function
    
hell:
    On Error Resume Next
    Close f
    Close f2
    DeleteLine = -1
    
End Function
 
Private Sub Form_Load()
    
    Dim f As Long, tmp As String, n As Long, data As String
    
    f = FreeFile
    tmp = Environ("temp") & "\test.txt"
    If Dir(tmp) <> "" Then Kill tmp
    
    Open tmp For Output As f
    Print #f, Replace("the\nwolf\nate\na\nfat\nsmall\nchild\nin\nthe\nwoods", "\n", vbCrLf)
    Close f
    
    n = DeleteLine(tmp, 4) 'fat
    Debug.Print n
    
    n = DeleteLine(tmp, 4, "SMALL", False)
    Debug.Print n
    
    f = FreeFile
    Open tmp For Binary As #f
    data = Input(FileLen(tmp), #f) ' Get entire Files data
    Close #f
    
    Kill tmp
    Debug.Print "data: " & vbCrLf & data
    
    End
    
End Sub

thank you very much
your code is working perfect
However by curiosity I want an expert of RC6 to show me how to do the task with RC6

[ahenry]

thank you very much
your code is working perfect
However by curiosity I want an expert of RC6 to show me how to do the task with RC6

Yes, Olaf writes great code, and we'd all love for him to write snippets for us on demand.

Anyhow, for the equivalent of your original function, you'd want something like:

    Dim fs As cFSO
    Dim output As New cStringBuilder
    Dim sFileContents As String
    Dim varLines As Variant
    Dim i As Integer

    Set fs = New_c.FSO
    sFileContents = fs.ReadTextContent(strFile)
    varLines = Split(sFileContents, vbCrLf)
    For i = 0 To UBound(varLines)
        ' Do your line analysis here
        output.Add varLines(i) & vbCrLf
    Next
    fs.WriteTextContent strFile, output.ToString

[VBClassic04]

Or u could just use the api method:

Option Explicit
Private Const EM_REPLACESEL As Long = &HC2
Private Const EM_SETSEL As Long = &HB1
Private Const EM_LINELENGTH As Long = &HC1
Private Const EM_LINEINDEX As Long = &HBB
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Sub Form_Load() 'Text1 is a multiline textbox
 Text1.Text = "First Line" & vbCrLf & "Line2000000" & vbCrLf & "ThirdLine" & vbCrLf & "Line4"
 
 DeleteLine 0    'Zero Based
End Sub

Sub DeleteLine(nLine As Long) 'nLine is zero based
 Dim lStart As Long
 Dim lEnd   As Long
 Dim sTemp  As String
 lStart = SendMessage(Text1.hWnd, EM_LINEINDEX, nLine, 0)
 lEnd = lStart + SendMessage(Text1.hWnd, EM_LINELENGTH, lStart, 0&)
 'Highlight nLine
 SendMessage Text1.hWnd, EM_SETSEL, lStart, ByVal lEnd + 2 '+2 for crlf
 'Replace Selection With Empty String STemp
 SendMessage Text1.hWnd, EM_REPLACESEL, True, StrPtr(sTemp)
 'Unselect all
 SendMessage Text1.hWnd, EM_SETSEL, 0&, ByVal 0&
End Sub

[Schmidt]

Yes, Olaf writes great code, and we'd all love for him to write snippets for us on demand.

Anyhow, for the equivalent of your original function, you'd want something like:

    Dim fs As cFSO
    Dim output As New cStringBuilder
    Dim sFileContents As String
    Dim varLines As Variant
    Dim i As Integer

    Set fs = New_c.FSO
    sFileContents = fs.ReadTextContent(strFile)
    varLines = Split(sFileContents, vbCrLf)
    For i = 0 To UBound(varLines)
        ' Do your line analysis here
        output.Add varLines(i) & vbCrLf
    Next
    fs.WriteTextContent strFile, output.ToString

Thanks for helping out...

@Adebiyi24
Based on the above...
A bit less memory-intensive version (with less procedure-locale vars) -
can be achieved with a procedure-local variable of: aOut As cArrayList (which supports "in-between-removal"):

Private Sub Form_Load() 'usage-Demo
  Const sFile$ = "c:\temp\some_lines.txt"
  
  New_c.FSO.WriteTextContent sFile, Replace("aa bb c4 dd", " ", vbCrLf) 'write a 4-line test-file
      RemoveLinesIn sFile, "C4"
  Debug.Print New_c.FSO.ReadTextContent(sFile) 'test, what's now "on disk" (in sFile)
End Sub

Sub RemoveLinesIn(sFile$, sFind$, Optional ByVal CmpMode As VbCompareMethod = 1)
    Dim aOut As cArrayList
    Set aOut = New_c.ArrayList(vbString)
        aOut.AddElements Split(New_c.FSO.ReadTextContent(sFile), vbCrLf) 'fill aOut "in one go" from a (split) String-Array
     
    Dim i As Long 'move backwards through the array, to avoid index-collisions after (potential) removal
    For i = aOut.Count - 1 To 0 Step -1
        If InStr(1, aOut(i), sFind, CmpMode) Then aOut.Remove i
    Next
    New_c.FSO.WriteTextContent sFile, aOut.Join(vbCrLf) 'write the "joined-back" lines back into the file
End Sub

The above If-condition (inside the backwards-array-loop) is somewhat simplified (compared to your original demands) -
but you get the idea, I think...

Still wondering though, why you're not using a little SQLite-DBFile(Table) for stuff like that.
(which would allow a "Delete From Table Where <your condition>"-command, to make this a "one-liner").

Olaf

[Adebiyi24]

Thank you Olaf
thank you all of you
solved