تشخيص فشرده شدن كليد در صورتي كه فوكوس بر روي برنامه نباشد

[prog220]

سلام دوستان این سورس کد که برای شما گذاشتم این کار را میکند که شما در موقعی که روی فرم فوکوس نشده میتوانید کلید اسکی کلید های فشرده شده را داشته باشید
با این کار شما میتوانید یک Key logger بسازیم

تشکر یادتان نره موفق باشید

كدهاي Module1:




Option Explicit
Public m_hDllKbdHook As Long 'public variable holding
'the handle to the hook procedure

Public Const WH_KEYBOARD_LL As Long = 13 'enables monitoring of keyboard
'input events about to be posted
'in a thread input queue

Private Const HC_ACTION As Long = 0 'wParam and lParam parameters
'contain information about a
'keyboard message
Private Const LLKHF_UP As Long = &H80& 'test the transition-state flag
Public Type KeyboardBytes
kbByte(0 To 255) As Byte
End Type
Private Type KBDLLHOOKSTRUCT
vkCode As Long 'a virtual-key code in the range 1 to 254
scanCode As Long 'hardware scan code for the key
flags As Long 'specifies the extended-key flag,
'event-injected flag, context code,
'and transition-state flag
time As Long 'time stamp for this message
dwExtraInfo As Long 'extra info associated with the message
End Type
Public 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

Public Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
Public Declare Function CallNextHookEx Lib "user32" _
(ByVal hHook As Long, _
ByVal nCode As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long

Public Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(pDest As Any, _
pSource As Any, _
ByVal cb As Long)
Public Declare Function GetKeyboardState Lib "user32" _
(kbArray As KeyboardBytes) As Long
Public Declare Function GetKeyState Lib "user32" _
(ByVal nVirtKey As Long) As Integer

Public Function LowLevelKeyboardProc(ByVal nCode As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim kbdllhs As KBDLLHOOKSTRUCT

If nCode = HC_ACTION Then

Call CopyMemory(kbdllhs, ByVal lParam, Len(kbdllhs))
If (kbdllhs.flags And LLKHF_UP) Then

MsgBox (kbdllhs.vkCode)


End If

End If 'nCode = HC_ACTION

LowLevelKeyboardProc = CallNextHookEx(m_hDllKbdHook, _
nCode, _
wParam, _
lParam)

End Function






:كد هاي داخل فرم اصلي





Option Explicit
Private Sub Form_Load() 'set and obtain the handle to the keyboard hook
m_hDllKbdHook = SetWindowsHookEx(WH_KEYBOARD_LL, _
AddressOf LowLevelKeyboardProc, _
App.hInstance, _
0&) If m_hDllKbdHook = 0 Then

MsgBox "Failed to install low-level keyboard hook."

End If

End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) If m_hDllKbdHook <> 0 Then
Call UnhookWindowsHookEx(m_hDllKbdHook)
End If

End Sub

[amirsadeghi]

دوست من مطمئنی این برنامه جواب میده؟
منظورم اینه که تو وی بی رانش کردی؟

بنظر میاد ارور داشته باشه!

روش دیگه ای هم برای اینکار هست که کیبورد رو به عنوان یه hid باهاش برخورد کنی...