'Creado por felsalman2500'
'Todos los derechos reservados'
'Su funcion es para ayuda a diseñadores'
'Funciones:'
'Convertir: Convierte de Texto a Hexagecimal
'letras: Convierte una sola letra
'SacarCaracteres: toma los caracteres de una cadena
'LlenarTextBox: llena un textbox respetando las ocho columas y espacios del codigo
'hexagecimal
'Decryptar: Convierte de Hexagecimal a decimal
Public Function Convertir(ByVal texto As String) As String
Dim leng As Long
leng = Len(texto)
Dim i As Integer
Dim res As String
For i = 1 To leng
Dim k As String
k = Mid(texto, i, 1)
res = res & Hex(Asc(k))
Next
Convertir = res
End Function
Public Function letras(ByVal letra As String) As String
Dim res As String
res = Hex(AscW(Mid(letra, 1, 1)))
letras = res
End Function
Public Function SacarCaracteres(ByVal texto As String) As String()
Dim leng As Long
leng = Len(texto)
Dim i As Integer
Dim t As Integer
Dim res(200) As String
For i = 1 To leng
res(i) = Mid(texto, i, 1)
MsgBox (res(i))
t = i
Next
SacarCaracteres = res
End Function
Public Sub LlenarTextBox(ByVal text As String, ByVal cont As textbox)
Dim leng As Long
leng = Len(text)
Dim t As Integer
Dim i As Integer
Dim res As String
t = 1
For i = 1 To leng Step 2
If t = 8 Then
res = res & Mid(text, i, 2) & vbCrLf
t = 1
Else
res = res & Mid(text, i, 2) & " "
t = t + 1
End If
cont.text = res
Next
End Sub
Public Function Decryptar(ByVal texto As String) As String
Dim k As Integer
Dim leng As Long
leng = Len(texto)
Dim i As Integer
Dim res As String
For i = 1 To leng Step 3
k = Val("&H" & Mid(texto, i, 2))
res = res & Chr$(k)
Next
Decryptar = res
End Function |
|
