CryptGenKey: Unterschied zwischen den Versionen

Aus API-Wiki
Wechseln zu: Navigation, Suche
K (vb)
 
(51 dazwischenliegende Versionen von 28 Benutzern werden nicht angezeigt)
Zeile 2: Zeile 2:
 
Die Funktion [[CryptGenKey]] erstellt einen zufälligen Schlüssel zur Verschlüsselung von Daten.
 
Die Funktion [[CryptGenKey]] erstellt einen zufälligen Schlüssel zur Verschlüsselung von Daten.
  
<vb>
+
<syntaxhighlight lang="vb">
 
Declare Function CryptGenKey Lib "advapi32.dll" ( _
 
Declare Function CryptGenKey Lib "advapi32.dll" ( _
 
                 ByVal hProv As Long, _
 
                 ByVal hProv As Long, _
 
                 ByVal AlgID As Long, _
 
                 ByVal AlgID As Long, _
 
                 ByVal dwFlags As Long, _
 
                 ByVal dwFlags As Long, _
                 ByRef phKey As Long) As Long</vb>
+
                 ByRef phKey As Long) As Long</syntaxhighlight>
  
 
===Parameter===
 
===Parameter===
Zeile 26: Zeile 26:
  
 
===Beispiel===
 
===Beispiel===
<vb>Const CALG_RSA_SIGN As Long = (ALG_CLASS_SIGNATURE Or ALG_TYPE_RSA Or ALG_SID_RSA_ANY)
+
<syntaxhighlight lang="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 _
 
     If CryptGenKey(hCryptProv, CALG_RSA_SIGN, KeyLength * &H10000 Or _
 
             CRYPT_EXPORTABLE, hRsaKey) = 0 Then
 
             CRYPT_EXPORTABLE, hRsaKey) = 0 Then
 
         Err.Raise Err.LastDllError, , "CryptGenKey Error!"
 
         Err.Raise Err.LastDllError, , "CryptGenKey Error!"
     End If</vb>
+
     End If</syntaxhighlight>
  
 
Ein komplettes Beispiel zum Ver- und Entschlüsseln findet sich unter [[CryptDecrypt]]
 
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:
 +
<syntaxhighlight lang="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
 +
 +
</syntaxhighlight>
 +
<br><br>
 +
Das folgende Beispiel zeigt den Schlüsseltausch mit Hilfe des Diffie-Hellman Algorithmus:
 +
<syntaxhighlight lang="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 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 Declare Function CryptSetKeyParam Lib "advapi32.dll" ( _
 +
                ByVal hKey As Long, _
 +
                ByVal dwParam As Long, _
 +
                ByRef pbData As Any, _
 +
                ByVal dwFlags As Long) As Long
 +
 +
Private Declare Function CryptGetKeyParam Lib "advapi32.dll" ( _
 +
                ByVal hKey As Long, _
 +
                ByVal dwParam As Long, _
 +
                ByRef pbData As Any, _
 +
                ByRef pdwDataLen As Long, _
 +
                ByVal dwFlags As Long) As Long
 +
 
 +
Private Type CRYPT_DATA_BLOB_VB
 +
    cbData As Long
 +
    pbData As Long
 +
    Data() As Byte
 +
End Type
 +
 +
Private Const MS_DEF_PROV As String = _
 +
                    "Microsoft Base Cryptographic Provider v1.0"
 +
 +
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 CRYPT_PREGEN        As Long = &H40
 +
 +
Private Const PUBLICKEYBLOB As Long = &H6
 +
 +
Private Const KP_ALGID  As Long = 7
 +
Private Const KP_P      As Long = 11
 +
Private Const KP_G      As Long = 12
 +
Private Const KP_X      As Long = 14
 +
 +
 +
Private Const ALG_CLASS_KEY_EXCHANGE As Long = &HA000&
 +
Private Const ALG_CLASS_HASH        As Long = &H8000&
 +
Private Const ALG_CLASS_DATA_ENCRYPT As Long = &H6000&
 +
Private Const ALG_CLASS_SIGNATURE    As Long = &H2000&
 +
 +
Private Const ALG_TYPE_ANY          As Long = 0
 +
Private Const ALG_TYPE_RSA          As Long = &H400&
 +
Private Const ALG_TYPE_BLOCK        As Long = &H600&
 +
Private Const ALG_TYPE_STREAM        As Long = &H800&
 +
Private Const ALG_TYPE_DH            As Long = &HA00&
 +
 +
