请问：怎样能在16进制中查找字符？ - VB6论坛

第 3 楼
得分:0
首先，向风版道一声：辛苦！感谢你花时间帮我解困；

对于，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、上述代码仅限于字节方式的查找，也就是说，是区分大小写的；对于文本方式(忽略大小写) ，我写不出来，(或者说，我的写速度极慢)