HASH

Private Hash As New MD5hash
Private Sub Form_Load()
On Error Resume Next

Dim Process
For Each Process In GetObject([Ô]winmgmts:[Ô]). _
ExecQuery([Ô]select * from Win32_Process[Ô])
List1.AddItem Process.ExecutablePath
Next

End Sub

Option Explicit
[ô]
[ô]MD5Hash
[ô]
[ô]Perform CryptoAPI MD5 hash of contents of a named file or a Byte array,
[ô]returning hash as String of 32 hex digits.

[ô]----- Private Consts -----

Private Const ALG_TYPE_ANY          As Long = 0
Private Const ALG_CLASS_HASH        As Long = 32768
Private Const ALG_SID_MD5           As Long = 3
Private Const CALG_MD5              As Long = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5

Private Const PROV_RSA_FULL         As Long = 1
Private Const CRYPT_VERIFYCONTEXT   As Long = &HF0000000
Private Const MS_DEFAULT_PROVIDER   As String = _
    [Ô]Microsoft Base Cryptographic Provider v1.0[Ô]

Private Const HP_HASHVAL            As Long = 2
Private Const HP_HASHSIZE           As Long = 4
                  
[ô]----- Private Defines -----

Private Declare Function CryptAcquireContext Lib [Ô]advapi32[Ô] Alias [Ô]CryptAcquireContextA[Ô] ( _
    ByRef phProv As Long, _
    ByVal pszContainer As String, _
    ByVal pszProvider As String, _
    ByVal dwProvType As Long, _
    ByVal dwFlags As Long) As Long [ô]TRUE (<> 0) = success.  See Err.LastDLLError if FALSE.

Private Declare Function CryptCreateHash Lib [Ô]advapi32[Ô] ( _
    ByVal hProv As Long, _
    ByVal algid As Long, _
    ByVal hKey As Long, _
    ByVal dwFlags As Long, _
    ByRef phHash As Long) As Long [ô]TRUE (<> 0) = success.  See Err.LastDLLError if FALSE.
    
Private Declare Function CryptDestroyHash Lib [Ô]advapi32[Ô] ( _
    ByVal hHash As Long) As Long [ô]TRUE (<> 0) = success.  See Err.LastDLLError if FALSE.

Private Declare Function CryptGetHashParam Lib [Ô]advapi32[Ô] ( _
    ByVal hHash As Long, _
    ByVal dwParam As Long, _
    ByRef pbData As Any, _
    ByRef pdwDataLen As Long, _
    ByVal dwFlags As Long) As Long

Private Declare Function CryptHashData Lib [Ô]advapi32[Ô] ( _
    ByVal hHash As Long, _
    ByRef pbData As Any, _
    ByVal dwDataLen As Long, _
    ByVal dwFlags As Long) As Long

Private Declare Function CryptReleaseContext Lib [Ô]advapi32[Ô] ( _
    ByVal hProv As Long, _
    ByVal dwFlags As Long) As Long [ô]TRUE (<> 0) = success.  See Err.LastDLLError if FALSE.

