| |
|
Autor: Enviado por: Hurricane - Enviado con fecha: 28-04-2005 01:03:05. |
Las siguientes funciones les van a servir para Encriptar y Desencriptar cadenas de caracteres con una Password.
Rem Encripta una cadena de caracteres.
Rem S = Cadena a encriptar
Rem P = Password
Function EncryptStr(ByVal S As String, ByVal P As String) As String
Dim I As Integer, R As String
Dim C1 As Integer, C2 As Integer
R = ""
If Len(P) > 0 Then
For I = 1 To Len(S)
C1 = Asc(Mid(S, I, 1))
If I > Len(P) Then
C2 = Asc(Mid(P, I Mod Len(P) + 1, 1))
Else
C2 = Asc(Mid(P, I, 1))
End If
C1 = C1 + C2 + 64
If C1 > 255 Then C1 = C1 - 256
R = R + Chr(C1)
Next I
Else
R = S
End If
EncryptStr = R
End Function
Rem Desencripta una cadena de caracteres.
Rem S = Cadena a desencriptar
Rem P = Password
Function UnEncryptStr(ByVal S As String, ByVal P As String) As String
Dim I As Integer, R As String
Dim C1 As Integer, C2 As Integer
R = ""
If Len(P) > 0 Then
For I = 1 To Len(S)
C1 = Asc(Mid(S, I, 1))
If I > Len(P) Then
C2 = Asc(Mid(P, I Mod Len(P) + 1, 1))
Else
C2 = Asc(Mid(P, I, 1))
End If
C1 = C1 - C2 - 64
If Sgn(C1)=-1 Then C1 = 256 + C1
R = R + Chr(C1)
Next I
Else
R = S
End If
UnEncryptStr = R
End Function
Saludos ;-)
|
|
