用 Delphi 做个发信机

最新推荐文章于 2024-09-23 16:59:13 发布

dreamfound

最新推荐文章于 2024-09-23 16:59:13 发布

阅读量663

点赞数

文章标签： delphi button 邮件服务器 integer 服务器 string

本文链接：https://blog.csdn.net/dreamfound/article/details/7480

版权

hai,大家好，我是梦寻，说来这应算是我的第二次发帖了，这回小梦给大家带来的是一个发信机，不知大家喜不喜欢。如果不满意的话，不要紧，您就狠狠的训梦寻一顿。Ok,如果您认为还可以的话请别忘了投梦寻一票哦,小梦先在这说声谢谢了。^_^

ok,还是那句老话，转入正题，现在我们就来做一个发信机。

首先我们应在工程中加入以下元件。

组件名 caption          关联的组件
Label1 邮件服务器地址：    Edit1
Label2 帐号名：           Edit2
Label3 端口号：           Edit3
Label4 收信群体服务器地址：Edit4
Label5 收信者名称：       ComboBox1
Label6 信件主题信息：     Edit5
Label7 所要发送信件：     Edit6
Label8 信件附件路径：     ListBox1
Label9 发信显示的信息名： Edit8
Label10 发信人 Email 地址：Edit9
CheckBox1 穷举式发信
Button1 开始发信
Button2 读入字典文件
Button3 ...               Edit6
Button4 增加/             ListBox
Button5 清除              ListBox
Panel1
Panel2
StatusBar1
OpenDialog1
NMSMTP1
ListBox1

好的，当我们加完了以上所有的组件后，并编好位置后，接下来我们就可以把以下代码以覆盖的形式拷入Delphi 的代码编辑栏中。

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Psock, NMsmtp, ExtCtrls, ComCtrls;

