##########################################################################
#
# IEEvents.pl
# Internet Explorer event trapping script
#
# Copyright © 2000-2001 by Dave Roth
# Courtesy of Roth Consulting
# http://www.roth.net/
#
# This file may be copied or modified only under the terms of either
# the Artistic License or the GNU General Public License, which may
# be found in the Perl 5.0 source kit.
#
# 2000.05.16
#
# Demonstration of COM events in Win32 Perl.
# This script kicks up an Internet Explorer window
# and connects to a web site. The script displays any
# cookie that is associated with the downloaded page.
#
##########################################################################
use vars qw( $VERSION );
use Win32::OLE qw( EVENTS in with valof );
use Win32::OLE::Variant;
Win32::OLE->Option( Warn => 0 );
$VERSION = 20000516;
$HomePage = "http://www.roth.net/";
@BLOCKED_URLS = qw(
doubleclick.net
);
%CLASS = (
events => 'DWebBrowserEvents2',
events2 => 'IShellWindows',
ie => 'InternetExplorer.Application',
);
$IE = Win32::OLE->GetActiveObject( $CLASS{ie} );
if( ! defined $IE )
{
print "Can not find open $CLASS{ie} object. Creating one...\n";
$IE = Win32::OLE->new( $CLASS{ie}, "Quit" ) || die "Dude, can't do it!";
}
#Win32::OLE->WithEvents( $IE, \&EventRoutine ); #, $CLASS{events2} );
Win32::OLE->WithEvents( $IE, \&EventRoutine, $CLASS{events} );
$IE->{Visible} = 1;
$IE->{RegisterAsDropTarget} = 1;
$IE->{RegisterAsBrowser} = 1;
$IE->Navigate( $HomePage );
while( $IE->{Busy} )
{
Spin( $IE );
}
Spin( $IE );
$Doc = $IE->{Document};
while( 1 )
{
if( 1000 < $iCount++ )
{
$iCount = 0;
sleep( 1 );
}
if( "Win32::OLE" eq ref $MyDoc )
{
Spin( $MyDoc );
}
Spin( $IE );
}
print "Finished.\n";
sub Spin
{
my( $Object ) = @_;
while( $Object->SpinMessageLoop() )
{
}
}
sub PrintUrl
{
local( $Url ) = @_;
$~ = HrefFormat;
write;
}
sub PrintDocUrl
{
local( $Url ) = @_;
$~ = DocHrefFormat;
write;
}
sub DocEvents
{
my( $Obj, $Event, @Args ) = @_;
print "******\nDocument event: $Event\n*******\n";
return;
}
sub EventRoutine
{
my( $Obj, $Event, @Args ) = @_;
$iEventCount++;
local( $EventDesc ) = $Event;
$~ = EventFormat;
if( "DownloadBegin" eq $Event )
{
write;
my( $Doc ) = $Obj->{Document};
my( $Url ) = $Doc->{Url};
my( $ImageList ) = $Doc->{images};
CleanImages( $Doc );
}
elsif( "DocumentComplete" eq $Event )
{
my( $Url ) = $Args[1]->Value();
# ONLY display info if $Url is not "". Otherwise the document
# download may have been canceled so there is nothing to display.
if( ( "" ne $Url ) && ( "" ne $Obj->{Document}->{Cookie} ) )
{
my @Values = split( /;\s*/ , $Obj->{Document}->{Cookie} );
local $Cookie;
write;
# Print URL
PrintUrl( $Url );
$~ = CookieFormat;
map
{
( $Cookie = $_ ) =~ s/%(\w\w)/pack( "c", hex( $1 ) )/gei;
write;
} ( @Values );
}
print "\n";
}
elsif( "BeforeNavigate2" eq $Event )
{
# We are about to download a page. Check to see if it is
# allowed...
local( $Url, $Message );
$Url = lc $Args[1]->Value();
my( $Doc ) = $Args[0]->{Document};
write;
CleanImages( $Doc );
PrintUrl( $Url );
foreach my $BlockedUrl ( @BLOCKED_URLS )
{
if( $Url =~ m@$BlockedUrl@i )
{
# Oops we have a blocked url so let's go and
# cancel this request!
$Message = "This URL is blocked. Cancelling the request!";
$~ = WarningFormat;
write;
WarningBeep();
$Args[6]->Put( 1 );
last;
}
}
print "\n";
}
elsif( "OnQuit" eq $Event )
{
write;
print "Terminating!\n";
undef $Obj;
exit( 1 );
}
elsif( "NewWindow2" eq $Event )
{
local( $Message ) = $Message = "A new browser window is requested. Cancelling the request!";
write;
PrintUrl( $Args[1]->Value() );
$~ = WarningFormat;
write;
# Don't allow any new child windows
$Args[1]->Put( 1 );
print "\n";
}
elsif( "NavigateComplete2" eq $Event )
{
my( $HtmlDoc ) = $Args[0]->{Document};
print "Arg 0: " . Win32::OLE->QueryObjectType( $Args[0] ) . "\n";
print "Document: " . Win32::OLE->QueryObjectType( $HtmlDoc ) . "\n";
write;
PrintUrl( $Args[1]->Value() );
my $iCount = 1;
print "Cookie:\n";
$Cookie = $HtmlDoc->{Cookie};
$~ = "CookieFormat";
write;
print "Graphics:\n";
foreach my $Img ( in( $HtmlDoc->{images} ) )
{
print $iCount++, ") $Img->{src}\n";
print "" . Win32::OLE->QueryObjectType( $Img ) . ": ";
# Here you can swap out this graphic image using sytnax like:
# $Img->{src} = "c:\\images\\No-Ads-Allowed.gif";
$Img->{src} = "";
}
}
else
{
# DumpValues( @Args );
}
return;
}
sub DumpValues
{
my( @Args ) = @_;
if( scalar @Args )
{
my $iCount = 0;
foreach my $Arg ( @Args )
{
$iCount++;
print " Argument $iCount) ";
if( "Win32::OLE" eq ref $Arg )
{
print "< " . Win32::OLE->QueryObjectType( $Arg ) . " >";
}
elsif( "Win32::OLE::Variant" eq ref $Arg )
{
print "< Variant > ( " . $Arg->Value() . " )";
}
else
{
print "'$Arg'";
}
print "\n";
}
}
print "\n";
}
sub WarningBeep
{
print "•";
}
sub CleanImages
{
my( $Doc ) = @_;
my( $ImageList ) = $Doc->{images};
my $iCount = 0;
return unless( "Win32::OLE" eq ref $ImageList );
print " Url: '$Url'\n";
foreach my $Image ( in( $ImageList ) )
{
print " ", ++$iCount, ") $Image->{src}\n";
$Image->{src} = "";
}
}
format CookieFormat =
COOKIE: ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Cookie
~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Cookie
~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Cookie
~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Cookie
~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Cookie
~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Cookie
~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Cookie
~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Cookie
~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Cookie
~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Cookie
~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Cookie
~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Cookie
~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Cookie
~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Cookie
.
format WarningFormat =
WARNING: @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Message
.
format HrefFormat =
Href: ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Url
~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Url
~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Url
~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Url
~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Url
.
format DocHrefFormat =
Page: ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Url
~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Url
~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Url
~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Url
~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Url
.
format EventFormat =
EVENT: @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$EventDesc
.