unit1.pas

值得学习开发的一些例子..............

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, IdMessage, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP, ComCtrls, Menus, IniFiles;

type
  TForm1 = class(TForm)
    IdSMTP1: TIdSMTP;
    IdMessage1: TIdMessage;
    ListBox1: TListBox;
    le_title: TLabeledEdit;
    me_content: TMemo;
    Label1: TLabel;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    le_smtp: TLabeledEdit;
    le_user: TLabeledEdit;
    le_email: TLabeledEdit;
    le_port: TLabeledEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    StatusBar1: TStatusBar;
    Button6: TButton;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    le_pass: TLabeledEdit;
    cb_authentication: TCheckBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    function SendEmail(aAddr: string): boolean;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  if not OpenDialog1.Execute then Exit; //如果没有选择文件则退出
  ListBox1.Items.LoadFromFile(OpenDialog1.FileName);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if ListBox1.Items.Count = 0 then exit;
  if SaveDialog1.Execute then //选择了保存文件
    ListBox1.Items.SaveToFile(SaveDialog1.FileName);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin //保存配置
  with TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'comm.ini') do
  begin
    WriteString('comm', 'smtp', le_smtp.Text);
    WriteString('comm', 'port', le_port.Text);
    WriteString('comm', 'user', le_user.Text);
    WriteString('comm', 'pass', le_pass.Text);
    WriteString('comm', 'email', le_email.Text);
    WriteBool('comm', 'pass', cb_authentication.Checked);
  end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin //读取配置
  with TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'comm.ini') do
  begin
    le_smtp.Text := ReadString('comm', 'smtp', 'smtp.163.com');
    le_port.Text := ReadString('comm', 'port', '25');
    le_user.Text := ReadString('comm', 'user', '');
    le_pass.Text := ReadString('comm', 'pass', '');
    le_email.Text := ReadString('comm', 'email', '');
    cb_authentication.Checked := ReadBool('comm', 'pass', False);
  end;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if Tag = 0 then
    CanClose := True else
  begin //正在发送状态不能退出程序
    CanClose := False;
    ShowMessage('请先中断发送');
  end;
end;

procedure TForm1.N1Click(Sender: TObject);
var
  s: string;
begin
  s := InputBox('输入对话框', '请输入邮件地址：', '@');
  if (Length(s) > 5) and (Pos('@', s) < Pos('.', s)) then
    ListBox1.Items.Add(s);
end;

procedure TForm1.N2Click(Sender: TObject);
begin
  ListBox1.DeleteSelected;
end;

procedure TForm1.N3Click(Sender: TObject);
begin
  ListBox1.Clear;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  Tag := 0; //用Form1的Tag属性作为发送中断的标志可以省一个全局变量
end;

function TForm1.SendEmail(aAddr: string): boolean;
begin
  IdMessage1.Body.Assign(me_content.Lines);
  IdMessage1.From.Text := le_email.Text;
  IdMessage1.ReplyTo.EMailAddresses := le_email.Text;
  IdMessage1.Recipients.EMailAddresses := aAddr;
  IdMessage1.Subject := le_title.Text;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  i: integer;
begin
  if ListBox1.Items.Count = 0 then
  begin
    showmessage('发送列表为空，群发失败！');
    exit;
  end;
  if me_content.Text = '' then
  begin
    showmessage('输入邮件内容！');
    exit;
  end;

  Button3.Enabled := False;
  if cb_authentication.Checked then //服务器验证
  begin
    IdSMTP1.AuthenticationType := atLogin;
    IdSMTP1.Username := le_user.Text;
    IdSMTP1.Password := le_pass.Text;
  end else
  begin
    IdSMTP1.AuthenticationType := atNone;
  end;
  IdSMTP1.Host := le_smtp.Text;
  IdSMTP1.Port := StrToIntDef(le_port.Text, 25); //如果转换错误默认25

  IdSMTP1.Connect; //连接
  try
    Tag := 1; //设置中断标志
    for i := 0 to ListBox1.Items.Count - 1 do
    begin //循环发送
      if Tag = 0 then exit; //如果中断则退出群发
      SendEmail(ListBox1.Items.Strings[i]);
      IdSMTP1.Send(IdMessage1);
      ListBox1.ItemIndex := i;
      StatusBar1.SimpleText := Format('正在发送... (%d/%d) %s', [i, ListBox1.Items.Count - 1, ListBox1.Items.Strings[i]]);
      Application.ProcessMessages;
    end;
  finally
    Tag := 0;
    IdSMTP1.Disconnect;
    Button3.Enabled := True;
  end;
  StatusBar1.SimpleText := '发送完成...';
end;

end.