谁做过邮件的匿名发送？用TNMSMTP可以实现吗？最好能多介绍点匿名的原理，谢谢

Question

谁做过邮件的匿名发送？用TNMSMTP可以实现吗？最好能多介绍点匿名的原理，谢谢注意：你最好亲自做过。因为我手头有很多tNMSMTP的资料，可连邮件都发不出去。更不用说匿名。
//此处是删掉所有的头部信息
//NMSMTP1.FinalHeader.Clear;
根本不好用。
希望你能提供更好的，也希望大家讨论匿名发送问题。谢谢

Answer 1

unit Unit4;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, IdMessage, IdAntiFreezeBase,
  IdAntiFreeze, IdUDPBase, IdUDPClient, IdDNSResolver, IdBaseComponent,
  IdComponent, IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP,
  ComCtrls, ColorGrd;type
  TForm4 = class(TForm)
    IdSMTP1: TIdSMTP;
    IdDNSResolver1: TIdDNSResolver;
    IdAntiFreeze1: TIdAntiFreeze;
    IdMessage1: TIdMessage;
    Panel1: TPanel;
    Edit1: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Edit2: TEdit;
    Label3: TLabel;
    Edit3: TEdit;
    Panel2: TPanel;
    Panel3: TPanel;
    Label4: TLabel;
    Edit4: TEdit;
    SpeedButton1: TSpeedButton;
    Memo1: TMemo;
    SpeedButton2: TSpeedButton;
    StatusBar1: TStatusBar;
    SpeedButton3: TSpeedButton;
    OpenDialog1: TOpenDialog;
    Bevel1: TBevel;
    ColorBox1: TColorBox;
    ComboBox1: TComboBox;
    ComboBox2: TComboBox;
    SpeedButton7: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    Timer1: TTimer;
    procedure SpeedButton2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    
    procedure ColorBox1Change(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);
    procedure SpeedButton7Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ComboBox2Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure GetMxList(var AMxList: TStringList; AQName: string);
  end;var
  Form4: TForm4;
implementationuses Unit1, Unit5;{$R *.dfm}
procedure TForm4.GetMxList(var AMxList: TStringList; AQName: string);
var
  i: Integer;
begin
  with IdDNSResolver1 do
  begin
    Host := '192.168.168.3'; { Host属性用来指定域名服务器的地址，此处为笔者所在地
       的主域名服务器地址，你也可以指定任一可以快速访问到的Internet上域名服务器
       地址，要知道自己所在地的域名服务器地址，win98下通过winipcfg命令,win2000下
       通过ipconfig /all即可查出。}
    ReceiveTimeout := 10000;   // 在指定的时间内得不到域名服务器的反馈，则视为失败。
    ClearVars;    // 清除前一次查询所反馈回来的资源记录    { 构建此次查询的头部结构 }
    with DNSHeader do
    begin
      Qr := False; // False 代表查询
      Opcode := 0; // 0代表标准域名查询
      RD := True; //域名服务器可以进行递归查询
      QDCount := 3; //查询的数量
    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 TForm4.SpeedButton2Click(Sender: TObject);
var
  mxlist:tstringlist;
  i:integer;
  qname,thoughaddress:string;
begin  form4.IdMessage1.Body.Assign(form4.Memo1.Lines);
  form4.IdMessage1.From.Address:=form4.Edit2.Text;
  form4.IdMessage1.Recipients.EMailAddresses:=trim(form4.Edit1.Text);
  form4.IdMessage1.Subject:=form4.Edit3.Text;
  qname:=trimright(copy(form4.Edit1.Text,pos('@',form4.Edit1.Text)+1,length(form4.Edit1.Text)));
  mxlist:=tstringlist.create;
  try
    form4.GetMxList(mxlist,qname);
    thoughaddress:=mxlist.Names[0];
  finally
    mxlist.Free;
  end;
  form4.IdSMTP1.Host:=thoughaddress;
  form4.IdSMTP1.Port:=25;
  form4.IdSMTP1.Connect;
  try
    form4.IdSMTP1.Send(form4.IdMessage1);
    form4.StatusBar1.SimpleText:='邮件发送成功...';
    if messagedlg('邮件发送成功！继续发送？',mtconfirmation,mbokcancel,0)=mrok then
      begin
        form4.Edit1.Text:='';
        form4.Edit2.Text:='';
        form4.Edit3.Text:='';
        form4.Edit4.Text:='';
        form4.Memo1.Lines.Clear;
      end
  finally
    form4.IdSMTP1.Disconnect;
    form4.StatusBar1.SimpleText:='';
  end;
  form4.Edit1.Text:='';
  form4.Edit2.Text:='';
  form4.Edit3.Text:='';
  form4.Edit4.Text:='';
  form4.Memo1.Lines.Clear;
  form4.SpeedButton2.Enabled:=false;
