CSDN博客

img dreamfound

用 Delphi 做个发信机

发表于2001/2/7 23:57:00  452人阅读

     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

0 0

相关博文

我的热门文章

img
取 消
img