mrfsyj.pas

Delphi数据库开发系统例子

unit MRFSYJ;

interface

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

type
  TFRM_FSYJ = class(TForm)
    Panel1: TPanel;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    ComboBox1: TComboBox;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    Label8: TLabel;
    Edit7: TEdit;
    Button1: TButton;
    Memo1: TMemo;
    Label9: TLabel;
    Button2: TButton;
    Button3: TButton;
    OpenDialog1: TOpenDialog;
    IdSMTP1: TIdSMTP;
    IdMessage1: TIdMessage;
    Edit3: TEdit;
    procedure FormShow(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Edit2KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Edit3KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Edit4KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Edit5KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Edit6KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FRM_FSYJ: TFRM_FSYJ;

implementation
  USES DATA;
{$R *.dfm}

procedure TFRM_FSYJ.FormShow(Sender: TObject);
var
  ini : Tinifile;
  ssp : string;
begin
  ssp := '发送邮件';
  ini:=Tinifile.Create('c:\cc.ini');
  ini.WriteString('one',datetimetostr(now),ssp);
  ini.Free;
  edit1.Clear;
  edit2.Clear;
  edit3.Clear;
  edit4.Clear;
  edit5.Clear;
  edit6.Clear;
  edit7.Clear;
  combobox1.Clear;
  memo1.Clear;

  with database.ADO_bb do
  begin
    close;
    sql.Clear;
    sql.Add('select * from tb_Client_lxrxx');
    open;
  end;
  if database.ADO_bb.RecordCount>0 then
  begin
    while not database.ADO_bb.Eof do
    begin
      combobox1.Items.Add(database.ADO_bb.fieldbyname('lxrxx_xm').AsString);
      database.ADO_bb.Next;
    end;
  end;
end;

procedure TFRM_FSYJ.ComboBox1Change(Sender: TObject);
begin
  with database.ADO_bb do
  begin
    close;
    sql.Clear;
    sql.Add('select * from tb_Client_lxrxx where lxrxx_xm='+''''+trim(combobox1.Text)+'''');
    open;
  end;
  edit4.Text := database.ADO_bb.fieldbyname('lxrxx_Email').AsString;
  edit1.SetFocus;
end;

procedure TFRM_FSYJ.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  a1,a2,i : integer;
  strmm : string;
begin
  i := 0;
  if (key = vk_return)and(edit1.Text <> '') then
  begin
    strmm := edit1.Text;
    a1 := length(edit1.Text);
    while strmm[i] <> '@' do
    begin
      i := i+1;
    end;
    edit6.Text := 'SMTP.'+copy(trim(edit1.Text),i+1,a1-i);
    edit2.SetFocus;
    

  end;
end;

procedure TFRM_FSYJ.Edit2KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (key = vk_return)and(edit2.Text <> '') then
    edit3.SetFocus;
end;

procedure TFRM_FSYJ.Edit3KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (key = vk_return)and(edit3.Text <> '') then
  begin
    if edit4.Text = '' then
      edit4.SetFocus
    else
      edit5.SetFocus;
  end;
end;

procedure TFRM_FSYJ.Edit4KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (key = vk_return)and(edit4.Text <> '') then
    edit5.SetFocus;
end;

procedure TFRM_FSYJ.Edit5KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (key = vk_return)and(edit5.Text <> '') then
    Button2.SetFocus;
end;

procedure TFRM_FSYJ.Edit6KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (key = vk_return)and(edit6.Text <> '') then
    edit7.SetFocus;
end;

procedure TFRM_FSYJ.Button1Click(Sender: TObject);
begin
  if opendialog1.Execute then
    self.Edit7.Text := opendialog1.FileName
  else
  begin
    self.Edit7.Text := '';
    showmessage('还没有附件。');
  end;
end;

procedure TFRM_FSYJ.Button2Click(Sender: TObject);
begin
  if (edit1.Text = '')or(edit2.Text = '')or(edit3.Text = '')
      or(edit4.Text = '')or(edit5.Text = '')or(edit6.Text = '')
      or(edit7.Text = '') then
  begin
    showmessage('请添写全部信息。');
  end
  else
  begin
     self.IdMessage1.Clear;
     self.IdMessage1.From.Text := edit1.Text;
     self.IdMessage1.Recipients.EMailAddresses := edit4.Text;
     self.IdMessage1.Body.Assign(memo1.Lines);
     self.IdMessage1.Subject := edit5.Text;
     if edit7.Text <> '' then
       Tidattachment.Create(idmessage1.MessageParts,edit7.Text);
     self.IdSMTP1.AuthenticationType := atlogin;
     self.IdSMTP1.Username := edit2.Text;
     self.IdSMTP1.Password := edit3.Text;
     self.IdSMTP1.Host := edit6.Text;
     try
       self.IdSMTP1.Connect();
       try
       self.IdSMTP1.Send(idmessage1);
       showmessage('E-mail已发送成功。');

       finally
       self.IdSMTP1.Disconnect;
       end;
     except
       on e:exception do
       begin
         showmessage('E-mail发送失败：'+E.Message);
       end;
     end;
  end;
end;

procedure TFRM_FSYJ.Button3Click(Sender: TObject);
begin
  if (edit1.Text = '')or(edit2.Text = '')or(edit3.Text = '')
      or(edit5.Text = '')or(edit6.Text = '')or(edit7.Text = '') then
  begin
    showmessage('请添写除收件人地址以外的全部信息。');
  end
  else
  begin
    with database.ADO_bb do
    begin
      close;
      sql.Clear;
      sql.Add('select * from tb_Client_lxrxx');
      open;
    end;
    if database.ADO_bb.RecordCount>0 then
    begin
      while not database.ADO_bb.Eof do
      begin
         edit4.Text := database.ADO_bb.fieldbyname('lxrxx_Email').AsString;
         self.IdMessage1.Clear;
         self.IdMessage1.From.Text := edit1.Text;
         self.IdMessage1.Recipients.EMailAddresses := edit4.Text;
         self.IdMessage1.Body.Assign(memo1.Lines);
         self.IdMessage1.Subject := edit5.Text;
         if edit7.Text <> '' then
           Tidattachment.Create(idmessage1.MessageParts,edit7.Text);
         self.IdSMTP1.AuthenticationType := atlogin;
         self.IdSMTP1.Username := edit2.Text;
         self.IdSMTP1.Password := edit3.Text;
         self.IdSMTP1.Host := edit6.Text;
         try
           self.IdSMTP1.Connect();
           try
           self.IdSMTP1.Send(idmessage1);
           finally
           self.IdSMTP1.Disconnect;
           end;
         except
           on e:exception do
           begin
             showmessage('E-mail发送失败：'+E.Message);
           end;
         end;
         database.ADO_bb.Next;
      end;
      showmessage('E-mail发送完成。');
    end;

  end;
end;

end.