CryptGenKey: Unterschied zwischen den Versionen

Aus API-Wiki
Wechseln zu: Navigation, Suche
K (Änderungen von 201.30.25.23 (Diskussion) rückgängig gemacht und letzte Version von Jochen Wierum wiederhergestellt)
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 lang="vb">>
  
 
===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 lang="vb">>
  
 
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:
 
Das folgende Beispiel zeigt den sicheren Austausch eines (symmetrischen) DES Schlüssels mit Hilfe des asymmetrischen RSA Algorithmus:
<vb>
+
<<syntaxhighlight lang="vb">>
 
Option Explicit
 
Option Explicit
 
   
 
   
Zeile 186: Zeile 186:
 
         'Fehler->Existiert der Container bereits?
 
         'Fehler->Existiert der Container bereits?
 
         If CryptAcquireContext(hCryptProvA, "Mein Container A", MS_DEF_PROV, PROV_RSA_FULL, 0) = 0 Then
 
         If CryptAcquireContext(hCryptProvA, "Mein Container A", MS_DEF_PROV, PROV_RSA_FULL, 0) = 0 Then
             MsgBox "Kann MS Base Provider nicht finden!", vbExclamation, "Fehler:"
+
             MsgBox "Kann MS Base Provider nicht finden!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
   
 
   
 
         'bestehenden RSA KeyExchange Schlüssel ermitteln:
 
         'bestehenden RSA KeyExchange Schlüssel ermitteln:
 
         ElseIf CryptGetUserKey(hCryptProvA, AT_KEYEXCHANGE, hPrivateKey) = 0 Then
 
         ElseIf CryptGetUserKey(hCryptProvA, AT_KEYEXCHANGE, hPrivateKey) = 0 Then
             MsgBox "Kann auf bestehenden Schlüssel nicht zugreifen!", vbExclamation, "Fehler:"
+
             MsgBox "Kann auf bestehenden Schlüssel nicht zugreifen!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
         End If
 
         End If
 
     Else
 
     Else
 
         'neuen RSA KeyExchange Schlüssel erzeugen:
 
         'neuen RSA KeyExchange Schlüssel erzeugen:
 
         If CryptGenKey(hCryptProvA, CALG_RSA_KEYX, CRYPT_EXPORTABLE, hPrivateKey) = 0 Then
 
         If CryptGenKey(hCryptProvA, CALG_RSA_KEYX, CRYPT_EXPORTABLE, hPrivateKey) = 0 Then
             MsgBox "Kann Schlüssel nicht erstellen!", vbExclamation, "Fehler:"
+
             MsgBox "Kann Schlüssel nicht erstellen!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
         End If
 
         End If
 
     End If
 
     End If
Zeile 203: Zeile 203:
 
     'Öffentlichen Teil des KeyExchange Schlüssels exportieren:
 
     'Öffentlichen Teil des KeyExchange Schlüssels exportieren:
 
     If CryptExportKey(hPrivateKey, 0, PUBLICKEYBLOB, 0, ByVal 0, cbData) = 0 Then
 
     If CryptExportKey(hPrivateKey, 0, PUBLICKEYBLOB, 0, ByVal 0, cbData) = 0 Then
         MsgBox "Kann Schlüssel Länge nicht ermitteln!", vbExclamation, "Fehler:"
+
         MsgBox "Kann Schlüssel Länge nicht ermitteln!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
     Else
 
     Else
 
         'Speicher reservieren und Schlüsseldaten abholen:
 
         'Speicher reservieren und Schlüsseldaten abholen:
 
         ReDim Preserve btPublicKey(cbData - 1)
 
         ReDim Preserve btPublicKey(cbData - 1)
 
         If CryptExportKey(hPrivateKey, 0, PUBLICKEYBLOB, 0, btPublicKey(0), cbData) = 0 Then
 
         If CryptExportKey(hPrivateKey, 0, PUBLICKEYBLOB, 0, btPublicKey(0), cbData) = 0 Then
             MsgBox "Kann Schlüssel nicht exportieren!", vbExclamation, "Fehler:"
+
             MsgBox "Kann Schlüssel nicht exportieren!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
         End If
 
         End If
 
     End If
 
     End If
