CryptGenKey
Die Funktion CryptGenKey erstellt einen zufälligen Schlüssel zur Verschlüsselung von Daten.
<vb> Declare Function CryptGenKey Lib "advapi32.dll" ( _
ByVal hProv As Long, _ ByVal AlgID As Long, _ ByVal dwFlags As Long, _ ByRef phKey As Long) As Long</vb>
Parameter
phProv
- [in] Handle zu einem CSP. Ein solches Handle wird mit CryptAcquireContext erzeugt.
AlgID
- [in] Definiert den Verschlüsselungsalgorithmus für den der Schlüssel verwendet wird. Beispiele sind: CALG_AES_128 oder CALG_3DES_112
dwFlags
- [in] Flags welche die Schlüsselerstellung weiter steuern, z.B. CRYPT_EXPORTABLE. Mittels der oberen 16 Bits kann ausserdem die gewünschte Schlüssellänge angegeben werden.
phKey
- [out] In diesem Long Wert wird das Handle des erstellten Schlüssels zurückgegeben. Um den Schlüssel zu zerstören wird CryptDestroyKey verwendet.
Rückgabe(n)
Bei Erfolg wird ein Wert ungleich 0 zurückgegeben.
Beispiel
<vb>Const CALG_RSA_SIGN As Long = (ALG_CLASS_SIGNATURE Or ALG_TYPE_RSA Or ALG_SID_RSA_ANY)
If CryptGenKey(hCryptProv, CALG_RSA_SIGN, KeyLength * &H10000 Or _ CRYPT_EXPORTABLE, hRsaKey) = 0 Then Err.Raise Err.LastDllError, , "CryptGenKey Error!" End If</vb>
Ein komplettes Beispiel zum Ver- und Entschlüsseln findet sich unter CryptDecrypt
Das folgende Beispiel zeigt den sicheren Austausch eines (symmetrischen) DES Schlüssels mit Hilfe des asymmetrischen RSA Algorithmus: <vb> Option Explicit
Private Declare Function CryptAcquireContext Lib "advapi32.dll" _
Alias "CryptAcquireContextA" ( _ ByRef phProv As Long, _ ByVal pszContainer As String, _ ByVal pszProvider As String, _ ByVal dwProvType As Long, _ ByVal dwFlags As Long) As Long
Private Declare Function CryptReleaseContext Lib "advapi32.dll" ( _
ByVal hProv As Long, _ ByVal dwFlags As Long) As Long
Private Declare Function CryptDestroyKey Lib "advapi32.dll" ( _
ByVal hKey As Long) As Long
Private Declare Function CryptGenKey Lib "advapi32.dll" ( _
ByVal hProv As Long, _ ByVal AlgID As Long, _ ByVal dwFlags As Long, _ ByRef phKey As Long) As Long
Private Declare Function CryptGetUserKey Lib "advapi32.dll" ( _
ByVal hProv As Long, _ ByVal dwKeySpec As Long, _ ByRef phUserKey As Long) As Long
Private Declare Function CryptExportKey Lib "advapi32.dll" ( _
ByVal hKey As Long, _ ByVal hExhKey As Long, _ ByVal dwBlobType As Long, _ ByVal dwFlags As Long, _ ByRef pbData As Any, _ ByRef pdwDataLen As Long) As Long
Private Declare Function CryptImportKey Lib "advapi32.dll" ( _
ByVal hProv As Long, _ ByRef pbData As Any, _ ByVal dwDataLen As Long, _ ByVal hPubKey As Long, _ ByVal dwFlags As Long, _ ByRef phKey As Long) As Long
Private Declare Function CryptEncrypt Lib "advapi32.dll" ( _
ByVal hKey As Long, _ ByVal hHash As Long, _ ByVal Final As Long, _ ByVal dwFlags As Long, _ ByVal pbData As Long, _ ByRef pdwDataLen As Long, _ ByVal dwBufLen As Long) As Long
Private Declare Function CryptDecrypt Lib "advapi32.dll" ( _
ByVal hKey As Long, _ ByVal hHash As Long, _ ByVal Final As Long, _ ByVal dwFlags As Long, _ ByVal pbData As Long, _ ByRef pdwDataLen As Long) As Long
Private Const MS_DEF_PROV As String = _
"Microsoft Base Cryptographic Provider v1.0"
Private Const PROV_RSA_FULL As Long = 1
Private Const CRYPT_NEWKEYSET As Long = &H8
Private Const CRYPT_EXPORTABLE As Long = &H1
Private Const CRYPT_NO_SALT As Long = &H10
Private Const CRYPT_DELETEKEYSET As Long = &H10
Private Const AT_KEYEXCHANGE As Long = 1
Private Const PUBLICKEYBLOB As Long = &H6
Private Const SIMPLEBLOB As Long = &H1
Const ALG_CLASS_KEY_EXCHANGE As Long = &HA000& Const ALG_CLASS_HASH As Long = &H8000& Const ALG_CLASS_DATA_ENCRYPT As Long = &H6000& Const ALG_CLASS_SIGNATURE As Long = &H2000& Const ALG_TYPE_STREAM As Long = &H800& Const ALG_TYPE_BLOCK As Long = &H600& Const ALG_TYPE_RSA As Long = &H400& Const ALG_TYPE_ANY As Long = 0 Const ALG_SID_RSA_ANY As Long = 0 Const ALG_SID_MD2 As Long = 1 Const ALG_SID_MD4 As Long = 2 Const ALG_SID_MD5 As Long = 3 Const ALG_SID_SHA As Long = 4 Const ALG_SID_SHA_256 As Long = 12 Const ALG_SID_SHA_384 As Long = 13 Const ALG_SID_SHA_512 As Long = 14 Const ALG_SID_RC4 As Long = 1 Const ALG_SID_DES As Long = 1 Const ALG_SID_RC2 As Long = 2 Const ALG_SID_3DES As Long = 3 Const ALG_SID_3DES_112 As Long = 9 Const ALG_SID_AES_128 As Long = 14 Const ALG_SID_AES_192 As Long = 15 Const ALG_SID_AES_256 As Long = 16 Const ALG_SID_AES As Long = 17
'Encryption: Public Enum EnmCryptAlgo
CALG_RC2 = (ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_RC2) CALG_RC4 = (ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_STREAM Or ALG_SID_RC4) CALG_DES = (ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_DES) CALG_3DES = (ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_3DES) CALG_3DES_112 = (ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_3DES_112) CALG_AES_128 = (ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_AES_128) CALG_AES_192 = (ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_AES_192) CALG_AES_256 = (ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_AES_256)
End Enum
'Rsa Keyexchange and Signature Algorithmen (asymmetrisch): Enum EnmRsaKeyTypes
CALG_RSA_SIGN = (ALG_CLASS_SIGNATURE Or ALG_TYPE_RSA Or ALG_SID_RSA_ANY) CALG_RSA_KEYX = (ALG_CLASS_KEY_EXCHANGE Or ALG_TYPE_RSA Or ALG_SID_RSA_ANY)
End Enum
Private Sub Command1_Click()
Dim hCryptProvA As Long Dim hPrivateKey As Long Dim hSessionKeyA As Long Dim hCryptProvB As Long Dim hPublicKey As Long Dim hSessionKeyB As Long Dim cbData As Long Dim btPublicKey() As Byte Dim btSessionKeyData() As Byte Dim btData() As Byte Dim x As Long '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 'Partner A erstellt einen RSA KeyExchange Schlüssel und exportiert den öffentlichen 'Schlüsselteil:
'-------------------------------------------------------------------------------------- 'Provider Kontext anfordern und gegebenenfalls RSA KeyExchange Schlüssel erstellen: If CryptAcquireContext(hCryptProvA, "Mein Container A", MS_DEF_PROV, PROV_RSA_FULL, CRYPT_NEWKEYSET) = 0 Then 'Fehler->Existiert der Container bereits? If CryptAcquireContext(hCryptProvA, "Mein Container A", MS_DEF_PROV, PROV_RSA_FULL, 0) = 0 Then MsgBox "Kann MS Base Provider nicht finden!", vbExclamation, "Fehler:" 'bestehenden RSA KeyExchange Schlüssel ermitteln: ElseIf CryptGetUserKey(hCryptProvA, AT_KEYEXCHANGE, hPrivateKey) = 0 Then MsgBox "Kann auf bestehenden Schlüssel nicht zugreifen!", vbExclamation, "Fehler:" End If Else 'neuen RSA KeyExchange Schlüssel erzeugen: If CryptGenKey(hCryptProvA, CALG_RSA_KEYX, CRYPT_EXPORTABLE, hPrivateKey) = 0 Then MsgBox "Kann Schlüssel nicht erstellen!", vbExclamation, "Fehler:" End If End If '-------------------------------------------------------------------------------------- 'Öffentlichen Teil des KeyExchange Schlüssels exportieren: If CryptExportKey(hPrivateKey, 0, PUBLICKEYBLOB, 0, ByVal 0, cbData) = 0 Then MsgBox "Kann Schlüssel Länge nicht ermitteln!", vbExclamation, "Fehler:" Else 'Speicher reservieren und Schlüsseldaten abholen: ReDim Preserve btPublicKey(cbData - 1) If CryptExportKey(hPrivateKey, 0, PUBLICKEYBLOB, 0, btPublicKey(0), cbData) = 0 Then MsgBox "Kann Schlüssel nicht exportieren!", vbExclamation, "Fehler:" End If End If '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 'Die öffentlichen Schlüsseldaten werden nun an den Partner B übermittelt, dort importiert, 'ein zufälliger symmetrischer Sessionkey erstellt und dieser exportiert wobei die 'Schlüsseldaten mit dem öffentlichen Schlüssel von Partner A verschlüsselt werden: '-------------------------------------------------------------------------------------- If CryptAcquireContext(hCryptProvB, "Mein Container B", MS_DEF_PROV, PROV_RSA_FULL, CRYPT_NEWKEYSET) = 0 Then 'Fehler->Existiert der Container bereits? If CryptAcquireContext(hCryptProvB, "Mein Container B", MS_DEF_PROV, PROV_RSA_FULL, 0) = 0 Then MsgBox "Kann MS Base Provider nicht finden!", vbExclamation, "Fehler:" End If End If 'Öffentlichen Schlüssel importieren: If CryptImportKey(hCryptProvB, btPublicKey(0), UBound(btPublicKey) + 1, 0, 0, hPublicKey) = 0 Then MsgBox "Kann Schlüssel nicht importieren!", vbExclamation, "Fehler:" 'Sessionkey erstellen: ElseIf CryptGenKey(hCryptProvB, CALG_DES, CRYPT_EXPORTABLE Or CRYPT_NO_SALT, hSessionKeyB) = 0 Then MsgBox "Kann Sessionkey nicht erstellen!", vbExclamation, "Fehler:" 'Sessionkey exportieren: ElseIf CryptExportKey(hSessionKeyB, hPublicKey, SIMPLEBLOB, 0, ByVal 0, cbData) <> 0 Then ReDim btSessionKeyData(cbData - 1) If CryptExportKey(hSessionKeyB, hPublicKey, SIMPLEBLOB, 0, btSessionKeyData(0), cbData) = 0 Then MsgBox "Kann Sessionkey nicht exportieren!", vbExclamation, "Fehler:" 'der Public Key wird nicht mehr benötigt -> zerstören: ElseIf CryptDestroyKey(hPublicKey) = 0 Then MsgBox "Kann Public Key nicht zerstören!", vbExclamation, "Fehler:" End If End If
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 'Die Daten des symmetrischen Sessionkeys werden nun zurück an den Partner A übermittelt, 'dort importiert, und nun besitzen beide Partner den selben Schlüssel der zum Austausch 'der Informationen verwendet werden kann: 'Sessionkey importieren (mit private key entschlüsseln): If CryptImportKey(hCryptProvA, btSessionKeyData(0), _ UBound(btSessionKeyData) + 1, hPrivateKey, 0, hSessionKeyA) = 0 Then MsgBox "Kann Sessionkey nicht importieren!", vbExclamation, "Fehler:" 'der KeyExchange Schlüssel wird nun nicht mehr benötigt: ElseIf CryptDestroyKey(hPrivateKey) = 0 Then MsgBox "Kann Private Key nicht zerstören!", vbExclamation, "Fehler:" End If btData = "Hello World!" 'Länge der verschlüsselten Daten ermitteln: cbData = UBound(btData) + 1 If CryptEncrypt(hSessionKeyA, 0, 1, 0, 0, cbData, 0) = 0 Then MsgBox "Kann Länge nicht ermitteln!", vbExclamation, "Fehler:" Else 'Speicher reservieren und verschlüsselte Daten abholen: x = UBound(btData) + 1 ReDim Preserve btData(cbData - 1) cbData = x If CryptEncrypt(hSessionKeyA, 0, 1, 0, VarPtr(btData(0)), cbData, UBound(btData) + 1) = 0 Then MsgBox "Kann Daten nicht verschlüsseln!", vbExclamation, "Fehler:" Else 'jetzt wieder entschlüsseln: If CryptDecrypt(hSessionKeyB, 0, 1, 0, VarPtr(btData(0)), cbData) = 0 Then MsgBox "Kann Daten nicht entschlüsseln!", vbExclamation, "Fehler:" Else ReDim Preserve btData(cbData - 1) MsgBox "Wieder entschlüsselt: " & CStr(btData), vbInformation, "Erfolgreich:" End If End If End If
If hSessionKeyA <> 0 Then CryptDestroyKey hSessionKeyA If hSessionKeyB <> 0 Then CryptDestroyKey hSessionKeyB If hCryptProvA <> 0 Then CryptReleaseContext hCryptProvA, 0 If hCryptProvB <> 0 Then CryptReleaseContext hCryptProvB, 0 CryptAcquireContext hCryptProvA, "Mein Container B", MS_DEF_PROV, PROV_RSA_FULL, CRYPT_DELETEKEYSET CryptAcquireContext hCryptProvB, "Mein Container A", MS_DEF_PROV, PROV_RSA_FULL, CRYPT_DELETEKEYSET
End Sub
</vb>