【VBA】暗号化API を使って、ファイルのハッシュ値（SHA-1、SHA-256、SHA-512、MD5）を求めてみた。

ダウンロードしたファイルの検証や、ファイルの改竄がないかの検証などに
MD5や、SHA-256などによるハッシュ値が使われる事があります。

例えば、下の図は、CrystalDiskInfoのダウンロードサイトに記載されているハッシュ値部分をキャプチャしたものです。
f:id:Z1000S:20201228214538p:plain

今回、VBA で、ファイルをByte 配列に読み込んで、
MD5、SHA-1、SHA-256、SHA-512によるハッシュ値を求めてみました。
（MS が非推奨と言っているAPIを使っています。）

以下、非推奨とうたっている部分の抜粋と翻訳

This API is deprecated. New and existing software should start using Cryptography Next Generation APIs. Microsoft may remove this API in future releases.

この API は非推奨です。新規および既存のソフトウェアは、Cryptography Next Generation APIs の使用を開始する必要があります。Microsoft は将来のリリースでこの API を削除する可能性があります。

暗号学的ハッシュ関数
SHA-1
SHA-2
MD5
環境
コード
実行例
- 呼び出し
- 実行結果

暗号学的ハッシュ関数

暗号学的ハッシュ関数は、ハッシュ関数のうち、暗号など情報セキュリティの用途に適する暗号数理的性質をもつもの。任意の長さの入力を（通常は）固定長の出力に変換する
https://ja.wikipedia.org/wiki/%E6%9A%97%E5%8F%B7%E5%AD%A6%E7%9A%84%E3%83%8F%E3%83%83%E3%82%B7%E3%83%A5%E9%96%A2%E6%95%B0

アルゴリズムが異なるハッシュ関数が何種類かあります。

SHA-1

Secure Hash Algorithmシリーズの暗号学的ハッシュ関数で、SHAの最初のバージョンであるSHA-0の弱点を修正したものだそうです。
Wikipediaによると、「シャーワン」と読むらしいです。
ja.wikipedia.org

SHA-2

前身のSHA-1から多くの改良が加えられており、6つのバリエーションが存在し、
SHA-256、SHA-512は、そのバリエーションのひとつです。
ja.wikipedia.org

MD5

MD4が前身であり、安全性を向上させたものとされている。
ただし、

2018年現在において、弱点が発見されていることを筆頭に暗号学的ハッシュ関数として必要な強度は既に残っていないので、強度が必要な場合には使ってはいけない。
https://ja.wikipedia.org/wiki/MD5#%E7%94%A8%E9%80%94

ja.wikipedia.org

環境

OS：Windows 10 Home 64bit
Excel：Microsoft 365 Personal 64bit

コード

ライセンス

MITライセンスを適用するものとします。
ご自由にお使いください。

Copyright (c) 2020 Z1000R_LR
This software is released under the MIT License.
http://opensource.org/licenses/mit-license.php

API 宣言等

Public Enum ALG_ID
    CALG_MD5 = &H8003&
    CALG_SHA1 = &H8004&
    CALG_SHA_256 = &H800C&
    CALG_SHA_512 = &H800E&
End Enum

Private Declare PtrSafe Function CryptAcquireContext Lib "Advapi32.dll" Alias "CryptAcquireContextA" ( _
    ByRef phProv As LongPtr, _
    ByVal szContainer As String, _
    ByVal szProvider As String, _
    ByVal dwProvType As Long, _
    ByVal dwFlags As Long) As Long

Private Declare PtrSafe Function CryptCreateHash Lib "Advapi32.dll" ( _
    ByVal hProv As LongPtr, _
    ByVal algid As Long, _
    ByVal hKey As LongPtr, _
    ByVal dwFlags As Long, _
    ByRef phHash As LongPtr) As Long

Private Declare PtrSafe Function CryptHashData Lib "Advapi32.dll" ( _
    ByVal hHash As LongPtr, _
    ByRef pbData As Any, _
    ByVal dwDataLen As Long, _
    ByVal dwFlags As Long) As Long

Private Declare PtrSafe Function CryptGetHashParam Lib "Advapi32.dll" ( _
    ByVal hHash As LongPtr, _
    ByVal dwParam As Long, _
    ByRef pbData As Any, _
    ByRef pdwDataLen As Long, _
    ByVal dwFlags As Long) As Long

Private Declare PtrSafe Function CryptDestroyHash Lib "Advapi32.dll" ( _
    ByVal hHash As LongPtr) As Long

Private Declare PtrSafe Function CryptReleaseContext Lib "Advapi32.dll" ( _
    ByVal hProv As LongPtr, _
    ByVal dwFlags As Long) As Long

Private Declare PtrSafe Function GetLastError Lib "kernel32" () As Long

Private Const PROV_RSA_AES          As Long = &H18&
Private Const CRYPT_VERIFYCONTEXT   As Long = &HF0000000
Private Const HP_HASHVAL            As Long = &H2&

Private Const ERROR_FILE_NOT_FOUND  As Long = &H2&
Private Const ERROR_INVALID_DATA    As Long = &HD&

ハッシュ値計算

