I want to get Windows to call a sub in my perl script when a new process starts, specifically a new IE process. Here's why:

I'm fiddling with Internet Explorer automation. I've managed to get pretty good at it. I figured out from googling and playing around with the DOM & IE Developer toolbar that I can have IE call my a subroutine for me when events happen, like so:

use Win32::OLE ;
use Win32::OLE qw(EVENTS);

my $shell = Win32::OLE->new('Shell.Application') or die "ERROR ", Win3
+2::OLE->LastError();

$windows = $shell->Windows;

$IE = Win32::OLE->new("InternetExplorer.Application") || die "Could no
+t start Internet Explorer.Application\n";

$IE->{visible} = 1;

$IE->Navigate('http://www.perlmonks.org');

Win32::OLE->WithEvents($IE,\&Event,"DWebBrowserEvents2");
Win32::OLE->MessageLoop();

$count = 1;
sub Event {

    my ($Obj,$Event,@Args) = @_;
    print "First Event # $count triggered: $Event\n";
    $count++;

    
}
[download]

What's cool is you can dig into the DOM and get an object ref to elements inside it, then you can do cool stuff like capture an event when a user clicks a button and auto fill forms when that happens.

Thanks to an anonymous monk's code here I can get all the IE windows running. Combining this, my event callbaks and DOM access and I can do pretty much anything in IE.

There's one catch, when my script runs it pulls all the open IE windows and I get events from them using withevents, but I can't do anything about new IE windows.

I'd like an event notification when an IE window starts up, e.g. I'd like Windows to call a sub in my perl script. I'm pretty sure WMI can do this, so I tried this:

use Win32::OLE qw(EVENTS);
use Win32::Console;

my $console = Win32::Console->new(STD_INPUT_HANDLE);

my $refWMI = Win32::OLE->GetObject('winMgmts:');
my $refSink = Win32::OLE->new ('WBemScripting.SWbemSink');

Win32::OLE->WithEvents($refSink,\&eventCallback);

my $strQuery = "SELECT * FROM __InstanceCreationEvent " . "WITHIN .1 W
+HERE TargetInstance ISA '\Win32_Process\' AND Name = 'iexplore.exe'";
$refWMI->ExecNotificationQueryAsync($refSink, $StrQuery);

Win32::OLE->MessageLoop();

$count = 1;    
sub eventCallback()
{ 

    my ($Obj,$Event,@Args) = @_;
    print "First Event # $count triggered: $Event\n";
    $count++;


}
[download]

But it's a no go. Has anyone done something like this? Minor Update, here's what I'm trying to do, but in VBScript instead of perl:

strComputer = "." 
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIM
+V2") 
Set MySink = WScript.CreateObject( _
    "WbemScripting.SWbemSink","SINK_")

objWMIservice.ExecNotificationQueryAsync MySink, _
    "SELECT * FROM __InstanceCreationEvent" & " WITHIN .1 WHERE Target
+Instance ISA 'Win32_Process'"


WScript.Echo "Waiting for events..."

While (True)
    Wscript.Sleep(1000)
Wend

Sub SINK_OnObjectReady(objObject, objAsyncContext)
    Wscript.Echo "__InstanceCreationEvent event has occurred."
End Sub

Sub SINK_OnCompleted(objObject, objAsyncContext)
    WScript.Echo "Event call complete."
End Sub
[download]

