⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit3.pas

📁 网络试验程序
💻 PAS
字号:
unit Unit3;

interface

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

type
  TForm3 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Image1: TImage;
    edtfrom: TEdit;
    edtto: TEdit;
    edtsubject: TEdit;
    memcoment: TMemo;
    edtattach: TEdit;
    Button1: TButton;
    edthost: TEdit;
    edtusername: TEdit;
    edtpsw: TEdit;
    Panel1: TPanel;
    SpeedButton1: TSpeedButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    StaticText1: TStaticText;
    OpenDialog1: TOpenDialog;
    IdSMTP1: TIdSMTP;
    IdMessage1: TIdMessage;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure edtattachMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure memcomentMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure edtfromMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure edttoMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure edtsubjectMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure edtusernameMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure edtpswMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure edthostMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Button3MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button2MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Button4MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Button1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure SpeedButton1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}
//发送邮件
procedure TForm3.Button2Click(Sender: TObject);
begin
  StaticText1.Caption := 'The letter is on sending.  Please wait ....    ' ;
  self.IdMessage1.Clear; //清除前一次邮件内容,以免重复发送
  self.IdMessage1.From.Text:=edtfrom.Text; //发件人
  self.IdMessage1.Recipients.EMailAddresses:=edtto.Text;//收件人
  self.IdMessage1.Body.Assign(memcoment.Lines);//邮件内容
  self.IdMessage1.Subject:=edtsubject.Text;//邮件主体
  if edtattach.Text<>'' then
  TIdAttachment.Create(IdMessage1.MessageParts, edtattach.Text);//附件
  self.IdSMTP1.AuthenticationType:=atlogin; //身分验证
  self.IdSMTP1.Username:=edtusername.Text; //用户名
  self.IdSMTP1.Password:=edtpsw.Text;//密码
  self.IdSMTP1.Host:=edthost.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;

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

procedure TForm3.edtattachMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
    StaticText1.Caption := '选择添加附件的 URL 路径。  ' ;
end;

procedure TForm3.memcomentMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
    StaticText1.Caption := '请在这里输入信件内容。' ;
end;

procedure TForm3.edtfromMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
    StaticText1.Caption := '请添加发件人地址....' ;
end;

procedure TForm3.edttoMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
    StaticText1.Caption := '请添加收件人地址....' ;
end;

procedure TForm3.edtsubjectMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
    StaticText1.Caption := '请添加信件主题....' ;
end;

procedure TForm3.edtusernameMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
    StaticText1.Caption := '请输入登陆邮箱时的用户名....' ;
end;

procedure TForm3.edtpswMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
    StaticText1.Caption := '请输入密码....' ;
end;

procedure TForm3.edthostMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
    StaticText1.Caption := '请输入发件人邮箱的邮件服务器地址  网易的邮件服务器地址为: smtp.163.com' ;
end;

procedure TForm3.Button3MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
    StaticText1.Caption := '清除信件内容  重新写信。' ;
end;

procedure TForm3.Button3Click(Sender: TObject);
begin
    memcoment.Clear ;
end;

procedure TForm3.Button4Click(Sender: TObject);
begin
    Form3.Close ;
end;

procedure TForm3.Button2MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
    StaticText1.Caption := '点击这里发送邮件....' ;
end;

procedure TForm3.Button4MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
    StaticText1.Caption := '点击这里返回主界面。'
end;

procedure TForm3.Button1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
    StaticText1.Caption := '点击这里添加附件....'   ;
end;

procedure TForm3.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
       StaticText1.Caption := '  ' ;
end;

procedure TForm3.SpeedButton1Click(Sender: TObject);
var
str:string;
begin
str:='WEB\Project2.exe';
winexec(PChar(str), SW_SHOWNORMAL);
end;


end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -