StringToBase Function [Source]

bueno, este code lo hize el 14 de febrero(domingo), no mas porque si (no tenia nada que hacer, estoy solo como perro, jaja).
la funcion convierte el Texto a la base en la que se especifica (2 para binario, 16 para hexadecima, Etc), le puse un limite de base (35) porque se acabaron las letras del abecedario y no me parecio ponerles los valores despues de la 'Z'. El code quiza se puede optimizar, pero no he tenido tiempo de checkarlo (por las tareas, el servicio social, etc).

Código:

'Autor: Xmbeat (JHCC)
'e-mail: xmbeat:-com, xmbeat@yahoo.com
'Fecha: 14 de Febrero del 2010
'Descripcion: Algoritmo para convertir el valor de la tabla _
 asii/ansi (255) a otro sistema de base y viceversa
'You can distribute the code freely without eliminating these commentaries
'0x35 = 232W0W3G363C0W1Q152T36373G0W2R352U0W2A2R3A3B2V160W3B2Y2V350D0A0W0W1W2R33330W2D3C2T320W150Y273G0W1X302T320Y190W2J363C160D0A1Y333A2V0D0A0W0W1W2R33330W2E2Y2R35323A0W152036390W2C2V2R2U0W3B2Y2V0W2T3634342V353B3A160D0A1Y352U0W232W


'StringToBase Function:
'Strings: Cadena de texto la cual se desea toString/detoString
'toString: Valor Booleano, cuando es seteado a True Convierte el Texto a la Base, _
            Cuando esta en False se hace lo opuesto
'Base: Valor Byte que indica la base de conversion, si la base  tiene mas de 1 digito _
        se convierte en Alfanumerico. Los valores para Base deben ser mayor que 1 y _
        menor a 36 (solo se usa el Abecedario (A-Z) para alfanumerico)
Private Function StringToBase(Strings As String, Optional toString As Boolean = False, _
Optional Base As Byte = 2) As String
Dim I           As Long
Dim NS          As String
Dim TS          As String
Dim CT          As Integer
Dim E           As Integer
Dim Limit       As Integer
Dim Rest        As Integer
Dim toBase      As Integer
On Error GoTo fallo
If Base > 35 Then Err.Raise 6, , "La Base no puede ser mayor a 35"
If Base < 2 Then Err.Raise 6, , "La Base no puede ser menor a 2"
Rest = 256
Do Until Rest <= 1
    Limit = Limit + 1
    Rest = Rest \ Base
Loop
For I = 1 To Len(Strings) Step IIf(toString = True, Limit, 1)
    NS = ""
    CT = IIf(toString, 0, Asc(Mid(Strings, I, 1)))
    For E = 1 To Limit
        If toString Then
            If Len(Mid(Strings, I)) < Limit Then Exit For
            NS = Mid(Mid(Strings, I, Limit), Limit + 1 - E, 1)
            If IsNumeric(NS) = False Then NS = CStr(Asc(NS) - 55)
            CT = CT + Val(NS) * Base ^ (E - 1)
        Else
            toBase = CT Mod Base
            If toBase < 10 Then
                NS = CStr(toBase) & NS
            Else
                NS = Chr$(55 + toBase) & NS
            End If
            
            CT = CT \ Base
        End If
    Next
    TS = TS & IIf(toString, Chr(CT), NS)
Next
StringToBase = TS
Exit Function
fallo:
If Err.Number = 6 Then
    Err.Raise 6, , Err.Description
    Exit Function
End If
Err.Raise 1, , "El Texto no esta codificado con la base " _
            & Base & "  y por lo tanto no se puede DetoString"

End Function

Private Sub Form_Load()
Const Texto As String = "by xmbeat"
Dim Binario As String
Dim Hexa As String
AutoRedraw = True
Binario = StringToBase(Texto)
Hexa = StringToBase(Texto, , 16)
Print Binario
Print Hexa
Print StringToBase(Hexa, True, 16)
End Sub