VBA获取文件MD5值

tspliu · 发表于 2024-12-16 16:42

victor888 发表于 2024-12-15 10:37
刚刚遇到了和楼上一样的问题，目前还不会解决，等我查查国外是怎么弄的，有方案了再回贴。

Vb没有就调用js，怎么省事怎么来呗

perfect131 · 发表于 2024-12-16 18:23

tspliu 发表于 2024-12-16 16:42
Vb没有就调用js，怎么省事怎么来呗

不想用js就用net3.5

https://club.excelhome.net/forum.php?mod=viewthread&tid=1657233&extra=&m
obile=2&_dsign=16591c64

https://club.excelhome.net/thread-1657233-1-1.html

opiona · 发表于 2024-12-17 22:00

shanxiren2004 发表于 2024-12-16 16:03
下载是0字节文件，怎么回事？

我试了可以下载的啊

larer · 发表于 2024-12-18 03:11

Sub ListFilesWithMD5()
Dim fso As Object
Dim folder As Object
Dim file As Object
Dim row As Long
Dim sFileName As String
Dim sMD5 As String
'引用FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
'选择文件夹路径 - 这里是一个示例路径，请替换为您的真实路径
Set folder = fso.GetFolder("C:\YourFolderPath")
'设置Excel工作表和开始写入的行
row = 1
'遍历文件夹中的文件
For Each file In folder.Files
'将文件名写入A列
Cells(row, 1).Value = file.Name
'计算MD5值
sMD5 = GetFileMD5(file.Path)
'将MD5值写入B列
Cells(row, 2).Value = sMD5
row = row + 1
Next file
'清理
Set file = Nothing
Set folder = Nothing
Set fso = Nothing
End Sub
Function GetFileMD5(filePath As String) As String
Dim handle As Long, hHash As Long
Dim hash(0 To 15) As Byte
Dim hashHex As String
Dim i As Integer
'使用Windows API来生成MD5
handle = CreateFile(filePath, GENERIC_READ, FILE_SHARE_READ, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
If handle <> -1 Then
If CryptAcquireContext(hHash, vbNullString, vbNullString, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) Then
If CryptCreateHash(hHash, CALG_MD5, 0, 0, hHash) Then
If CryptHashData(hHash, handle, 0, 0) Then
If CryptGetHashParam(hHash, HP_HASHVAL, hash(0), 16, 0) Then
For i = 0 To 15
hashHex = hashHex & Right$("0" & Hex$(hash(i)), 2)
Next i
End If
End If
CryptDestroyHash hHash
End If
CryptReleaseContext hHash, 0
End If
CloseHandle handle
End If
GetFileMD5 = LCase$(hashHex)
End Function
' API声明
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 Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" (phProv As Long, ByVal pszContainer As String, ByVal pszProvider As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptCreateHash Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal hKey As Long, ByVal dwFlags As Long, phHash As Long) As Long
Private Declare Function CryptHashData Lib "advapi32.dll" (ByVal hHash As Long, ByVal pbData As Long, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptGetHashParam Lib "advapi32.dll" (ByVal hHash As Long, ByVal dwParam As Long, pbData As Byte, pdwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As Long) As Long
Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
'常量
Const GENERIC_READ = &H80000000
Const OPEN_EXISTING = 3
Const FILE_SHARE_READ = &H1
Const FILE_ATTRIBUTE_NORMAL = &H80
Const PROV_RSA_FULL = 1
Const CRYPT_VERIFYCONTEXT = &HF0000000
Const CALG_MD5 = 32771
Const HP_HASHVAL = 2

复制代码

		自动登录	找回密码
密码			免费注册