用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=>"自定義掃描網(wǎng)段", -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，即當(dāng)前時間顯示欄
    
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，版權(quán)說明
    
63. $mw->Label(-text => "推廣開源  Perl/Tk開發(fā)\n-------------------------\n聯(liá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 => "填寫并掃描網(wǎng)段", -buttons => ["確定掃描", "放棄重置"], -command => \&scan_subnet);
    
73.                 $db->add('LabEntry', -textvariable => \$subnet, -width => 20, -background => 'white', -foreground => 'blue',
    
74.                                          -label => "網(wǎng)段", -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) {#測試而已，暫且數(shù)據(jù)寫小一點，貌似寫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 ||= '?';#如未成功獲取，則設(shè)置主機名為?
    
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.     }

復(fù)制代碼

隨手寫了一個TK小工具，用于檢測內(nèi)網(wǎng)在線PC（其他功能還沒有添加進去）。

1、用法：點“工具”-“自定義掃描網(wǎng)段”，填寫網(wǎng)段號（實際公司內(nèi)部網(wǎng)段全部是192.168.X.X，比如我要掃描192.168.1.x和192.168.2.x兩個網(wǎng)段PC，則彈出框網(wǎng)段填寫1,2 用逗號隔開，程序中是這么設(shè)定的）�，F(xiàn)在運行中出現(xiàn)一個問題：sub scan_subnet{..}這個子函數(shù)故障，其中foreach my $host(@host)成了無限循環(huán)，停不下來（滾動框中不停循環(huán)出現(xiàn)insert的數(shù)據(jù)）。不知道哪里出了問題，請各位幫斧正。看了一下午，頭都暈了，謝謝！

2、另外，還想實現(xiàn)一個功能：類似msdos下ping 192.168.1.1 -t 實時顯示數(shù)據(jù)，滾動條隨數(shù)據(jù)增加而變化的同時，光標總是顯示在出現(xiàn)的最后一個字符。而我上面的程序需要手動拉滾動框才能顯示最后一行數(shù)據(jù)。

mouse.rice

不頂要沉了，兄弟姐們們賜教啊。感謝！

mouse.rice

有解惑的兄弟沒