41 lines
1.4 KiB
Plaintext
41 lines
1.4 KiB
Plaintext
Public Function ConvertToSecureString(Plaintext)
|
|
|
|
'Stand: 26.08.2020
|
|
'Source: https://gist.github.com/albert1205/c8430b5bfa505f9308e4fa789b9b1d7f
|
|
|
|
Const offset = 10
|
|
Const minAsc = 33
|
|
Const maxAsc = 126
|
|
|
|
Dim Ciphertext
|
|
Randomize
|
|
Ciphertext = Ciphertext & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
|
|
Ciphertext = Ciphertext & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
|
|
For i=1 To Len(Plaintext)*2
|
|
If i mod 2 = 0 Then
|
|
newAsc = Asc(Mid(Plaintext,i/2,1)) - offset
|
|
If newAsc < minAsc Then
|
|
newAsc = newAsc + maxAsc - minAsc + 1
|
|
End If
|
|
Ciphertext = Ciphertext & Chr(newAsc)
|
|
' MsgBox Asc(Mid(Plaintext,i/2,1)) & " -> " & newAsc
|
|
Else
|
|
Ciphertext = Ciphertext & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
|
|
' MsgBox "Rnd:" & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
|
|
End If
|
|
Next
|
|
Ciphertext = Ciphertext & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
|
|
Ciphertext = Ciphertext & Chr(Int((maxAsc-minAsc+1)*Rnd+minAsc))
|
|
ConvertToSecureString = Ciphertext
|
|
|
|
End Function
|
|
|
|
Private Sub EncryptTool()
|
|
|
|
Plaintext = InputBox("Bitte den zu verschluesselnden String eingeben:","Eingabe erfolderlich","")
|
|
Ciphertext = ConvertToSecureString(Plaintext)
|
|
InputBox "Ihre Eingabe lautete: " & Plaintext & vbNewLine & vbNewLine & "Verschluesselt, sieht der String wie folgt aus:","Erledigt!",Ciphertext
|
|
|
|
End Sub
|
|
|
|
Call EncryptTool |