From：http://hi.baidu.com/farmerluo/blog/item/41dc92589bc3fdd99d820407.html

!/usr/bin/perl -w

requirement:

rpm -ivh http://dag.wieers.com/rpm/packages/rpmforge-release/rpmforge-release-0.3.6-1.el5.rf.i386.rpm

yum -y install perl-Authen-SASL perl-MIME-Base64 perl-DBI

脚本功能: 邮件群发脚本

作者: Luo Hui(farm[separator]er.luo at gmail.com)

最后时间: 2008.12.05

版本：Ver 0.3

版本历史：

0.3(2008.12.05):1)更新发送机制，更新为每发次一封邮件重新连一次SMTP服务器

0.2(2008.12.02):1)更新由脚本自动到数据库内取邮件地址,不再从文件文件中取.

2)邮件内容文件由脚本参数设定，方便使用

0.1(2008.12.01):1)初始版本

[separator]
use strict;
use warnings;
use DBI();
use File::Basename;
use MIME::Base64;
use Net::SMTP;

发送服务器

my $smtp_server = ‘mail.test.com’;

认证用户名

my $username = ‘service@test.com’;

认证密码

my $password = ‘test’;

发件人

my $from_mail = ‘service@test.com’;

查询邮件地址的sql语句

my $strsql = “SELECT email FROM uc_members “;

邮件主题

my $subject = encode_base64( ‘每日内容精选’, “” );

my $argvnum = @ARGV;
die “Usage:\n” , basename( $0 ) , ” Mail Body File \n” unless ( $argvnum >= 1 );

my $mailfile = $ARGV[0];

if ( ! -e $mailfile ) {
print “mail body file no exists!\n”;
exit(1);
}

连接数据库的资料可在这改

my $dbh = DBI->connect( “DBI:mysql:database=ucenter;host=10.1.1.1”,
“root”, “test”,
{‘RaiseError’ => 1} );

my $sth = $dbh->prepare( $strsql );
$sth->execute();
my $email = $sth->fetchall_arrayref or die “$sth->errstr\n”;
$sth->finish();

my ( $i, @to_mails );

for $i ( 0 .. $#{$email} ) {
#print $email->[$i][0];
push( @to_mails , $email->[$i][0] );
}

open(FHMF, $mailfile) or die “$!”;
local($/) = undef;
my $mail_body = ;
close( FHMF );
$/ = “\n”;

$mail_body = encode_base64( $mail_body );

$i = 0;
foreach my $to_mail( @to_mails )
{
my $smtp = Net::SMTP -> new( Host => $smtp_server,
# Debug => 1,
Hello => $smtp_server,
) || die “Can’t connect $smtp_server $!\n”;

$smtp -> auth( $username, $password ) || die “Can’t authenticate: $!\n”;

chomp($to_mail);
$smtp -> mail( $from_mail );
$smtp -> to( $to_mail );
$smtp -> data( );

# send mail head
$smtp -> datasend( “From: $from_mail\n” );
$smtp -> datasend( “To: $to_mail\n” );
$smtp -> datasend( “MIME-Version: 1.0 \n” );
$smtp -> datasend( “Content-Type: text/html; charset=gb2312 \n” );
$smtp -> datasend( “Content-Transfer-Encoding: base64\n” );
$smtp -> datasend( “Subject: =?gb2312?B?$subject?=\n\n”);

# send mail body
$smtp -> datasend( $mail_body );
$smtp -> dataend();

$i++;
print “send mail:$i mail to:$to_mail\n”;

$smtp -> quit();
}

最后编辑： selboo 编辑于2010/10/29 11:46

转载请注明：爱开源 » perl邮件群发脚本(V0.3版)