求救！Delphi7 indy组件实现邮件收发的具体做法

Question

具体做法 谢谢各位高手了

Answer 1

unit Unit2;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdMessageClient, IdSMTP, IdMessage, IdPOP3, IdTCPConnection,
  IdTCPClient;type
  TForm2 = class(TForm)
    Button1: TButton;
    IdSMTP1: TIdSMTP;
    IdMessage1: TIdMessage;
    IdPOP31: TIdPOP3;
    Button2: TButton;
    ListBox1: TListBox;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);  private
    { Private declarations }
  public
    { Public declarations }
function CheckTxt(s:string):string;
  end;
  var yang:integer;
var
  Form2: TForm2;implementation{$R *.dfm}procedure TForm2.Button2Click(Sender: TObject);
var
  mailcount : integer;
  i : integer;
  tmp : string;
begin
  IdPOP31.Connect();    //连接到POP3服务器
 // mailcount := IdPOP31.CheckMessages;  //得到邮箱邮件的各数
{  for i:=1 to mailcount do   //遍历每一封邮件
  begin
     IdMessage1.Clear;
     IdPOP31.retrieveHeader(i,IdMessage1);  //得到邮件的头信息
     tmp := IdMessage1.Subject;      //得到邮件的标题
     Memo1.Lines.Add(tmp);
     IdPOP31.Retrieve(i,IdMessage1);  //接收到邮件所有内容
     tmp := IdMessage1.Body.Text;   //邮件正文
     memo1.Lines.Add(tmp);
  end;
  IdPOP31.Disconnect;   //断开连接
  }
//showmessage(inttostr(mailcount));
  for i:=6 to  7 do
   begin
     IdMessage1.Clear;
      idpop31.RetrieveHeader(i,idmessage1);
  tmp := IdMessage1.Subject;
  tmp:=checktxt(tmp);    //得到邮件的标题
 //  Memo1.Lines.Add(tmp);
  // listbox1.Items.Insert(i,tmp);
   listbox1.Items.Add(tmp);
    //接收到邮件所有内容
 // TIdAttachment.Create(IdMessage1.MessageParts,'ppp.xls'); //    tmp := IdMessage1.Body.Text;   //邮件正文
 //     tmp:=checktxt(tmp);
    IdPOP31.Retrieve(i,IdMessage1);
      if idmessage1.MessageParts.Count=1 then
      TIdAttachment(IdMessage1.MessageParts.Items[0]).SaveToFile('d1.xls');
     end;
     IdPOP31.Disconnect;
    showmessage('OK');
