main.pas

邮件群发源码

{邮件群发系统 v1.2
 作者: 于志强
 Email: [e-mail]
 msn: [e-mail]
 QQ: 15693996 (验证：delphi)
 需要指定SMTP服务器.
 目前还没找到不需要SMTP服务器的方法，望哪位大侠可以告知;
 您可以任意修改此软件，如果您对此软件有修改，希望能给我发一份。
}
unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, RzEdit, Mask, ExtCtrls, RzPanel, RzTabs, RzButton,
  ComCtrls, RzListVw, ImgList, RzPrgres, RzRadChk, IdComponent,
  IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP, IdBaseComponent,
  IdMessage, RzLstBox, XPMan, IniFiles, IdEmailAddress;

type
  TfrmMain = class(TForm)
    RzPageControl1: TRzPageControl;
    TabSheet1: TRzTabSheet;
    TabSheet2: TRzTabSheet;
    RzGroupBox1: TRzGroupBox;
    Label1: TLabel;
    Edit1: TRzEdit;
    Label2: TLabel;
    Edit2: TRzEdit;
    Label3: TLabel;
    Edit3: TRzEdit;
    RzGroupBox2: TRzGroupBox;
    Label4: TLabel;
    Edit4: TRzEdit;
    Label5: TLabel;
    Edit5: TRzEdit;
    RzMemo1: TRzMemo;
    RzPanel1: TRzPanel;
    RzPanel2: TRzPanel;
    RzToolbar1: TRzToolbar;
    RzToolButton1: TRzToolButton;
    RzToolButton2: TRzToolButton;
    RzToolButton3: TRzToolButton;
    ICOlist: TImageList;
    ListView1: TRzListView;
    RzSpacer2: TRzSpacer;
    RzToolButton4: TRzToolButton;
    RzToolButton5: TRzToolButton;
    RzToolButton9: TRzToolButton;
    RzSpacer1: TRzSpacer;
    RzToolButton6: TRzToolButton;
    RzToolButton7: TRzToolButton;
    RzToolButton8: TRzToolButton;
    Splitter1: TSplitter;
    RzPanel3: TRzPanel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    RzPanel4: TRzPanel;
    RzToolbar2: TRzToolbar;
    RzToolButton10: TRzToolButton;
    RzEdit6: TRzEdit;
    RzEdit7: TRzEdit;
    RzCheckBox1: TRzCheckBox;
    RzEdit8: TRzEdit;
    RzPanel5: TRzPanel;
    Label10: TLabel;
    MailMessage: TIdMessage;
    Mail: TIdSMTP;
    SaveDialog2: TSaveDialog;
    SaveDialog1: TSaveDialog;
    OpenDialog2: TOpenDialog;
    Label11: TLabel;
    RzEdit9: TRzEdit;
    RzMemo2: TRzMemo;
    RzBitBtn1: TRzBitBtn;
    RzBitBtn2: TRzBitBtn;
    RzPanel6: TRzPanel;
    Label12: TLabel;
    ListBox1: TRzListBox;
    RzBitBtn3: TRzBitBtn;
    RzBitBtn4: TRzBitBtn;
    TabSheet3: TRzTabSheet;
    OpenDialog1: TOpenDialog;
    Label13: TLabel;
    SuccessList: TRzMemo;
    Label14: TLabel;
    FailList: TRzMemo;
    ProgressBar1: TProgressBar;
    ImageList1: TImageList;
    Label15: TLabel;
    RzSpacer3: TRzSpacer;
    RzToolButton11: TRzToolButton;
    RzPanel7: TRzPanel;
    Label16: TLabel;
    RzBitBtn5: TRzBitBtn;
    RzBitBtn6: TRzBitBtn;
    RzBitBtn7: TRzBitBtn;
    RzBitBtn8: TRzBitBtn;
    RzBitBtn9: TRzBitBtn;
    RzBitBtn10: TRzBitBtn;
    Label17: TLabel;
    Label18: TLabel;
    TimerSend: TTimer;
    procedure RzBitBtn3Click(Sender: TObject);
    procedure RzBitBtn4Click(Sender: TObject);
    procedure RzBitBtn1Click(Sender: TObject);
    procedure RzBitBtn2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure RzToolButton1Click(Sender: TObject);
    procedure RzToolButton2Click(Sender: TObject);
    procedure RzToolButton3Click(Sender: TObject);
    procedure RzToolButton4Click(Sender: TObject);
    procedure RzToolButton5Click(Sender: TObject);
    procedure RzToolButton6Click(Sender: TObject);
    procedure RzToolButton7Click(Sender: TObject);
    procedure RzToolButton8Click(Sender: TObject);
    procedure RzToolButton9Click(Sender: TObject);
    procedure RzToolButton10Click(Sender: TObject);
    procedure RzToolButton11Click(Sender: TObject);
    procedure RzBitBtn5Click(Sender: TObject);
    procedure RzBitBtn6Click(Sender: TObject);
    procedure RzBitBtn7Click(Sender: TObject);
    procedure RzBitBtn8Click(Sender: TObject);
    procedure RzBitBtn9Click(Sender: TObject);
    procedure RzBitBtn10Click(Sender: TObject);
    procedure TimerSendTimer(Sender: TObject);
  private
    function TrimMessage(AMessage, AIdent, AEmail: string): string;
    function DigitalToTime(I: integer): string;
    { Private declarations }
  public
    { Public declarations }
    procedure SendEmail1;
    procedure SendEmail2;
    procedure SetAddrQty;
    procedure FillAddrList(AMemo: TRzMemo);
  end;

