-
Dec 13th, 2021, 09:25 AM
#1
[VB6] WinXP compatible PBKDF2
This one uses legacy CryptoAPI and requires XP for HMAC support and XP SP3 minimum for the SHA-2 support for the hash function (i.e. SHA256, SHA384 and SHA512) while MD5 and SHA1 are always supported.
Code:
'--- mdPbkdf2.bas
Option Explicit
DefObj A-Z
'=========================================================================
' API
'=========================================================================
'--- for CryptAcquireContext
Private Const PROV_RSA_AES As Long = 24
Private Const CRYPT_VERIFYCONTEXT As Long = &HF0000000
'--- for CryptCreateHash
Private Const CALG_RC2 As Long = &H6602&
Private Const CALG_MD5 As Long = &H8003&
Private Const CALG_HMAC As Long = &H8009&
Private Const CALG_SHA1 As Long = &H8004&
Private Const CALG_SHA_256 As Long = &H800C&
Private Const CALG_SHA_384 As Long = &H800D&
Private Const CALG_SHA_512 As Long = &H800E&
'--- for CryptGet/SetHashParam
Private Const HP_HASHVAL As Long = 2
Private Const HP_HMAC_INFO As Long = 5
'--- for CryptImportKey
Private Const PLAINTEXTKEYBLOB As Long = 8
Private Const CUR_BLOB_VERSION As Long = 2
Private Const CRYPT_IPSEC_HMAC_KEY As Long = &H100
Private Const LNG_FACILITY_WIN32 As Long = &H80070000
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function htonl Lib "ws2_32" (ByVal hostlong As Long) As Long
'--- advapi32
Private Declare Function CryptAcquireContext Lib "advapi32" Alias "CryptAcquireContextW" (phProv As Long, ByVal pszContainer As Long, ByVal pszProvider As Long, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptReleaseContext Lib "advapi32" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptImportKey Lib "advapi32" (ByVal hProv As Long, pbData As Any, ByVal dwDataLen As Long, ByVal hPubKey As Long, ByVal dwFlags As Long, phKey As Long) As Long
Private Declare Function CryptDestroyKey Lib "advapi32" (ByVal hKey As Long) As Long
Private Declare Function CryptGetHashParam Lib "advapi32" (ByVal hHash As Long, ByVal dwParam As Long, pbData As Any, pdwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptSetHashParam Lib "advapi32" (ByVal hHash As Long, ByVal dwParam As Long, pbData As Any, ByVal dwFlags As Long) As Long
Private Declare Function CryptCreateHash Lib "advapi32" (ByVal hProv As Long, ByVal AlgId As Long, ByVal hKey As Long, ByVal dwFlags As Long, phHash As Long) As Long
Private Declare Function CryptHashData Lib "advapi32" (ByVal hHash As Long, pbData As Any, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptDestroyHash Lib "advapi32" (ByVal hHash As Long) As Long
Private Type BLOBHEADER
bType As Byte
bVersion As Byte
reserved As Integer
aiKeyAlg As Long
cbKeySize As Long
Buffer(0 To 255) As Byte
End Type
Private Const sizeof_BLOBHEADER As Long = 12
Private Type HMAC_INFO
HashAlgid As Long
pbInnerString As Long
cbInnerString As Long
pbOuterString As Long
cbOuterString As Long
End Type
'=========================================================================
' Functions
'=========================================================================
Public Function DeriveKeyPBKDF2(sAlgId As String, baPass() As Byte, baSalt() As Byte, ByVal lNumIter As Long, baRetVal() As Byte) As Boolean
Dim lSize As Long
Dim lHashAlgId As Long
Dim lHashSize As Long
Dim hProv As Long
Dim uBlob As BLOBHEADER
Dim hKey As Long
Dim baHmac() As Byte
Dim lIdx As Long
Dim lRemaining As Long
Dim hResult As Long
Dim sApiSource As String
lSize = UBound(baRetVal) + 1
Select Case UCase$(sAlgId)
Case "SHA256"
lHashAlgId = CALG_SHA_256
lHashSize = 32
Case "SHA384"
lHashAlgId = CALG_SHA_384
lHashSize = 48
Case "SHA512"
lHashAlgId = CALG_SHA_512
lHashSize = 64
Case "MD5"
lHashAlgId = CALG_MD5
lHashSize = 16
Case Else
lHashAlgId = CALG_SHA1
lHashSize = 20
End Select
If CryptAcquireContext(hProv, 0, 0, PROV_RSA_AES, CRYPT_VERIFYCONTEXT) = 0 Then
hResult = Err.LastDllError
sApiSource = "CryptAcquireContext"
GoTo QH
End If
uBlob.bType = PLAINTEXTKEYBLOB
uBlob.bVersion = CUR_BLOB_VERSION
uBlob.aiKeyAlg = CALG_RC2
Debug.Assert UBound(uBlob.Buffer) >= UBound(baPass)
uBlob.cbKeySize = UBound(baPass) + 1
Call CopyMemory(uBlob.Buffer(0), baPass(0), uBlob.cbKeySize)
If CryptImportKey(hProv, uBlob, sizeof_BLOBHEADER + uBlob.cbKeySize, 0, CRYPT_IPSEC_HMAC_KEY, hKey) = 0 Then
hResult = Err.LastDllError
sApiSource = "CryptImportKey"
GoTo QH
End If
ReDim baHmac(0 To lHashSize - 1) As Byte
For lIdx = 0 To (lSize + lHashSize - 1) \ lHashSize - 1
If Not pvCryptoDeriveKeyHmacPrf(hProv, hKey, lHashAlgId, baSalt, htonl(lIdx + 1), lNumIter, baHmac) Then
GoTo QH
End If
lRemaining = lSize - lIdx * lHashSize
If lRemaining > lHashSize Then
lRemaining = lHashSize
End If
Call CopyMemory(baRetVal(lIdx * lHashSize), baHmac(0), lRemaining)
Next
'--- success
DeriveKeyPBKDF2 = True
QH:
If hKey <> 0 Then
Call CryptDestroyKey(hKey)
End If
If hProv <> 0 Then
Call CryptReleaseContext(hProv, 0)
End If
If LenB(sApiSource) <> 0 Then
Err.Raise IIf(hResult < 0, hResult, hResult Or LNG_FACILITY_WIN32), sApiSource
End If
End Function
Private Function pvCryptoDeriveKeyHmacPrf(ByVal hProv As Long, ByVal hKey As Long, ByVal lHashAlgId As Long, _
baSalt() As Byte, ByVal lCounter As Long, ByVal lNumIter As Long, baRetVal() As Byte) As Boolean
Dim hHash As Long
Dim uInfo As HMAC_INFO
Dim baTemp() As Byte
Dim lIdx As Long
Dim lJdx As Long
Dim hResult As Long
Dim sApiSource As String
uInfo.HashAlgid = lHashAlgId
baTemp = baRetVal
For lIdx = 0 To lNumIter - 1
If CryptCreateHash(hProv, CALG_HMAC, hKey, 0, hHash) = 0 Then
hResult = Err.LastDllError
sApiSource = "CryptCreateHash(CALG_HMAC)"
GoTo QH
End If
If CryptSetHashParam(hHash, HP_HMAC_INFO, uInfo, 0) = 0 Then
hResult = Err.LastDllError
sApiSource = "CryptSetHashParam(HP_HMAC_INFO)"
GoTo QH
End If
If lIdx = 0 Then
If UBound(baSalt) >= 0 Then
If CryptHashData(hHash, baSalt(0), UBound(baSalt) + 1, 0) = 0 Then
hResult = Err.LastDllError
sApiSource = "CryptHashData(baSalt)"
GoTo QH
End If
End If
If CryptHashData(hHash, lCounter, 4, 0) = 0 Then
hResult = Err.LastDllError
sApiSource = "CryptHashData(lCounter)"
GoTo QH
End If
Else
If CryptHashData(hHash, baTemp(0), UBound(baTemp) + 1, 0) = 0 Then
hResult = Err.LastDllError
sApiSource = "CryptHashData(baTemp)"
GoTo QH
End If
End If
If CryptGetHashParam(hHash, HP_HASHVAL, baTemp(0), UBound(baTemp) + 1, 0) = 0 Then
hResult = Err.LastDllError
sApiSource = "CryptGetHashParam(HP_HASHVAL)"
GoTo QH
End If
If hHash <> 0 Then
Call CryptDestroyHash(hHash)
hHash = 0
End If
If lIdx = 0 Then
baRetVal = baTemp
Else
For lJdx = 0 To UBound(baTemp)
baRetVal(lJdx) = baRetVal(lJdx) Xor baTemp(lJdx)
Next
End If
Next
'--- success
pvCryptoDeriveKeyHmacPrf = True
QH:
If hHash <> 0 Then
Call CryptDestroyHash(hHash)
End If
If LenB(sApiSource) <> 0 Then
Err.Raise IIf(hResult < 0, hResult, hResult Or LNG_FACILITY_WIN32), sApiSource
End If
End Function
Sample usage:
Code:
Private Sub Form_Load()
Dim baPass() As Byte
Dim baSalt(0 To 7) As Byte
Dim baDerivedKey() As Byte
baPass = StrConv("password123", vbFromUnicode)
pvGenRandom VarPtr(baSalt(0)), UBound(baSalt) + 1
'--- dimensioned to the output size of the required derived key
ReDim baDerivedKey(0 To 999) As Byte
If DeriveKeyPBKDF2("SHA512", baPass, baSalt, 10000, baDerivedKey) Then
Text1.SelLength = &H7FFF&
Text1.SelText = DesignDumpArray(baDerivedKey) & vbCrLf
End If
End Sub
cheers,
</wqw>
Last edited by wqweto; Dec 13th, 2021 at 01:55 PM.
-
Dec 13th, 2021, 12:48 PM
#2
Hyperactive Member
Re: [VB6] WinXP compatible PBKDF2
I forget to put pvGenRandom
-
Dec 13th, 2021, 01:05 PM
#3
Re: [VB6] WinXP compatible PBKDF2
Thanks for posting this...
Mostly for my own reassurance (but perhaps you welcome this post for the same reasons) -
I've just cross-checked yours with my own routine (we use it in SCRAM-Auth currently)...
and found no differences in the returned ByteArray-Results (for all the supported Hash-Functions).
The only thing which is a bit "inconvenient" in your implementation currently,
is that the passed result-array has to be properly redimed beforehand (in the right ByteSize, which matches the Hash-Algo)...
For a bit more comfort, I'd move this task into the routine itself.
E.g. for a moment, I was already considering looking for errors in my impl. (and yours),
because the results differed (having worked my way downwards to the "MD5" Hash-Initializers)...
until I realized that I made an "Off-By-One"-mistake in the defintion of your result-array...
(having accidentally defined it as (0 to 16) instead of (0 to 15)).
Anyways, here's my test-code:
Code:
Option Explicit
Private Sub Form_Load()
Dim Pass() As Byte: Pass = New_c.Crypt.VBStringToUTF8("some password")
Dim Salt() As Byte: Salt = New_c.Crypt.VBStringToUTF8("a bit of salt")
Dim RetBytes1() As Byte
RetBytes1 = PBKDF2(Pass, Salt, 123, "sha512")
ReDim RetBytes2(0 To 63) As Byte
DeriveKeyPBKDF2 "sha512", Pass, Salt, 123, RetBytes2
Caption = StrComp(RetBytes1, RetBytes2) = 0
End Sub
Public Function PBKDF2(Pass() As Byte, Salt() As Byte, ByVal Iterations As Long, Optional HashAlgo As String, Optional ByVal ReturnHexStr As Boolean)
Dim H() As Byte: H = Salt
ReDim Preserve H(UBound(H) + 4)
H(UBound(H)) = 1
Dim B() As Byte, i As Long, j As Long
For i = 0 To Iterations - 1
Select Case UCase$(HashAlgo)
Case "SHA512": H = New_c.Crypt.HMAC_SHA512(H, Pass, False)
Case "SHA384": H = New_c.Crypt.HMAC_SHA384(H, Pass, False)
Case "SHA256": H = New_c.Crypt.HMAC_SHA256(H, Pass, False)
Case "MD5": H = New_c.Crypt.HMAC_MD5(H, Pass, False)
Case Else: H = New_c.Crypt.HMAC_SHA1(H, Pass, False)
End Select
If i = 0 Then B = H Else For j = 0 To UBound(H): B(j) = B(j) Xor H(j): Next
Next
If Not ReturnHexStr Then PBKDF2 = B: Exit Function 'return Bytes
For i = 0 To UBound(B) 'return a HexString
PBKDF2 = PBKDF2 & LCase$(Right$("0" & Hex(B(i)), 2))
Next
End Function
Olaf
Last edited by Schmidt; Dec 13th, 2021 at 01:37 PM.
-
Dec 13th, 2021, 01:53 PM
#4
Re: [VB6] WinXP compatible PBKDF2
Yes, you have to dimension the RetBytes2 array before calling this function exactly to the size of the derived key you'll need produced.
If you need 1000 bytes of expanded key then you have to dimension the output array beforehand, there is no separate parameter for the desired output size to be used along the key derivation.
I actually used BCryptDeriveKeyPBKDF2 API function from CNG to compare/debug results.
Originally Posted by yokesee
I forget to put pvGenRandom
Not only (DesignDumpArray is missing too and there is no Text1 control too).
The sample code is not meant to be run but to show the gist of the function call (that's why it's somewhat more colorful).
cheers,
</wqw>
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|