看了这个帖子：
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
---------------------
作者：dahual
来源：CSDN
原文：https://blog.csdn.net/dahual/article/details/6327998
版权声明：本文为博主原创文章，转载请附上博文链接！