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

📄 unit1.pas

📁 AHM控件包 AHM控件包
💻 PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, AHMMails, AHMTIEmails,Buttons, ComCtrls, AHMMailClass,
  AHMTMailAccount;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Memo1: TMemo;
    AHMSMTPMail1: TAHMSMTPMail;
    Panel1: TPanel;
    Edit5: TEdit;
    Label4: TLabel;
    StatusBar1: TStatusBar;
    Button1: TButton;
    ListBox1: TListBox;
    Button2: TButton;
    Button3: TButton;
    Label3: TLabel;
    Edit3: TEdit;
    Label7: TLabel;
    Edit4: TEdit;
    ProgressBar1: TProgressBar;
    AHMAccountHolder1: TAHMAccountHolder;
    procedure Button1Click(Sender: TObject);
    procedure AHMSMTPMail1BeforeSend(Sender: TObject);
    procedure AHMSMTPMail1Error(Sender: TObject; Error: Integer;
      VMessage: String);
    procedure AHMSMTPMail1SendProgress(Sender: TObject; Percent: Word);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure AHMSMTPMail1AfterSend(sender: TObject;
      MailMessage: TAHMMessage);
    procedure AHMSMTPMail1BeforeExecute(Sender: TObject);
    procedure AHMSMTPMail1Connect(Sender: TObject; const Server: String;
      Port: Integer);
    procedure AHMSMTPMail1Disconnect(Sender: TObject; const Server: String;
      Port: Integer);
    procedure AHMSMTPMail1ServerMessage(Sender: TObject; Status,
      Msg: String);
    procedure AHMSMTPMail1ServerResponse(Sender: TObject; Status,
      MsgText: String; IsError: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var I : Integer;
begin
  if AHMAccountHolder1.Accounts.Count=0 then
  with AHMAccountHolder1.Accounts.Add do
  begin
    AccountName:='Current Account';
    SMTPServer:=Edit5.text;
    Default:=True;
    {Default is the account that will be used for sending messages. At least one account needs to default to send messages}
  end else
  with AHMAccountHolder1.Accounts[0] do
  begin
    AccountName:='Current Account';
    SMTPServer:=Edit5.text;
  end;
  with AHMSMTPMail1.Messages.Add do
  try
    Subject   :=Edit1.Text;
    SendTo    :=Edit2.text;
    Message.Text:=Memo1.Lines.Text;
    FromMail  :=Edit3.Text;
    ReplyTo   :=Edit3.Text;
    FromName  :=edit4.text;
    //Having stored the filenames of wanted attachments within a listbox you can do the following
    if Listbox1.Items.Count>0 then For I:=0 to Listbox1.Items.Count-1 do
    Attachments.Add(Listbox1.Items[I]);
    AHMSMTPMail1.Execute;
  finally
    Free;
  end;
end;

procedure TForm1.AHMSMTPMail1BeforeSend(Sender: TObject);
begin
  Statusbar1.Simpletext:='Sending '+edit1.text;
end;

procedure TForm1.AHMSMTPMail1Error(Sender: TObject; Error: Integer;
  VMessage: String);
begin
 showmessage(VMessage);
end;

procedure TForm1.AHMSMTPMail1SendProgress(Sender: TObject; Percent: Word);
begin
  Statusbar1.Simpletext:='Sending '+Inttostr(Percent)+'%';
  Progressbar1.Position:=Percent;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  with TOpenDialog.Create(Application) do
  try
    if Execute then
    Listbox1.Items.add(Filename);
  finally
    free;
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  if Listbox1.ItemIndex>-1 then
   Listbox1.Items.Delete(Listbox1.Itemindex);
end;

procedure TForm1.AHMSMTPMail1AfterSend(sender: TObject;
  MailMessage: TAHMMessage);
begin
  Statusbar1.Simpletext:='Sending Message to '+MailMessage.SendTo;
  Progressbar1.Position:=0;
end;

procedure TForm1.AHMSMTPMail1BeforeExecute(Sender: TObject);
begin
  Progressbar1.Position:=0;
end;

procedure TForm1.AHMSMTPMail1Connect(Sender: TObject; const Server: String;
  Port: Integer);
begin
  Statusbar1.Simpletext:='Connecting to '+Server;
end;

procedure TForm1.AHMSMTPMail1Disconnect(Sender: TObject;
  const Server: String; Port: Integer);
begin
  Statusbar1.Simpletext:='Disconnecting '+Server;
end;

procedure TForm1.AHMSMTPMail1ServerMessage(Sender: TObject; Status,
  Msg: String);
begin
  Statusbar1.Simpletext:=Status+' - '+Msg;
end;

procedure TForm1.AHMSMTPMail1ServerResponse(Sender: TObject; Status,
  MsgText: String; IsError: Boolean);
begin
  if IsError then
    Statusbar1.Simpletext:='(Error) '+Status+' - '+Msgtext
  else Statusbar1.Simpletext:=Status+' - '+MsgText;
end;

end.

⌨️ 快捷键说明

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