File I/O Snippets

[plenderj]

Code Snippets.
All 100% mine. Waha :)

Give me a mention if you use the code ...



' Clear the contents of a file
'
Private Sub clearFile(ByVal strPath As String)
If Not Len(Dir(strPath)) = 0 Then
Open strPath For Output As #1
Close #1
End If
End Sub

' Is a given string contained within a given file ?
'
Private Function isStringInFile(ByVal strString As String, ByVal strFile As String) As Boolean
isStringInFile = InStr(returnContents(strFile), strString) <> 0
End Function

' Delete a specific line from a file (note: first line = line number 0)
'
Private Sub deleteLine(ByVal strFile As String, ByVal lineNumber As Long)
Dim strArrBuff() As String, i As Long
Open strFile For Input As #1
strArrBuff() = Split(input(LOF(1), 1), vbCrLf)
Close #1
Open strFile For Output As #1
For i = 0 To UBound(strArrBuff)
If Not i = lineNumber Then Print #1, strArrBuff(i)
Next
Close #1
End Sub

' Return a specific line number from a file (note: first line = line number 0)
'
Private Function getLine(ByVal strFile As String, ByVal lineNumber As Long) As String
Open strFile For Input As #1
getLine = Split(input(LOF(1), 1), vbCrLf)(lineNumber)
Close #1
End Function

' Append a line to the end of a file
'
Private Sub appendLine(ByVal strFile As String, ByVal strLineOfText As String)
Open strFile For Append As #1
Print #1, strLineOfText
Close #1
End Sub

' Insert a line of text in a file
'
Private Sub insertLine(ByVal strFile As String, ByVal lineNumber As Long, ByVal strLineOfText As String)
Dim strBuff() As String: strBuff = Split(returnContents(strFile), vbCrLf)
Dim i As Long
Open strFile For Output As #1
For i = 0 To UBound(strBuff)
If i = lineNumber Then Print #1, strLineOfText
Print #1, strBuff(i)
Next
Close #1
End Sub

' Insert a string of text in a file
'
Private Sub insertString(ByVal strFile As String, ByVal writePosition As Long, ByVal strStringOfText As String)
Dim strBuff As String: strBuff = returnContents(strFile)
Open strFile For Output As #1
Print #1, Left(strBuff, writePosition) & strStringOfText & Mid(strBuff, writePosition)
Close #1
End Sub

' Return the contents of a file
'
Private Function returnContents(ByVal strFile As String) As String
Open strFile For Input As #1
returnContents = input(LOF(1), 1)
Close #1
End Function

' Return the path of a given full path to a file
'
Private Function returnPathOfFile(ByVal strFile As String) As String
returnPathOfFile = Left(strFile, InStrRev(strFile, "\"))
End Function

' Return the filename of a given full path to a file
'
Private Function returnNameOfFile(ByVal strFile As String) As String
returnNameOfFile = Mid(strFile, InStrRev(strFile, "\") + 1)
End Function

' Split a file up into n byte chunks
'
Private Sub splitUpFile(ByVal strFile As String, ByVal nByteSize As Long)
Dim strBuff As String: strBuff = returnContents(strFile)
Dim currPos As Long, endPos As Long: currPos = 1: endPos = Len(strBuff)
Dim fileNumber As Long
While currPos <= endPos
Open Left(strFile, InStrRev(strFile, ".") - 1) & "(" & fileNumber & ")" & Mid(strFile, InStrRev(strFile, ".")) For Output As #1
If (currPos + nByteSize) > endPos Then
Print #1, Mid(strBuff, currPos)
Else
Print #1, Mid(strBuff, currPos, nByteSize)
End If
Close #1
fileNumber = fileNumber + 1
currPos = currPos + nByteSize
Wend
End Sub

' Merge a number of source files into a destination file
'
Private Sub mergeFiles(ByVal strDestinationFile As String, ParamArray strSourceFiles())
Dim i As Long, strBuff As String
Open strDestinationFile For Output As #1
For i = 0 To UBound(strSourceFiles)
Print #1, ""
Print #1, "***"
Print #1, "*** " & strSourceFiles(i)
Print #1, "***"
Print #1, returnContents(strSourceFiles(i))
Next
Close #1
End Sub

[plenderj]

Some much needed updates :) I suggest you use the following snippets in place of some of the ones above.
This is because if you open a Binary file using the Input mode, it will nearly certainly fail once it hits binary characters.
But if you open for Binary, and use the different input procedure, then you can open both text and binary files.

Using the Get, , #FileNumber is also very fast!



' Return a specific line number from a file (note: first line = line number 0)
'
Private Function getLine(ByVal strFile As String, ByVal lineNumber As Long) As String
Dim strBuff As String
Open strFile For Binary As #1
strBuff = Space(Lof(1))
Get #1, , strBuff
getLine = Split(strBuff, vbCrLf)(lineNumber)
Close #1
End Function

' Return a specific line number from a file (note: first line = line number 0) - a neater version.
'
Private Function getLine(ByVal strFile As String, ByVal lineNumber As Long) As String
getLine = Split(returnContents(strFile), vbCrLf)(lineNumber)
End Function


' Delete a specific line from a file (note: first line = line number 0)
'
Private Sub deleteLine(ByVal strFile As String, ByVal lineNumber As Long)
Dim strArrBuff() As String, i As Long, strFileContent As String
strArrBuff() = Split(returnContents(strFile), vbCrLf)
strArrBuff(lineNumber) = vbNullString
Open strFile For Output As #1
Print #1, Join(strArrBuff, vbCrLf);
Close #1
End Sub


' Return the contents of a file
'
Private Function returnContents(ByVal strFile As String) As String
Dim strBuff As String
Open strFile For Binary As #1
strBuff = Space(Lof(1))
Get #1, , strBuff
returnContents = strBuff
Close #1
End Function

[plenderj]

* 21-October-2004 - Moved to CodeBank *