邮件发送程序调试出错,帮忙看看!

邮件发送程序调试出错,帮忙看看!

邮件发送程序调试出错,帮忙看看!
作者提供的相关的附件(大小:3 K)

调试信息为:

Net::SMTP=GLOB(0x2f60984)<<< 220 KAV6 Smtp Proxy Server Ready
Net::SMTP=GLOB(0x2f60984)>>> EHLO localhost.localdomain
Net::SMTP=GLOB(0x2f60984)<<< 250-sohumx112.sohu.com
Net::SMTP=GLOB(0x2f60984)<<< 250-PIPELINING
Net::SMTP=GLOB(0x2f60984)<<< 250-SIZE 10485760
Net::SMTP=GLOB(0x2f60984)<<< 250-ETRN
Net::SMTP=GLOB(0x2f60984)<<< 250-AUTH LOGIN
Net::SMTP=GLOB(0x2f60984)<<< 250-AUTH=LOGIN
Net::SMTP=GLOB(0x2f60984)<<< 250 8BITMIME
Tk::Error: wrong # args: should be ".frame1.text get index1 ?index2 ...?" at C:/
Perl/site/lib/Tk.pm line 247.
Tk callback for .frame1.text
Tk::__ANON__ at C:/Perl/site/lib/Tk.pm line 247
Tk::Derived::Delegate at C:/Perl/site/lib/Tk/Derived.pm line 469
Tk::Widget::__ANON__ at C:/Perl/site/lib/Tk/Widget.pm line 322
main::send1 at C:\DOCUME~1\winxp\LOCALS~1\Temp\dir8B.tmp\sendmail.pl line 228
main::link_send at C:\DOCUME~1\winxp\LOCALS~1\Temp\dir8B.tmp\sendmail.pl line 209
Tk callback for .frame4.button
Tk::__ANON__ at C:/Perl/site/lib/Tk.pm line 247
Tk::Button::butUp at C:/Perl/site/lib/Tk/Button.pm line 111
<ButtonRelease-1>
(command bound to event)

愿意帮忙的留个qq
源程序在附件里
程序代码
#!/usr/bin/perl

use strict;
use Tk;
use encoding 'gb2312';
use Tk::ROText;
use Net::SMTP;
use MIME::Base64;

my $smtp;

#**************************************************** 创建窗体 *************************************************

#创建主窗口并进行配置
my $mw=MainWindow->new();
$mw->geometry("620x700+230+0");

#创建一个提示标签和一个输入框
$mw->Label(-text=>"请输入收件人\(多个收件人请用空格隔开\):")->pack(-anchor=>'nw',-padx=>5);
my $mail_receiver=$mw->Entry(-width=>100,-borderwidth=>2,-relief=>'sunken');
$mail_receiver->pack(-anchor=>"nw",-padx=>5,-pady=>1);

#创建一个提示标签和一个输入框
$mw->Label(-text=>"请输入smtp服务器:")->pack(-anchor=>'nw',-padx=>5);
my $smtp_server=$mw->Entry(-width=>20,-borderwidth=>5,-relief=>'sunken');
$smtp_server->pack(-anchor=>'nw',-padx=>5,-pady=>1);

#创建一个提示标签和一个输入框
$mw->Label(-text=>"请输入在smtp服务器上的账户\(如xxxyyy\@xxx.com,则请输入xxxyyy\):")->pack(-anchor=>'nw',-padx=>5);
my $user_in_server=$mw->Entry(-width=>20,-borderwidth=>5,-relief=>'sunken');
$user_in_server->pack(-anchor=>'nw',-padx=>5,-pady=>1);

#创建一个提示标签和一个输入框
$mw->Label(-text=>"请输入在smtp服务器上的登陆密码:")->pack(-anchor=>'nw',-padx=>5);
my $password_in_server=$mw->Entry(-width=>20,-show=>'*',-borderwidth=>5,-relief=>'sunken',-font=>5,-foreground=>'#0088ff');
$password_in_server->pack(-anchor=>'nw',-padx=>5,-pady=>1);

