Revised script for taking Internet Explorer screenshots using Perl and Win32::OLE

ie10screenshot.pl

#!/usr/bin/env perl

use 5.020; # hey, why not?
use warnings;
use Const::Fast;

use Win32::GuiTest qw(
    GetForegroundWindow
    SetForegroundWindow
    GetScreenRes
);

use Win32::OLE qw(EVENTS valof);
use Win32::MessageLoop;
$Win32::OLE::Warn = 3;

run(@ARGV);

sub run {
    my $url = shift;
    $url or die "Need URL\n";

    navigate($url, \&WebBrowserEventHandler);

    return;
}

sub navigate {
    my $url = shift;
    my $handler = shift;

    my $do_take_screenshot;

    const my %BrowserEvents => (
        DocumentComplete => sub {
            $do_take_screenshot = 1;
            Win32::MessageLoop->QuitMessageLoop;
        },
        OnQuit => sub {
            $do_take_screenshot = 0;
            Win32::MessageLoop->QuitMessageLoop;
        },
        _ => sub { },
    );

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

    Win32::OLE->WithEvents(
        $browser,
        sub { $handler->(\%BrowserEvents, @_) },
        'DWebBrowserEvents2'
    );

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

    Win32::MessageLoop->MessageLoop;

    if ($do_take_screenshot) {
        take_screenshot($browser);
    }

    $browser->Quit;

    return;
}

sub WebBrowserEventHandler {
    my $handlers = shift;
    my $browser = shift;
    my $event = shift;

    log_browser_event($event, @_);

    my $handler = exists $handlers->{$event}
                ? $handlers->{$event}
                : $handlers->{_}
    ;
    $handler->($browser, $event, @_);
    return;
}

sub take_screenshot {
    my $browser = shift;

    wait_until_ready($browser);

    my $hwnd = $browser->{HWND};
    my $title = $browser->{Document}{title};
    $title =~ s/[^A-Za-z0-9_-]+/-/g;

    my $ds = Win32::GuiTest::DibSect->new;

    my $fgwnd = GetForegroundWindow();
    SetForegroundWindow $hwnd;
    $ds->CopyWindow($hwnd);
    SetForegroundWindow $fgwnd;

    $ds->SaveAs("$title.bmp");
    $ds->Destroy;

    return;
}

sub position_browser {
    my $browser = shift;
    my $doc = $browser->{Document};
    my $body = $doc->{body};

    my ($x, $y) = GetScreenRes();
    # This will include taskbar(s).
    # I am too lazy to do it correctly.
    # http://stackoverflow.com/a/9826269/100754
    $browser->{Left} = 0;
    $browser->{Top} = 0;
    $browser->{Width} = $x;
    $browser->{Height} = $y - 32;
    return;
}

sub wait_until_ready {
    my $browser = shift;
    {
        local $| = 1;
        while ($browser->Busy) {
            print '.';
            sleep 1;
        }
    }
    return;
}

sub log_browser_event {
    my $event = shift;
    no warnings 'uninitialized';
    my $args = eval { join(' ' => map valof($_), @_) };
    say "$event: $args";
    return;
}