Marco Cantù 1998, Mastering Delphi 4
Project: SENDLIST.DPR
Project Structure
SENDLIST.DPR
program SendList;
uses
Forms,
SendForm in 'SendForm.pas' {MainForm};
{$R *.RES}
begin
Application.Title := 'SimpleMail';
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.
SENDFORM.PAS
unit SendForm;
interface
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, Menus,
StdCtrls, Dialogs, Buttons, Messages, ExtCtrls, ComCtrls,
Psock, NMsmtp;
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;
Mail: TNMSMTP;
Label5: TLabel;
eFrom: TEdit;
BtnSendAll: TButton;
eServer: 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 MailSendStart(Sender: TObject);
procedure MailSuccess(Sender: TObject);
procedure MailFailure(Sender: TObject);
procedure MailConnect(Sender: TObject);
procedure MailDisconnect(Sender: TObject);
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, nBcc: 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 := eFrom.Text;
Mail.Connect;
// set the fixed part of the header
Mail.PostMessage.FromAddress := eFrom.Text;
Mail.PostMessage.ToAddress.Clear;
Mail.PostMessage.ToAddress.Add (eFrom.Text);
Mail.PostMessage.Subject := eSubject.Text;
Mail.PostMessage.Body.SetText (
reMessageText.Lines.GetText);
// send to list, in groups
while nItem < ListAddr.Items.Count do
begin
// show the current selection
ListAddr.ItemIndex := nItem;
Application.ProcessMessages;
// fill the bcc list
Mail.PostMessage.ToBlindCarbonCopy.Clear;
nBcc := 0;
while (nBcc < BccInMsg) and (nBcc + nItem < ListAddr.Items.Count) do
begin
Mail.PostMessage.ToBlindCarbonCopy.Add (ListAddr.Items [nItem + nBcc]);
Inc (nBcc);
end;
// send the message
Mail.SendMail;
// increse the counter
Inc (nItem, nBcc);
end;
// we're done
Mail.Disconnect;
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.MailSendStart(Sender: TObject);
begin
ListLog.Items.Add ('Sending to group: ' +
Mail.PostMessage.ToBlindCarbonCopy [0]);
end;
procedure TMainForm.MailSuccess(Sender: TObject);
begin
ListLog.Items.Add ('Done');
end;
procedure TMainForm.MailFailure(Sender: TObject);
begin
ListLog.Items.Add ('Error');
end;
procedure TMainForm.MailConnect(Sender: TObject);
begin
ListLog.Items.Add ('Connected to host');
end;
procedure TMainForm.MailDisconnect(Sender: TObject);
begin
ListLog.Items.Add ('Disconnected for host');
end;
end.
SENDFORM.DFM
object MainForm: TMainForm
Left = 193
Top = 109
AutoScroll = False
Caption = 'Send List'
ClientHeight = 501
ClientWidth = 593
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 = 241
Width = 3
Height = 260
Cursor = crHSplit
end
object Panel1: TPanel
Left = 0
Top = 30
Width = 593
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 = 241
Width = 321
Height = 260
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 = 593
Height = 30
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 = 208
Top = 8
Width = 44
Height = 13
Caption = 'From/To:'
end
object eSubject: TEdit
Left = 53
Top = 4
Width = 148
Height = 21
TabOrder = 0
end
object eFrom: TEdit
Left = 256
Top = 3
Width = 153
Height = 21
TabOrder = 1
end
object eServer: TEdit
Left = 463
Top = 4
Width = 121
Height = 21
TabOrder = 2
end
end
object ListLog: TListBox
Left = 324
Top = 241
Width = 269
Height = 260
Align = alClient
ItemHeight = 13
TabOrder = 3
end
object Mail: TNMSMTP
Port = 25
ReportLevel = 0
OnDisconnect = MailDisconnect
OnConnect = MailConnect
EncodeType = uuMime
ClearParams = False
SubType = mtPlain
OnSendStart = MailSendStart
OnSuccess = MailSuccess
OnFailure = MailFailure
Left = 72
Top = 78
end
end
Copyright Marco Cantù 1998