[VB+ASM][Snippet] Low Level Keyboard

Trabajando a bajo nivel con hooks sobre el teclado, en el proceso no mostrar ninguna clase de msgbox.

module

Código

Option Explicit
 
 
'''''''''''''''''''''''''''''''''''''''''''''''''
'	Autor: RHL
'	Email: opRhl@hotmail.com
'	Not remove this text
'''''''''''''''''''''''''''''''''''''''''''''''''
 
 
 
Private Declare Sub RtlMoveMemory Lib "Kernel32.dll" (Dest As Any, Src As Any, ByVal ln As Long)
Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As Any, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) 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 Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
 
Private Type KBDLLHOOKSTRUCT
    vkCode              As Long
    scanCode            As Long
    flags               As Long
    time                As Long
    dwExtraInfo         As Long
End Type
 
Private Const MSGTEXT                       As String = "DATA"
    Private Const VKC                       As String = vbCrLf & "VKC: "
    Private Const SCC                       As String = vbCrLf & "SCC: "
    Private Const FLG                       As String = vbCrLf & "FLG: "
    Private Const TME                       As String = vbCrLf & "TME: "
    Private Const EXI                       As String = vbCrLf & "EXI: "
Private Const MSGCaption                    As String = vbCrLf & "DATA"
 
Public Const WH_KEYBOARD_LL                 As Long = 13&
Public Const SH                             As String = "558BEC5352578B450883F8007C3483F800752F8B550C81FA040100007D2781FA000100007522BFXXXXXXXX8B5D10558BEBB9050000008B4500890783C70483C504E2F35DE8XXXXXXXX8B15XXXXXXXXFF7510FF750CFF750852E8XXXXXXXX5F5A5B8BE55DC20C00" 
private KB                                  As KBDLLHOOKSTRUCT
private hwHook                              As Long
private runCode(108)                        As Byte
 
 
Public Function Reghook(ByVal hw As Long) As Boolean
    hwHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf FncVBASM, App.hInstance, 0)
    If hwHook Then Reghook = True
End Function
 
Public Sub UnHook(ByVal hw As Long)
    UnhookWindowsHookEx hwHook
End Sub
 
' shellcode to execute
'MOV EAX,0B0
'PUSH EBP
'MOV EBP,ESP
'PUSH EBX
'PUSH EDX
'PUSH EDI
'MOV EAX,DWORD PTR SS:[EBP+8]
'CMP EAX,0
'JL  $+XX
'CMP EAX,0
'JNZ $+XX
'MOV EDX,DWORD PTR SS:[EBP+C]
'CMP EDX,104
'JGE $+XX
'CMP EDX,100
'JNZ $+XX
'MOV EDI,[Struct KB]
'MOV EBX,DWORD PTR SS:[EBP+10]
'PUSH EBP
'MOV EBP,EBX
'MOV ECX,5
'MOV EAX,DWORD PTR SS:[EBP]
'MOV DWORD PTR DS:[EDI],EAX
'ADD EDI,4
'ADD EBP,4
'LOOP $
'POP EBP
'CALL MSG
'MOV EDX,DWORD PTR DS:[hHook]
'PUSH DWORD PTR SS:[EBP+10]
'PUSH DWORD PTR SS:[EBP+C]
'PUSH DWORD PTR SS:[EBP+8]
'PUSH EDX
'CALL CallNextHookEx
'POP EDI
'POP EDX
'POP EBX
'MOV ESP,EBP
'POP EBP
'RETN 0C
 