Zeile 221: Zeile 221:
 
         'Fehler->Existiert der Container bereits?
 
         'Fehler->Existiert der Container bereits?
 
         If CryptAcquireContext(hCryptProvB, "Mein Container B", MS_DEF_PROV, PROV_RSA_FULL, 0) = 0 Then
 
         If CryptAcquireContext(hCryptProvB, "Mein Container B", MS_DEF_PROV, PROV_RSA_FULL, 0) = 0 Then
             MsgBox "Kann MS Base Provider nicht finden!", vbExclamation, "Fehler:"
+
             MsgBox "Kann MS Base Provider nicht finden!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
         End If
 
         End If
 
     End If
 
     End If
Zeile 227: Zeile 227:
 
     'Öffentlichen Schlüssel importieren:
 
     'Öffentlichen Schlüssel importieren:
 
     If CryptImportKey(hCryptProvB, btPublicKey(0), UBound(btPublicKey) + 1, 0, 0, hPublicKey) = 0 Then
 
     If CryptImportKey(hCryptProvB, btPublicKey(0), UBound(btPublicKey) + 1, 0, 0, hPublicKey) = 0 Then
         MsgBox "Kann Schlüssel nicht importieren!", vbExclamation, "Fehler:"
+
         MsgBox "Kann Schlüssel nicht importieren!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
   
 
   
 
     'Sessionkey erstellen:
 
     'Sessionkey erstellen:
 
     ElseIf CryptGenKey(hCryptProvB, CALG_DES, CRYPT_EXPORTABLE Or CRYPT_NO_SALT, hSessionKeyB) = 0 Then
 
     ElseIf CryptGenKey(hCryptProvB, CALG_DES, CRYPT_EXPORTABLE Or CRYPT_NO_SALT, hSessionKeyB) = 0 Then
         MsgBox "Kann Sessionkey nicht erstellen!", vbExclamation, "Fehler:"
+
         MsgBox "Kann Sessionkey nicht erstellen!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
   
 
   
 
     'Sessionkey exportieren:
 
     'Sessionkey exportieren:
Zeile 237: Zeile 237:
 
         ReDim btSessionKeyData(cbData - 1)
 
         ReDim btSessionKeyData(cbData - 1)
 
         If CryptExportKey(hSessionKeyB, hPublicKey, SIMPLEBLOB, 0, btSessionKeyData(0), cbData) = 0 Then
 
         If CryptExportKey(hSessionKeyB, hPublicKey, SIMPLEBLOB, 0, btSessionKeyData(0), cbData) = 0 Then
             MsgBox "Kann Sessionkey nicht exportieren!", vbExclamation, "Fehler:"
+
             MsgBox "Kann Sessionkey nicht exportieren!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
          
 
          
 
         'der Public Key wird nicht mehr benötigt -> zerstören:
 
         'der Public Key wird nicht mehr benötigt -> zerstören:
 
         ElseIf CryptDestroyKey(hPublicKey) = 0 Then
 
         ElseIf CryptDestroyKey(hPublicKey) = 0 Then
             MsgBox "Kann Public Key nicht zerstören!", vbExclamation, "Fehler:"
+
             MsgBox "Kann Public Key nicht zerstören!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
         End If
 
         End If
 
     End If
 
     End If
Zeile 253: Zeile 253:
 
     If CryptImportKey(hCryptProvA, btSessionKeyData(0), _
 
     If CryptImportKey(hCryptProvA, btSessionKeyData(0), _
 
             UBound(btSessionKeyData) + 1, hPrivateKey, 0, hSessionKeyA) = 0 Then
 
             UBound(btSessionKeyData) + 1, hPrivateKey, 0, hSessionKeyA) = 0 Then
         MsgBox "Kann Sessionkey nicht importieren!", vbExclamation, "Fehler:"
+
         MsgBox "Kann Sessionkey nicht importieren!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
      
 
      
 
     'der KeyExchange Schlüssel wird nun nicht mehr benötigt:
 
     'der KeyExchange Schlüssel wird nun nicht mehr benötigt:
 
     ElseIf CryptDestroyKey(hPrivateKey) = 0 Then
 
     ElseIf CryptDestroyKey(hPrivateKey) = 0 Then
         MsgBox "Kann Private Key nicht zerstören!", vbExclamation, "Fehler:"
