unit Unit1;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls, ExtCtrls, ComCtrls, Psock, NMsmtp; 
 
 
 
 
type
TForm1 = class(TForm)
  Memo: TRichEdit;
  Panel1: TPanel;
  SMTP: TNMSMTP;
  Panel2: TPanel;
  FromAddress: TEdit;
  predefined: TLabel;
  FromName: TEdit;
  Subject: TEdit;
  LocalProgram: TEdit;
  ReplyTo: TEdit;
  islog: TCheckBox;
  Host: TEdit;
  Port: TEdit;
  userid: TEdit;
  Button1: TButton;
  procedure Button1Click(Sender: TObject);
private
  Procedure CleanContext;
  procedure PerformConnection;
  procedure AddMessage(msg:string; color:integer);
  procedure log(inpt :string);
  Procedure SetSMTP;
public
  function SendEmail(_to, cc, bcc, Subject, body, attachment:string; HTMLFormat:boolean):boolean;
end;

var Form1: TForm1;

implementation
{$R *.DFM}

Procedure TForm1.SetSMTP;
begin
 SMTP.Host:=Host.Text; 
 
 SMTP.Port:=strtoint(Port.text); 
 
 SMTP.UserID:=userid.text; 
 
 
end;

Function GetEmailDateTime:string;
var tz:_time_Zone_information;
    s:string;
begin
 GetTimeZoneInformation(tz); 
 
 if (tz.Bias*100 div 60)<1000 then 
 
   s:=format(' -0%d',[tz.Bias*100 div 60]) 
 
 else 
 
   s:=format(' -%d',[tz.Bias*100 div 60]); 
 
 result:=formatdatetime('ddd, dd mmm yyyy hh:nn:ss',now)+s; 
 
 
end;

Procedure TForm1.CleanContext;
{set default values, some of them comes from "Setup" form}
begin
 SMTP.PostMessage.FromAddress:=FromAddress.text; 
 
 SMTP.PostMessage.FromName:=FromName.text; 
 
 SMTP.PostMessage.ToAddress.Clear; 
 
 SMTP.PostMessage.ToCarbonCopy.clear; 
 
 SMTP.PostMessage.ToBlindCarbonCopy.clear; 
 
 SMTP.PostMessage.Body.clear; 
 
 SMTP.PostMessage.Attachments.clear; 
 
 SMTP.PostMessage.Subject:=Subject.text; 
 
 SMTP.PostMessage.LocalProgram:=LocalProgram.text; 
 
 (*Mon, 27 Nov 2000 12:37:46 -0700*) 
 
 SMTP.PostMessage.Date:=GetEmailDateTime; 
 
 SMTP.PostMessage.ReplyTo:=ReplyTo.Text; 
 
 
end;

procedure TForm1.log(inpt :string);
  var outf:textfile;
begin  {writing in the log file}
 if not islog.checked then exit; 
 
 assignfile(outf, changefileext(paramstr(0), '.log')); 
 
 if fileexists(changefileext(paramstr(0), '.log')) then 
 
   append(outf) 
 
 else 
 
   rewrite(outf); 
 
 writeln(outf, datetimetostr(now)+'|'+inpt); 
 
 closefile(outf); 
 
 
end;

procedure TForm1.AddMessage(msg:string; color:integer);
begin {showing in the memo field progress...}
 while memo.lines.Count>2000 do memo.lines.Delete(0); 
 
 memo.sellength:=0; 
 
 memo.selstart:=length(memo.text); 
 
 memo.selattributes.Color:=Color; 
 
 memo.seltext:=#13#10+DateTimeTostr(now)+' '+msg; 
 
 memo.perform($00B7,0,0); 
 
 Application.ProcessMessages; 
 
 if color<>clRed then log(DateTimeTostr(now)+' '+msg) else log('Error: '+DateTimeTostr(now)+' '+msg); 
 
 
end;

procedure TForm1.PerformConnection;
begin
 while (not SMTP.connected) do 
 
   begin 
 
     SetSMTP; 
 
     AddMessage('Connecting to SMTP',clBlue); 
 
     application.processmessages; 
 
     try 
 
       SMTP.Connect; 
 
       AddMessage('No Errors',clBlue); 
 
     except 
 
       on e:exception do AddMessage('Error conection: '+e.message,clBlue); 
 
     end; 
 
   end; 
 
 
end;

