TCP/IP(七)

页面导航:首页 > 软件编程 > Delphi > TCP/IP(七)

TCP/IP(七)

来源: 作者: 时间:2016-01-23 10:15 【

(*@\000000501*)(*@/// 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.c

(*@\\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 EPr

Tags:

相关文章

    文章评论

    最 近 更 新
    热 点 排 行
    Js与CSS工具
    代码转换工具
    
    <