#创建一个提示标签和一个输入框
$mw->Label(-text=>"请输入主题:")->pack(-anchor=>'nw',-padx=>5);
my $subject_to_mail=$mw->Entry(-width=>100,-borderwidth=>5,-relief=>'sunken');
$subject_to_mail->pack(-anchor=>'nw',-padx=>5,-pady=>1);

#创建一个Frame,并创建一个提示标签、一个按钮
my $frame1=$mw->Frame;
$frame1->Label(-text=>"请输入要发送的信息\(可以从文本中读入\):")->pack(-anchor=>'nw',-side=>'left',-ipady=>3);
my $button1=$frame1->Button(-text=>"选择文本文件",-command=>\&Browse1,-borderwidth=>3,-relief=>'raised');
$button1->pack(-side=>'right',-padx=>5,-expand=>1,-pady=>1);
$frame1->pack(-padx=>5,-anchor=>'nw');

#创建一个文本输入框
my $text_to_mail=$mw->Scrolled("Text",-height=>8,-width=>85,-scrollbars=>'oe');
$text_to_mail->pack(-anchor=>'nw',-padx=>5,-pady=>2);

#创建一个Frame,并创建一个提示标签和一个按钮
my $frame2=$mw->Frame;
$frame2->Label(-text=>"请选择附件:")->pack(-anchor=>'nw',-side=>'left');
my $button2=$frame2->Button(-text=>"选择附件",-command=>\&Browse2,-borderwidth=>3,-relief=>'raised');
$button2->pack(-side=>'right',-padx=>5,-expand=>1,-pady=>1);
$frame2->pack(-padx=>5,-anchor=>'nw',-pady=>2);

#创建一个Frame,并创建一个提示标签、一个按钮和一个列表框
my $frame3=$mw->Frame;
$frame3->Label(-text=>"已选择的附件:")->pack(-pady=>1,-side=>'left');
my $file_list=$frame3->Scrolled("Listbox",-height=>2,-width=>60,-scrollbars=>'oe',-selectmode=>'multiple');
$file_list->pack(-anchor=>'nw',-pady=>1,-padx=>5,-side=>'left');
my $button3=$frame3->Button(-text=>"删除附件:",-command=>\&Delete_attachment,-borderwidth=>3,-relief=>'raised');
$button3->pack(-side=>'right',-pady=>1,-padx=>5);
#$frame3->Listbox(-height=>1,-width=>60)->pack(-expand=>1,-pady=>1,-padx=>5,-side=>'right');
$frame3->pack(-anchor=>'nw',-padx=>5);

#创建一个Frame,并创建三个按钮
my $frame4=$mw->Frame;
my $button4=$frame4->Button(-text=>"连接并发送",-command=>\&link_send,-borderwidth=>5,-relief=>'raised');
$button4->pack(-side=>'left',-pady=>1,-padx=>55);
my $button5=$frame4->Button(-text=>"清空重来",-command=>\&clear_info,-borderwidth=>5,-relief=>'raised');
$button5->pack(-side=>'left',-pady=>1,-padx=>65);
my $button6=$frame4->Button(-text=>"退出",-command=> sub { exit; },-relief=>'raised',-borderwidth=>5);
$button6->pack(-side=>'left',-pady=>1,-padx=>55);
$frame4->pack(-anchor=>'nw',-padx=>5,-pady=>1);

#创建一个提示标签和一个文本输入框
$mw->Label(-text=>"调试信息:")->pack(-anchor=>'nw',-padx=>5);
my $text_report=$mw->Scrolled("ROText",-height=>12,-width=>85,-scrollbars=>'osre',-foreground=>"red",-wrap=>'none');
$text_report->pack(-anchor=>'nw',-padx=>5,-pady=>5);

#窗体不允许改变大小
$mw->resizable(0,0);

#进入主循坏
MainLoop;

