Хотя бы принципы описал.

пример шифра "Одноразовый блокнот" (OnceTimeNotepad) - один из самых стойких к взлому

Public Function OnceTimeNotepad(ByVal Text As String, Password as String) As String
'МАХ Метод одноразового блокнота
Dim Res As String, I As Long
Dim AsN As Long
Do While Len(Password) < Len(Text)
Password = Password & Password ' создаём цикличный ключ
Loop
For I = 1 To Len(Text)
AsN = (CLng(Asc(Mid$(Text, I, 1))) + CLng(Asc(Mid$(Password, I, 1))))
Res = Res & Chr(AsN Mod 256)
Next
OnceTimeNotepad = Res

End Function




Public Function ReOnceTimeNotepad(ByVal Text As String, Password as String) As String
'МАХ Метод одноразового блокнота (расшифровка)
Dim Res As String, I As Long
Dim AsN As Long
Do While Len(Password) < Len(Text)
Password = Password & Password ' создаём цикличный ключ
Loop
For I = 1 To Len(Text)
AsN = (CLng(Asc(Mid$(Text, I, 1))) - CLng(Asc(Mid$(Password, I, 1))))
Res = Res & Chr((AsN + 256) Mod 256)
Next
ReOnceTimeNotepad = Res
End Function

SNBEM - Еще один, но он не имеет расшифровки. Удобен для хранения паролей.

Public Function IsPrime(ByVal P As Long) As Boolean
Dim Max As Long, F As Long
IsPrime = False
If P < 2 Then Exit Function
If ((P And 1) = 0) Then
IsPrime = (P = 2)
Exit Function
End If
If ((P Mod 3) = 0) Then
IsPrime = (P = 3)
Exit Function
End If
Max = CLng(Int(Sqr(P)))
For F = 5 To Max Step 6
If (((P Mod F) = 0) Or ((P Mod (F + 2)) = 0)) Then Exit Function
Next
IsPrime = True
End Function

Public Function SNBEM(Text)
'МАХ шифровка односторонним ключём
Dim I As Long, J As Long, K As Long, L As Long, P As Long, R As String, T As String
T = Text
For P = 1 To 2
R = ""
L = Len(Text)
For I = 1 To L
J = (L * I + 723) Mod (L + I)
For K = I To Len(Text)
J = ((J * Asc(Mid(Text, K, 1))) Mod 256)
Do While Not IsPrime(J)
J = J + 1
Loop
Next
J = J Mod 256
R = Chr(J) & R
Next
Text = R
Next
Text = T
SNBEM = R
End Function

Public Source As String
Public Letter As String
Public Sub CodeEncode()
Source = frmCryptographer.txtSource.Text: frmCryptographer.txtText.Text = ""
For i = 1 To Len(Source)
Letter = Mid(Source, i, 1)
frmCryptographer.txtText.Text = frmCryptographer.txtText.Text + Chr(Asc(Letter) - 4)
Next i
End Sub
Public Sub Encode()
Source = frmCryptographer.txtSource.Text: frmCryptographer.txtText.Text = ""
For i = 1 To Len(Source)
Letter = Mid(Source, i, 1)
frmCryptographer.txtText.Text = frmCryptographer.txtText.Text + Chr(Asc(Letter) + 4)
Next i
End Sub