gyn

 1 use Win32::GUI;
 2 use strict;
 3 use Encode;
 4 use Net::FTP;
 5 use Time::Local;
 6 use Tk;
 7 use Tk::BrowseEntry;
 8 
 9 my $hw = Win32::GUI::GetPerlWindow();
10 Win32::GUI::Hide($hw);
11 
12 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
13 my @t = localtime(time() - 86400);
14 my $tm;
15 my $bt;
16 my $mw;
17 my $signal = 0;
18 my $sd = sprintf("%d", $t[5] + 1900).sprintf("%.2d", $t[4] + 1).sprintf("%.2d", $t[3]);
19 my $data = sprintf("%d", $t[5] + 1900).'-'.sprintf("%.2d", $t[4] + 1).'-'.sprintf("%.2d", $t[3]);
20 my $ta = sprintf("%d", $year + 1900).'-'.sprintf("%.2d", $mon + 1).'-'.sprintf("%.2d", $mday);
21 
22 sub hanzi { return decode('gb2312', shift); }
23 sub shezhi {
24     $tm = timelocal($sec,$min,$hour,$mday,$mon,$year);
25     $signal = 1;
26     open C, 'chonglu.rpjf';
27     open T, '>temp';
28     while (<C>) { 
29         chomp;
30         $_ =~ s/(.*)([0-9]{8})(.*)/$1$sd$3/;
31         $_ =~ s/(.*)([0-9]{4}\-[0-9]{2}\-[0-9]{2})(.*)/$1$data$3/;
32         print T "$_\n";
33     }
34     close C; close T;
35     system 'del chonglu.rpjf';
36     system 'rename temp chonglu.rpjf';
37     $bt->configure(-state => 'disable');
38 }
39 sub monitor {
40     if ($signal) { 
41         if (time() >= $tm) {
42             $signal = 0;
43             system 'producer -j "d:\shixian\chonglu.rpjf" -daw -lc "e,i"';
44         }
45         if (-e "shixian$sd.rm") {
46             my $f = Net::FTP->new('media.zsgd.com') or print 'ftp failed';
47             $f->login('jh', '2020038');
48             $f->put("shixian$sd.rm");
49             $f->quit();
50             print "send complete\n";
51         }
52     }
53 }
54 
55 $mw = MainWindow->new(-title => hanzi('视线重录'));
56 $mw->Label(-text => $ta)->pack(-side => 'left', -expand => 1, -fill => 'x');
57 foreach ((['小时', \$hour, [0..23]], ['分', \$min, [0..59]], ['秒', \$sec, [0..59]])) {
58     $mw->BrowseEntry(-label => hanzi($_->[0]), -variable => $_->[1], -choices => $_->[2])->pack(-side => 'left', -expand => 1, -fill => 'x');
59 }
60 $bt = $mw->Button(-text => hanzi('设置'), -command => \&shezhi)->pack(-side => 'bottom');
61 $mw->resizable(0, 0);
62 $mw->repeat(1000, \&monitor);
63 MainLoop();
64 

# ! perl -w

use  strict;
use  Win32 :: SerialPort;

my   $port   =   ' COM2 ' ;  #  serail port name registried in OS
my   $count   =   0 ;  #  count number of heartbeat-receiving failture
my   $max_count   =   5 ;  #  max fail count to be tolerated 
my   $interface   =   '

# ---------------------------------- 
# 接口 IP 配置         
# ---------------------------------- 
pushd interface ip


# "local" 的接口 IP  配置

set address name="local" source=static addr=192.168.6.185 mask=255.255.255.0
set address name="local" gateway=192.168.6.65 gwmetric=0
set dns name="local" source=static addr=192.168.6.112 register=PRIMARY
add dns name="local" addr=192.168.6.201 index=2
set wins name="local" source=static addr=none


popd
# 接口 IP 配置结束


' ;  #  net inetrface config information

sub  errlog {
     # log the failtrue occuring time
    
     open  ERR ,   ' >>err.log ' ;
     my   @time   =   localtime ();
     my   $time   =   sprintf ( " %d " ,   $time [ 5 ]  +   1900 ) 
                         .   ' - '  
                         .   sprintf ( " %d " ,   $time [ 4 ]  +   1 )
                         .   ' - '
                         .   " $time[3] "
                         .   '   '
                         .   sprintf ( " %.2d " ,   $time [ 2 ])
                         .   ' : '
                         .   sprintf ( " %.2d " ,   $time [ 1 ])
                         .   ' : '
                         .   sprintf ( " %.2d " ,   $time [ 0 ]);
     print  ERR  $time . " \n " ;
     close  ERR;
}

sub  ipchange {
     #  change ip addrress
    
     open  TMP ,   ' >tmp ' ;
     print  TMP  $interface ;
     close  TMP;
    
     eval  {
         system   ' netsh -f tmp ' ;
         unlink   ' tmp ' ;
    };
    
     if  ($@) { return   0 ;}
     return   1 ;
}

my   $ob   =  Win32 :: SerialPort -> new( $port ) or  die   " CANNOT OPEN $port " ;
#  open serial port 

eval  {
     #  set serial port properties
    
     $ob -> baudrate( 9600 );
     $ob -> parity( ' none ' );
     $ob -> databits( 8 );
     $ob -> stopbits( 1 );
     $ob -> handshake( ' none ' );
};
    
if  ($@) { die   ' SET FAILED ' ;}

$ob -> write_settings or  die   " CANNOT WRITE $port DRIVER " ;
#  write to port driver to make it active

while  ( 1 ) {
     #  loop receiving heartbeat from remote machine
    # change ip address after designated count of failture 
    
     my  ( $length ,   $result )  =   $ob -> read ( 10 );
    
     if  ( $result ) { 
         $count   =   0 ;
    }  elsif  ( $count   ==   $max_count ) {
        errlog();
         if  (not ipchange()) {  print   ' IP CHANGE FAILED ' ; }
         last ;
    }     else  { 
         $count ++ ;
    }
    
     sleep ( 1 );
}

undef   $ob ;