登陆百度和GOOGLE的perl/Tk脚本.pl

#!/usr/bin/perl     
#####################################
# jondy       #
# QQ:222411      #
# http://zhack.blog.163.com/  #
##############################################
#            #
# 这是一个简单的登陆baidu和google的脚本  #
# 用Perl/Tk做的界面；       #
# 开发环境 WinXP sp2 + perl v5.8.4   #
# 转载请把这几行绿了吧唧的字留下    #
#            #
##############################################
use strict;
use warnings;
use encoding 'euc-cn';
use Tk;
use Tk::NoteBook;

my ($host,$phost,$postdata,$datalength,$line);

my $mw = new MainWindow;
$mw->title('登陆网站到搜索引擎');
$mw->minsize(400,200);
$mw->resizable(0,0);

my $book = $mw->NoteBook()->pack( -fill=>'both', -expand=>1 );

my $tab1 = $book->add( "Sheet 1", -label=>"www.baidu.com");
my $tab2 = $book->add( "Sheet 2", -label=>"www.google.com", -raisecmd=>/&geturl);
##############################   baidu   #################
$tab1->Label(-text => "（例：http://zhack.blog.163.com）",-font=>'{宋体} 9 {normal}')
->pack(-fill=>'x');
my $url1 = $tab1->Entry(-width =>50,-relief=>'groove',-font=>'{MS Sans Serif} 9 {normal}')
->pack(-fill=>'x');
$tab1->Button(-text=>'提交到百度',-font=>'{宋体} 9 {normal}',-command=>/&baidu)->pack();
$tab1->Label(-text => "
一个免费登录网站只需提交一页（首页）,百度搜索引擎会自动收录网页.
符合相关标准您提交的网址，会在1个月内按百度搜索引擎收录标准被处理.
百度不保证一定能收录您提交的网站.                                ",
  -font=>'{宋体} 9 {normal}')
->pack(-fill=>'x');
##############################   google   ##################
$tab2->Label(-text => "（例：http://zhack.blog.163.com）",-font=>'{宋体} 9 {normal}')
->pack(-fill=>'x');
my $url2 = $tab2->Entry(-width =>50,-relief=>'groove',-font=>'{MS Sans Serif} 9 {normal}')
->pack(-fill=>'x');
$tab2->Label(-text => "（例：Perl 是一种方便的脚本语言！）",-font=>'{宋体} 9 {normal}')
->pack(-fill=>'x');
my $keys = $tab2->Entry(-width =>50,-relief=>'groove',-font=>'{宋体} 9 {normal}')
->pack(-fill=>'x');
$tab2->Button(-text=>'提交到Google',-font=>'{宋体} 9 {normal}',-command=>/&google)->pack;
$tab2->Label(-text => "
登录网址时，只须提交最上层的网页，其它各页由 Googlebot 自行查找。
Google 会定期检索并更新所有网站；对于失效网页则将其删除。       ",-font=>'{宋体} 9 {normal}')
->pack(-fill=>'x');
MainLoop;

sub geturl{
$url2->delete('0.0','end');
$url2->insert(0,$url1->get);
}

sub baidu {
$host="utility.baidu.com";
$phost=$url1->get;
$postdata = "url=$phost&ivc=UxxfRwFYVF8=&code=NNZZ&Submit=%CC%E1%BD%BB%CD%F8%D5%BE";
$datalength = length($postdata);
&postcheck("baidu");
}

sub google {
$host="www.google.com";
$phost=$url2->get;
$postdata = "GET /intl/zh-CN/addurl?q=$phost&dq=$keys->get&submit=%B5%C7%C2%BC HTTP/1.1/r/n/r/n";
$datalength = length($postdata);
&postcheck("google");
}

sub postcheck{
my ($tmp)=@_;
my ($name, $aliases, $type, $len, @thataddr, $a, $b, $c, $d, $that);
($name, $aliases, $type, $len, @thataddr) = gethostbyname($host);
($a, $b, $c, $d) = unpack("C4", $thataddr[0]);
$that = pack('S n C4 x8', 2, 80, $a, $b, $c, $d);
socket(S, 2, 1, 0);
select(S);
$| = 1;
select(STDOUT);
connect(S, $that);
if ($tmp =~ /baidu/){
  print S "POST /addurl/apply.php HTTP/1.1/r/n";
  print S "Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, */*/r/n";
  print S "Accept-Language: zh-cn/r/n";
  print S "Content-Type: application/x-www-form-urlencoded/r/n";
  print S "Accept-Encoding: gzip, deflate/r/n";
  print S "User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)/r/n";
  print S "Host: $host/r/n";
  print S "Content-Length: $datalength/r/n";
  print S "Connection: Keep-Alive/r/n";
  print S "Cache-Control: no-cache/r/n/r/n";
  print S "$postdata/r/n/r/n";
  my $s = <S>;
  if ($s =~ /302/) {
   &MsgShow('OK','恭喜',"$phost 添加到百度成功!","info");
  }
}
if ($tmp =~ /google/) {
  print S $postdata;
  my $s = <S>;
  if ($s =~ /200/) {
   &MsgShow('OK','恭喜',"$phost 添加到Google成功!","info");
  }
}
close(S);
}

sub MsgShow
{
my ($type,$title,$msg,$ico)=@_;
my $msgbox = $mw->messageBox(-type=>$type , -title => $title,-message => $msg,-icon => $ico);
return($msgbox);
}