转至繁体中文版     | 网站首页 | 图文教程 | 资源下载 | 站长博客 | 图片素材 | 武汉seo | 武汉网站优化 | 
最新公告:     敏韬网|教学资源学习资料永久免费分享站!  [mintao  2008年9月2日]        
您现在的位置: 学习笔记 >> 图文教程 >> 软件开发 >> Delphi程序 >> 正文
TCP/IP(七)         ★★★★

TCP/IP(七)

作者:闵涛 文章来源:闵涛的学习笔记 点击数:1491 更新时间:2009/4/23 18:43:56

(*@\\\0000000501*)

(*@/// procedure t_smtp.action; *)
procedure t_smtp.action;
var
  i,j: integer;
  s: string;
begin
  if (f_receipts=NIL) or (f_receipts.count=0)
    or (f_body=NIL) or (f_body.count=0) or (f_user='''''''') then  EXIT;
    (* not all necessary data filled in *)
  login;
  f_host:=my_hostname;
(*@///   Open Connection and submit header data *)
self.response;   (* Read the welcome message *)

self.SendCommand(''''HELO ''''+f_host);   (* open connection *)
self.response;
if f_status_nr>=300 then
  raise EProtocolError.Create(''''SMTP'''',f_status_txt,f_status_nr);

self.SendCommand(''''MAIL FROM: <''''+address_from(f_user,1)+''''>'''');   (* send header data *)
self.response;
if f_status_nr>=300 then
  raise EProtocolError.Create(''''SMTP'''',f_status_txt,f_status_nr);


for i:=0 to f_receipts.count-1 do begin
  j:=0;
  while true do begin
    inc(j);
    s:=address_from(f_receipts.strings[i],j);
    if s<>'''''''' then begin
      self.SendCommand(''''RCPT TO: <''''+s+''''>'''');   (* submit the receipts *)
      self.response;
      (* Log error users for later check ? *)
      end
    else BREAK;
    end;
  end;

self.SendCommand(''''DATA'''');   (* ready to send the mail *)
self.response;
if f_status_nr=354 then begin
  for i:=0 to f_body.count-1 do begin
    if f_body.strings[i]=''''.'''' then f_body.strings[i]:='''','''';
    self.write_s(f_socket,f_body.strings[i]+#13#10);
    end;
  self.write_s(f_socket,''''.''''+#13#10);
  self.response;
  end;
if f_status_nr>=300 then
  raise EProtocolError.Create(''''SMTP'''',f_status_txt,f_status_nr);
(*@\\\*)
  end;
(*@\\\0000000A17*)
(*@/// procedure t_smtp.response; *)
procedure t_smtp.response;
var
  s: string;
begin
  s:=self.read_line(f_socket);
  if assigned(f_tracer) then
    f_tracer(s,tt_proto_get);
  f_status_nr:=strtoint(copy(s,1,3));
  f_status_txt:=copy(s,5,length(s));
  (* if the answer consists of several lines read and discard all the following *)
  while pos(''''-'''',s)=4 do begin
    s:=self.read_line(f_socket);
    if assigned(f_tracer) then
      f_tracer(s,tt_proto_get);
    end;
  end;
(*@\\\0000000801*)

(*@/// procedure t_smtp.SetBody(Value: TStringList); *)
procedure t_smtp.SetBody(Value: TStringList);
begin
  if value=NIL then
    f_body.clear
  else
    f_body.assign(value);
  end;
(*@\\\0000000603*)
(*@/// procedure t_smtp.SetRecipients(Value: TStringList); *)
procedure t_smtp.SetRecipients(Value: TStringList);
begin
  if value=NIL then
    f_receipts.clear
  else
    f_receipts.assign(value);
  end;
(*@\\\0000000603*)
(*@\\\0000000401*)
(*@/// class t_pop3(t_tcpip) *)
type
(*@///   t_reply=class(TObject) *)
t_reply=class(TObject)
public
  index: integer;
  length: integer;
  from: string;
  subject: string;
  end;
(*@\\\0000000601*)

(*@/// constructor t_pop3.Create(Aowner:TComponent); *)
constructor t_pop3.Create(Aowner:TComponent);
begin
  inherited create(Aowner);
  f_list:=NIL;
  f_mail:=TStringlist.Create;
  f_list:=TList.Create;
  f_socket_number:=110;
  end;
(*@\\\0000000501*)
(*@/// destructor t_pop3.Destroy; *)
destructor t_pop3.Destroy;
begin
  f_mail.free;
  try
    if f_list<>NIL then
      while f_list.count>0 do begin
        TObject(f_list.items[0]).Free;
        f_list.delete(0);
        end;
  except
    end;
  f_list.free;
  inherited destroy;
  end;
(*@\\\0000000C01*)

(*@/// procedure t_pop3.action; *)
procedure t_pop3.action;
begin
  login;
  if f_list.count<>0 then
    getmail(1);
  logout;
  end;
(*@\\\0000000501*)
(*@/// procedure t_pop3.response; *)
procedure t_pop3.response;
var
  s: string;
begin
  s:=self.read_line(f_socket);
  if assigned(f_tracer) then
    f_tracer(s,tt_proto_get);
  if copy(s,1,3)=''''+OK'''' then
    { everything OK }
  else if copy(s,1,4)=''''-ERR'''' then
    raise EProtocolError.Create(''''POP3'''',s,500)
  else
    raise EProtocolError.Create(''''POP3'''',s,999);
  end;
(*@\\\0000000701*)

(*@/// procedure t_pop3.Login;                         // USER, PASS, LIST *)
procedure t_pop3.Login;
var
  s: string;
  h: t_reply;
begin
  inherited login;
  self.response;
  self.SendCommand(''''USER ''''+f_user);   (* open connection *)
  self.response;
  self.write_s(f_socket,''''PASS ''''+f_pass+#13#10);
  if assigned(f_tracer) then
    f_tracer(''''PASS *****'''',tt_proto_sent);
  self.response;
  self.SendCommand(''''LIST'''');   (* open connection *)
  self.response;
  while true do begin
    s:=self.read_line(f_socket);
    if s=''''.'''' then BREAK;
    h:=t_reply.Create;
    h.index:=strtoint(copy(s,1,pos('''' '''',s)-1));
    h.length:=strtoint(copy(s,pos('''' '''',s)+1,length(s)));
    h.from:='''''''';
    h.subject:='''''''';
    f_list.add(h);
    end;
  end;
(*@\\\*)
(*@/// procedure t_pop3.GetHeaders;                    // TOP *)
procedure t_pop3.GetHeaders;
var
  i: integer;
  h: t_reply;
  s: string;
begin
  f_mail.clear;
  for i:=f_list.count-1 downto 0 do begin
    h:=t_reply(f_list.items[i]);
    self.SendCommand(''''TOP ''''+inttostr(h.index)+'''' 1'''');
    try
      self.response;   (* this may give a EProtocolError on older POP server *)
      while true do begin
        s:=self.read_line(f_socket);
        if s=''''.'''' then BREAK;
        if pos(''''From:'''',s)=1 then
          h.from:=copy(s,7,length(s));
        if pos(''''Subject:'''',s)=1 then
          h.subject:=copy(s,10,length(s));
        end;
      if h.subject<>'''''''' then
        f_mail.insert(0,h.from+#7+h.subject)
      else
        f_mail.insert(0,h.from)
    except
      on EProtocolError do
        f_mail.insert(0,inttostr(h.index));
      (* ignore errors due to unimplemented TOP *)
      end;
    end;
  end;
(*@\\\*)
(*@/// procedure t_pop3.Logout;                        // QUIT *)
procedure t_pop3.Logout;
begin
  if f_logged_in then begin
    self.SendCommand(''''QUIT'''');
    self.response;
    end;
  inherited logout;
  if f_list<>NIL then
    while f_list.count>0 do begin
      TObject(f_list.items[0]).Free;
      f_list.delete(0);
      end;
  end;
(*@\\\0000000401*)
(*@/// procedure t_pop3.GetMail(index: integer);       // RETR *)
procedure t_pop3.GetMail(index: integer);
var
  s: string;
begin
  if not f_logged_in then login;
  self.SendCommand(''''RETR ''''+inttostr(index));
  self.response;
  f_mail.clear;
  while true do begin
    s:=self.read_line(f_socket);
    if s=''''.'''' then BREAK;
    f_mail.add(s);
    end;
  end;
(*@\\\0000000601*)
(*@/// procedure t_pop3.DeleteMail(index:integer);     // DELE *)
procedure t_pop3.DeleteMail(index:integer);
begin
  if not f_logged_in then login;
  self.SendCommand(''''DELE ''''+inttostr(index));
  self.res

[1] [2]  下一页


没有相关教程
教程录入:mintao    责任编辑:mintao 
  • 上一篇教程:

  • 下一篇教程:
  • 【字体: 】【发表评论】【加入收藏】【告诉好友】【打印此文】【关闭窗口
      注:本站部分文章源于互联网,版权归原作者所有!如有侵权,请原作者与本站联系,本站将立即删除! 本站文章除特别注明外均可转载,但需注明出处! [MinTao学以致用网]
      网友评论:(只显示最新10条。评论内容只代表网友观点,与本站立场无关!)

    同类栏目
    · C语言系列  · VB.NET程序
    · JAVA开发  · Delphi程序
    · 脚本语言
    更多内容
    热门推荐 更多内容
  • 没有教程
  • 赞助链接
    更多内容
    闵涛博文 更多关于武汉SEO的内容
    500 - 内部服务器错误。

    500 - 内部服务器错误。

    您查找的资源存在问题,因而无法显示。

    | 设为首页 |加入收藏 | 联系站长 | 友情链接 | 版权申明 | 广告服务
    MinTao学以致用网

    Copyright @ 2007-2012 敏韬网(敏而好学,文韬武略--MinTao.Net)(学习笔记) Inc All Rights Reserved.
    闵涛 投放广告、内容合作请Q我! E_mail:admin@mintao.net(欢迎提供学习资源)

    站长:MinTao ICP备案号:鄂ICP备11006601号-18

    闵涛站盟:医药大全-武穴网A打造BCD……
    咸宁网络警察报警平台