|
利用自建的文件缓冲区来提高文件读写速度，下面是与VB 自带的Put Get 进行比较
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
测试代码 :Form1
Option Explicit
Private cfb1 As CFileBuff
Private cfb2 As CFileBuff
Private fh1 As Long
Private fh2 As Long
Private Sub Command1_Click()
Dim fn1 As String
Dim fn2 As String
Dim fn3 As String
Dim ch As Byte
Dim i As Long
Dim st1 As Single, et1 As Single
Dim st2 As Single, et2 As Single
fn1 = App.Path & "\D.DAT"
fn2 = App.Path & "\D.BAK"
fn3 = App.Path & "\D.BAK2"
st1 = Timer
Set cfb1 = New CFileBuff
Set cfb2 = New CFileBuff
If cfb1.Create(fn1) = True Then
cfb2.Create (fn2)
Do
If cfb1.GetByte(ch) = 1 Then
cfb2.PutByte ch
Else
Exit Do
End If
Loop While cfb1.FEof = False
Else
Debug.Print "Error Open File!"
End If
Set cfb1 = Nothing
Set cfb2 = Nothing
et1 = Timer
'''' MsgBox CStr(et1 - st1)
st2 = Timer
fh1 = FreeFile(0)
Open fn1 For Binary As fh1
fh2 = FreeFile(0)
Open fn3 For Binary As fh2
Do
Get fh1, , ch
Put fh2, , ch
Loop While EOF(fh1) = False
Close fh1
Close fh2
et2 = Timer
MsgBox CStr(et1 - st1) & " " & CStr(et2 - st2)
Debug.Print "Success!"
End Sub
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
类代码 : CFileBuff
Option Explicit
''''文件缓冲类，利用块读写来提高文件的读写速度
Private Const GENERIC_WRITE = &H40000000
Private Const GENERIC_READ = &H80000000
Const FILE_ATTRIBUTE_NORMAL = &H80
Const CREATE_ALWAYS = 2
Const OPEN_ALWAYS = 4
Const INVALID_HANDLE_VALUE = -1
Const ERROR_HANDLE_EOF = 38
Private 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
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hObject As Long) As Long
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
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 SetFilePointer Lib "kernel32" ( _
ByVal hFile As Long, ByVal loWord As Long, ByVal hiWord As Long, ByVal MoveMethod As Long) As Long
Public Enum enumFileSeek
FS_BEGIN
FS_CURRENT
FS_END
End Enum
Private Const MAX_FILE_BUFF As Long = 512 ''''定义最大的缓冲区，正好一个扇区
Private Const EOF_CHAR As Byte = 0
Private m_fb(MAX_FILE_BUFF - 1) As Byte
Private m_NeedCloseFile As Boolean ''''是否需要
Private m_Handle As Long
Private m_OffSet As Long
Private m_DirtyFlag As Boolean
Private m_LastBuff As Boolean
Private m_MaxBytes As Long
Private m_FileName As String
''''按标志创建文件
Public Function Create(FileName As String) As Boolean
m_Handle = CreateFile(FileName, GENERIC_WRITE Or GENERIC_READ, 0, 0, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
If m_Handle <> INVALID_HANDLE_VALUE Then ''''看是否正确创建了文件
m_FileName = FileName
ReadFileToBuff
Create = True
Else
Create = False
End If
End Function
''''关闭文件
Public Sub CloseFile()
WriteBuffToFile
CloseHandle m_Handle
End Sub
''''移动文件指针，不支持超过2 ^ 31 的位移
Public Function FSeek(Pos As Long, FS As enumFileSeek) As Boolean
Dim iPos As Long
If m_DirtyFlag = True Then WriteBuffToFile
Select Case FS
Case FS_BEGIN
If Pos < 0 Then FSeek = False
If SetFilePointer(m_Handle, Pos, 0, 0) = &HFFFFFFFF Then
FSeek = False
Else
If ReadFileToBuff = -1 Then
FSeek = False
Else
FSeek = True
End If
End If
Case FS_END
If Pos > 0 Then FSeek = False
If SetFilePointer(m_Handle, Pos, 0, 2) = &HFFFFFFFF Then
FSeek = False
Else
If ReadFileToBuff = -1 Then
FSeek = False
Else
FSeek = True
End If
End If
Case FS_CURRENT
iPos = Pos - (m_MaxBytes - m_OffSet) ''''计算实际的偏移位置
If SetFilePointer(m_Handle, iPos, 0, 1) = &HFFFFFFFF Then
FSeek = False
Else
If ReadFileToBuff = -1 Then
FSeek = False
Else
FSeek = True
End If
End If
End Select
End Function
''''取一个字节
''''返回 1 表示正确取到字符
''''返回 0 表示已到文件尾，并且ch= EOF_CHAR
''''返回 -1 表示取字符错误。
Public Function GetByte(ByRef ch As Byte [1] [2] 下一页 | 
