📄 unitmain.pas.~54~
字号:
unit unitMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, IdIOHandler, IdIOHandlerSocket,
IdIOHandlerStack, IdMessage, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdExplicitTLSClientServerBase, IdMessageClient, IdSMTPBase,
IdSMTP, IdText, IDAttachmentFile;
type
TfrmMain = class(TForm)
GroupBox1: TGroupBox;
Label1: TLabel;
edtHost: TEdit;
Label2: TLabel;
edtPort: TEdit;
Label3: TLabel;
edtUserName: TEdit;
edtPassword: TEdit;
Label4: TLabel;
GroupBox2: TGroupBox;
MemContent: TMemo;
Label5: TLabel;
edtFile: TEdit;
Button1: TButton;
rbEmailType: TRadioGroup;
btnSend: TButton;
btnExit: TButton;
StatusBar1: TStatusBar;
SendMstp: TIdSMTP;
AMessage: TIdMessage;
IdIOHandlerStack1: TIdIOHandlerStack;
Label6: TLabel;
edtSubject: TEdit;
Label7: TLabel;
GroupBox3: TGroupBox;
GroupBox4: TGroupBox;
edtSendName: TEdit;
edtSendAddress: TEdit;
Label8: TLabel;
Label9: TLabel;
edtReceiveAddress: TEdit;
edtReceiveName: TEdit;
Label10: TLabel;
Label11: TLabel;
OpenDialog1: TOpenDialog;
procedure btnExitClick(Sender: TObject);
procedure btnSendClick(Sender: TObject);
procedure edtPortKeyPress(Sender: TObject; var Key: Char);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
procedure SetStatusText(const Text: String; IsBold: Boolean = False);
function CheckInputInfo: Boolean;
function ConnectMailServer: Boolean;
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
{$R *.dfm}
procedure TfrmMain.btnExitClick(Sender: TObject);
begin
if SendMstp.Connected then
SendMstp.Disconnect;
Close;
end;
procedure TfrmMain.btnSendClick(Sender: TObject);
var
IdBody, IdHtml: TIdText;
i: Integer;
Att: TIdAttachmentFile;
begin
if not CheckInputInfo then
Exit;
SetStatusText('正在连接邮件服务器...');
if ConnectMailServer then
SetStatusText('连接服务器成功...')
else
SetStatusText('连接服务器失败...', True);
Application.ProcessMessages;
with AMessage do
begin
NoDecode := False;
NoEncode := False;
ContentType := 'multipart/mixed';
Encoding := meMIME;
MsgId := 'PrettyPic';
if FileExists(edtFile.Text) then
References := ChangeFileExt(ExtractFileName(edtFile.Text), '')
else
References := '';
Recipients.Clear;
ReplyTo.Clear;
with Recipients.Add do
begin
Name := edtReceiveName.Text;
Address := edtReceiveAddress.Text;
end;
Subject := edtSubject.Text;
Sender.Name := edtSendName.Text;
Sender.Address := edtSendAddress.Text;
From.Name := Sender.Name;
From.Address := Sender.Address;
if rbEmailType.ItemIndex = 0 then
begin
IdBody := TIdText.Create(MessageParts);
IdBody.ContentType := 'text/plain';
for I := 0 to MemContent.Lines.Count - 1 do
IdBody.Body.Add(MemContent.Lines.Strings[i]);
IdBody.Body.Add('');
end
else
begin
IdHtml := TIdText.Create(MessageParts);
IdHtml.ContentType := 'text/html;charset=gb2312';
IdHtml.ContentTransfer := '7bit';
IdHtml.Body.Add('<html>');
IdHtml.Body.Add(' <head>');
IdHtml.Body.Add(' <title>' + edtSubject.Text + '</title>');
IdHtml.Body.Add(' </head>');
IdHtml.Body.Add(' <body title="' + References + '">');
for I := 0 to MemContent.Lines.Count - 1 do
IdHtml.Body.Add(' ' + MemContent.Lines.Strings[i] + '<br>');
IdHtml.Body.Add(' <img src="cid:PrettyPic" alt="' + ExtractFileName(edtFile.Text) +
'" name="' + ExtractFileName(edtFile.Text) + '" title="Just an image included.">');
IdHtml.Body.Add(' </body>');
IdHtml.Body.Add('</html>');
end;
Application.ProcessMessages;
SetStatusText('正在加载图片...');
Att := TIdAttachmentFile.Create(MessageParts, edtFile.Text);
Att.ExtraHeaders.Values['Content-ID'] := 'PrettyPic';
Att.ContentType := 'image/jpeg';
end;
Application.ProcessMessages;
SetStatusText('正在发送邮件....');
try
SendMstp.Send(AMessage);
SetStatusText('邮件发送成功...');
Att.Free;
if IdBody <> nil then
IdBody.Free;
if IdHtml <> nil then
IdHtml.Free;
except on E: Exception do
SetStatusText('Error:' + E.Message);
end;
end;
procedure TfrmMain.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
edtFile.Text := OpenDialog1.FileName;
end;
function TfrmMain.CheckInputInfo: Boolean;
begin
Result := True;
if Trim(edtHost.Text) = '' then
begin
Result := False;
SetStatusText('请输入服务器地址！', True);
Exit;
end;
if Trim(edtPort.Text) = '' then
begin
Result := False;
SetStatusText('请输入端口号！', True);
Exit;
end;
if Trim(edtUserName.Text) = '' then
begin
Result := False;
SetStatusText('请输入用户名！', True);
Exit;
end;
end;
function TfrmMain.ConnectMailServer: Boolean;
begin
with SendMstp do
begin
Host := edtHost.Text;
Port := StrToIntDef(edtPort.Text, 25);
AuthType := atDefault;
Username := edtUserName.Text;
Password := edtPassword.Text;
try
if not Connected then
Connect;
Result := True;
except
Result := False;
end;
end;
end;
procedure TfrmMain.edtPortKeyPress(Sender: TObject; var Key: Char);
begin
if not (Key in ['0'..'9', #8]) then
Key := #0;
end;
procedure TfrmMain.SetStatusText(const Text: String; IsBold:Boolean);
begin
if IsBold then
begin
StatusBar1.Font.Style := [fsBold];
StatusBar1.Font.Color := clRed;
end
else
begin
StatusBar1.Font.Style := [];
StatusBar1.Font.Color := clBlack;
end;
StatusBar1.Panels[0].Text := Text;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -