unit uQuickEMail;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent, IdComponent,
  IdUDPBase, IdUDPClient, IdDNSResolver, StdCtrls, Grids, ValEdit, ExtCtrls,
  IdMessage, IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP,
  ComCtrls;

type
  TQuickEMailFrm = class(TForm)
    IdDNSResolver: TIdDNSResolver;
    IdAntiFreeze1: TIdAntiFreeze;
    IdSMTP: TIdSMTP;
    IdMsgSend: TIdMessage;
    Panel1: TPanel;
    Label5: TLabel;
    edtFrom: TEdit;
    Label1: TLabel;
    edtTo: TEdit;
    edtSubject: TEdit;
    Label6: TLabel;
    Panel2: TPanel;
    mmContent: TMemo;
    Panel3: TPanel;
    Label4: TLabel;
    Panel4: TPanel;
    StatusBar1: TStatusBar;
    btnSend: TButton;
    procedure btnSendClick(Sender: TObject);
  private
    { Private declarations }
    procedure GetMxList(AMxList: TStringList; AQName: string);
  public
    { Public declarations }
  end;

var
  QuickEMailFrm: TQuickEMailFrm;

implementation

{$R *.dfm}

{ TForm1 }

{ *****************************************************************************
  這個過程是用來得到郵件特快專遞目的地服務器名稱及優先級別數，參數AMXList是用
　來接收結果值，AQName代表傳遞過來的域名
  *****************************************************************************}
procedure TQuickEMailFrm.GetMxList(AMxList: TStringList; AQName: string);
var
  i: Integer;
begin
  with IdDNSResolver do
  begin
    Host := '202.102.13.141'; { Host屬性用來指定域名服務器的地址，此處為筆者所在地
       的主域名服務器地址，你也可以指定任一可以快速訪問到的Internet上域名服務器
       地址，要知道自己所在地的域名服務器地址，win98下通過winipcfg命令,win2000下
       通過ipconfig /all即可查出。}
    ReceiveTimeout := 10000;   // 在指定的時間內得不到域名服務器的反饋，則視為失敗。
    ClearVars;    // 清除前一次查詢所反饋回來的資源記錄

    { 構建此次查詢的頭部結構 }
    with DNSHeader do
    begin
      Qr := False; // False 代表查詢
      Opcode := 0; // 0代表標準域名查詢
      RD := True; //域名服務器可以進行遞歸查詢
      QDCount := 1; //查詢的數量
    end;

    { 構建要查詢的問題 }
    DNSQDList.Clear;
    with DNSQDList.Add do
    begin
      QName := AQName; //要查詢的域名
      QType := cMX; //QTYPE指定要查詢的資源記錄的種類，值為cMX代表郵件交換記錄
      QClass := cIN;
    end;

    ResolveDNS; //向域名服務器發出請求

    { 從域名服務器接收反饋的結果，將反饋回來的郵件服務器名稱放在AMXList列表的Name部分，
      郵件服務器的優先級別數放在Value部分。 }
    for i := 0 to DNSAnList.Count - 1 do
      AMxList.Add(DNSAnList[i].RData.MX.Exchange + '=' +
        IntToStr(DNSAnList[i].RData.MX.Preference));
  end;
end;

{ 單擊"發送"按鈕時發送專遞郵件 }
procedure TQuickEMailFrm.btnSendClick(Sender: TObject);
var
  MxList: TStringList;
  i: Integer;
  QName, ThoughAddress: string;
begin
  //根據用戶所填寫的內容創建郵件
  with IdMsgSend do
  begin
    Body.Assign(mmContent.Lines); //郵件正文
    From.Address := Trim(edtFrom.Text);  //發件人地址
    Recipients.EMailAddresses := Trim(edtTo.Text);  //收件人地址
    Subject := edtSubject.Text; //郵件主題
  end;

  //從輸入的收件人地址中取出郵箱域名，利用前面的GetMxList過程得到目的地地址
  QName := TrimRight(copy(edtTo.Text, Pos('@', edtTo.Text) + 1, Length(edtTo.Text)));
  MxList := TStringList.Create;
  try
    GetMxList(MxList, QName);
    ThoughAddress := MxList.Names[0];
    {取反饋回來的第一個服務器為目的地，讀者可
      根據實際需要改進，比如說考慮到信件的優先級或當你選擇的服務器因繁忙而暫時
      不能處理你的信件時，換用其它服務器試試 }
  finally
    MxList.Free;
  end;

  //發送郵件
  with IdSMTP do
  begin
    Host := ThoughAddress; // 將Host賦值為目的地，這就是特快專遞與普通郵件的區別
    Port := 25; // smtp服務默認的端口為25
    Connect; //連接到服務器
    try
      Send(IdMsgSend); //發送剛才創建的郵件
      ShowMessage('發送完畢'); //發送完畢后提示
    finally
      Disconnect; //斷開服務器連接
    end;
  end;
end;

end.