JavaとVBA(Access)から同じセキュリティテーブルを使ってログインを実装する(Salt+Stretched+Hash{sha256})

ちょっと覚え書き

JavaとVBA(Access)から同じセキュリティテーブルを使ってログインを実装する(Salt+Stretched+Hash{sha256})

• 旧資産のAccessから新資産のJavaと同じセキュリティテーブルを利用してログインさせたいというユーザ要望に応えるために実装
• JavaはMessageDigestを利用
• VBA(Access)はadvapi32.dllを利用

まずはJava

Java暗号化クラス

EncryptPassword.java

import java.security.MessageDigest;
import java.security.NoSuchAlgorithmException;
 
public class EncryptPassword {
	private static int STRETCH_COUNT = 1000;

	/*
	 * salt + ストレッチングしたパスワードを取得
	 */
	public static String getStretchedPassword(String password, String saltString) throws Throwable {
		String salt = getSha256(saltString);
		String hash = "";

		for (int i = 0; i < STRETCH_COUNT; i++) {
			hash = getSha256(hash + salt + password);
		}

		return hash;
	}
 
	/*
	 * 文字列から SHA256 のハッシュ値を取得
	 */
	private static String getSha256(String target) throws Throwable {

		MessageDigest md = null;
		StringBuffer buf = new StringBuffer();

		try {
			md = MessageDigest.getInstance("SHA-256");
			md.update(target.getBytes());
			byte[] digest = md.digest();

			for (int i = 0; i < digest.length; i++) {
				buf.append(String.format("%02x", digest[i]));
			}

		} catch (NoSuchAlgorithmException e) {
			e.printStackTrace();
			throw e;
		}

		return buf.toString();
	}
}

Javaドライバクラス

TestMain.java

public class TestMain {

	public static void main(String[] args) throws Throwable {

		System.out.println(EncryptPassword.getStretchedPassword("test", "testsalt"));

	}

}

###次にVBA

VBA暗号化モジュール

modEncrypt.bas

Option Explicit

Private 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
Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv 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, ByRef phHash As Long) As Long
Private Declare Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As Long) As Long
Private Declare Function CryptHashData Lib "advapi32.dll" (ByVal hHash As Long, pbData As Any, ByVal cbData 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 Any, ByRef pcbData As Long, ByVal dwFlags As Long) As Long

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

Private Const HP_HASHVAL      As Long = 2

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

Private Const ALG_SID_SHA_256 As Long = 12

Private Const CALG_SHA_256    As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_256)

Private Const STRETCH_COUNT As Integer = 1000

' Create Hash
Private Function CreateHash(byteData() As Byte, ByVal lngAlgID As Long) As String
    Dim hProv, hHash As Long
    Dim byteHash(0 To 63) As Byte
    Dim lngLength As Long
    Dim lngResult As Long
    Dim strHash As String
    Dim i As Long
    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(byteData()) - LBound(byteData()) + 1
            If lngLength > 0 Then lngResult = CryptHashData(hHash, byteData(LBound(byteData())), lngLength, 0&) Else: lngResult = CryptHashData(hHash, ByVal 0&, 0&, 0&)
            If lngResult <> 0& Then
                lngLength = UBound(byteHash()) - LBound(byteHash()) + 1
                If CryptGetHashParam(hHash, HP_HASHVAL, byteHash(LBound(byteHash())), lngLength, 0&) <> 0& Then
                    For i = 0 To lngLength - 1
                        strHash = strHash & Right$("0" & Hex$(byteHash(LBound(byteHash()) + 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 Long) As String
    CreateHashString = CreateHash(StrConv(strData, vbFromUnicode), lngAlgID)
End Function

' SHA-256
Public Function CreateSHA256HashString(ByVal strData As String) As String
    CreateSHA256HashString = CreateHashString(strData, CALG_SHA_256)
End Function

Public Function getSHA256HashPassword(password As String, saltString As String)

    Dim salt, hash As String
    Dim i As Integer

    salt = CreateSHA256HashString(saltString)
    hash = ""
    For i = 1 To STRETCH_COUNT
        DoEvents
        
        hash = CreateSHA256HashString(hash & salt & password)
    Next i

    getSHA256HashPassword = hash
End Function

VBAドライバモジュール

modMain.bas

Private Sub Main()

    Debug.Print getSHA256HashPassword("test", "testsalt")

End Sub

実行結果

Java

VBA

同じ結果が得られました(´ω｀)