(* @ @ @ 0000000501 *)
(* @ /// procedure t_smtp.action; *) procedure t_smtp.action; var i, j: integer; s: string; begin if (f_receipts = nil) or (f_body = nil) 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 EPROTOCOLERRROR.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? *) ELSE BREAK; END;
Self.sendcommand (* 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] = ' 'TENF_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 line read and discard all the folloading *) 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: TSTRI Nglist); begin if value = nil dam @ ipsign (value); end; (* @ @ @ @ @ @ /// procedure t_smtp.setringlist); *) Procedure T_smtp.setRecipients (value: tstringlist); begin if value = nil dam = = v = nil dam = // Class T_POP3 (T_TCPIP) *) TYPE (* @ /// T_reply = Class (TOBJECT) *) T_reply = Class (TOBJECT) PUBLIC INDEX: Integer; Length: Integer; From: string; Subject: string; * @ @ / 0000006060 *)
(* @ /// 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; (* @ @ @ /// destructor t_pop3.destroy; *) deStructor t_pop3.destroy; begin f_mail.free; try if f_list <> nil dam 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; (* @ @ @ @ @ @ @ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@000000 /// advancedure 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' TEN {Everything OK} Else IF Copy (S, 1, 4) = '- Err' TEN RAISE EPROTOCOLERRROR.CREATE ('POP3', S, 500) Else Raise EPROTOC OLERR.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 (* open connection *) self.response; while true do beg s: = self.read_line (f_socket); if s = '.' Then Break; h: h: h: h: = t_reply .Create; H.index: = start (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' INTSTOSTR (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 <> '' TENF_MAIL.INSERT (0, H.FROM # 7 H.Subject) Else F_mail.insert (0, H.FROM) Except on EPROTOCOLERROR DO F_MAIL.INSERT (0, INTSTR) H.index));
(* ignore error *) end; end; end; (* @ /// *) (* @ /// quit t_pop3.logout; // quit *) procedure t_pop3.logout; begin if f_logged_in dam Self.sendCommand ('quit'); self.response; end; inherited logout; if f_list <> nil dam ket f_list.count> 0 do begin tobject (f_list.items [0]). free; f_list.delete (0) End; end; (* @ @ @ @ @ /// procedure t_pop3.getmail (index: integer); // retr *) procedure t_pop3.getmail (INDEX: Integer); var s: string; Begin if not f_logged_in life; self.sendcommand ('retr' INTOSTR (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; (* @ /// @ @ @ @) (index: integer); // dele *) procedure t_pop3.deletemail (INDEX: Integer; begin if not f_logged_in dam; self.sendcommand ('Dele' INTOSTR (INDEX)); self.response; end; (* @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ / 00000 00401 *) (* @ @ @ @ c c cc *) (* @ /// function nntpdate (date: tdatetime): string; *) function nntpdate (date: tdatetime) (DATE: TDATETIME) : String; Begin Result: = formatdatetime ('YYMMDD HHNNSS', DATE); END; (* @ @ @ @ @ @ @ @)
(* @ /// constructor t_nntp.Create (Aowner: TComponent); *) constructor t_nntp.Create (Aowner: TComponent); begin inherited create (Aowner); f_news: = TStringlist.Create; f_newsgroups: = TStringlist.Create; f_socket_number : = 119; End; (* @ /// 0000000401 *) (* @ /// destructor t_nntp.destroy; *) deStructor t_nntp.destroy; begin f_news.free; f_newsgroups.free; inherited destroy; end; (* @ /// 0000000501 *) (* @ /// procedure t_nntp.SetNews (value: TStringlist); *) procedure t_nntp.SetNews (value: TStringlist); begin if value = NIL then f_news.clear else f_news.assign (value) ; END; (* @ @ @ @ @ @) procedure t_nntp.action; begin login; (* ??? *) logout; end; (* @ ///// 0000000401 *)
(* @ /// procedure t_nntp.login; *) procedure t_nntp.login; begin inherited login; self.response; self.sendcommand (* Some NNTP Servers NEED THIS *) TRY SELF.RESPONSE; Except (* ignore if the server doesn't understand this *) end; end; (* @ @ @ @ @ @ @ /// quit; // quit *) procedure t_nntp.logout; begin if F_logged_in dammand ('quit'); self.response; end; inherited logout; end; (* @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ 0000000306 *)
(* @ /// procedure t_nntp.getatic; // article *) procedure t_nntp.getArticleId (const msgid: string); begin if not f_logged_in dam; if msgid [1] <'<' Then Self.sendcommand ('Article <' MSGID '>) Else Self.sendCommand (' Article ' MSGID); Self.Response; f_news.clear; getArticleinternal, End; (* @ @ @ @ @ @ @@@@ /// procedure t_nntp.postarticle; // post *) procedure t_nntp.postarticle; var i: integer; begin if not f_logged_in life; self.sendcommand ('pos "; self.response; for i: = 0 to f_news .count-1 do begin if f_news.strings [i] = '.' Then Write_s (f_socket, '..' # 13 # 10) Else Write_s (f_socket, f_news.strings [i] # 13 # 10); End; write_s (f_socket, '.' # 13 # 10); self.response; end; (* @ /// 0000000601 *) (* @ /// procedure t_nntp.getallnewsgroups; // list *) Procedure T_nNTP. GetAllNewsGroups; var s: string; begin if not f_logged_in dam; f_newsgroups.clear; Self.sendcommand ('list'); self.response; while true do begin s: = read_line (f_socket); if s <> '.' TENF_NEWSGROUPS.ADD (Copy (S, 1, POS ('', s) -1)) else BREAK; end; end; (* @ /// 0000000601 *) (* @ /// procedure t_nntp.GetNewNewsgroups (since: TDateTime); // NEWGROUPS *) procedure t_nntp.GetNewNewsgroups (since: TDateTime) Var s: string; begin if not f_logged_in dam; f_newsgroups.clear; self.sendcommand ('newgroups' nntpdate (Since)); self.response; while true do begin s: = read_line (f_socket); if S < > '.'