+
         MsgBox "Kann Private Key nicht zerstören!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
     End If
 
     End If
 
      
 
      
Zeile 265: Zeile 265:
 
     cbData = UBound(btData) + 1
 
     cbData = UBound(btData) + 1
 
     If CryptEncrypt(hSessionKeyA, 0, 1, 0, 0, cbData, 0) = 0 Then
 
     If CryptEncrypt(hSessionKeyA, 0, 1, 0, 0, cbData, 0) = 0 Then
         MsgBox "Kann Länge nicht ermitteln!", vbExclamation, "Fehler:"
+
         MsgBox "Kann Länge nicht ermitteln!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
     Else
 
     Else
 
         'Speicher reservieren und verschlüsselte Daten abholen:
 
         'Speicher reservieren und verschlüsselte Daten abholen:
Zeile 272: Zeile 272:
 
         cbData = x
 
         cbData = x
 
         If CryptEncrypt(hSessionKeyA, 0, 1, 0, VarPtr(btData(0)), cbData, UBound(btData) + 1) = 0 Then
 
         If CryptEncrypt(hSessionKeyA, 0, 1, 0, VarPtr(btData(0)), cbData, UBound(btData) + 1) = 0 Then
             MsgBox "Kann Daten nicht verschlüsseln!", vbExclamation, "Fehler:"
+
             MsgBox "Kann Daten nicht verschlüsseln!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
         Else
 
         Else
 
             'jetzt wieder entschlüsseln:
 
             'jetzt wieder entschlüsseln:
 
             If CryptDecrypt(hSessionKeyB, 0, 1, 0, VarPtr(btData(0)), cbData) = 0 Then
 
             If CryptDecrypt(hSessionKeyB, 0, 1, 0, VarPtr(btData(0)), cbData) = 0 Then
                 MsgBox "Kann Daten nicht entschlüsseln!", vbExclamation, "Fehler:"
+
                 MsgBox "Kann Daten nicht entschlüsseln!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
             Else
 
             Else
 
                 ReDim Preserve btData(cbData - 1)
 
                 ReDim Preserve btData(cbData - 1)
                 MsgBox "Wieder entschlüsselt: " & CStr(btData), vbInformation, "Erfolgreich:"
+
                 MsgBox "Wieder entschlüsselt: " & CStr(btData), <syntaxhighlight lang="vb">Information, "Erfolgreich:"
 
             End If
 
             End If
 
         End If
 
         End If
Zeile 292: Zeile 292:
 
End Sub
 
End Sub
  
</vb>
+
</<syntaxhighlight lang="vb">>
 
<br><br>
 
<br><br>
 
Das folgende Beispiel zeigt den Schlüsseltausch mit Hilfe des Diffie-Hellman Algorithmus:
 
Das folgende Beispiel zeigt den Schlüsseltausch mit Hilfe des Diffie-Hellman Algorithmus:
<vb>
+
<<syntaxhighlight lang="vb">>
 
Option Explicit
 
Option Explicit
 
   
 
   
Zeile 478: Zeile 478:
 
     'Provider Kontext anfordern und Schlüssel erstellen:
 
     '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
 
     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:"
+
         MsgBox "Kann Provider Kontext nicht öffnen!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
     ElseIf CryptGenKey(hCryptProvA, CALG_DH_SF, KEY_LENGTH * &H10000 Or CRYPT_EXPORTABLE, hPrivateKeyA) = 0 Then
 
     ElseIf CryptGenKey(hCryptProvA, CALG_DH_SF, KEY_LENGTH * &H10000 Or CRYPT_EXPORTABLE, hPrivateKeyA) = 0 Then
         MsgBox "Kann Schlüssel nicht erstellen!", vbExclamation, "Fehler:"
+
         MsgBox "Kann Schlüssel nicht erstellen!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
     End If
 
     End If
 
   
 
   
