Пример работы с SMTP

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('vit@vingrad.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

Другое по теме:

• Отправка письма
• MAPI и MS Exchange
• Использование SMTP Relay Server