Generated: Tue Feb 2 17:54:22 2010 from autoie03.pl 2006/06/14 12 KB.
#!/Perl # FROM : http://www.roth.net/perl/scripts/scripts.asp?IEEvents.pl ########################################################################## # # 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. # # Added output to LOG file, and increased the message output, # so a quiet review can be done, after the page has been CLOSED! # geoff mclane - mailto: geoffair _at_ hotmail _dot_ com - 2006-06-14 ########################################################################## use vars qw( $VERSION ); use Win32::OLE qw( EVENTS in with valof ); use Win32::OLE::Variant; use FileHandle; Win32::OLE->Option( Warn => 0 ); $VERSION = 20000516; $HomePage = "http://www.roth.net/"; ##$HomePage = "http://geoffmclane.com/"; ##$HomePage = 'http://www.friendofflowers.com/'; ##$HomePage = 'http://macpcfirstaid.com/'; @BLOCKED_URLS = qw( doubleclick.net ); %CLASS = ( events => 'DWebBrowserEvents2', events2 => 'IShellWindows', ie => 'InternetExplorer.Application', ); # LOG FILE STUFF my $write_log = 0; my $outfile = "$0.txt"; my $LOG = new FileHandle ">$outfile"; ##if ( open( $LOG, ">$outfile" ) ) { if ($LOG) { $write_log = 1; select $LOG; } else { $write_log = 0; prt( "WARNING: Unable to open $outfile LOG ...\n" ); } prt("Finding active IE object ...\n"); $IE = Win32::OLE->GetActiveObject( $CLASS{ie} ); if( ! defined $IE ) { prt( "Can not find open $CLASS{ie} object. Creating one...\n" ); $IE = Win32::OLE->new( $CLASS{ie}, "Quit" ) || mydie( "HEY Dude, can't do it!?!?\n" ); } else { prt( "Using existing $CLASS{ie} object ...\n" ); } prt("\nEstablishing an event callback ...\n"); #Win32::OLE->WithEvents( $IE, \&EventRoutine ); #, $CLASS{events2} ); Win32::OLE->WithEvents( $IE, \&EventRoutine, $CLASS{events} ); prt("\nSetting VISIBLE ...\n"); $IE->{Visible} = 1; prt("\nSetting RegisterAsDropTarget ...\n"); $IE->{RegisterAsDropTarget} = 1; prt("\nSetting RegisterAsBrowser ...\n"); $IE->{RegisterAsBrowser} = 1; prt("\nNavigating to [$HomePage] ...\n"); $IE->Navigate( $HomePage ); prt("\nSpinning, while Busy ...\n"); while( $IE->{Busy} ) { Spin( $IE ); } prt("\nOne more spin ...\n"); Spin( $IE ); prt("\nGetting MyDoc ...\n"); $MyDoc = $IE->{Document}; prt("\nEntering FOREVER loop ... exit is when browser quits ...\n"); $sCount = 0; while( 1 ) { $sCount++; #if( 1000 < $iCount++ ) if( $sCount > 1000 ) { #$iCount = 0; $sCount = 0; sleep( 1 ); } if( "Win32::OLE" eq ref $MyDoc ) { Spin( $MyDoc ); } Spin( $IE ); } prt( "Finished.\n" ); sub Spin { my( $Object ) = @_; while( $Object->SpinMessageLoop() ) { # process all messages ... } } sub PrintUrl { local( $U ) = @_; $~ = HrefFormat; write; #prt( "PrintUrl: $U \n" ); } sub PrintDocUrl { local( $U ) = @_; $~ = DocHrefFormat; write; #prt( "PrintDocUrl: $U \n" ); } sub DocEvents { my( $Obj, $Event, @Args ) = @_; prt( "******\nDocument event: $Event\n*******\n" ); return; } sub EventRoutine { my( $Obj, $Event, @Args ) = @_; $iEventCount++; prt("Event $iEventCount: $Event\n"); DumpValues( @Args ); local( $EventDesc ) = $Event; $~ = EventFormat; if( "DownloadBegin" eq $Event ) { write; # if ($write_log) { write $LOG; } my( $Doc ) = $Obj->{Document}; my( $Url ) = $Doc->{Url}; my( $ImageList ) = $Doc->{images}; CleanImages( $Doc, $Url ); } 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 ); } prt( "\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, $Url ); 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; } } prt( "\n" ); } elsif( "OnQuit" eq $Event ) { write; prt( "\nTerminating!\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 ); prt( "\n" ); } elsif( "NavigateComplete2" eq $Event ) { my( $HtmlDoc ) = $Args[0]->{Document}; prt( "Arg 0: " . Win32::OLE->QueryObjectType( $Args[0] ) . "\n" ); prt( "Document: " . Win32::OLE->QueryObjectType( $HtmlDoc ) . "\n" ); write; PrintUrl( $Args[1]->Value() ); my $iCount = 0; prt( "Cookie:\n" ); $Cookie = $HtmlDoc->{Cookie}; $~ = "CookieFormat"; write; prt( "Graphics:\n" ); foreach my $Img ( in( $HtmlDoc->{images} ) ) { $iCount++; prt( "$iCount ) [" . $Img->{src} . "] " ); prt( "ObjectType [" . Win32::OLE->QueryObjectType( $Img ) . "]\n" ); # Here you can swap out this graphic image using sytnax like: # $Img->{src} = "c:\\images\\No-Ads-Allowed.gif"; # or CLEAR the image with # $Img->{src} = ""; } if ($iCount == 0) { prt("No images ...\n"); } } #else #{ # ### aready done at top ... # ###DumpValues( @Args ); #} return; } sub DumpValues { my( @Args ) = @_; prt("Dump values ...\n"); if( scalar @Args ) { my $iCount = 0; foreach my $Arg ( @Args ) { $iCount++; prt( " Argument $iCount) " ); if( "Win32::OLE" eq ref $Arg ) { prt( "< " . Win32::OLE->QueryObjectType( $Arg ) . " >" ); } elsif( "Win32::OLE::Variant" eq ref $Arg ) { prt( "< Variant > ( " . $Arg->Value() . " )" ); } else { prt( "'$Arg'" ); } prt( "\n" ); } } else { prt("No ARGS count ...\n"); } prt( "Dump values done ...\n" ); } sub WarningBeep { prt( "•" ); } sub CleanImages { my( $Doc, $Url ) = @_; my( $ImageList ) = $Doc->{images}; my $iCount = 0; my $type = ref $ImageList; prt( "CleanImages: type = [$type] ...\n" ); #return unless( "Win32::OLE" eq ref $ImageList ); if ($type eq "Win32::OLE") { prt( " Url: '$Url'\n" ); foreach my $Image ( in( $ImageList ) ) { $iCount++; prt( "$iCount ) " . $Image->{src} . "\n" ); ### $Image->{src} = ""; # if you want to NOT display the image } if ($iCount == 0) { prt("No images in image list???\n"); } else { prt("Cleared $iCount images ...\n"); } } } ################################ ### output and log file sub wlog { my $ml = shift; print $LOG $ml; } sub prt { my $m = shift; if ($write_log) { wlog($m); } print STDOUT $m; } sub mydie { my $msg = shift; if ($write_log) { wlog($msg); } die $msg; } sub close_log { if ($write_log) { prt( "Closing LOG file, and passing to 'system($outfile)'\nMay need to CLOSE notepad to continue ...\n" ); close( $LOG ); system( $outfile ); } } 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 ~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< $Url ~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< $Url ~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< $Url . format DocHrefFormat = Page: ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< $Url ~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< $Url ~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< $Url ~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< $Url ~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< $Url . format EventFormat = EVENT: @<<<<<<<<<<<<<<<<<<<<<<<<<<<<< $EventDesc . # eof - autoie03.pl