Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0735: Asymmetrisches Verschlüsselungssystem (RSA)

VB 5/6-Tipp 0735: Asymmetrisches Verschlüsselungssystem (RSA)

 von Dario

Schwierigkeitsgrad:

Verwendete API-Aufrufe: CallWindowProcA (ASM_cdLong)

Download: Download des Beispielprojektes [5,51 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 Modul "mdlCrypt" alias mdlCrypt.bas --------
Option Explicit

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


' Die eigentlichen Kernfunktionen:
' Zum Signieren und Verschlüsseln werden zwar die gleichen Funktionen verwendet, aber zum besseren Auseinanderhalten zweimal implementiert^^

Public Function Encrypt(ByVal Message As Long, ByVal Party As Party) As Long
   Encrypt = ModExp(Message, Party.e, Party.N)
End Function

Public Function TestSignature(ByVal Signature As Long, ByVal Message As Long, ByVal Party As Party) As Boolean
   TestSignature = (ModExp(Signature, Party.e, Party.N) = Message)
End Function

Public Function GetSignaturePlaintext(ByVal Signature As Long, ByVal Party As Party) As Long
   GetSignaturePlaintext = ModExp(Signature, Party.e, Party.N)
End Function
   
   
   
' 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, 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 "mdlCrypt" alias mdlCrypt.bas ---------
'---------- Anfang Klasse "Party" alias Party.cls  ----------
Option Explicit

' Repräsentation einer beteiligten Partei

Private p As Long, q As Long  ' Die Primzahlen
Private d As Long             ' Der Private Key
Private X As Long             ' Eulersche Funktion von N

Public e As Long, N As Long   ' Der Public Key

' Initialisieren
Public Sub Initialize()
   Call Randomize
   
   p = NextPrime(Random(100, 250))     ' Erste Primzahl
   
   Do
      q = NextPrime(Random(100, 250))  ' 2. Primzahl <> 1. Primzahl
   Loop While p = q
   
   N = p * q                           ' Öffentlicher Schlüssel
   X = (p - 1) * (q - 1)               ' Eulersche Funktion von N
   
   e = CoPrime(X)                      ' Teilerfremde Zahl e zu X
   d = EuklidEx(e, X)                  ' d * e = 1 (mod X)
   
   p = 0 ' Brauchen wir nicht mehr
   q = 0 ' Das auch nicht
End Sub

' Nachricht entschlüsseln
Public Function Decrypt(Message As Long) As Long
   Decrypt = ModExp(Message, d, N)
End Function

' Nachricht signieren
Public Function Sign(Message As Long) As Long
   Sign = ModExp(Message, d, N)
End Function

' Muss sein ;-)
Public Function TooBig(Plaintext As Long) As Boolean
   TooBig = (Plaintext >= d)
End Function
'----------- Ende Klasse "Party" alias Party.cls  -----------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command4"
' Steuerelement: Textfeld "Text6"
' Steuerelement: Textfeld "Text5"
' Steuerelement: Schaltfläche "Command5"
' Steuerelement: Textfeld "Text3"
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Schaltfläche "Command3"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Textfeld "Text4"
' Steuerelement: Textfeld "Text2"
' Steuerelement: Textfeld "Text1"
' Steuerelement: Beschriftungsfeld "Label6"
' Steuerelement: Beschriftungsfeld "Label4"
' Steuerelement: Beschriftungsfeld "Label3"
' Steuerelement: Beschriftungsfeld "Label2"
' Steuerelement: Beschriftungsfeld "Label1"
' Steuerelement: Linien-Steuerelement "Line2"
' Steuerelement: Linien-Steuerelement "Line1"
Option Explicit

Private Alice As New Party ' Sender
Private Bob   As New Party ' Empfänger

Private Sub Form_Load()
   Call NewKeys
End Sub

Private Sub Command5_Click()
   Call NewKeys
End Sub


Private Sub Command1_Click()
   Dim Plaintext As Long, Encoded As Long
   
   If Val(Text1.Text) >= Bob.N Then
      Call MsgBox("Wert zu hoch", vbCritical)
      Exit Sub
   End If
   
   ' Verschlüsseln
   If IsNumeric(Text1.Text) Then
      Plaintext = CLng(Text1.Text)
      Encoded = Encrypt(Plaintext, Bob)
      Text2.Text = CStr(Encoded)
   End If
End Sub

Private Sub Command2_Click()
   Dim Plaintext As Long, Encoded As Long
   
   ' Entschlüsseln
   If IsNumeric(Text2.Text) Then
      Encoded = CLng(Text2.Text)
      Plaintext = Bob.Decrypt(Encoded)
      Text3.Text = CStr(Plaintext)
   End If
End Sub


Private Sub Command3_Click()
   Dim Plaintext As Long, Signed As Long
   
   If Alice.TooBig(Val(Text4.Text)) Then
      Call MsgBox("Wert zu hoch", vbCritical)
      Exit Sub
   End If
   
   ' Authentifikationscode erstellen
   If IsNumeric(Text4.Text) Then
      Plaintext = CLng(Text4.Text)
      Signed = Alice.Sign(Plaintext)
      Text5.Text = CStr(Signed)
   End If
End Sub

Private Sub Command4_Click()
   Dim Plaintext As Long, Signature As Long
      
   ' Authentifikation prüfen
   If IsNumeric(Text5.Text) Then
      Signature = CLng(Text5.Text)
      Plaintext = GetSignaturePlaintext(Signature, Alice)
      Text6.Text = CStr(Plaintext)
      Label6.Caption = IIf(Text4.Text = Text6.Text, "Authentifikation als Alice erfolgreich", "Nicht authentifiziert")
   End If
End Sub


' Neue Schlüssel und auch schonst alles neu
Private Sub NewKeys()
   Call Alice.Initialize
   Call Bob.Initialize
   
   Label3.Caption = "Public-Key: { " & CStr(Alice.e) & " ; " & CStr(Alice.N) & " }"
   Label4.Caption = "Public-Key: { " & CStr(Bob.e) & " ; " & CStr(Bob.N) & " }"
   
   Text1.Text = ""
   Text2.Text = ""
   Text3.Text = ""
   Text4.Text = ""
   Text5.Text = ""
   Text6.Text = ""
End Sub

' NumberOnly-Eingaben prüfen
Private Sub Text1_KeyPress(KeyAscii As Integer)
   KeyAscii = IIf(KeyAscii < Asc("0") Or KeyAscii > Asc("9") Xor KeyAscii = 8, 0, KeyAscii)
End Sub
Private Sub Text4_KeyPress(KeyAscii As Integer)
   KeyAscii = IIf(KeyAscii < Asc("0") Or KeyAscii > Asc("9") Xor KeyAscii = 8, 0, KeyAscii)
End Sub
Private Sub Text5_KeyPress(KeyAscii As Integer)
   KeyAscii = IIf(KeyAscii < Asc("0") Or KeyAscii > Asc("9") Xor KeyAscii = 8, 0, KeyAscii)
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------