Wednesday, June 27, 2012

Using Win32::OLE with events to capture Internet Explorer screenshots with Perl

Another post inspired by a Stackoverflow question.

The OP wanted to know how to capture a screen shot of a specific Internet Explorer window using Perl's Imager::Screenshot which is a very useful module I did not know about until I came across this question.

I give three methods in my answer. The first one uses Win32::GuiTest to find all sorts of browser windows and take shots of all of them. The second one uses Win32::OLE to create an InternetExplorer.Application instance to navigate to a specific URL and uses a busy loop to wait for the document to be loaded.

The third one utilizes events so as to avoid busy loops. It's a little tricky because it seems like if the document contains dynamically loaded elements, the first DocumentComplete event may be fired even if there are still elements to be loaded.

The following script demonstrates the use of event support with Win32::OLE:

#!/usr/bin/env perl

use strict; use warnings;
use feature 'say';

use Const::Fast;
use Imager;
use Imager::Screenshot qw( screenshot );
use Win32::GuiTest qw( SetForegroundWindow );
use Win32::OLE qw(EVENTS valof);
$Win32::OLE::Warn = 3;

const my $TYPE => 'bmp';
const my $READYSTATE_COMPLETE => 4;

my ($URL) = @ARGV;
die "Need URL\n" unless defined $URL;

my $browser = Win32::OLE->new(
    "InternetExplorer.Application", sub { $_[0]->Quit }
);
Win32::OLE->WithEvents($browser, \&Event, 'DWebBrowserEvents2');

$browser->{Visible} = 1;
$browser->Navigate2($URL);

Win32::OLE->MessageLoop;

Win32::OLE->SpinMessageLoop;

$browser->Quit;

sleep 3;

sub Event {
    my ($browser, $event, @argv) = @_;

    if ($event eq 'DocumentComplete') {
        sleep 1;
        $browser->{ReadyState} == $READYSTATE_COMPLETE
            or return;

        my $hwnd = $browser->{HWND};
        SetForegroundWindow $hwnd;

        my $img = screenshot(hwnd => $hwnd, decor => 1)
            or die Imager->errstr;

        my $url = valof( $argv[1] );

        $url =~ s{^https?://}{};
        $url =~ s{[^A-Za-z0-9_-]}{-}g;

        $img->write(file => "$url.$TYPE", type => $TYPE)
            or die $img->errstr;

        Win32::OLE->QuitMessageLoop;
    }
    elsif ($event eq 'StatusTextChange') {
        say $browser->{StatusText};
    }
    else {
        say $event;
    }

    return;
}

We first create an instance of InternetExplorer.Application, make it visible so we can receive DocumentComplete events and enter the message loop.

In the event handler, every time we receive a DocumentComplete event, we sleep a little, and check if the ReadyState property indicates it's safe to take a screenshot.

If so, we query the $browser object to find its window handle, bring that window to the foreground using Win32::GuiTest::SetForegroundWindow, and take the screenshot.

This is still not infallible as it is possible for something else to pop up and partially obscure the window between the SetForegroundWindow call and the screenshot being taken, but I am not sure what can be done with that.

Once the screenshot is taken, we quit the message loop. Win32::OLE documentation recommends invoking SpinMessageLoop and waiting a few seconds, so that explains the funky sleep at the end. Through trial and error, I found it gave more reliable results to invoke $browser->Quit after the SpinMessageLoop but before the sleep.

I tested the code on Windows XP SP3 with IE 8 using ActivePerl 5.14.2. Please let me know if it works properly on Vista and Windows 7 systems as well.

3 comments:

  1. I had to go with this approach [http://www.perlmonks.org/?node_id=822495] as I cannot get Imager::Screenshot working. Did you have to do anything special to get it working?

    I'm getting this error "Imager API version incorrect loaded 5 vs expected 4 at C:/Perl/site/lib/Imager/Screenshot.pm", which some people have said is due to libjpeg being old. I'm not even sure how one would go about updating/fixing that. I went so far as to install [https://metacpan.org/module/Prima::codecs::win64] in the hopes that it would magically fix the mismatch, but didn't have any luck.

    I know you're not looking for QA here, but if you had any struggles getting I::S working, I'd be curious what you did to fix it. I've tried wtih Active Perl v5.10.1 and Citrus v5.16.1 on Win7.

    ReplyDelete
    Replies
    1. I don't remember having any such issues. Have you tried reinstalling Imager?

      I'll try it out on a Win7-64 system when I get a chance.

      Delete