$wmi -destroyat the end when you no longer need WMI.Also, the Tcl event loop must be running, either through Tk or through a vwait command.[Maiki] - 2011-05-06 09:08:40Assumes twapi 3.0 - will need to be modified for earlier versions
proc start_process_tracker {} {
# Get local WMI root provider
set ::wmi [twapi::_wmi]
# Create an WMI event sink
set ::event_sink [twapi::comobj wbemscripting.swbemsink]
# Attach our handler to it
set ::event_sink_id [$::event_sink -bind process_start_handler]
# Associate the sink with a query that polls every 1 sec for process
# starts.
$::wmi ExecNotificationQueryAsync [$::event_sink -interface] "select * from __InstanceCreationEvent within 1 where TargetInstance ISA 'Win32_Process'"
}
proc process_start_handler {wmi_event args} {
if {$wmi_event eq "OnObjectReady"} {
# First arg is a IDispatch interface of the event object
# Create a TWAPI COM object out of it
set ifc [lindex $args 0]
IUnknown_AddRef $ifc; # Must hold ref before creating comobj
set event_obj [twapi::comobj_idispatch $ifc]
# Get and print the Name property
puts "Process [$event_obj ProcessID] [$event_obj ProcessName] started at [clock format [large_system_time_to_secs [$event_obj TIME_CREATED]] -format {%x %X}]"
# Get rid of the event object
$event_obj -destroy
}
}Avoiding Hangs in Queries neb 2011-07-19 I've been using a set of wmi queries on a large number of machines. Occasionally, they will hang for no apparent reason. Everything works, connects, etc, but the query just never returns. This is an oft-asked-about issue, online; and Microsoft never saw fit to offer any way to cancel or timeout a query. You can, however, use an Asynchronous (as opposed to a 'Semisynchronous') query using close to the same process as above.The following code is a knock-off of this MSDN example: http://msdn.microsoft.com/en-us/library/aa392295%28v=vs.85%29.aspx
package require twapi
set ::bdone 0
set count 0
proc change_handler {wmi_event args} {
switch $wmi_event {
OnObjectReady {
# Create a TWAPI COM object out of the IDispatch interface (first arg)
set ifc [lindex $args 0]
::twapi::IUnknown_AddRef $ifc; # Must hold ref before creating comobj
set event_obj [twapi::comobj_idispatch $ifc]
puts "Name: [$event_obj Name]"
incr ::count
$event_obj destroy
}
OnCompleted {
set ::bdone 1
}
}
}
set eventsink [twapi::comobj wbemscripting.swbemsink]
set eventsink_id [$eventsink -bind change_handler]
set wmi [twapi::_wmi]
after 12 {if {!$::bdone} {set ::bdone 2}}
set wql {SELECT Name FROM Win32_Process}
$wmi ExecQueryAsync [$eventsink -interface] $wql
vwait bdone
$eventsink -unbind $eventsink_id
$eventsink -destroy
$wmi -destroy
after 3000
puts "$count objects"
if {$::bdone==2} {puts timedout}'after 12' corresponds to roughly how long it takes the machine I am on to return the first record. Adding one ms results in the rest of the list all burped out at once.A more annotated version follows. Note it also uses '$eventsink Cancel' for the timeout action, rather than relying on the variable. Canceling triggers the 'OnCompleted' event, with a result value of 0x80041032 (user cancel). It also seems to work faster: Cancel will interrupt the list in around 6ms on my machine, vs 12 for the version above.There should be a way to turn the objErrorObject parameter into a COM or SWbemLastError object (which would have a GetObjectText_ method), but I haven't worked it out.package require twapi
set ::bdone 0
set count 0
proc change_handler {wmi_event args} {
switch $wmi_event { # http://msdn.microsoft.com/en-us/library/gg196623%28v=VS.85%29.aspx
OnObjectReady { # objObject, objAsyncContext
# Create a TWAPI COM object out of the IDispatch interface (first arg)
set ifc [lindex $args 0]
::twapi::IUnknown_AddRef $ifc; # Must hold ref before creating comobj
set event_obj [twapi::comobj_idispatch $ifc]
puts "Name: [$event_obj Name]"
incr ::count
$event_obj -destroy
}
OnCompleted { # iHResult, objErrorObject, objAsyncContext
set ::bdone 1
if {[lindex $args 0]} {
puts "Completed with error of 0x[format %08X [lindex $args 0]] (0x80041032 = user cancel)"
}
}
OnProgress { # iUpperBound, iCurrent, strMessage, objWbemAsyncContext
# Needs the '128' in the ExecQueryAsync call (4th param). Not all queries supply progress info.
puts Progress
}
OnObjectPut { # objWbemObjectPath, objWbemAsyncContext
puts Put
}
default {
puts "Unhandled event: $wmi_event"
}
}
}
set eventsink [twapi::comobj wbemscripting.swbemsink]
set eventsink_id [$eventsink -bind change_handler]
set wmi [twapi::_wmi]
after 6 {$eventsink Cancel; puts "query timed out."}
set wql {SELECT Name FROM Win32_Process}
# params: eventsink, query string, must be 'WQL', 128 (0x80) = wbemFlagSendStatus
$wmi ExecQueryAsync [$eventsink -interface] $wql WQL 128
vwait bdone
puts "unmaking objects"
$eventsink -unbind $eventsink_id
$eventsink -destroy
$wmi -destroy
puts "Pausing to make sure everything is canceled."
after 3000
puts "$count objects"One thing I am worried about with these is that we set event_obj on each record returned, but I can't destroy it. Uncommenting the destroy line stops the query results at that point. In VBS examples online, they don't worry about destroying the objects--but they also don't have to create them. I'm not certain if the result of comobj_idispatch gets re-used, and then dies when it goes out of scope, or if it's creating a new object at every iteration (and how to delete it), and therefore these scripts have a memory leak.APN neb, I've modified your examples above to do an IUnknown_AddRef on the event object interface before converting it to a comobj. This is required in the general case. You can then call $event_obj destroy. and I believe you will not see the query results stop. Otherwise, yes, you will have a memory leak of comobj objects. Let me know if that does not work for you.IMHO, WMI is a completely unreliable piece of crap. I spent long hours debugging what I thought were problems in TWAPI's event handling when it turned out VB code and MS own SDK tools exhibited the same behaviours with hangs and timeouts. I don't know if the WMI implementations have improved in the last few years.neb: Thank you, APN. I had tried putting in an addref, but mucked it up somewhere. I've made the references you added explicit, so they run as-is on my machine.And no, WMI has not improved, in my experience. Aside from the intermittent and inexplicable hangs, I find it easy to corrupt the repository. Eg, we had a range of subnets that had originally been on Novell. When it was uninstalled, WMI corrupted on approximately 50% of the machines, requiring a stop/delete/restart type of refresh. It's not immediately obvious *why* things don't work, in that situation. WMI just sort of stops giving back results.