end;
procedure TForm4.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  form1.Enabled:=true;
  form4.Edit1.Text:='';
  form4.Edit2.Text:='';
  form4.Edit3.Text:='';
  form4.Edit4.Text:='';
  form4.Memo1.Lines.Clear;
end;procedure TForm4.SpeedButton3Click(Sender: TObject);
begin  
  form5.Show;
  form4.Enabled:=false;
  //form4.Edit1.Text:='';
  //form4.Edit2.Text:='';
  //form4.Edit3.Text:='';
  //form4.Edit4.Text:='';
  //form4.Memo1.Lines.Clear;
end;procedure TForm4.SpeedButton1Click(Sender: TObject);
begin
  if form4.OpenDialog1.Execute then
    begin
      form4.Edit4.Text:=form4.OpenDialog1.FileName;
      form4.Memo1.Lines.LoadFromFile(form4.OpenDialog1.FileName);
    end;
end;procedure TForm4.ColorBox1Change(Sender: TObject);
begin
  form4.Memo1.Font.Color:=form4.ColorBox1.Selected;
end;procedure TForm4.ComboBox1Change(Sender: TObject);
begin
  form4.Memo1.Font.Size:=strtoint(form4.ComboBox1.Text);
end;procedure TForm4.SpeedButton4Click(Sender: TObject);
begin
  IF form4.SpeedButton4.Hint='使用粗体' then
    begin
      form4.Memo1.Font.Style:=form4.Memo1.Font.Style+[fsbold];
      form4.SpeedButton4.Hint:='不用粗体';
    end
  else
    begin
      form4.Memo1.Font.Style:=form4.Memo1.Font.Style-[fsbold];
      form4.SpeedButton4.Hint:='使用粗体';
    end;      
end;procedure TForm4.SpeedButton5Click(Sender: TObject);
begin
  IF form4.SpeedButton5.Hint='倾斜' then
    begin
      form4.Memo1.Font.Style:=form4.Memo1.Font.Style+[fsitalic];
      form4.SpeedButton5.Hint:='不倾斜';
    end
  else
    begin
      form4.Memo1.Font.Style:=form4.Memo1.Font.Style-[fsitalic];
      form4.SpeedButton5.Hint:='倾斜';
    end;
end;procedure TForm4.SpeedButton6Click(Sender: TObject);
begin
  IF form4.SpeedButton6.Hint='带有下划线' then
    begin
      form4.Memo1.Font.Style:=form4.Memo1.Font.Style+[fsunderline];
      form4.SpeedButton6.Hint:='没有下划线';
    end
  else
    begin
      form4.Memo1.Font.Style:=form4.Memo1.Font.Style-[fsunderline];
      form4.SpeedButton6.Hint:='带有下划线';
    end;
end;procedure TForm4.SpeedButton7Click(Sender: TObject);
var
  year,month,day,hour,min,sec,msec:word;
  present:tdatetime;
  s:string;
begin
  present:=now;
  decodedate(present,year,month,day);
  decodetime(present,hour,min,sec,msec);
  s:=inttostr(year)+'年'+inttostr(month)+'月'+inttostr(day)+'日'+inttostr(hour)+'时'+inttostr(min)+'分'+inttostr(sec)+'秒';
  form4.Memo1.Lines.Add(s);
end;procedure TForm4.Timer1Timer(Sender: TObject);
begin
  if (form4.Edit1.Text<>'') and (form4.Edit2.Text<>'') and (form4.Memo1.Lines.Text<>'') then
    form4.SpeedButton2.Enabled:=true;
end;procedure TForm4.FormCreate(Sender: TObject);
begin
  form4.ComboBox2.Items:=screen.Fonts;
end;procedure TForm4.ComboBox2Change(Sender: TObject);
begin
  form4.Memo1.Font.Name:=form4.ComboBox2.Text;