type
TForm1 = class(TForm)
    NMSMTP1: TNMSMTP;
    Panel1: TPanel;
    Label9: TLabel;
    Edit8: TEdit;
    Edit9: TEdit;
    Label10: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Edit6: TEdit;
    Edit5: TEdit;
    Button3: TButton;
    Button4: TButton;
    Panel2: TPanel;
    Label1: TLabel;
    Label4: TLabel;
    Edit4: TEdit;
    ComboBox1: TComboBox;
    Button1: TButton;
    Button2: TButton;
    CheckBox1: TCheckBox;
    Label5: TLabel;
    Edit2: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    Edit3: TEdit;
    StatusBar1: TStatusBar;
    OpenDialog1: TOpenDialog;
    ListBox1: TListBox;
    Edit1: TEdit;
    Button5: TButton;
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure NMSMTP1Success(Sender: TObject);
    procedure NMSMTP1Failure(Sender: TObject);
    procedure SendNextmail(var datteinc:integer);
    procedure Button1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure NMSMTP1ConnectionFailed(Sender: TObject);
    procedure NMSMTP1ConnectionRequired(var Handled: Boolean);
    procedure NMSMTP1InvalidHost(var Handled: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Edit8KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Edit9KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Edit6KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Edit5KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Edit2KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Edit4KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ComboBox1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure helpshow;
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
private
    { Private declarations }
public
    { Public declarations }
end;

var
Form1: TForm1;
sendsuc,sendfal,cursennum,totaco:integer;
connal,startsen:boolean;
implementation

{$R *.DFM}
procedure TForm1.helpshow;
begin
showmessage(
#13+'┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓'+#13+
'┃ 在使用本发信机发信时，应先作完以下几项:                     ┃'+#13+
'┣━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┫'+#13+
'┃    1 在收信地址栏中输入收信群体的地址                        ┃'+#13+
'┃      例:收信体为 xxx@yyy.nnn 则应在其中填入:yyy.nnn          ┃'+#13+
'┃                                                              ┃'+#13+
'┃    2 由于本发信机仅是个范例故而不具备有穷举发信功能，因此您应┃'+#13+
'┃      在收信栏中手动输入收信者名或读入一字典文件，格式举例如下┃'+#13+
'┃      例,发给 xx1、xx2   则每输完一个，按回车键一次)          ┃'+#13+
'┃                                                              ┃'+#13+
'┣━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┫'+#13+
'┃    本发信机仅做为一个范例，如果您用它来做一些不合法的事情， ┃'+#13+
'┃ 一切后果自行负责.                                            ┃'+#13+
'┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛'+#13+
'      Copy(R)ight by hhq,2001.02.07     HomePage:www.suye.8u8.com');
end;

procedure TForm1.SendNextmail(var datteinc:integer);
begin
if ComboBox1.Items.Count>cursennum then
   begin
   inc(datteinc);
   statusbar1.Panels[0].Text:='总发送了('+inttostr(sendsuc+sendfal)+')次';
   statusbar1.Panels[1].Text:='成功发送('+inttostr(sendsuc)+')封';
   statusbar1.Panels[2].text:='当前正发送:'+combobox1.Items.Strings[cursennum]+'@'+edit4.Text;
   ComboBox1.text:=ComboBox1.items.strings[cursennum];
   inc(cursennum);
   NMSMTP1.PostMessage.Attachments.AddStrings(listbox1.Items);
   NMSMTP1.PostMessage.ToAddress.Add(combobox1.Items.Strings[cursennum]+'@'+edit4.Text);
   NMSMTP1.SendMail;
   end else
   begin
   startsen:=false;
   button1.Caption:='开始发信';
   showmessage('请读入新发信进程以便进行信件发送。'+#13+'       (按 F1 键可获得帮助信息)');
   edit1.Enabled:=true;
   edit2.Enabled:=true;
   edit3.Enabled:=true;
   edit4.Enabled:=true;
   combobox1.Enabled:=true;
   button2.Enabled:=true;
   button1.Enabled:=false;
   edit4.SetFocus;
   end;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
if opendialog1.Execute then
    begin
    edit6.text:=opendialog1.FileName;
    NMSMTP1.PostMessage.Body.LoadFromFile(edit6.text);
    end;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
if opendialog1.Execute then
begin
ListBox1.Items.Add(opendialog1.filename);
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if opendialog1.Execute then
begin
button1.Caption:='开始发信';
button1.Enabled:=true;
startsen:=false;
sendsuc:=0;
sendfal:=0;
cursennum:=0;
ComboBox1.Items.LoadFromFile(opendialog1.FileName);
ComboBox1.text:=ComboBox1.items.strings[0];
totaco:=combobox1.Items.Count;
statusbar1.Panels[3].text:='总共('+inttostr(totaco)+')封';
end
else
   begin
   showmessage('由于您未选择字典文件，因此请您在收信栏中手工填加。');
   combobox1.SetFocus;
   end;
end;

procedure TForm1.NMSMTP1Success(Sender: TObject);
begin
if startsen then SendNextmail(sendsuc);
end;

procedure TForm1.NMSMTP1Failure(Sender: TObject);
begin
if startsen then SendNextmail(sendfal);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if edit4.text='' then
begin
showmessage('请在收信服务器栏中填入收信群体的服务器'+#13+
              ' 例如:要寄到 xxx@yyy.nnn 则填入 yyy.nnn');
edit4.SetFocus;
end
   else
    if combobox1.text='' then
    begin
    showmessage('请读入地址字典文件。');
    button2.SetFocus;
    button2.Click;
    end
else
begin
if startsen then
   begin
     startsen:=false;
     button1.Caption:='继续发信';
     edit1.Enabled:=true;
     edit2.Enabled:=true;
     edit3.Enabled:=true;
     edit4.Enabled:=true;
     combobox1.Enabled:=true;
     button2.Enabled:=true;
     end
    else
      begin
      edit1.Enabled:=false;
      edit2.Enabled:=false;
      edit3.Enabled:=false;
      edit4.Enabled:=false;
      combobox1.Enabled:=false;
      button2.Enabled:=false;
      startsen:=true;
      NMSMTP1.Host := Edit1.Text;
      NMSMTP1.Port := StrToInt(Edit3.Text);
      NMSMTP1.UserID := Edit2.Text;
     button1.Caption:='暂停发信';
{if not connal then
begin
NMSMTP1.Connect;
connal:=true;
showmessage('yes');
end;}
NMSMTP1.PostMessage.FromAddress := Edit9.Text;
NMSMTP1.PostMessage.FromName := Edit8.Text;
NMSMTP1.PostMessage.Subject := Edit5.Text;
SendNextmail(sendsuc);
end;
end;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
NMSMTP1.Abort;
end;

procedure TForm1.NMSMTP1ConnectionFailed(Sender: TObject);
begin
ShowMessage('连接失败');
connal:=false;;
end;

procedure TForm1.NMSMTP1ConnectionRequired(var Handled: Boolean);
begin
If MessageDlg('您还未连线是否进行连接', mtConfirmation, mbOkCancel, 0) = mrOk then
Begin
Handled := TRUE;
NMSMTP1.Connect;
End;

end;

procedure TForm1.NMSMTP1InvalidHost(var Handled: Boolean);
var
tmpstr:string;
begin
If InputQuery('输入邮件服务器地址!', '请输入邮件服务器地址:',tmpstr) then
Begin
    NMSMTP1.Host := tmpstr;
    edit1.text:=tmpstr;
    Handled := TRUE;
End;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
connal:=false;
startsen:=false;
end;

procedure TForm1.Edit1Change(Sender: TObject);
var
tmpstr:string;
begin
tmpstr:=edit1.text;
NMSMTP1.Host := tmpstr;
end;
procedure TForm1.Edit2Change(Sender: TObject);
begin
NMSMTP1.UserID := Edit2.Text;
end;

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

procedure TForm1.Edit8KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=vk_return then edit9.SetFocus;
end;

procedure TForm1.Edit9KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=vk_return then edit5.SetFocus;
end;

procedure TForm1.Edit6KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=vk_return then edit1.SetFocus;
end;

procedure TForm1.Edit5KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=vk_return then button3.SetFocus;
end;

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=vk_return then edit2.SetFocus;

end;

procedure TForm1.Edit2KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=vk_return then edit4.SetFocus;
end;

procedure TForm1.Edit4KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (key=vk_return)then if (combobox1.Items.Count=0) then button2.SetFocus else button1.setfocus;
end;

procedure TForm1.ComboBox1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (key=vk_return) and (comboBox1.Text<>'') then
begin
ComboBox1.Items.Add(ComboBox1.text);
ComboBox1.text:='';
totaco:=combobox1.Items.Count;
statusbar1.Panels[3].text:='总共('+inttostr(totaco)+')封';
end;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=vk_f1 then form1.helpshow;
end;

end.

好了，完成以上几步后，接下来我们只要为各个组件联系到各自所对应的事件，那吗我们用 Delphi 所做的发信机也就几呼完成了。当然您也可以对它进行修改，以让它更符合您的口味。虽然步骤多了点，不过至少我们做出了自己的一个发信机。

最后偷偷的告诉您一下，您想偷懒吗，如果是，那吗，嘿嘿…，那就..

快找小梦要完整的程序代码，可要快哦，不然小梦过几天就跑掉了哦。小梦的伊妹儿是:su_ye@163.net，主页 www.suye.8u8.com