求可判断两个二进制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
核心优势
- 前置快速过滤:先对比文件大小,大小不同直接返回结果,跳过后续耗时操作
- 内存映射IO优化:通过
CreateFileMapping将文件直接映射到虚拟内存,避免VBA逐字节读取的IO开销 - 原生高效对比:使用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
相关产品推荐
相关产品推荐

