使用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 TypePrivate 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 LongPrivate 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 LongPrivate 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 LongPrivate 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 LongPrivate Declare Function GetFileSizeEx Lib "kernel32.dll" (ByVal hFile As Long, ByRef lpFileSize As Currency) As LongEnum DesiredAccess GENERIC_READ = &H80000000 GENERIC_WRITE = &H40000000 GENERIC_EXECUTE = &H20000000 GENERIC_ALL = &H10000000End EnumEnum ShareMode FILE_SHARE_READ = &H1 FILE_SHARE_WRITE = &H2 FILE_SHARE_DELETE = &H4End 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 = 1End EnumEnum 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 = &H80000000End EnumPrivate 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 TypePrivate Declare Function SetFilePointerEx Lib "kernel32" (ByVal hFile As Long, ByVal liDistanceToMove As Currency, lpNewFilePointer As Currency, ByVal dwMoveMethod As Long) As LongEnum MoveMethod FILE_BEGIN = 0 FILE_CURRENT = 1 FILE_END = 2End EnumPrivate Declare Function SetEndOfFile Lib "kernel32" (ByVal hFile As Long) As LongPrivate Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long''''''''''''''''''''''''''''''''''''''''''''''''''''Private m_Handle As LongPrivate m_FileName As StringPrivate Sub Class_Initialize() Handle = INVALID_HANDLE_VALUE FileName = ""End SubPrivate Sub Class_Terminate() Call FileCloseEnd Sub'*******properties*******Public Property Get Handle() As Long Handle = m_HandleEnd PropertyPrivate Property Let Handle(ByVal Value As Long) m_Handle = ValueEnd PropertyPublic Property Get FileName() As String FileName = m_FileNameEnd PropertyPrivate Property Let FileName(ByVal Value As String) m_FileName = ValueEnd 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 IfEnd 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 IfEnd 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 IfEnd 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 IfEnd 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 IfEnd 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 IfEnd 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 IfEnd Function''''''''''''''''''''''''''''''''''''''''''''''''''''Private Function cur2dbl(cur As Currency) As Double cur2dbl = cur * 10000End FunctionPrivate Function dbl2cur(dbl As Double) As Currency dbl2cur = dbl / 10000End FunctionPrivate 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 IfEnd Function复制代码参考链接：http://hi.baidu.com/hnxyy/blog/item/e77c3f87db17612ac65cc3b3.html

 

测试工程：

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