Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Quiero encriptar mi password y grabarlo a mi tabla en Access

196 views
Skip to first unread message

Alan Manuel

unread,
Jun 14, 2004, 5:04:47 AM6/14/04
to
Hola amigos, deseos sus ayuda.

Kiero guardar mi password encriptado en mi BD Access, y
despues cuando me logeo desencripte para poder tener el
acceso. Este es mi Codigo, pero solo comprueba ke exista
en la BD, a este codigo como puedo implementarle el
encriptar y desencriptar

Private Sub CmdAceptar_Click()
If NroIntentos = 3 Then
msg = "Número de Intentos no válidos para
ingresar al Aplicativo."
MsgBox msg, vbInformation, "Error"
Call cmdCancelar_Click
End If

'User Id no ingresado
If Len(Trim(txtUserName.Text)) = 0 Then
msg = "Usuario no fue ingresado."
MsgBox msg, vbInformation, "Instrucciones"
txtUserName.SetFocus
Exit Sub
End If

'Password no ingresado
If Len(Trim(txtPassword.Text)) = 0 Then
msg = "Password no fue ingresado."
MsgBox msg, vbInformation, "Instrucciones"
txtPassword.SetFocus
Exit Sub
End If

'Analiza usuario
ssql = "Select * From SegUsuarios " & _
"Where user ='" & Trim(txtUserName.Text) & "'"
Set rs = New ADODB.Recordset
rs.Open ssql, cn, adOpenStatic, adLockReadOnly

'Usuario no está registrado
If rs.EOF Then
msg = "Usuario " & Trim(txtUserName.Text) & _
" no está Registrado en el Aplicativo."
MsgBox msg, vbInformation, "Instrucciones"
txtUserName.SetFocus
NroIntentos = NroIntentos + 1
Exit Sub
End If

'Contraseña no válida
If Trim(txtPassword.Text) <> Trim(rs!Password) Then
msg = "Password no Válido para el Usuario " &
rs!user
MsgBox msg, vbInformation, "Instrucciones"
txtPassword.SetFocus
NroIntentos = NroIntentos + 1
SendKeys "{Home}+{End}"
Exit Sub
End If

'Usuario y Password correctos
kUserId = Trim(txtUserName.Text)
Unload Me
Load FrmProgress
FrmProgress.Show
End Sub


Este es mi codigfo en mi formulario de ingreso, aki seria
el desencriptar y en otro para crear usuarios nuevo el
encriptar y desencriptar, yo estoy usando ADO con Access
2000

Alan Manuel Carihua Jesús

Jesús M.G.

unread,
Jun 14, 2004, 5:07:46 AM6/14/04
to
Hola, mira en la web de rubén Vigón en la sección utilidades:

VCrypto
Librería ActiveX (DLL) para encriptado/desencriptado de cadenas de texto. Incluye los algoritmos XOR, Base64, DES, Gost, SkipJack, BlowFish, RC4, TEA y Microsoft® Crypto API, además de otras funciones como generación de cadenas y números aleatorios. Incluye ejemplo de uso

http://www.mvp-access.com/rubenvigon/


Saludos.

--
Jesús Morales González
Almuñécar (Granada) España
E-mail: jesusARROBApolizainformaticaPUNTOcom
Mesenger: jemog...@ESTOhotmail.com
----
(Guía de buen uso del foro)
http://www.mvp-access.com/rubenvigon/foro/default.htm
---
¡Yo uso Google antes de preguntar! ¿y tu?
http://tinyurl.com/gbeq


"Alan Manuel" <AlanC...@msn.com> escribió en el mensaje news:1bc1401c451ee$a46957d0$a601...@phx.gbl...

Alex Martínez

unread,
Jun 14, 2004, 5:12:28 AM6/14/04
to

Puedes usar la librería VCrypto, de nuestro compañero Rubén Vigón:
http://www.mvp-access.com/rubenvigon/zip/vcrypto.zip

--
Saludos,
Alex
[MS-MVP Visual Basic]


Alan Manuel

unread,
Jun 14, 2004, 5:30:02 AM6/14/04
to
Amigos me sale un error

AL momento ke voy a agregar al componente me sale

No se puede cargar 'C:\Windows\System\VCrypt.dll

porke me sale ese error

Rubén Vigón

unread,
Jun 14, 2004, 5:34:26 AM6/14/04
to
Por cierto, tu código:

ssql = "SELECT * FROM SegUsuarios WHERE User = '" & Trim(txtUserName.Text) & "'"

Es propenso a sufrir lo que se denomina "inyección de SQL"; por ejemplo, supón que un usuario malicioso introdujese lo siguiente en tu caja de texto «txtUserName»:

Pedro' OR 'a' ='a

