by VisualScope (20 Submissions)
Category: Encryption
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Thu 7th December 2000
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Encryption code. You specify a key used to encrypt/decrypt that can be letters or numbers and it uses it to encrypt/decrypt it. Once it's
VBcoders
'there are no limits to what this can do
'
'
'go to http://www.VisualScope.cjb.net for example programs using this
--------------------------------------------------------------------------------
'place this in a class module called cipher...
Option Explicit
'CIPHER.CLS
Private mstrKey As String
Private mstrText As String
'~~~.KeyString
'A string (key) used in encryption and decryption
Public Property Let KeyString(strKey As String)
mstrKey = strKey
Initialize
End Property
'~~~.Text
'Write text to be encrypted or decrypted
Public Property Let Text(strText As String)
mstrText = strText
End Property
'Read text that was encrypted or decrypted
Public Property Get Text() As String
Text = mstrText
End Property
'~~~.DoXor
'Exclusive-or method to encrypt or decrypt
Public Sub DoXor()
On Error Resume Next
Dim lngC As Long
Dim intB As Long
Dim lngN As Long
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
'~~~.Stretch
'Convert any string to a printable, displayable string
Public Sub Stretch()
On Error Resume Next
Dim lngC As Long
Dim lngN As Long
Dim lngJ As Long
Dim lngK As Long
Dim lngA As Long
Dim strB As String
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
'~~~.Shrink
'Inverse of the Stretch method;
'result can contain any of the 256-byte values
Public Sub Shrink()
On Error Resume Next
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
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
'Initializes random numbers using the key string
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
'-------------------------------------------------------------------------------
'Then use this code to encrypt text
Public Sub Encrypt()'call encrypt
Dim cipherTest As New Cipher 'entire encryption process
cipherTest.KeyString = keytoencrypt.text'the key is used to encrypt the text. it can be letters and numbers
cipherTest.Text = plaintext.text'plaintext is a textbox containg what you want to encrypt
cipherTest.DoXor
cipherTest.Stretch
encryptedtext.text = cipherTest.Text'encryptedtext.text is where the encrypted text will show up
End Sub
--------------------------------------------------------------------------------
'use this to decrypt
Public Sub Decrypt()'call decrypt
Dim cipherTest As New Cipher 'entire decryption process
cipherTest.KeyString = keyusedtodecrypt.text'keyusedtodecrypt.text is what is used to decrypt the text. It can be letters or numbers
cipherTest.Text = textyouwantdecrypted.Text'textyouwantdecrypted is a textbox containg the text you want decrypted
cipherTest.Shrink
cipherTest.DoXor
decryptedtext.Text = cipherTest.Text'decryptedtext.text is where the decrypted text will show up
End If
End Sub
--------------------------------------------------------------------------------
No comments have been posted about Encryption code. You specify a key used to encrypt/decrypt that can be letters or numbers and it us. Why not be the first to post a comment about Encryption code. You specify a key used to encrypt/decrypt that can be letters or numbers and it us.