Results 1 to 4 of 4

Thread: [VB6] WinXP compatible PBKDF2

  1. #1

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    [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>

  2. #2
    Hyperactive Member
    Join Date
    Jun 2016
    Location
    EspaƱa
    Posts
    506

    Re: [VB6] WinXP compatible PBKDF2

    I forget to put pvGenRandom

  3. #3
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,219

    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.

  4. #4

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    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.

    Quote Originally Posted by yokesee View Post
    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
  •  



Click Here to Expand Forum to Full Width