Zeile 486: Zeile 486:
 
     'Öffentlichen Teil des KeyExchange Schlüssels exportieren:
 
     'Öffentlichen Teil des KeyExchange Schlüssels exportieren:
 
     If CryptExportKey(hPrivateKeyA, 0, PUBLICKEYBLOB, 0, ByVal 0, cbData) = 0 Then
 
     If CryptExportKey(hPrivateKeyA, 0, PUBLICKEYBLOB, 0, ByVal 0, cbData) = 0 Then
         MsgBox "Kann Schlüssel Länge nicht ermitteln!", vbExclamation, "Fehler:"
+
         MsgBox "Kann Schlüssel Länge nicht ermitteln!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
     Else
 
     Else
 
         'Speicher reservieren und Schlüsseldaten abholen:
 
         'Speicher reservieren und Schlüsseldaten abholen:
 
         ReDim Preserve btPublicKeyA(cbData - 1)
 
         ReDim Preserve btPublicKeyA(cbData - 1)
 
         If CryptExportKey(hPrivateKeyA, 0, PUBLICKEYBLOB, 0, btPublicKeyA(0), cbData) = 0 Then
 
         If CryptExportKey(hPrivateKeyA, 0, PUBLICKEYBLOB, 0, btPublicKeyA(0), cbData) = 0 Then
             MsgBox "Kann Schlüssel nicht exportieren!", vbExclamation, "Fehler:"
+
             MsgBox "Kann Schlüssel nicht exportieren!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
         End If
 
         End If
 
     End If
 
     End If
Zeile 506: Zeile 506:
 
   
 
   
 
     If CryptGetKeyParam(hPrivateKeyA, KP_G, G_Blob.Data(0), G_Blob.cbData, 0) = 0 Then
 
     If CryptGetKeyParam(hPrivateKeyA, KP_G, G_Blob.Data(0), G_Blob.cbData, 0) = 0 Then
         MsgBox "Kann G nicht lesen!", vbExclamation, "Fehler:"
+
         MsgBox "Kann G nicht lesen!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
     ElseIf CryptGetKeyParam(hPrivateKeyA, KP_P, P_Blob.Data(0), P_Blob.cbData, 0) = 0 Then
 
     ElseIf CryptGetKeyParam(hPrivateKeyA, KP_P, P_Blob.Data(0), P_Blob.cbData, 0) = 0 Then
         MsgBox "Kann P nicht lesen!", vbExclamation, "Fehler:"
+
         MsgBox "Kann P nicht lesen!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
     End If
 
     End If
 
      
 
      
Zeile 520: Zeile 520:
 
     'Provider Kontext anfordern und Schlüssel erstellen:
 
     '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
 
     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:"
+
         MsgBox "Kann Provider Kontext nicht öffnen!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
     ElseIf CryptGenKey(hCryptProvB, CALG_DH_SF, KEY_LENGTH * &H10000 Or CRYPT_EXPORTABLE Or CRYPT_PREGEN, hPrivateKeyB) = 0 Then
 
     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:"
+
         MsgBox "Kann Schlüssel nicht erstellen!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
     End If
 
     End If
 
      
 
      
Zeile 528: Zeile 528:
 
     'P und G importieren:
 
     'P und G importieren:
 
     If CryptSetKeyParam(hPrivateKeyB, KP_G, G_Blob, 0) = 0 Then
 
     If CryptSetKeyParam(hPrivateKeyB, KP_G, G_Blob, 0) = 0 Then
         MsgBox "Kann G nicht setzen!", vbExclamation, "Fehler:"
+
         MsgBox "Kann G nicht setzen!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
     ElseIf CryptSetKeyParam(hPrivateKeyB, KP_P, P_Blob, 0) = 0 Then
 
     ElseIf CryptSetKeyParam(hPrivateKeyB, KP_P, P_Blob, 0) = 0 Then
         MsgBox "Kann P nicht setzen!", vbExclamation, "Fehler:"
+
         MsgBox "Kann P nicht setzen!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
     ElseIf CryptSetKeyParam(hPrivateKeyB, KP_X, ByVal 0, 0) = 0 Then
 
     ElseIf CryptSetKeyParam(hPrivateKeyB, KP_X, ByVal 0, 0) = 0 Then
         MsgBox "Kann X nicht generieren!", vbExclamation, "Fehler:"