'パラメータ
'   byContentArry(IN)   :ハッシュを計算するファイル（Byte配列）
'   algid(IN)           :取得するハッシュの種類
'   sHash(OUT)          :計算したハッシュ値
'復帰値
'   0                   :成功
'   0以外               :失敗（GetLastErrorによるエラーコード）
Public Function getHash(ByRef byContentArry() As Byte, ByVal algid As ALG_ID, ByRef sHash As String) As Long

    Dim byHash()    As Byte
    Dim hProv       As LongPtr
    Dim hHash       As LongPtr
    Dim lHashBytes  As Long
    Dim lResult     As Long
    Dim lContentBytes   As Long
    Dim i           As Long

    sHash = ""

    'ハッシュ長設定
    Select Case algid
    Case ALG_ID.CALG_MD5
        lHashBytes = 16
    Case ALG_ID.CALG_SHA1
        lHashBytes = 20
    Case ALG_ID.CALG_SHA_256
        lHashBytes = 32
    Case ALG_ID.CALG_SHA_512
        lHashBytes = 64
    Case Else
        Err.Raise ERROR_INVALID_DATA, "getHash", "Invalid ALG_ID.[ 0x" & Right$("0000000" & Hex(algid), 8) & " ]"
    End Select

    'ハッシュ格納用
    ReDim byHash(lHashBytes - 1)

    Do
        '暗号化サービスプロバイダ内の特定のキーコンテナのハンドルを取得
        lResult = CryptAcquireContext(hProv, vbNullString, vbNullString, PROV_RSA_AES, CRYPT_VERIFYCONTEXT)
        If lResult = 0 Then
            lResult = GetLastError
            Exit Do
        End If

        '暗号化サービスプロバイダのハッシュオブジェクトのハンドル作成
        lResult = CryptCreateHash(hProv, algid, 0, 0, hHash)
        If lResult = 0 Then
            lResult = GetLastError
            Exit Do
        End If

        'ハッシュオブジェクトにデータを追加
        lContentBytes = UBound(byContentArry) - LBound(byContentArry) + 1
        lResult = CryptHashData(hHash, byContentArry(0), lContentBytes, 0)
        If lResult = 0 Then
            lResult = GetLastError
            Exit Do
        End If

        'ハッシュ値取得
        lResult = CryptGetHashParam(hHash, HP_HASHVAL, byHash(0), lHashBytes, 0)
        If lResult = 0 Then
            lResult = GetLastError
            Exit Do
        End If

        'Byte配列から16進文字列化
        sHash = String$(lHashBytes * 2, "0")
        For i = 0 To lHashBytes - 1
            Mid$(sHash, i * 2 + 1, 2) = Right$("0" & Hex(byHash(i)), 2)
        Next i
    Loop While False

    If hHash <> 0 Then
        'hHashで参照されるハッシュオブジェクト破棄
        Call CryptDestroyHash(hHash)
    End If

    If hProv <> 0 Then
        '暗号サービスプロバイダと鍵コンテナのハンドル解放
        Call CryptReleaseContext(hProv, 0)
    End If

End Function

ファイル読み込み

Public Function getFileContent(ByVal sTargetPath As String, ByRef byContentArry() As Byte) As Long

    Dim iFileNo As Integer
    Dim lBytes  As Long

    On Error GoTo ERR_FILE_OPEN_FAIL

    'ファイルパスチェック
    If Len(sTargetPath) = 0 Then
        Err.Raise ERROR_INVALID_DATA, "getFileContent", "Path is zero length."
    ElseIf Dir(sTargetPath) = "" Then
        Err.Raise ERROR_FILE_NOT_FOUND, "getFileContent", "File Not Found."
    ElseIf GetAttr(sTargetPath) = vbDirectory Then
        Err.Raise ERROR_INVALID_DATA, "getFileContent", "Path is directory."
    End If

    'ファイル読み込み
    iFileNo = FreeFile
    Open sTargetPath For Binary Access Read As iFileNo
    lBytes = LOF(iFileNo)
    ReDim byContentArry(lBytes - 1)
    Get iFileNo, 1, byContentArry
    Close iFileNo

    Exit Function

ERR_FILE_OPEN_FAIL:
    getFileContent = Err.Number

    Debug.Print "[0x" & Right$("0000000" & Hex(Err.Number), 8) & "] getFileContent :" & Err.Description

End Function

実行例

呼び出し

Public Sub getVBE7DllHash()

    Const TARGET_PATH   As String = "C:\Program Files\Microsoft Office\root\vfs\ProgramFilesCommonX64\Microsoft Shared\VBA\VBA7.1\VBE7.DLL"
    Dim byContentArry() As Byte
    Dim sHash   As String

    Call getFileContent(TARGET_PATH, byContentArry)
    Call getHash(byContentArry, CALG_MD5, sHash)
    Debug.Print "MD5    :" & sHash
    Call getHash(byContentArry, CALG_SHA1, sHash)
    Debug.Print "SHA1   :" & sHash
    Call getHash(byContentArry, CALG_SHA_256, sHash)
    Debug.Print "SHA-256:" & sHash
    Call getHash(byContentArry, CALG_SHA_512, sHash)
    Debug.Print "SHA-512:" & sHash

End Sub