用perl实现NAV的病毒库更新（学习，交流）

takelook

虽然不算是软件开发， 还是发这里了。

诺顿病毒库的liveupdate一般是每星期更新一次， 网上的intelligentupdate是每天更新但只能手动下载

最近在学习perl， 作了个自动更新NAV的脚本可以自动下载intelligentupdate。欢迎爱好者交流。

由于是初学，加了好多不必要的代码（主要是试试），不大严谨还可能有bug。

如果有想试试的可以去下个activeperl装上http://www.activestate.com/Produ ... .plex?id=ActivePerl
然后把下面的代码用notepad保存成.pl文件（activeperl自动关联的默认的扩展名），用wperl.exe（\perl\bin 目录下）可以不显示dos窗口， 我就是保存成.plm文件，然后关联.plm文件用wperl.exe打开， 放到启动组中，每次开机自动检测更新norton。

takelook

发送邮件的函数
sub perl_sendemail {
     my ($MailFrom,$MailTo,$MailSubject,$MailBody) = @_;
        use Net::SMTP;  
        my $ServerName = "youremailsmtpserver"; #ie mail.yahoo.com
        # Create a new SMTP object  
        $smtp = Net::SMTP->new($ServerName, Debug => 1) || die "Couldn't connect to server";

        $smtp->mail( $MailFrom );  
        $smtp->to( $MailTo );

        # Start the mail  
        $smtp->data();

        $smtp->datasend("To:  $MailTo\n");

        $smtp->datasend("From:  $MailFrom\n");  
        $smtp->datasend("Subject: $MailSubject\n");  
        $smtp->datasend("\n");

        $smtp->datasend("$MailBody\n\n");

        $smtp->dataend();

        $smtp->quit();
}

999rose

好东西，多谢楼主共享。
不过好象设置太麻烦了点，而且只能开机时检测。象我等几天关一次机的人就不实用了。
还是手动更新吧。:)

takelook

# Global variable
$tempath=$ENV{"TEMP"}. "\\";  #环境变量，暂时保存下载的文件
$reg_key="perlnav";         # 用注册表保存更新的信息
$reg_sub1="filename";     # 文件名
$reg_sub2="method";      #FTP或HTTP
#诺顿FTP站点信息
$ftp_hostname = 'ftp.symantec.com';
$ftp_username = 'anonymous';
$ftp_password = '[email protected]';
$ftp_remotepath='public/english_us_canada/antivirus_definitions/norton_antivirus/';

$perl_mailfrom="adm\@symantect.com"; #随便啦
$perl_mailto="name\@my.com"; #自己的邮箱
$perl_mailsubject="Nav Update"; #邮件标题

sleep(15);  #等待15秒，以便机器启动完毕

#注册表操作
use Win32::Registry;

$HKEY_CURRENT_USER->Create($reg_key, $perlkeyhandle) || die "Open Registry Error $!";
$perlkeyhandle->GetValues(\%perlkeyhash);
$oldfilename=$perlkeyhash{$reg_sub1}->[2];
print "old file name is * $oldfilename * \n";

从诺顿网站获取最新更新文件名
use LWP::UserAgent; # Include the LWP::UserAgent class
$ua = LWP::UserAgent->new; # Create a new UserAgent object
$req = HTTP::Request->new('GET','http://securityresponse.symantec.com/avcenter/download/pages/US-N95.html');
$res = $ua->request($req); # Send the request and store the response

# Use regular expression to get the filename part of the latest antivirus definition example 20030827-021-i32.exe
$res->as_string =~ /<td><p><b><a href="\/avcenter\/download\/us-files\/(\d+-\d+-i32.exe)"/;
$newfilename = $1; # get new file name
print "new file name is * $newfilename * \n";
print "temp path is * $tempath" . "$newfilename *\n";

takelook

if ($newfilename ne $oldfilename){
        use Net::FTP;
        $ftp = Net::FTP->new($ftp_hostname);         # construct object
        $ftp->login($ftp_username, $ftp_password);       # log in
        $ftp->pasv();
        $ftp->cwd($ftp_remotepath);                   # change directory
        $ftp->get($newfilename,$tempath . $newfilename);
        $ftp->quit;
        if ( -e $tempath . $newfilename){
                print "FTP successful,need to set key\n";
                $perlkeyhandle->SetValueEx($reg_sub1,0,REG_SZ,$newfilename);       
                $perlkeyhandle->SetValueEx($reg_sub2,0,REG_SZ,"FTP");       
                system($tempath . $newfilename . " /q" );
                unlink($tempath . $newfilename);
                perl_sendemail($perl_mailfrom,$perl_mailto,$perl_mailsubject . " successful by FTP",$newfilename);
        }
        else{
                $req = HTTP::Request->new('GET',"http://securityresponse.symantec.com/avcenter/download/us-files/$newfilename");
                $res = $ua->request($req, $tempath . $newfilename);
                if ( -e $tempath . $newfilename){
                        print "HTTP successful,need to set key\n";
                        $perlkeyhandle->SetValueEx($reg_sub1,0,REG_SZ,$newfilename);       
                        $perlkeyhandle->SetValueEx($reg_sub2,0,REG_SZ,"HTTP");       
                        system($tempath . $newfilename . " /q" );
                        unlink($tempath . $newfilename);
                        perl_sendemail($perl_mailfrom,$perl_mailto,$perl_mailsubject . " successful by HTTP",$newfilename);
                }
                else {
                        perl_sendemail($perl_mailfrom,$perl_mailto,$perl_mailsubject . " Failed","network problem???Fetching $newfilename failed");
                }
        }
}
else{
        $perlkeyhandle->SetValueEx($reg_sub2,0,REG_SZ,"SAME AS BEFORE");       
        print "same def\n";
        perl_sendemail($perl_mailfrom,$perl_mailto,$perl_mailsubject . " not performed","same definition");
}

完

takelook

呵呵，其实liveupdate一般也就够了，我做这个主要是熟悉一下perl。
:)

最初由 999rose 发布
[B]好东西，多谢楼主共享。
不过好象设置太麻烦了点，而且只能开机时检测。象我等几天关一次机的人就不实用了。
还是手动更新吧。:) [/B]