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

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

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

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