var
  frmMain: TfrmMain;
  iCount: integer;
implementation

uses AddEmail, PubUnit, ImportFromDB;

{$R *.dfm}

procedure TfrmMain.RzBitBtn3Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    TIdAttachment.Create(MailMessage.MessageParts, OpenDialog1.FileName);
    ListBox1.Items.Add(OpenDialog1.FileName);
  end;
end;

procedure TfrmMain.RzBitBtn4Click(Sender: TObject);
var
  I: integer;
begin
  ListBox1.DeleteSelected;
  MailMessage.MessageParts.Clear;
  for I := 0 to ListBox1.Items.Count - 1 do
  begin
     TIdAttachment.Create(MailMessage.MessageParts, ListBox1.Items[I]); 
  end;
end;
procedure TfrmMain.RzBitBtn1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    RzMemo2.Lines.LoadFromFile(OpenDialog1.FileName); 
end;

procedure TfrmMain.RzBitBtn2Click(Sender: TObject);
begin
  if SaveDialog2.Execute then
    RzMemo2.Lines.SaveToFile(SaveDialog2.FileName);
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
var
  Ini: TIniFile;
begin
  Ini := TIniFile.Create(ExtractFilePath(ParamStr(0))+'Setup.ini');
  try
    Ini.WriteString('SETUP', 'SMTP', Edit1.Text);
    Ini.WriteString('SETUP', 'USRNME', Edit2.Text);
    Ini.WriteString('SETUP', 'USRPWD', Edit3.Text);
    Ini.WriteString('SETUP', 'EMAIL', Edit4.Text);
    Ini.WriteString('SETUP', 'SENDER', Edit5.Text);
  finally
    Ini.Free;
  end;

end;


procedure TfrmMain.FormCreate(Sender: TObject);
var
  Ini: TIniFile;
begin
  Ini := TIniFile.Create(ExtractFilePath(ParamStr(0))+'Setup.ini');
  try
    Edit1.Text := Ini.ReadString('SETUP', 'SMTP', '');
    Edit2.Text := Ini.ReadString('SETUP','USRNME', '');
    Edit3.Text := Ini.ReadString('SETUP', 'USRPWD', '');
    Edit4.Text := Ini.ReadString('SETUP', 'EMAIL', '');
    Edit5.Text := Ini.ReadString('SETUP', 'SENDER', '');
  finally
    Ini.Free;
  end;

end;

procedure TfrmMain.RzToolButton1Click(Sender: TObject);
var
  AnItem: TListItem;
begin
  with TfrmAddEmail.Create(Application) do
  begin
    ShowModal;
    if ModalResult = mrOk then
    begin
      AnItem := ListView1.Items.Add;
      AnItem.Caption := PubUnit.NewUser;
      AnItem.SubItems.Add(PubUnit.NewMail);
      SetAddrQty;
    end;
  end;
end;

procedure TfrmMain.RzToolButton2Click(Sender: TObject);
var
  AnItem: TListItem;
begin
  if ListView1.SelCount = 1 then
  with TfrmAddEmail.Create(Application) do
  begin
    AnItem := ListView1.Selected;
    Edit1.Text := AnItem.Caption;
    Edit2.Text := AnItem.SubItems[0];
    ShowModal;
    if ModalResult = mrOK then
    begin
      AnItem.Caption := PubUnit.NewUser;
      AnItem.SubItems[0] := PubUnit.NewMail;
    end;
    SetAddrQty;
  end;
end;

procedure TfrmMain.RzToolButton3Click(Sender: TObject);
begin
  if ListView1.SelCount > 0 then
    if Application.MessageBox('是否删除选中的邮件地址！', '确认',
      MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2) = IDYES then
        ListView1.DeleteSelected;
        SetAddrQty;
end;

procedure TfrmMain.RzToolButton4Click(Sender: TObject);
var
  AList: TStringList;
  AnItem: TListItem;
  I, J: integer;
begin
  AList := TStringList.Create;
  try
    if OpenDialog2.Execute then
    begin
      AList.LoadFromFile(OpenDialog2.FileName);
      ListView1.Items.Clear;
      for I := 0 to AList.Count - 1 do
      begin
         if AnsiPos('<|>', AList[I]) > 0 then
         begin
           J := AnsiPos('<|>', AList[I]);
           AnItem := ListView1.Items.Add;
           AnItem.Caption := Copy(AList[I], 1, J - 1);
           AnItem.SubItems.Add(Copy(AList[I], J + 3, Length(AList[I])));
         end;
      end;
      SetAddrQty;
    end;
  finally
    AList.Free;
  end;
end;

procedure TfrmMain.RzToolButton5Click(Sender: TObject);
var
  AList: TStringList;
  I: integer;
  AnItem: TListItem;
begin
  if SaveDialog1.Execute then
  begin
    AList := TStringList.Create;
    try
      for I := 0 to ListView1.Items.Count - 1 do
      begin
        AnItem := ListView1.Items[I];
        AList.Add(AnItem.Caption + '<|>' + AnItem.SubItems[0]);
      end;
      AList.SaveToFile(SaveDialog1.FileName);
      SetAddrQty;
    finally
      AList.Free;
    end;
  end;
end;

procedure TfrmMain.RzToolButton6Click(Sender: TObject);
var
  I: integer;
begin
  for I := 0 to ListView1.Items.Count - 1 do
  begin
    ListView1.Items[I].Checked := True;
  end;
end;

procedure TfrmMain.RzToolButton7Click(Sender: TObject);
var
  I: integer;