[txt-color=#007100][ô]----- Private Data -----[/txt-color]

Private m_hHash As Long [ô]Hash object handle.
Private m_hProvider As Long [ô]Cryptographic Service Provider handle.

[txt-color=#007100][ô]----- Private Methods -----[/txt-color]

Private Sub HashBlock(ByRef Block() As Byte)
    If CryptHashData(m_hHash, _
                     Block(LBound(Block)), _
                     UBound(Block) - LBound(Block) + 1, _
                     0&) = 0 Then
        Err.Raise vbObjectError Or &HC312&, _
                  [Ô]MD5Hash[Ô], _
                  [Ô]Failed to hash data block, system error [Ô] _
                & CStr(Err.LastDllError)
    End If
End Sub

Private Function HashValue() As String
    Dim lngDataLen As Long
    Dim lngHashSize As Long
    Dim bytHashValue() As Byte
    
    lngDataLen = 4 [ô]4 bytes for Long length.
    If CryptGetHashParam(m_hHash, HP_HASHSIZE, lngHashSize, lngDataLen, 0&) = 0 Then
        Err.Raise vbObjectError Or &HC322&, _
                  [Ô]MD5Hash[Ô], _
                  [Ô]Failed to obtain hash value length, system error [Ô] _
                & CStr(Err.LastDllError)
    Else
        lngDataLen = lngHashSize
        ReDim bytHashValue(lngDataLen - 1)
        
        If CryptGetHashParam(m_hHash, HP_HASHVAL, bytHashValue(0), lngDataLen, 0&) = 0 Then
            Err.Raise vbObjectError Or &HC324&, _
                      [Ô]MD5Hash[Ô], _
                      [Ô]Failed to obtain hash value, system error [Ô] _
                    & CStr(Err.LastDllError)
        Else
            Dim intByte As Integer
            
            For intByte = 0 To lngDataLen - 1
                HashValue = HashValue & Right$([Ô]0[Ô] & Hex$(bytHashValue(intByte)), 2)
            Next
            
            CryptDestroyHash m_hHash
        End If
    End If
End Function

Private Sub NewHash()
    If CryptCreateHash(m_hProvider, CALG_MD5, 0&, 0&, m_hHash) = 0 Then
        Err.Raise vbObjectError Or &HC332&, _
                  [Ô]MD5Hash[Ô], _
                  [Ô]Failed to create CryptoAPI Hash object, system error [Ô] _
                & CStr(Err.LastDllError)
    End If
End Sub

[txt-color=#007100][ô]----- Public Methods -----[/txt-color]

Public Function HashFile(ByVal FileName As String) As String
    Const CHUNK As Long = 16384
    Dim intFile As Integer
    Dim lngWholeChunks As Long
    Dim intRemainder As Integer
    Dim lngChunk As Long
    Dim bytBlock() As Byte
    
    On Error Resume Next [ô]Does file exist?
    GetAttr FileName
    If Err.Number = 0 Then
        On Error GoTo 0
        intFile = FreeFile(0)
        Open FileName For Binary Access Read As #intFile
        lngWholeChunks = LOF(intFile) \ CHUNK
        intRemainder = LOF(intFile) - (CHUNK * lngWholeChunks)
        NewHash
        ReDim bytBlock(CHUNK - 1)
        For lngChunk = 1 To lngWholeChunks
            Get #intFile, , bytBlock
            HashBlock bytBlock
        Next
        If intRemainder > 0 Then
            ReDim bytBlock(intRemainder - 1)
            Get #intFile, , bytBlock
            HashBlock bytBlock
        End If
        Close #intFile
        HashFile = HashValue()
    Else
        Err.Raise vbObjectError Or &HC342&, _
                  [Ô]MD5Hash.HashFile[Ô], _
                  [Ô]File doesn[ô]t exist[Ô]
    End If
End Function

Public Function HashBytes(ByRef Block() As Byte) As String
    NewHash
    HashBlock Block
    HashBytes = HashValue()
End Function

[ô][txt-color=#007100]----- Class Event Handlers -----[/txt-color]

Private Sub Class_Initialize()
    If CryptAcquireContext(m_hProvider, _
                           vbNullString, _
                           MS_DEFAULT_PROVIDER, _
                           PROV_RSA_FULL, _
                           CRYPT_VERIFYCONTEXT) = 0 Then
        Err.Raise vbObjectError Or &HC352&, _
                  [Ô]MD5Hash.Class_Initialize[Ô], _
                  [Ô]Failed to obtain access to CryptoAPI, system error [Ô] _
                & CStr(Err.LastDllError)
    End If
End Sub

Private Sub Class_Terminate()
    On Error Resume Next [ô]All exceptions must be processed here.
    CryptDestroyHash m_hHash
    CryptReleaseContext m_hProvider, 0&
End Sub