Шифратор текста в цифровые значения и обратно

    Class DictClass
        Property Key As String
        Property Value As String
        Shared Function ArrToList(StringArr As String(,)) As List(Of DictClass)
            If IsNothing(StringArr) Then Return Nothing
            ArrToList = New List(Of DictClass)
            If UBound(StringArr) = 0 Then Exit Function
            For Ind As Integer = 0 To UBound(StringArr)
                ArrToList.Add(New DictClass With {.Key = StringArr(Ind, 0), .Value = StringArr(Ind, 1)})
            Next
        End Function
 
        Public Class ComparerDictKey
            Implements IComparer(Of DictClass)
 
            Public Function Compare(ByVal x As DictClass,
            ByVal y As DictClass) As Integer _
            Implements IComparer(Of DictClass).Compare
 
                Return (x.Key).CompareTo(y.Key)
            End Function
        End Class
 
        Shared Function Coding(Dict As List(Of DictClass), ByVal StringCoding As String) As String
            Dim Compar As New ComparerDictKey
 
            Dict.Sort(Compar)
            Coding = ""
            Dim Begin As Integer = 0
            Do While StringCoding.Length > Begin
                Dim DictFind = New DictClass
                Dim FullKey As String
                Dim Value As String
                Dim BeginLen As Integer = 1
                FullKey = ""
                Value = ""
                Do While StringCoding.Length >= Begin + BeginLen
                    DictFind.Key = StringCoding.Substring(Begin, BeginLen)
                    Dim IndKeyNew As Integer = Dict.BinarySearch(DictFind, Compar)
                    If IndKeyNew >= 0 Then
                        FullKey = DictFind.Key
                        Value = Dict.ElementAt(IndKeyNew).Value
                    Else
                        Dim PrevKey As String = Dict.ElementAt(-IndKeyNew - 1).Key
                        If PrevKey.Length > DictFind.Key.Length AndAlso PrevKey.Substring(0, DictFind.Key.Length) = DictFind.Key Then
                            BeginLen += 1
                        Else
                            Exit Do
                        End If
                    End If
                    BeginLen += 1
                Loop
                If Value = "" Then
                    MsgBox("Ошибка кодирования!")
                End If
                Coding += Value
                Begin += FullKey.Length
            Loop
        End Function
 
        Public Class ComparerDictValue
            Implements IComparer(Of DictClass)
 
            Public Function Compare(ByVal x As DictClass,
            ByVal y As DictClass) As Integer _
            Implements IComparer(Of DictClass).Compare
 
                Return (x.Value).CompareTo(y.Value)
            End Function
        End Class
 
        Shared Function DeCoding(Dict As List(Of DictClass), ByVal StringDeCoding As String) As String
            If StringDeCoding.Length Mod 3 <> 0 Then
                MsgBox("Ошибка декодирования!")
            End If
            Dim ValueArr(StringDeCoding.Length \ 3)
            Dim Compar As New ComparerDictValue
            Dict.Sort(Compar)
            DeCoding = ""
            Dim Begin As Integer = 0
            For BeginCod As Integer = 0 To StringDeCoding.Length - 1 Step 3
                Dim DictFind = New DictClass
                DictFind.Value = StringDeCoding.Substring(BeginCod, 3)
                Dim IndValue As Integer = Dict.BinarySearch(DictFind, Compar)
                If IndValue < 0 Then
                    MsgBox("Ошибка декодирования!")
                End If
                DeCoding += Dict.ElementAt(IndValue).Key
            Next BeginCod
        End Function
    End Class
 
 
    Dim MyDict As List(Of DictClass)
 
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Dim MyDictArrr(,) = {
                        {"привет", "325"},
                        {"как дела", "448"},
                        {"а", "678"},
                        {"б", "789"},
                        {"л", "021"},
                        {"в", "211"},
                        {" ", "781"},
                        {"к", "741"},
                        {"п", "ппп"},
                        {"т", "999"},
                        {"р", "230"},
                        {"и", "555"},
                        {"я", "747"},
                        {"1", "222"},
                        {"д", "620"},
                        {"2", "345"},
                        {"и", "367"},
                        {"3", "446"},
                        {"4", "852"},
                        {"е", "100"}
                    }
        MyDict = DictClass.ArrToList(MyDictArrr)
 
    End Sub
    Private Sub ButtonCoding_Click(sender As Object, e As EventArgs) Handles ButtonCoding.Click
        TextBox2.Text = DictClass.Coding(MyDict, TextBox1.Text)
    End Sub
    Private Sub ButtonDeCoding_Click(sender As Object, e As EventArgs) Handles ButtonDeCoding.Click
        TextBox1.Text = DictClass.DeCoding(MyDict, TextBox2.Text)
    End Sub

