www.pudn.com > smtpcli.zip > MAILSND1.PAS
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Author: François PIETTE
Object: How to use TSmtpCli component
Creation: 09 october 1997
Version: 2.00
EMail: francois.piette@pophost.eunet.be francois.piette@rtfm.be
http://www.rtfm.be/fpiette
Support: Use the mailing list twsocket@rtfm.be See website for details.
Legal issues: Copyright (C) 1997, 1998 by François PIETTE
Rue de Grady 24, 4053 Embourg, Belgium. Fax: +32-4-365.74.56
This software is provided 'as-is', without any express or
implied warranty. In no event will the author be held liable
for any damages arising from the use of this software.
Permission is granted to anyone to use this software for any
purpose, including commercial applications, and to alter it
and redistribute it freely, subject to the following
restrictions:
1. The origin of this software must not be misrepresented,
you must not claim that you wrote the original software.
If you use this software in a product, an acknowledgment
in the product documentation would be appreciated but is
not required.
2. Altered source versions must be plainly marked as such, and
must not be misrepresented as being the original software.
3. This notice may not be removed or altered from any source
distribution.
Updates:
Oct 26, 1997 V1.00 Released
Jan 10, 1998 V1.01 Added a Port property
Feb 15, 1998 V1.02 Added file attachement support
Mar 06, 1998 V1.03 Check for DisplayMemo overflow (100 lines allowed)
Aug 03, 1998 V2.00 Revised for new asynchronous SMTP component version
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit MailSnd1;
interface
uses
WinTypes, WinProcs, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, SmtpProt, StdCtrls, ExtCtrls, IniFiles;
const
SmtpTestVersion = 2.00;
type
TSmtpTestForm = class(TForm)
MsgMemo: TMemo;
DisplayMemo: TMemo;
ToolsPanel: TPanel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Subject: TLabel;
Label4: TLabel;
HostEdit: TEdit;
FromEdit: TEdit;
ToEdit: TEdit;
SubjectEdit: TEdit;
SignOnEdit: TEdit;
PortEdit: TEdit;
Label5: TLabel;
AttachPanel: TPanel;
Label6: TLabel;
FileAttachMemo: TMemo;
InfoPanel: TPanel;
Label7: TLabel;
ClearDisplayButton: TButton;
ConnectButton: TButton;
HeloButton: TButton;
MailFromButton: TButton;
RcptToButton: TButton;
DataButton: TButton;
AbortButton: TButton;
QuitButton: TButton;
MailButton: TButton;
OpenButton: TButton;
Label8: TLabel;
SmtpClient: TSmtpCli;
procedure SmtpClientDisplay(Sender: TObject; Msg: String);
procedure SmtpClientGetData(Sender: TObject; LineNum: Integer;
MsgLine: PChar; MaxLen: Integer; var More: Boolean);
procedure SmtpClientHeaderLine(Sender: TObject; Msg: PChar;
Size: Integer);
procedure FormCreate(Sender: TObject);
procedure ClearDisplayButtonClick(Sender: TObject);
procedure ConnectButtonClick(Sender: TObject);
procedure SmtpClientRequestDone(Sender: TObject; RqType: TSmtpRequest;
Error: Word);
procedure HeloButtonClick(Sender: TObject);
procedure MailFromButtonClick(Sender: TObject);
procedure RcptToButtonClick(Sender: TObject);
procedure DataButtonClick(Sender: TObject);
procedure AbortButtonClick(Sender: TObject);
procedure QuitButtonClick(Sender: TObject);
procedure MailButtonClick(Sender: TObject);
procedure OpenButtonClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
FIniFileName : String;
FInitialized : Boolean;
procedure BuildRcptList;
procedure ExceptionHandler(Sender: TObject; E: Exception);
public
{ Déclarations publiques }
end;
var
SmtpTestForm: TSmtpTestForm;
implementation
{$R *.DFM}
const
SectionData = 'Data';
KeyHost = 'HostName';
KeyPort = 'Port';
KeyFrom = 'From';
KeyTo = 'To';
KeySubject = 'Subject';
KeySignOn = 'SignOn';
SectionWindow = 'Window';
KeyTop = 'Top';
KeyLeft = 'Left';
KeyWidth = 'Width';
KeyHeight = 'Height';
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSmtpTestForm.FormCreate(Sender: TObject);
begin
Application.OnException := ExceptionHandler;
DisplayMemo.Clear;
FIniFileName := LowerCase(ExtractFileName(Application.ExeName));
FIniFileName := Copy(FIniFileName, 1, Length(FIniFileName) - 3) + 'ini';
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSmtpTestForm.FormShow(Sender: TObject);
var
IniFile : TIniFile;
begin
if not FInitialized then begin
FInitialized := TRUE;
IniFile := TIniFile.Create(FIniFileName);
HostEdit.Text := IniFile.ReadString(SectionData, KeyHost,
'localhost');
PortEdit.Text := IniFile.ReadString(SectionData, KeyPort,
'smtp');
FromEdit.Text := IniFile.ReadString(SectionData, KeyFrom,
'first.last@company.com');
ToEdit.Text := IniFile.ReadString(SectionData, KeyTo,
'john.doe@acme;tartempion@brol.fr');
SubjectEdit.Text := IniFile.ReadString(SectionData, KeySubject,
'This is the message subject');
SignOnEdit.Text := IniFile.ReadString(SectionData, KeySignOn,
'your name');
Top := IniFile.ReadInteger(SectionWindow, KeyTop, (Screen.Height - Height) div 2);
Left := IniFile.ReadInteger(SectionWindow, KeyLeft, (Screen.Width - Width) div 2);
Width := IniFile.ReadInteger(SectionWindow, KeyWidth, Width);
Height := IniFile.ReadInteger(SectionWindow, KeyHeight, Height);
IniFile.Free;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSmtpTestForm.FormClose(Sender: TObject;
var Action: TCloseAction);
var
IniFile : TIniFile;
begin
IniFile := TIniFile.Create(FIniFileName);
IniFile.WriteString(SectionData, KeyHost, HostEdit.Text);
IniFile.WriteString(SectionData, KeyPort, PortEdit.Text);
IniFile.WriteString(SectionData, KeyFrom, FromEdit.Text);
IniFile.WriteString(SectionData, KeyTo, ToEdit.Text);
IniFile.WriteString(SectionData, KeySubject, SubjectEdit.Text);
IniFile.WriteString(SectionData, KeySignOn, SignOnEdit.Text);
IniFile.WriteInteger(SectionWindow, KeyTop, Top);
IniFile.WriteInteger(SectionWindow, KeyLeft, Left);
IniFile.WriteInteger(SectionWindow, KeyWidth, Width);
IniFile.WriteInteger(SectionWindow, KeyHeight, Height);
IniFile.Free;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{$IFDEF VER80}
function TrimRight(Str : String) : String;
var
i : Integer;
begin
i := Length(Str);
while (i > 0) and (Str[i] = ' ') do
i := i - 1;
Result := Copy(Str, 1, i);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TrimLeft(Str : String) : String;
var
i : Integer;
begin
if Str[1] <> ' ' then
Result := Str
else begin
i := 1;
while (i <= Length(Str)) and (Str[i] = ' ') do
i := i + 1;
Result := Copy(Str, i, Length(Str) - i + 1);
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function Trim(Str : String) : String;
begin
Result := TrimLeft(TrimRight(Str));
end;
{$ENDIF}
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSmtpTestForm.BuildRcptList;
var
Buf : String;
I : Integer;
begin
SmtpClient.RcptName.Clear;
Buf := ToEdit.Text;
while TRUE do begin
I := Pos(';', Buf);
if I <= 0 then begin
SmtpClient.RcptName.Add(Trim(Buf));
break;
end
else begin
SmtpClient.RcptName.Add(Trim(Copy(Buf, 1, I - 1)));
Delete(Buf, 1, I);
end;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSmtpTestForm.SmtpClientDisplay(Sender: TObject; Msg: String);
begin
{ Memo boxes are not unlimited...}
if DisplayMemo.Lines.Count > 100 then
DisplayMemo.Clear;
DisplayMemo.Lines.Add(Msg);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSmtpTestForm.SmtpClientGetData(
Sender : TObject;
LineNum : Integer;
MsgLine : PChar;
MaxLen : Integer;
var More: Boolean);
var
Len : Integer;
begin
if LineNum > MsgMemo.Lines.count then
More := FALSE
else begin
Len := Length(MsgMemo.Lines[LineNum - 1]);
{ Truncate the line if too long (should wrap to next line) }
if Len >= MaxLen then
StrPCopy(MsgLine, Copy(MsgMemo.Lines[LineNum - 1], 1, MaxLen - 1))
else
StrPCopy(MsgLine, MsgMemo.Lines[LineNum - 1]);
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSmtpTestForm.SmtpClientHeaderLine(Sender: TObject; Msg: PChar;
Size: Integer);
begin
{ This demonstrate how to add a line to the message header }
{ Just detect one of the header lines and add text at the end of this }
{ line. Use #13#10 to form a new line }
{ Here we check for the From: header line and add a Comments: line }
if StrLIComp(Msg, 'From:', 5) = 0 then
StrCat(Msg, #13#10 + 'Comments: This is a test');
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSmtpTestForm.ClearDisplayButtonClick(Sender: TObject);
begin
DisplayMemo.Clear;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSmtpTestForm.ExceptionHandler(Sender: TObject; E: Exception);
begin
Application.ShowException(E);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Connect to the mail server }
procedure TSmtpTestForm.ConnectButtonClick(Sender: TObject);
begin
SmtpClient.Host := HostEdit.Text;
SmtpClient.Port := PortEdit.Text;
SmtpClient.Connect;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Send HELO command with our local identification }
procedure TSmtpTestForm.HeloButtonClick(Sender: TObject);
begin
SmtpClient.SignOn := SignOnEdit.Text;
SmtpClient.Helo;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Open is Connect and Helo methods combined }
procedure TSmtpTestForm.OpenButtonClick(Sender: TObject);
begin
SmtpClient.Host := HostEdit.Text;
SmtpClient.Port := PortEdit.Text;
SmtpClient.SignOn := SignOnEdit.Text;
SmtpClient.Open;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Send originator }
procedure TSmtpTestForm.MailFromButtonClick(Sender: TObject);
begin
SmtpClient.FromName := FromEdit.Text;
SmtpClient.MailFrom;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Send recipients }
procedure TSmtpTestForm.RcptToButtonClick(Sender: TObject);
begin
BuildRcptList;
SmtpClient.RcptTo;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Send text and attached files to mail server }
procedure TSmtpTestForm.DataButtonClick(Sender: TObject);
begin
BuildRcptList;
SmtpClient.HdrFrom := FromEdit.Text;
SmtpClient.HdrTo := ToEdit.Text;
SmtpClient.HdrSubject := SubjectEdit.Text;
SmtpClient.EmailFiles := FileAttachMemo.Lines;
SmtpClient.Data;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ MailFrom, RcptTo and Data methods combined }
procedure TSmtpTestForm.MailButtonClick(Sender: TObject);
begin
BuildRcptList;
SmtpClient.HdrFrom := FromEdit.Text;
SmtpClient.HdrTo := ToEdit.Text;
SmtpClient.HdrSubject := SubjectEdit.Text;
SmtpClient.SignOn := SignOnEdit.Text;
SmtpClient.FromName := FromEdit.Text;
SmtpClient.EmailFiles := FileAttachMemo.Lines;
SmtpClient.Host := HostEdit.Text;
SmtpClient.Port := PortEdit.Text;
SmtpClient.Mail;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSmtpTestForm.QuitButtonClick(Sender: TObject);
begin
SmtpClient.Quit;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSmtpTestForm.AbortButtonClick(Sender: TObject);
begin
SmtpClient.Abort;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSmtpTestForm.SmtpClientRequestDone(Sender: TObject;
RqType: TSmtpRequest; Error: Word);
begin
DisplayMemo.Lines.Add('RequestDone Rq=' + IntToStr(Ord(RqType)) +
' Error='+ IntToStr(Error));
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
end.