See what you can use from this.
I give no further support.
Jan
unit MailUnit ;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs, ComCtrls,
IniFiles,
StdCtrls, NMsmtp, PSock, NMpop3, Buttons, Menus, ExtCtrls,
Graphics;
type
TMailAction=(maNone,maSend,maReceive);
MailMsgHandler = PROCEDURE(TheMessage: String);
TFrmMail = class(TForm)
POP3: TNMPOP3;
SMTP1: TNMSMTP;
Label1: TLabel;
procedure FormShow(Sender: TObject);
procedure SMTP1AttachmentNotFound(Filename: String);
procedure SMTP1AuthenticationFailed(var Handled:boolean);
procedure SMTP1ConnectionFailed(Sender: TObject);
procedure SMTP1Disconnect(Sender: TObject);
procedure SMTP1EncodeEnd(Filename: String);
procedure SMTP1Failure(Sender: TObject);
procedure SMTP1HostResolved(Sender: TComponent);
procedure SMTP1InvalidHost(var Handled:boolean);
procedure SMTP1PacketSent(Sender: TObject);
procedure SMTP1RecipientNotFound(Recipient: String);
procedure SMTP1SendStart(Sender: TObject);
procedure SMTP1Status(Sender: TComponent; Status: String);
procedure SMTP1Success(Sender: TObject);
procedure SMTP1Connect(Sender: TObject);
procedure SMTP1ConnectionRequired(var Handled: Boolean);
procedure SMTP1EncodeStart(Filename: String);
private
MMHandler : MailMsgHandler;
public
MailSent : Boolean; { Set TRUE/FALSE directly after }
Function PrepareSMTP(HostNam,UsrID: String; MMH : MailMsgHandler):
Boolean;
Function PrepareSMTPMsg(TPMFromName,
TPMFromAddress,
TPMReplyTo,
TPMSubject : String;
TPMListMailAddresses,
TPMListAttachmentNames,
TPMListMailBody,
TPMListCC,
TPMListBCC : TStrings): Boolean;
end;
var
FrmMail : TFrmMail;
SMTPConnectionOpen : Boolean; { TRUE is the SMTP connection is
established }
implementation
uses Strngs, Errors;
{$R *.DFM}
(*************************** General ************************)
procedure TFrmMail.FormShow(Sender: TObject);
begin
SMTPConnectionOpen := FALSE;
end;
(*************************** SMTP ************************)
Function TFrmMail.PrepareSMTP(HostNam,UsrID: String; MMH : MailMsgHandler):
Boolean;
{ Sets the SMTP properties Host and UserID, and some defaults. }
begin
PrepareSMTP := FALSE;
if (HostNam = '') then
begin
ShowErrorBox('SMTP gegevens ontbreken','Servernaam niet ingesteld');
Exit;
end;
if (UsrID = '') then
begin
ShowErrorBox('SMTP gegevens ontbreken','Naam gebruiker niet
ingesteld');
Exit;
end;
WITH SMTP1 DO
BEGIN
ClearParameters; { Clears all PostMessage fields }
Host := HostNam;
UserID := UsrID;
TimeOut := cServerTimeOut;
EncodeType := uuMime;
ClearParams := FALSE; { Keep the PostMessage properties after
sending }
END;
MMHandler := MMH;
PrepareSMTP := TRUE;
end; { FrmMail.PrepareSMTP}
Function TFrmMail.PrepareSMTPMsg(TPMFromName,
TPMFromAddress,
TPMReplyTo,
TPMSubject : String;
TPMListMailAddresses,
TPMListAttachmentNames,
TPMListMailBody,
TPMListCC,
TPMListBCC : TStrings): Boolean;
begin
PrepareSMTPMsg := FALSE;
if (TPMFromName = '') then
begin
ShowErrorBox('SMTP gegevens ontbreken','Servernaam niet ingesteld');
Exit;
end;
if (TPMFromAddress = '') then
begin
ShowErrorBox('SMTP gegevens ontbreken','Afzender niet ingesteld');
Exit;
end;
if (TPMSubject = '') then
begin
ShowErrorBox('SMTP gegevens ontbreken','Onderwerp niet ingesteld');
Exit;
end;
IF TPMListMailAddresses.Count = 0 THEN
begin
ShowErrorBox('SMTP gegevens ontbreken','Geaddresseerde(n) mail adres
niet ingesteld');
Exit;
end;
IF TPMListMailBody.Count = 0 THEN
begin
ShowErrorBox('SMTP gegevens ontbreken','Tekst bericht niet
ingesteld');
Exit;
end;
WITH FrmMail.SMTP1.PostMessage DO
BEGIN
FromName := TPMFromName;
FromAddress := TPMFromAddress;
ReplyTo := TPMReplyTo;
Subject := TPMSubject;
LocalProgram := 'QSA MailUnit version ' + MailUnitVersion;
ToCarbonCopy.Clear;
IF TPMListCC <> NIL THEN ToCarbonCopy.AddStrings(TPMListCC);
ToBlindCarbonCopy.Clear;
IF TPMListBCC <> NIL THEN ToBlindCarbonCopy.AddStrings(TPMListBCC);
ToAddress.Clear;
ToAddress.AddStrings(TPMListMailAddresses);
Attachments.Clear;
Attachments.AddStrings(TPMListAttachmentNames);
Body.Clear;
Body.AddStrings(TPMListMailBody);
END;
PrepareSMTPMsg := TRUE;
end; { FrmMail.PrepareSMTPMsg}
Procedure TFrmMail.SMTP1ConnectionFailed(Sender: TObject);
begin
MmHandler('SMTP Connection failed');
SMTPConnectionOpen := FALSE;
end; {proc }
Procedure TFrmMail.SMTP1Disconnect(Sender: TObject);
begin
MmHandler('SMTP Disconnected');
SMTPConnectionOpen := FALSE;
end; {proc }
Procedure TFrmMail.SMTP1AttachmentNotFound(Filename:string);
begin
MmHandler('SMTP Attachment '+FileName+' not found.');
end; {proc }
Procedure TFrmMail.SMTP1HostResolved(Sender: TComponent);
begin
MmHandler('SMTP Host resolved');
end; {proc }
Procedure TFrmMail.SMTP1SendStart(Sender: TObject);
begin
MailSent := FALSE;
MmHandler('SMTP Sending now');
end; {proc }
Procedure TFrmMail.SMTP1AuthenticationFailed(var Handled: Boolean);
begin
MmHandler('SMTP Authentication failed');
Handled := FALSE;
end; {proc }
Procedure TFrmMail.SMTP1Success(Sender: TObject);
begin
MailSent := TRUE;
MmHandler('SMTP Operation successful');
end; {proc }
Procedure TFrmMail.SMTP1Failure(Sender: TObject);
begin
MmHandler('SMTP Failure');
end; {proc }
Procedure TFrmMail.SMTP1PacketSent(Sender: TObject);
begin
MmHandler(IntToStr(SMTP1.BytesSent) + ' bytes of
'+IntToStr(SMTP1.BytesTotal)+' sent');
end; {proc }
Procedure TFrmMail.SMTP1EncodeEnd(Filename: String);
begin
MmHandler('SMTP Finished encoding '+Filename);
end; {proc }
Procedure TFrmMail.SMTP1RecipientNotFound(Recipient: String);
begin
ShowMessage('SMTP Recipient "'+Recipient+'" not found');
end; {proc }
Procedure TFrmMail.SMTP1InvalidHost(var Handled: Boolean);
begin
MmHandler('SMTP Invalid host: '+SMTP1.Host);
Handled := False;
end; {proc }
Procedure TFrmMail.SMTP1Status(Sender: TComponent; Status: String);
begin
MmHandler('SMTP Status = '+Status);
end; {proc }
procedure TFrmMail.SMTP1Connect(Sender: TObject);
begin
SMTPConnectionOpen := TRUE;
end;
procedure TFrmMail.SMTP1ConnectionRequired(var Handled: Boolean);
begin
If MessageDlg('Connection Required. Connect?', mtConfirmation, mbOkCancel,
0) = mrOk then
Begin
Handled := TRUE;
SMTP1.Connect;
End;
end;
procedure TFrmMail.SMTP1EncodeStart(Filename: String);
begin
MmHandler('SMTP Start encoding '+Filename);
end;
end.
Calling code is something like:
procedure TFrmCentraalMail.SpdBtnVerzendenClick(Sender: TObject);
VAR
S,
MAdrs,
WGInsID,
FName : String;
N,NrMailsSent,
NrMailsToDo : Word;
GotNews : Boolean;
MessageHandler : MailMsgHandler;
CCList,BCCList : TStringlist;
RCode : Integer;
BEGIN
CCList := TStringList.Create;
BCCList := TStringList.Create;
IF INIBCCAddress <> '' THEN
BCCList.Add(INIBCCAddress);
MessageHandler := ShowMailMessage;
IF NOT FrmMail.PrepareSMTP(INISMTPServer,INIPOPUserName,MessageHandler)
THEN Exit;
NrMailsSent := 0;
NrMailsToDo := 0; { Prevent compiler warnings }
{ Disable 'Sluiten' button: }
BibClose.Enabled := FALSE;
CASE SendWhat OF
swLeerkracht: BEGIN
{ Set up common message parameters: }
GotNews := WeHaveNews;
MmoMailBody.Clear;
MmoMailBody.Lines.Add('Dit is een e-mail van ASBO AFS
Centraal v. '+cProgVersion+'.');
IF GotNews THEN
MmoMailBody.Lines.Add('Bijgevoegd zijn een nieuw
leerkrachtenbestand en de nieuwsbrief.')
ELSE
MmoMailBody.Lines.Add('Bijgevoegd is een nieuw
leerkrachtenbestand.');
{$IFDEF TestFase}
MmoMailBody.Lines.Add('');
MmoMailBody.Lines.Add('-- TESTFASE mail --');
{$ENDIF}
{ Connect: }
try
SetAnimate(True);
FrmMail.SMTP1.Connect;
except
on E:Exception do HandleNoSMTPConnect(E.Message);
end; {try}
NrMailsToDo := SubStrCnt(';',SendFileList) + 1;
IF SMTPConnectionOpen THEN
BEGIN
WHILE SendFileList <> '' DO
BEGIN
LstBxMailAddresses.Clear;
LstBxAttachmentNames.Clear;
FName := ParseSt(SendFileList,';');
N := Pos('.',FName);
WGInsID := Copy(FName,3,N-3);
MAdrs := GetMailAddress(WGInsID);
IF MAdrs = '' THEN
ShowErrorBox('Email adres niet
gevonden','Werkgever/Instelling ' + WGInsID)
ELSE
BEGIN
LstBxMailAddresses.Items.Add(MAdrs);
{ Just before sending, copy the file to
LEERKRT.TXT: }
S := AFSVerzendDir + 'LEERKRT.TXT';
...
read more »
