Título: StringToBase Function [Source]
Publicado por: xmbeat92 en 16 Febrero 2010, 04:02 am
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:-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
|