[求助]关于用 LWP 模拟登陆带有校验码的网站

[求助]关于用 LWP 模拟登陆带有校验码的网站
大家好，我现在尝试用 LWP 登录一些带有 校验码认证 的网站，但总是不得其门，我随便挑选了一个，做了一个小测试，请看如下代码


[quote]

#!/usr/bin/perl
use strict;
use warnings;
use LWP;



print "This is libwww-perl-$LWP::VERSION\n";

[color=red] #编辑一下，你的注册名/密码[/color]
my $username="";
my $password="";


my $response;
my $url;
my $browser = LWP::UserAgent->new;
[color=red]#开通 Cookies;[/color]
$browser->cookie_jar({});
[color=red]#模拟普通的浏览器 [/color]
$browser->agent('Mozilla/4.76 [us] (Win98; U)');


[color=red]#入口地址，先初始化一下 ASP_session[/color]
$url = 'http://xinhuanet.zsurvey.com/Login.asp';
$response = $browser->get( $url ,);
die "错误！ Can't get $url -- ", $response->status_line unless $response->is_success;
print $response->headers_as_string;



[color=red]#获取网站当前的校验码[/color]
$url = 'http://xinhuanet.zsurvey.com/Inc/GetCode.ASP';
$response = $browser->get($url,':content_file' => 'code.bmp',
'Referer' => 'http://xinhuanet.zsurvey.com/Login.asp',);
die "错误！ Can't get $url -- ", $response->status_line unless $response->is_success;
print $response->headers_as_string;




[color=red]#通过其它软件，自己识别验证码的数字，然后人工输入 [/color]

print " code.bmp Enter code:";
my $v_code= <STDIN>;
[color=red] #去除回车[/color]
chomp($v_code);


$url = 'http://xinhuanet.zsurvey.com/Login.asp?action=chk&City=1';
$response = $browser->post( $url,
['LoginName' => $username,
'password' => $password,
'ValueCode'=> '$v_code',
'CookieDate'=>'1',
'comeurl' =>'',
'Submit' =>' 登 录 '],
'Referer' => 'http://xinhuanet.zsurvey.com/Login.asp',);
die "错误！ Can't get $url -- ", $response->status_line unless $response->is_success;
print "\n";
print $response->content;

exit();

[/quote]

我看看都差不多，但是系统总是提示 “您输入的校验码与系统产生的不一致，请重新输入。”

请问，是不是我获取 校验码 的程序有误？我看了看应该对的啊，请各位指教！谢谢！

[CCB]10[/CCB]

没太仔细看,你保存Cookie了吗？服务器是通过Cookie来鉴别验证码的！

这个就是保存的啊
#开通 Cookies;
$browser->cookie_jar({});

是我的错误
哎，'ValueCode'=> '$v_code',

应该是 'ValueCode'=> [color=red][b]"[/color][/b]$v_code[color=red][b]"[/color][/b],


胸闷啊

