Re: Detect Application Launch




"Jimmy Jam" <jjam@xxxxxxxxx> wrote in message
news:uKNtMX29FHA.572@xxxxxxxxxxxxxxxxxxxxxxx
> Is there a way to hook the system event when an application is launched ?
> I need to be notified when any application is launched.
>
> I could poll process IDs over and over to detect this, but I would rather
> do it more elegantly via a hook if such a method were available.


Yes, there is, but (without sounding arrogant), it's not for the faint of
heart. <g>

What you need to do is set up a shell hook. There are a couple of ways to do
this, but only one (and only recently documented) that's really feasible in
VB. The previously documented way was to call the SetWindowsHookEx function
and specify WH_SHELL. This requires a callback function in a standard (i.e.
not ActiveX) DLL, which VB cannot create (well, it can with 3rd-party tools,
but VB's not designed to create such a DLL).

In one (maybe several) of the legal settlements MS made, they documented
many functions that were previously undocumented. Two of these functions
are RegisterShellHookWindow and DeregisterShellHookWindow. Here's a link to
the docs:

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/winui/winui/windowsuserinterface/windowing/hooks/hookreference/hookfunctions/registershellhookwindow.asp


With these, creating a shell hook in VB is relatively easy because you just
need to subclass your app's main form (so if you're already quite
comfortable with subclassing, this wouldn't be too difficult). To get the
message you need to respond to in your WindowProc function, you need to call
RegisterWindowMessage. Here's sample code for this:

-----BEGIN CODE
Public Function EnableShellHook(ByVal WinHandle As Long) As Boolean

'Setup the system-wide WH_SHELL hook

'This is the message that Shell32's ShellHookProc sends us whenever
'a shell hook occurs
msgShellHook = RegisterWindowMessage("SHELLHOOK")

'Register this form with Windows to receive the ShellHook message
If RegisterShellHookWindow(WinHandle) <> 0 Then
'Just a double-check since this is critical
If Err.LastDllError = 0 Then
EnableShellHook = True
Else
EnableShellHook = False
End If
End If


End Function
-----END CODE

Now, in your WindowProc function, you'll have something like this:

-----BEGIN CODE
Private Function WndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal
wParam As Long, ByVal lParam As Long) As Long

Dim sModuleName As String

Select Case uMsg
Case msgShellHook
WndProc = CallWindowProc(lpfnDefWndProc, hwnd, uMsg, wParam,
lParam)

Select Case wParam
Case HSHELL_WINDOWCREATED
sModuleName =
StripExtension(GetModuleNameFromHandle(lParam))
If Len(sModuleName) Then
If LCase$(sModuleName) <> "vb6" Then
Debug.Print sModuleName
End If
Else
Debug.Print "Empty"
End If

frmMain.WindowCreated lParam
Case HSHELL_WINDOWDESTROYED
sModuleName =
StripExtension(GetModuleNameFromHandle(lParam))
If Len(sModuleName) Then
If LCase$(sModuleName) <> "vb6" Then
Debug.Print sModuleName
End If
Else
Debug.Print "Empty"
End If

frmMain.WindowDestroyed lParam
End Select
Case Else
WndProc = CallWindowProc(lpfnDefWndProc, hwnd, uMsg, wParam,
lParam)
End Select

End Function

Public Function StripExtension(ByVal sFileName As String) As String

'Removes the extension from the passed filename. Long file names
'make this a bit more difficult because periods are valid characters
'within the file's name. You cannot just find the position of the
'first period and assume everything after that is the extension, as
'you could with DOS. You also cannot assume that the extension is
'the 3 rightmost characters because an extension does not HAVE to
'be 3 characters. Unlike under DOS, extensions can be of any
'length (and even in DOS, extensions could also be 1 or 2
'characters).

'The extension is those characters that follow the final period
'in the file's name. The procedure to do this is identical
'to that of removing the filename from a fully qualified path;
'we're just looking for periods instead of backslashes.

'P.S. Yes, VB6's InstrRev function makes this easier. However,
'this code keeps compatibility with earlier versions of VB.

Dim iExists As Integer
Dim iPosition As Integer
Dim sTemp As String

iExists = InStr(sFileName, ".")

