Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0750: No-Key Protokoll - Schlüsselvereinbarung

VB 5/6-Tipp 0750: No-Key Protokoll - Schlüsselvereinbarung

 von Dario

Schwierigkeitsgrad:

Verwendete API-Aufrufe: CallWindowProcA (ASM_cdLong)

Download: Download des Beispielprojektes [6,61 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
'---------- Anfang Klasse "Party" alias Party.cls  ----------
Option Explicit

' Repräsentation einer beteiligten Partei

Private Transmission As NoKeyTransmission    ' Unsere Transmission

Private Key    As Long                       ' Der Schlüssel, den wir haben wollen
Private Exp    As Long                       ' Unsere Primzahl
Private Exp2   As Long                       ' Ihr Inverses

Public Event GotMessage(ByVal Message As String)

' Initialisieren
Public Sub Initialize(ByVal Tr As NoKeyTransmission)
   Call Randomize
   
   Set Transmission = Tr
   
   Exp = CoPrime(Transmission.Modul - 1)        ' Exponenten festlegen
   Exp2 = EuklidEx(Exp, Transmission.Modul - 1) ' Entschlüsselungsexponenten festlegen
End Sub

' Verschlüsseln
Public Function Encrypt(ByVal Data As Long) As Long
   Encrypt = ModExp(Data, Exp, Transmission.Modul)
End Function

' Entschlüsseln
Public Function Decrypt(ByVal Data As Long) As Long
   Decrypt = ModExp(Data, Exp2, Transmission.Modul)
End Function

' Setzen
Public Function SetKey(c3 As Long)
   Key = Decrypt(c3)
   
   Call Form1.List3.AddItem("[c4] = " & CStr(Key))
   Call Form1.List3.AddItem("")
End Function

' Schlüssel vereinbaren
Public Function ArrangeKey(Value As Long)
   Key = Value
   
   Call Form1.List3.AddItem("[k] = " & CStr(Key))
   
   Call Transmission.Arrange(Value)
End Function

' Text versenden
Public Sub Submit(ByVal Text As String, ByVal Dest As Party)
   Dim Bytes() As Byte
   
   Bytes = StrConv(Text, vbFromUnicode)
   
   ' Mit dem Schlüssel verschlüsseln
   Call EncryptSymmetrical(Bytes, Key)
   
   Call Form1.List3.AddItem(">> " & StrConv(Bytes, vbUnicode))
   
   ' Empfangen
   Call Dest.Receive(StrConv(Bytes, vbUnicode))
End Sub

' Ich empfange Text
Public Sub Receive(ByVal Cyphertext As String)
   Dim Bytes() As Byte
   
   Bytes = StrConv(Cyphertext, vbFromUnicode)
   
   ' Mit dem Schlüssel entschlüsseln
   Call EncryptSymmetrical(Bytes, Key)
   
   RaiseEvent GotMessage(StrConv(Bytes, vbUnicode))
End Sub
'----------- Ende Klasse "Party" alias Party.cls  -----------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Listen-Steuerelement "List3"
' Steuerelement: Schaltfläche "Command3"
' Steuerelement: Listen-Steuerelement "List2"
' Steuerelement: Listen-Steuerelement "List1"
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Textfeld "Text2"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Textfeld "Text1"
' Steuerelement: Beschriftungsfeld "Label3"
' Steuerelement: Linien-Steuerelement "Line2"
' Steuerelement: Linien-Steuerelement "Line1"
' Steuerelement: Beschriftungsfeld "Label2"
' Steuerelement: Beschriftungsfeld "Label1"
Option Explicit

Private Transmission       As New NoKeyTransmission

Private WithEvents Alice   As Party
Private WithEvents Bob     As Party

Private Sub Alice_GotMessage(ByVal Message As String)
   Call List1.AddItem(Message)
End Sub

Private Sub Bob_GotMessage(ByVal Message As String)
   Call List2.AddItem(Message)
End Sub

Private Sub Form_Load()
   Set Alice = New Party
   Set Bob = New Party
End Sub

Private Sub Command1_Click()
   If Text1.Text = "" Then Exit Sub
   Call Alice.Submit(Text1.Text, Bob)
   Text1.Text = ""
End Sub

Private Sub Command2_Click()
   If Text2.Text = "" Then Exit Sub
   Call Bob.Submit(Text2.Text, Alice)
   Text2.Text = ""
End Sub

Private Sub Command3_Click()
   Dim ctl As Control
   
   For Each ctl In Me.Controls
      If Not TypeOf ctl Is Line Then ctl.Enabled = Not ctl.Enabled
   Next
   
   ' Schlüssel vereinbaren
   
   Call Transmission.Initialize(Alice, Bob, 10000)
   
   ' Nur Alice darf den Key festlegen
   Dim Key As Long
   Key = Random(0, 10000)

   Call Alice.ArrangeKey(Key)
   
   Caption = "NoKey-Protokoll - Key = " & CStr(Key)
   
   ' Hier ggf. noch Schlüssel vergleichen
End Sub

'---------- Ende Formular "Form1" alias Form1.frm  ----------
'--- Anfang Klasse "NoKeyTransmission" alias NoKeyTransmission.cls  ---
Option Explicit

Public Modul As Long             ' Öffentliches Modul für die Exponentialfunktion
Public A As Party, B As Party    ' Unsere involvierten Parteien

' Anwerfen
Public Sub Initialize(ByVal Party1 As Party, ByVal Party2 As Party, _
    Optional ByVal MinModule As Long = 2000)
   Set A = Party1
   Set B = Party2

   Modul = NextPrime(MinModule)
   
   ' Parteien intialisieren
   Call A.Initialize(Me)
   Call B.Initialize(Me)
End Sub

Public Sub Arrange(Value As Long)
   ' Klartext
   Dim k As Long
   ' Die Zwischenstufen - Überflüssig aber vom Verständnis hilfreich
   Dim c1 As Long, c2 As Long, c3 As Long
   
   k = Value
   
   c1 = A.Encrypt(k)    ' Von A verschlüsselt
   Call Form1.List3.AddItem("c1 = " & CStr(c1))
   
   c2 = B.Encrypt(c1)   ' Von A und B verschlüsselt
   Call Form1.List3.AddItem("c2 = " & CStr(c2))
      
   c3 = A.Decrypt(c2)   ' A entschlüsselt : Von B verschlüsselt
   Call Form1.List3.AddItem("c3 = " & CStr(c3))
   
   Call B.SetKey(c3)    ' Von beiden entschlüsselt: B hat den Klartext
   
End Sub
'--- Ende Klasse "NoKeyTransmission" alias NoKeyTransmission.cls  ---
'------- Anfang Modul "mdlCrypt" alias mdlCrypto.bas  -------
Option Explicit

' Unsere Schwachstelle
' Ein recht schli(e)chtes symmetrisches Verfahren

Sub EncryptSymmetrical(Data() As Byte, ByVal Key As Long)
   Call Rnd(-1)  ' Zufallsfolgen resetten
   Call Randomize(Key)
   
   
   Dim i As Long
   For i = LBound(Data) To UBound(Data)
      Data(i) = Data(i) Xor CByte(Int(Rnd * 255))
   Next i
   
   ' Nein, nichts zurückgeben - Wir haben Referenzen^^
   
   Call Randomize ' Normal weiter
End Sub
'-------- Ende Modul "mdlCrypt" alias mdlCrypto.bas  --------
'--------- Anfang Modul "mdlMath" alias mdlMath.bas ---------
Option Explicit

' Hier noch einmal das Modul das schon für den RSA-Tipp verwendet wurde in
' gewohnter Ausführung

Private Declare Function ASM_cdLong _
    Lib "user32" Alias "CallWindowProcA" _
   (ByRef asm As Long, _
    ByVal PA1 As Long, _
    ByVal PA2 As Long, _
    ByVal PA3 As Long, _
    ByVal PA4 As Long) As Long

' Implementierung von benötigten mathematischen Funktionen:

' Berechnung einer Zufallszahl innerhalb vorgegebener Grenzen
Public Function Random(ByVal Min As Long, ByVal Max As Long) As Long
   Random = Int(Rnd * (Max - Min)) + Min
End Function

' Hochzählen bis zur nächsten Primzahl
Public Function NextPrime(Number As Long) As Long
   Dim i As Long
   
   i = Number + IIf((Number And 1) = 1, 0, 1)
   
   Do While Not IsPrime(i)
      i = i + 2
   Loop
    
   NextPrime = i
End Function

' Ist eine Zahl eine Primzahl?
Private Function IsPrime(ByVal Number As Long) As Boolean
   Dim i As Long
    
   For i = 2 To Sqr(Number - 1)
      If Number Mod i = 0 Then
         IsPrime = False
         Exit Function
      End If
   Next i
    
   IsPrime = True
End Function

' Modulare Exponentation

' ' VB6-Version ist leider zu langsam:
'Public Function ModExp(Basis As Long, ByVal Exponent As Long, Modul As Long) As Long
'    ModExp = 1
'
'    While Exponent > 0
'      ModExp = ModExp * Basis Mod Modul
'      Exponent = Exponent - 1
'    Wend
'End Function


' ASM-Beschleunigte Funktion
' Hinweis: Dieser Code stammt von Udo Schmidt!
Public Function ModExp(Base As Long, Exp As Long, Module As Long) As Long
    Static asm(8) As Long

    If asm(0) = 0 Then
        asm(0) = &H748B5756:  asm(1) = &H4C8B0C24:  asm(2) = &H7C8B1024
        asm(3) = &H1B81424:   asm(4) = &HF7000000:  asm(5) = &H8BF7F7E6
        asm(6) = &HF77549C2:  asm(7) = &H10C25E5F:  asm(8) = &H0
    End If

    ModExp = ASM_cdLong(asm(0), Base, Exp, Module, 0)
End Function

' Finden der kleinstmöglichen teilerfremden Zahl
Public Function CoPrime(ByVal CoPrimeTo As Long) As Long
   Dim i As Long
   i = 2
   
   Do
      Do
         i = i + 1
         If i > CoPrimeTo Then Exit Function
      Loop While ggT(i, CoPrimeTo) <> 1
   Loop While EuklidEx(i, CoPrimeTo) < 0
   
   CoPrime = i
End Function

' Berechnung des größten gemeinsamen Teilers zweier Zahlen
Private Function ggT(ByVal A As Long, ByVal B As Long) As Long
  Dim tmp As Long

  tmp = A Mod B
  
  If tmp = 0 Then
    ggT = B
    Exit Function
  Else
    A = B
    B = tmp
  End If
  
  While A Mod B <> 0
    tmp = A Mod B
    A = B
    B = tmp
  Wend
  
  ggT = tmp
End Function

' Berechnung des multiplikativ Inversen durch den erweiterten euklidischen Algorithmus
Function EuklidEx(ByVal A As Long, ByVal B As Long) As Long
   Dim x1 As Long, xtmp As Long, y1 As Long, ytmp As Long
   Dim r As Long, t As Long, q As Long, x0 As Long, y0 As Long
   
   x0 = 1
   y1 = 1
   t = 1
   
   Do While B <> 0
      r = A Mod B
      q = A \ B
      A = B
      B = r
      xtmp = x1
      ytmp = y1
      x1 = q * x1 + x0
      y1 = q * y1 + y0
      x0 = xtmp
      y0 = ytmp
      t = -t
  Loop
  
  EuklidEx = x0 * t
   
End Function

'---------- Ende Modul "mdlMath" alias mdlMath.bas ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------