+
         MsgBox "Kann X nicht generieren!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
     End If
 
     End If
 
      
 
      
Zeile 538: Zeile 538:
 
     'Öffentlichen Teil des KeyExchange Schlüssels exportieren:
 
     'Öffentlichen Teil des KeyExchange Schlüssels exportieren:
 
     If CryptExportKey(hPrivateKeyB, 0, PUBLICKEYBLOB, 0, ByVal 0, cbData) = 0 Then
 
     If CryptExportKey(hPrivateKeyB, 0, PUBLICKEYBLOB, 0, ByVal 0, cbData) = 0 Then
         MsgBox "Kann Schlüssel Länge nicht ermitteln!", vbExclamation, "Fehler:"
+
         MsgBox "Kann Schlüssel Länge nicht ermitteln!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
     Else
 
     Else
 
         'Speicher reservieren und Schlüsseldaten abholen:
 
         'Speicher reservieren und Schlüsseldaten abholen:
 
         ReDim Preserve btPublicKeyB(cbData - 1)
 
         ReDim Preserve btPublicKeyB(cbData - 1)
 
         If CryptExportKey(hPrivateKeyB, 0, PUBLICKEYBLOB, 0, btPublicKeyB(0), cbData) = 0 Then
 
         If CryptExportKey(hPrivateKeyB, 0, PUBLICKEYBLOB, 0, btPublicKeyB(0), cbData) = 0 Then
             MsgBox "Kann Schlüssel nicht exportieren!", vbExclamation, "Fehler:"
+
             MsgBox "Kann Schlüssel nicht exportieren!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
         End If
 
         End If
 
     End If
 
     End If
Zeile 554: Zeile 554:
 
     'Öffentliche Schlüssel importieren:
 
     'Öffentliche Schlüssel importieren:
 
     If CryptImportKey(hCryptProvB, btPublicKeyA(0), UBound(btPublicKeyA) + 1, hPrivateKeyB, 0, hSessionKeyB) = 0 Then
 
     If CryptImportKey(hCryptProvB, btPublicKeyA(0), UBound(btPublicKeyA) + 1, hPrivateKeyB, 0, hSessionKeyB) = 0 Then
         MsgBox "Kann Schlüssel A nicht importieren!", vbExclamation, "Fehler:"
+
         MsgBox "Kann Schlüssel A nicht importieren!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
     ElseIf CryptImportKey(hCryptProvA, btPublicKeyB(0), UBound(btPublicKeyB) + 1, hPrivateKeyA, 0, hSessionKeyA) = 0 Then
 
     ElseIf CryptImportKey(hCryptProvA, btPublicKeyB(0), UBound(btPublicKeyB) + 1, hPrivateKeyA, 0, hSessionKeyA) = 0 Then
         MsgBox "Kann Schlüssel B nicht importieren!", vbExclamation, "Fehler:"
+
         MsgBox "Kann Schlüssel B nicht importieren!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
     End If
 
     End If
 
      
 
      
Zeile 562: Zeile 562:
 
     'zu Sessionkey umwandeln:
 
     'zu Sessionkey umwandeln:
 
     If CryptSetKeyParam(hSessionKeyA, KP_ALGID, CALG_RC4, 0) = 0 Then
 
     If CryptSetKeyParam(hSessionKeyA, KP_ALGID, CALG_RC4, 0) = 0 Then
         MsgBox "Kann Schlüssel nicht umwandeln!", vbExclamation, "Fehler:"
+
         MsgBox "Kann Schlüssel nicht umwandeln!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
     ElseIf CryptSetKeyParam(hSessionKeyB, KP_ALGID, CALG_RC4, 0) = 0 Then
 
     ElseIf CryptSetKeyParam(hSessionKeyB, KP_ALGID, CALG_RC4, 0) = 0 Then
         MsgBox "Kann Schlüssel nicht umwandeln!", vbExclamation, "Fehler:"
+
         MsgBox "Kann Schlüssel nicht umwandeln!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
     End If
 
     End If
 
   
 
   
