Project Structure

• SendList.dpr
• SendForm.pas
• SendForm.dfm

program SendList;

uses
  Forms,
  SendForm in 'SendForm.pas' {MainForm};

{$R *.RES}

begin
  Application.Title := 'SimpleMail';
  Application.CreateForm(TMainForm, MainForm);
  Application.Run;
end.

unit SendForm;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, Menus,
  StdCtrls, Dialogs, Buttons, Messages, ExtCtrls, ComCtrls,
  Psock, NMsmtp, IdComponent, IdTCPConnection, IdTCPClient,
  IdMessageClient, IdSMTP, IdBaseComponent, IdMessage;

type
  TMainForm = class(TForm)
    Panel2: TPanel;
    reMessageText: TRichEdit;
    Panel1: TPanel;
    Label1: TLabel;
    eName: TEdit;
    Splitter1: TSplitter;
    ListLog: TListBox;
    Label2: TLabel;
    eSubject: TEdit;
    Label3: TLabel;
    BbtnAddToList: TButton;
    ListAddr: TListBox;
    BtnRemove: TButton;
    BtnFind: TButton;
    Label5: TLabel;
    eFrom: TEdit;
    BtnSendAll: TButton;
    eServer: TEdit;
    MailMessage: TIdMessage;
    Mail: TIdSMTP;
    Label4: TLabel;
    Label6: TLabel;
    eUserName: TEdit;
    Password: TLabel;
    ePassword: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure BtnSendAllClick(Sender: TObject);
    procedure BbtnAddToListClick(Sender: TObject);
    procedure BtnRemoveClick(Sender: TObject);
    procedure BtnFindClick(Sender: TObject);
    procedure MailConnected(Sender: TObject);
    procedure MailDisconnected(Sender: TObject);
    procedure MailStatus(axSender: TObject; const axStatus: TIdStatus;
      const asStatusText: String);
    procedure MailWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCountMax: Integer);
    procedure MailWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
  private
    FileName: string;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

procedure TMainForm.FormCreate(Sender: TObject);
begin
  // load the list of addresses
  FileName := ChangeFileExt (Application.ExeName, '.txt');
  ListAddr.Items.LoadFromFile (FileName);
  ListLog.Items.Add ('Addresses: ' + IntToStr (
    ListAddr.Items.Count));
  // select the first item
  ListAddr.ItemIndex := 0;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  // save the list of addresses
  ListAddr.Items.SaveToFile (FileName);
end;

const
  BccInMsg = 30;

procedure TMainForm.BtnSendAllClick(Sender: TObject);
var
  nItem: Integer;
  Res: Word;
begin
  Res := MessageDlg ('Start sending from item ' +
      IntToStr (ListAddr.ItemIndex) + ' (' +
      ListAddr.Items [ListAddr.ItemIndex] + ')?'#13 +
      '(No starts form 0)',
      mtConfirmation,
      [mbYes, mbNo, mbCancel], 0);
  if Res = mrCancel then
    Exit;
  if Res = mrYes then
    nItem := ListAddr.ItemIndex
  else
    nItem := 0;

  // connect
  Mail.Host := eServer.Text;
  Mail.UserID := eUserName.Text;
  if ePassword.Text <> '' then
  begin
    Mail.Password := ePassword.Text;
    Mail.AuthenticationType := atLogin;
  end;
  Mail.Connect;

  // send the messages, one by one, prepending a custom message
  try
    // set the fixed part of the header
    MailMessage.From.Name := eFrom.Text;
    MailMessage.Subject := eSubject.Text;
    MailMessage.Body.SetText (
      reMessageText.Lines.GetText);
    MailMessage.Body.Insert (0, 'Hello');

    while nItem < ListAddr.Items.Count do
    begin
      // show the current selection
      Application.ProcessMessages;
      ListAddr.ItemIndex := nItem;
      MailMessage.Body [0] := 'Hello ' + ListAddr.Items [nItem];
      MailMessage.Recipients.EMailAddresses := ListAddr.Items [nItem];
      Mail.Send(MailMessage);
      Inc (nItem);
    end;
  finally // we're done
    Mail.Disconnect;
  end;
end;

procedure TMainForm.BbtnAddToListClick(Sender: TObject);
begin
  ListAddr.ItemIndex :=
    ListAddr.Items.Add (eName.Text);
end;

procedure TMainForm.BtnRemoveClick(Sender: TObject);
begin
  // copy the item to the name edit box and remove it
  eName.Text := ListAddr.Items [ListAddr.ItemIndex];
  ListAddr.Items.Delete (ListAddr.ItemIndex);
end;

procedure TMainForm.BtnFindClick(Sender: TObject);
var
  I: Integer;
begin
  for I := 0 to ListAddr.Items.Count - 1 do
    if Pos (eName.Text, ListAddr.Items [I]) > 0 then
    begin
      ListAddr.ItemIndex := I;
      Break;
    end;
  Beep;
end;

procedure TMainForm.MailConnected(Sender: TObject);
begin
  ListLog.Items.Add ('Connected to host');
end;

procedure TMainForm.MailDisconnected(Sender: TObject);
begin
  ListLog.Items.Add ('Disconnected from host');
