Option Explicit

Private mstrKeyPhrase As String * 3

`~~~.Char
Property Let Char(intKey As Integer)
    Select Case intKey
        Case vbKeyE: mstrKeyPhrase = Mid$(mstrKeyPhrase, 2) & "E"
        Case vbKeyG: mstrKeyPhrase = Mid$(mstrKeyPhrase, 2) & "G"
        Case Else: mstrKeyPhrase = ""
    End Select
    If mstrKeyPhrase = "EGG" Then EasterEgg
End Property

Private Sub EasterEgg()
    MsgBox "JC and JW were here!!!"
End Sub

Option Explicit

Dim eggTest As New Egg

Sub Form_Load()
    Me.KeyPreview = True
End Sub

Sub Form_KeyDown(intKeyCode As Integer, intShift As Integer)
    eggTest.Char = intKeyCode
End Sub

Option Explicit

Private Sub cmdOK_Click()
    If txtPassword.Text <> "sesame" Then
        MsgBox "Incorrect password", vbCritical
    Else
        MsgBox "Okay!Dear John, How Do I... Correct password"
    End If
End Sub

Private Sub Form_Load()
    txtPassword.PasswordChar = "*"
    txtPassword.Text=""
End Sub

Option Explicit

Private Sub cmdEncrypt_Click()
    Dim cipherTest As New Cipher
    cipherTest.KeyString = txtKey.Text
    cipherTest.Text = txtClear.Text
    cipherTest.DoXor
    cipherTest.Stretch
    txtEncrypted.Text = cipherTest.Text
End Sub

Private Sub cmdDecrypt_Click()
    Dim cipherTest As New Cipher
    cipherTest.KeyString = txtKey.Text
    cipherTest.Text = txtEncrypted.Text
    cipherTest.Shrink
    cipherTest.DoXor
    txtDecrypted.Text = cipherTest.Text
End Sub

'CIPHER.CLS
`CIPHER.CLS
Option Explicit

Private mstrKey As String
Private mstrText As String

`~~~.KeyString
`A string (key) used in eintCryption and decryption
Public Property Let KeyString(strKey As String)
    mstrKey = strKey
    Initialize
End Property

`~~~.Text
`Write text to be eintCrypted or decrypted
Public Property Let Text(strText As String)
    mstrText = strText
End Property

`Read text that was eintCrypted or decrypted
Public Property Get Text() As String
    Text = mstrText
End Property
`~~~.DoXor
`Exclusive-or method to encrypt or decrypt
Public Sub DoXor()
    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()
    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()
    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

Option Explicit

Private mstrAppName As String
Private mstrSection As String
Private mstrKey As String
Private mstrSetting As String

Private Sub cmdEncrypt_Click()
    Dim cipherTest As New Cipher
    cipherTest.KeyString = txtKey.Text
    cipherTest.Text = txtUser.Text
    cipherTest.DoXor
    cipherTest.Stretch
    mstrSetting = cipherTest.Text
    mstrAppName = App.Title
    mstrSection = "Testing"
    mstrKey = "User Name"
    SaveSetting mstrAppName, mstrSection, mstrKey, mstrSetting
    txtEncrypted.Text = cipherTest.Text
End Sub

Private Sub cmdDecrypt_Click()
    Dim cipherTest As New Cipher
    mstrAppName = App.Title
    mstrSection = "Testing"
    mstrKey = "User Name"
    cipherTest.Text = GetSetting(mstrAppName, mstrSection, mstrKey)
    cipherTest.KeyString = txtKey.Text
    cipherTest.Shrink
    cipherTest.DoXor
    txtDecrypted.Text = cipherTest.Text
End Sub