正在加载...

perl邮件群发脚本(V0.3版)

[ 2010/08/13 12:00 | by selboo ]

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 = <FHMF>;
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
Tags: , ,
,
发表评论
表情
打开HTML
打开UBB
打开表情
隐藏
记住我
昵称   密码   游客无需密码
网址   电邮   [注册]