Code aus Form1.frm
Option Explicit
Public Partei As String, p As Currency, g As Currency
Public alpha As Currency, beta As Currency
Public Function Connect(IP As String, Port As Long) As Currency
  Dim k As Currency, a As Currency
    
    If ws.State <> sckClosed Then
      ws.Close
    End If
    
    Partei = "A"
    g = 0: p = 0: alpha = 0: beta = 0
    
    ws.LocalPort = 0
    ws.Connect IP, Port
    Do: DoEvents: Loop Until ws.State >= sckConnected
    
    If ws.State <> sckConnected Then
      MsgBox "Fehler aufgetreten"
      Exit Function
    End If
    
    'Diffie-Hellman-Schlüsselvereinbarung
    'Wir sind die initiierende Partei A, daher legen wir p und g fest
    'im praktischen Einsatz sollten p und g zufällig bestimmt werden
    p = 80107: g = 5
    
    ws.SendData CStr(g) & vbCrLf: DoEvents
    ws.SendData CStr(p) & vbCrLf: DoEvents
    
    'Nun wählt jede Partei einen privaten Schlüssel, wir wählen a
    a = Int(Rnd * 5000 + 100)
    
    'Als nächstes bilden wir den Wert Alpha mit der diskreten
    'Exponentialfunktion, um keinen Überlauf zu erhalten benutzen
    'wir eine eigene Funktion hierzu
    alpha = PowerMod(g, a, p)
    
    ws.SendData CStr(alpha) & vbCrLf
    
    'Nun warten wir auf Beta, wenn B nicht antwortet, hängt er sich
    'hier in einer Endlosschleife auf, man müsste noch einen Timeout
    'einbauen
    Do: DoEvents: Loop Until beta <> 0
    
    'Aus dem Wert beta bilden wir nun unseren gemeinsamen Schlüssel
    k = PowerMod(beta, a, p)
    
    ws.Close
    
    Connect = k
End Function
Private Sub Command1_Click()
  Dim k As Currency
    
    k = Connect("127.0.0.1", 11532)
    
    Label1.Caption = "Schlüssel k: " & k
End Sub
Private Sub Form_Load()
    On Error Resume Next
    
    Randomize Timer
    
    ws.LocalPort = 11532
    ws.Listen
    
    If Err.Number > 0 Then
      Label2.Caption = "Kein Server"
    Else
      Command1.Enabled = False
    End If
End Sub
Private Sub ws_Close()
    ws.Close
End Sub
Private Sub ws_ConnectionRequest(ByVal requestID As Long)
    ws.Close
    ws.Accept requestID
End Sub
Private Sub ws_DataArrival(ByVal bytesTotal As Long)
  Static Buffer As String, i As Long
  Dim Temp As String, Zahl As String, k As Currency
    
    ws.GetData Temp, vbString
    Buffer = Buffer & Temp
    
    While InStr(Buffer, vbCrLf)
      Zahl = Left$(Buffer, InStr(Buffer, vbCrLf) - 1)
      Buffer = Mid$(Buffer, InStr(Buffer, vbCrLf) + 2)
      
      If Partei = "A" Then
        beta = Val(Zahl)
      Else
        Select Case i
          Case 0
            g = Val(Zahl)
          Case 1
            p = Val(Zahl)
          Case 2
            i = -1
            'Sobald alpha angekommen ist, erwartet die andere _
                Partei, dass
            'wir beta berechnen und abschicken
            alpha = Val(Zahl)
            
            k = DH_Key_B
            
            Label1.Caption = "Schlüssel k: " & k
            
            ws.Close
            DoEvents
            ws.LocalPort = 11532
            ws.Listen
        End Select
        
        i = i + 1
      End If
    Wend
End Sub
Public Function DH_Key_B() As Currency
  Dim b As Currency, k As Currency
    
    'Nun wählt jede Partei einen privaten Schlüssel, wir wählen b
    b = Rnd * 5000 + 100
    
    'Als nächstes bilden wir den Wert Beta mit der diskreten
    'Exponentialfunktion, um keinen Überlauf zu erhalten benutzen
    'wir eine eigene Funktion hierzu
    beta = PowerMod(g, b, p)
    
    ws.SendData CStr(beta) & vbCrLf: DoEvents
    
    'Aus dem Wert alpha bilden wir nun unseren gemeinsamen Schlüssel
    k = PowerMod(alpha, b, p)
    
    DH_Key_B = k
End Function
Public Function PowerMod(Basis As Currency, ByVal Exponent As _
    Currency, Modul As Currency) As Currency
    PowerMod = 1
    
    While Exponent > 0
      PowerMod = Modulo((PowerMod * Basis), Modul)
      Exponent = Exponent - 1
    Wend
End Function
Public Function Modulo(ByVal a As Currency, b As Currency) As Currency
    While a > b: a = a - b: Wend
      Modulo = a
  End Function