Option Explicit

Private Sub cmdEncrypt_Click()
    Dim cipherTest As New Cipher
    cipherTest.KeyString = txtKeyString.Text
    cipherTest.Text = txtClearText.Text
    cipherTest.DoXor
    cipherTest.Stretch
    lblEncryptedText.Caption = cipherTest.Text
End Sub

Private Sub cmdDecrypt_Click()
    Dim cipherTest As New Cipher
    cipherTest.KeyString = txtKeyString.Text
    cipherTest.Text = lblEncryptedText.Caption
    cipherTest.Shrink
    cipherTest.DoXor
    lblDecryptedText.Caption = cipherTest.Text
End Sub

'CIPHER.CLS
Option Explicit

Private msKeyString As String
Private msText As String

'~~~.KeyString
'A string (key) used in encryption and decryption
Public Property Let KeyString(sKeyString As String)
    msKeyString = sKeyString
    Initialize
End Property

'~~~.Text
'Write text to be encrypted or decrypted
Public Property Let Text(sText As String)
    msText = sText
End Property

'Read text that was encrypted or decrypted 
Public Property Get Text() As String
    Text = msText
End Property

'~~~.DoXor
'Exclusive-or method to encrypt or decrypt
Public Sub DoXor()
    Dim nC As Integer
    Dim nB As Integer
    Dim lI As Long
    For lI = 1 To Len(msText)
        nC = Asc(Mid(msText, lI, 1))
        nB = Int(Rnd * 256)
        Mid(msText, lI, 1) = Chr(nC Xor nB)
    Next lI
End Sub

'~~~.Stretch
'Convert any string to a printable, displayable string
Public Sub Stretch()
    Dim nC As Integer
    Dim lI As Long
    Dim lJ As Long
    Dim nK As Integer
    Dim lA As Long
    Dim sB As String
    lA = Len(msText)
    sB = Space(lA + (lA + 2) \ 3)
    For lI = 1 To lA
        nC = Asc(Mid(msText, lI, 1))
        lJ = lJ + 1
        Mid(sB, lJ, 1) = Chr((nC And 63) + 59)
        Select Case lI Mod 3
        Case 1
            nK = nK Or ((nC \ 64) * 16)
        Case 2
            nK = nK Or ((nC \ 64) * 4)
        Case 0
            nK = nK Or (nC \ 64)
            lJ = lJ + 1
            Mid(sB, lJ, 1) = Chr(nK + 59)
            nK = 0
        End Select
    Next lI
    If lA Mod 3 Then
        lJ = lJ + 1
        Mid(sB, lJ, 1) = Chr(nK + 59)
    End If
    msText = sB
End Sub

'~~~.Shrink
'Inverse of the Stretch method;
'result can contain any of the 256-byte values
Public Sub Shrink()
    Dim nC As Integer
    Dim nD As Integer
    Dim nE As Integer
    Dim lA As Long
    Dim lB As Long
    Dim lI As Long
    Dim lJ As Long
    Dim lK As Long
    Dim sB As String
    lA = Len(msText)
    lB = lA - 1 - (lA - 1) \ 4
    sB = Space(lB)
    For lI = 1 To lB
        lJ = lJ + 1
        nC = Asc(Mid(msText, lJ, 1)) - 59
        Select Case lI Mod 3
        Case 1
            lK = lK + 4
            If lK > lA Then lK = lA
            nE = Asc(Mid(msText, lK, 1)) - 59
            nD = ((nE \ 16) And 3) * 64
        Case 2
            nD = ((nE \ 4) And 3) * 64
        Case 0
            nD = (nE And 3) * 64
            lJ = lJ + 1
        End Select
        Mid(sB, lI, 1) = Chr(nC Or nD)
    Next lI
    msText = sB
End Sub

'Initializes random numbers using the key string
Private Sub Initialize()
    Dim nI As Integer
    Randomize Rnd(-1)
    For nI = 1 To Len(msKeyString)
        Randomize Rnd(-Rnd * Asc(Mid(msKeyString, nI, 1)))
    Next nI
End Sub