Trucos de Visual Basic 6.0 Encriptar y desencriptar cadenas

'Encripta una cadena de caracteres.
'S = Cadena a encriptar
'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


'Desencripta una cadena de caracteres.
'S = Cadena a desencriptar
'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