Zeile 581: Zeile 581:
 
     cbData = UBound(btData) + 1
 
     cbData = UBound(btData) + 1
 
     If CryptEncrypt(hSessionKeyA, 0, 1, 0, 0, cbData, 0) = 0 Then
 
     If CryptEncrypt(hSessionKeyA, 0, 1, 0, 0, cbData, 0) = 0 Then
         MsgBox "Kann Länge nicht ermitteln!", vbExclamation, "Fehler:"
+
         MsgBox "Kann Länge nicht ermitteln!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
     Else
 
     Else
 
         'Speicher reservieren und verschlüsselte Daten abholen:
 
         'Speicher reservieren und verschlüsselte Daten abholen:
Zeile 588: Zeile 588:
 
         cbData = x
 
         cbData = x
 
         If CryptEncrypt(hSessionKeyA, 0, 1, 0, VarPtr(btData(0)), cbData, UBound(btData) + 1) = 0 Then
 
         If CryptEncrypt(hSessionKeyA, 0, 1, 0, VarPtr(btData(0)), cbData, UBound(btData) + 1) = 0 Then
             MsgBox "Kann Daten nicht verschlüsseln!", vbExclamation, "Fehler:"
+
             MsgBox "Kann Daten nicht verschlüsseln!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
         Else
 
         Else
 
             'jetzt wieder entschlüsseln:
 
             'jetzt wieder entschlüsseln:
 
             If CryptDecrypt(hSessionKeyB, 0, 1, 0, VarPtr(btData(0)), cbData) = 0 Then
 
             If CryptDecrypt(hSessionKeyB, 0, 1, 0, VarPtr(btData(0)), cbData) = 0 Then
                 MsgBox "Kann Daten nicht entschlüsseln!", vbExclamation, "Fehler:"
+
                 MsgBox "Kann Daten nicht entschlüsseln!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
 
             Else
 
             Else
 
                 ReDim Preserve btData(cbData - 1)
 
                 ReDim Preserve btData(cbData - 1)
                 MsgBox "Wieder entschlüsselt: " & CStr(btData), vbInformation, "Erfolgreich:"
+
                 MsgBox "Wieder entschlüsselt: " & CStr(btData), <syntaxhighlight lang="vb">Information, "Erfolgreich:"
 
             End If
 
             End If
 
         End If
 
         End If
Zeile 605: Zeile 605:
 
     If hCryptProvB <> 0 Then CryptReleaseContext hCryptProvB, 0
 
     If hCryptProvB <> 0 Then CryptReleaseContext hCryptProvB, 0
 
End Sub
 
End Sub
</vb>
+
</<syntaxhighlight lang="vb">>
 
[[Kategorie:Crypt Api]]
 
[[Kategorie:Crypt Api]]
 
[[Kategorie:Funktionen]]
 
[[Kategorie:Funktionen]]

Version vom 5. November 2016, 23:09 Uhr

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

<<syntaxhighlight lang="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</<syntaxhighlight lang="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

