【delphi开源代码栏目提醒】:网学会员为广大网友收集整理了，MRFSYJ.pas，希望对大家有所帮助！

    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.
    

上一篇：MRFK_ZCX.pas
下一篇：临床前药物安全性评价中毒性病理学新技术的应用