潇洒也是错!!![CCB]2[/CCB.
潇洒也是错!!![CCB]2[/CCB]

呵呵，希望对你有用。--.
呵呵，希望对你有用。
[quote]
### y6cme@4red.org 2004.08.24
### ccb_repass.pl
use DB_File;
use HTML::Parser;
use HTTP::Cookies;
use Image::Magick;
use LWP::UserAgent;
use HTTP::Request::Common qw (POST);
###++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++###
++$|;
my $oldimg;
my $palette="M\@QODCI17?/;-'. ";
my $url='https://ibsbjstar.ccb.com.cn/app/ccbMain?CUSTYPE=0&TXCODE=CLOGIN';
###++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++##
open(FILE,">hack_ccb.txt");
my $ua=new LWP::UserAgent;
$ua->agent('Mozilla/5.0');
$ua->cookie_jar(new HTTP::Cookies);
###++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++###

my $request=$ua->request(POST 'https://ibsbjstar.ccb.com.cn/app/ccbMain?CUSTYPE=0&TXCODE=CLOGIN',
[
]
)->as_string;
print FILE $request,"\n";
###++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++###
sub img_get{
if(shift eq "img"){
$_=shift->{src};
if($_=~/Encoder/){
$oldimg="https://ibsbjstar.ccb.com.cn$_";
}
}
}
my $parser1=HTML::Parser->new(api_version=>3);
$parser1->handler(start=>\&img_get,'tagname,attr');
$parser1->parse("$request");
$parser1->eof;
$ua->mirror($oldimg,"Encoder.gif");
###++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++###
my $img=Image::Magick->new;
$img->Read("Encoder.gif");
my($r,$g,$b,$a,$colour,$xcount,$ycount,$substring,$readval);
my $spew="";
for($ycount=0;$ycount<$img->Get('Height');$ycount++){
for($xcount=0;$xcount<$img->Get('Width');$xcount++){
$readval=$img->Get('pixel['.$xcount.','.$ycount.']');
($r,$g,$b,$a)=split(/,/,$readval);
$colour=int((($r+$g+$b)/3)/16);
$substring=substr($palette,$colour,1);
$spew.=$substring;
}
$spew.="\n";
}
open TXT, ">Encoder.txt" or die("写文件失败！");
print TXT $spew;
close TXT;
open(OLD,"Encoder.txt");
my $one;
my $two;
my $three;
my $four;
my $five;
while(my $line=<OLD>){
$one.=substr($line,0,8)."\n";
$two.=substr($line,8,8)."\n";
$three.=substr($line,16,8)."\n";
$four.=substr($line,24,8)."\n";
$five.=substr($line,32,8)."\n";
}
close OLD;
my %inventory;
dbmopen(%inventory,"ccbimg.dbm",0700);
my $FORMAT_LINES_LEFT=0;
my $imgcode="$inventory{$one}$inventory{$two}$inventory{$three}$inventory{$four}$inventory{$five}";
print "$imgcode\n";
dbmclose %inventory;
my $newreq=$ua->request(POST 'https://ibsbjstar.ccb.com.cn/app/ccbMain',
[
"USERID"=>xxxxxxxxxxxxxxx,
"LOGPASS"=>"xxxxxx",
"PT_CONFIRM_PWD"=>$imgcode,
"TXCODE"=>"100101",
]
)->as_string;
print FILE $newreq,"\n";
my %hash;
sub ccb_go{
my($tagname,$attr)=@_;
###my($self,$tagname,$attr,$attrseq,$origtext)=@_;
if($tagname eq "input"){
print "$attr->{name}===$attr->{value}\n";
$hash{$attr->{name}}=$attr->{value};
}
}
my $parser2=HTML::Parser->new(api_version=>3
$parser2->handler(start=>\&ccb_go,'tagname,attr');
$parser2->parse("$newreq");
$parser2->eof;
my $newreq2=$ua->request(POST 'https://ibsbjstar.ccb.com.cn/app/ccbMain',
[
TXCODE=>"100105",
BRANCHID=>351000000,
"SKEY"=>$hash{SKEY},
"COOKIES"=>$hash{COOKIES},
"USERID"=>$hash{USERID},
"USERNAME"=>$hash{USERNAME},
"FIRSTPAGE"=>$hash{FIRSTPAGE},
"PAGE"=>$hash{PAGE},
"BANK"=>$hash{BANK},
]
)->as_string;
print FILE $newreq2,"\n";
my %gh;
sub ccb_hack{
my($tagname,$attr)=@_;
if($tagname eq "input"){
print "\n-----------------------\n$attr->{name}===$attr->{value}\n";
$gh{$attr->{name}}=$attr->{value};
}
}
my $parser3=HTML::Parser->new(api_version=>3);
$parser3->handler(start=>\&ccb_hack,'tagname,attr');
$parser3->parse("$newreq2");
$parser3->eof;
my $newreq3=$ua->request(POST 'https://ibsbjstar.ccb.com.cn/app/ccbMain',
[
"TXCODE"=>"700101",
"FLAG"=>"0",
"OLD_PASSWORD"=>xxxxxxxx,
"NEW_PASSWORD"=>"xxxxxxxx",
"CONFIR"=>"xxxxxxxxx",
"SKEY"=>$gh{SKEY},
"USERID"=>$gh{USERID},
"BRANCHID"=>"351000000",
]
)->as_string;
print FILE $newreq3,"\n";
close FILE;
[/quote]

   

去除回车是chop，不是chom.
去除回车是chop，不是chomp吧？