SOLDIERX.COM Nobody Can Stop Information Insemination

Public Function Encrypt(ByVal StringToEncrypt As String) As String
OnError:
    On Error GoTo ErrHandler

Dimensions:
    Dim intMousePointer As Integer
    Dim dblCountLength As Double
    Dim intRandomNumber As Integer
    Dim strCurrentChar As String
    Dim intAscCurrentChar As Integer
    Dim intInverseAsc As Integer
    Dim intAddNinetyNine As Integer
    Dim dblMultiRandom As Double
    Dim dblWithRandom As Double
    Dim intCountPower As Integer
    Dim intPower As Integer
    Dim strConvertToBase As String

Constants:
    Const intLowerBounds = 10
    Const intUpperBounds = 28

MainCode:
    Let intMousePointer = Screen.MousePointer
    Let Screen.MousePointer = vbHourglass
    For dblCountLength = 1 To Len(StringToEncrypt)
        Randomize
        Let intRandomNumber = Int((intUpperBounds - intLowerBounds + 1) * Rnd + _
            intLowerBounds)
        Let strCurrentChar = Mid(StringToEncrypt, dblCountLength, 1)
        Let intAscCurrentChar = Asc(strCurrentChar)
        Let intInverseAsc = 256 - intAscCurrentChar
        Let intAddNinetyNine = intInverseAsc + 99
        Let dblMultiRandom = intAddNinetyNine * intRandomNumber
        Let dblWithRandom = Mid(dblMultiRandom, 1, 2) & intRandomNumber & _
            Mid(dblMultiRandom, 3, 2)
        For intCountPower = 0 To 5
            If dblWithRandom / (93 ^ intCountPower) >= 1 Then
                Let intPower = intCountPower
            End If
        Next intCountPower
        Let strConvertToBase = ""
        For intCountPower = intPower To 0 Step -1
            Let strConvertToBase = strConvertToBase & _
                Chr(Int(dblWithRandom / (93 ^ intCountPower)) + 33)
            Let dblWithRandom = dblWithRandom Mod 93 ^ intCountPower
        Next intCountPower
        Let Encrypt = Encrypt & Len(strConvertToBase) & strConvertToBase
    Next dblCountLength
    Let Screen.MousePointer = intMousePointer
    Exit Function

ErrHandler:
    Select Case Err.Number
        Case Else
            Err.Clear
            Resume Next
    End Select
End Function