Imports System.IO
Imports System.Runtime.Serialization.Formatters.Binary
Public Class Form3
    Private dCod As Dictionary(Of String, Integer)
    Private dDecod As Dictionary(Of Integer, String)
    Private abFile As String
    Private Sub Form3_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        abFile = Path.Combine(Application.StartupPath, "Alphabet.dat")
    End Sub
    Private Sub Create_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        MessageBox.Show("Старые сообщения не смогут быть прочитаны в новом алфавите. Продолжить?", "Вы уверены?", _
           MessageBoxButtons.YesNo, MessageBoxIcon.Question)
        creationNewAlphabet()
    End Sub
    Private Sub Coding_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click
        If dCod Is Nothing Then
            dCod = BinaryDeserialize(abFile)
            dDecod = dCod.ToDictionary(Function(kvp) kvp.Value, Function(kvp) kvp.Key)
        End If
        TextBox2.Clear()
        Dim strC As String = Coding(TextBox1.Text, dCod)
        With SaveFileDialog1
            .Filter = "txt files (*.txt)|*.txt|All files (*.*)|*.*"
            .FilterIndex = 0
            .RestoreDirectory = True
            .InitialDirectory = Application.StartupPath
            If .ShowDialog() = DialogResult.OK Then
                File.WriteAllText(.FileName, strC)
                TextBox2.Text = strC
            End If
        End With
    End Sub
    Private Sub deCoding_Click(sender As System.Object, e As System.EventArgs) Handles Button3.Click
        Dim strC As String = ""
        With OpenFileDialog1
            .Filter = "txt files (*.txt)|*.txt|All files (*.*)|*.*"
            .FilterIndex = 0
            .RestoreDirectory = True
            .InitialDirectory = Application.StartupPath
            If .ShowDialog() = DialogResult.OK Then
                strC = File.ReadAllText(.FileName)
                TextBox2.Text = strC
            Else
                Exit Sub
            End If
        End With
        TextBox3.Clear()
        If dDecod Is Nothing Then
            dCod = BinaryDeserialize(abFile)
            dDecod = dCod.ToDictionary(Function(kvp) kvp.Value, Function(kvp) kvp.Key)
        End If
        strC = System.Text.RegularExpressions.Regex.Replace(strC, "\d{3}", Function(m) dDecod(m.Value))
        TextBox3.Text = strC
    End Sub
    Private Sub creationNewAlphabet()
        Dim r As New Random()
        Dim vv As Integer() = Enumerable.Range(100, 899).OrderBy(Function(n) r.Next).Take(80).ToArray() 'А-я;Ё;ё;0-9; ;формат;версии;сведения
        Dim kk(vv.Length - 1) As String
        For i = 0 To 63
            kk(i) = Chr(i + 192)
        Next
        kk(64) = Chr(168)
        kk(65) = Chr(184)
        For i = 66 To 75
            kk(i) = Chr(i - 66 + 48)
        Next
        kk(76) = Chr(32)
        kk(77) = "формат"
        kk(78) = "версии"
        kk(79) = "сведения"
        Dim da As New Dictionary(Of String, Integer)
        For i = 0 To vv.Length - 1
            da.Add(kk(i), vv(i))
        Next
        BinarySerialize(da, abFile)
    End Sub
    Private Function Coding(ByVal text As String, ByVal da As Dictionary(Of String, Integer)) As String
        Dim wrd() As String = text.Split({" "c, "."c, ","c, "!"c, "?"c}, StringSplitOptions.RemoveEmptyEntries)
        Dim sb As New System.Text.StringBuilder
        Dim wr As String = ""
        For i = 0 To wrd.Length - 1
            wr = wrd(i)
            If da.ContainsKey(wr) Then
                sb.Append(da(wr))
            Else
                For j = 0 To wr.Length - 1
                    sb.Append(da(wr(j)))
                Next
            End If
            sb.Append(da(" "))
        Next
        Return sb.ToString
    End Function
    Private Sub BinarySerialize(ByVal item As Dictionary(Of String, Integer), ByVal fileName As String)
        Using stream As Stream = File.Open(fileName, FileMode.Create)
            Dim binaryFormatter As BinaryFormatter = New BinaryFormatter()
            binaryFormatter.Serialize(stream, item)
        End Using
    End Sub
    Private Function BinaryDeserialize(ByVal fileName As String) As Dictionary(Of String, Integer)
        Using stream As Stream = File.Open(fileName, FileMode.OpenOrCreate)
            Dim Formatter As New BinaryFormatter()
            stream.Seek(0, SeekOrigin.Begin)
            Dim item As Dictionary(Of String, Integer) = DirectCast(Formatter.Deserialize(stream), Dictionary(Of String, Integer))
            Return item
        End Using
    End Function
End Class