Public Function FncVBASM(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    FncVBASM = &H50
    FncVBASM = FncVBASM + &H60
    FncVBASM = FncVBASM + &H10
    FncVBASM = FncVBASM + &H80
    FncVBASM = FncVBASM + &H40
    FncVBASM = FncVBASM + &H20
    FncVBASM = FncVBASM + &H100
    FncVBASM = FncVBASM - &H200
    FncVBASM = FncVBASM * &H2
    FncVBASM = FncVBASM - &H150
    FncVBASM = FncVBASM + &H20
    FncVBASM = FncVBASM + &H10
    FncVBASM = FncVBASM + &H60
    FncVBASM = FncVBASM + &H10
    FncVBASM = FncVBASM + &H40
    FncVBASM = FncVBASM + &H60
    FncVBASM = FncVBASM + &H10
    FncVBASM = FncVBASM + &H40
    FncVBASM = FncVBASM + &H6
    FncVBASM = FncVBASM + &H79
    FncVBASM = FncVBASM + &H9
End Function
 
 
Public Function PreCodASM(lpFunctASM As Long) As Boolean
    Dim Protect         As Long
    Dim lsize           As Long
    Dim i               As Long
    Dim tLng            As Long
    Dim tSC             As String
    Dim addrMSG         As Long
 
    tSC = SH
    addrMSG = Getaddrf(AddressOf MSG)
    tLng = getAddrCNHE
 
    Mid(tSC, 79, 8) = Hex$(Invertlong(VarPtr(KB)))                                   
    Mid(tSC, 139, 8) = Hex$(Invertlong(addrMSG - &H5 - (lpFunctASM + 73)))
    Mid(tSC, 151, 8) = Hex$(Invertlong(VarPtr(hwHook)))                              
    Mid(tSC, 181, 8) = Hex$(Invertlong(tLng - &H5 - (lpFunctASM + 94)))              
 
    lsize = Len(tSC) \ 2
    For i = 0 To lsize - 1
        runCode(i) = CLng("&H" & Mid$(tSC, i * 2 + 1, 2))
    Next
 
    If 0 = VirtualProtect(ByVal lpFunctASM, lsize + 5, PAGE_EXECUTE_READWRITE, Protect) Then Exit Function
    RtlMoveMemory ByVal lpFunctASM + &H5, ByVal VarPtr(runCode(0)), lsize
    VirtualProtect ByVal lpFunctASM, lsize + 5, Protect, Protect
    PreCodASM = True
End Function
 
Private Function Invertlong(ByVal llng As Long) As Long
Dim t               As Long
	t = (((llng And &HFF000000) \ &H1000000) And &HFF&) Or ((llng And &HFF0000) \ &H100&) Or ((llng And &HFF00&) * &H100&) Or ((llng And &H7F&) * &H1000000): If (llng And &H80&) Then t = t Or &H80000000
	Invertlong = t
End Function
 
Private Function getAddrCNHE() As Long
    Dim AddrUSER            As Long
 
    AddrUSER = GetModuleHandle("user32.dll")
    getAddrCNHE = GetProcAddress(AddrUSER, "CallNextHookEx")
End Function
 
Public Function Getaddrf(lp As Long) As Long
    Getaddrf = lp
End Function
 
Public Sub MSG()
MsgBox MSGTEXT & VKC & KB.vkCode & SCC & KB.scanCode & FLG & KB.flags & TME & KB.time & EXI & KB.dwExtraInfo, 0, MSGCaption
' EAX = 0
End Sub
 
 
'''''''''''''''''''''''''''''''''''''''''''''''''
'	Autor: RHL
'	Email: opRhl@hotmail.com
'	Not remove this text
'''''''''''''''''''''''''''''''''''''''''''''''''

Example:
form

Código

 
'''''''''''''''''''''''''''''''''''''''''''''''''
'	Autor: RHL
'	Email: opRhl@hotmail.com
'	Not remove this text
'''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" ( _
                                                                ByVal lpModuleName As String) As Long
 
Private Sub Form_Load()
    If GetModuleHandle("VBA6") Then Debug.Print "only compiled": End
    If Reghook(Me.hWnd) Then MsgBox "Hooked activate!"
    If not PreCodASM(AddressOf FncVBASM) Then debug.print "error": end
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    UnHook (Me.hWnd)
End Sub

con esto me despido de vb...