-
Apr 29th, 2021, 12:17 PM
#1
Thread Starter
Hyperactive Member
[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.
-
Apr 29th, 2021, 03:41 PM
#2
Thread Starter
Hyperactive Member
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
-
May 3rd, 2021, 05:02 AM
#3
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>
Last edited by wqweto; May 3rd, 2021 at 05:16 AM.
-
May 4th, 2021, 12:05 AM
#4
Thread Starter
Hyperactive Member
Re: [RESOLVED] clsCrypt.cls
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
-
May 17th, 2022, 08:38 AM
#5
Member
Re: [RESOLVED] clsCrypt.cls
@LeanDroA; Can you post the GetbSize routine?
-
May 17th, 2022, 10:02 AM
#6
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
-
May 17th, 2022, 10:48 AM
#7
Re: [RESOLVED] clsCrypt.cls
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
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
|