Captura de Clave
Publicado por Socrates (10 intervenciones) el 15/11/2011 01:02:43
Estimados
El código abajo descrito es de Jefferson, hace mención a un formulario ( frm3) en cual no tiene ningún texbox.
Necesito capturar la clave que el usuario coloca en el inputbox, y ponerla en el formulario principal.
¿Como le hago?
Option Compare Database
Option Explicit
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function SendMessageLongRef Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private m_ASC As Long
Sub inputbox_Password(El_Form As Form, Caracter As String)
Dim Buscar, PassWord As String
m_ASC = Asc(Caracter)
Call SetTimer(El_Form.hwnd, &H5000&, 100, AddressOf TimerProc)
PassWord = InputBox(" Ingrese el Password " & vbCrLf & _
" Para Abrir este Formulario", "Usuario")
If PassWord = "" Then
MsgBox "Debe Ingresar su Contraseña", vbCritical, "Adios"
DoCmd.Close
End
Exit Sub
Else
Buscar = DLookup("[Clave]", _
"Usuarios", "[Clave]= " & "'" & PassWord & "'" & "")
If Buscar = PassWord Then
Else
MsgBox "Esta Contraseña es Errada", vbCritical, "Adios"
DoCmd.Close
End
Exit Sub
End If
End If
End Sub
Private Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
Dim Handle_InputBox As Long
Handle_InputBox = FindWindowEx(FindWindow("#32770", "Usuario"), 0, "Edit", "")
Call SendMessageLongRef(Handle_InputBox, &HCC&, m_ASC, 0)
Call KillTimer(hwnd, idEvent)
End Sub
El código abajo descrito es de Jefferson, hace mención a un formulario ( frm3) en cual no tiene ningún texbox.
Necesito capturar la clave que el usuario coloca en el inputbox, y ponerla en el formulario principal.
¿Como le hago?
Option Compare Database
Option Explicit
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function SendMessageLongRef Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private m_ASC As Long
Sub inputbox_Password(El_Form As Form, Caracter As String)
Dim Buscar, PassWord As String
m_ASC = Asc(Caracter)
Call SetTimer(El_Form.hwnd, &H5000&, 100, AddressOf TimerProc)
PassWord = InputBox(" Ingrese el Password " & vbCrLf & _
" Para Abrir este Formulario", "Usuario")
If PassWord = "" Then
MsgBox "Debe Ingresar su Contraseña", vbCritical, "Adios"
DoCmd.Close
End
Exit Sub
Else
Buscar = DLookup("[Clave]", _
"Usuarios", "[Clave]= " & "'" & PassWord & "'" & "")
If Buscar = PassWord Then
Else
MsgBox "Esta Contraseña es Errada", vbCritical, "Adios"
DoCmd.Close
End
Exit Sub
End If
End If
End Sub
Private Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
Dim Handle_InputBox As Long
Handle_InputBox = FindWindowEx(FindWindow("#32770", "Usuario"), 0, "Edit", "")
Call SendMessageLongRef(Handle_InputBox, &HCC&, m_ASC, 0)
Call KillTimer(hwnd, idEvent)
End Sub
Valora esta pregunta


0