Search code examples
perlwinapiscreenshot

Capturing screen failed when the active window has an error message box


I'm writing a software testing framework using perl on Windows platform, which run test cases by calling the software under test. If a test case fails, the framework will capture the screen so we could get more information about the failure.

At first I used an small program called boxcutter-fs.exe. So all I need is to call this program when test case fails:

system("boxcutter-fs.exe screenshot.png");
print "Failed: $?" if ($?);

When the framework handles a normal failure, it works great and give me the right failure screenshot. But I noticed that when the software crashed (an error message box would occur on the active window, and the software under test will be killed after a timeout), boxcutter-fs.exe exited with code 1, and didn't get any screenshot.


Then I turned to other solutions. The first alternative that I tried is Win32::GuiTest:

eval {
    SendKeys('{PRTSCR}');
    my $screen = Win32::Clipboard::GetBitmap() or die "No image captured: $!\n";
    open    BITMAP, "> screenshot.bmp" or die "Couldn't open bitmap file: $!\n";
    binmode BITMAP;
    print   BITMAP $screen;
    close   BITMAP;
};
print "$@" if ($@);

The same result. This works well unless the software crash case occurred. The program reported No image captured so I think Win32::Clipboard::GetBitmap didn't get any thing in the Clipboard.


The last solution is Imager::Screenshot:

eval {
    my $img = screenshot(hwnd => 'active');
    $img->write(file => 'screenshot.bmp', type => 'bmp' ) 
          or die "Failed: ", $img->{ERRSTR} , "\n";
};
print "$@" if ($@);

This time it gave a black screen screenshot (an all-black image) when the software crash case occurs. Still doesn't work.

Then I found that when the crash and error message box occurs, but the software hasn't been killed so the test framework is still hanging, using a small script with any of the solutions above could capture the screenshot. It seems they just fail at the moment when the software under test is being killed.

Since these 3 methods all use Win32 API to get the screenshot, I wonder they might fail due to the same issue? Any hints?


Solution

  • I studied the source code of Imager::Screenshot, and found the possible cause for the screenshot failure.

    First of all, if I use -d option of perl to debug the screenshot script, when the software under test crashed and was killed after a timeout, the screenshot worked. So I suppose the screenshot failure should be a corner case in a specific situation.

    Then I read the source code of Imager::Screenshot. Basically, it's a perl module calling XS extensions written with Win32 APIs. The processing flow is basically as following:

    1. Use GetDC according to the window handler hwnd to get display device context dc
    2. Use CreateCompatibleDC to get the device context handler hdc
    3. Use GetDIBits to retrieve the bits of the device context, and write them to the bmp file

    My problem is that when the software under test crashed and was killed, the hwnd of its window would be invalid at once, but it was still passed to GetDC to get the display device context, thus the result was invalid too (the bmp file was memset to all 0 at the beginning, so it's a black screenshot)


    Now that I noticed the root cause was the invalid hwnd, I come up with a work around: take the screenshot before killing the software under test. I used Proc::Background and Win32::GuiTest. The key point is to ensure the software GUI is set as foreground window:

    sub captureWindow {
        my ($pid, $screenshot_name) = @_;
        for my $hwnd (&findHwnd($pid)) {
            if (Win32::GuiTest::SetActiveWindow($hwnd) && Win32::GuiTest::SetForegroundWindow($hwnd)) {
                system("boxcutter-fs.exe $screenshot_name");
                # send ALT+TAB key so the script was set back to foreground window
                Win32::GuiTest::SendKeys("%{TAB}");
                last;
            }
        }
    }
    
    sub findHwnd {
        my ($target_pid) = @_;
        my @target_hwnd;
    
        EnumWindows(
            Win32::API::Callback->new(sub {
                my ($hwnd, $target_pid) = @_;
    
                my $pid = 0xffffffff;
                my $tid = GetWindowThreadProcessId($hwnd, $pid);
    
                $pid = unpack 'L', $pid;
    
                if ($target_pid == $pid) {
                    push @target_hwnd, $hwnd;
                }
                return 1;
            }, 'NN', 'I'),
            $target_pid,
        );
    
        return @target_hwnd;
    }
    
    sub monitorTestProcess {
        my ($cmd, $timeout) = @_;
        my $rs;
    
        my $proc = Proc::Background->new($cmd);
        my $pid = $proc->pid;
    
        select(undef, undef, undef, 0.5);
        &captureWindow($pid, "screenshot_begin.png");
    
        my $timeCount = 0;
        while ($proc->alive) {
            if ($timeCount >= $timeout) {
                &captureWindow($pid, "screenshot_timeout.png");
                $proc->die;
                last;
            }
            select(undef, undef, undef, 1);
            $timeCount++;
        }
    
        return $rs;
    }