Function TForm1.SendEmail(_to, cc, bcc, Subject, body,  attachment:string; HTMLFormat:boolean):boolean;
begin
 PerformConnection; 
 
 result:=true; 
 
 CleanContext; 
 
 try 
 
   if (attachment<>'') and (not Fileexists(attachment)) then 
 
     begin 
 
       AddMessage('Attachment is not ready yet ('+ attachment+') ', clNavy); 
 
       sleep(300); 
 
       result:=false; 
 
       exit; 
 
     end; 
 
   SMTP.PostMessage.ToAddress.text:=StringReplace(_to, ';',#13#10, [rfReplaceAll, rfIgnoreCase]); 
 
   if cc<>'' then SMTP.PostMessage.ToCarbonCopy.text:=StringReplace(cc, ';',#13#10, [rfReplaceAll, rfIgnoreCase]); 
 
   if bcc<>'' then SMTP.PostMessage.ToBlindCarbonCopy.text:=StringReplace(bcc, ';',#13#10, [rfReplaceAll, rfIgnoreCase]); 
 
   if Subject<>'' then SMTP.PostMessage.Subject:=Subject; 
 
   if HTMLFormat then SMTP.SubType:=mtPlain else SMTP.SubType:=mtHtml; 
 
   SMTP.PostMessage.Body.Text:=Body; 
 
   if attachment<>'' then SMTP.PostMessage.Attachments.add(attachment); 
 
   AddMessage('Sending to '+ _to, clGreen); 
 
   SMTP.SendMail; 
 
   AddMessage('Complete.'+#13#10, clGreen); 
 
 except 
 
   on e:sysutils.exception do 
 
     begin 
 
       AddMessage(e.message, clRed); 
 
       result:=false; 
 
     end; 
 
 end; 
 
 
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  SendEmail('somewhere@somedomain.ru', '', '', 'test', 'body',  '', False);
end;

end.


А это форма для этого примера:

object Form1: TForm1
 Left = 278 
 
 Top = 108 
 
 Width = 539 
 
 Height = 480 
 
 Caption = 'Form1' 
 
 Color = clBtnFace 
 
 Font.Charset = DEFAULT_CHARSET 
 
 Font.Color = clWindowText 
 
 Font.Height = -11 
 
 Font.Name = 'MS Sans Serif' 
 
 Font.Style = [] 
 
 OldCreateOrder = False 
 
 PixelsPerInch = 96 
 
 TextHeight = 13 
 
 object Memo: TRichEdit 
 
 
 Left = 0 
 
 Top = 0 
 
 Width = 346 
 
 Height = 420 
 
 Align = alClient 
 
 Lines.Strings = ('Memo') 
 
 TabOrder = 0 
 
 
 end 
 
 object Panel1: TPanel 
 
 
 Left = 0 
 
 Top = 420 
 
 Width = 531 
 
 Height = 33 
 
 Align = alBottom 
 
 Caption = 'Panel1' 
 
 TabOrder = 1 
 
 object Button1: TButton 
 
 
 Left = 440 
 
 Top = 8 
 
 Width = 75 
 
 Height = 25 
 
 Caption = 'Button1' 
 
 TabOrder = 0 
 
 OnClick = Button1Click 
 
 
 end 
 
 
 end 
 
 object Panel2: TPanel 
 
 
 Left = 346 
 
 Top = 0 
 
 Width = 185 
 
 Height = 420 
 
 Align = alRight 
 
 Caption = 'Panel2' 
 
 TabOrder = 2 
 
 object predefined: TLabel 
 
 
 Left = 8 
 
 Top = 8 
 
 Width = 87 
 
 Height = 13 
 
 Caption = 'predefined values:' 
 
 
 end 
 
 object FromAddress: TEdit 
 
 
 Left = 24 
 
 Top = 32 
 
 Width = 121 
 
 Height = 21 
 
 TabOrder = 0 
 
 Text = 'FromAddress' 
 
 
 end 
 
 object FromName: TEdit 
 
 
 Left = 24 
 
 Top = 56 
 
 Width = 121 
 
 Height = 21 
 
 TabOrder = 1 
 
 Text = 'FromName' 
 
 
 end 
 
 object Subject: TEdit 
 
 
 Left = 24 
 
 Top = 80 
 
 Width = 121 
 
 Height = 21 
 
 TabOrder = 2 
 
 Text = 'Subject' 
 
 
 end 
 
 object LocalProgram: TEdit 
 
 
 Left = 24 
 
 Top = 104 
 
 Width = 121 
 
 Height = 21 
 
 TabOrder = 3 
 
 Text = 'LocalProgram' 
 
 
 end 
 
 object ReplyTo: TEdit 
 
 
 Left = 24 
 
 Top = 128 
 
 Width = 121 
 
 Height = 21 
 
 TabOrder = 4 
 
 Text = 'ReplyTo' 
 
 
 end 
 
 object islog: TCheckBox 
 
 
 Left = 32 
 
 Top = 168 
 
 Width = 97 
 
 Height = 17 
 
 Caption = 'islog' 
 
 TabOrder = 5 
 
 
 end 
 
 object Host: TEdit 
 
 
 Left = 24 
 
 Top = 240 
 
 Width = 121 
 
 Height = 21 
 
 TabOrder = 6 
 
 Text = 'Host' 
 
 
 end 
 
 object Port: TEdit 
 
 
 Left = 24 
 
 Top = 264 
 
 Width = 121 
 
 Height = 21 
 
 TabOrder = 7 
 
 Text = 'Port' 
 
 
 end 
 
 object userid: TEdit 
 
 
 Left = 24 
 
 Top = 288 
 
 Width = 121 
 
 Height = 21 
 
 TabOrder = 8 
 
 Text = 'userid' 
 
 
 end 
 
 
 end 
 
 object SMTP: TNMSMTP 
 
 
 Port = 25 
 
 ReportLevel = 0 
 
 EncodeType = uuMime 
 
 ClearParams = True 
 
 SubType = mtPlain 
 
 Charset = 'us-ascii' 
 
 Left = 296 
 
 Top = 32 
 
 
 end 
 
 
end