<<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 _
           CRYPT_EXPORTABLE, hRsaKey) = 0 Then
       Err.Raise Err.LastDllError, , "CryptGenKey Error!"
   End If</<syntaxhighlight lang="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: <<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!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"

       'bestehenden RSA KeyExchange Schlüssel ermitteln:
       ElseIf CryptGetUserKey(hCryptProvA, AT_KEYEXCHANGE, hPrivateKey) = 0 Then
           MsgBox "Kann auf bestehenden Schlüssel nicht zugreifen!", <syntaxhighlight lang="vb">Exclamation, "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!", <syntaxhighlight lang="vb">Exclamation, "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!", <syntaxhighlight lang="vb">Exclamation, "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!", <syntaxhighlight lang="vb">Exclamation, "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!", <syntaxhighlight lang="vb">Exclamation, "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!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"

   'Sessionkey erstellen:
   ElseIf CryptGenKey(hCryptProvB, CALG_DES, CRYPT_EXPORTABLE Or CRYPT_NO_SALT, hSessionKeyB) = 0 Then
       MsgBox "Kann Sessionkey nicht erstellen!", <syntaxhighlight lang="vb">Exclamation, "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!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
       
       'der Public Key wird nicht mehr benötigt -> zerstören:
       ElseIf CryptDestroyKey(hPublicKey) = 0 Then
           MsgBox "Kann Public Key nicht zerstören!", <syntaxhighlight lang="vb">Exclamation, "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!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
   
   'der KeyExchange Schlüssel wird nun nicht mehr benötigt:
   ElseIf CryptDestroyKey(hPrivateKey) = 0 Then
       MsgBox "Kann Private Key nicht zerstören!", <syntaxhighlight lang="vb">Exclamation, "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!", <syntaxhighlight lang="vb">Exclamation, "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!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
       Else
           'jetzt wieder entschlüsseln:
           If CryptDecrypt(hSessionKeyB, 0, 1, 0, VarPtr(btData(0)), cbData) = 0 Then
               MsgBox "Kann Daten nicht entschlüsseln!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
           Else
               ReDim Preserve btData(cbData - 1)
               MsgBox "Wieder entschlüsselt: " & CStr(btData), <syntaxhighlight lang="vb">Information, "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 lang="vb">>

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!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
   ElseIf CryptGenKey(hCryptProvA, CALG_DH_SF, KEY_LENGTH * &H10000 Or CRYPT_EXPORTABLE, hPrivateKeyA) = 0 Then
       MsgBox "Kann Schlüssel nicht erstellen!", <syntaxhighlight lang="vb">Exclamation, "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!", <syntaxhighlight lang="vb">Exclamation, "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!", <syntaxhighlight lang="vb">Exclamation, "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!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
   ElseIf CryptGetKeyParam(hPrivateKeyA, KP_P, P_Blob.Data(0), P_Blob.cbData, 0) = 0 Then
       MsgBox "Kann P nicht lesen!", <syntaxhighlight lang="vb">Exclamation, "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!", <syntaxhighlight lang="vb">Exclamation, "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!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
   End If
   
   '--------------------------------------------------------------------------------------
   'P und G importieren:
   If CryptSetKeyParam(hPrivateKeyB, KP_G, G_Blob, 0) = 0 Then
       MsgBox "Kann G nicht setzen!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
   ElseIf CryptSetKeyParam(hPrivateKeyB, KP_P, P_Blob, 0) = 0 Then
       MsgBox "Kann P nicht setzen!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
   ElseIf CryptSetKeyParam(hPrivateKeyB, KP_X, ByVal 0, 0) = 0 Then
       MsgBox "Kann X nicht generieren!", <syntaxhighlight lang="vb">Exclamation, "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!", <syntaxhighlight lang="vb">Exclamation, "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!", <syntaxhighlight lang="vb">Exclamation, "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!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
   ElseIf CryptImportKey(hCryptProvA, btPublicKeyB(0), UBound(btPublicKeyB) + 1, hPrivateKeyA, 0, hSessionKeyA) = 0 Then
       MsgBox "Kann Schlüssel B nicht importieren!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
   End If
   
   '--------------------------------------------------------------------------------------
   'zu Sessionkey umwandeln:
   If CryptSetKeyParam(hSessionKeyA, KP_ALGID, CALG_RC4, 0) = 0 Then
        MsgBox "Kann Schlüssel nicht umwandeln!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
   ElseIf CryptSetKeyParam(hSessionKeyB, KP_ALGID, CALG_RC4, 0) = 0 Then
        MsgBox "Kann Schlüssel nicht umwandeln!", <syntaxhighlight lang="vb">Exclamation, "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!", <syntaxhighlight lang="vb">Exclamation, "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!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
       Else
           'jetzt wieder entschlüsseln:
           If CryptDecrypt(hSessionKeyB, 0, 1, 0, VarPtr(btData(0)), cbData) = 0 Then
               MsgBox "Kann Daten nicht entschlüsseln!", <syntaxhighlight lang="vb">Exclamation, "Fehler:"
           Else
               ReDim Preserve btData(cbData - 1)
               MsgBox "Wieder entschlüsselt: " & CStr(btData), <syntaxhighlight lang="vb">Information, "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 lang="vb">>