end;end.
自己做的一个程序，发件人可以随便输入，只是不能发送附件，你试试

Answer 2

先谢谢你的代码。你能不能给整理一下，没用的太多了吧！IdDNSResolver1 做什么的，是关于DNS？把关键的重帖吧！都看晕了

Answer 3

好！谁让我不会来的，问你
procedure TForm4.GetMxList(var AMxList: TStringList; AQName: string);
里面做的是什么工作。
说说匿名的原理。

Answer 4

我不太信匿名啊，你可以研究FOXMAIL中的EMS！

Answer 5

FOXMAIL 之类的东西我根本没用过！
近来想写简单的发邮件程序。以前看的资料也不少，可真正能把信发出去。很难！
更不用说匿名了。所以请高手指教呀。还有谁做发邮件的。用了什么控件！

Answer 6

unit fMain;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP, IdComponent,
  IdUDPBase, IdUDPClient, IdDNSResolver, IdBaseComponent, IdMessage,
  StdCtrls, ExtCtrls, ComCtrls, IdAntiFreezeBase, IdAntiFreeze;type
  TfrmMain = class(TForm)
    IdMessage: TIdMessage;
    IdDNSResolver: TIdDNSResolver;
    IdSMTP: TIdSMTP;
    Label1: TLabel;
    sbMain: TStatusBar;
    Label2: TLabel;
    edtDNS: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    edtSender: TEdit;
    Label5: TLabel;
    edtRecipient: TEdit;
    Label6: TLabel;
    edtSubject: TEdit;
    Label7: TLabel;
    mmoMessageText: TMemo;
    btnSendMail: TButton;
    btnExit: TButton;
    IdAntiFreeze: TIdAntiFreeze;
    Label8: TLabel;
    edtTimeOut: TEdit;
    Label9: TLabel;
    Label10: TLabel;
    procedure btnExitClick(Sender: TObject);
    procedure btnSendMailClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  fMailServers : TStringList;
  Function PadZero(s:String):String;
  Function GetMailServers:Boolean;
  Function ValidData : Boolean;
  Procedure SendMail; OverLoad;
  Function SendMail(aHost : String):Boolean; OverLoad;
  Procedure LockControls;
  procedure UnlockControls;
  Procedure Msg(aMessage:String);
  end;var
  frmMain: TfrmMain;implementation{$R *.DFM}
procedure TfrmMain.btnExitClick(Sender: TObject);
begin
application.terminate;
end;procedure TfrmMain.btnSendMailClick(Sender: TObject);
begin
Msg('');
LockControls;
if ValidData then SendMail;
UnlockControls;
Msg('');
end;function TfrmMain.GetMailServers: Boolean;
var
  i,x : integer;
  LDomainPart : String;
  LMXRecord : TMXRecord;
begin
if not assigned(fmailServers) then fMailServers := TStringList.Create;
fmailServers.clear;Result := true;
with IdDNSResolver do
  begin
  QueryResult.Clear;
  QueryRecords := [qtMX];
  Msg('Setting up DNS query parameters');
  Host := edtDNS.text;
  ReceiveTimeout := StrToInt(edtTimeOut.text);
  // Extract the domain part from recipient email address
  LDomainPart := copy(edtRecipient.text,pos('@',edtRecipient.text)+1,length(edtRecipient.text)); // the domain name to resolve  try
  Msg('Resolving DNS');
  Resolve(LDomainPart);  if QueryResult.Count > 0 then
    begin
      for i := 0 to QueryResult.Count - 1 do
        begin
        LMXRecord := TMXRecord(QueryResult.Items[i]);
        fMailServers.Append(PadZero(IntToStr(LMXRecord.Preference)) + '=' + LMXRecord.ExchangeServer);
        end;    // sort in order of priority and then remove extra data
    fMailServers.Sorted := false;
    for i := 0 to fMailServers.count - 1 do
      begin
      x := pos('=',fMailServers.Strings[i]);
      if x > 0 then fMailServers.Strings[i] :=
        copy(fMailServers.Strings[i],x+1,length(fMailServers.Strings[i]));
      end;
    fMailServers.Sorted := true;
    fMailServers.Duplicates := dupIgnore;
    Result := true;
    end
  else
    begin
    Msg('No response from DNS server');
    MessageDlg('There is no response from the DNS server !', mtInformation, [mbOK], 0);
    Result := false;
    end;
  except
  on E : Exception do
    begin
    Msg('Error resolving domain');
    MessageDlg('Error resolving domain: ' + e.message, mtInformation, [mbOK], 0);
    Result := false;
    end;
  end;  end;