Para evitar la inyección de código SQL, utiliza consultas con parámetros

Un saludo!

Rubén Vigón
Microsoft MVP Visual Basic
http://www.mvp-access.com/rubenvigon

Alex Martínez

unread,
Jun 14, 2004, 5:36:46 AM6/14/04
to

No tienes que añadirlo a los componentes de tu proyecto, sino a las
referencias (Proyecto -> Referencias)

Alan Manuel

unread,
Jun 14, 2004, 5:45:21 AM6/14/04
to
Amigo ALex, y en mi ejemplo ke te envie como lo adaptaria,
ayudeme

Alex Martínez

unread,
Jun 14, 2004, 5:50:59 AM6/14/04
to
Alan Manuel wrote:
> Amigo ALex, y en mi ejemplo ke te envie como lo adaptaria,
> ayudeme

Tienes un ejemplo de uso en el archivo VCrypto.doc que va incluido en el ZIP
que descargaste.

Alan Manuel

unread,
Jun 14, 2004, 6:18:24 AM6/14/04
to
Hola Ruben, enseñame a usar tu DLL VCrypto, este codigo
tengo en mi boton grabar, Como puedo implementarlo en mi
programa, por favor necesito de su ayuda, le voy a
agradecer muchisimo.


Private Sub cmdGrabar_Click()
If Validar_Datos = False Then Exit Sub
If MsgBox("Desea grabar?", vbYesNo + vbQuestion, "Usuario
nuevo") = vbNo Then Exit Sub

Call GrabarDatos
Call LimpiaCampos

'Desactivo botones Grabar y Eliminar
cmdGrabar.Enabled = False
cmdEliminar.Enabled = False
End Sub


Este es mi Funcion GrabarDatos

Sub GrabarDatos()


Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.CursorType = adOpenDynamic
rs.LockType = adLockBatchOptimistic
rs.Open "SegUsuarios", cn
rs.AddNew
rs.Fields("user") = Trim(txtUserName.Text)
rs.Fields("password") = Trim(txtPassword.Text)
rs.UpdateBatch
Set rs = Nothing
End Sub

Rubén Vigón

unread,
Jun 14, 2004, 6:34:10 AM6/14/04
to
Para encriptar una cadena mediante mi librería, sólo tienes que usar el método «Encriptar» de la clase «VCrypto»; por ejemplo, modificando un poco tu código para guardar el contenido de tu caja de texto "txtPassword" encriptado en tu campo "Password":

rs.Fields("user") = Trim(txtUserName.Text)

rs.Fields("password") = EncriptarCadena(Trim(txtPassword.Text))

Private Function EncriptarCadena(ByVal strCadena As String) As String
Dim V As VCrypto
Set V = New VCrypto
strCadena = V.Encriptar(vcrAlgoritmoMSCryptoApi, strCadena, "AlanManuel")
strCadena = V.Encriptar(vcrAlgoritmoBase64, strCadena)
EncriptarCadena = strCadena
Set V = Nothing
End Function

Alan Manuel

unread,
Jun 14, 2004, 7:08:27 AM6/14/04
to
Amigo Ruben ayudeme por favor

Lluís Franco (de viaje)

unread,
Jun 14, 2004, 7:15:41 AM6/14/04
to
Hola Alan,

> Amigo Ruben ayudeme por favor

Uhmmmmm, no entiendo... si te acaba de decir justamente lo que tienes que
hacer. ¿Que es lo que no has entendido?
Saludos,
--
Bye,
Lluís Franco VB-MCP-MVP (de viaje)

Alan Manuel

unread,
Jun 14, 2004, 7:31:22 AM6/14/04
to
Me sale un error en tiempo de ejecucion
Error '9'
Subscript out of range
Ayudeme...

Private Sub cmdAceptar_Click()

'Cancelación por intentos incorrectos


If NroIntentos = 3 Then
msg = "Número de Intentos no válidos para
ingresar al Aplicativo."
MsgBox msg, vbInformation, "Error"
Call cmdCancelar_Click
End If

'User Id no ingresado
If Len(Trim(txtUserName.Text)) = 0 Then
msg = "Usuario no fue ingresado."
MsgBox msg, vbInformation, "Instrucciones"
txtUserName.SetFocus
Exit Sub
End If

'Password no ingresado

If EncriptarCadena(Len(Trim(txtPassword.Text))) =

0 Then
msg = "Password no fue ingresado."
MsgBox msg, vbInformation, "Instrucciones"
txtPassword.SetFocus
Exit Sub
End If

'Analiza usuario
ssql = "Select * From SegUsuarios " & _
"Where user ='" & Trim(txtUserName.Text) & "'"

Set rs = New ADODB.Recordset

rs.Open ssql, cn, adOpenStatic, adLockReadOnly

'Usuario no está registrado
If rs.EOF Then
msg = "Usuario " & Trim(txtUserName.Text) & _
" no está Registrado en el Aplicativo."
MsgBox msg, vbInformation, "Instrucciones"
txtUserName.SetFocus
NroIntentos = NroIntentos + 1
Exit Sub
End If

'Contraseña no válida
If Trim(txtPassword.Text) <> EncriptarCadena(Trim
(rs!Password)) Then


msg = "Password no Válido para el Usuario " &
rs!user
MsgBox msg, vbInformation, "Instrucciones"
txtPassword.SetFocus
NroIntentos = NroIntentos + 1
SendKeys "{Home}+{End}"
Exit Sub
End If

'Usuario y Password correctos
kUserId = Trim(txtUserName.Text)
Unload Me
Load FrmProgress
FrmProgress.Show
End Sub

Private Function EncriptarCadena(ByVal strCadena As

String) As String
Dim V As VCrypto
Set V = New VCrypto

strCadena = V.Desencriptar(vcrAlgoritmoSkipJack,
strCadena, "alanmanuel")
strCadena = V.Desencriptar(vcrAlgoritmoBase64,

Alan Manuel

unread,
Jun 14, 2004, 7:54:28 AM6/14/04
to
Amigo Ruben ayudeme, le acabo de enviar mi codigo como
hago para implementarlo el desencriptar

Lluís Franco (de viaje)

unread,
Jun 14, 2004, 7:58:00 AM6/14/04
to
> Me sale un error en tiempo de ejecucion

Hola,
Es extraño...en que línea de marca el error?

AlanManuel

unread,
Jun 14, 2004, 8:03:38 AM6/14/04
to

Lluís Franco (de viaje)

unread,
Jun 14, 2004, 8:06:12 AM6/14/04
to
Por cierto,
Para corregir el error 9,debes corregir parte de tu código (la parte de
verificación del password no ingresado) por esto

'Password no ingresado
If Len(Trim(txtPassword.Text)) = 0 Then


msg = "Password no fue ingresado."
MsgBox msg, vbInformation, "Instrucciones"
txtPassword.SetFocus
Exit Sub
End If

Saludos,

Alan Manuel

unread,
Jun 14, 2004, 8:16:46 AM6/14/04
to
Creo ke al parecer estaba encriptando algo en vacio, pero
ya lo sake y aun me sale el mismo error... amigo ayudeme.


'Password no ingresado
If Len(Trim(txtPassword.Text)) = 0 Then


msg = "Password no fue ingresado."
MsgBox msg, vbInformation, "Instrucciones"
txtPassword.SetFocus
Exit Sub
End If

Private Function EncriptarCadena(ByVal strCadena As

String) As String
Dim V As VCrypto
Set V = New VCrypto

strCadena = V.Desencriptar(vcrAlgoritmoSkipJack,
strCadena, "alanmanuel")

'strCadena = V.Encriptar(vcrAlgoritmoSkipJack,
strCadena, "JoasysSistemas")
'strCadena = V.Encriptar(vcrAlgoritmoMSCryptoApi,
strCadena, "AlanManuel")

