Attribute VB_Name = "strEncrypt"
Public Function Encrypt(ByVal eText As String)
    Dim Success As String
    If eText = "" Then Exit Function
    Dim MPointer As MousePointerConstants
    MPointer = Screen.MousePointer
    Screen.MousePointer = vbHourglass
    Success = CharCounter(eText)
    Success = ChangeText(Success)
    Success = ShuffleText(Success)
    Success = InvertText(Success)
    Success = InvertCase(Success)
    Success = InvertAsc(Success)
    Encrypt = Success
    Screen.MousePointer = MPointer
End Function

Public Function Decrypt(ByVal eText As String)
    If eText = "" Then Exit Function
    Dim Success As String
    Dim MPointer As MousePointerConstants
    MPointer = Screen.MousePointer
    Screen.MousePointer = vbHourglass
    Success = InvertAsc(eText)
    Success = InvertCase(Success)
    Success = InvertText(Success)
    Success = UnShuffleText(Success)
    Success = RestoreText(Success)
    Success = CharDeCounter(Success)
    Decrypt = Success
    Screen.MousePointer = MPointer
End Function

Public Function InvertText(ByVal eText As String)
    Dim TextLen As Long
    Dim Success As String
    Dim ActualAsc As Long
    Dim x As Long
    TextLen = Len(eText)
    For x = 1 To TextLen
        ActualAsc = Asc(Mid(eText, x, 1))
        Success = Chr(ActualAsc) & Success
    Next x
    On Error GoTo errhandler
    InvertText = Success
    Exit Function
errhandler:
    InvertText = "Text was modified or doesn't exist . . ."
    Exit Function
End Function

Public Function InvertAsc(ByVal eText As String)
    Dim TextLen As Long
    Dim Success As String
    Dim ActualAsc As Long
    Dim Invert As Long
    Dim x As Long
    TextLen = Len(eText)
    For x = 1 To TextLen
        ActualAsc = Asc(Mid(eText, x, 1))
        Invert = 256 - ActualAsc
        Success = Success & Chr(Invert)
    Next x
    On Error GoTo errhandler
    InvertAsc = Success
    Exit Function
errhandler:
    InvertAsc = "Text was modified or doesn't exist. . ."
    Exit Function
End Function

Public Function InvertCase(ByVal eText As String)
    Dim TextLen As Long
    Dim Success As String
    Dim ActualAsc As Long
    Dim Invert As Long
    Dim x As Long
    TextLen = Len(eText)
    For x = 1 To TextLen
        ActualAsc = Asc(Mid(eText, x, 1))
        Select Case ActualAsc
            Case 97 To 122
                ActualAsc = ActualAsc - 32
            Case 65 To 90
                ActualAsc = ActualAsc + 32
        End Select
        Invert = ActualAsc
        Success = Success & Chr(Invert)
    Next x
    On Error GoTo errhandler
    InvertCase = Success
    Exit Function
errhandler:
    InvertCase = "Text was modified or doesn't exist. . ."
    Exit Function
End Function

Public Function HumanToMyNumber(ByVal eText As String) As String
    Dim TextLen As Long
    Dim Success As String
    Dim ActualAsc As Long
    Dim Invert As Long
    Dim x As Long
    TextLen = Len(eText)
    For x = 1 To TextLen
        ActualAsc = Asc(Mid(eText, x, 1))
        Select Case ActualAsc
            Case 48 To 57
                Invert = ActualAsc - 26
            Case Else
                Invert = ActualAsc
        End Select
        Success = Success & Chr(Invert)
    Next x
    On Error GoTo errhandler
    HumanToMyNumber = Success
    Exit Function
errhandler:
    HumanToMyNumber = "Text was modified or doesn't exist. . ."
    Exit Function
End Function

Public Function MyNumberToHuman(ByVal eText As String) As Long
    Dim TextLen As Long
    Dim Success As Long
    Dim ActualAsc As Long
    Dim Invert As Long
    Dim x As Long
    TextLen = Len(eText)
    For x = 1 To TextLen
        ActualAsc = Asc(Mid(eText, x, 1))
        Select Case ActualAsc
            Case 22 To 31
                Invert = ActualAsc + 26
            Case Else
                Invert = ActualAsc
        End Select
        On Error GoTo errhandler
        Success = Success & Chr(Invert)
    Next x
    On Error GoTo errhandler
    MyNumberToHuman = Success
    Exit Function
errhandler:
    Exit Function
End Function

