Colocar el código en un módulo y llamar a la función:
Código:
obtenercontraseña = DesencriptarContraseña(Contaseña)
Ejemplo:
Código:
Text2.Text = DesencriptarContraseña(Text1.Text)
http://www.securityfocus.com/data/vulnerabilities/exploits/FileZilla_pass.c
Código:
'****************************************************************
'* modDecryptFZilla.bas *
'* descifra las contraseñas que se almacenan en: *
'* HKEY_CURRENT_USER\Software\FileZilla\Recent Servers\ *
'* por el cliente FileZilla. *
'* *
'* La función digit2char convierte de 3 en 3 de ascii a char. *
'* La función decrypt realiza los cálculos para descifrar *
'* cadena obtenida con digit2char. *
'* *
'* Port de C a Visual Basic por xavierote (Javier Ferre) *
'* Código original por: Unknown Author *
'****************************************************************
Option Explicit
Dim password As String
Private Function digit2char(buff As String) As Integer
Dim ascii_buff As String
Dim i As Integer
Dim j As Integer
Dim longitud As Integer
Dim tmp_buffer As Integer
longitud = Len(buff) / 3 'longitud del password
For i = 0 To Len(buff) - 1 Step 3
tmp_buffer = Mid$(buff, i + 1, 3) 'obtiene los digitos de 3 en 3 para convertir a Char
If tmp_buffer > 255 Then 'Si un valor es mayor de 255, da error
MsgBox "La contraseña introducida no es correcta debido a que el valor obtenido, cada 3 digitos, es mayor de 255." & vbCrLf & "Valor obtenido: " & tmp_buffer, vbCritical, "Error"
Exit Function
End If
ascii_buff = ascii_buff & Chr$(tmp_buffer)
Next i
password = ascii_buff
digit2char = longitud
End Function
Private Function decrypt(buff As String) As Integer
Dim i As Integer
Dim pos As Integer
Dim longitud As Integer
Dim buffer_final As String
Dim convirtiendo As Integer
Dim operando As Integer
Dim resultado As Integer
Dim m_key As String
m_key = "FILEZILLA1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ"
If (Len(buff) Mod 3) = 0 Then 'Si es múltiplo de 3, descifra
longitud = digit2char(buff) 'A parte de convertir los números en cadena de texto, obtiene la longitud de la cadena resultante
pos = longitud Mod Len(m_key) 'Obtiene la posición inicial para el m_key
For i = 0 To longitud - 1 'Como empieza desde el 0, la longitud será uno menos
convirtiendo = Asc(Mid$(password, i + 1, 1)) 'Convierte el carácter actual en valor ascii para hacer los cálculos
operando = Asc(Mid$(m_key, (i + 1 + pos) Mod Len(m_key), 1)) 'Cálculos para la decodificación
resultado = Int(convirtiendo Xor operando) 'Xor de las 2 variables anteriores.
buffer_final = buffer_final & Chr$(resultado) 'Hallando todos los carácteres
Next i
password = buffer_final
decrypt = longitud
Else 'Si no es múltiplo de 3
MsgBox "El password introducido no es correcto, debe ser múltiplo de 3", vbCritical, "Error"
password = ""
End If
End Function
Public Function DesencriptarContraseña(Pass As String) As String
decrypt Pass 'Llama a la función decrypt introduciendo el valor de la cadena Pass
DoEvents 'Espera a que se realicen los cálculos
DesencriptarContraseña = password 'Devuelve la contraseña descifrada
End Function
Saludos!!