• Home
 · 
• Windows API Call/Explanation
 · 
• File I/O using API calls

File I/O using API calls

File I/O using API calls

API Declarations



'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




Rate File I/O using API calls

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

'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