(*@\\\0000000B01*) (*@\\\0000000801*) (*@/// class t_news(t_mailnews) *) (*@/// constructor t_news.Create(Aowner:TComponent); *) constructor t_news.Create(Aowner:TComponent); begin inherited create(AOwner); f_nntp:=NIL; f_newsgroups:=TStringList.Create; end; (*@\\\0000000501*) (*@/// destructor t_news.Destroy; *) destructor t_news.Destroy; begin f_newsgroups.Free; inherited destroy; end; (*@\\\000000030F*)
(*@/// procedure t_news.SetNewsgroups(Value: TStringList); *) procedure t_news.SetNewsgroups(Value: TStringList); begin if value=NIL then f_newsgroups.clear else f_newsgroups.assign(value); end; (*@\\\0000000603*)
(*@/// procedure t_news.action; *) procedure t_news.action; var s:string; i:integer; begin if (f_nntp=NIL) or (f_newsgroups=NIL) or (f_newsgroups.count=0) or (f_newsgroups.count>10) (* no spamming, please *) or (f_from='''''''') then EXIT; s:=''''Newsgroups: ''''; i:=0; while true do begin s:=s+f_newsgroups.strings[i]; inc(i); if i<f_newsgroups.count then s:=s+'''',''''; f_message.add(s); if i>=f_newsgroups.count then BREAK; s:='''' ''''; end; if f_organization<>'''''''' then f_message.add(f_organization); inherited action; f_nntp.login; f_nntp.news:=f_message; f_nntp.PostArticle; f_nntp.logout; f_message.clear; end; (*@\\\*) (*@\\\0000000401*)
(*@/// class t_attachment(TObject) *) (*@/// constructor t_attachment.Create; *) constructor t_attachment.Create; begin inherited create; f_text:=TStringlist.create; f_data:=TMemoryStream.Create; f_encoding:=ec_none; end; (*@\\\0000000617*) (*@/// destructor t_attachment.Destroy; *) destructor t_attachment.Destroy; begin f_text.free; f_data.free; inherited destroy; end; (*@\\\*)
(*@/// procedure t_attachment.SetText(value:TStringList); *) procedure t_attachment.SetText(value:TStringList); begin if value=NIL then f_text.clear else begin f_text.assign(value); f_text.SaveToStream(TMemoryStream(f_data)); end; end; (*@\\\0000000701*) (*@/// procedure t_attachment.SetData(value:TStream); *) procedure t_attachment.SetData(value:TStream); begin if value=NIL then TMemoryStream(f_data).clear else begin f_text.clear; TMemoryStream(f_data).LoadFromStream(value); end; end; (*@\\\000000041A*) (*@\\\*) (*@/// class t_mime(TComponent) *) (*@/// constructor t_mime.Create(Aowner:TComponent); *) constructor t_mime.Create(Aowner:TComponent); begin inherited Create(AOwner); f_attachment:=TList.Create; end; (*@\\\000000040F*) (*@/// destructor t_mime.Destroy; *) destructor t_mime.Destroy; begin if f_attachment<>NIL then begin try RemoveAllAttachments; except end; end; f_attachment.free; inherited Destroy; end; (*@\\\0000000701*)
(*@/// function t_mime.AttachFile(const filename:string):integer; *) function t_mime.AttachFile(const filename:string):integer; var t: t_attachment; data: TFileStream; begin t:=t_attachment.Create; t.kind:=''''application/octet-stream''''; t.encoding:=ec_base64; data:=NIL; try data:=TFileStream.Create(filename,fmOpenRead); t.data:=data; data.free; except data.free; t.free; raise; end; t.disposition:=''''attachment; filename="''''+filename_of(filename)+''''"''''; result:=f_attachment.add(t); end; (*@\\\*) (*@/// function t_mime.AttachText(text: TStringList):integer; *) function t_mime.AttachText(text: TStringList):integer; var t: t_attachment; begin t:=t_attachment.Create; t.kind:=''''text/plain''''; t.encoding:=ec_quotedprintable; t.text:=text; t.disposition:=''''''''; result:=f_attachment.add(t); end; (*@\\\000000060C*) (*@/// procedure t_mime.RemoveAttachment(index: integer); *) procedure t_mime.RemoveAttachment(index: integer); begin if (index>=0) and (f_attachment.count>index) then begin TObject(f_attachment[index]).free; f_attachment.delete(index); end; end; (*@\\\0000000301*) (*@/// procedure t_mime.RemoveAllAttachments; *) procedure t_mime.RemoveAllAttachments; begin while f_attachment.count>0 do begin TObject(f_attachment[0]).free; f_attachment.delete(0); end; end; (*@\\\000000031E*) (*@/// function t_mime.GetNumberOfAttachments: integer; *) function t_mime.GetNumberOfAttachments: integer; begin result:=f_attachment.count; end; (*@\\\0000000317*)
(*@/// procedure t_mime.action; *) procedure t_mime.action; var data, encoded: TStringList; i,j,p: integer; attach: t_attachment; begin if f_mail=NIL then EXIT; boundary:=inttostr(round((now-encodedate(1970,1,1))*86400))+inttohex(my_ip_address,8)+''''==''''; data:=NIL; p:=-1; try data:=TStringList.Create; f_mail.Header.add(''''MIME-Version: 1.0''''); f_mail.Header.add(''''Content-Type: multipart/mixed; boundary="''''+boundary+''''"''''); f_mail.Header.add(''''Content-Transfer-Encoding: 7bit''''); data.assign(f_mail.Body); if data.count>0 then begin f_mail.Body.clear; p:=AttachText(data); end; for i:=0 to f_attachment.count-1 do begin attach:=t_attachment(f_attachment[i]); f_mail.Body.Add(''''''''); f_mail.Body.Add(''''--''''+boundary); f_mail.Body.Add(''''Content-Type: ''''+attach.kind); if attach.disposition<>'''''''' then f_mail.Body.Add(''''Content-Disposition: ''''+attach.disposition); case attach.encoding of ec_base64: f_mail.Body.Add(''''Content-Transfer-Encoding: base64''''); ec_quotedprintable: f_mail.Body.Add(''''Content-Transfer-Encoding: quoted-printable''''); end; f_mail.Body.Add(''''''''); case attach.encoding of (*@/// ec_base64: *) ec_base64: begin encoded:=encode_base64(attach.data); f_mail.Body.AddStrings(encoded); encoded.free; end; (*@\\\0000000201*) (*@/// ec_quotedprintable: // only for text ! *) ec_quotedprintable: begin for j:=0 to attach.text.count-1 do f_mail.Body.Add(eight2seven_quoteprint(attach.text[j])); end; (*@\\\0000000315*) (*@/// ec_none: // only for text ! *) ec_none: begin for j:=0 to attach.text.count-1 do f_mail.Body.Add(eight2seven_quoteprint(attach.text[j])); end; (*@\\\0000000403*) end; end; f_mail.Body.Add(''''''''); f_mail.Body.Add(''''--''''+boundary+''''--''''); f_mail.action; if data.count>0 then f_mail.body:=data; finally data.free; RemoveAttachment(p); end; end; (*@\\\0000002201*) (*@/// procedure t_mime.SetMail(mail: TStringlist); *) procedure t_mime.SetMail(mail: TStringlist); (*@/// procedure strip_header(const line:string; var field,data: string); *) procedure strip_header(const line:string; var field,data: string); var h: integer; begin h:=pos('''':'''',line); if h>0 then begin field:=lowercase(copy(line,1,h-1)); data:=trim(copy(line,h+1,length(line))); end else begin field:=''''''''; data:=''''''''; [1] [2] 下一页 [ORACLE]ORACLE SQL性能优化系列 (九)
|