用perl/Tk简单写了一个在线PC检测工具，一处故障求斧正。

mouse.rice

1. use strict;
   
2. use Tk;
   
3. use Tk::StrfClock;
   
4. use Sys::Hostname;
   
5. use Net::Ping;
   
6. use Socket;
   
7. 
   
8. use encoding("gbk");
   
9. 
   
10. my $subnet;
    
11. my $sub;
    
12. 
    
13. #定义主窗口
    
14. my $mw = MainWindow->new;
    
15. $mw->geometry("300x420");
    
16. $mw->title("随便写点啥");
    
17. 
    
18. #定义按钮及菜单
    
19. my $main_menu = $mw->Menu();
    
20. $mw->configure(-menu => $main_menu);
    
21. 
    
22. my $main_frame = $mw->Frame()
    
23.                     ->pack(-side => 'top', -fill => 'x');
    
24. 
    
25. my $file_menu = $main_menu->cascade(-label=>"文件", -tearoff=>0);
    
26. $file_menu->command(-label=>"退出", -command=>sub{exit});
    
27. 
    
28. 
    
29. my $tool_menu = $main_menu->cascade(-label=>"工具", -tearoff=>0);
    
30. 
    
31. $tool_menu->command(-label=>"自定义扫描网段", -command=>\&fill_subnet);
    
32. 
    
33. my $look_menu = $main_menu->cascade(-label=>"查看", -tearoff=>0);
    
34. $look_menu->command(-label=>"日志", -command=>\&log);
    
35. 
    
36. 
    
37. my $help_menu = $main_menu->cascade(-label=>"帮助", -tearoff=>0);
    
38. $help_menu->command(-label=>"使用说明", -command=>\&readme);
    
39. 
    
40. #定义第二个frame，即当前时间显示栏
    
41. my $frame_2 = $main_frame->Frame()
    
42.                            ->pack(-side => 'right', -fill => 'x');
    
43. 
    
44. $frame_2->StrfClock(-font=>"fixed 9 bold", -foreground=>'#128110')->pack();
    
45. 
    
46. #定义滚动框
    
47. my $frame_3 = $mw->Frame()
    
48.    ->pack(-side => 'top', -ipady=>'0.1', -fill => 'x');
    
49. 
    
50. my $t = $frame_3->Scrolled("Text",
    
51.                          -scrollbars => 'oe',  
    
52.                               -width  => 40,
    
53.                              -height  => 22,
    
54.                                -wrap  => 'none',
    
55.                     )
    
56.                 ->pack(-side => 'top', -expand => 1);
    
57. 
    
58. 
    
59. $mw->Frame(-background => "blue")
    
60.       ->pack(-side => 'top', -ipady=>'0.5', -fill => 'x');
    
61. 
    
62. #定义最下面一个frame，版权说明
    
63. $mw->Label(-text => "推广开源  Perl/Tk开发\n-------------------------\n联系人：XXX\tQQ: 11111111", -font=>"fixed 9")
    
64.    ->pack(-side => "bottom");
    
65. 
    
66. MainLoop;
    
67. 
    
68. sub fill_subnet
    
69.         {
    
70.                 use Tk::DialogBox;
    
71.                 use Tk::LabEntry;
    
72.                 my $db = $mw->DialogBox(-title => "填写并扫描网段", -buttons => ["确定扫描", "放弃重置"], -command => \&scan_subnet);
    
73.                 $db->add('LabEntry', -textvariable => \$subnet, -width => 20, -background => 'white', -foreground => 'blue',
    
74.                                          -label => "网段", -labelPack => [-side => 'left'])
    
75.                    ->pack;
    
76.                 my $answer = $db->Show( );
    
77.         }
    
78. 
    
79. sub scan_subnet
    
80.         {
    
81. 
    
82.        my @host;
    
83.            my @subnet = (split "," , $subnet);
    
84.            foreach my $sub (@subnet) {
    
85.                for my $ip_range (1..3) {#测试而已，暂且数据写小一点，貌似写1 .. 254卡死了...
    
86.                        my $ips = "192.168.$sub.$ip_range";
    
87.                        push @host, $ips;
    
88.                }
    
89.        }
    
90. 
    
91.        foreach my $host (@host){
    
92.            my $p = Net::Ping->new("icmp");
    
93. 
    
94.            if ($p->ping($host,0.1)){
    
95.                
    
96.                my $hostname = gethostbyaddr(inet_aton($host),AF_INET);
    
97.                $hostname ||= '?';#如未成功获取，则设置主机名为?
    
98.                $t->repeat(1000, sub {$t->insert('end', "$host => $hostname is On_line\n")});
    
99.             }else{     
    
100.                $t->repeat(1000, sub {$t->insert('end', "$host is offline\n")});
     
101.            }
     
102.            $p->close();
     
103.        }
     
104.     }

复制代码

随手写了一个TK小工具，用于检测内网在线PC（其他功能还没有添加进去）。

1、用法：点“工具”-“自定义扫描网段”，填写网段号（实际公司内部网段全部是192.168.X.X，比如我要扫描192.168.1.x和192.168.2.x两个网段PC，则弹出框网段填写1,2 用逗号隔开，程序中是这么设定的）。现在运行中出现一个问题：sub scan_subnet{..}这个子函数故障，其中foreach my $host(@host)成了无限循环，停不下来（滚动框中不停循环出现insert的数据）。不知道哪里出了问题，请各位帮斧正。看了一下午，头都晕了，谢谢！

2、另外，还想实现一个功能：类似msdos下ping 192.168.1.1 -t 实时显示数据，滚动条随数据增加而变化的同时，光标总是显示在出现的最后一个字符。而我上面的程序需要手动拉滚动框才能显示最后一行数据。

mouse.rice

不顶要沉了，兄弟姐们们赐教啊。感谢！

mouse.rice

有解惑的兄弟没