'description d'un objet binaire large
Private Type DATA_BLOB
    cbData As Long
    pbData As Long
End Type
'protège des données pour la session en cours
Private Declare Function CryptProtectData Lib "crypt32.dll" (ByRef pDataIn As DATA_BLOB, ByVal szDataDescr As String, ByVal pOptionalEntropy As Long, ByVal pvReserved As Long, ByVal pPromptStruct As Long, ByVal dwFlags As Long, ByRef pDataOut As DATA_BLOB) As Long
'déprotège des données pour la session en cours
Private Declare Function CryptUnprotectData Lib "crypt32.dll" (ByRef pDataIn As DATA_BLOB, ByVal ppszDataDescr As Long, ByVal pOptionalEntropy As Long, ByRef pvReserved As Any, ByVal pPromptStruct As Long, ByVal dwFlags As Long, ByRef pDataOut As DATA_BLOB) As Long
'copie une zone mémoire dans une autre
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
'libère de la mémoire allouée
Private Declare Function LocalFree Lib "kernel32.dll" (ByVal hMem As Long) As Long
'affiche un message d'erreur windows
'===================================
'errCode : code d'erreur
Public Sub ShowErr(ByVal errCode As Long)
On Local Error GoTo Fin
'&H80070000 -> &H8007FFFF : map les codes d'erreus ERROR_XXX de Windows
Err.Raise &H80070000 + errCode
Fin:
    MsgBox Err.Description, vbCritical
End Sub
'chiffre des données pour la session en cours
'============================================
'ptrData : pointeur vers les données à chiffrer
'dwDataSize : taille des données à chiffrer
'ptrEntropy : pointeur vers des données de salissures pour complexifier le déchiffrage hors session
'dwEntropySize : taille des données de salissures
'outBuff : données chiffrées
'renvoie un code d'erreur (ou ERROR_SUCCESS)
Public Function Crypt(ByVal ptrData As Long, ByVal dwDataSize As Long, ByVal ptrEntropy As Long, ByVal dwEntropySize As Long, outBuff() As Byte) As Long
Dim DataIn As DATA_BLOB, DataOut As DATA_BLOB, entropy As DATA_BLOB
Dim pEntr As Long
'remplit les données entrantes
DataIn.cbData = dwDataSize
DataIn.pbData = ptrData
entropy.cbData = dwEntropySize
entropy.pbData = ptrEntropy
If ptrEntropy Then
    pEntr = VarPtr(entropy)
Else
    pEntr = 0
End If
'chiffre les données
If CryptProtectData(DataIn, "", pEntr, 0&, 0&, 0&, DataOut) = 0 Then
    Crypt = Err.LastDllError
Else
    'récupère les données chiffrées
    ReDim outBuff(DataOut.cbData - 1)
    CopyMemory outBuff(0), ByVal DataOut.pbData, DataOut.cbData
    LocalFree DataOut.pbData
    Crypt = 0
End If
End Function

'déchiffre des données pour la session en cours
'============================================
'ptrData : pointeur vers les données à déchiffrer
'dwDataSize : taille des données à déchiffrer
'ptrEntropy : pointeur vers des données de salissures pour complexifier le déchiffrage hors session
'dwEntropySize : taille des données de salissures
'outBuff : données déchiffrées
'renvoie un code d'erreur (ou ERROR_SUCCESS)
Public Function Decrypt(ByVal ptrData As Long, ByVal dwDataSize As Long, ByVal ptrEntropy As Long, ByVal dwEntropySize As Long, outBuff() As Byte) As Long
Dim DataIn As DATA_BLOB, DataOut As DATA_BLOB, entropy As DATA_BLOB
Dim pEntr As Long
'remplit les données entrantes
DataIn.cbData = dwDataSize
DataIn.pbData = ptrData
entropy.cbData = dwEntropySize
entropy.pbData = ptrEntropy
If ptrEntropy Then
    pEntr = VarPtr(entropy)
Else
    pEntr = 0
End If
'déchiffre les données
If CryptUnprotectData(DataIn, 0&, pEntr, 0&, 0&, 0&, DataOut) = 0 Then
    Decrypt = Err.LastDllError
Else
    'récupère les données déchiffrées
    ReDim outBuff(DataOut.cbData - 1)
    CopyMemory outBuff(0), ByVal DataOut.pbData, DataOut.cbData
    LocalFree DataOut.pbData
    Decrypt = 0
End If
End Function