使用API进行文件读写——CreateFile,ReadFile,WriteFile等

原文：

simple and easy——API文件读写类

http://www.vbgood.com/thread-102870-1-1.html

 

看了这个帖子： http://www.vbgood.com/thread-99249-1-1.html 就写了一个使用API读写文件的简单类，苦力活。 演示代码在附件里。 '*********************************** 'Written by D.L. ' '2011/04/04 '*********************************** Option Explicit 'Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long 'Private Type SECURITY_ATTRIBUTES ' nLength As Long ' lpSecurityDescriptor As Long ' bInheritHandle As Long 'End Type 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 Private Declare Function ReadFile Lib "kernel32.dll" (ByVal hFile As Long, ByRef lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, ByRef lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long Private Declare Function WriteFile Lib "kernel32.dll" (ByVal hFile As Long, ByRef lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, ByRef lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long Private Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long 'Private Declare Function GetFileSize Lib "kernel32.dll" (ByVal hFile As Long, ByRef lpFileSizeHigh As Long) As Long Private Declare Function GetFileSizeEx Lib "kernel32.dll" (ByVal hFile As Long, ByRef lpFileSize As Currency) As Long Enum DesiredAccess GENERIC_READ = &H80000000 GENERIC_WRITE = &H40000000 GENERIC_EXECUTE = &H20000000 GENERIC_ALL = &H10000000 End Enum Enum ShareMode FILE_SHARE_READ = &H1 FILE_SHARE_WRITE = &H2 FILE_SHARE_DELETE = &H4 End Enum 'This parameter must be one of the following values, which cannot be combined: Enum CreationDisposition TRUNCATE_EXISTING = 5 OPEN_ALWAYS = 4 OPEN_EXISTING = 3 CREATE_ALWAYS = 2 CREATE_NEW = 1 End Enum Enum FlagsAndAttributes 'attributes FILE_ATTRIBUTE_ARCHIVE = &H20 FILE_ATTRIBUTE_COMPRESSED = &H800 FILE_ATTRIBUTE_DIRECTORY = &H10 FILE_ATTRIBUTE_HIDDEN = &H2 FILE_ATTRIBUTE_NORMAL = &H80 'The file does not have other attributes set. This attribute is valid only if used alone. FILE_ATTRIBUTE_READONLY = &H1 FILE_ATTRIBUTE_SYSTEM = &H4 FILE_ATTRIBUTE_TEMPORARY = &H100 'flags FILE_FLAG_BACKUP_SEMANTICS = &H2000000 FILE_FLAG_DELETE_ON_CLOSE = &H4000000 FILE_FLAG_NO_BUFFERING = &H20000000 FILE_FLAG_OVERLAPPED = &H40000000 FILE_FLAG_POSIX_SEMANTICS = &H1000000 FILE_FLAG_RANDOM_ACCESS = &H10000000 FILE_FLAG_SEQUENTIAL_SCAN = &H8000000 FILE_FLAG_WRITE_THROUGH = &H80000000 End Enum Private Const INVALID_HANDLE_VALUE = -1 'Private Declare Function SetFilePointer Lib "kernel32.dll" (ByVal hFile As Long, ByVal lDistanceToMove As Long, ByRef lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long 'Private Const INVALID_SET_FILE_POINTER = -1 'Private Declare Function SetFilePointerEx Lib "kernel32" (ByVal hFile As Long, liDistanceToMove As LARGE_INTEGER, lpNewFilePointer As LARGE_INTEGER, ByVal dwMoveMethod As Long) As Long 'Private Type LARGE_INTEGER ' Lowpart As Long ' Highpart As Long 'End Type Private Declare Function SetFilePointerEx Lib "kernel32" (ByVal hFile As Long, ByVal liDistanceToMove As Currency, lpNewFilePointer As Currency, ByVal dwMoveMethod As Long) As Long Enum MoveMethod FILE_BEGIN = 0 FILE_CURRENT = 1 FILE_END = 2 End Enum Private Declare Function SetEndOfFile Lib "kernel32" (ByVal hFile As Long) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long '''''''''''''''''''''''''''''''''''''''''''''''''''' Private m_Handle As Long Private m_FileName As String Private Sub Class_Initialize() Handle = INVALID_HANDLE_VALUE FileName = "" End Sub Private Sub Class_Terminate() Call FileClose End Sub '*******properties******* Public Property Get Handle() As Long Handle = m_Handle End Property Private Property Let Handle(ByVal Value As Long) m_Handle = Value End Property Public Property Get FileName() As String FileName = m_FileName End Property Private Property Let FileName(ByVal Value As String) m_FileName = Value End Property '*******public functions******* 'FileOpen '打开文件 Public Function FileOpen(ByVal FileName As String, ByVal CreateIfNotExists As Boolean) As Boolean Dim dwCreation As Long If (CreateIfNotExists) Then dwCreation = OPEN_ALWAYS Else dwCreation = OPEN_EXISTING End If If (CreateFile2(FileName, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, dwCreation, 0, 0)) Then FileOpen = True Else FileOpen = False End If End Function 'FileSeek '移动文件指针 Public Function FileSeek(ByVal DistanceToMove As Double, ByVal MoveMethod As MoveMethod) As Boolean Dim lRet As Long Dim curIn As Currency, curOut As Currency If (Handle = INVALID_HANDLE_VALUE) Then Exit Function curIn = dbl2cur(DistanceToMove) lRet = SetFilePointerEx(Handle, curIn, curOut, MoveMethod) If (lRet) Then FileSeek = True Else FileSeek = False End If End Function 'FileWrite '写文件 Public Function FileWrite(Buffer() As Byte) As Boolean Dim lRet As Long Dim lBufferLength As Long Dim lBytesWritten As Long If (Handle = INVALID_HANDLE_VALUE) Then Exit Function If (IsArrayInit(Buffer()) = False) Then Exit Function lBufferLength = UBound(Buffer) - LBound(Buffer) + 1 lRet = WriteFile(Handle, Buffer(0), lBufferLength, lBytesWritten, 0) If (lRet And lBytesWritten = lBufferLength) Then 'lRet = FlushFileBuffers(Handle) FileWrite = True Else FileWrite = False End If End Function 'FileRead '读文件 Public Function FileRead(Buffer() As Byte) As Boolean Dim lRet As Long Dim lBufferLength Dim lBytesRead As Long If (Handle = INVALID_HANDLE_VALUE) Then Exit Function If (IsArrayInit(Buffer()) = False) Then Exit Function lBufferLength = UBound(Buffer) - LBound(Buffer) + 1 lRet = ReadFile(Handle, Buffer(0), lBufferLength, lBytesRead, 0) If (lRet) Then FileRead = True Else FileRead = False End If End Function 'FileClose '关闭文件 Public Function FileClose() As Boolean Dim lRet As Long If (Handle = INVALID_HANDLE_VALUE) Then Exit Function lRet = CloseHandle(Handle) If (lRet) Then Handle = INVALID_HANDLE_VALUE FileName = "" FileClose = True End If End Function 'CreateFile2 '创建文件，同 CreateFile API 函数，这个函数可以不暴露 Public Function CreateFile2(ByVal lpFileName As String, ByVal dwDesiredAccess As DesiredAccess, ByVal dwShareMode As ShareMode, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As CreationDisposition, ByVal dwFlagsAndAttributes As FlagsAndAttributes, ByVal hTemplateFile As Long) As Boolean 'The lpFileName string should be //./x: to open a floppy drive x or a partition x on a hard disk.For example: ' 'String Meaning '//./A: Obtains a handle to drive A on the user's computer. '//./C: Obtains a handle to drive C on the user's computer. m_FileName = lpFileName Handle = CreateFile(lpFileName, dwDesiredAccess, dwShareMode, lpSecurityAttributes, dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile) CreateFile2 = IIf(Handle <> INVALID_HANDLE_VALUE, True, False) End Function 'FileGetSize '取得文件大小（字节） Public Function FileGetSize(Size As Double) As Boolean Dim lRet As Long Dim curOut As Currency If (Handle = INVALID_HANDLE_VALUE) Then Exit Function lRet = GetFileSizeEx(Handle, curOut) If (lRet) Then Size = cur2dbl(curOut) FileGetSize = True End If End Function 'FileSetSize '指定文件大小（字节） Public Function FileSetSize(ByVal Size As Double) As Boolean Dim lRet As Long Dim curOut As Currency If (Size < 0) Then Exit Function If (Handle = INVALID_HANDLE_VALUE) Then Exit Function lRet = SetFilePointerEx(Handle, dbl2cur(Size), curOut, FILE_BEGIN) If (lRet) Then lRet = SetEndOfFile(Handle) If (lRet) Then FileSetSize = True End If End If End Function '''''''''''''''''''''''''''''''''''''''''''''''''''' Private Function cur2dbl(cur As Currency) As Double cur2dbl = cur * 10000 End Function Private Function dbl2cur(dbl As Double) As Currency dbl2cur = dbl / 10000 End Function Private Function IsArrayInit(ByRef lpsa() As Byte) As Boolean Dim lRet As Long IsArrayInit = True Err.Clear On Error Resume Next lRet = LBound(lpsa()) If (Err.Number) Then Err.Clear IsArrayInit = False End If End Function 复制代码 参考链接：http://hi.baidu.com/hnxyy/blog/item/e77c3f87db17612ac65cc3b3.html

 

测试工程：

http://download.csdn.net/source/3197291