#******************************************* 回调函数的实现 **************************************************

sub get_mail_receiver{
my $mailreceiver;
my @mail_receivers;
$mailreceiver=$mail_receiver->get();
@mail_receivers=split (/\s+/,$mailreceiver);
return @mail_receivers;
}

sub get_smtpserver{
my $smtpserver;
$smtpserver=$smtp_server->get();
return $smtpserver;
}

sub get_user{
my $user=$user_in_server->get();
return $user;
}

sub get_password{
my $password;
$password=$password_in_server->get();
return $password;
}

sub get_subject{
my $subject;
$subject=$subject_to_mail->get();
return $subject;
}

sub get_attachment{
my @attachment;
my $num;
my $i;

$num=$file_list->size();
for($i=0;$i<$num;$i++){
$attachment[$i]=$file_list->get($i);
}

return @attachment;
}

sub Delete_attachment{
my $message;
my @selected;
my $i=$file_list->size();
if(!$i){
$message="没有附件!\n";
show_message($message);
}
else{
@selected = $file_list->curselection;
$i=@selected;
if(!$i){
$message="没有选择附件!\n";
show_message($message);
}
else{
foreach (@selected){
$file_list->delete($_);
$message="所选附件: 已移除!\n";
show_message($message);
}
}

}
}

sub initialization{
my $flag=0;
my $message;
if( $mail_receiver->get() eq ""){
$message="收件人不能是空!\n";
show_message($message);
}
if( $smtp_server->get() eq ""){
$message="smtp服务器不能是空!\n";
show_message($message);
}
if( $user_in_server->get() eq ""){
$message="帐户不能是空!\n";
show_message($message);
}
if( $password_in_server->get() eq ""){
$message="登陆密码不能是空!\n";
show_message($message);
}
if( $subject_to_mail->get() eq ""){
$message="主题不能是空!\n";
show_message($message);
}
}

sub link_send{
my $message;

my $user=get_user();
my $password=get_password();
my $server=get_smtpserver();

$smtp= Net::SMTP->new(
Host => "$server",
# Hello => 'my.mail.domain'
Timeout => 180,
Debug => 1,
) or warn "couldn't open $server";
if($smtp==0){
$message="连接被拒绝(或超时),请再来一次!\n";
show_message($message);
}
else{
$smtp->auth($user,$password);
if($smtp){
$message="服务器已登陆!\n";
show_message($message);
if(send1($smtp,$user)){
$message="邮件已发送到邮箱!\n";
showmessage($message);
}
}
else{
$message="帐户、密码不匹配,重新输入!\n";
show_message($message);
}
}
}

