邮件发送程序调试出错,帮忙看看!
caishengyin
|
1#
发表于 2005-05-24 20:32
|
caishengyin
|
1#
caishengyin 发表于 2005-05-24 20:32
邮件发送程序调试出错,帮忙看看!
邮件发送程序调试出错,帮忙看看!
作者提供的相关的附件(大小: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 源程序在附件里 |
caishengyin
|
2#
caishengyin 发表于 2005-05-26 16:32
程序代码
#!/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'); } |