Delphi - Indy 创建邮件自动发送服务

服务器自动邮件线程

功能：此程序主要实现对Oracle数据库表tableName（存放需要发送邮件的相关信息）里面相关信息的邮件发送。

优点：开发人员可以直接再数据库后台对tableName表进行插入操作，前台会自动发送相关邮件，高效开发。

界面布局：

代码实现如下：

  1 unit uSendMail;
  2 
  3 interface
  4 
  5 uses
  6     Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7     Dialogs, ExtCtrls, DB, DBAccess, Ora, MemDS, RzButton, StdCtrls, RzPanel,
  8     RzLabel, RzCmboBx, IdComponent, IdTCPConnection, IdTCPClient,
  9     IdMessageClient, IdSMTP, IdBaseComponent, IdMessage, RzEdit, Mask, RzTabs;
 10 
 11 type
 12     TForm1 = class(TForm)
 13         RzPanel1: TRzPanel;
 14         Memo1: TMemo;
 15         Btn_Start: TRzBitBtn;
 16         Btn_Finish: TRzBitBtn;
 17         SEND_MAIL: TOraStoredProc;
 18         Qry_GetMail: TOraQuery;
 19         OraSession_sendmail: TOraSession;
 20         tmr1: TTimer;
 21         RzBitBtn1: TRzBitBtn;
 22         RzLabel1: TRzLabel;
 23         OraQuery1: TOraQuery;
 24         RzComboBox1: TRzComboBox;
 25         RzLabel2: TRzLabel;
 26         RzLabel3: TRzLabel;
 27         RzPageControl1: TRzPageControl;
 28         RzTabSheetTabSheet1: TRzTabSheet;
 29         rzgrpbxPl_to: TRzGroupBox;
 30         TRzLabelDis_to: TRzLabel;
 31         TRzLabelDis_attach: TRzLabel;
 32         TRzLabelDis_sub: TRzLabel;
 33         TRzLabelDis_cc: TRzLabel;
 34         TRzLabelDis_body: TRzLabel;
 35         rz_attach: TRzEdit;
 36         Rz_body: TRzMemo;
 37         TRzBitBtn_send: TRzBitBtn;
 38         TRzBitBtn_open: TRzBitBtn;
 39         Rz_to: TRzMemo;
 40         Rz_cc: TRzMemo;
 41         Rz_sub: TRzMemo;
 42         rzgrpbxPl_from: TRzGroupBox;
 43         TRzLabelDis_from: TRzLabel;
 44         TRzLabelDis_server: TRzLabel;
 45         TRzLabelDis_password: TRzLabel;
 46         rz_from: TRzEdit;
 47         rz_server: TRzEdit;
 48         rz_password: TRzEdit;
 49         IdMsgSend: TIdMessage;
 50         SMTP: TIdSMTP;
 51         RzTabSheetTabSheet3: TRzTabSheet;
 52         procedure Btn_StartClick(Sender: TObject);
 53         procedure Btn_FinishClick(Sender: TObject);
 54         procedure tmr1Timer(Sender: TObject);
 55         procedure FormCreate(Sender: TObject);
 56         procedure RzBitBtn1Click(Sender: TObject);
 57         procedure TRzBitBtn_sendClick(Sender: TObject);
 58     private
 59         { Private declarations }
 60     public
 61         { Public declarations }
 62     end;
 63 
 64 var
 65     Form1: TForm1;
 66 
 67 implementation
 68 
 69 {$R *.dfm}
 70 
 71 procedure TForm1.Btn_StartClick(Sender: TObject);
 72 begin
 73     OraSession_sendmail.Connected := True;
 74     tmr1.Enabled := True;
 75     Btn_Start.Enabled := False;
 76     Btn_Start.Caption := '运行中';
 77 end;
 78 
 79 procedure TForm1.Btn_FinishClick(Sender: TObject);
 80 begin
 81     tmr1.Enabled := False;
 82     Btn_Start.Enabled := True;
 83     Btn_Start.Caption := '启动';
 84     OraSession_sendmail.Connected := False;
 85 end;
 86 
 87 procedure TForm1.tmr1Timer(Sender: TObject);
 88 begin
 89     Qry_GetMail.Close;
 90     Qry_GetMail.SQL.Text := 'select t.* from tableName t where sended =0 and rownum=1';
 91     Qry_GetMail.Open;
 92     if Qry_GetMail.RecordCount > 0 then
 93     begin
 94         Memo1.Text := Memo1.Text + chr(13) + chr(10) + '邮件发送中...' + DateTimeToStr(Now);
 95         //tmr1.Enabled := false;
 96         Rz_to.Text := Qry_GetMail.FieldByName('receiver').AsString;
 97         Rz_sub.Text := Qry_GetMail.FieldByName('sub').AsString;
 98         Rz_body.Text := Qry_GetMail.FieldByName('txt').AsString;
 99         TRzBitBtn_send.Click;
