[Perl]循环捕获windows [prt sc] 键的截图

523066680

刚刚试了一下，没有做文件名冲突判断（Snap1.bmp Snap2.bmp Snap3.bmp....），再执行一次的时候会将上次的截图覆盖。
有闲情了再改吧。

1. 
   
2. =info
   
3.     Via 523066680 @ bathome.net
   
4.     2015-03
   
5. =cut
   
6. 
   
7. use Win32::Clipboard;
   
8. use Term::ReadKey;
   
9. use Time::HiRes qw/sleep/;
   
10. use IO::Handle;
    
11. STDOUT->autoflush(1);
    
12. 
    
13. my $Fold = "D:\\Snap";
    
14. my $i = 0;
    
15. my $clip = Win32::Clipboard->new();
    
16. $clip->Empty();
    
17. mkdir $Fold unless (-e $defult);
    
18. 
    
19. my $timesec = &timesec();
    
20. 
    
21. while (1) {
    
22.     $image = $clip->GetBitmap();
    
23.     if ($image) {
    
24.         $i++;
    
25.         print "Catch one!\n";
    
26.         &savepic("$timesec $i.bmp", \$image);
    
27.         $clip->Empty();
    
28.     }
    
29.     &keyout();
    
30.     sleep 0.2;
    
31.     print ".";
    
32. }
    
33. 
    
34. sub savepic {
    
35.     my ($name, $rdata) = (shift, shift);
    
36.     open    BITMAP, ">$Fold\\$name";
    
37.     binmode BITMAP;
    
38.     print   BITMAP ${$rdata};
    
39.     close   BITMAP;
    
40. }
    
41. 
    
42. sub keyout {
    
43.     my $key;
    
44.     $key = ReadKey(-1);
    
45.     if ( ord($key) == 27 ) {
    
46.         print "Quit";
    
47.         sleep 1.0;
    
48.         exit;
    
49.     }
    
50. }
    
51. 
    
52. sub timesec {
    
53.     my ($sec,$min,$hour,$day,$mon,$year) = localtime();
    
54.     return
    
55.         sprintf (
    
56.             "%02d-%02d %02d.%02d.%02d",
    
57.             $mon, $day, $hour, $min, $sec
    
58.         );
    
59. }
    

复制代码

按Prt Screen键截图，自动保存到D盘snap文件夹。
按Esc 键退出。

执行输出类似这样：
──────────┐
.......Catch one!   │
....Catch one!      │
..........Catch one!│
....Catch one!      │
.......Quit         │
──────────┘

命名格式为  月-日 时.分.秒 序号.bmp

CrLf

万一不是截图的呢？

CrLf

人家只是在 qq 里复制了一张图，就被你个禽兽拦截了