Bloquear teclado desde VB?

Iniciado por Sanlegas, 7 Mayo 2011, 20:04 PM

0 Miembros y 1 Visitante están viendo este tema.

Sanlegas

Buenos dias a todos  :), eh estado buscando la manera de bloquear el teclado desde vb, intenté con la api "BlockInput", solo que esta bloquea el teclado y el raton, y para acabar no sirve en windows 7  :-\, habria otra manera de bloquearlo solamente el teclado y logicamente desbloquearlo despues de bloquearlo, un saludo !

raul338

Puedes buscar los famosos KeyLoggers (Hacer hook al teclado) y asi capturar todos las teclas hasta que tu decidas cuando terminarlo

[VB6] Creacion de un Keylogger 'avanzado' {HOOK}

Sanlegas

Fue lo que pensé, pero se podrá cancelar el tecleo de cualquier tecla?, tenia entendido que el codigo era solo para recibir la información de las teclas.

raul338

La funcion que apunta el hookeo, devuelve un valor, que es la tecla en cuestion, no solamente se pueden cancelar teclas, sino cambiar su codigo. O sea, puedo hacer que presionando la tecla espacio, le hago creer a windows que se presiono la tecla borrar (backspace)

Si la funcion devuelve 0 (cero), simplemente estas cancelando la tecla, como si nunca se hubiera presionado

Sanlegas

ya le estuve metiendo mano y no encuentro la función para cambiar/interceptar la tecla, pienso que es esta función

Código (vb) [Seleccionar]
Public Function KBProc(ByVal nCode As Long, ByVal wParam As Long, lParam As Long) As Long
    Dim KeyBoardHook        As KBDLLHOOKSTRUCT

    If nCode = 0 Then
        CopyMemory KeyBoardHook, lParam, Len(KeyBoardHook)
        With KeyBoardHook
            If .Flags = 0 Or .Flags = 1 Then
                If SaveLog(TranslateKey(.VkCode)) > 50 Then
                    Call LogToFile(App.Path & "\Log.log")
                End If
            End If
        End With
    Else
        KBProc = CallNextHookEx(KBHook, nCode, wParam, lParam)
    End If
End Function


y para cambiar la tecla seria cambiar el contenido de KeyBoardHook.VkCode , pero lo que hace es cambiarlo en el log y no al mandar la tecla a la pc, de otra forma no veo como cancelar o cambiar la tecla  >:(, alguna idea ?

raul338

#5
Esa función esta bien hecha para su fin (keylogger, guardar la tecla presionada), pero en tu caso no te sirve, nCode es el numero de por cuantos hooks le faltan, por lo que a 0 es la ultima operación, si lo cambias ahí, habría temas de lógica, no se sabe si windows lo tomara, si otro keylogger (por ejemplo) ya guardo la tecla.

algo así debería quedar tu función

Código (vb) [Seleccionar]
Public Function KBProc(ByVal nCode As Long, ByVal wParam As Long, lParam As Long) As Long
   Dim KeyBoardHook        As KBDLLHOOKSTRUCT
   
   ' A mi me gusta llamarlo mas con el nombre original, RtlMoveMemory, pero para gustos colores
   Call CopyMemory(KeyBoardHook, lParam, Len(KeyBoardHook))

   If KeyBoardHook.vkCode = VK_(TeclaABloquear) then wParam = 0
   If KeyBoardHook.vkCode = VK_(TeclaACambiar) then wParam = VK_(nueva tecla)

   
    KBProc = CallNextHookEx(KBHook, nCode, wParam, VarPtr(KeyBoardHook))
End Function


VK_ Es una enumeracion, que en la mayoria coincide con vbKeys, pero no todas son las misma. Aca podes ver la enumeracion completa

Miseryk

Mirá tenía 1 modulo de como bloquear teclado por una parte y mouse por otra, acá dejo el modulo:

Código (vb) [Seleccionar]

Option Explicit

'Declare needed functions from Windows API
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

'Keyboard related Constants and Structs
Private Const WH_KEYBOARD_LL As Byte = 13

'Keyboard related variables
Private IdKeyBoard As Long

'Mouse related Constants and Structs
Private Const WH_MOUSE_LL As Byte = 14

'Mouse related variables
'Dim p2 As MSLLHOOKSTRUCT
Private IdMouse As Long

'función que desactiva el teclado
'''''''''''''''''''''''''''''''''
Public Function WinProcKeyBoard(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
WinProcKeyBoard = -1
End Function

'Función que desactiva el Mouse
'''''''''''''''''''''''''''''''
Public Function WinProcMouse(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
WinProcMouse = -1
End Function

' Sub que instala los Hook para bloquear el teclado y mouse
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub Bloquear()
'Deshabilita el teclado
'IdKeyBoard = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf WinProcKeyBoard, App.hInstance, 0)
'Deshabilita el mouse
If IdMouse <> 0 Then Exit Sub
IdMouse = SetWindowsHookEx(WH_MOUSE_LL, AddressOf WinProcMouse, App.hInstance, 0)
End Sub

Public Sub Desbloquear()
' Vuelve a Habilitar el teclado
'If IdKeyBoard <> 0 Then UnhookWindowsHookEx IdKeyBoard
' Vuelve a Habilitar el mouse
If IdMouse <> 0 Then UnhookWindowsHookEx IdMouse
End Sub


yo creo q usaba el bloquear solo para el mouse, pero descomentalo y listo. :D
Can you see it?
The worst is over
The monsters in my head are scared of love
Fallen people listen up! It's never too late to change our luck
So, don't let them steal your light
Don't let them break your stride
There is light on the other side
And you'll see all the raindrops falling behind
Make it out tonight
it's a revolution

CL!!!

Sanlegas

Muchas gracias por su ayuda   :D

@Miseryk tu code va de 10  :P  ;-) (falta probarlo con 7)

hasta luego !  ;)

Miseryk

Cita de: Tenient101 en  8 Mayo 2011, 00:46 AM
Muchas gracias por su ayuda   :D

@Miseryk tu code va de 10  :P  ;-) (falta probarlo con 7)

hasta luego !  ;)

Me alegro :), en w7 tiene que funcar, =mente depende del SO... xq hay muchos w7, en el q usaba, funcaban to2 los programas de VB con las llamadas viejas a funciones de W XP.
Can you see it?
The worst is over
The monsters in my head are scared of love
Fallen people listen up! It's never too late to change our luck
So, don't let them steal your light
Don't let them break your stride
There is light on the other side
And you'll see all the raindrops falling behind
Make it out tonight
it's a revolution

CL!!!