You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

求可判断两个二进制PDF文件是否相同的高效VBA函数

高效VBA二进制文件对比函数实现

要实现高效的二进制文件对比,我们可以借助Windows原生API的内存映射与内存对比功能,比逐字节读取的方式快得多,尤其适合大文件(比如PDF)的对比场景。以下是完整实现:

Option Explicit

' Windows API声明
Private Declare PtrSafe Function CreateFile Lib "kernel32" Alias "CreateFileA" _
    (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _
    ByVal dwShareMode As Long, lpSecurityAttributes As Any, _
    ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, _
    ByVal hTemplateFile As LongPtr) As LongPtr

Private Declare PtrSafe Function CreateFileMapping Lib "kernel32" Alias "CreateFileMappingA" _
    (ByVal hFile As LongPtr, lpFileMappingAttributes As Any, _
    ByVal flProtect As Long, ByVal dwMaximumSizeHigh As Long, _
    ByVal dwMaximumSizeLow As Long, ByVal lpName As String) As LongPtr

Private Declare PtrSafe Function MapViewOfFile Lib "kernel32" _
    (ByVal hFileMappingObject As LongPtr, ByVal dwDesiredAccess As Long, _
    ByVal dwFileOffsetHigh As Long, ByVal dwFileOffsetLow As Long, _
    ByVal dwNumberOfBytesToMap As LongPtr) As LongPtr

Private Declare PtrSafe Function CloseHandle Lib "kernel32" _
    (ByVal hObject As LongPtr) As Long

Private Declare PtrSafe Function GetFileSize Lib "kernel32" _
    (ByVal hFile As LongPtr, lpFileSizeHigh As Long) As Long

Private Declare PtrSafe Function memcmp Lib "msvcrt.dll" _
    (ByVal buf1 As LongPtr, ByVal buf2 As LongPtr, ByVal count As LongPtr) As Long

Private Const GENERIC_READ As Long = &H80000000
Private Const FILE_SHARE_READ As Long = &H1
Private Const OPEN_EXISTING As Long = 3
Private Const PAGE_READONLY As Long = &H2
Private Const FILE_MAP_READ As Long = &H4

Public Function CompareFiles(ByVal filePath1 As String, ByVal filePath2 As String) As Boolean
    Dim hFile1 As LongPtr, hFile2 As LongPtr
    Dim hMap1 As LongPtr, hMap2 As LongPtr
    Dim pView1 As LongPtr, pView2 As LongPtr
    Dim fileSize1 As Long, fileSizeHigh1 As Long
    Dim fileSize2 As Long, fileSizeHigh2 As Long
    Dim cmpResult As Long
    
    ' 初始化返回值为False
    CompareFiles = False
    
    ' 检查文件是否存在
    If Dir(filePath1) = "" Or Dir(filePath2) = "" Then Exit Function
    
    ' 打开第一个文件
    hFile1 = CreateFile(filePath1, GENERIC_READ, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, 0, 0)
    If hFile1 = -1 Then Exit Function
    
    ' 打开第二个文件
    hFile2 = CreateFile(filePath2, GENERIC_READ, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, 0, 0)
    If hFile2 = -1 Then
        CloseHandle hFile1
        Exit Function
    End If
    
    ' 获取文件大小(支持大文件的高32位判断)
    fileSize1 = GetFileSize(hFile1, fileSizeHigh1)
    fileSize2 = GetFileSize(hFile2, fileSizeHigh2)
    
    ' 大小不同直接返回False
    If fileSize1 <> fileSize2 Or fileSizeHigh1 <> fileSizeHigh2 Then
        CloseHandle hFile1
        CloseHandle hFile2
        Exit Function
    End If
    
    ' 创建文件映射
    hMap1 = CreateFileMapping(hFile1, ByVal 0&, PAGE_READONLY, 0, 0, vbNullString)
    hMap2 = CreateFileMapping(hFile2, ByVal 0&, PAGE_READONLY, 0, 0, vbNullString)
    
    If hMap1 = 0 Or hMap2 = 0 Then
        CloseHandle hFile1
        CloseHandle hFile2
        CloseHandle hMap1
        CloseHandle hMap2
        Exit Function
    End If
    
    ' 映射文件到内存
    pView1 = MapViewOfFile(hMap1, FILE_MAP_READ, 0, 0, 0)
    pView2 = MapViewOfFile(hMap2, FILE_MAP_READ, 0, 0, 0)
    
    If pView1 = 0 Or pView2 = 0 Then
        CloseHandle hFile1
        CloseHandle hFile2
        CloseHandle hMap1
        CloseHandle hMap2
        CloseHandle pView1
        CloseHandle pView2
        Exit Function
    End If
    
    ' 调用memcmp对比内存块,返回0表示完全相同
    cmpResult = memcmp(pView1, pView2, fileSize1 Or (fileSizeHigh1 * &H100000000))
    CompareFiles = (cmpResult = 0)
    
    ' 释放所有资源,避免内存泄漏
    CloseHandle pView1
    CloseHandle pView2
    CloseHandle hMap1
    CloseHandle hMap2
    CloseHandle hFile1
    CloseHandle hFile2
End Function

核心优势

  1. 前置快速过滤:先对比文件大小,大小不同直接返回结果,跳过后续耗时操作
  2. 内存映射IO优化:通过CreateFileMapping将文件直接映射到虚拟内存,避免VBA逐字节读取的IO开销
  3. 原生高效对比:使用C标准库的memcmp进行内存块对比,比VBA循环快数倍,尤其适合大文件

使用示例

Sub TestFileComparison()
    Dim isIdentical As Boolean
    isIdentical = CompareFiles("sample.pdf", "sample_CopyOf.pdf")
    ' 输出True(如果两个文件是完全副本)
    Debug.Print isIdentical
End Sub

该函数的效果完全等效于命令行执行fc /c sample.pdf sample_CopyOf.pdf,但无需依赖外部命令调用,在VBA环境中执行效率更高。

内容的提问来源于stack exchange,提问作者Valarenti

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.07.26 03:13:17