autoie03.pl to HTML.

index -|- end

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( "&bullet;" );
}
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

index -|- top

checked by tidy  Valid HTML 4.01 Transitional