VB2008でadvapi32.dll を使ったMD5の取得 (ID:141469)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

こんにちわ、現在 advapi32.dll を使ってMD5のハッシュ値を取得しようと思ってます。

http://su-u.jp/juju/%B5%A4%A4%DE%A4%B0%A4%EC%C6%FC%B5%AD/2007-03-08.html
上記のサイト様のVBサンプルをVB2008のVB6アップデートツールで変換して
とりあえずビルドは出来る状態になったのですが、あるエラーで行き詰ってしまいました。

Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" (ByRef phProv As Integer, ByVal pszContainer As String, ByVal pszProvider As String, ByVal dwProvType As Integer, ByVal dwFlags As Integer) As Integer
    Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Integer, ByVal dwFlags As Integer) As Integer
    Private Declare Function CryptCreateHash Lib "advapi32.dll" (ByVal hProv As Integer, ByVal Algid As Integer, ByVal hKey As Integer, ByVal dwFlags As Integer, ByRef phHash As Integer) As Integer
    Private Declare Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As Integer) As Integer
    'UPGRADE_ISSUE: パラメータ 'As Any' の宣言はサポートされません。 詳細については、'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="FAE78A8D-8978-4FD4-8208-5B7324A8F795"' をクリックしてください。
    '** Any を String に変更
    Private Declare Function CryptHashData Lib "advapi32.dll" (ByVal hHash As Integer, ByRef pbData As String, ByVal cbData As Integer, ByVal dwFlags As Integer) As Integer
    'UPGRADE_ISSUE: パラメータ 'As Any' の宣言はサポートされません。 詳細については、'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="FAE78A8D-8978-4FD4-8208-5B7324A8F795"' をクリックしてください。
    '** Any を String に変更
    Private Declare Function CryptGetHashParam Lib "advapi32.dll" (ByVal hHash As Integer, ByVal dwParam As Integer, ByRef pbData As String, ByRef pcbData As Integer, ByVal dwFlags As Integer) As Integer

Private Const PROV_RSA_FULL As Integer = 1
    Private Const PROV_RSA_AES As Integer = 24
    Private Const CRYPT_VERIFYCONTEXT As Integer = &HF0000000

Private Const HP_HASHVAL As Integer = 2
    Private Const HP_HASHSIZE As Integer = 4

Private Const ALG_TYPE_ANY As Integer = 0
    Private Const ALG_CLASS_HASH As Integer = 32768

Private Const ALG_SID_MD5 As Integer = 3
    Private Const ALG_SID_SHA_256 As Integer = 12

Private Const CALG_MD5 As Integer = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5)
    Private Const CALG_SHA_256 As Integer = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_256)

' Create Hash
    Private Function CreateHash(ByRef abytData() As Byte, ByVal lngAlgID As Integer) As String
        Dim hProv, hHash As Integer
        Dim abytHash(63) As Byte
        Dim lngLength As Integer
        Dim lngResult As Integer
        Dim strHash As String
        Dim i As Integer
        strHash = ""
        If CryptAcquireContext(hProv, vbNullString, vbNullString, IIf(lngAlgID >= CALG_SHA_256, PROV_RSA_AES, PROV_RSA_FULL), CRYPT_VERIFYCONTEXT) <> 0 Then
            If CryptCreateHash(hProv, lngAlgID, 0, 0, hHash) <> 0 Then
                lngLength = UBound(abytData) - LBound(abytData) + 1
                If lngLength > 0 Then lngResult = CryptHashData(hHash, abytData(LBound(abytData)), lngLength, 0) Else lngResult = CryptHashData(hHash, 0, 0, 0)
                If lngResult <> 0 Then
                    lngLength = UBound(abytHash) - LBound(abytHash) + 1
                    If CryptGetHashParam(hHash, HP_HASHVAL, abytHash(LBound(abytHash)), lngLength, 0) <> 0 Then
                        For i = 0 To lngLength - 1
                            '** Right同等のメソッド追加
                            strHash = strHash & Right("0" & Hex(abytHash(LBound(abytHash) + i)), 2)
                        Next
                    End If
                End If
                CryptDestroyHash(hHash)
            End If
            CryptReleaseContext(hProv, 0)
        End If
        CreateHash = LCase(strHash)
    End Function

' Create Hash From String(Shift_JIS)
    Private Function CreateHashString(ByVal strData As String, ByVal lngAlgID As Integer) As String
        'UPGRADE_ISSUE: 定数 vbFromUnicode はアップグレードされませんでした。 詳細については、'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="55B59875-9A95-4B71-9D6A-7C294BF7139D"' をクリックしてください。
        '** StrConv(strData, vbFromUnicode) を StrData に変更
        CreateHashString = CreateHash(System.Text.UnicodeEncoding.Unicode.GetBytes(strData), lngAlgID)
    End Function

' Create Hash From File
    Private Function CreateHashFile(ByVal strFileName As String, ByVal lngAlgID As Integer) As String
        Dim abytData() As Byte
        Dim intFile As Short
        Dim lngError As Integer
        On Error Resume Next
        'UPGRADE_WARNING: Dir に新しい動作が指定されています。 詳細については、'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"' をクリックしてください。
        If Len(Dir(strFileName)) > 0 Then
            intFile = FreeFile
            FileOpen(intFile, strFileName, OpenMode.Binary, OpenAccess.Read, OpenShare.Shared)
            'UPGRADE_ISSUE: InputB 関数はサポートされません。 詳細については、'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="367764E5-F3F8-4E43-AC3E-7FE0B5E074E2"' をクリックしてください。
            'UPGRADE_TODO: System.Text.UnicodeEncoding.Unicode.GetBytes() を使うためにコードがアップグレードされましたが、動作が異なる可能性があります。 詳細については、'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="93DD716C-10E3-41BE-A4A8-3BA40157905B"' をクリックしてください。
            '** InputB(LOF(intFile), intFile) を intFile に変更
            abytData = System.Text.UnicodeEncoding.Unicode.GetBytes(intFile)
            FileClose(intFile)
        End If
        lngError = Err.Number
        On Error GoTo 0
        If lngError = 0 Then CreateHashFile = CreateHash(abytData, lngAlgID) Else CreateHashFile = ""
    End Function

' MD5
    Public Function CreateMD5Hash(ByRef abytData() As Byte) As String
        CreateMD5Hash = CreateHash(abytData, CALG_MD5)
    End Function
    Public Function CreateMD5HashString(ByVal strData As String) As String
        CreateMD5HashString = CreateHashString(strData, CALG_MD5)
    End Function
    Public Function CreateMD5HashFile(ByVal strFileName As String) As String
        CreateMD5HashFile = CreateHashFile(strFileName, CALG_MD5)
    End Function

' Rightメソッド
    Public Shared Function Right(ByVal stTarget As String, ByVal iLength As Integer) As String
        If iLength <= stTarget.Length Then
            Return stTarget.Substring(stTarget.Length - iLength)
        End If
        Return stTarget
    End Function

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        CreateMD5HashFile("C:\テスト.txt")
    End Sub

以上、現在のコードです、長くてすみません；
変更ヶ所は'** と記入してる所です、殆ど理解出来てないので、まずい変更かもしれません；
現状の内容で実行すると(種類 'System.ExecutionEngineException' の例外がスローされました。)
と出てプログラムが落ちてしまいます。

ソースも理解出来てないので何処がおかしいかも解らない状態です。
親切な方、どうかご教授お願いします。。

←解決時は質問者本人がここをチェックしてください。

戻る