VB文件 hash 查看器

概述  窗体代码 1 Private Sub Text1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) 2 Dim path As String, hash As String 3 For Each fil

 

窗体代码

 1 Private Sub Text1_olEDragDrop(Data As DataObject,Effect As Long,button As Integer,Shift As Integer,X As Single,Y As Single) 2     Dim path As String,hash As String 3     For Each file In Data.files 4         path = path & file 5     Next 6     If (GetAttr(path) And vbDirectory) = vbDirectory Then 7         MsgBox "请勿拖放文件夹，谢谢！",vbExclamation,"提示" 8     Else 9         hash = Hashfile(path)10         Text1.Text = Text1.Text & "文件路径： " & path & vbCrLf _11                                 & "创建时间： " & fileDateTime(path) & vbCrLf _12                                 & "文件大小： " & fileLen(path) & " 字节" & vbCrLf _13                                 & "文件HASH： " & hash & vbCrLf & vbCrLf14     End If15 End Sub

 

模块代码

 1 Public Declare Function CryptAcquireContext lib "advAPI32.dll" Alias "CryptAcquireContextA" (ByRef PHProv As Long,ByVal pszContainer As String,ByVal pszProvIDer As String,ByVal DWProvType As Long,ByVal DWFlags As Long) As Long 2 Public Declare Function CryptReleaseContext lib "advAPI32.dll" (ByVal hProv As Long,ByVal DWFlags As Long) As Long 3 Public Declare Function CryptCreateHash lib "advAPI32.dll" (ByVal hProv As Long,ByVal Algid As Long,ByVal hKey As Long,ByVal DWFlags As Long,ByRef phHash As Long) As Long 4 Public Declare Function CryptDestroyHash lib "advAPI32.dll" (ByVal hHash As Long) As Long 5 Public Declare Function CryptHashData lib "advAPI32.dll" (ByVal hHash As Long,pbData As Any,ByVal DWDataLen As Long,ByVal DWFlags As Long) As Long 6 Public Declare Function CryptGetHashParam lib "advAPI32.dll" (ByVal hHash As Long,ByVal DWParam As Long,pDWDataLen As Long,ByVal DWFlags As Long) As Long 7 Public Const PROV_RSA_FulL = 1 8 Public Const CRYPT_NEWKEYSET = &H8 9 Public Const ALG_CLASS_HASH = 3276810 Public Const ALG_TYPE_ANY = 011 Public Const ALG_SID_MD2 = 112 Public Const ALG_SID_MD4 = 213 Public Const ALG_SID_MD5 = 314 Public Const ALG_SID_SHA1 = 415 Enum HashAlgorithm16    MD2 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD217    MD4 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD418    MD5 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD519    SHA1 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA120 End Enum21 Public Const HP_HASHVAL = 222 Public Const HP_HASHSIZE = 423 24 Public Function Hashfile(ByVal filename As String,Optional ByVal Algorithm As HashAlgorithm = MD5) As String25     Dim hCtx As Long26     Dim hHash As Long27     Dim lfile As Long28     Dim lRes As Long29     Dim lLen As Long30     Dim lIDx As Long31     Dim abHash() As Byte32     If Len(Dir$(filename)) = 0 Then Err.Raise 5333     lRes = CryptAcquireContext(hCtx,vbNullString,PROV_RSA_FulL,0)34     If lRes = 0 And Err.LastDllError = &H80090016 Then35       lRes = CryptAcquireContext(hCtx,CRYPT_NEWKEYSET)36     End If37     If lRes <> 0 Then38        lRes = CryptCreateHash(hCtx,Algorithm,0,0,hHash)39        If lRes <> 0 Then40           lfile = Freefile41           Open filename For Binary As lfile42           If Err.Number = 0 Then43              Const BLOCK_SIZE As Long = 32 * 1024& ‘ 32K44              ReDim abBlock(1 To BLOCK_SIZE) As Byte45              Dim lCount As Long46              Dim lBlocks As Long47              Dim lLastBlock As Long48              lBlocks = LOF(lfile) \ BLOCK_SIZE49              lLastBlock = LOF(lfile) - lBlocks * BLOCK_SIZE50              For lCount = 1 To lBlocks51                 Get lfile,abBlock52                 lRes = CryptHashData(hHash,abBlock(1),BLOCK_SIZE,0)53                 If lRes = 0 Then Exit For54              Next55              If lLastBlock > 0 And lRes <> 0 Then56                 ReDim abBlock(1 To lLastBlock) As Byte57                 Get lfile,abBlock58                 lRes = CryptHashData(hHash,lLastBlock,0)59              End If60              Close lfile61           End If62           If lRes <> 0 Then63              lRes = CryptGetHashParam(hHash,HP_HASHSIZE,lLen,4,0)64              If lRes <> 0 Then65                  ReDim abHash(0 To lLen - 1)66                  lRes = CryptGetHashParam(hHash,HP_HASHVAL,abHash(0),0)67                  If lRes <> 0 Then68                      For lIDx = 0 To UBound(abHash)69                          Hashfile = Hashfile & Right$("0" & Hex$(abHash(lIDx)),2)70                          DoEvents71                      Next72                  End If73              End If74           End If75           CryptDestroyHash hHash76        End If77     End If78     CryptReleaseContext hCtx,079     If lRes = 0 Then Err.Raise Err.LastDllError80 End Function

 

完整工程文件： https://pan.baidu.com/s/1xF2rcvzG5zHz0V0Cu4U_gg 密码:tdqb

总结

以上是内存溢出为你收集整理的VB文件 hash 查看器全部内容，希望文章能够帮你解决VB文件 hash 查看器所遇到的程序开发问题。

如果觉得内存溢出网站内容还不错，欢迎将内存溢出网站推荐给程序员好友。