sub send1(){
#my $smtp=shift @_;
#my $user=shift @_;
my ($smtp,$user)=shift @_;
my $mailreceiver=get_mail_receiver();
my $subject=get_subject();

my $i;
my $name;
my $format;

my $text_mail=$text_to_mail->get();
my @attachment=get_attachment();

$smtp->mail($user);
$smtp->to($mailreceiver);
$smtp->data();
$smtp->datasend("MIME-Version:1.0\n");
$smtp->datasend("From: $user\n");
$smtp->datasend("To: $mailreceiver\n"); #######
$smtp->datasend("Subject: $subject\n");
$smtp->datasend("\n");
#$smtp->datasend("$text_to_mail\n");

if(!@attachment){
$smtp->datasend("$text_to_mail\n"); #没有附件,默认发送文本
}
else{ #有附件,Content-Type给出主体类别
$smtp->datasend("Content-Type:Multipart/Mixed;Boundary=Start_a_part\n\n");
$smtp->datasend("--Start_a_part\n");
$smtp->datasend("Content-Type: text/plain; charset=\"gb2312\"\n");
$smtp->datasend("Content-Transfer-Encoding: base64\n");
$smtp->datasend("\n");
$text_mail=encode_base64($text_mail);
$smtp->datasend("$text_to_mail");
$smtp->datasend("\n");

for($i=0;$i<@attachment;$i++){
$name=$attachment[$i];
$format=~s/(.*)\\//; #for win to get format
$format=~s/(\w+)\.//;

if(-T $attachment[$i]){
$smtp->datasend("--Start_a_part\n");
$smtp->datasend("Content-Type: text/plain; charset=\"gb2312\"\n");
$smtp->datasend("Content-Transfer-Encoding: base64\n");
$smtp->datasend("\n");
$attachment[$i]=encode_base64($attachment[$i]);
$smtp->datasend("$attachment[$i]");
$smtp->datasend("\n");
}
if($format=~/gif|jepg|png|bmp|tiff/){
$smtp->datasend("--Start_a_part\n");
$smtp->datasend("Content-Type:image/$format;\n");
$smtp->datasend("Content-Disposition:attachment;filename=$name\n");
$smtp->datasend("Content-Transfer-Encoding: base64\n");
$smtp->datasend("\n");
$attachment[$i]=encode_base64($attachment[$i]);
$smtp->datasend("$attachment[$i]");
$smtp->datasend("\n");
}
if($format=~/basic|mpeg|midi|x-aiff|x-wav/){
$smtp->datasend("--Start_a_part\n");
$smtp->datasend("Content-Type:audio/$format;\n");
$smtp->datasend("Content-Disposition:attachment;filename=$name\n");
$smtp->datasend("Content-Transfer-Encoding: base64\n");
$smtp->datasend("\n");
$attachment[$i]=encode_base64($attachment[$i]);
$smtp->datasend("$attachment[$i]");
$smtp->datasend("\n");
}
else{
$smtp->datasend("--Start_a_part\n");
$smtp->datasend("Content-Type:application/$format;\n");
$smtp->datasend("Content-Disposition:attachment;filename=$name\n");
$smtp->datasend("Content-Transfer-Encoding: base64\n");
$smtp->datasend("\n");
$attachment[$i]=encode_base64($attachment[$i]);
$smtp->datasend("$attachment[$i]");
$smtp->datasend("\n");
}
}
$smtp->dataend();
}
return;
}

sub show_message{
my @message=@_;
my $count;
for($count=0;$count<@message;$count++){
$text_report->insert('end',$message[$count]);
$text_report->see('end');
}
$text_report->update;
}

sub Browse1{
my $message;
my $types = [
['Text Files', ['.txt', '.text']],
['C Source Files', '.c', 'TEXT'],
['All Files', '*', ],
];
my $file=$mw->getOpenFile(-title=>"选择文件",-filetypes=>$types);
if($file eq ""){
$message="没有选择文件!\n";
show_message($message);
}
else{
if(!open(TEXTFILE,$file)){
$message="不能打开文件:$file!\n";
show_message($message);
}
else{
open (TXTFILE, $file);
foreach (<TXTFILE>) {
$text_to_mail->insert('end',$_);
}
close(TXTFILE);

$message="打开文件 :$file 成功!\n";
show_message($message);
}
}
}

sub Browse2{
my $message;
my $types = [
['Text Files', ['.txt', '.pl']],
['C Source Files', '.c', 'TEXT'],
['doc 文档', '.doc' ],
['Audio Files', ['.wav', '.mp3']],
['Image Files', ['.jpeg', '.gif']],
['All Files', '*', ],
];

my $file=$mw->getOpenFile(-title=>"选择附件",-filetypes=>$types);
if($file eq ""){
$message="没有选择附件!\n";
show_message($message);
}
else{
$file_list->insert('end',$file);
$message="打开文件 :$file 成功!\n";
show_message($message);
}
}

sub clear_info{
$mail_receiver->delete('0','end');
$smtp_server->delete('0','end');
$user_in_server->delete('0','end');
$password_in_server->delete('0','end');
$subject_to_mail->delete('0','end');
$text_to_mail->delete('1.0','end');
$file_list->delete('0','end');
$text_report->delete('1.0','end');
}