Metin şifreleme ve çözme formunuza 2 tane textbox ekleyip birinin ismini txtText yapalım diğerinin isminide txtPassword yapalım. yine iki adet command butonu ekleyip Birinin ismini cmdEncrypt diğerinin ismini cmdDecrypt olarak değiştirelim. Aşağıdaki kodu Formun Kod penceresine ekleyelim.

Option Explicit
#Const CASE_SENSITIVE_PASSWORD = False
Private Sub cmdEncrypt_Click()
txtText = EncryptText((txtText), txtPassword)
End Sub
Private Sub cmdDecrypt_Click()
txtText = DecryptText((txtText), txtPassword)
End Sub
Private Function EncryptText(strText As String, ByVal strPwd As String)
Dim i As Integer, c As Integer
Dim strBuff As String

#If Not CASE_SENSITIVE_PASSWORD Then
strPwd = UCase$(strPwd)
#End If
If Len(strPwd) Then
For i = 1 To Len(strText)
c = Asc(Mid$(strText, i, 1))
c = c + Asc(Mid$(strPwd, (i Mod Len(strPwd)) + 1, 1))
strBuff = strBuff & Chr$(c And &HFF)
Next i
Else
strBuff = strText
End If
EncryptText = strBuff
End Function
Private Function DecryptText(strText As String, ByVal strPwd As String)
Dim i As Integer, c As Integer
Dim strBuff As String
#If Not CASE_SENSITIVE_PASSWORD Then
strPwd = UCase$(strPwd)
#End If
If Len(strPwd) Then
For i = 1 To Len(strText)
c = Asc(Mid$(strText, i, 1))
c = c - Asc(Mid$(strPwd, (i Mod Len(strPwd)) + 1, 1))
strBuff = strBuff & Chr$(c And &HFF)
Next i
Else
strBuff = strText
End If
DecryptText = strBuff
End Function
Private Sub Form_Load()
cmdDecrypt.Caption = "çöz"
cmdEncrypt.Caption = "Şifrele"
txtPassword.Text = "deneme"
txtText = "Bu bir denemedir..."
End Sub

alıntıdır.