AW: textdatei per vba verschlüsseln ?
ypsilon
hi dennis,
mit vba = gut kann ich dir den brocken ja einfach hinschmeissen:
viel spass ;-)
Function Verschlüsseln(ByVal s As String, key As Long) As String
Dim n As Long, i As Long, ss As String
Dim k1 As Long, k2 As Long, k3 As Long, k4 As Long, t As Long
Static saltvalue As String * 4
For i = 1 To 4
t = 100 * (1 + Asc(Mid(saltvalue, i, 1))) * Rnd() * (Timer + 1)
Mid(saltvalue, i, 1) = Chr(t Mod 256)
Next
s = Mid(saltvalue, 1, 2) & s & Mid(saltvalue, 3, 2)
n = Len(s)
ss = Space(n)
ReDim sn(n) As Long
k1 = 11 + (key Mod 233)
k2 = 7 + (key Mod 239)
k3 = 5 + (key Mod 241)
k4 = 3 + (key Mod 251)
For i = 1 To n
sn(i) = Asc(Mid(s, i, 1))
Next
For i = 2 To n
sn(i) = sn(i) Xor sn(i - 1) Xor ((k1 * sn(i - 1)) Mod 256)
Next
For i = n - 1 To 1 Step -1
sn(i) = sn(i) Xor sn(i + 1) Xor (k2 * sn(i + 1)) Mod 256
Next
For i = 3 To n
sn(i) = sn(i) Xor sn(i - 2) Xor (k3 * sn(i - 1)) Mod 256
Next
For i = n - 2 To 1 Step -1
sn(i) = sn(i) Xor sn(i + 2) Xor (k4 * sn(i + 1)) Mod 256
Next
For i = 1 To n
Mid(ss, i, 1) = Chr(sn(i))
Next
Verschlüsseln = ss
End Function
Function Entschlüsseln(ByVal s As String, key As Long) As String
Dim n As Long, i As Long, ss As String
Dim k1 As Long, k2 As Long, k3 As Long, k4 As Long
n = Len(s)
ss = Space(n)
ReDim sn(n) As Long
k1 = 11 + (key Mod 233)
k2 = 7 + (key Mod 239)
k3 = 5 + (key Mod 241)
k4 = 3 + (key Mod 251)
For i = 1 To n
sn(i) = Asc(Mid(s, i, 1))
Next
For i = 1 To n - 2
sn(i) = sn(i) Xor sn(i + 2) Xor (k4 * sn(i + 1)) Mod 256
Next
For i = n To 3 Step -1
sn(i) = sn(i) Xor sn(i - 2) Xor (k3 * sn(i - 1)) Mod 256
Next
For i = 1 To n - 1
sn(i) = sn(i) Xor sn(i + 1) Xor (k2 * sn(i + 1)) Mod 256
Next
For i = n To 2 Step -1
sn(i) = sn(i) Xor sn(i - 1) Xor (k1 * sn(i - 1)) Mod 256
Next
For i = 1 To n
Mid(ss, i, 1) = Chr(sn(i))
Next i
Entschlüsseln = Mid(ss, 3, Len(ss) - 4)
End Function
Private Sub Encrypt()
Dim Schlüssel As Long
Dim s As String, ss As String
Dim ff As Byte
ff = FreeFile
Schlüssel = 5544 'Codierungsschlüssel
Open "c:\original.txt" For Input As ff
Open "c:\crypt.txt" For Output As ff + 1
Do While Not EOF(ff)
Input #ff, s
ss = Verschlüsseln(s, Schlüssel)
Print #ff + 1, ss
Loop
Close
Kill "c:\original.txt"
End Sub
Private Sub Decrypt()
Dim Schlüssel As Long
Dim s As String, ss As String
Dim ff As Byte
ff = FreeFile
Schlüssel = 5544 'Codierungsschlüssel
Open "c:\original.txt" For Output As ff
Open "c:\crypt.txt" For Input As ff + 1
Do While Not EOF(ff + 1)
Input #ff + 1, s
ss = Entschlüsseln(s, Schlüssel)
Print #ff, ss
Loop
Close
Kill "c:\crypt.txt"
End Sub
cu Micha