有几个问题想问题一个,你这个代码,应该解决了 2.5G 大小文件的查找,当用户要求对 一个 4.1G大小的文件查找时会不会出错?无符号long为4G ,4.1G正好超出。
另外:InStrB 返回值 是 long ,当所在位置超过了 long 范围时,InStrB 的返回值是多少??是怎么样的情况。
你程序里大量使用 Currency 类型的数据,这个是可以超过 long 的范围,但要注意到,VB内置函数,大多数只能返回 long 范围,而不是 Currency 范围,这里是否存在超过 long 范围,而不超出 Currency 范围的情况。
------------------------
文本查找,把文本转为 byte数组,然后同样查找。
转换代码只要一行就可以了: s = StrConv("assb", vbFromUnicode)
StrConv
可以转换字符串内码,返回的值可以给 byte数组,并且可以自动调整byte数组的大小。
vbFromUnicode:按省缺代码页转为 ANSI 字符串。
vbUnicode:按转为 Unicode 字符串。可以把包含中文的 byte数组,转化为能显示为中文的字符串
=======================
程序代码:
Option Explicit
Private Type SYSTEM_INFO
dwOemID As Long
dwPageSize As Long
lpMinimumApplicationAddress As Long
lpMaximumApplicationAddress As Long
dwActiveProcessorMask As Long
dwNumberOrfProcessors As Long
dwProcessorType As Long
dwAllocationGranularity As Long
wProcessorLevel As Integer
wProcessorRevision As Integer
End Type
Private Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (lpDst As Any, ByVal Length As Long)
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject 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 Const GENERIC_READ = &H80000000
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const FILE_SHARE_DELETE = &H4
Private Const OPEN_EXISTING = 3
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_FLAG_SEQUENTIAL_SCAN = &H8000000
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
'--- 文件映射
Private Declare Function CreateFileMapping Lib "kernel32" Alias "CreateFileMappingA" (ByVal hFile As Long, ByVal lpFileMappigAttributes As Long, ByVal flProtect As Long, ByVal dwMaximumSizeHigh As Long, ByVal dwMaximumSizeLow As Long, ByVal lpName As String) As Long
Private Declare Function MapViewOfFile Lib "kernel32" (ByVal hFileMappingObject As Long, ByVal dwDesiredAccess As Long, ByVal dwFileOffsetHigh As Long, ByVal dwFileOffsetLow As Long, ByVal dwNumberOfBytesToMap As Long) As Long
Private Declare Function UnmapViewOfFile Lib "kernel32" (ByVal lpBaseAddress As Long) As Long
Private Const PAGE_READONLY = &H2
Private Const FILE_MAP_READ = &H4
Private Type LARGE_INTEGER
LowPart As Long
HighPart As Long
End Type
Private fhWnd As Long, AllocationGranularity As Long
Private mFileSize As Currency
Private Buffer() As Byte
Private Sub Form_Load()
Dim SysInfo As SYSTEM_INFO
Call GetSystemInfo(SysInfo)
AllocationGranularity = SysInfo.dwAllocationGranularity
End Sub
Private Sub Form_Unload(Cancel As Integer)
Erase Buffer
End Sub
Private Sub Command1_Click()
Dim FileName As String, FindStr As String
Dim Le As Long, Pos As Long, P As Long
Dim FindPos As Currency, Start As Currency
Dim bFind() As Byte, bFind2() As Byte '加一个数组
Dim TTT As Single
TTT = Timer
FileName = "C:\xxx\xxx\xxx.yyy" '文件名(包含路径)
If Dir(FileName) = "" Then Exit Sub
'--------------------------------------------------------------
FindStr = "FFAABBCC" '查找字节 字符串
Le = Len(FindStr)
If Le Mod 2 = 1 Then Le = Le + 1
Le = Le \ 2 - 1
ReDim bFind(Le) As Byte
ReDim bFind2(Le) As Byte '加一个数组
Pos = 1
For P = 0 To Le
bFind(P) = Val("&H" & Mid(FindStr, Pos, 2))
'----------生成大小写字母转换的第二个数组----------
If bFind(P) > 64 And bFind(P) < 91 Then '大写字母
bFind2(P) = bFind(P) + 32 '转小写字母
ElseIf bFind(P) > 96 And bFind(P) < 123 Then '小写字母
bFind2(P) = bFind(P) - 32 '转大写字母
Else
bFind2(P) = bFind(P) '非字母按原字符
End If
Pos = Pos + 2
Next
'--------------------------------------------------------------
fhWnd = OpenFile(FileName) '打开文件
mFileSize = GetFileSizeAPI(fhWnd) '获得文件大小
Debug.Print "文件大小 = " & FormatNumber(mFileSize, 0, , , vbTrue) & " 字节"
ReDim Buffer(AllocationGranularity - 1) As Byte '注意:缓冲区大小必须是 AllocationGranularity,或 AllocationGranularity的整数倍
'FindByte 函数返回查找字节位置,-1表示没有匹配;
'Start 参数:表示查找起始位置,0表示从头开始;
Start = 0
FindPos = FindByte(bFind, bFind2, Start) '查找 '多传一个数组进去
Call CloseHandle(fhWnd) '关闭文件
Erase bFind
Debug.Print "用时 = " & (Timer - TTT) * 1000 & " 毫秒; " & "查找位置 = " & FindPos
End Sub
Private Function FindByte(ByteFind() As Byte, ByteFind2() As Byte, ByVal Start As Currency) As Currency
'需要多传一个数组进来
Dim fMaphWnd As Long, MapByteSum As Long, FindLen As Long, bStrPtr As Long, Start2 As Long
Dim fSize As Currency, Offset As Currency
Dim Follow As Boolean
Dim bStrand() As Byte
FindLen = UBound(ByteFind)
ReDim bStrand(FindLen * 2 - 1) As Byte
bStrPtr = VarPtr(bStrand(0))
MapByteSum = AllocationGranularity
Offset = Int(Start / AllocationGranularity) * AllocationGranularity
Start = Start - Offset + 1
If MapByteSum - Start < FindLen Then Start2 = FindLen - (MapByteSum - Start) Else Start2 = 1
fSize = mFileSize - Offset
fMaphWnd = OpenFileMapping(fhWnd)
Do
If MapByteSum > fSize Then
MapByteSum = fSize
Call ZeroMemory(Buffer(0), AllocationGranularity)
End If
Call ReadFileMapping(fMaphWnd, Offset, MapByteSum, Buffer)
If Follow = True Then
Call CopyMemory(bStrand(FindLen), Buffer(0), FindLen)
' FindByte = InStrB(Start2, bStrand, ByteFind) - 1
'instrb改为自定义函数
FindByte = UInStrB(Start2, bStrand, ByteFind, ByteFind2) - 1
If FindByte > -1 Then
FindByte = Offset - FindLen + FindByte
Exit Do
End If
Start2 = 1
End If
' FindByte = InStrB(Start, Buffer, ByteFind) - 1
FindByte = UInStrB(Start2, bStrand, ByteFind, ByteFind2) - 1
If FindByte > -1 Then
FindByte = Offset + FindByte
Exit Do
End If
If fSize > MapByteSum Then
Call CopyMemory(ByVal bStrPtr, Buffer(MapByteSum - FindLen), FindLen)
Follow = True
End If
Offset = Offset + AllocationGranularity
fSize = fSize - MapByteSum
Start = 1
Loop Until fSize = 0
Call CloseHandle(fMaphWnd) '关闭文件映射
Erase bStrand
End Function
Private Function UInStrB(ByVal Start2 As Long, ByRef bStrand() As Byte, ByRef ByteFind() As Byte, ByRef ByteFind2() As Byte) As Currency
Dim FN As Boolean
Dim i As Long '循环变量
Dim bfw1 As Long, bfw2 As Long '二个位置变量
Do
bfw1 = InStrB(Start2, bStrand, ByteFind(0))
bfw2 = InStrB(Start2, bStrand, ByteFind2(0))
'-----------取最近的位置------------
'存在几种情况:0,0;>0,0;0,>0;>0,>0。
If bfw1 = 0 And bfw2 = 0 Then
'第一种,没找到,退出循环
Exit Do
'ElseIf bfw1 > 0 And bfw2 = 0 Then '第二种不需要处理,这个判断也可以不执行
'第二种不需处理
ElseIf bfw1 = 0 And bfw2 > 0 Then
'第三种使用第二个位置
bfw1 = bfw2
ElseIf bfw1 > 0 And bfw2 > 0 Then
'第四种,使用最近的位置
If bfw1 > bfw2 Then bfw1 = bfw2
End If
FN = True
For i = 1 To UBound(ByteFind)
If bStrand(bfw1 + i) = ByteFind(i) Or bStrand(bfw1 + i) = ByteFind2(i) Then '如果等于其中一个
Else '与二个均不相等,那么设置为没找到
FN = False
End If
Next i
Start2 = bfw1 + 1 '从新的位置找起
Loop While Not FN 'for 循环结束后,如果找到,那么fn为真值,这时不需要再次循环查找,否则需要继续DO循环
UInStrB = bfw1 'bfw1要么是 fn 为true 得到的结果,要么是没进for 循环的 0
End Function
Private Function OpenFile(ByVal FileName As String) As Long '打开文件
Dim ShareMode As Long
ShareMode = FILE_SHARE_READ Or FILE_SHARE_WRITE Or FILE_SHARE_DELETE
OpenFile = CreateFile(FileName, GENERIC_READ, ShareMode, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL Or FILE_FLAG_SEQUENTIAL_SCAN, 0)
End Function
Private Function GetFileSizeAPI(ByVal FilehWnd As Long) As Currency '文件大小;字节
Dim fLo As Long, fHi As Long
fLo = GetFileSize(FilehWnd, fHi)
GetFileSizeAPI = HighLowToSize(fLo, fHi)
End Function
Private Function OpenFileMapping(ByVal FilehWnd As Long, Optional ByVal FileSize As Currency = 0) As Long '打开文件映射
Dim fLo As Long, fHi As Long
If FileSize > 0 Then Call SizeToHighLow(FileSize, fLo, fHi)
OpenFileMapping = CreateFileMapping(FilehWnd, 0, PAGE_READONLY, fHi, fLo, vbNullString)
End Function
Private Function ReadFileMapping(ByVal MapFilehWnd As Long, ByVal Offset As Currency, ByVal ViewSize As Long, ByRef Buffer() As Byte) As Boolean
Dim MapMemPtr As Long, fLo As Long, fHi As Long
If Offset > 0 Then Call SizeToHighLow(Offset, fLo, fHi)
MapMemPtr = MapViewOfFile(MapFilehWnd, FILE_MAP_READ, fHi, fLo, ViewSize)
If MapMemPtr > 0 Then
Call CopyMemory(Buffer(0), ByVal MapMemPtr, ViewSize)
Call UnmapViewOfFile(MapMemPtr)
ReadFileMapping = True
End If
End Function
Private Function HighLowToSize(ByVal LowLong As Long, ByVal HighLong As Long) As Currency
Dim LI As LARGE_INTEGER
With LI
.LowPart = LowLong
.HighPart = HighLong
End With
Call CopyMemory(HighLowToSize, LI, Len(LI))
HighLowToSize = HighLowToSize * 10000
End Function
Private Sub SizeToHighLow(ByVal FileSize As Currency, ByRef LowLong As Long, ByRef HighLong As Long)
Dim LI As LARGE_INTEGER
Call CopyMemory(LI, CCur(FileSize / 10000), Len(LI))
With LI
LowLong = .LowPart
HighLong = .HighPart
End With
End Sub