Início
Convidad 18/10/2010, 18:07'As funções abaixo são muito usadas no nosso dia-a-dia, servem para criptografar e
'descriptografar strings
'OBS.: SOMENTE STRINGS.
'======================================================================================
' As funções feitas abaixo servem para criptografar e descriptografar texto
'======================================================================================
'Para Criptografar texto use o seguinte comando, o exemplo a seguir utiliza o
'código em um CommandButton, mas você pode usar em qualquer parte do seu código
'Imaginando que você tenha uma string digitada em Text1
'Private Sub Command1_Click()
' Text1.Text = EncriptarTexto(Text1.Text)
'End Sub
'Código para Descriptografar.
'Private Sub Command2_Click()
' Text2.Text = DesEncriptarTexto (Text2.Text)
'End Sub
'Os números abaixo são opções que eu estou lhe
'dando como índice, mas você poderá escolher
'qualquer índice menor que 144 e maior que 0.
'Estou lhe dando essas opções porque foram as
'que achei mais interessantes para codificação.
'===============================================
' RELAÇÃO DOS NÚMEROS PARA ÍNDICES DE
' CODIFICAÇÃO DAS STRINGS
'===============================================
'ÍNDICES
' - 23
' - 59
' - 61
' - 62
' - 77
' - 80
' - 82
' - 119
' - 137
'Para criptografar
Public Function EncriptarTexto(Texto As String) As String
On Error GoTo ErroTamanho
Dim x As String
Dim strConta As Integer
Dim P As Integer
Dim LN1 As Currency
x = Empty
strConta = 0
Do While Not strConta = Len(Texto)
strConta = strConta + 1
LN1 = Asc(Mid(Texto, strConta, 1)) + 23
x = x & Chr(LN1)
Loop
EncriptarTexto = x
Exit Function
ErroTamanho:
If Err = 5 Then
MsgBox "O número para criptografar excedeu o tamanho permitido, VERIFIQUE!!!", vbCritical, "Valor Excedido..."
x = Empty
Exit Function
End If
End Function
'Para descriptografar
Public Function DesEncriptarTexto(Texto As String) As String
On Error GoTo ErroTamanho
Dim x As String
Dim strConta As Integer
Dim P As Integer
Dim LN1 As Currency
x = Empty
strConta = 0
Do While Not strConta = Len(Texto)
strConta = strConta + 1
LN1 = Asc(Mid(Texto, strConta, 1)) - 23
x = x & Chr(LN1)
Loop
DesEncriptarTexto = x
Exit Function
ErroTamanho:
If Err = 5 Then
MsgBox "O número para descriptografar excedeu o tamanho permitido, VERIFIQUE!!!", vbCritical, "Valor Excedido..."
x = Empty
Exit Function
End If
End Function
'descriptografar strings
'OBS.: SOMENTE STRINGS.
'======================================================================================
' As funções feitas abaixo servem para criptografar e descriptografar texto
'======================================================================================
'Para Criptografar texto use o seguinte comando, o exemplo a seguir utiliza o
'código em um CommandButton, mas você pode usar em qualquer parte do seu código
'Imaginando que você tenha uma string digitada em Text1
'Private Sub Command1_Click()
' Text1.Text = EncriptarTexto(Text1.Text)
'End Sub
'Código para Descriptografar.
'Private Sub Command2_Click()
' Text2.Text = DesEncriptarTexto (Text2.Text)
'End Sub
'Os números abaixo são opções que eu estou lhe
'dando como índice, mas você poderá escolher
'qualquer índice menor que 144 e maior que 0.
'Estou lhe dando essas opções porque foram as
'que achei mais interessantes para codificação.
'===============================================
' RELAÇÃO DOS NÚMEROS PARA ÍNDICES DE
' CODIFICAÇÃO DAS STRINGS
'===============================================
'ÍNDICES
' - 23
' - 59
' - 61
' - 62
' - 77
' - 80
' - 82
' - 119
' - 137
'Para criptografar
Public Function EncriptarTexto(Texto As String) As String
On Error GoTo ErroTamanho
Dim x As String
Dim strConta As Integer
Dim P As Integer
Dim LN1 As Currency
x = Empty
strConta = 0
Do While Not strConta = Len(Texto)
strConta = strConta + 1
LN1 = Asc(Mid(Texto, strConta, 1)) + 23
x = x & Chr(LN1)
Loop
EncriptarTexto = x
Exit Function
ErroTamanho:
If Err = 5 Then
MsgBox "O número para criptografar excedeu o tamanho permitido, VERIFIQUE!!!", vbCritical, "Valor Excedido..."
x = Empty
Exit Function
End If
End Function
'Para descriptografar
Public Function DesEncriptarTexto(Texto As String) As String
On Error GoTo ErroTamanho
Dim x As String
Dim strConta As Integer
Dim P As Integer
Dim LN1 As Currency
x = Empty
strConta = 0
Do While Not strConta = Len(Texto)
strConta = strConta + 1
LN1 = Asc(Mid(Texto, strConta, 1)) - 23
x = x & Chr(LN1)
Loop
DesEncriptarTexto = x
Exit Function
ErroTamanho:
If Err = 5 Then
MsgBox "O número para descriptografar excedeu o tamanho permitido, VERIFIQUE!!!", vbCritical, "Valor Excedido..."
x = Empty
Exit Function
End If
End Function