Autor
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...
En línea
Pero te ha quedado bonito el código, aunque el ASM se podría aligerar.
