Results 1 to 7 of 7

Thread: [RESOLVED] clsCrypt.cls

  1. #1

    Thread Starter
    Hyperactive Member
    Join Date
    Dec 2008
    Location
    Argentina
    Posts
    439

    Resolved [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)
    Last edited by LeandroA; Apr 29th, 2021 at 12:23 PM.
    leandroascierto.com Visual Basic 6 projects

  2. #2

    Thread Starter
    Hyperactive Member
    Join Date
    Dec 2008
    Location
    Argentina
    Posts
    439

    Re: clsCrypt.cls

    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
    leandroascierto.com Visual Basic 6 projects

  3. #3
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: [RESOLVED] clsCrypt.cls

    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>

  4. #4

    Thread Starter
    Hyperactive Member
    Join Date
    Dec 2008
    Location
    Argentina
    Posts
    439

    Re: [RESOLVED] clsCrypt.cls

    Quote Originally Posted by wqweto View Post
    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
    leandroascierto.com Visual Basic 6 projects

  5. #5
    Member
    Join Date
    Nov 2019
    Posts
    33

    Re: [RESOLVED] clsCrypt.cls

    @LeanDroA; Can you post the GetbSize routine?

  6. #6
    PowerPoster Arnoutdv's Avatar
    Join Date
    Oct 2013
    Posts
    5,872

    Re: [RESOLVED] clsCrypt.cls

    I assume it's something like this
    Code:
    Public Function GetbSize(btArray() As Byte) As Long
      GetbSize= UBound(btArray) - LBound(btArray) + 1
    End Function

  7. #7
    Frenzied Member
    Join Date
    Dec 2012
    Posts
    1,470

    Re: [RESOLVED] clsCrypt.cls

    Quote Originally Posted by Juggler_IN View Post
    @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

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