Public Function ShuffleText(ByVal eText As String) As String
    Dim TextLen As Long
    Dim TempLen As Long
    Dim FirstPos As Long
    Dim Success As String
    Dim ActualAsc As Long
    Dim Invert As Long
    Dim TextPos As Long
    Dim x As Long
    TextLen = Len(eText)
        
    Randomize
    TextPos = Rnd * TextLen
    FirstPos = TextLen - TextPos + 1
    Success = HumanToMyNumber(FirstPos) & Chr(14)
    If TextPos = TextLen Then TextPos = 0
    For x = 1 To TextLen
        If TextPos = TextLen Then TextPos = 0
        TextPos = TextPos + 1
        ActualAsc = Asc(Mid(eText, TextPos, 1))
        Success = Success & Chr(ActualAsc)
    Next x
    On Error GoTo errhandler
    ShuffleText = Success
    Exit Function
errhandler:
    ShuffleText = "Text was modified or doesn't exist. . ."
    Exit Function
End Function

Public Function UnShuffleText(ByVal eText As String) As String
    Dim TextLen As Long
    Dim TempLen As Long
    Dim FirstPos As Long
    Dim Success As String
    Dim ActualAsc As String
    Dim TextPos As Long
    Dim Invert As Long
    Dim x, h As Long
    TextLen = Len(eText)
    For x = 1 To TextLen
        h = h + 1
        ActualAsc = Asc(Mid(eText, x, 1))
        If ActualAsc = 14 Then Exit For
    Next x
    h = h - 1
    On Error GoTo errhandler
    FirstPos = Val(MyNumberToHuman(Mid(eText, 1, h)))
    Select Case FirstPos
        Case Is >= TextLen, 1
            UnShuffleText = Right(eText, TextLen - h - 1)
            Exit Function
        Case Else
            TextPos = FirstPos
    End Select
    TextLen = TextLen - h
    eText = Right(eText, TextLen)
    For x = 1 To TextLen
        On Error GoTo errhandler
        ActualAsc = Asc(Mid(eText, TextPos, h))
        If TextPos >= TextLen Then TextPos = 1
        TextPos = TextPos + 1
        Success = Success & Chr(ActualAsc)
    Next x
    On Error GoTo errhandler
    UnShuffleText = Right(Success, TextLen - 1)
    Exit Function
errhandler:
    UnShuffleText = "Text was modified or doesn't exist. . ."
    Exit Function
End Function

Public Function CharCounter(ByVal eText As String) As String
    Dim TextLen As Long
    Dim Succes As String
    TextLen = Len(eText)
    Success = HumanToMyNumber(TextLen) & Chr(12) & eText
    On Error GoTo errhandler
    CharCounter = Success
    Exit Function
errhandler:
    CharCounter = "Text was modified or doesn't exist. . ."
    Exit Function
End Function

Public Function CharDeCounter(ByVal eText As String) As String
    Dim TextLen As Long
    Dim Success As String
    Dim ActualAsc As Long
    Dim AscCount As Long
    Dim x As Long
    TextLen = Len(eText)
    For x = 1 To TextLen
        ActualAsc = Asc(Mid(eText, x, 1))
        If ActualAsc = 12 Then Exit For
    Next x
    AscCount = Val(MyNumberToHuman(Left(eText, x - 1)))
    On Error GoTo errhandler
    eText = Right(eText, TextLen - x)
    TextLen = Len(eText)
    If AscCount = TextLen Then
        Success = eText
    Else
        Success = "Text was modified or doesn't exist. . ."
    End If
    On Error GoTo errhandler
    CharDeCounter = Success
    Exit Function
errhandler:
    CharDeCounter = "Text was modified or doesn't exist. . ."
    Exit Function
End Function

Public Function ChangeText(ByVal eText As String) As String
    Dim TextLen As Long
    Dim Success As String
    Dim ActualAsc As Long
    Dim DumpAsc As Long
    Dim DumpChr As String
    Dim x As Long
    TextLen = Len(eText)
    Randomize
    DumpAsc = Rnd * 9
    For x = 1 To TextLen
        ActualAsc = Asc(Mid(eText, x, 1))
        ActualAsc = ActualAsc + DumpAsc
        Success = Success & Chr(ActualAsc)
    Next x
    DumpChr = HumanToMyNumber(DumpAsc)
    Success = Success & DumpChr
    On Error GoTo errhandler
    ChangeText = Success
    Exit Function
errhandler:
    ChangeText = "Text was modified or doesn't exist. . ."
    Exit Function
End Function

Public Function RestoreText(ByVal eText As String) As String
    Dim TextLen As Long
    Dim Success As String
    Dim DumpAsc As Long
    Dim x As Long
    TextLen = Len(eText)
    DumpAsc = MyNumberToHuman(Right(eText, 1))
    eText = Left(eText, TextLen - 1)
    TextLen = Len(eText)
    For x = 1 To TextLen
        ActualAsc = Asc(Mid(eText, x, 1))
        ActualAsc = ActualAsc - DumpAsc
        Success = Success & Chr(ActualAsc)
    Next x
    On Error GoTo errhandler
    RestoreText = Success
    Exit Function
errhandler:
    RestoreText = "Text was modified or doesn't exist. . ."
    Exit Function
End Function
