by Waty Thierry (60 Submissions)
Category: Files/File Controls/Input/Output
Compatability: Visual Basic 4.0 (32-bit)
Difficulty: Unknown Difficulty
Originally Published: Tue 13th April 1999
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
File I/O using API calls
VBcoders
'Reads input from the file
Declare Function ReadFile Lib "kernel32" _
(ByVal hFile As Long, lpBuffer As Any, _
ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, _
ByVal lpOverlapped As Long) As Long
'Closes the file
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'Outputs to the file
Private Declare Function WriteFile Lib "kernel32" _
(ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, _
lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
'Opens the file (grabs a file handle)
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
(ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long
'Output the data on hold to the file
Declare Function FlushFileBuffers Lib "kernel32" _
(ByVal hFile As Long) As Long
'Find out how big the file is
Declare Function GetFileSize Lib "kernel32" _
(ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Const GENERIC_WRITE = &H40000000
Const GENERIC_READ = &H80000000
Const FILE_ATTRIBUTE_NORMAL = &H80
Const CREATE_ALWAYS = 2
Const OPEN_ALWAYS = 4
Const INVALID_HANDLE_VALUE = -1
'This array type must be used to print and read to the file
Type FileString
Value As Integer
End Type
Private minFileCount As Integer 'Number of files open
Private mblFileInput() As Boolean 'If the file has been read in yet
Private mlgFileCursor() As Long 'The current position of the cursor in the file
Private mlgFileHandles() As Long 'List of file handles opened
Private mstFileData() As String 'Data inputted from a file
'----------
'Main: Main code startup
'----------
Public Sub Main()
On Error GoTo ErrorHandler
Dim linFile As Integer 'File number to reference file
Dim lstInput As String 'Input from file
'Grab a file number using a function to simplify the API call
linFile = OpenFile("C:\Filename.txt")
If linFile = -1 Then Err.Raise 1234, , "OpenFile failed"
'Print text to the file
PrintLine linFile, "Hello World"
'Close the file
If CloseFile(linFile) = -1 Then Err.Raise 1234, , "CloseFile failed"
'Open the file
linFile = OpenFile("C:\Filename.txt")
If linFile = -1 Then Err.Raise 1234, , "OpenFile failed"
'Input the text from the file
InputLine linFile, lstInput
'Close the file
If CloseFile(linFile) = -1 Then Err.Raise 1234, , "CloseFile failed"
Exit Sub
ErrorHandler:
App.LogEvent "modMain.CECMain():" & Err.Description & ":" & Err.Number, 1
Err.Clear
End Sub
'----------
'PrintLine: Output text to a file
'----------
Private Sub PrintLine(ByVal inFile As Integer, ByVal stOutput As String)
On Error GoTo ErrorHandler
Dim x As Integer 'Iterative
Dim linLen As Integer 'Length of string
Dim llgFileHandle As Long 'File Handle to reference file by
Dim llgSuccess As Long 'If the Write was successful
Dim llgBytesWritten As Long 'Number of bytes written
Dim llgBytesToWrite As Long 'Length of string
Dim lfsOut() As FileString 'ASCII Chars to output
'Check for valid filename
If Not ((inFile > 0) And (inFile <= minFileCount)) Then
Err.Raise 123, , "Bad File Number"
End If
'Convert the string to an array of character #s
linLen = Len(stOutput)
ReDim lfsOut(linLen + 1)
For x = 1 To linLen
lfsOut(x - 1).Value = Asc(Mid$(stOutput, x, 1))
Next x
'Append Carriage Return + Line Feed
lfsOut(linLen).Value = Asc(vbCr)
lfsOut(linLen + 1).Value = Asc(vbLf)
'Get the number of bytes to write
llgBytesToWrite = (UBound(lfsOut) + 1) * LenB(lfsOut(0))
'Grab the file handle
llgFileHandle = mlgFileHandles(inFile - 1)
'Write the data to the file
llgSuccess = WriteFile(llgFileHandle, lfsOut(LBound(lfsOut)), _
llgBytesToWrite, llgBytesWritten, 0)
Exit Sub
ErrorHandler:
App.LogEvent "modMain.PrintLine(" & inFile & "," & stOutput & "):" & Err.Description & ":" & Err.Number, 1
Err.Clear
End Sub
'----------
'OpenFile: Open a file and store the File Handle
'----------
Private Function OpenFile(ByVal stFileName As String) As Integer
On Error GoTo ErrorHandler
Dim linFile As Integer 'File number
Dim x As Integer 'Iterative variable
Dim llgFile As Long 'File Handle
'Open the file
llgFile = CreateFile(stFileName, GENERIC_WRITE Or GENERIC_READ, _
0, 0, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
'If the file handle is valid
If llgFile <> -1 Then
'Look to see if there are empty spaces in the file list
For x = 1 To minFileCount - 1
If mlgFileHandles(x) = 0 Then
linFile = x
Exit For
End If
Next x
'If there are empty spaces then fill one
If linFile = 0 Then linFile = minFileCount
'If no empty spaces then make a new one
If linFile = minFileCount Then
ReDim Preserve mlgFileHandles(linFile)
ReDim Preserve mblFileInput(linFile)
ReDim Preserve mstFileData(linFile)
ReDim Preserve mlgFileCursor(linFile)
End If
mlgFileHandles(linFile) = llgFile
'Increment the counter
If linFile = minFileCount Then minFileCount = minFileCount + 1
linFile = linFile + 1
Else
linFile = -1
End If
OpenFile = linFile
'
Exit Function
ErrorHandler:
App.LogEvent "modMain.OpenFile(" & stFileName & "):" & Err.Description & ":" & Err.Number, 1
Err.Clear
End Function
'----------
'CloseFile: Close a file and free up the file handle
'----------
Private Function CloseFile(ByVal inFile As Integer) As Integer
On Error GoTo ErrorHandler
Dim llgFile As Long 'File Handle
Dim llgResult As Long 'Result of operations
llgFile = mlgFileHandles(inFile - 1)
'Flush the file buffers to force writing of the data.
llgResult = FlushFileBuffers(llgFile)
'Close the file.
llgResult = CloseHandle(llgFile)
mlgFileHandles(inFile - 1) = 0
mblFileInput(inFile - 1) = False
mstFileData(inFile - 1) = ""
mlgFileCursor(inFile - 1) = 0
'If it is the last file in the list take back the arrays 1
If (inFile = minFileCount) Then
minFileCount = minFileCount - 1
If inFile <> 1 Then
ReDim Preserve mlgFileHandles(minFileCount - 1)
ReDim Preserve mblFileInput(minFileCount - 1)
ReDim Preserve mstFileData(minFileCount - 1)
ReDim Preserve mlgFileCursor(minFileCount - 1)
End If
End If
Exit Function
ErrorHandler:
App.LogEvent "modMain.CloseFile(" & inFile & "):" & Err.Description & ":" & Err.Number, 1
Err.Clear
End Function
'----------
'InputLine: Input a line of text from a file
'----------
Public Sub InputLine(ByVal inFile As Integer, stInput As String)
On Error GoTo ErrorHandler
Dim lblCr As Boolean 'A Carriage return was found
Dim lblLf As Boolean 'A Line feed was found
Dim x As Integer 'Iterative variable
Dim llgCursor As Long 'Current cursor position in file
Dim lstChar As String 'Current character at current position
Dim lstFile As String 'File string inputted
'Empty the inputted string
stInput = ""
'Read in the entire file if it hasn't already been done
If Not (mblFileInput(inFile - 1)) Then
InputFile inFile
End If
'If the file read didn't take, error out.
If Not (mblFileInput(inFile - 1)) Then Err.Raise 123, , "File Input Failed"
'Set up the positioning variables
llgCursor = mlgFileCursor(inFile - 1)
lstFile = mstFileData(inFile - 1)
If llgCursor = 0 Then llgCursor = 1
'Read in until a vbCrLf is found
For x = llgCursor To Len(lstFile)
lstChar = Mid$(lstFile, x, 1)
Select Case lstChar
Case vbCr: lblCr = True
Case vbLf: lblLf = True
Case Else: lblCr = False: lblLf = False
End Select
If lblCr And lblLf Then
Exit For
ElseIf Not (lblCr Or lblLf) Then
stInput = stInput & lstChar
End If
Next x
'Save the cursor for next time
mlgFileCursor(inFile - 1) = x
Exit Sub
ErrorHandler:
App.LogEvent "modMain.InputLine(" & inFile & "," & stInput & "):" & Err.Description & ":" & Err.Number, 1
Err.Clear
End Sub
'----------
'PrintLine: Output text to a file
'----------
Private Sub InputFile(ByVal inFile As Integer)
On Error GoTo ErrorHandler
Dim x As Integer 'Iterative variable
Dim y As Integer 'Iterative variable
Dim z As Integer 'Iterative variable
Dim llgFile As Long 'File Handle
Dim llgSizeHigh As Long 'Biggest file size??
Dim llgSuccess As Long 'If operation was successful = 1
Dim llgBytesRead As Long 'Number of bytes read successfully
Dim llgBytesToRead As Long 'Number of bytes to read from the file
Dim lstChar1 As String 'Character1 if 2 chars were read in
Dim lstChar2 As String 'Character2 if 2 chars were read in
Dim lstFile As String 'Entire file string
Dim lfsIn() As FileString 'File character # input array
'Grab the file handle from the list
llgFile = mlgFileHandles(inFile - 1)
'Find out how big the file is
llgBytesToRead = GetFileSize(llgFile, llgSizeHigh)
'Set the array up to read that many bytes
ReDim lfsIn(llgBytesToRead)
'Read in all the data in the file
llgSuccess = ReadFile(llgFile, lfsIn(LBound(lfsIn)), _
llgBytesToRead, llgBytesRead, 0)
'Make sure it's not empty
y = lfsIn(0).Value
'Loop through and get all the data
While (y <> 0) And (x <= UBound(lfsIn))
y = lfsIn(x).Value
'If 2 chars were read in, y = char1 + char2
'char1 = Chr#, char2 = Chr#*256
If y > 256 Then
'Figure out what the second character is
For z = 1 To 256
If y < (z * 256) Then
lstChar1 = y - ((z - 1) * 256)
lstChar2 = (y - lstChar1) / 256
lstFile = lstFile & Chr(lstChar1) & Chr(lstChar2)
Exit For
End If
Next z
'If 1 char was read in, y = Chr#
ElseIf y > 0 Then
lstFile = lstFile & Chr(y)
End If
x = x + 1
Wend
'If it was all successful then save the file data in the module variables
If llgSuccess = 1 Then
mstFileData(inFile - 1) = lstFile
mblFileInput(inFile - 1) = True
End If
Exit Sub
ErrorHandler:
App.LogEvent "modMain.InputFile(" & inFile & "):" & Err.Description & ":" & Err.Number, 1
Err.Clear
End Sub