Alan Manuel

unread,
Jun 14, 2004, 9:04:22 AM6/14/04
to
Ruben acabo de enviarte la lineaq ke sale error, ayudame
con eso

Lakrom

unread,
Jun 14, 2004, 12:28:38 PM6/14/04
to
Prueba con este código, a mi me funciona bien.

Private Const PW_DEFAULT As String = ""
Private Const PW_SECTION As String = "Login"
Private Const PW_KEY As String = "Encrypted Password"

Public Property Get Password() As String
Password = GetSetting(r!passchr, PW_SECTION, PW_KEY, PW_DEFAULT)
End Property

Public Property Let Password(ByVal NewValue As String)
SaveSetting AppName, PW_SECTION, PW_KEY, Encrypt(NewValue)
End Property

Public Function Encrypt(ByVal strText) As String
Dim I As Integer, c As Integer
Dim strBuff As String

#If Not CASE_SENSITIVE_PASSWORD Then
strText = UCase$(strText)
#End If

If Len(strText) Then
For I = 1 To Len(strText)
c = Asc(Mid$(strText, I, 1))
c = c + Asc(Mid$(strText, (I Mod Len(strText)) + 1, 1))
strBuff = strBuff & Chr$(c And &HFF)
Next I
Else
strBuff = strText
End If
Encrypt = strBuff
End Function


"Alan Manuel" <AlanC...@msn.com> escribió en el mensaje
news:1bc1401c451ee$a46957d0$a601...@phx.gbl...

0 new messages