unit NsSmtpClient; interface uses SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs, {Indy} IdMessage, IDAttachmentFile, IDMessageparts, IdSMTP, IdEMailAddress, IdComponent, IDText, IdCoderHeader, {Ns} nsStr;//NsLogFiles type TMailListType = (ltCC,ltBCC,ltTo,ltReplyTo); TMailContentType = (ctText,ctHtml,ctMixed,ctAlternative); TMailStatusEvent = procedure(ASender: TObject; const AStatusText: string) of object; TNsSmtpClient = class(TComponent) private FAttachments: TStringlist; FAttachmentSize: Integer; FLogFile: string; FLogStrings: TStringList; FMailSubject: string; FMailType: TMailContentType; FMailTypeTmp: string; FOnMailStatus: TMailStatusEvent; FSmtpPassword: string; FSmtpPort: Integer; FSmtpServer: string; FSmtpUser: string; procedure AttachmentChange(Sender: TObject); procedure DoStatusChange(StatusText: String); function GetAttachments: TStringlist; function GetLogPath: string; function GetMailBCC: string; function GetMailBody: TStrings; function GetMailCC: string; function GetMailFrom: TIdEMailAddressItem; function GetMailReplyTo: string; function GetMailTo: string; function GetPriority: TIdMessagePriority; procedure InitializeISO(var VTransferHeader: TTransfer; var VHeaderEncoding: Char; var VCharSet: string); procedure SetAttachments(Value: TStringlist); procedure SetLogFile(const Value: string); procedure SetMailBCC(const Value: string); procedure SetMailBody(Value: TStrings); procedure SetMailCC(const Value: string); procedure SetMailFrom(Value: TIdEMailAddressItem); procedure SetMailReplyTo(const Value: string); procedure SetMailSubject(const Value: string); procedure SetMailTo(const Value: string); procedure SetMailType(const Value: TMailContentType); procedure SetPriority(Value: TIdMessagePriority); procedure SetSmtpUser(const Value: string); procedure SmtpStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string); public FAttachmentCount: Integer; Mail: TIdMessage; Smtp: TIdSmtp; constructor Create(aOwner: TComponent); override; destructor Destroy; override; procedure AddAttachment(aFile: String); procedure AddMailAddr(TargetList: TMailListType; addr, aName: String); procedure ClearAttachments; procedure ClearMailList(TargetList: TMailListType); procedure ClearText; function Send: Boolean; virtual; property AttachmentCount: Integer read FAttachmentCount; property AttachmentSize: Integer read FAttachmentSize; property MailBody: TStrings read GetMailBody write SetMailBody; published property Attachments: TStringlist read GetAttachments write SetAttachments; property LogFile: string read FLogFile write SetLogFile; property LogPath: string read GetLogPath; property LogStrings: TStringList read FLogStrings; property MailBCC: string read GetMailBCC write SetMailBCC; property MailCC: string read GetMailCC write SetMailCC; property MailFrom: TIdEMailAddressItem read GetMailFrom write SetMailFrom; property MailReplyTo: string read GetMailReplyTo write SetMailReplyTo; property MailSubject: string read FMailSubject write SetMailSubject; property MailTo: string read GetMailTo write SetMailTo; property MailType: TMailContentType read FMailType write SetMailType; property Priority: TIdMessagePriority read GetPriority write SetPriority; property SmtpPassword: string read FSmtpPassword write FSmtpPassword; property SmtpPort: Integer read FSmtpPort write FSmtpPort; property SmtpServer: string read FSmtpServer write FSmtpServer; property SmtpUser: string read FSmtpUser write SetSmtpUser; property OnMailStatus: TMailStatusEvent read FOnMailStatus write FOnMailStatus; end; procedure Register; const msgMailSent = 'Mail sent sucessfully'; msgMailFail = 'Mail sent unsuccessfully'; implementation procedure Register; begin RegisterComponents('_Paul', [TNsSmtpClient]); end; { ******************************** TNsSmtpClient ********************************* } constructor TNsSmtpClient.Create(aOwner: TComponent); begin inherited Create(aOwner); FLogStrings :=Tstringlist.Create; Mail := TIDMessage.create(self); Smtp := TIDSmtp.create(self); MailType := ctHtml; SmtpPort := 25; //LogFile := 'MailLog'; Priority := mpNormal; Attachments.OnChange := AttachmentChange; mail.OnInitializeISO := InitializeISO; mail.Encoding := meMIME; mail.CharSet := 'GB2312'; mail.IsEncoded := true; end; destructor TNsSmtpClient.Destroy; begin FLogStrings.Free; inherited; // TODO -cMM: TNsSmtpClient.Destroy default body inserted end; procedure TNsSmtpClient.AddAttachment(aFile: String); begin if FileExists(aFile) then begin with TIdAttachmentFile.Create(mail.MessageParts,aFile) do boundaryBegin := true; Mail.ContentType := 'multipart/mixed'; Inc(FAttachmentCount); end; end; procedure TNsSmtpClient.AddMailAddr(TargetList: TMailListType; addr, aName: String); procedure SetMailItem(aItem: TIdEMailAddressItem; Addr, aName: String); begin aItem.Address := addr; aItem.Name := aName; end; begin case TargetList of ltBcc : SetMailItem(mail.BCCList.add,addr,aName); ltCC : SetMailItem(mail.CCList.add,addr,aName); ltTo : SetMailItem(mail.Recipients.add,addr,aName); ltReplyTo : SetMailItem(mail.ReplyTo.add,addr,aName); end; end; procedure TNsSmtpClient.AttachmentChange(Sender: TObject); var I: Integer; begin ClearAttachments; FAttachmentCount := 0; for i := 0 to FAttachments.count-1 do AddAttachment(FAttachments[i]); end; procedure TNsSmtpClient.ClearAttachments; var I: Integer; begin i := 0; while i< mail.MessageParts.count do begin if mail.MessageParts[i] is TIDAttachmentFile then TIDAttachmentFile(mail.MessageParts[i]).Destroy else inc(i); end; end; procedure TNsSmtpClient.ClearMailList(TargetList: TMailListType); begin case TargetList of ltBcc : mail.BCCList.clear; ltCC : mail.CCList.Clear; ltTo : mail.Recipients.Clear; ltReplyTo : Mail.ReplyTo.Clear; end; end; procedure TNsSmtpClient.ClearText; var I: Integer; begin i := 0; while i< mail.MessageParts.count do begin if mail.MessageParts[i] is TIDText then TIDText(mail.MessageParts[i]).Destroy else inc(i); end; end; procedure TNsSmtpClient.DoStatusChange(StatusText: String); begin FLogStrings.Add(StatusText); //addlog(StatusText); if Assigned(FOnMailStatus) then FOnMailStatus(self,StatusText); end; function TNsSmtpClient.GetAttachments: TStringlist; begin if FAttachments=nil then FAttachments := TstringList.create; Result := FAttachments; end; function TNsSmtpClient.GetLogPath: string; begin Result := ExtractFilePath(ParamStr(0))+'Log/'; if not DirectoryExists(Result) then CreateDir(Result) end; function TNsSmtpClient.GetMailBCC: string; begin Result := Mail.BccList.EMailAddresses; end; function TNsSmtpClient.GetMailBody: TStrings; begin Result := Mail.Body; end; function TNsSmtpClient.GetMailCC: string; begin Result := Mail.CCList.EMailAddresses; end; function TNsSmtpClient.GetMailFrom: TIdEMailAddressItem; begin Result := Mail.From; end; function TNsSmtpClient.GetMailReplyTo: string; begin Result := Mail.ReplyTo.EMailAddresses; end; function TNsSmtpClient.GetMailTo: string; begin Result := Mail.Recipients.EMailAddresses; end; function TNsSmtpClient.GetPriority: TIdMessagePriority; begin Result := mail.Priority; end; procedure TNsSmtpClient.InitializeISO(var VTransferHeader: TTransfer; var VHeaderEncoding: Char; var VCharSet: string); begin // VCharSet := 'UTF-8'; // TODO -cMM: TNsSmtpClient.InitializeISO default body inserted end; function TNsSmtpClient.Send: Boolean; begin with smtp do begin Result := false; ClearText; FLogStrings.Clear; if (AttachmentCount>0)and(MailBody.text>'') then with TIDText.create(mail.messageparts,MailBody) do ContentType := FMailTypeTmp; Smtp.OnStatus := SmtpStatus; port := SmtpPort; host := SmtpServer; UserName := SmtpUser; Password := SmtpPassword; //Mail.GenerateHeader; // mail.Body.Text := utf8encode(mail.Body.text); // mail.Subject := utf8encode(mail.subject); try try connect; DoStatusChange(format('MailTo:%S',[MailTo])); Send(mail); DoStatusChange(msgMailSent); Result := true; except on e : exception do begin DoStatusChange(e.message); DoStatusChange(msgMailfail); Result := false; end; end; finally disconnect; end; end; end; procedure TNsSmtpClient.SetAttachments(Value: TStringlist); begin with FAttachments do begin BeginUpdate; try Assign(Value); finally EndUpdate; end; end; end; procedure TNsSmtpClient.SetLogFile(const Value: string); begin FLogFile := Value; //NsLogFile := LogPath+value; end; procedure TNsSmtpClient.SetMailBCC(const Value: string); begin if Value<>'' then mail.BCCList.EMailAddresses := value; end; procedure TNsSmtpClient.SetMailBody(Value: TStrings); begin Mail.Body.assign(Value); end; procedure TNsSmtpClient.SetMailCC(const Value: string); begin if Value<>'' then mail.CCList.EMailAddresses := value; end; procedure TNsSmtpClient.SetMailFrom(Value: TIdEMailAddressItem); begin Mail.From := value; end; procedure TNsSmtpClient.SetMailReplyTo(const Value: string); begin if Value<>'' then mail.ReplyTo.EMailAddresses := value; end; procedure TNsSmtpClient.SetMailSubject(const Value: string); begin FMailSubject := Value; Mail.Subject := Value; end; procedure TNsSmtpClient.SetMailTo(const Value: string); begin if Value<>'' then mail.Recipients.EMailAddresses := value; end; procedure TNsSmtpClient.SetMailType(const Value: TMailContentType); begin FMailType := Value; case Value of ctHtml : Mail.contentType := 'text/html'; ctText : Mail.ContentType := 'text/plain'; ctMixed: Mail.ContentType := 'multipart/mixed'; ctAlternative : Mail.ContentType := 'multipart/alternative' end; FMailTypeTmp := Mail.ContentType; end; procedure TNsSmtpClient.SetPriority(Value: TIdMessagePriority); begin Mail.priority := Value; end; procedure TNsSmtpClient.SetSmtpUser(const Value: string); begin if (MailFrom.Address=FSmtpUser) or (MailFrom.Address='') then MailFrom.Address := Value; FSmtpUser := Value; end; procedure TNsSmtpClient.SmtpStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string); begin DoStatusChange(AStatusText); end; end.