(*@\\\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] 下一页 没有相关教程
|