Private Const ALG_SID_RSA_ANY        As Long = 0
 +
Private Const ALG_SID_DH_SANDF      As Long = 1 ' Diffie-Hellman
 +
Private Const ALG_SID_DH_EPHEM      As Long = 2 ' Diffie-Hellman
 +
 +
Private Const ALG_SID_MD2            As Long = 1
 +
Private Const ALG_SID_MD4            As Long = 2
 +
Private Const ALG_SID_MD5            As Long = 3
 +
Private Const ALG_SID_SHA            As Long = 4
 +
Private Const ALG_SID_SHA_256        As Long = 12
 +
Private Const ALG_SID_SHA_384        As Long = 13
 +
Private Const ALG_SID_SHA_512        As Long = 14
 +
 +
Private Const ALG_SID_RC4            As Long = 1
 +
Private Const ALG_SID_DES            As Long = 1
 +
Private Const ALG_SID_RC2            As Long = 2
 +
Private Const ALG_SID_3DES          As Long = 3
 +
Private Const ALG_SID_3DES_112      As Long = 9
 +
Private Const ALG_SID_AES_128        As Long = 14
 +
Private Const ALG_SID_AES_192        As Long = 15
 +
Private Const ALG_SID_AES_256        As Long = 16
 +
Private Const ALG_SID_AES            As Long = 17
 +
 +
'Encryption (symmetrisch):
 +
Private 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
 +
 +
'Keyexchange and Signature Algorithmen (asymmetrisch):
 +
Private Enum EnmKeyTypes
 +
    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)
 +
    CALG_DH_SF = (ALG_CLASS_KEY_EXCHANGE Or ALG_TYPE_DH Or ALG_SID_DH_SANDF)
 +
    CALG_DH_EPHEM = (ALG_CLASS_KEY_EXCHANGE Or ALG_TYPE_DH Or ALG_SID_DH_EPHEM)
 +
End Enum
 +
 +
Private Const MS_ENH_DSS_DH_PROV As String = _
 +
                    "Microsoft Enhanced DSS and Diffie-Hellman Cryptographic Provider"
 +
Private Const PROV_DSS_DH As Long = 13
 +
 +
 +
