📄 mailsnd1.pas
字号:
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
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, KeyCc, CcEdit.Text);
IniFile.WriteString(SectionData, KeyBcc, BccEdit.Text);
IniFile.WriteString(SectionData, KeySubject, SubjectEdit.Text);
IniFile.WriteString(SectionData, KeySignOn, SignOnEdit.Text);
IniFile.WriteString(SectionData, KeyUser, UsernameEdit.Text);
IniFile.WriteString(SectionData, KeyPass, PasswordEdit.Text);
IniFile.WriteInteger(SectionData, KeyAuth, AuthComboBox.ItemIndex);
IniFile.WriteInteger(SectionData, KeyPriority, PriorityComboBox.ItemIndex);
IniFile.WriteInteger(SectionData, KeyConfirm, Ord(ConfirmCheckBox.Checked));
SaveStringsToIniFile(FIniFileName, SectionFileAttach,
KeyFileAttach, FileAttachMemo.Lines);
SaveStringsToIniFile(FIniFileName, SectionMsgMemo,
KeyMsgMemo, MsgMemo.Lines);
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.SmtpClientDisplay(Sender: TObject; Msg: String);
begin
Display(Msg);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSmtpTestForm.SmtpClientGetData(
Sender : TObject;
LineNum : Integer;
MsgLine : Pointer;
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 : Pointer;
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
FAllInOneFlag := FALSE;
SmtpClient.Host := HostEdit.Text;
SmtpClient.Port := PortEdit.Text;
SmtpClient.HdrPriority := TSmtpPriority(PriorityComboBox.ItemIndex);
SmtpClient.Connect;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Send HELO command with our local identification }
procedure TSmtpTestForm.HeloButtonClick(Sender: TObject);
begin
FAllInOneFlag := FALSE;
SmtpClient.SignOn := SignOnEdit.Text;
SmtpClient.Helo;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSmtpTestForm.EhloButtonClick(Sender: TObject);
begin
FAllInOneFlag := FALSE;
SmtpClient.SignOn := SignOnEdit.Text;
SmtpClient.EHlo;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSmtpTestForm.AuthButtonClick(Sender: TObject);
begin
FAllInOneFlag := FALSE;
SmtpClient.Username := UsernameEdit.Text;
SmtpClient.Password := PasswordEdit.Text;
SmtpClient.AuthType := TSmtpAuthType(AuthComboBox.ItemIndex);
SmtpClient.Auth;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ If smtpAuthNone is seleted then Open combines methods Connect and Helo. }
{ If any other authentication type is selected then Open combines methods }
{ Connect, Ehlo and Auth. }
procedure TSmtpTestForm.OpenButtonClick(Sender: TObject);
begin
FAllInOneFlag := FALSE;
SmtpClient.Host := HostEdit.Text;
SmtpClient.Port := PortEdit.Text;
SmtpClient.SignOn := SignOnEdit.Text;
SmtpClient.Username := UsernameEdit.Text;
SmtpClient.Password := PasswordEdit.Text;
SmtpClient.AuthType := TSmtpAuthType(AuthComboBox.ItemIndex);
SmtpClient.HdrPriority := TSmtpPriority(PriorityComboBox.ItemIndex);
SmtpClient.Open;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Send originator }
procedure TSmtpTestForm.MailFromButtonClick(Sender: TObject);
begin
FAllInOneFlag := FALSE;
SmtpClient.FromName := FromEdit.Text;
SmtpClient.MailFrom;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Send recipients }
procedure TSmtpTestForm.RcptToButtonClick(Sender: TObject);
begin
FAllInOneFlag := FALSE;
SmtpClient.RcptName.Clear;
SmtpClient.RcptNameAdd(ToEdit.Text, CcEdit.Text, BccEdit.text);
SmtpClient.RcptTo;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Send text and attached files to mail server }
procedure TSmtpTestForm.DataButtonClick(Sender: TObject);
begin
FAllInOneFlag := FALSE;
SmtpClient.RcptName.Clear;
SmtpClient.RcptNameAdd(ToEdit.Text, CcEdit.Text, BccEdit.text);
SmtpClient.HdrFrom := FromEdit.Text;
SmtpClient.HdrTo := ToEdit.Text;
SmtpClient.HdrCc := CcEdit.Text;
SmtpClient.HdrSubject := SubjectEdit.Text;
SmtpClient.EmailFiles := FileAttachMemo.Lines;
SmtpClient.ConfirmReceipt := ConfirmCheckBox.Checked;
SmtpClient.Data;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ MailFrom, RcptTo and Data methods combined }
procedure TSmtpTestForm.MailButtonClick(Sender: TObject);
begin
FAllInOneFlag := FALSE;
SmtpClient.RcptName.Clear;
SmtpClient.RcptNameAdd(ToEdit.Text, CcEdit.Text, BccEdit.text);
SmtpClient.HdrFrom := FromEdit.Text;
SmtpClient.HdrTo := ToEdit.Text;
SmtpClient.HdrCc := CcEdit.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
FAllInOneFlag := FALSE;
SmtpClient.Quit;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSmtpTestForm.AbortButtonClick(Sender: TObject);
begin
FAllInOneFlag := FALSE;
SmtpClient.Abort;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSmtpTestForm.SmtpClientRequestDone(
Sender : TObject;
RqType : TSmtpRequest;
Error : Word);
begin
{ For every operation, we display the status }
if (Error > 0) and (Error < 10000) then
Display('RequestDone Rq=' + IntToStr(Ord(RqType)) +
' Error='+ SmtpClient.ErrorMessage)
else
Display('RequestDone Rq=' + IntToStr(Ord(RqType)) +
' Error='+ IntToStr(Error));
{ Check if the user has asked for "All-In-One" demo }
if not FAllInOneFlag then
Exit; { No, nothing more to do here }
{ We are in "All-In-One" demo, start next operation }
{ But first check if previous one was OK }
if Error <> 0 then begin
FAllInOneFlag := FALSE; { Terminate All-In-One demo }
Display('Error, stoped All-In-One demo');
Exit;
end;
case RqType of
smtpConnect: begin
if SmtpClient.AuthType = smtpAuthNone then
SmtpClient.Helo
else
SmtpClient.Ehlo;
end;
smtpHelo: SmtpClient.MailFrom;
smtpEhlo: SmtpClient.Auth;
smtpAuth: SmtpClient.MailFrom;
smtpMailFrom: SmtpClient.RcptTo;
smtpRcptTo: SmtpClient.Data;
smtpData: SmtpClient.Quit;
smtpQuit: Display('All-In-One done !');
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSmtpTestForm.AllInOneButtonClick(Sender: TObject);
begin
if SmtpClient.Connected then begin
MessageBeep(MB_OK);
Display('All-In-One demo start in non connected state.');
Display('Please quit or abort the connection first.');
Exit;
end;
FAllInOneFlag := TRUE;
{ Initialize all SMTP component properties from our GUI }
SmtpClient.Host := HostEdit.Text;
SmtpClient.Port := PortEdit.Text;
SmtpClient.SignOn := SignOnEdit.Text;
SmtpClient.FromName := FromEdit.Text;
SmtpClient.HdrFrom := FromEdit.Text;
SmtpClient.HdrTo := ToEdit.Text;
SmtpClient.HdrCc := CcEdit.Text;
SmtpClient.HdrSubject := SubjectEdit.Text; { + #13#10#9 + ' Testing continuation line !'};
SmtpClient.EmailFiles := FileAttachMemo.Lines;
SmtpClient.AuthType := TSmtpAuthType(AuthComboBox.ItemIndex);
SmtpClient.Username := UsernameEdit.Text;
SmtpClient.Password := PasswordEdit.Text;
SmtpClient.HdrPriority := TSmtpPriority(PriorityComboBox.ItemIndex);
SmtpClient.ConfirmReceipt := ConfirmCheckBox.Checked;
{ Recipient list is computed from To, Cc and Bcc fields }
SmtpClient.RcptName.Clear;
SmtpClient.RcptNameAdd(ToEdit.Text, CcEdit.Text, BccEdit.text);
Display('Connecting to SMTP server...');
{ Start first operation to do to send an email }
{ Next operations are started from OnRequestDone event }
SmtpClient.Connect
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -