首先,向风版道一声:辛苦!感谢你花时间帮我解困;
对于,2G以上的文件会超出Long范围,我用的是API读文件内容,而不是 Open xxx For Binary As xx
以下是我写的程序:
程序代码:
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
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
Pos = 1
For P = 0 To Le
bFind(P) = Val("&H" & Mid(FindStr, Pos, 2))
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, Start) '查找
Call CloseHandle(fhWnd) '关闭文件
Erase bFind
Debug.Print "用时 = " & (Timer - TTT) * 1000 & " 毫秒; " & "查找位置 = " & FindPos
End Sub
Private Function FindByte(ByteFind() 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
If FindByte > -1 Then
FindByte = Offset - FindLen + FindByte
Exit Do
End If
Start2 = 1
End If
FindByte = InStrB(Start, Buffer, ByteFind) - 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 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
图片附件: 游客没有浏览图片的权限,请
登录 或
注册
关于上述代码的几点说明:
1、给“FileName”变量指定路径文件名,(可以指定大于2G的文件);
2、给“FindStr”变量指定搜索关键字;注意:格式是字节。如:“FFAABBCC”
3、上述代码仅限于
字节方式的查找,也就是说,是区分大小写的;对于
文本方式(忽略大小写) ,我写不出来,(或者说,我的写速度极慢)