Private Sub Command1_Click()
 +
    Dim hCryptProvA As Long
 +
    Dim hPrivateKeyA As Long
 +
    Dim btPublicKeyA() As Byte
 +
    Dim hSessionKeyA As Long
 +
   
 +
    Dim hCryptProvB As Long
 +
    Dim hPrivateKeyB As Long
 +
    Dim btPublicKeyB() As Byte
 +
    Dim hSessionKeyB As Long
 +
   
 +
    Dim cbData As Long
 +
    Dim btData() As Byte
 +
    Dim x As Long
 +
   
 +
    Dim P_Blob As CRYPT_DATA_BLOB_VB
 +
    Dim G_Blob As CRYPT_DATA_BLOB_VB
 +
   
 +
    Const KEY_LENGTH As Long = 1024
 +
   
 +
    'etwaige alte Container löschen
 +
    CryptAcquireContext hCryptProvA, "Mein Container B", MS_ENH_DSS_DH_PROV, PROV_DSS_DH, CRYPT_DELETEKEYSET
 +
    CryptAcquireContext hCryptProvB, "Mein Container A", MS_ENH_DSS_DH_PROV, PROV_DSS_DH, CRYPT_DELETEKEYSET
 +
   
 +
   
 +
    '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 +
    'Partner A erstellt einen D-H KeyExchange Schlüssel und exportiert den öffentlichen
 +
    'Schlüsselteil sowie die Parameter P und G:
 +
 +
    '--------------------------------------------------------------------------------------
 +
    'Provider Kontext anfordern und Schlüssel erstellen:
 +
    If CryptAcquireContext(hCryptProvA, "Mein Container A", MS_ENH_DSS_DH_PROV, PROV_DSS_DH, CRYPT_NEWKEYSET) = 0 Then
 +
        MsgBox "Kann Provider Kontext nicht öffnen!", vbExclamation, "Fehler:"
 +
    ElseIf CryptGenKey(hCryptProvA, CALG_DH_SF, KEY_LENGTH * &H10000 Or CRYPT_EXPORTABLE, hPrivateKeyA) = 0 Then
 +
        MsgBox "Kann Schlüssel nicht erstellen!", vbExclamation, "Fehler:"
 +
    End If
 +
 +
    '--------------------------------------------------------------------------------------
 +
    'Öffentlichen Teil des KeyExchange Schlüssels exportieren:
 +
    If CryptExportKey(hPrivateKeyA, 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 btPublicKeyA(cbData - 1)
 +
        If CryptExportKey(hPrivateKeyA, 0, PUBLICKEYBLOB, 0, btPublicKeyA(0), cbData) = 0 Then
 +
            MsgBox "Kann Schlüssel nicht exportieren!", vbExclamation, "Fehler:"
 +
        End If
 +
    End If
 +
 +
    '--------------------------------------------------------------------------------------
 +
    'P und G exportieren:
 +
    ReDim P_Blob.Data(KEY_LENGTH / 8 - 1)
 +
    P_Blob.cbData = KEY_LENGTH / 8
 +
    P_Blob.pbData = VarPtr(P_Blob.Data(0))
 +
 +
    ReDim G_Blob.Data(KEY_LENGTH / 8 - 1)
 +
    G_Blob.cbData = KEY_LENGTH / 8
 +
    G_Blob.pbData = VarPtr(G_Blob.Data(0))
 +
 +
    If CryptGetKeyParam(hPrivateKeyA, KP_G, G_Blob.Data(0), G_Blob.cbData, 0) = 0 Then
 +
        MsgBox "Kann G nicht lesen!", vbExclamation, "Fehler:"
 +
    ElseIf CryptGetKeyParam(hPrivateKeyA, KP_P, P_Blob.Data(0), P_Blob.cbData, 0) = 0 Then
 +
        MsgBox "Kann P nicht lesen!", vbExclamation, "Fehler:"
 +
    End If
 +
   
 +
    '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 +
    'Die öffentlichen Schlüsseldaten, P und G werden nun an den Partner B übermittelt.
 +
    'Partner B erstellt seinerseits einen D-H KeyExchange Schlüssel mit den erhaltenen
 +
    'Parametern P und G, exportiert den öffentlichen Schlüsselteil und übermittelt diesen
 +
    'an Partner A:
 +
 +
    '--------------------------------------------------------------------------------------
 +
    'Provider Kontext anfordern und Schlüssel erstellen:
 +
    If CryptAcquireContext(hCryptProvB, "Mein Container B", MS_ENH_DSS_DH_PROV, PROV_DSS_DH, CRYPT_NEWKEYSET) = 0 Then
 +
        MsgBox "Kann Provider Kontext nicht öffnen!", vbExclamation, "Fehler:"
 +
    ElseIf CryptGenKey(hCryptProvB, CALG_DH_SF, KEY_LENGTH * &H10000 Or CRYPT_EXPORTABLE Or CRYPT_PREGEN, hPrivateKeyB) = 0 Then
 +
        MsgBox "Kann Schlüssel nicht erstellen!", vbExclamation, "Fehler:"
 +
    End If
 +
   
 +
    '--------------------------------------------------------------------------------------
 +
    'P und G importieren:
 +
    If CryptSetKeyParam(hPrivateKeyB, KP_G, G_Blob, 0) = 0 Then
 +
        MsgBox "Kann G nicht setzen!", vbExclamation, "Fehler:"
 +
    ElseIf CryptSetKeyParam(hPrivateKeyB, KP_P, P_Blob, 0) = 0 Then
 +
        MsgBox "Kann P nicht setzen!", vbExclamation, "Fehler:"
 +
    ElseIf CryptSetKeyParam(hPrivateKeyB, KP_X, ByVal 0, 0) = 0 Then
 +
        MsgBox "Kann X nicht generieren!", vbExclamation, "Fehler:"
 +
    End If
 +
   
 +
    '--------------------------------------------------------------------------------------
 +
    'Öffentlichen Teil des KeyExchange Schlüssels exportieren:
 +
    If CryptExportKey(hPrivateKeyB, 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 btPublicKeyB(cbData - 1)
 +
        If CryptExportKey(hPrivateKeyB, 0, PUBLICKEYBLOB, 0, btPublicKeyB(0), cbData) = 0 Then
 +
            MsgBox "Kann Schlüssel nicht exportieren!", vbExclamation, "Fehler:"
 +
        End If
 +
    End If
 +
   
 +
    '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 +
    'Beide öffentlichen Schlüsseldaten werden nun importiert und der gemeinsame Sessionkey
 +
    'kann daraus ermittelt werden:
 +
   
 +
    '--------------------------------------------------------------------------------------
 +
    'Öffentliche Schlüssel importieren:
 +
    If CryptImportKey(hCryptProvB, btPublicKeyA(0), UBound(btPublicKeyA) + 1, hPrivateKeyB, 0, hSessionKeyB) = 0 Then
 +
        MsgBox "Kann Schlüssel A nicht importieren!", vbExclamation, "Fehler:"
 +
    ElseIf CryptImportKey(hCryptProvA, btPublicKeyB(0), UBound(btPublicKeyB) + 1, hPrivateKeyA, 0, hSessionKeyA) = 0 Then
 +
        MsgBox "Kann Schlüssel B nicht importieren!", vbExclamation, "Fehler:"
 +
    End If
 +
   
 +
    '--------------------------------------------------------------------------------------
 +
    'zu Sessionkey umwandeln:
 +
    If CryptSetKeyParam(hSessionKeyA, KP_ALGID, CALG_RC4, 0) = 0 Then
 +
        MsgBox "Kann Schlüssel nicht umwandeln!", vbExclamation, "Fehler:"
 +
    ElseIf CryptSetKeyParam(hSessionKeyB, KP_ALGID, CALG_RC4, 0) = 0 Then
 +
        MsgBox "Kann Schlüssel nicht umwandeln!", vbExclamation, "Fehler:"
 +
    End If
 +
 +
    '--------------------------------------------------------------------------------------
 +
    'die D-H Schlüssel werden nun nicht mehr benötigt:
 +
    CryptDestroyKey hPrivateKeyA
 +
    CryptDestroyKey hPrivateKeyB
 +
 +
 +
 +
 +
    '--------------------------------------------------------------------------------------
 +
    'Test:
 +
    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
 +
End Sub
 +
</syntaxhighlight>
 
[[Kategorie:Crypt Api]]
 
[[Kategorie:Crypt Api]]
 +
[[Kategorie:Funktionen]]

Aktuelle Version vom 5. November 2016, 23:46 Uhr

Die Funktion CryptGenKey erstellt einen zufälligen Schlüssel zur Verschlüsselung von Daten.

Declare Function CryptGenKey Lib "advapi32.dll" ( _
                 ByVal hProv As Long, _
                 ByVal AlgID As Long, _
                 ByVal dwFlags As Long, _
                 ByRef phKey As Long) As Long

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

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

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:

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



Das folgende Beispiel zeigt den Schlüsseltausch mit Hilfe des Diffie-Hellman Algorithmus:

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 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 Declare Function CryptSetKeyParam Lib "advapi32.dll" ( _
                ByVal hKey As Long, _
                ByVal dwParam As Long, _
                ByRef pbData As Any, _
                ByVal dwFlags As Long) As Long

Private Declare Function CryptGetKeyParam Lib "advapi32.dll" ( _
                ByVal hKey As Long, _
                ByVal dwParam As Long, _
                ByRef pbData As Any, _
                ByRef pdwDataLen As Long, _
                ByVal dwFlags As Long) As Long
  
Private Type CRYPT_DATA_BLOB_VB
    cbData As Long
    pbData As Long
    Data() As Byte
End Type

Private Const MS_DEF_PROV As String = _
                    "Microsoft Base Cryptographic Provider v1.0"
 
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 CRYPT_PREGEN         As Long = &H40

Private Const PUBLICKEYBLOB As Long = &H6

Private Const KP_ALGID  As Long = 7
Private Const KP_P      As Long = 11
Private Const KP_G      As Long = 12
Private Const KP_X      As Long = 14


Private Const ALG_CLASS_KEY_EXCHANGE As Long = &HA000&
Private Const ALG_CLASS_HASH         As Long = &H8000&
Private Const ALG_CLASS_DATA_ENCRYPT As Long = &H6000&
Private Const ALG_CLASS_SIGNATURE    As Long = &H2000&

Private Const ALG_TYPE_ANY           As Long = 0
Private Const ALG_TYPE_RSA           As Long = &H400&
Private Const ALG_TYPE_BLOCK         As Long = &H600&
Private Const ALG_TYPE_STREAM        As Long = &H800&
Private Const ALG_TYPE_DH            As Long = &HA00&

Private Const ALG_SID_RSA_ANY        As Long = 0
Private Const ALG_SID_DH_SANDF       As Long = 1 ' Diffie-Hellman
Private Const ALG_SID_DH_EPHEM       As Long = 2 ' Diffie-Hellman

Private Const ALG_SID_MD2            As Long = 1
Private Const ALG_SID_MD4            As Long = 2
Private Const ALG_SID_MD5            As Long = 3
Private Const ALG_SID_SHA            As Long = 4
Private Const ALG_SID_SHA_256        As Long = 12
Private Const ALG_SID_SHA_384        As Long = 13
Private Const ALG_SID_SHA_512        As Long = 14

Private Const ALG_SID_RC4            As Long = 1
Private Const ALG_SID_DES            As Long = 1
Private Const ALG_SID_RC2            As Long = 2
Private Const ALG_SID_3DES           As Long = 3
Private Const ALG_SID_3DES_112       As Long = 9
Private Const ALG_SID_AES_128        As Long = 14
Private Const ALG_SID_AES_192        As Long = 15
Private Const ALG_SID_AES_256        As Long = 16
Private Const ALG_SID_AES            As Long = 17
 
'Encryption (symmetrisch):
Private 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

'Keyexchange and Signature Algorithmen (asymmetrisch):
Private Enum EnmKeyTypes
    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)
    CALG_DH_SF = (ALG_CLASS_KEY_EXCHANGE Or ALG_TYPE_DH Or ALG_SID_DH_SANDF)
    CALG_DH_EPHEM = (ALG_CLASS_KEY_EXCHANGE Or ALG_TYPE_DH Or ALG_SID_DH_EPHEM)
End Enum

Private Const MS_ENH_DSS_DH_PROV As String = _
                    "Microsoft Enhanced DSS and Diffie-Hellman Cryptographic Provider"
Private Const PROV_DSS_DH As Long = 13

 
Private Sub Command1_Click()
    Dim hCryptProvA As Long
    Dim hPrivateKeyA As Long
    Dim btPublicKeyA() As Byte
    Dim hSessionKeyA As Long
    
    Dim hCryptProvB As Long
    Dim hPrivateKeyB As Long
    Dim btPublicKeyB() As Byte
    Dim hSessionKeyB As Long
    
    Dim cbData As Long
    Dim btData() As Byte
    Dim x As Long
    
    Dim P_Blob As CRYPT_DATA_BLOB_VB
    Dim G_Blob As CRYPT_DATA_BLOB_VB
    
    Const KEY_LENGTH As Long = 1024
    
    'etwaige alte Container löschen
    CryptAcquireContext hCryptProvA, "Mein Container B", MS_ENH_DSS_DH_PROV, PROV_DSS_DH, CRYPT_DELETEKEYSET
    CryptAcquireContext hCryptProvB, "Mein Container A", MS_ENH_DSS_DH_PROV, PROV_DSS_DH, CRYPT_DELETEKEYSET
    
    
    '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    'Partner A erstellt einen D-H KeyExchange Schlüssel und exportiert den öffentlichen
    'Schlüsselteil sowie die Parameter P und G:

    '--------------------------------------------------------------------------------------
    'Provider Kontext anfordern und Schlüssel erstellen:
    If CryptAcquireContext(hCryptProvA, "Mein Container A", MS_ENH_DSS_DH_PROV, PROV_DSS_DH, CRYPT_NEWKEYSET) = 0 Then
        MsgBox "Kann Provider Kontext nicht öffnen!", vbExclamation, "Fehler:"
    ElseIf CryptGenKey(hCryptProvA, CALG_DH_SF, KEY_LENGTH * &H10000 Or CRYPT_EXPORTABLE, hPrivateKeyA) = 0 Then
        MsgBox "Kann Schlüssel nicht erstellen!", vbExclamation, "Fehler:"
    End If
 
    '--------------------------------------------------------------------------------------
    'Öffentlichen Teil des KeyExchange Schlüssels exportieren:
    If CryptExportKey(hPrivateKeyA, 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 btPublicKeyA(cbData - 1)
        If CryptExportKey(hPrivateKeyA, 0, PUBLICKEYBLOB, 0, btPublicKeyA(0), cbData) = 0 Then
            MsgBox "Kann Schlüssel nicht exportieren!", vbExclamation, "Fehler:"
        End If
    End If
 
    '--------------------------------------------------------------------------------------
    'P und G exportieren:
    ReDim P_Blob.Data(KEY_LENGTH / 8 - 1)
    P_Blob.cbData = KEY_LENGTH / 8
    P_Blob.pbData = VarPtr(P_Blob.Data(0))
 
    ReDim G_Blob.Data(KEY_LENGTH / 8 - 1)
    G_Blob.cbData = KEY_LENGTH / 8
    G_Blob.pbData = VarPtr(G_Blob.Data(0))
 
    If CryptGetKeyParam(hPrivateKeyA, KP_G, G_Blob.Data(0), G_Blob.cbData, 0) = 0 Then
        MsgBox "Kann G nicht lesen!", vbExclamation, "Fehler:"
    ElseIf CryptGetKeyParam(hPrivateKeyA, KP_P, P_Blob.Data(0), P_Blob.cbData, 0) = 0 Then
        MsgBox "Kann P nicht lesen!", vbExclamation, "Fehler:"
    End If
    
    '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    'Die öffentlichen Schlüsseldaten, P und G werden nun an den Partner B übermittelt.
    'Partner B erstellt seinerseits einen D-H KeyExchange Schlüssel mit den erhaltenen
    'Parametern P und G, exportiert den öffentlichen Schlüsselteil und übermittelt diesen
    'an Partner A:
 
    '--------------------------------------------------------------------------------------
    'Provider Kontext anfordern und Schlüssel erstellen:
    If CryptAcquireContext(hCryptProvB, "Mein Container B", MS_ENH_DSS_DH_PROV, PROV_DSS_DH, CRYPT_NEWKEYSET) = 0 Then
        MsgBox "Kann Provider Kontext nicht öffnen!", vbExclamation, "Fehler:"
    ElseIf CryptGenKey(hCryptProvB, CALG_DH_SF, KEY_LENGTH * &H10000 Or CRYPT_EXPORTABLE Or CRYPT_PREGEN, hPrivateKeyB) = 0 Then
        MsgBox "Kann Schlüssel nicht erstellen!", vbExclamation, "Fehler:"
    End If
    
    '--------------------------------------------------------------------------------------
    'P und G importieren:
    If CryptSetKeyParam(hPrivateKeyB, KP_G, G_Blob, 0) = 0 Then
        MsgBox "Kann G nicht setzen!", vbExclamation, "Fehler:"
    ElseIf CryptSetKeyParam(hPrivateKeyB, KP_P, P_Blob, 0) = 0 Then
        MsgBox "Kann P nicht setzen!", vbExclamation, "Fehler:"
    ElseIf CryptSetKeyParam(hPrivateKeyB, KP_X, ByVal 0, 0) = 0 Then
        MsgBox "Kann X nicht generieren!", vbExclamation, "Fehler:"
    End If
    
    '--------------------------------------------------------------------------------------
    'Öffentlichen Teil des KeyExchange Schlüssels exportieren:
    If CryptExportKey(hPrivateKeyB, 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 btPublicKeyB(cbData - 1)
        If CryptExportKey(hPrivateKeyB, 0, PUBLICKEYBLOB, 0, btPublicKeyB(0), cbData) = 0 Then
            MsgBox "Kann Schlüssel nicht exportieren!", vbExclamation, "Fehler:"
        End If
    End If
    
    '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    'Beide öffentlichen Schlüsseldaten werden nun importiert und der gemeinsame Sessionkey
    'kann daraus ermittelt werden:
    
    '--------------------------------------------------------------------------------------
    'Öffentliche Schlüssel importieren:
    If CryptImportKey(hCryptProvB, btPublicKeyA(0), UBound(btPublicKeyA) + 1, hPrivateKeyB, 0, hSessionKeyB) = 0 Then
        MsgBox "Kann Schlüssel A nicht importieren!", vbExclamation, "Fehler:"
    ElseIf CryptImportKey(hCryptProvA, btPublicKeyB(0), UBound(btPublicKeyB) + 1, hPrivateKeyA, 0, hSessionKeyA) = 0 Then
        MsgBox "Kann Schlüssel B nicht importieren!", vbExclamation, "Fehler:"
    End If
    
    '--------------------------------------------------------------------------------------
    'zu Sessionkey umwandeln:
    If CryptSetKeyParam(hSessionKeyA, KP_ALGID, CALG_RC4, 0) = 0 Then
         MsgBox "Kann Schlüssel nicht umwandeln!", vbExclamation, "Fehler:"
    ElseIf CryptSetKeyParam(hSessionKeyB, KP_ALGID, CALG_RC4, 0) = 0 Then
         MsgBox "Kann Schlüssel nicht umwandeln!", vbExclamation, "Fehler:"
    End If
 
    '--------------------------------------------------------------------------------------
    'die D-H Schlüssel werden nun nicht mehr benötigt:
    CryptDestroyKey hPrivateKeyA
    CryptDestroyKey hPrivateKeyB
 
 
 
 
    '--------------------------------------------------------------------------------------
    'Test:
    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
End Sub