unit1.pas

在应用程序中加入flash,一个可以在软件窗体中加入flash的源代码程序

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, Psock, NMsmtp, StdCtrls;

type
  TForm1 = class(TForm)
    ToAddress: TEdit;
    Subject: TEdit;
    ToCarbonCopy: TEdit;
    ToBlindCarbonCopy: TEdit;
    Attachment: TEdit;
    FromName: TEdit;
    FromAddress: TEdit;
    Host: TEdit;
    UserID: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Body: TMemo;
    SendButton: TButton;
    NewButton: TButton;
    ClearButton: TButton;
    AttachButton: TButton;
    CloseButton: TButton;
    NMSMTP: TNMSMTP;
    OpenDialog: TOpenDialog;
    StatusBar: TStatusBar;
    procedure SendButtonClick(Sender: TObject);
    procedure NewButtonClick(Sender: TObject);
    procedure ClearButtonClick(Sender: TObject);
    procedure AttachButtonClick(Sender: TObject);
    procedure CloseButtonClick(Sender: TObject);
    procedure NMSMTPAuthenticationFailed(var Handled: Boolean);
    procedure NMSMTPSuccess(Sender: TObject);
    procedure NMSMTPFailure(Sender: TObject);
    procedure NMSMTPHeaderIncomplete(var handled: Boolean;
      hiType: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.SendButtonClick(Sender: TObject);
begin
    Form1.Cursor := crHourGlass;  {光标变为酒杯形}
    SendButton.Enabled := FALSE;  {"发送"按钮变灰}
    NewButton.Enabled := FALSE;   {"新邮件"按钮变灰}
    ClearButton.Enabled := FALSE; {"清除"按钮变灰}
    AttachButton.Enabled := FALSE; {"添加附件"按钮变灰}
    StatusBar.SimpleText := '正在连接服务器，请稍候......';
    NMSMTP.PostMessage.ToAddress.Text := ToAddress.Text; {收件人地址}
    NMSMTP.PostMessage.Subject := Subject.Text;  {主题}
    NMSMTP.PostMessage.ToCarbonCopy.Text := ToCarbonCopy.Text;  {抄送}
    NMSMTP.PostMessage.ToBlindCarbonCopy.Text := ToBlindCarbonCopy.Text;   {暗送}
    NMSMTP.PostMessage.FromAddress := FromAddress.Text;   {发件人地址}
    NMSMTP.PostMessage.FromName := FromName.Text;   {发件人姓名}
    NMSMTP.PostMessage.Attachments.Text := Attachment.Text;   {附件}
    NMSMTP.PostMessage.Body.Text := Body.Text;   {邮件正文}
    NMSMTP.PostMessage.Date := DateTimeToStr(Now);   {日期和时间，取系统当前值}
    NMSMTP.PostMessage.ReplyTo := FromAddress.Text;   {回复地址，取发件人地址}
    NMSMTP.Host := Host.Text;  {SMTP服务器地址，由服务商提供名称，不同的服务器值不相同}
    NMSMTP.UserID := UserID.Text;  {用户在SMTP服务器上的用户名，有的需要提供，有的不需要}
    NMSMTP.Connect;  {连接SMTP服务器}
    NMSMTP.SendMail;  {发送邮件}
    NMSMTP.Disconnect;  {断开同SMTP服务器的连接}
end;

procedure TForm1.NewButtonClick(Sender: TObject);
begin
{新邮件，将收件人地址、主题、抄送、暗送、附件、正文编辑框中的内容清空}
    ToAddress.Clear;
    Subject.Clear;
    ToCarbonCopy.Clear;
    ToBlindCarbonCopy.Clear;
    Attachment.Clear;
    Body.Clear;
end;

procedure TForm1.ClearButtonClick(Sender: TObject);
begin
{清除SMTP组件参数，并将所有编辑框中的内容清空}
    NMSMTP.ClearParameters;
    ToAddress.Clear;
    Subject.Clear;
    ToCarbonCopy.Clear;
    ToBlindCarbonCopy.Clear;
    Attachment.Clear;
    Body.Clear;
    FromAddress.Clear;
    FromName.Clear;
    Host.Clear;
    UserID.Clear;

end;

procedure TForm1.AttachButtonClick(Sender: TObject);
begin
{打开文件对话框，添加附件}
    if OpenDialog.Execute then
      Attachment.Text := (OpenDialog.FileName);
end;

procedure TForm1.CloseButtonClick(Sender: TObject);
begin
Close;
end;

procedure TForm1.NMSMTPAuthenticationFailed(var Handled: Boolean);
var
    S: String;
begin
    {当身份验证没有通过时，再给一次重新输入的机会}
    S := NMSMTP.UserID;
    if InputQuery('身份验证失败', '请重新输入用户名(User ID): ', S) then
    begin
        NMSMTP.UserID := S;
        Handled := TRUE;
    end;
end;

procedure TForm1.NMSMTPSuccess(Sender: TObject);
begin
MessageDlg('邮件已经成功发送!', mtInformation, [mbYes], 0);
    SendButton.Enabled := TRUE; {发送按钮恢复正常}
    NewButton.Enabled := TRUE;  {新邮件按钮恢复正常}
    ClearButton.Enabled := TRUE;  {清除按钮恢复正常}
    AttachButton.Enabled := TRUE;  {添加附件按钮恢复正常}
    Form1.Cursor := crDefault;   {光标变为缺省形状}
    StatusBar.SimpleText := '已经成功发送邮件！';

end;

procedure TForm1.NMSMTPFailure(Sender: TObject);
begin
MessageDlg('邮件发送失败!', mtInformation, [mbYes], 0);
    SendButton.Enabled := TRUE;  {发送按钮恢复正常}
    NewButton.Enabled := TRUE;   {新邮件按钮恢复正常}
    ClearButton.Enabled := TRUE;  {清除按钮恢复正常}
    AttachButton.Enabled := TRUE;   {添加附件按钮恢复正常}
    Form1.Cursor := crDefault;   {光标变为缺省形状}
    StatusBar.SimpleText := '发送邮件失败！';

end;

procedure TForm1.NMSMTPHeaderIncomplete(var handled: Boolean;
  hiType: Integer);
var
    Str: String;
begin
    {当所需信息不完整时，给予一次重新输入的机会}
    case hiType of
        hiFromAddress:
        if InputQuery('发件人地址没有填写', '请输入发件人地址:', Str) then
        begin
            NMSMTP.PostMessage.FromAddress := Str;
            Handled := TRUE;
        end;
        hiToAddress:
        if InputQuery('收件人地址没有填写', '请输入收件人地址:', Str) then
        begin
            NMSMTP.PostMessage.ToAddress.Text := Str;
            Handled := TRUE;
        end;
    end;
end;

end.