![]() |
Tipp 0108
|
Texte verschlüsseln/entschlüsseln
|
 |
|
Autor/Einsender: Datum: |
|
Patrick Schlangen 22.07.2001 |
|
Entwicklungsumgebung: |
|
VB 6 |
|
|
Mit diesem Tipp können Texte bis zu 64-bit Tiefe verschlüsselt und auch wieder entschlüsselt werden.
|
|
Code im Codebereich des
Klassenmoduls clsCryptText |
|
|
Option Explicit
Private mstrKey As String
Private mstrText As String
Public Property Let KeyString(strKey As String)
mstrKey = strKey
Initialize
End Property
Public Property Let Text(strText As String)
mstrText = strText
End Property
Public Property Get Text() As String
Text = mstrText
End Property
Public Sub CryptMitXOR()
Dim lngC As Long
Dim intB As Long
Dim lngN As Long
On Error Resume Next
For lngN = 1 To Len(mstrText)
lngC = Asc(Mid(mstrText, lngN, 1))
intB = Int(Rnd * 256)
Mid(mstrText, lngN, 1) = Chr(lngC Xor intB)
Next lngN
End Sub
Public Sub Stretch()
Dim lngC As Long
Dim lngN As Long
Dim lngJ As Long
Dim lngK As Long
Dim lngA As Long
Dim strB As String
On Error Resume Next
lngA = Len(mstrText)
strB = Space(lngA + (lngA + 2) \ 3)
For lngN = 1 To lngA
lngC = Asc(Mid(mstrText, lngN, 1))
lngJ = lngJ + 1
Mid(strB, lngJ, 1) = Chr((lngC And 63) + 59)
Select Case lngN Mod 3
Case 1
lngK = lngK Or ((lngC \ 64) * 16)
Case 2
lngK = lngK Or ((lngC \ 64) * 4)
Case 0
lngK = lngK Or (lngC \ 64)
lngJ = lngJ + 1
Mid(strB, lngJ, 1) = Chr(lngK + 59)
lngK = 0
End Select
Next lngN
If lngA Mod 3 Then
lngJ = lngJ + 1
Mid(strB, lngJ, 1) = Chr(lngK + 59)
End If
mstrText = strB
End Sub
Public Sub DoCd()
Dim lngC As Long
Dim lngD As Long
Dim lngE As Long
Dim lngA As Long
Dim lngB As Long
Dim lngN As Long
Dim lngJ As Long
Dim lngK As Long
Dim strB As String
On Error Resume Next
lngA = Len(mstrText)
lngB = lngA - 1 - (lngA - 1) \ 4
strB = Space(lngB)
For lngN = 1 To lngB
lngJ = lngJ + 1
lngC = Asc(Mid(mstrText, lngJ, 1)) - 59
Select Case lngN Mod 3
Case 1
lngK = lngK + 4
If lngK > lngA Then lngK = lngA
lngE = Asc(Mid(mstrText, lngK, 1)) - 59
lngD = ((lngE \ 16) And 3) * 64
Case 2
lngD = ((lngE \ 4) And 3) * 64
Case 0
lngD = (lngE And 3) * 64
lngJ = lngJ + 1
End Select
Mid(strB, lngN, 1) = Chr(lngC Or lngD)
Next lngN
mstrText = strB
End Sub
Private Sub Initialize()
Dim lngN As Long
Randomize Rnd(-1)
For lngN = 1 To Len(mstrKey)
Randomize Rnd(-Rnd * Asc(Mid(mstrKey, lngN, 1)))
Next lngN
End Sub
|
|
|
Code im Codebereich des
Moduls modCryptText |
|
|
Option Explicit
Global Crypt As Boolean
Function EnCrypt(eText As String, eKey As String) As String
Dim cipherTest As New clsCryptText
cipherTest.KeyString = eKey
cipherTest.Text = eText
cipherTest.CryptMitXOR
cipherTest.Stretch
EnCrypt = cipherTest.Text
End Function
Function DeCrypt(dText As String, dKey As String) As String
Dim cipherTest As New clsCryptText
cipherTest.KeyString = dKey
cipherTest.Text = dText
cipherTest.DoCd
cipherTest.CryptMitXOR
DeCrypt = cipherTest.Text
End Function
|
|
|
Code im Codebereich der frmStart |
|
|
Option Explicit
Private Sub cmdEncrypt_Click()
frmCryptText.cmdEnCrypt1.Caption = cmdEncrypt.Caption
frmCryptText.Caption = "Verschlüsseln"
Crypt = True
frmCryptText.Show 0, Me
End Sub
Private Sub cmdDecrypt_Click()
frmCryptText.cmdEnCrypt1.Caption = cmdDecrypt.Caption
frmCryptText.Caption = "Entschlüsseln"
Crypt = False
frmCryptText.Show 0, Me
End Sub
|
|
|
Code im Codebereich der Form
frmCryptText |
|
|
Option Explicit
Private Sub Form_Load()
Me.Height = 4035
End Sub
Private Sub cmdEnCrypt1_Click()
If Crypt = True Then
Text3.Text = EnCrypt(Text2.Text, Text1.Text)
Else
Text3.Text = DeCrypt(Text2.Text, Text1.Text)
End If
Me.Height = 7020
End Sub
|
|
|
|
|
Windows-Version |
95 |
 |
|
98/SE |
 |
|
ME |
 |
|
NT |
 |
|
2000 |
 |
|
XP |
 |
|
Vista |
 |
|
Win
7 |
 |
|
|
VB-Version |
VBA 5 |
 |
|
VBA 6 |
 |
|
VB 4/16 |
 |
|
VB 4/32 |
 |
|
VB 5 |
 |
|
VB 6 |
 |
|
|
|
Download (5,5 kB)
|
Downloads bisher: [ 4633 ]
|
|
|