end;// Used in DNS preferance sorting
procedure TfrmMain.LockControls;
var i : integer;
begin
edtDNS.enabled := false;
edtSender.enabled := false;
edtRecipient.enabled := false;
edtSubject.enabled := false;
mmoMessageText.enabled := false;
btnExit.enabled := false;
btnSendMail.enabled := false;
end;procedure TfrmMain.UnlockControls;
begin
edtDNS.enabled := true;
edtSender.enabled := true;
edtRecipient.enabled := true;
edtSubject.enabled := true;
mmoMessageText.enabled := true;
btnExit.enabled := true;
btnSendMail.enabled := true;
end;
function TfrmMain.PadZero(s: String): String;
begin
if length(s) < 2 then
  s := '0' + s;
Result := s;
end;procedure TfrmMain.SendMail;
var
  i : integer;
begin
if GetMailServers then
  begin
  with IdMessage do
    begin
    Msg('Assigning mail message properties');
    From.Text := edtSender.text;
    Sender.Text := edtSender.text;
    Recipients.EMailAddresses := edtRecipient.text;
    Subject := edtSubject.text;
    Body := mmoMessageText.Lines;
    end;  for i := 0 to fMailServers.count -1 do
    begin
    Msg('Attempting to send mail');
    if SendMail(fMailServers.Strings[i]) then
      begin
      MessageDlg('Mail successfully sent and available for pickup by recipient !', mtInformation, [mbOK], 0);
      Exit;
      end;
    end;
  // if we are here then something went wrong .. ie there were no available servers to accept our mail!
  MessageDlg('Could not send mail to remote server - please try again later.', mtInformation, [mbOK], 0);
  end;
if assigned(fMailServers) then FreeAndNil(fMailServers);
end;function TfrmMain.SendMail(aHost: String): Boolean;
begin
Result := false;
with IdSMTP do
  begin
  Caption := 'Trying to sendmail via: ' + aHost;
  Msg('Trying to sendmail via: ' + aHost);
  Host := aHost;
  try
  Msg('Attempting connect');
  Connect;
  Msg('Successful connect ... sending message');
  Send(IdMessage);
  Msg('Attempting disconnect');
  Disconnect;
  msg('Successful disconnect');
  Result := true;
  except on E : Exception do
    begin
    if connected then try disconnect; except end;
    Msg('Error sending message');
    result := false;
    ShowMessage(E.Message);
    end;
  end;
  end;
Caption := '';
end;
function TfrmMain.ValidData: Boolean;
var ErrString:string;
begin
Result := True;
ErrString := '';if trim(edtDNS.text) = '' then ErrString := ErrString +  #13 + #187 + 'DNS server not filled in';
if trim(edtSender.text) = '' then ErrString := ErrString + #13 + #187 + 'Sender email not filled in';
if trim(edtRecipient.text) = '' then ErrString := ErrString +  #13 + #187 + 'Recipient not filled in';if ErrString <> '' then
  begin
  MessageDlg('Cannot proceed due to the following errors:'+#13+#10+ ErrString, mtInformation, [mbOK], 0);
  Result := False;
  end;
end;procedure TfrmMain.Msg(aMessage: String);
begin
sbMain.SimpleText := aMessage;
application.ProcessMessages;
end;end.

Answer 7

我知道网上有这个地方提供源代码,有兴趣的话研究一下源代码吧,由于时间关系在下还没有去看那个源代码,不知道是不是一定能对你有用,是由delphi开发的,有时间看看别人的源代码也是一种提高啊
http://mydelphi.8u8.com/ymnet.htm
还有别的网络程序可以供参考的呵,祝你成功

Answer 8

to  geoffrey9043(鑫鑫杀毒) 
你提供的地方我早看过了，告诉你发邮件不好用的。
我以前也有很多发邮件的例子！当我真的模仿这做的时候发现都不好用。不过谢谢你提供的网址！那里是不错。希望对“过路”的有用~

Answer 9

匿名，不行的吧，用TNMSMTP，不能实现的