'Codigo de I/O utilizando API Option Explicit '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 'Desde cualquier parte del programa: 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