• Home
 · 
• Files/File Controls/Input/Output
 · 
• File I/O using API calls

File I/O using API calls

File I/O using API calls

Rate File I/O using API calls

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

'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