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).
'Autor: Xmbeat (JHCC)
'e-mail: xmbeat@hotmail.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