I'll see if I can move it to perl, but I've never been good at porting :(. Here's my 1st attempt, but it doesn't work:

use Win32::OLE qw(EVENTS);
use Win32::Console;
use Data::Dumper;

my $refWMI = Win32::OLE->GetObject('winMgmts:');
my $refSink = Win32::OLE->CreateObject('WbemScripting.SWbemSink', "SIN
+K_");

my $strQuery = "SELECT * FROM __InstanceCreationEvent" & " WITHIN .1 W
+HERE TargetInstance ISA 'Win32_Process'";
$refWMI->ExecNotificationQueryAsync($refSink, $strQuery);

while (true){

    sleep 1;
    print "Sleeping to keep the script alive...\n";
}

$count = 1;    

sub SINK_OnObjectReady{

    print "Ready\n";

}

sub SINK_OnCompleted{

    print "Done\n";
    
}
[download]

From the VBScript code it looks like there's some Microsoft Magic going on where VBScript picks up on the subroutines because they start with 'SINK_', but I don't know how (if) I can recreate that in Perl. Onward & upward, I found this, but I haven't had any luck adapting it. Here's the code:

----------------------------------------------------------------------
+--------------------------------------
use Win32;
use Thread::Use;
use threads;
use threads::shared;



my $thr2 = threads->new(\&ProcNotify,"ProcessId","2104",".","1");
my $thr = threads->new(\&ProcNotify,"ProcessId","3800","jjj","1");


while (1) {


Win32::Sleep(10);


}




sub ProcNotify
{
my ($KEY,$VAL,$HOST,$flag) = @_;


useit Win32::OLE qw(in EVENTS);


print "$KEY,$VAL,$HOST";


Win32::OLE->Option("Warn"=>3);



my $eo = myEvents->new(KEY => $KEY, VAL => $VAL, HOST => $HOST, WMI =>
+ $WMI, FLAG => $flag);

my $wbemsink = new Win32::OLE("WbemScripting.SWbemSink");


my $wbemloc = new Win32::OLE("WbemScripting.SWbemLocator");


my $wbemsvc = $wbemloc->ConnectServer("$HOST", "root/cimv2");


# Set impersonationlevel


$wbemsvc->{Security_}->{ImpersonationLevel} = 3;


Win32::OLE->WithEvents($wbemsink, "myEvents");


my $myQuery = "SELECT * FROM __InstanceModificationEvent WITHIN 5"


."WHERE TargetInstance ISA 'Win32_Process' and TargetInstance.$KEY = '
+$VAL'";


$wbemsvc->ExecNotificationQueryAsync($wbemsink, $myQuery);


while(1)
{
        Win32::Sleep(10);
        Win32::OLE->SpinMessageLoop();
}


}





package myEvents;



my $self;


sub new() {



    my $invocant = shift;
    my $class = ref($invocant) || $invocant;
    $self = {
        KEY => undef,
        VAL => undef,
        HOST => undef,
        WMI => undef,
        FLAG => undef,
        @_,
    };
    my $Machine = $self->{HOST};
     my $WMI;


     if($FLAG eq "1")
     {
        use Win32::OLE qw(in);
     }


$WMI = Win32::OLE->GetObject( "WinMgmts://$HOST" ) || do { print "WMI 
+is not installed or supported on this OS\r\n";};

    $self->{WMI} = $WMI;


    return bless $self, $class;


}



sub OnObjectReady {
#my ($self) = @_;


print "Hello From OnObjectReady!".$self->{KEY},$self->{VAL}."\n";
my $key = $self->{KEY};
my $value = $self->{VAL};
my $WMI = $self->{WMI};
my $Class = $WMI->ExecQuery("SELECT * FROM Win32_Process WHERE $key = 
+\"$value\"") || do { return "Cannot Perform Query"};
my $PRIORITY = "";
foreach my $struct(in $Class)
{
if($PRIORITY eq "LOW")
{
Win32::Sleep(5);
}
my @retvals;
my $structcount = 0;
foreach my $obj (in $struct->{Properties_})
{
if (ref($obj->{Value}) eq "ARRAY")
{

        if($PRIORITY eq "LOW")
        {                       
                Win32::Sleep(6);
        }
                foreach(in $obj->{Value})
                {
                        print $_,"\n";
                        #push(@retvals,$_);
                }


          } else
          {
        if($PRIORITY eq "LOW")
        {                       
                Win32::Sleep(6);
        }
                        #if (($obj->{Name} ne $ignore))
                        #{
                                my $val = $obj->{Value};
                                if( ($obj->{Value} eq "") || ($obj->{V
+alue} eq undef))
                                {
                                        $val = 'NULL';
                                }
                                print $obj->{Name},">",$val,"\n";
                                #push(@retvals,{ Name => $obj->{Name},
+ Value => $val});
                        #}
          }     
        }


 }


}


sub OnCompleted {


print "Hello From OnCompleted!";
#print TargetInstance->{State};
#Win32::MsgBox("Hello From OnCompleted!");


}


sub OnObjectPut {


print "Hello From OnObjectPut!";
#Win32::MsgBox("Hello From OnObjectPut!");


}


sub OnProgress {


print "Hello From OnProgress!";
#Win32::MsgBox("Hello From OnProgress!");


}


1;
[download]