Option Explicit
Public Sub verschlüsseln()
Dim strEingabe As String, strPW As String
strEingabe = InputBox("Zu verschlüsselnder Text:", "Texteingabe")
If strEingabe = vbNullString Then
Exit Sub
End If
strPW = InputBox("Passwort:", "Passworteingabe")
If strPW = vbNullString Then
Exit Sub
End If
MsgBox "Der verschlüsselte Text lautet: " & vbCrLf & vbCrLf & _
Crypt(strEingabe, strPW, True), vbInformation
End Sub
Public Sub entschlüsseln()
Dim strEingabe As String, strPW As String
strEingabe = InputBox("Zu entschlüsselnder Text:", "Texteingabe")
If strEingabe = vbNullString Then
Exit Sub
End If
strPW = InputBox("Passwort:", "Passworteingabe")
If strPW = vbNullString Then
Exit Sub
End If
MsgBox "Der entschlüsselte Text lautet: " & vbCrLf & vbCrLf & _
Crypt(strEingabe, strPW, False), vbInformation
End Sub
Private Function Crypt(Inp As String, Key As String, Mode As Boolean) As String
Dim z As String
Dim i As Integer, Position As Integer
Dim cptZahl As Long, orgZahl As Long
Dim keyZahl As Long, cptString As String
For i = 1 To Len(Inp)
Position = Position + 1
If Position > Len(Key) Then Position = 1
keyZahl = Asc(Mid(Key, Position, 1))
If Mode Then
orgZahl = Asc(Mid(Inp, i, 1))
cptZahl = orgZahl Xor keyZahl
cptString = Hex(cptZahl)
If Len(cptString) < 2 Then cptString = "0" & cptString
z = z & cptString
Else
If i > Len(Inp) \ 2 Then Exit For
cptZahl = CByte("&H" & Mid$(Inp, i * 2 - 1, 2))
orgZahl = cptZahl Xor keyZahl
z = z & Chr$(orgZahl)
End If
Next i
Crypt = z
End Function