分享
 
 
 

VB二进制快速读写类(正在测试,版本不断维护中)

王朝c#·作者佚名  2006-12-17
窄屏简体版  字體: |||超大  

利用自建的文件缓冲区来提高文件读写速度,下面是与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) As Long

Dim fl As Long

If m_LastBuff = False Then

If m_OffSet = MAX_FILE_BUFF Then

fl = ReadFileToBuff

Select Case fl

Case 0

GetByte = 0

Case -1

GetByte = -1

Case Else

ch = m_fb(0)

m_OffSet = 1

GetByte = 1

End Select

Else

ch = m_fb(m_OffSet)

m_OffSet = m_OffSet + 1

GetByte = 1

End If

Else

If m_OffSet < m_MaxBytes Then

ch = m_fb(m_OffSet)

m_OffSet = m_OffSet + 1

GetByte = 1

Else

ch = EOF_CHAR

GetByte = 0

End If

End If

End Function

'写一个字节,如果正确表示1,错误为-1

Public Function PutByte(by As Byte) As Long

If m_OffSet < MAX_FILE_BUFF Then

m_fb(m_OffSet) = by

m_OffSet = m_OffSet + 1

m_DirtyFlag = True

Else '已写满一个缓冲区

WriteBuffToFile

m_fb(0) = by

m_OffSet = 1

m_DirtyFlag = True

End If

End Function

'看当前指针是否到达文件最尾端

Public Function FEof() As Boolean

If m_LastBuff = False Then

FEof = False

Else

If m_OffSet = m_MaxBytes Then

FEof = True

Else

FEof = False

End If

End If

End Function

'///////////////////////////////////////////////////////////////////////////////////////

'预读字节到缓冲区,并返回实际读到的字节,如果返回-1,则表示出错了。

Private Function ReadFileToBuff() As Long

Dim dwReadNum As Long

If ReadFile(m_Handle, m_fb(0), MAX_FILE_BUFF, dwReadNum, 0) = 0 Then

ReadFileToBuff = -1

Else

If dwReadNum <> MAX_FILE_BUFF Then

'最后一个缓冲区

m_LastBuff = True

m_MaxBytes = dwReadNum

m_OffSet = 0

m_DirtyFlag = False

ReadFileToBuff = dwReadNum

Else

m_LastBuff = False

m_MaxBytes = MAX_FILE_BUFF

m_OffSet = 0

m_DirtyFlag = False

ReadFileToBuff = MAX_FILE_BUFF

End If

End If

End Function

'写缓冲区到文件,并返回实际写的字节数

Private Function WriteBuffToFile() As Long

Dim dwWriteNum As Long

If m_OffSet = 0 Or m_DirtyFlag = False Then '如果写入数为0或者写入标志错则不写入

WriteBuffToFile = 0

Else

If WriteFile(m_Handle, m_fb(0), m_OffSet, dwWriteNum, 0) Then

WriteBuffToFile = dwWriteNum

Else

WriteBuffToFile = -1 '出错

End If

End If

m_OffSet = 0

m_DirtyFlag = False

End Function

Private Sub Class_Initialize()

Dim i As Long

m_OffSet = 0

m_Handle = 0

m_DirtyFlag = False

m_FileName = ""

m_LastBuff = False

m_MaxBytes = MAX_FILE_BUFF

End Sub

Private Sub Class_Terminate()

CloseFile

End Sub

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有