Vlákno názorů k článku Nová softwarová sklizeň (15. 8. 2007) od turzin - #!/usr/bin/perl -w use strict; my %options=(); ...

#!/usr/bin/perl -w
use strict;

my %options=();
$options{host}='xxxxxxxxx';
$options{user}='xxxxxxxxx';
$options{pwd}='xxxxxxxx';
$options{rdir}='data/screenshot';
$options{sleep}='10'; # sleep time in seconds

# image magick convert.exe path http://www.imagemagick.org
$options{impath}='c:\imagick\convert.exe';
$options{crop}='1200x880+53+96'; # image crop
$options{resize}='600x440'; # image resize
$options{gamma}='0.4'; # gamma correction ( image is too light after resize )
$options{colors}='16'; # image color reduction

$options{html}='index.htm'; # html file name


my $IMAGE_NAME=''; # global variable with file name changing file name every run to avoid problems with browser caching
my $start_time=time();
my $last_image=''; # name of the last image that has been put to the server in previous run, will be used for delete command

sub generate_html()
{
my $html_code='
---- cutted by www.root.cz ------
';
open (HTML, ">$options{html}");
print HTML $html_code;
close (HTML);
}

sub sleeping()
{
system ( 'del', '*.bmp');
# system ( 'del', '*.gif');
# system ( 'del', $IMAGE_NAME );
system ( 'del', $options{html} );
my $runtime=time()-$start_time;
print "script runtime : $runtime \n";
my $sleep_for=$options{sleep}-$runtime;
print '----*----*----*----*----*----*----*----*'."\n";
my $sec=0;
while ($sec<$sleep_for) { print '##'; sleep (1); $sec ++; } "\n"; $start_time=time(); sub save_screenshot() use win32::ole; win32::api; win32::clipboard; "saving screenshot\n"; my $key win32::api("user32", "keybd_event", 'iinp', 'v'); die "can't import user32.dll: $!\n" if(not defined $key); $clip "empty the clipboard\n"; $clip->Empty();

print "simulate printscreen key press\n";
$key->Call(0x2C, 0x45, 0x01, 0); # simulate a "printscrn" key press
$key->Call(0x2C, 0x45, 0x03, 0); # & release

print "wait for the image to fill the clipboard\n";
# $clip->WaitForChange();
sleep (1);

my $screenshot = $clip->GetBitmap();

open (BITMAP, ">shot.bmp");
binmode BITMAP;
print BITMAP $screenshot;
close(BITMAP);

$IMAGE_NAME=time().'.gif';

print "GIF processing\n";
system ( $options{impath}, 'shot.bmp',
'-crop', $options{crop},
'-resize', $options{resize},
'-gamma', $options{gamma},
'-colors', $options{colors},
$IMAGE_NAME );

print "Cleaning Memory\n";
undef $clip, $key;
}



print "First run 5 seconds delay.\n";
sleep (5);

use Net::FTP;

my $ftp = Net::FTP->new($options{host}, Passive => 1 ) || die("Error: $@\n");
print "Attempting to connect to $options{host}...\n";
$ftp->login($options{user},$options{pwd}) and print "Login Successful\n";
$ftp->ascii and print "Set type to ASCII\n";
$ftp->cwd($options{rdir}) and print "Changed remote dir to $options{rdir}\n";

while ('jelito' ne 'kopyto')
{
&save_screenshot;
&generate_html;

print "Attempting to delete *.gif...\n";
if ($last_image) {$ftp->delete($last_image) or print ">>> DELETE FAILED !!! \n"; }
print "Attempting to upload ...\n";
$ftp->binary;
print "binary mode, uploading image ...\n";
$ftp->put($IMAGE_NAME, $IMAGE_NAME) or print ">>> UPLOAD FAILED !!! \n";
print "uploading html ...\n";
$ftp->put($options{html}, $options{html}) or print ">>> UPLOAD FAILED !!! \n";
# $ftp->ascii;
# $ftp->quit and print("Logged off\n");
print "FTP Finished\n";
$last_image=$IMAGE_NAME;

&sleeping;
}

Boutros klidek