end;

procedure TMainForm.MailStatus(axSender: TObject;
  const axStatus: TIdStatus; const asStatusText: String);
begin
  ListLog.Items.Add (asStatusText);
end;

procedure TMainForm.MailWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin
  ListLog.Items.Add ('Sending to: ' +
    MailMessage.Recipients.EMailAddresses);
end;

procedure TMainForm.MailWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
  ListLog.Items.Add ('Done');
end;

end.

object MainForm: TMainForm
  Left = 193
  Top = 109
  AutoScroll = False
  Caption = 'Send List'
  ClientHeight = 501
  ClientWidth = 622
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clBlack
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  Position = poDefaultPosOnly
  OnClose = FormClose
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Splitter1: TSplitter
    Left = 321
    Top = 276
    Width = 3
    Height = 225
    Cursor = crHSplit
  end
  object Panel1: TPanel
    Left = 0
    Top = 65
    Width = 622
    Height = 211
    Align = alTop
    BevelOuter = bvLowered
    TabOrder = 2
    object Label1: TLabel
      Left = 12
      Top = 11
      Width = 31
      Height = 13
      Hint = 'Recipient''s name(s), comma delimited'
         Caption = 'Name:'
      ParentShowHint = False
      ShowHint = True
    end
    object Label3: TLabel
      Left = 12
      Top = 34
      Width = 19
      Height = 13
      Caption = 'List:'
    end
    object eName: TEdit
      Left = 48
      Top = 7
      Width = 441
      Height = 21
      ParentShowHint = False
      ShowHint = False
      TabOrder = 0
    end
    object BbtnAddToList: TButton
      Left = 504
      Top = 32
      Width = 75
      Height = 25
      Caption = 'Add To &List'
      TabOrder = 1
      OnClick = BbtnAddToListClick
    end
    object ListAddr: TListBox
      Left = 48
      Top = 32
      Width = 441
      Height = 169
      ItemHeight = 13
      Sorted = True
      TabOrder = 2
    end
    object BtnRemove: TButton
      Left = 504
      Top = 72
      Width = 75
      Height = 25
      Caption = '&Remove'
      TabOrder = 3
      OnClick = BtnRemoveClick
    end
    object BtnFind: TButton
      Left = 504
      Top = 112
      Width = 75
      Height = 25
      Caption = '&Find'
      TabOrder = 4
      OnClick = BtnFindClick
    end
    object BtnSendAll: TButton
      Left = 504
      Top = 152
      Width = 75
      Height = 25
      Caption = 'Send to &All'
      TabOrder = 5
      OnClick = BtnSendAllClick
    end
  end
  object reMessageText: TRichEdit
    Left = 0
    Top = 276
    Width = 321
    Height = 225
    Align = alLeft
    Lines.Strings = (
      'This is a test message.'
      ''
      'Message sent by the Send List program '
      'of the book Mastering Delphi.')
    TabOrder = 1
  end
  object Panel2: TPanel
    Left = 0
    Top = 0
    Width = 622
    Height = 65
    Align = alTop
    BevelOuter = bvNone
    TabOrder = 0
    object Label2: TLabel
      Left = 11
      Top = 8
      Width = 39
      Height = 13
      Hint = 'Subject of this message'
      Caption = 'Subject:'
      ParentShowHint = False
      ShowHint = True
    end
    object Label5: TLabel
      Left = 16
      Top = 40
      Width = 26
      Height = 13
      Caption = 'From:'
    end
    object Label4: TLabel
      Left = 264
      Top = 8
      Width = 25
      Height = 13
      Caption = 'Host:'
    end
    object Label6: TLabel
      Left = 240
      Top = 37
      Width = 53
      Height = 13
      Caption = 'UserName:'
    end
    object Password: TLabel
      Left = 426
      Top = 37
      Width = 49
      Height = 13
      Caption = 'Password:'
    end
    object eSubject: TEdit
      Left = 56
      Top = 4
      Width = 153
      Height = 21
      TabOrder = 0
    end
    object eFrom: TEdit
      Left = 56
      Top = 35
      Width = 153
      Height = 21
      TabOrder = 1
    end
    object eServer: TEdit
      Left = 295
      Top = 4
      Width = 121
      Height = 21
      TabOrder = 2
    end
    object eUserName: TEdit
      Left = 296
      Top = 32
      Width = 121
      Height = 21
      TabOrder = 3
    end
    object ePassword: TEdit
      Left = 480
      Top = 32
      Width = 121
      Height = 21
      PasswordChar = '*'
      TabOrder = 4
    end
  end
  object ListLog: TListBox
    Left = 324
    Top = 276
    Width = 298
    Height = 225
    Align = alClient
    ItemHeight = 13
    TabOrder = 3
  end
  object MailMessage: TIdMessage
    BccList = <>
    CCList = <>
    Recipients = <>
    ReplyTo = <>
    Left = 144
    Top = 80
  end
  object Mail: TIdSMTP
    OnStatus = MailStatus
    OnDisconnected = MailDisconnected
    OnWorkBegin = MailWorkBegin
    OnWorkEnd = MailWorkEnd
    OnConnected = MailConnected
    Left = 144
    Top = 120
  end
end