脚本之家,脚本语言编程技术及教程分享平台!
分类导航

Python|VBS|Ruby|Lua|perl|VBA|Golang|PowerShell|Erlang|autoit|Dos|bat|

服务器之家 - 脚本之家 - perl - 用perl写的单位电脑信息采集程序

用perl写的单位电脑信息采集程序

2020-06-01 11:29脚本之家 perl

perl,后来我又改过了增加了一些交互和数据库检测的功能。主要用于收集ip、mac、姓名、房间,后来又加入了维修记录的功能。服务器端接受数据并存入数据库中。

用perl写的单位电脑信息采集程序

复制代码 代码如下:


主要用于收集ip、mac、姓名、房间,后来又加入了维修记录的功能。服务器端接受数据并存入数据库中。
#############################
use strict;
use Tk;
use Encode;

#SOCKE参数
my $PF_INET = 2;
my $port = 2345;
my $remote_addr = pack('SnC4x8',$PF_INET,$port,192,168,138,228);
my $SOCK_DGRAM = 2;

#Frame
my ($label_room, $label_name, $label_ctrl, $label_notice);

#确定、取消
my ($enter, $cancel);

#房间、姓名变量
my ($room, $name);
$room = '';
$name = '';

#主界面
my $mw = MainWindow->new(-title => hanzi('信息收集'));
$mw->minsize(qw/200 100/);
$mw->maxsize(qw/200 100/);

#三个Frame
$label_room = $mw->Frame( qw/-borderwidth 2 -relief groove/ )->pack( qw/-side top -fill both/ );
$label_name = $mw->Frame( qw/-borderwidth 2 -relief groove/ )->pack( qw/-side top -fill both/ );
$label_ctrl = $mw->Frame( qw/-borderwidth 2 -relief groove/ )->pack( qw/-side top -fill both/ );

#房间号码输入
$label_room->Label(-text => hanzi('房间号码'))->pack(qw/-side left -expand 1/);
$label_room->Entry(-textvariable => \$room, -relief => 'groove')->pack(qw/-side right -expand 1/);

#姓名输入
$label_name->Label(-text => hanzi('姓名'))->pack(qw/-side left -expand 1/);
$label_name->Entry(-textvariable => \$name, -relief => 'groove')->pack(qw/-side right -expand 1/);

#确定与重置
$enter = $label_ctrl->Button(-text => hanzi('确定'), -command => \&enter)->pack(qw/-side left -expand 1/);
$cancel = $label_ctrl->Button(-text => hanzi('重置'), -command => \&cancel)->pack(qw/-side right -expand 1/);

#提示
$label_notice = $mw->Label(-text => hanzi('欢迎使用'), -relief => 'groove', -background => '#FFFF99')->pack(qw/-side bottom -fill x/);

MainLoop();

#汉字解码
sub hanzi{
    return decode('gb2312', shift);    
}

#确定函数
sub    enter{
    chomp($room);
    chomp($name);
    $room =~ s/^\s+//;
    $name =~ s/^\s+//;
    if($room eq '' or $name eq ''){
        $label_notice->configure(-text => hanzi('输入不能为空')) ;
        return 0;
    }#if
    else{
        open(IPCF,'-|',"ipconfig -all");

        my ($mac_addr, $ip_addr, $out_buffer);
        while(<IPCF>){
            chomp;
            if($_ = ~s/(.*)(00(\-[0-9A-Z]{2}){5})(.*)/$2/){
                $mac_addr = join('', split(/-/,$_));
            }
            if($_ = ~/IP Address/){
                $_ = ~s/(.*)([0-9]{3}(\.[0-9]{1,3}){3})(.*)/$2/;
                $ip_addr = $_;
            }
        }#while
        $out_buffer = $room."\t".$mac_addr."\t".$ip_addr."\t".encode('utf8', $name);

        socket(UDP_CLIENT, $PF_INET, $SOCK_DGRAM, getprotobyname('udp'));
        send(UDP_CLIENT, $out_buffer, 0, $remote_addr);

        close(UDP_CLIENT);
        close(IPCF);
        $mw->destroy();
    }#else        
}

#重置函数
sub cancel{
    $label_notice->configure(-text => hanzi('重置为空'));
    $room = '';
    $name = '';
}
 

延伸 · 阅读

精彩推荐
  • perlPerl List::Util模块使用实例

    Perl List::Util模块使用实例

    这篇文章主要介绍了Perl List::Util模块使用实例,本文给出扫描符合条件的某个列表并取出第一个符合条件的、求1到1000之间的和 、求一组数字的最大值与最小...

    脚本之家4712020-06-22
  • perlPerl的经典用法分享

    Perl的经典用法分享

    Perl的经典用法分享,学习perl的朋友可以参考下 ...

    脚本之家6562020-06-06
  • perlPerl从文件中读取字符串的两种实现方法

    Perl从文件中读取字符串的两种实现方法

    有时候我们需要从文件中读取字符串,这里简单介绍下, 需要的朋友可以参考下 ...

    脚本之家6252020-06-08
  • perlperl pop push shift unshift实例介绍

    perl pop push shift unshift实例介绍

    perl的pop跟push操作数组的最右边,shift跟unshift操作数组的最左边 ...

    脚本之家4612020-06-10
  • perlPerl使用nginx FastCGI环境做WEB开发实例

    Perl使用nginx FastCGI环境做WEB开发实例

    这篇文章主要介绍了Perl使用nginx FastCGI环境做WEB开发实例,实现了路由系统和模板系统,需要的朋友可以参考下...

    Perl教程网2412020-06-18
  • perlperl use vars pragma使用技巧

    perl use vars pragma使用技巧

    perl 中的vars是perl中的一个pragma(预编译指示符),专门用来预定义全局变量,这些预定义后的全局变量在qw()列表中,在整个引用perl文件中皆可使用,即便使...

    perl教程网6812020-06-16
  • perlperl常见问题集合之二

    perl常见问题集合之二

    哪些平台上有 Perl?要到哪里去找? Perl的标准发行版(由 perl 发展小组负责维护)仅以原始码形式发行。您可在 http: //www.perl.com/CPAN/src/latest.tar.gz处取得。这个档...

    脚本之家2102020-05-29
  • perlperl命令行参数内建数组@ARGV浅析

    perl命令行参数内建数组@ARGV浅析

    这篇文章主要介绍了perl命令行参数内建数组@ARGV浅析,本文重点在于讲解@ARGV的用法,并通过实例来说明,需要的朋友可以参考下 ...

    perl教程网6162020-06-18