100         OraQuery1.SQL.Text := ' update tableName t set t.sended = 1, t.sendtime = sysdate where t.sysid = :sysid';
101         OraQuery1.ParamByName('sysid').AsString := Qry_GetMail.FieldByName('sysid').AsString;
102         OraQuery1.ExecSQL;
103         Memo1.Text := Memo1.Text + chr(13) + chr(10) + '成功发送邮件！' + DateTimeToStr(Now);
104        // tmr1.Enabled := True;
105     end;
106 end;
107 
108 procedure TForm1.FormCreate(Sender: TObject);
109 begin
110     Btn_Start.Click;
111 end;
112 
113 procedure TForm1.RzBitBtn1Click(Sender: TObject);
114 begin
115     if RzComboBox1.Text = '' then
116     begin
117         ShowMessage('请选择重发时间段！');
118         Exit;
119     end;
120     if RzComboBox1.Text = '6' then
121     begin
122         OraQuery1.Close;
123         OraQuery1.SQL.Text := 'update tableName t set t.sended=0 where t.inserttime>sysdate-1/24*6';
124         OraQuery1.ExecSQL;
125     end;
126     if RzComboBox1.Text = '12' then
127     begin
128         OraQuery1.Close;
129         OraQuery1.SQL.Text := 'update tableName t set t.sended=0 where t.inserttime>sysdate-1/24*12';
130         OraQuery1.ExecSQL;
131     end;
132     if RzComboBox1.Text = '18' then
133     begin
134         OraQuery1.Close;
135         OraQuery1.SQL.Text := 'update tableName t set t.sended=0 where t.inserttime>sysdate-1/24*18';
136         OraQuery1.ExecSQL;
137     end;
138     if RzComboBox1.Text = '24' then
139     begin
140         OraQuery1.Close;
141         OraQuery1.SQL.Text := 'update tableName t set t.sended=0 where t.inserttime>sysdate-1/24*24';
142         OraQuery1.ExecSQL;
143     end;
144     if RzComboBox1.Text = '36' then
145     begin
146         OraQuery1.Close;
147         OraQuery1.SQL.Text := 'update tableName t set t.sended=0 where t.inserttime>sysdate-1/24*36';
148         OraQuery1.ExecSQL;
149     end;
150     if RzComboBox1.Text = '48' then
151     begin
152         OraQuery1.Close;
153         OraQuery1.SQL.Text := 'update tableName t set t.sended=0 where t.inserttime>sysdate-1/24*48';
154         OraQuery1.ExecSQL;
155     end;
156     ShowMessage('重发成功，请勿多点！');
157 end;
158 
159 procedure TForm1.TRzBitBtn_sendClick(Sender: TObject);
160 begin
161     IdMsgSend.Clear;
162   //  TIdAttachment.Create(IdMsgSend.MessageParts, Rz_attach.Text);
163     with IdMsgSend do
164     begin
165         if Rz_body.Text = '' then Rz_body.Text := Rz_sub.Text;
166         Body.Assign(Rz_body.Lines);
167         From.Text := Rz_from.Text;
168         Recipients.EMailAddresses := Rz_to.Text; { 发送到： }
169         Subject := Rz_sub.Text; { Subject: header }
170         Priority := TIdMessagePriority(4); { Message Priority }
171         CCList.EMailAddresses := Rz_cc.Text; {CC}
172         BccList.EMailAddresses := ''; {BBC}
173         ReceiptRecipient.Text := ''; //需要回复
174     end;
175     SMTP.AuthenticationType := atLogin;
176     SMTP.Username := Rz_from.Text; //发送人
177     SMTP.Password := Rz_password.Text; //密码
178     SMTP.Host := Rz_server.Text; //服务器
179     SMTP.Port := 25;
180     SMTP.Connect;
181     try
182         SMTP.Send(IdMsgSend);
183     finally
184         SMTP.Disconnect;
185     end;
186 end;
187 
188 end.

 

转载于:https://www.cnblogs.com/jeremywucnblog/p/11427747.html