If iExists = 0 Then
'If no dot, then file name has no extension
StripExtension = sFileName
Exit Function
End If

Do While iExists
iPosition = iExists
iExists = InStr(iPosition + 1, sFileName, ".")
Loop

If iPosition > 0 Then
sTemp = Left$(sFileName, iPosition - 1)
End If

StripExtension = sTemp

End Function
-----END CODE

Now, let's see if I can get all the declarations for the API functions,
structures, and constants for the above code. If I missed any, sorry. Post
back with whatever is missing and I'll provide it (or someone else surely
will).

Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type

Private Declare Function RegisterShellHookWindow Lib "user32" (ByVal hwnd As
Long) As Long
Private Declare Function DeregisterShellHookWindow Lib "user32" (ByVal hwnd
As Long) As Long
Private Declare Function RegisterWindowMessage Lib "user32" Alias
"RegisterWindowMessageA" (ByVal lpString As String) As Long

Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd
As Long, lpdwProcessId As Long) As Long
Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias
"CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long)
As Long
Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First"
(ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next"
(ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)

'Constants for ShellHook message
Private Const HSHELL_WINDOWCREATED As Long = 1
Private Const HSHELL_WINDOWDESTROYED As Long = 2
Private Const HSHELL_ACTIVATESHELLWINDOW As Long = 3
Private Const HSHELL_WINDOWACTIVATED As Long = 4
Private Const HSHELL_GETMINRECT As Long = 5
Private Const HSHELL_REDRAW As Long = 6
Private Const HSHELL_TASKMAN As Long = 7
Private Const HSHELL_LANGUAGE As Long = 8
Private Const HSHELL_SYSMENU As Long = 9
Private Const HSHELL_ENDTASK As Long = 10
Private Const HSHELL_ACCESSIBILITYSTATE As Long = 11
Private Const HSHELL_APPCOMMAND As Long = 12
Private Const HSHELL_WINDOWREPLACED As Long = 13
Private Const HSHELL_WINDOWREPLACING As Long = 14

Public Const MAX_PATH As Long = 260

I think that's all the API declarations.

I AM aware that I left out the code for the GetModuleNameFromHandle
function. That code was written by Kevin Provance and it would be
inappropriate for me to post it to a public newsgroup without Kevin's
consent. Maybe Kevin will read this and be willing to post the code himself
or tell me that I can go ahead and post it. Otherwise, I'm sure you can find
code on the net (either the web or newsgroups) on how to get a module name
from a window handle.

Now you ARE going to have some problems you'll need to deal with. For
example, you'll probably want to ignore child and maybe even popup windows
(windows that have either the WS_CHILD or WS_POPUP style). Also, Windows
Explorer creates many hidden windows that you'll probably want to ignore.
Just check the module name for any windows you want to ignore.

--
Mike
Microsoft MVP Visual Basic


.



Relevant Pages

  • Re: Detect Application Launch
    ... > 'Removes the extension from the passed filename. ... > Private Declare Function RegisterShellHookWindow Lib "user32" (ByVal hwnd ... you'll probably want to ignore child and maybe even popup windows ...
    (microsoft.public.vb.winapi)
  • Re: Detecting Windows Styles in VB6
    ... > computer is using Windows XP or Windows Classic Style, ... Private Declare Function DllGetVersion Lib "ComCtl32.dll" As Long ... Private Type DLLVersionInfo ...
    (microsoft.public.vb.general.discussion)
  • Re: Determining Win XP vs. Classic styles
    ... Private Enum Enum_OperatingSystem ... Private Declare Function IsThemeActive Lib "uxtheme.dll" As Long ... ' Return true if Windows is XP or above AND if visual style ...
    (microsoft.public.vb.winapi)
  • Re: Hooks
    ... Now I have set the hook I am getting those messages. ... Gary Chanson (Windows SDK MVP) ... Is that thread id is possible for these concept (all child windows ...
    (microsoft.public.win32.programmer.gdi)
  • Re: How to avoid that a key can be hold down
    ... MsgBox is displayed it must not work. ... because the entire code could have been in the hook. ... Private Sub Form_Unload ... Private Declare Function SetWindowsHookEx Lib "user32" _ ...
    (comp.lang.basic.visual.misc)