Label5: TLabel;
eUserName: TEdit;
ePassword: TEdit;
Label4: TLabel;
GroupBox2: TGroupBox;
Label7: TLabel;
eSMTPServer: TEdit;
SMTPConnectBtn: TButton;
POPConnectBtn: TButton;
eHomeAddr: TEdit;
Label8: TLabel;
Panel2: TPanel;
Label9: TLabel;
lMessageCount: TLabel;
Label10: TLabel;
eCurMessage: TEdit;
udCurMessage: TUpDown;
ConnectStatus: TStatusBar;
procedure FormCreate(Sender: TObject);
procedure POP1StateChanged(Sender: TObject; State: Smallint);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure SMTP1StateChanged(Sender: TObject; State: Smallint);
procedure FormResize(Sender: TObject);
procedure ClearBtnClick(Sender: TObject);
procedure SMTP1Verify(Sender: TObject);
procedure SendBtnClick(Sender: TObject);
procedure POP1ProtocolStateChanged(Sender: TObject;
ProtocolState: Smallint);
procedure SMTPConnectBtnClick(Sender: TObject);
procedure POPConnectBtnClick(Sender: TObject);
procedure eSMTPServerChange(Sender: TObject);
procedure ePOPServerChange(Sender: TObject);
procedure cbSendFileClick(Sender: TObject);
procedure udCurMessageClick(Sender: TObject; Button: TUDBtnType);
procedure POP1RefreshMessageCount(Sender: TObject; Number: Integer);
procedure POP1DocOutput(Sender: TObject; const DocOutput: DocOutput);
procedure POP1Error(Sender: TObject; Number: Smallint;
var Description: WideString; Scode: Integer; const Source,
HelpFile: WideString; HelpContext: Integer;
var CancelDisplay: WordBool);
procedure SMTP1DocInput(Sender: TObject; const DocInput: DocInput);
procedure SMTP1Error(Sender: TObject; Number: Smallint;
private
RecvVerified,
SMTPError,
POPError: Boolean;
FMessageCount: Integer;
procedure SendFile(Filename: string);
procedure SendMessage;
procedure CreateHeaders;
end;
var
Mail: TMail;
implementation
{$R *.DFM}
const
icDocBegin = 1;
icDocHeaders = 2;
icDocData = 3;
icDocEnd = 5;
{When calling a component method which maps onto an OLE call, NoParam substitutes
for an optional parameter. As an alternative to calling the component method, you
may access the component's OLEObject directly -
i.e., Component.OLEObject.MethodName(,Foo,,Bar)}
function NoParam: Variant;
begin
TVarData(Result).VType := varError;
TVarData(Result).VError := DISP_E_PARAMNOTFOUND;
procedure TMail.FormCreate(Sender: TObject);
SMTPError := False;
POPError := False;
FMessageCount := 0;
procedure TMail.FormClose(Sender: TObject; var Action: TCloseAction);
if POP1.State = prcConnected then POP1.Quit;
if SMTP1.State = prcConnected then SMTP1.Quit;
procedure TMail.FormResize(Sender: TObject);
SendBtn.Left := ClientWidth - SendBtn.Width - 10;
ClearBtn.Left := ClientWidth - ClearBtn.Width - 10;
cbSendFile.Left := ClientWidth - cbSendFile.Width - 10;
eTo.Width := SendBtn.Left - eTo.Left - 10;
eCC.Width := SendBtn.Left - eCC.Left - 10;
eSubject.Width := SendBtn.Left - eSubject.Left - 10;
procedure TMail.ClearBtnClick(Sender: TObject);
eTo.Text := '';
eCC.Text := '';
eSubject.Text := '';
OpenDialog.Filename := '';
reMessageText.Lines.Clear;
procedure TMail.eSMTPServerChange(Sender: TObject);
SMTPConnectBtn.Enabled := (eSMTPServer.Text <> '') and (eHomeAddr.Text <> '');
procedure TMail.ePOPServerChange(Sender: TObject);
POPConnectBtn.Enabled := (ePOPServer.Text <> '') and (eUsername.Text <> '')
and (ePassword.Text <> '');
procedure TMail.cbSendFileClick(Sender: TObject);
if cbSendFile.Checked then
if OpenDialog.Execute then
cbSendFile.Caption := cbSendFile.Caption + ': '+OpenDialog.Filename
else
cbSendFile.Checked := False;
end else
cbSendFile.Caption := '&Attach Text File';
{Clear and repopulate MIME headers, using the component's DocInput property. A
separate DocInput OLE object could also be used. See RFC1521/1522 for complete
information on MIME types.}
procedure TMail.CreateHeaders;
with SMTP1 do
DocInput.Headers.Clear;
DocInput.Headers.Add('To', eTo.Text);
DocInput.Headers.Add('From', eHomeAddr.Text);
DocInput.Headers.Add('CC', eCC.Text);
DocInput.Headers.Add('Subject', eSubject.Text);
DocInput.Headers.Add('Message-Id', Format('%s_%s_%s', [Application.Title,
DateTimeToStr(Now), eHomeAddr.Text]));
DocInput.Headers.Add('Content-Type', 'TEXT/PLAIN charset=US-ASCII');
{Send a simple mail message}
procedure TMail.SendMessage;
CreateHeaders;
SendDoc(NoParam, DocInput.Headers, reMessageText.Text, '', '');
{Send a disk file. Leave SendDoc's InputData parameter blank and
specify a filename for InputFile to send the contents of a disk file. You can
use the DocInput event and GetData methods to do custom encoding (Base64, UUEncode, etc.) }
procedure TMail.SendFile(Filename: string);
DocInput.Filename := FileName;
SendDoc(NoParam, DocInput.Headers, NoParam, DocInput.FileName, '');
{Set global flag indicating recipients are addressable (this only ensures that the
address is in the correct format, not that it exists and is deliverable), then
send the text part of the message}
procedure TMail.SMTP1Verify(Sender: TObject);
SendMessage;
RecvVerified := True;
{Verify addressees, send text message in the Verify event, and if an attachment is
specified, send it}
procedure TMail.SendBtnClick(Sender: TObject);
Addressees: string;
if SMTP1.State = prcConnected then
RecvVerified := False;
Addressees := eTo.Text;
if eCC.Text <> '' then
Addressees := Addressees + ', '+ eCC.Text;
SMTP1.Verify(Addressees);
{wait for completion of Verify-Text message send}
while SMTP1.Busy do
Application.ProcessMessages;
{Check global flag indicating addresses are in the correct format - if true,
the text part of the message has been sent}
if not RecvVerified then
MessageDlg('Incorrect address format', mtError, [mbOK], 0);
Exit;
end
SendFile(OpenDialog.Filename);
MessageDlg('Not connected to SMTP server', mtError, [mbOK], 0);
{SMTP component will call this event every time its connection state changes}
procedure TMail.SMTP1StateChanged(Sender: TObject; State: Smallint);
case State of
prcConnecting:
ConnectStatus.SimpleText := 'Connecting to SMTP server: '+SMTP1.RemoteHost+'...';
prcResolvingHost:
ConnectStatus.SimpleText := 'Resolving Host';
prcHostResolved:
ConnectStatus.SimpleText := 'Host Resolved';
prcConnected:
ConnectStatus.SimpleText := 'Connected to SMTP server: '+SMTP1.RemoteHost;
SMTPConnectBtn.Caption := 'Disconnect';
prcDisconnecting:
ConnectStatus.SimpleText := 'Disconnecting from SMTP server: '+SMTP1.RemoteHost+'...';
prcDisconnected:
ConnectStatus.SimpleText := 'Disconnected from SMTP server: '+SMTP1.RemoteHost;
SMTPConnectBtn.Caption := 'Connect';
eSMTPServer.Enabled := not (State = prcConnected);
eHomeAddr.Enabled := not (State = prcConnected);
{The DocInput event is called each time the DocInput state changes during a mail transfer.
Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17