end;
 function tform2.CheckTxt(s:   string):   string;
  var   
  s1,s2,s3:   integer;   
  t,v:   string;   
  Encoding:   char;   
  hex,step:   integer;   
  a1:   array[1..4]   of   byte;   
  b1:   array[1..3]   of   byte;   
  j:   integer;   
  byte_ptr,real_bytes:   integer;   
  begin   
  s1:=Pos('=?',s);   
  s2:=   1   ;   
  hex:=   0   ;   
  if   s1>0   then   
  begin   
  for   s2:=Length(s)-1   downto   1   do   
  begin   
  if   Copy(s,s2,2)='?='   then   Break;   
  end;   
  end;   
  if   (s1=0)   or   (s2=1)   then   
  begin   
  Result:=s;   
  Exit;   
  end;   
  t:=Copy(s,s1+2,s2-2-s1);   
  s3:=Pos('?',t);   
    
  Delete(t,1,s3);   
  if(t='')then   
  begin   
  Result:=   s;   
  Exit   ;   
  end   ;   
  Encoding:=t[1];   
  Delete(t,1,2);   
  v:='';   
  step:=0;   
  case   Encoding   of   
  'Q':   
  while   t<>''   do   
  begin   
  case   step   of   
  0:   
  begin   
  case   t[1]   of   
  '_':   v:=v+'   ';   
  '=':   step:=1;   
  else   v:=v+t[1];   
  end;   
  end;   
  1:   
  begin   
  if   t[1]<='9'   then   hex:=(Ord(t[1])-Ord('0'))*16   
  else   hex:=(Ord(t[1])-55)*16;   
  step:=2;   
  end;   
  2:   
  begin   
  if   t[1]<='9'   then   hex:=hex+(Ord(t[1])-Ord('0'))   
  else   hex:=hex+Ord(t[1])-55;   
  v:=v+Chr(hex);   
  step:=0;   
  end;   
  end;   
  Delete(t,1,1);   
  end;   
  'B':   
  begin   
  byte_ptr:=0;   
  for   j:=1   to   Length(t)   do   
  begin   
  Inc(byte_ptr);   
  case   t[j]   of   
  'A'..'Z':   a1[byte_ptr]:=Ord(t[j])-65;   
  'a'..'z':   a1[byte_ptr]:=Ord(t[j])-71;   
  '0'..'9':   a1[byte_ptr]:=Ord(t[j])+4;   
  '+':   a1[byte_ptr]:=62;   
  '/':   a1[byte_ptr]:=63;   
  '=':   a1[byte_ptr]:=64;   
  end;   
  if   byte_ptr=4   then   
  begin   
  byte_ptr:=0;   
  real_bytes:=3;   
  if   a1[1]=64   then   real_bytes:=0;   
  if   a1[3]=64   then   
  begin   
  a1[3]:=0;   
  a1[4]:=0;   
  real_bytes:=1;   
  end;   
  if   a1[4]=64   then   
  begin   
  a1[4]:=0;   
  real_bytes:=2;   
  end;   
  b1[1]:=a1[1]*4+(a1[2]   div   16);   
  b1[2]:=(a1[2]   mod   16)*16+(a1[3]div   4);   
  b1[3]:=(a1[3]   mod   4)*64   +a1[4];   
  if(real_bytes>0)then   
  v:=   v   +   chr(b1[1])   ;   
  if(real_bytes>1)then   
  v:=   v   +   chr(b1[2])   ;   
  if(real_bytes>2)then   
  v:=   v   +   chr(b1[3])   ;   
  end;   
  end;   
  end;   
  end;   
  Result:=Copy(s,1,s1-1)+v+Copy(s,s2+2,999);   
    
  end;   
procedure TForm2.Button1Click(Sender: TObject);
beginyang:=2;
end;end.

Answer 2

发邮件的把收邮件的头和邮件内容改一下就行了
然后send

Answer 3

发送邮件功能的主要代码
procedure TfrmMessageEditor.bbtnOkClick(Sender: TObject);begin
  begin
  with IdMsgSend do
  begin
    Body.Assign(Memo1.Lines);
    Recipients.EMailAddresses := edtTo.Text; { To: header }
    Subject := edtSubject.Text; { Subject: header }
    Priority := TIdMessagePriority(cboPriority.ItemIndex); { Message Priority }
    CCList.EMailAddresses := edtCC.Text; {CC}
    BccList.EMailAddresses := edtBCC.Text; {BBC}
    if chkReturnReciept.Checked then
    begin {We set the recipient to the From E-Mail address }
      ReceiptRecipient.Text := From.Text;
    end
    else
    begin {indicate that there is no receipt recipiant}
      ReceiptRecipient.Text := '';
    end;
  end;  {authentication settings}
  SMTP.AuthenticationType := atLogin;//现在的smtp邮箱一般都需要验证，所以没有经过
//判断，直接用atLogin
  SMTP.UserID := 你在SMTP服务器的用户名;
  SMTP.Password :=密码;  {General setup}
  SMTP.Host := SMTP服务器地址;
  SMTP.Port := 25;//一般都用25这个端口  {now we send the message}
  SMTP.Connect; // try
    SMTP.Send(IdMsgSend);
//  except    SMTP.Disconnect;
 // end;  showmessage('邮件发送成功！');
  bbtnOk.Enabled:=false;
  edtto.Text:='';
  edtsubject.Text:='';
  edtcc.Text:='';
  edtbcc.Text:='';
  memo1.Lines.Clear;
  lvfiles.Items.Clear; end;
end;

Answer 4

是的
Delphi6中的indy
Idsmtp我给重命名为了SMTP

Answer 5

有很多网站的邮箱服务器都屏蔽了indy的，像163就是