在哪里可以找到可以收发邮件的delphi源程序(100分)

请各位高手帮我找一个可以运行的收发邮件的delphi源程序，小弟万分感谢！！！

www.vclxx.com

ht99,首先我想感谢你！！！
但是，www.vclxx.com上的两个源程序都解不开（我用的是winrar），请指教！！！！

要用winzip解开。
delphi不是有自带的例子吗？demos/internet目录下

很多呀？告诉我EMAIL，我发给你！

这个也要源码？？？
自己写个，又不难。

delphi自带例程：
demos/fastnet/smtp
demos/fastnet/pop3

sakemail

有很多的不错的控件，比如上面的sakemail,
不过不知道delphi6的pop3和smtp控件是否有改进，呵呵自己研究看看好了

惊工之鸟，我的email:zzhpxiong0036@sina.com,请你发给我好吗！！！
谢谢！

delphi6 有！ 不错！

wzx,我用的是5.0版，可否把delphi6.0中的email源程序发给我！zzhpxiong0036@sina.com

../Borland/Delphi6/Demos/Indy/MailClient

中有个例子很好，带SMTP认证

uses shellapi;



procedure TForm1.Button1Click(Sender: TObject);

var

Param : String;

begin

Param :='mailto:' + 'user@host.com'+ '?subject=' + 'Your Subject' + '&Body=' + 'Your Message Text';


shellexecute( Form1.handle

'open'

PChar(Param)

nil

nil

sw_shownormal);

end;


Note:

Shellexecute doesn't accept Attachments.


Bemerkung:

Shellexecute akzeptiert keine Attachment-Angaben.

http://202.96.70.228/cakk/delphi/delphi.htm 有个coolmail
那个sakemail一时找不到了。

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, ExtCtrls, Menus, NMsmtp, Psock, NMpop3, ADODB, Db, StdCtrls,unit2,
AppEvnts;

type
TeMail = class(TForm)
sbSys: TStatusBar;
MainMenu1: TMainMenu;
File1: TMenuItem;
Exit1: TMenuItem;
Operate1: TMenuItem;
StartSmtpServer1: TMenuItem;
StopSmtpServer1: TMenuItem;
StartPop3Server1: TMenuItem;
StopPop3Server1: TMenuItem;
N1: TMenuItem;
PC1: TPageControl;
tsSMTP: TTabSheet;
tsPOP: TTabSheet;
adoEmail: TADOConnection;
atReceive: TADOTable;
aqReceive: TADOQuery;
aqSend: TADOQuery;
tmServer: TTimer;
tmWork: TTimer;
popReceive: TNMPOP3;
popCheck: TNMPOP3;
smtpSend: TNMSMTP;
sbSMTP: TStatusBar;
sbPOP: TStatusBar;
btnSMTP: TButton;
mmHistory: TMemo;
Label1: TLabel;
btnPOP: TButton;
lServer: TLabel;
lProgress: TLabel;
pbReceive: TProgressBar;
mmList: TMemo;
Label4: TLabel;
ApplicationEvents1: TApplicationEvents;
mmInfo: TMemo;
Label5: TLabel;
atHistory: TADOTable;
lSendMailNum: TLabel;
lCheck: TLabel;
N2: TMenuItem;
SetPOP3Server1: TMenuItem;
Help1: TMenuItem;
Abort1: TMenuItem;
lReceiveNum: TLabel;
lSendNum: TLabel;
procedure Exit1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Operate1Click(Sender: TObject);
procedure btnSMTPClick(Sender: TObject);
procedure StartSmtpServer1Click(Sender: TObject);
procedure StopSmtpServer1Click(Sender: TObject);
procedure btnPOPClick(Sender: TObject);
procedure StartPop3Server1Click(Sender: TObject);
procedure StopPop3Server1Click(Sender: TObject);
function GetServersInfo:Boolean;
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure tmServerTimer(Sender: TObject);
function CheckSendMail:Boolean;
procedure FormDestroy(Sender: TObject);
procedure ApplicationEvents1Exception(Sender: TObject; E: Exception);
procedure tmWorkTimer(Sender: TObject);
procedure popCheckConnect(Sender: TObject);
procedure popCheckDisconnect(Sender: TObject);
procedure popCheckStatus(Sender: TComponent; Status: String);
procedure popCheckSuccess(Sender: TObject);
procedure popCheckConnectionFailed(Sender: TObject);
procedure popCheckAuthenticationFailed(var Handled: Boolean);
procedure popCheckAuthenticationNeeded(var Handled: Boolean);
procedure popCheckConnectionRequired(var Handled: Boolean);
procedure popCheckDecodeEnd(Sender: TObject);
procedure popCheckDecodeStart(var FileName: String);
procedure popCheckFailure(Sender: TObject);
procedure popCheckHostResolved(Sender: TComponent);
procedure popCheckInvalidHost(var Handled: Boolean);
procedure popCheckList(Msg, Size: Integer);
procedure popCheckPacketRecvd(Sender: TObject);
procedure popCheckReset(Sender: TObject);
procedure popCheckRetrieveEnd(Sender: TObject);
procedure popCheckRetrieveStart(Sender: TObject);
procedure popReceiveConnect(Sender: TObject);
procedure popReceiveRetrieveEnd(Sender: TObject);
procedure popReceiveList(Msg, Size: Integer);
procedure popReceiveAuthenticationFailed(var Handled: Boolean);
procedure popReceiveAuthenticationNeeded(var Handled: Boolean);
procedure popReceiveConnectionFailed(Sender: TObject);
procedure popReceiveConnectionRequired(var Handled: Boolean);
procedure popReceiveDecodeEnd(Sender: TObject);
procedure popReceiveDecodeStart(var FileName: String);
procedure popReceiveDisconnect(Sender: TObject);
procedure popReceiveFailure(Sender: TObject);
procedure popReceiveHostResolved(Sender: TComponent);
procedure popReceiveInvalidHost(var Handled: Boolean);
procedure popReceivePacketRecvd(Sender: TObject);
procedure popReceiveReset(Sender: TObject);
procedure popReceiveRetrieveStart(Sender: TObject);
procedure popReceiveStatus(Sender: TComponent; Status: String);
procedure popReceiveSuccess(Sender: TObject);
procedure smtpSendAttachmentNotFound(Filename: String);
procedure smtpSendAuthenticationFailed(var Handled: Boolean);
procedure smtpSendConnect(Sender: TObject);
procedure smtpSendConnectionFailed(Sender: TObject);
procedure smtpSendConnectionRequired(var Handled: Boolean);
procedure smtpSendDisconnect(Sender: TObject);
procedure smtpSendEncodeEnd(Filename: String);
procedure smtpSendEncodeStart(Filename: String);
procedure smtpSendFailure(Sender: TObject);
procedure smtpSendHeaderIncomplete(var handled: Boolean;
hiType: Integer);
procedure smtpSendHostResolved(Sender: TComponent);
procedure smtpSendInvalidHost(var Handled: Boolean);
procedure smtpSendMailListReturn(MailAddress: String);
procedure smtpSendPacketSent(Sender: TObject);
procedure smtpSendRecipientNotFound(Recipient: String);
procedure smtpSendSendStart(Sender: TObject);
procedure smtpSendStatus(Sender: TComponent; Status: String);
procedure smtpSendSuccess(Sender: TObject);
procedure SetPOP3Server1Click(Sender: TObject);
procedure Abort1Click(Sender: TObject);
procedure mmHistoryKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
totSendNum,totreceiveNum:integer;
toStopPOP,toStopSMTP:Boolean;
CurReceiveCount:Integer;
POPServerReady:Boolean;
mvCheckMailNum:Integer;
DoCheckMail:boolean;
CurSystemStatus:ESysStatus;
EmailBoxMum:Integer;
HaveEmailBox:Boolean;
ReceiveMailDone:Boolean;
TotalReceiveMailNum:Integer;
CurReceiveMailNum:Integer;
ProcessCurMailDone:Boolean;
mHaveException:Boolean;
mTryCount:Integer;
PendStopSmtp:Boolean;
PendStopPop:Boolean;
RunSMTP:Boolean;
RunPOP:Boolean;
mPOPNum:Integer;
SomeThingToDo:Boolean;
TimerForWhich:ETask;
mPOPServer:array [0..9] of RPOPInfo;
mSMTPServer:RSMTPInfo;
mCSMTPServer:RSMTPInfo;
CurTryCount,CurTryNum:Integer;
DoneCurSendMail,CurSendMailSuccess:Boolean;
mLogFile:TLogFile;
SMTPConnect:Boolean;
POPCConnect:Boolean;
POPRConnect:Boolean;
{ Private declarations }
public
function CanStopSMTP:Boolean;
function CanStopPOP:Boolean;
function SendMail:boolean;
function CheckMail(var MailNumber:Integer):Boolean;
function ReceiveMail:Boolean;
function CheckMailOne(BoxNo:Integer;var HaveMail:Boolean):Boolean;
function fStartSMTP:Boolean;
function fStopSMTP:Boolean;
function fStartPOP:Boolean;
function fStopPOP:Boolean;
function HaveEmailToReceive:Boolean;
function sRE(ErrLevel:Integer;Sender:TObject;E:Exception;aStr:string=''):Boolean;overload;
function sRE(ErrLevel:Integer;E:Exception;aStr:string=''):Boolean;overload;
function sRE(ErrLevel:Integer;E:string):Boolean;overload;
function SendMailOne(MailID:Integer):Boolean;
procedure ClearSMTPServer;
procedure ClearPOPServer;
{ Public declarations }
end;

var
eMail: TeMail;

implementation

{$R *.DFM}

uses unit3;

procedure TeMail.ClearSMTPServer;
begin
lSendMailNum.Caption:=' ';
mmHistory.Clear;
sbSMTP.SimpleText:=' ';
btnSMTP.Enabled:=True;
end;

procedure TeMail.ClearPOPServer;
begin
lCheck.Caption:=' ';
lServer.Caption:=' ';
lProgress.Caption:=' ';
pbReceive.Max:=1;
pbReceive.Position:=0;
mmList.Clear;
mmInfo.Clear;
sbPOP.SimpleText:=' ';
btnPOP.Enabled:=True;
end;

function TeMail.sRE(ErrLevel:Integer;Sender:TObject;E:Exception;aStr:string=''):Boolean;
begin
sRE:=true;
sbSys.SimpleText:=TimeToStr(Time)+' -> '+'Exception('+ Sender.ClassName+') : '+E.Message+' ; '+aStr;
if InDebug then
mLogFile.WriteLog(ErrLevel,'Exception('+ Sender.ClassName+') : '+E.Message+' ; '+aStr);
end;

function TeMail.sRE(ErrLevel:Integer;E:Exception;aStr:string=''):Boolean;
begin
sRE:=true;
sbSys.SimpleText:=TimeToStr(Time)+' -> '+'Exception('+ E.ClassName+') : '+E.Message+' ; '+aStr;
if InDebug then
mLogFile.WriteLog(ErrLevel,'Exception('+ E.ClassName+') : '+E.Message+' ; '+aStr);
end;

function TeMail.sRE(ErrLevel:Integer;E:string):Boolean;
begin
sRE:=True;
sbSys.SimpleText:=TimeToStr(Time)+' -> '+E;
if InDebug then
mLogFile.WriteLog(ErrLevel,E);
end;

function TeMail.HaveEmailToReceive:Boolean;
begin
HaveEmailToReceive:=HaveEmailBox;
end;

function TeMail.fStartSMTP:Boolean;
begin
fStartSMTP:=False;
if not RunSMTP then
begin
btnSMTP.Caption :='Stop SMTP Server';
sbSys.SimpleText:='Start SMTP Server at ' + TimeToStr(Time);
if not tmServer.Enabled then
tmServer.Enabled:=True;
RunSMTP:=True;
if CurSystemStatus=sNotReady then
CurSystemStatus:=sIdle;
ClearSMTPServer;
fStartSMTP:=True;
totSendNum:=0;
end;
PendStopSmtp:=False;
toStopSMTP:=False;
end;

function TeMail.fStopSMTP:Boolean;
begin
fstopSMTP:=False;
if RunSMTP then
if CanStopSMTP and toStopSMTP then
begin
btnSMTP.Caption :='Start SMTP Server';
sbSys.SimpleText:='Stop SMTP Server at ' + TimeToStr(Time);
RunSmtp:=False;
if (not (RunSmtp or RunPop)) and (tmServer.Enabled) then
tmServer.Enabled:=False;
PendStopSmtp:=False;
toStopSMTP:=False;
ClearSMTPServer;
fStopSMTP:=True;
if (not RunPOP) and (not RunSMTP) then
TimerForWhich:=tNotReady;
totSendNum:=0;
lSendNum.Visible:=False;
end
else if not CanStopSMTP then
begin
btnSMTP.Enabled:=False;
PendStopSmtp:=True;
toStopSMTP:=True;
end
else
begin
btnSMTP.Enabled:=False;
toStopSmtp:=True;
end;
end;

function TeMail.fStartPOP:Boolean;
begin
fStartPOP:=False;
if not RunPOP then
begin
btnPOP.Caption:='Stop POP3 Server';
sbSys.SimpleText:='Start POP3 Server at ' + TimeToStr(Time);
if not tmServer.Enabled then
tmServer.Enabled:=True;
RunPOP:=True;
if CurSystemStatus=sNotReady then
CurSystemStatus:=sIdle;
ClearPOPServer;
fStartPOP:=True;
if TimerForWhich=tNotReady then
TimerForWhich:=tIdle;
totReceiveNum:=0;
end;
PendStopPop:=False;
toStopPOP:=False;
end;

function TeMail.fStopPOP:Boolean;
begin
fStopPOP:=False;
if RunPOP then
if CanStopPOP and toStopPOP then
begin
btnPOP.Caption:='Start POP3 Server';
sbSys.SimpleText:='Stop POP3 Server at ' + TimeToStr(Time);
RunPOP:=False;
if (not (RunSmtp or RunPop)) and (tmServer.Enabled) then
tmServer.Enabled:=False;
ClearPOPServer;
fStopPOP:=True;
PendStopPop:=False;
toStopPOP:=False;
if (not RunPOP) and (not RunSMTP) then
TimerForWhich:=tNotReady;
totReceiveNum:=0;
lReceiveNum.Visible:=False;
end
else if not CanStopPOP then
begin
btnPOP.Enabled:=False;
PendStopPop:=True;
toStopPOP:=True;
end
else
begin
btnPOP.Enabled:=False;
toStopPop:=True;
end;
end;

function TeMail.CheckMailOne(BoxNo:Integer;var HaveMail:Boolean):Boolean;
begin
CheckMailOne:=False;
try
lCheck.Caption:='Check Mail in Server : '+mPOPServer[BoxNo].mServer;
try
if popCheck.Connected then
popCheck.Disconnect;
popCheck.Host:=mPOPServer[BoxNo].mServer;
popCheck.UserID:=mPOPServer[BoxNo].mUser;
popCheck.Password:=mPOPServer[BoxNo].mPassWord;
popCheck.AttachFilePath:=mPOPServer[BoxNo].mAttchPath;
popCheck.Port:=mPOPServer[BoxNo].mPort;
popCheck.DeleteOnRead:=False;
DoCheckMail:=True;
mvCheckMailNum:=-1;
popCheck.Connect;
while DoCheckMail do
begin
Application.ProcessMessages;
end;
except
on E:Exception do
sRE(gErr1,E,'In CheckMail:'+mPOPServer[BoxNo].mServer);
end;
if (mvCheckMailNum>-1) or (not doCheckmail) then
begin
if mvCheckMailNum>0 then
HaveMail:=True
else
HaveMail:=False;
CheckMailOne:=True;
end;
finally
if popCheck.Connected then
popCheck.Disconnect;
lCheck.Caption:=' ';
end;
end;

function TeMail.ReceiveMail:Boolean;
var
i:Integer;
mOldSystemStatus:ESysStatus;
begin
mOldSystemStatus:=CurSystemStatus;
CurSystemStatus:=sReceiveMail;
ReceiveMail:=False;
try
if HaveEmailBox then
begin
i:=EmailBoxMum;
lServer.Caption:='Server : '+mPOPServer.mServer;
pbReceive.Max:=1;
pbReceive.Position:=0;
try
if popReceive.Connected then
popReceive.Disconnect;
popReceive.Host:=mPOPServer.mServer;
popReceive.UserID:=mPOPServer.mUser;
popReceive.Password:=mPOPServer.mPassWord;
popReceive.AttachFilePath:=mPOPServer.mAttchPath;
popReceive.Port:=mPOPServer.mPort;
popReceive.DeleteOnRead:=True;
ReceiveMailDone:=False;
popReceive.Connect;
while not ReceiveMailDone do
begin
Application.ProcessMessages;
end;
except
on E:Exception Do
sRE(gErr1,E,'Receive Mail :'+mPOPServer.mServer);
end;
ReceiveMail:=True;
end;
finally
mmList.Clear;
mmInfo.Clear;
lCheck.Caption:='';
lServer.Caption:='';
lProGress.Caption:='';
sbPOP.SimpleText:='';
sbSys.SimpleText:='';
pbReceive.Max:=1;
pbReceive.Position:=0;
HaveEmailBox:=False;
CurSystemStatus:=mOldSystemStatus;
end;
end;

function TeMail.SendMailOne(MailID:Integer):Boolean;
var
AttNum:integer;
AttPath,AttName:string;
tStrs:TStringList;
begin
SendMailOne:=False;
tStrs:=TStringlist.Create;
try
if not adoEmail.Connected then
adoEmail.Open;
if adoEmail.Connected then
begin
if aqSend.Active then
aqSend.Close;
aqSend.SQL.Clear;
aqSend.SQL.Add('SELECT * FROM tblSendMail WHERE ID='+IntToStr(MailID));
aqSend.Open;
CurTryCount:=aqSend.FieldByName('Counter').AsInteger;
if aqSend.RecordCount<>1 then
sRE(gErr1,'DataBase Err ! ')
else
begin
try
CurSendMailSuccess:=False;
CurTryNum:=0;
while (not CurSendMailSuccess) and (CurTryNum<4) do
begin
try
if smtpSend.Connected then
smtpSend.Disconnect;
while smtpSend.Connected do
begin
Application.ProcessMessages;
end;
try
smtpSend.ClearParameters;
smtpSend.PostMessage.Body.Clear;
mCSMTPServer.mServer:=aqSend.FieldByName('SMTPServerName').AsString;
mCSMTPServer.mUser:=aqSend.FieldByName('UserName').AsString;
mCSMTPServer.mPassword:=aqSend.FieldByName('Password').AsString;
mCSMTPServer.mMailBox:=aqSend.FieldByName('FromEmail').AsString;
mCSMTPServer.mPort:=25;
smtpSend.ClearParams:=True;
smtpSend.Host:=aqSend.FieldByName('SMTPServerName').AsString;
smtpSend.UserID:=aqSend.FieldByName('UserName').AsString;
smtpSend.Port:=25;
smtpSend.PostMessage.FromAddress:=aqSend.FieldByName('FromEmail').AsString;
smtpSend.PostMessage.FromName:=aqSend.FieldByName('UserName').AsString;
smtpSend.PostMessage.Subject:=aqSend.FieldByName('Subject').AsString;
smtpSend.PostMessage.Body.Text:=aqSend.FieldByName('MailBody').AsString;
StrToStrS(aqSend.FieldByName('ToEmail').AsString,';',tStrs);
smtpSend.PostMessage.ToAddress.Assign(tStrs);
StrToStrS(aqSend.FieldByName('CCEmail').AsString,';',tStrs);
smtpSend.PostMessage.ToCarbonCopy.Assign(tStrs);
StrToStrS(aqSend.FieldByName('BCCEmail').AsString,';',tStrs);
smtpSend.PostMessage.ToBlindCarbonCopy.Assign(tStrs);
AttPath:=aqSend.FieldByName('AttachBackupPath').AsString;
AttNum:=aqSend.FieldByName('AttachCounter').AsInteger;
AttName:=aqSend.FieldByName('AttachName').AsString;
if AttNum>0 then
begin
if not ExtAtt(AttName,AttPath,';',AttNum,tStrs) then
sRE(gErr1,'Attachment Number Err ! ')
else
smtpSend.PostMessage.Attachments.Assign(tStrs);
end
else
smtpSend.PostMessage.Attachments.Clear;
except
on E:Exception do
sRE(gErr1,E,'SendMail(Set Params):'+IntToStr(MailID));
end;
DoneCurSendMail:=False;
Inc(CurTryNum);
smtpSend.Connect;
while not DoneCurSendMail do
begin
Application.ProcessMessages;
end;
except
on E:Exception do
sRE(gErr1,E,'Sendmail(Connect And Send):'+IntToStr(MailID));
end;
end;
if (not CurSendMailSuccess) and (CurTryCount>-100) then
begin
if CurTryCount>99 then
CurTryCount:=99;
if CurTryCount>0 then
CurTryCount:=-101+CurTryCount
else
Dec(CurTryCount);
aqSend.Edit;
aqSend.FieldByName('Counter').AsInteger:=CurTryCount;
aqSend.Post;
end
else
begin
if atHistory.Active then
atHistory.Close;
atHistory.Active:=true;
try
try
atHistory.Append;
if CurSendMailSuccess then
begin
SendMailOne:=true;
atHistory.FieldByName('isOK').AsString:='1'
end
else
atHistory.FieldByName('isOK').AsString:='0';
atHistory.FieldByName('ID').AsInteger:=aqSend.FieldByName('ID').AsInteger;
atHistory.FieldByName('AttachCounter').AsInteger:=aqSend.FieldByName('AttachCounter').AsInteger;
atHistory.FieldByName('Counter').AsInteger:=aqSend.FieldByName('Counter').AsInteger;
atHistory.FieldByName('ToEmail').AsString:=aqSend.FieldByName('ToEmail').AsString;
atHistory.FieldByName('CCEmail').AsString:=aqSend.FieldByName('CCEmail').AsString;
atHistory.FieldByName('BCCEmail').AsString:=aqSend.FieldByName('BCCEmail').AsString;
atHistory.FieldByName('FromEmail').AsString:=aqSend.FieldByName('FromEmail').AsString;
atHistory.FieldByName('Subject').AsString:=aqSend.FieldByName('Subject').AsString;
atHistory.FieldByName('SMTPServerName').AsString:=aqSend.FieldByName('SMTPServerName').AsString;
atHistory.FieldByName('AttachBackupPath').AsString:=aqSend.FieldByName('AttachBackupPath').AsString;
atHistory.FieldByName('AttachName').AsString:=aqSend.FieldByName('AttachName').AsString;
atHistory.FieldByName('UserName').AsString:=aqSend.FieldByName('UserName').AsString;
atHistory.FieldByName('Password').AsString:=aqSend.FieldByName('Password').AsString;
atHistory.FieldByName('MailBody').AsString:=aqSend.FieldByName('MailBody').AsString;
atHistory.FieldByName('DateTime').AsString:=aqSend.FieldByName('DateTime').AsString;
atHistory.FieldByName('Priority').AsString:=aqSend.FieldByName('Priority').AsString;
atHistory.Post;
except
on E:Exception do
sRE(gErr1,E,'In Append History Table');
end;
finally
atHistory.Active:=False;
end;
if mmHistory.Lines.Count>1000 then
mmHistory.Clear;
mmHistory.Lines.Add(DateToStr(Date)+' -> '+TimeToStr(Time)+' # Send mail : '+ aqSend.FieldByName('ID').AsString);
mmHistory.Lines.Add(' From: '+aqSend.FieldByName('FromEmail').AsString);
mmHistory.Lines.Add(' To: '+aqSend.FieldByName('ToEmail').AsString);
mmHistory.Lines.Add(' Subject: '+aqSend.FieldByName('Subject').AsString);
mmHistory.Lines.Add(' Attachmemt Count: '+aqSend.FieldByName('AttachCounter').AsString);
if CurSendMailSuccess then
mmHistory.Lines.Add(' ^_^ OK ^_^ ')
else
mmHistory.Lines.Add(' ~_~ Err ~_~ ');
mmHistory.Lines.Add(' ');
try
aqSend.Close;
aqSend.SQL.Clear;
aqSend.SQL.Add('DELETE FROM tblSendMail Where ID='+IntToStr(MailID));
aqSend.ExecSQL;
finally
aqSend.Close;
end;
end;
except
on E:Exception do sRE(gErr1,E,'SendMailOne:'+InttoStr(MailID));
end;
end;
end
else
sRE(gErr1,'Database Err ! ');
finally
tStrs.Free;
end;
end;

function TeMail.SendMail:Boolean;
var
MailID:Integer;
MailCount:Integer;
SendMailOK:Boolean;
mOldSystemStatus:ESysStatus;
begin
mOldSystemStatus:=CurSystemStatus;
CurSystemStatus:=sSendMail;
SendMailOK:=False;
try
try
while not SendMailOK do
begin
adoEmail.Open;
if adoEmail.Connected then
begin
try
if aqSend.Active then
aqSend.Close;
aqSend.SQL.Clear;
aqSend.SQL.Add('SELECT count(*) FROM tblSendMail');
aqSend.Open;
MailCount:=aqSend.Fields[0].AsInteger;
aqSend.Close;
if MailCount<1 then
SendMailOK:=true
else
begin
lSendMailNum.Caption:=IntToStr(MailCount)+' E_Mail need to be sent';
aqSend.SQL.Clear;
aqSend.SQL.Add('SELECT ID FROM tblSendMail ORDER BY Priority DESC, Counter DESC');
aqSend.Open;
if not aqSend.Eof then
begin
MailID:=aqSend.FieldByName('ID').AsInteger;
if SendMailOne(MailID) then
begin
Inc(totSendNum);
lSendNum.Caption:=IntToStr(totSendNum)+' Mails sent';
if totSendNum>0 then
lSendNum.Visible:=true;
end;
end;
aqSend.Close;
end;
except
on E:Exception do sRE(gErr1,E,'In SendMail(Open And Send)');
end;
adoEmail.Close;
end
else
begin
sRE(gErr1,'Cannot connect SQL Server ! ');
SendMailOK:=True;
end;
end;
except
on E:Exception do sRE(gErr1,E,'In SendMail(Connect DataBase)');
end;
finally
lSendMailNum.Caption:='';
sbSMTP.SimpleText:='';
sbSys.SimpleText:='';
SendMail:=SendMailOK;
lSendMailNum.Caption:=' ';
CurSystemStatus:=mOldSystemStatus;
end;
end;

function TeMail.CheckMail(var MailNumber:Integer):Boolean;
var
i,j:Integer;
mHaveMail:Boolean;
CheckDone:Boolean;
mOldSystemStatus:ESysStatus;
begin
mOldSystemStatus:=CurSystemStatus;
CurSystemStatus:=sCheckMail;
CheckMail:=False;
CheckDone:=False;
MailNumber:=0;
try
for i:=0 to mPOPNum-1 do
begin
if not CheckDone then
begin
mHaveMail:=False;
try
if CheckMailOne(i,mHaveMail) then
begin
if mHaveMail then
begin
MailNumber:=i;
CheckMail:=true;
CheckDone:=True;
end;
end
else
begin
for j:=0 to gTryCheckNumber do
begin
mHaveMail:=False;
if CheckMailOne(i,mHaveMail) then
begin
if mHaveMail then
begin
MailNumber:=i;
CheckMail:=true;
CheckDone:=True;
end;
end;
end;
end;
except
on E:Exception do
sRE(gErr1,E,'CheckMail:'+IntToStr(i));
end;
end
else
Break;
end;
finally
lCheck.Caption:='';
sbPOP.SimpleText:='';
sbSys.SimpleText:='';
CurSystemStatus:=mOldSystemStatus;
end;
end;

function TeMail.CanStopSMTP:Boolean;
begin
CanStopSMTP:=not SMTPConnect;
end;

function TeMail.CanStopPOP:Boolean;
begin
CanStopPOP:=not (POPCConnect or POPRConnect);
end;

function TeMail.CheckSendMail:Boolean;
begin
CheckSendMail:=False;
try
adoEmail.Open;
if adoEmail.Connected then
begin
aqSend.SQL.Clear;
aqSend.SQL.Add('SELECT COUNT(*) FROM tblSendMail');
aqSend.Open;
if not aqSend.Eof then
if aqSend.Fields[0].AsInteger>0 then
CheckSendMail:=True;
aqSend.Close;
adoEmail.Close;
end
else
sRE(gErr1,'Cannot connect SQL Server ! ');
except
on E:Exception do sRE(gErr1,E,'In CheckSendMail(Connect And Count)');
end;
end;

function TeMail.GetServersInfo:Boolean;
var
i:Integer;
GetOK:Boolean;
POPOffice:TPOPOffice;
SMTPOffice:TSMTPOffice;
begin
POPOffice:=TPOPOffice.Create;
try
if POPOffice.mIsOK then
begin
mPOPNum:=POPOffice.mPOPONum;
for i:=0 to mPOPNum-1 do
begin
mPOPServer.mServer:=POPOffice.mPOPOffice.mServer;
mPOPServer.mUser:=POPOffice.mPOPOffice.mUser;
mPOPServer.mPassWord:=POPOffice.mPOPOffice.mPassWord;
mPOPServer.mAttchPath:=POPOffice.mPOPOffice.mAttchPath;
mPOPServer.mPort:=POPOffice.mPOPOffice.mPort;
end;
GetOK:=True;
end
else
GetOK:=false;
finally
POPOffice.Free;
end;
if GetOk then
begin
GetServersInfo:=True;
SMTPOffice:=TSMTPOffice.Create;
try
if SMTPOffice.mIsOK then
begin
mSMTPServer.mServer:=SMTPOffice.mSMTPOffice.mServer;
mSMTPServer.mMailBox:=SMTPOffice.mSMTPOffice.mMailBox;
mSMTPServer.mUser:=SMTPOffice.mSMTPOffice.mUser;
mSMTPServer.mPassword:=SMTPOffice.mSMTPOffice.mPassword;
mSMTPServer.mPort:=SMTPOffice.mSMTPOffice.mPort;
GetServersInfo:=True;
end
finally
SMTPOffice.Free;
end;
end
else
GetServersInfo:=False;
end;

procedure TeMail.Exit1Click(Sender: TObject);
begin
Close;
end;

procedure TeMail.FormCreate(Sender: TObject);
begin
toStopPOP:=False;
toStopSMTP:=False;
POPCConnect:=False;
POPRConnect:=False;
SMTPConnect:=False;
CurSystemStatus:=sNotReady;
RunSMTP:=False;
RUNPOP:=False;
mTryCount:=0;
TimerForWhich:=tIdle;
SomeThingToDo:=False;
HaveEmailBox:=False;
gAppPath:=ExtractFilePath(ParamStr(0));
TimerForWhich:=tIdle;
ClearSMTPServer;
ClearPOPServer;
if InDebug then
mLogFile:=TLogFile.Create;
if not GetServersInfo then
POPServerReady:=False
else
POPServerReady:=True;
{
if inDebug then
begin
smtpSend.CaptureFile(gAppPath+'smtpSend.Log');
popCheck.CaptureFile(gAppPath+'popCheck.Log');
popReceive.CaptureFile(gAppPath+'popReceive.Log');
end;
}
PC1.ActivePage:=tsSmtp;
end;

procedure TeMail.Operate1Click(Sender: TObject);
begin
StartSmtpServer1.Enabled := (not RunSMTP) and ((not PendStopSMTP) and (not toStopSMTP)) ;
StopSmtpServer1.Enabled :=(RunSMTP {and CanStopSMTP}) and ((not PendStopSMTP) and (not toStopSMTP));
StartPOP3Server1.Enabled :=POPServerReady and (not RunPOP) and ((not PendStopPOP) and (not toStopPOP));
StopPOP3Server1.Enabled :=POPServerReady and(RunPOP {and CanStopPOP}) and ((not PendStopPOP) and (not toStopPOP));
SetPOP3Server1.Enabled:=(not RunPOP);
end;

procedure TeMail.btnSMTPClick(Sender: TObject);
begin
if not fStartSMTP then
fStopSMTP;
end;

procedure TeMail.StartSmtpServer1Click(Sender: TObject);
begin
fStartSMTP;
end;

procedure TeMail.StopSmtpServer1Click(Sender: TObject);
begin
fStopSMTP;
end;

procedure TeMail.btnPOPClick(Sender: TObject);
begin
if POPServerReady then
begin
if not fStartPOP then
fStopPOP;
end;
end;

procedure TeMail.StartPop3Server1Click(Sender: TObject);
begin
if POPServerReady then
fStartPOP;
end;

procedure TeMail.StopPop3Server1Click(Sender: TObject);
begin
if POPServerReady then
fStopPOP;
end;

procedure TeMail.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if not (RunSmtp or RunPOP) then
CanClose:=True
else
begin
CanClose:=False;
ShowMessage(' Please stop servers first ! ');
end;
end;

procedure TeMail.tmServerTimer(Sender: TObject);
begin
tmServer.Enabled:=False;
try
if mHaveException then
begin
try
if SMTPConnect then
smtpSend.Disconnect;
if POPCConnect then
popCheck.Disconnect;
if POPRConnect then
popReceive.Disconnect;
finally
SMTPConnect:=False;
POPCConnect:=False;
POPRConnect:=False;
CurSystemStatus:=sIdle;
mHaveException:=False;
end;
end;
if TimerForWhich=tIdle then
begin
if PendStopSmtp or toStopSMTP then
fStopSMTP;
if PendStopPop or toStopPOP then
fStopPop;
if RunSmtp or RunPOP then
begin
SomeThingToDo:=False;
try
if RunSmtp then
begin
if CheckSendMail then
begin
SomeThingToDo:=True;
TimerForWhich:=tSend;
end;
end;
if RunPop and (not SomeThingToDo) then
begin
if HaveEmailToReceive then
begin
SomethingToDo:=True;
TimerForWhich:=tReceive;
end
else
begin
SomeThingToDo:=True;
TimerForWhich:=tCheck;
end;
end;
finally
if SomeThingToDo then
tmWork.Enabled:=True
else
tmServer.Enabled:=True;
end;
case TimerForWhich of
tSend:
sbSys.SimpleText:='Server is going to send mail ... ';
tReceive:
sbSys.SimpleText:='Server is going to receive mail ... ';
tCheck:
sbSys.SimpleText:='Server is going to check mail ... ';
else
sbSys.SimpleText:='Server is idle ... ';
end;
end;
end
else
tmServer.Enabled:=True;
except
on E:Exception do
begin
sRE(gErr1,E,'On tmServer.OnTimer');
tmServer.Enabled:=True;
end;
end;
end;

procedure TeMail.FormDestroy(Sender: TObject);
begin
if InDebug then
mLogFile.Free;
end;

procedure TeMail.ApplicationEvents1Exception(Sender: TObject;
E: Exception);
begin
sRE(gErr1,Sender,E,'In ApplicationEvents');
mHaveException:=True;
try
if (Sender.ClassName ='TTimer') and (E.Message ='Connection Failed') then
begin
mHaveException:=False;
end;
finally
tmServer.Enabled:=True;
end;
end;

procedure TeMail.tmWorkTimer(Sender: TObject);
begin
tmWork.Enabled:=False;
try
case TimerForWhich of
tSend:
begin
sbSys.SimpleText:='Server is sending mail ... ';
SendMail;
sbSys.SimpleText:='Server has sent mail ! ';
end;
tReceive:
begin
sbSys.SimpleText:='Server is receiving mail ... ';
ReceiveMail;
sbSys.SimpleText:='Server has received mail ! ';
end;
tCheck:
begin
sbSys.SimpleText:='Server is checking mail ... ';
HaveEmailBox:=CheckMail(EmailBoxMum);
sbSys.SimpleText:='Server has checked mail ! ';
end;
else
sbSys.SimpleText:='Server is idle ! ';
end;
finally
TimerForWhich:=tIdle;
tmServer.Enabled:=true;
end;
end;

procedure TeMail.popCheckConnect(Sender: TObject);
begin
POPCConnect:=True;
mvCheckMailNum:=popCheck.MailCount;
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Connect ! ';
popCheck.Disconnect;
end;

procedure TeMail.popCheckDisconnect(Sender: TObject);
begin
POPCConnect:=False;
DoCheckMail:=False;
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Disconnect ! ';
end;

procedure TeMail.popCheckStatus(Sender: TComponent; Status: String);
begin
sbPOP.SimpleText:=TimeToStr(Time)+' : '+Status;
end;

procedure TeMail.popCheckSuccess(Sender: TObject);
begin
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Success ! ';
end;

procedure TeMail.popCheckConnectionFailed(Sender: TObject);
begin
DoCheckMail:=False;
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Connection failed ! ';
sRE(gErr1,'CheckMail : Connection failed ! ');
end;

procedure TeMail.popCheckAuthenticationFailed(var Handled: Boolean);
begin
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Authentication failed ! ';
sRE(gErr1,'CheckMail : Authentication failed ! ');
end;

procedure TeMail.popCheckAuthenticationNeeded(var Handled: Boolean);
begin
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Authentication needed ! ';
end;

procedure TeMail.popCheckConnectionRequired(var Handled: Boolean);
begin
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Connection required ! ';
end;

procedure TeMail.popCheckDecodeEnd(Sender: TObject);
begin
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Decode end ! ';
end;

procedure TeMail.popCheckDecodeStart(var FileName: String);
begin
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Decode start ! ';
end;

procedure TeMail.popCheckFailure(Sender: TObject);
begin
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Failure ! ';
sRE(gErr1,'CheckMail : Failure ! ');
end;

procedure TeMail.popCheckHostResolved(Sender: TComponent);
begin
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Host resolved ! ';
end;

procedure TeMail.popCheckInvalidHost(var Handled: Boolean);
begin
POPCConnect:=False;
DoCheckMail:=False;
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Invalid host ! ';
sRE(gErr1,'CheckMail : Invalid host ! ');
end;

procedure TeMail.popCheckList(Msg, Size: Integer);
begin
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'List ! ';
end;

procedure TeMail.popCheckPacketRecvd(Sender: TObject);
begin
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Packet received ! ';
end;

procedure TeMail.popCheckReset(Sender: TObject);
begin
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Reset ! ';
end;

procedure TeMail.popCheckRetrieveEnd(Sender: TObject);
begin
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Retrieve end ! ';
end;

procedure TeMail.popCheckRetrieveStart(Sender: TObject);
begin
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Retrieve start ! ';
end;

procedure TeMail.popReceiveConnect(Sender: TObject);
var
i:Integer;
eMsg:string;
begin
POPRConnect:=True;
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Connect ! ';
CurReceiveMailNum:=-1;
CurReceiveCount:=0;
try
CurReceiveCount:=popReceive.MailCount;
TotalReceiveMailNum:=CurReceiveCount;
if CurReceiveCount>0 then
begin
mmList.Clear;
popReceive.List;
CurReceiveMailNum:=0;
ProcessCurMailDone:=False;
for i:=CurReceiveCount downto 1 do
begin
try
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'To Receive Mail: '+IntToStr(i);
CurReceiveMailNum:=i;
ProcessCurMailDone:=False;
popReceive.Parse:=True;
popReceive.GetMailMessage(i);
while not ProcessCurMailDone do
begin
Application.ProcessMessages;
end;
except
on E:Exception do
begin
SetLength(eMsg,200);
eMsg:=E.Message;
if Pos('List index out of bounds',eMsg)>0 then
begin
popReceive.DeleteMailMessage(i);
end
else
SRE(gErr1,Sender,E,'ReceiveConnect:GetMail:'+IntToStr(i));
end;
end
end;
end;
finally
ReceiveMailDone:=True;
popreceive.Disconnect;
CurReceiveMailNum:=-1;
TotalReceiveMailNum:=-1;
end;
end;

procedure TeMail.popReceiveRetrieveEnd(Sender: TObject);
var
toEmail:string;
fromEmail:string;
Subject:string;
pop3ServerName:string;
attchBackUp:string;
AttachName:string;
UserName:string;
Password:string;
MailBody:string;
szDateTime:string;
isCheck:string;
isOK:string;
nAttachCount:Integer;
nMailID:Integer;
IsStatus:string;
szMailDate:string;
maPath:string;
i:Integer;
OldFN,NewFN:string;
AccessPath:Boolean;
begin
lProgress.Caption:='Progress ('+IntToStr(TotalReceiveMailNum-CurReceiveMailNum+1)+'/'+IntToStr(TotalReceiveMailNum)+') : ';
pbReceive.Max:=TotalReceiveMailNum;
pbReceive.Position:=TotalReceiveMailNum-CurReceiveMailNum;
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Process Email: '+IntToStr(CurReceiveMailNum);
ProcessCurMailDone:=False;
toEmail:='';
fromEmail:=popReceive.MailMessage.From;
Subject:=popReceive.MailMessage.Subject;
pop3ServerName:=mPOPServer[EmailBoxMum].mServer;
attchBackUp:=mPOPServer[EmailBoxMum].mAttchPath;
nAttachCount:=popReceive.MailMessage.Attachments.Count;
userName:='';
Password:='';
MailBody:=popReceive.MailMessage.Body.Text;
szDateTime:=FormatDateTime('yyyymmdd',Date)+FormatDateTime('hhnnss',Time);
isCheck:='0';
isOK:='0';
isStatus:='0';
mmInfo.Clear;
mmInfo.Lines.Add(' POP3 Server : '+pop3ServerName);
mmInfo.Lines.Add(' User ID :'+mPOPServer[EmailBoxMum].mUser);
mmInfo.Lines.Add(' From Mail : '+fromEmail);
mmInfo.Lines.Add(' Subject : '+Subject);
mmInfo.Lines.Add(' attachment Count : '+IntToStr(nAttachCount));
mmInfo.Lines.Add(' CurMailID : '+IntToStr(CurReceiveMailNum));
adoEmail.Open;
if adoEmail.Connected then
begin
if atReceive.Active then
atReceive.Active:=False;
atReceive.Open;
try
atReceive.Append;
atReceive.FieldByName('ToEmail').AsString:=toEmail;
atReceive.FieldByName('FromEmail').AsString:=fromEmail;
atReceive.FieldByName('Subject').AsString:=Subject;
atReceive.FieldByName('POP3ServerName').AsString:=POP3ServerName;
if nattachCount=0 then
begin
atReceive.FieldByName('AttachBackupPath').AsString:='';
atREceive.FieldByName('AttachName').AsString:='';
end
else
begin
atReceive.FieldByName('AttachBackupPath').AsString:=attchBackUp;
StrSToStr(popReceive.MailMessage.Attachments,';',AttachName);
atReceive.FieldByName('AttachName').AsString:=AttachName;
end;
atReceive.FieldByName('AttachCounter').AsInteger:=nAttachCount;
atReceive.FieldByName('UserName').AsString:='';
atReceive.FieldByName('Password').AsString:='';
atReceive.FieldByName('MailBody').AsString:=MailBody;
atReceive.FieldByName('DateTime').AsString:=szDateTime;
atREceive.FieldByName('IsCheck').AsString:=isCheck;
atReceive.FieldByName('IsOK').AsString:=isOK;
atReceive.FieldByName('IsStatus').AsString:=isStatus;
atReceive.FieldByName('PendingStartTime').AsString:='';
atReceive.FieldByName('PendingEndTime').AsString:='';
atReceive.Post;
finally
atReceive.Active:=False;
end;
if nAttachcount>0 then
begin
AccessPath:=True;
if atReceive.Active then
atReceive.Close;
atReceive.Active:=True;
atReceive.FindLast;
nMailID:=atReceive.FieldByName('ID').AsInteger;
szMailDate:=copy(atReceive.FieldByName('DateTime').AsString,1,8);
atReceive.Close;
maPath:=AttchBackUp;
while maPath[Length(maPath)]='/' do
begin
Delete(maPath,Length(maPath),1);
end;
if not DirectoryExists(maPath) then
begin
if not CreateDir(maPath) then
begin
sRE(gErr1,'Cannot access '+maPath+', Create subdirectory'+' in program file directory ! ');
maPath:=gAppPath;
end;
end;
maPath:=maPath+'/'+szMailDate;
if not DirectoryExists(maPath) then
begin
if not CreateDir(maPath) then
begin
sRE(gErr1,'Cannot access '+maPath+', Create subdirectory'+' in program file directory ! ');
AccessPath:=False;
end;
end;
if AccessPath then
begin
maPath:=maPath+'/'+IntToStr(nMailID);
if not DirectoryExists(maPath) then
begin
if not CreateDir(maPath) then
begin
sRE(gErr1,'Cannot access '+maPath+', Create subdirectory'+' in program file directory ! ');
AccessPath:=False;
end;
end;
end;
if AccessPath then
begin
maPath:=maPath+'/';
if AttchBackUp[length(AttchBackUp)]<>'/' then
AttchBackUp:=AttchBackUp+'/';
for i:=0 to nAttachCount-1 do
begin
OldFN:=AttchBackUp+popReceive.MailMessage.Attachments.Strings;
NewFN:=maPath+popReceive.MailMessage.Attachments.Strings;
CopyFile(PChar(OldFN),PChar(NewFN),False);
DeleteFile(OldFN);
end;
end;
end;
end;
Inc(totReceiveNum);
lReceiveNum.Caption:=IntToStr(totReceiveNum)+' Mails received';
if totReceiveNum>0 then
lReceivenum.Visible:=True;
ProcessCurMailDone:=true;
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Done Process Email: '+IntToStr(CurReceiveMailNum);
end;

procedure TeMail.popReceiveList(Msg, Size: Integer);
begin
mmList.Lines.Add('Message '+IntToStr(Msg)+': '+IntToStr(Size)+' bytes');
end;

procedure TeMail.popReceiveAuthenticationFailed(var Handled: Boolean);
begin
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Authentication failed ! ';
sRE(gErr1,'ReceiveMail : Authentication failed ! ');
end;

procedure TeMail.popReceiveAuthenticationNeeded(var Handled: Boolean);
begin
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Authentication needed ! ';
end;

procedure TeMail.popReceiveConnectionFailed(Sender: TObject);
begin
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Connection failed ! ';
sRE(gErr1,'ReceiveMail : Connection failed ! ');
end;

procedure TeMail.popReceiveConnectionRequired(var Handled: Boolean);
begin
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Connection required ! ';
popReceive.Connect;
end;

procedure TeMail.popReceiveDecodeEnd(Sender: TObject);
begin
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Decode end';
end;

procedure TeMail.popReceiveDecodeStart(var FileName: String);
var
strS:string;
strF:string;
begin
SetLength(strS,200);
SetLength(strF,200);
strS:=FileName;
if pos('?B?',Uppercase(strS))>0 then
begin
Delete(strS,1,pos('?B?',Uppercase(strS))+2);
Delete(strS,pos('?=',strS),2);
strF:=DecodeBase64(strS);
FileName:=strF;
end
else if pos('?Q?',Uppercase(FileName))>0 then
begin
Delete(strS,1,pos('?Q?',Uppercase(strS))+2);
Delete(strS,pos('?=',strS),2);
strF:=DecodeQuotedP(strS);
FileName:=strF;
end;
if Pos('?',FileName)>0 then
FileName:=Format('%f',[Time])+'.Tmp';
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Decode start ! ';
end;

procedure TeMail.popReceiveDisconnect(Sender: TObject);
begin
POPRConnect:=False;
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Disconnect ! ';
DeleteTempFile(popReceive.AttachFilePath);
end;

procedure TeMail.popReceiveFailure(Sender: TObject);
begin
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Failure ! ';
sRE(gErr1,'ReceiveMail : Failure ! ');
end;

procedure TeMail.popReceiveHostResolved(Sender: TComponent);
begin
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Host resolved ! ';
end;

procedure TeMail.popReceiveInvalidHost(var Handled: Boolean);
begin
POPRConnect:=False;
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Invalid host ! ';
sRE(gErr1,'ReceiveMail : Invalid host ! ');
end;

procedure TeMail.popReceivePacketRecvd(Sender: TObject);
begin
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Packet received ! ';
end;

procedure TeMail.popReceiveReset(Sender: TObject);
begin
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Reset ! ';
end;

procedure TeMail.popReceiveRetrieveStart(Sender: TObject);
begin
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Retrieve start ! ';
end;

procedure TeMail.popReceiveStatus(Sender: TComponent; Status: String);
begin
sbPOP.SimpleText:=TimeToStr(Time)+' : '+Status;
end;

procedure TeMail.popReceiveSuccess(Sender: TObject);
begin
sbPOP.SimpleText:=TimeToStr(Time)+' : '+'Success ! ';
end;

procedure TeMail.smtpSendAttachmentNotFound(Filename: String);
begin
sbSMTP.SimpleText:=TimeToStr(Time)+' : '+'Attachment('+FileName+') not found ! ';
sRE(gErr1,'SendMail : Attachment('+FileName+') not found ! ');
end;

procedure TeMail.smtpSendAuthenticationFailed(var Handled: Boolean);
begin
sbSMTP.SimpleText:=TimeToStr(Time)+' : '+'Authentication failed ! ';
sRE(gErr1,'SendMail : Authentication failed ! ');
end;

procedure TeMail.smtpSendConnect(Sender: TObject);
begin
SMTPConnect:=True;
sbSMTP.SimpleText:=TimeToStr(Time)+' : '+'Connect ! ';
if smtpSend.ReplyNumber = 250 then
smtpSend.Transaction('auth login');
if smtpSend.ReplyNumber = 334 then
begin
smtpSend.Transaction(EncodeBase64(mCSMTPServer.mUser));
smtpSend.Transaction(EncodeBase64(mCSMTPServer.mPassword));
end;
smtpSend.SendMail;
sbSMTP.SimpleText:=TimeToStr(Time)+' : '+'Start send mail ! ';
end;

procedure TeMail.smtpSendConnectionFailed(Sender: TObject);
begin
sbSMTP.SimpleText:=TimeToStr(Time)+' : '+'Connection failed ! ';
sRE(gErr1,'SendMail : Connection failed ! ');
end;

procedure TeMail.smtpSendConnectionRequired(var Handled: Boolean);
begin
sbSMTP.SimpleText:=TimeToStr(Time)+' : '+'Connection required ! ';
smtpSend.Connect;
end;

procedure TeMail.smtpSendDisconnect(Sender: TObject);
begin
SMTPConnect:=False;
sbSMTP.SimpleText:=TimeToStr(Time)+' : '+'Disconnect ! ';
DoneCurSendMail:=True;
end;

procedure TeMail.smtpSendEncodeEnd(Filename: String);
begin
sbSMTP.SimpleText:=TimeToStr(Time)+' : '+'Encode end ! ';
end;

procedure TeMail.smtpSendEncodeStart(Filename: String);
begin
sbSMTP.SimpleText:=TimeToStr(Time)+' : '+'Encode start ! ';
end;

procedure TeMail.smtpSendFailure(Sender: TObject);
begin
DoneCurSendMail:=True;
CurSendMailSuccess:=False;
sbSMTP.SimpleText:=TimeToStr(Time)+' : '+'Send failure ! ';
sRE(gErr1,'SendMail : Send failure ! ');
end;

procedure TeMail.smtpSendHeaderIncomplete(var handled: Boolean;
hiType: Integer);
begin
sbSMTP.SimpleText:=TimeToStr(Time)+' : '+'Header incomplete ! ';
sRE(gErr1,'SendMail : Header incomplete ! ');
end;

procedure TeMail.smtpSendHostResolved(Sender: TComponent);
begin
sbSMTP.SimpleText:=TimeToStr(Time)+' : '+'Host resolved ! ';
end;

procedure TeMail.smtpSendInvalidHost(var Handled: Boolean);
begin
sbSMTP.SimpleText:=TimeToStr(Time)+' : '+' Invalid host ! ';
sRE(gErr1,'SendMail : Invalid host !');
end;

procedure TeMail.smtpSendMailListReturn(MailAddress: String);
begin
sbSMTP.SimpleText:=TimeToStr(Time)+' : '+'MailList '+MailAddress+' return ! ';
end;

procedure TeMail.smtpSendPacketSent(Sender: TObject);
begin
sbSMTP.SimpleText:=TimeToStr(Time)+' : '+'Packet sent ! ';
end;

procedure TeMail.smtpSendRecipientNotFound(Recipient: String);
begin
sbSMTP.SimpleText:=TimeToStr(Time)+' : '+Recipient+' not found ! ';
sRE(gErr1,'SendMail : '+Recipient+' not found ! ');
end;

procedure TeMail.smtpSendSendStart(Sender: TObject);
begin
sbSMTP.SimpleText:=TimeToStr(Time)+' : '+'Send start ! ';
end;

procedure TeMail.smtpSendStatus(Sender: TComponent; Status: String);
begin
sbSMTP.SimpleText:=TimeToStr(Time)+' : '+Status;
end;

procedure TeMail.smtpSendSuccess(Sender: TObject);
begin
DoneCurSendMail:=True;
CurSendMailSuccess:=True;
sbSMTP.SimpleText:=TimeToStr(Time)+' : '+'Send success ! ';
smtpSend.Disconnect;
end;

procedure TeMail.SetPOP3Server1Click(Sender: TObject);
var
frmIni:TfrmIni;
begin
frmIni:=TfrmIni.Create(Application);
frmIni.ShowModal;
frmIni.Free;
if GetServersInfo then
POPServerReady:=true
else
POPServerReady:=False;
end;

procedure TeMail.Abort1Click(Sender: TObject);
var
DllName,szEN,szCO,szIDChar;
LibHandle:THandle;
ShowAboutrocedure(szExeName,szCorp,szProductIDChar);stdcall;
begin
szEN:=StrNew(PChar(ExtractFileName(Application.ExeName)));
szCo:=StrNew(PChar('AAA'));
szID:=StrNew(PChar('BBB'));
DllName:=StrNew(PChar('cr.dll'));
try
LibHandle := LoadLibrary(DllName);
if LibHandle = 0 then
ShowMessage('Cannot find CR.DLL ! ')
else
begin
try
@ShowAbout:=GetProcAddress(LibHandle, 'ShowAbout');
if not (@ShowAbout = nil) then
ShowAbout(szEN,szCO,szID)
else
ShowMessage('Call procedure Err ! ');
finally
FreeLibrary(LibHandle);
end;
end;
finally
StrDispose(szEN);
StrDispose(szCO);
StrDispose(szID);
StrDispose(DllName);
end;
end;

procedure TeMail.mmHistoryKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
NewString: string;
ShowStr:string;
tStr:string;
MS:TMemoryStatus;
begin
try
if ((ssShift in Shift) and (ssCtrl in Shift)) and (Key=VK_F12) then
begin
SetLength(NewString,20);
newString:='';
if InputQuery('Enter Password','Password:',NewString) then
begin
if NewString='DebugStatus' then
begin
SetLength(ShowStr,250);
SetLength(tStr,50);
case TimerForWhich of
tIdle:
tStr:='tIdle';
tSend:
tStr:='tSend';
tCheck:
tStr:='tCheck';
tReceive:
tStr:='tReceive';
else
tStr:='Unknown';
end;
ShowStr:='TimerForWhich:'+tStr;
case CurSystemStatus of
sNotReady:
tStr:='sNotReady';
sIdle:
tStr:='sIdle';
sCheckMail:
tStr:='sCheckMail';
sSendMail:
tStr:='sSendMail';
sReceiveMail:
tStr:='sReceiveMail';
else
tStr:='Unknown';
end;
ShowStr:=ShowStr+#13+'CurSystemStatus:'+tStr;
if SMTPConnect then
ShowStr:=ShowStr+#13+'SMTP:'+'Connect';
if POPCConnect then
ShowStr:=ShowStr+#13+'POP(C):'+'Connect';
if POPRConnect then
ShowStr:=ShowStr+#13+'POP(R):'+'Connect';
ShowStr:=ShowStr+#13#13+'Memory Status:';
MS.dwLength:=SizeOf(TMemorystatus);
FillChar(MS,SizeOf(TMemorystatus),0);
GlobalMemoryStatus(MS);
ShowStr:=ShowStr+#13+Format('Total:%u',[MS.dwTotalPhys]);
ShowStr:=ShowStr+#13+Format('Avail:%u',[MS.dwAvailPhys]);
ShowStr:=ShowStr+#13+Format('InUse:%u%%',[MS.dwMemoryLoad]);
ShowStr:=ShowStr+#13+Format('TotPage:%u',[MS.dwTotalPageFile]);
ShowStr:=ShowStr+#13+Format('AvlPage:%u',[MS.dwAvailPageFile]);
ShowStr:=ShowStr+#13+Format('TotVirtual:%u',[MS.dwTotalVirtual]);
ShowStr:=ShowStr+#13+Format('AvlVritual:%u',[MS.dwAvailVirtual]);
ShowMessage(ShowStr);
end;
end;
end;
finally
;
end;
end;

end.

我写的一个局域网代理收发邮件的，附上密码校验和编码解码功能
unit Unit2;

interface

uses
inifiles,Sysutils,Dialogs,Classes,Controls,StrUtils;

type
RPOPInfo=record
mServer:String;
mUser:String;
mPassWord:String;
mAttchPath:String;
mPort:Integer;
end;

ETask=(tIdle,tSend,tCheck,tReceive,tNotReady);
ESysStatus=(sNotReady,sIdle,sCheckMail,sSendMail,sReceiveMail);

RSMTPInfo=record
mServer:string;
mMailBox:string;
mUser:String;
mPassword:string;
mPort:Integer;
end;

TLOGFile=class
private
mTypeNum:array [1..10] of Integer;
mIniFile:TIniFile;
mReady:Boolean;
Public
constructor Create;
destructor Destroy;override;
function WriteLog(mLevel:Integer;mString:String):Boolean;
end;

TPOPOffice=class
private
mIniFile:TIniFile;
mLog:TLOGFile;
public
mIsOK:Boolean;
mPOPOffice:array[0..9] of RPOPInfo;
mPOPONum:Integer;
constructor Create;
destructor Destroy;override;
function ReadPOPONum:Integer;
function GetPOPInfo(nIndex:Integer;var pInfo:RPOPInfo):Boolean;
end;

TSMTPOffice=class
private
mIniFile:TIniFile;
mLog:TLOGFile;
public
mIsOK:Boolean;
mSMTPOffice:RSMTPInfo;
constructor Create;
destructor Destroy;override;
function GetSMTPInfo(var pInfo:RSMTPInfo):Boolean;
end;

const
gErr1=1;
gErr2=2;
gErr3=3;
gErr4=4;
gErr5=5;
gErr6=6;
gErr7=7;
gErr8=8;
gErr9=9;
gErr10=10;
gTryCheckNumber=3;
InDebug=True; // ToChange

var
gAccessErr:Integer;
gAppPath:String;

function EncodeBase64(Source:string):string;
function StrToStrS(Source:string;divide:string;var tStrs:TStringList):Boolean;
function StrSToStr(Source:TStrings;divide:string;var tStr:string):Boolean;
function ExtAtt(SourceName,SourcePath,Divide:string;SourceNum:Integer;var tStrs:TStringList):Boolean;
function DecodeBase64(Source:string):string;
function DecodeQuotedP(Source:string):string;
function EncodeQuotedP(Source:string):string;
procedure DeleteTempFile(PathName:string);

implementation

function EncodeQuotedP(Source:string):string;
function dQP(bt:Byte):string;
var
str:string;
begin
setlength(str,5);
str:=Format('%X',[bt]);
if Length(str)=1 then
str:='0'+str;
str:='='+str;
dQP:=str;
end;
var
i,LenStr:Integer;
tStr:string;
begin
LenStr:=Length(Source);
SetLength(tStr,3*LenStr+3);
tStr:='';
for i:=1 to LenStr do
begin
case Source of
'!'..'<','>'..'~':
tStr:=tStr+Source;
else
tStr:=tStr+dQP(ord(Source));
end;
end;
EncodeQuotedP:=tStr;
end;

function DecodeQuotedP(Source:string):string;
var
sStr:string;
tStr:string;
function qCov(subStr:string):Char;
var
Tmp:Integer;
function CtoI(C:Char):Integer;
var
Retn:Integer;
begin
case C of
'0':Retn:=0;
'1':Retn:=1;
'2':Retn:=2;
'3':Retn:=3;
'4':Retn:=4;
'5':Retn:=5;
'6':Retn:=6;
'7':Retn:=7;
'8':Retn:=8;
'9':Retn:=9;
'A':Retn:=10;
'B':Retn:=11;
'C':Retn:=12;
'D':Retn:=13;
'E':Retn:=14;
'F':Retn:=15;
else
Retn:=0;
end;
CtoI:=Retn;
end;
begin
if Pos('=',subStr)>0 then
Delete(subStr,1,1);
subStr:=UpperCase(subStr);
if Length(subStr)=2 then
begin
Tmp:=CtoI(subStr[1])*16+CtoI(subStr[2]);
qCov:=Char(Tmp);
end
else
qCov:=#0;
end;
begin
SetLength(sStr,10);
SetLength(tStr,200);
tStr:='';
While Source<>'' do
begin
if Source[1]='=' then
begin
sStr:=MidStr(Source,1,3);
tStr:=tStr+qCov(sStr);
Delete(Source,1,3);
end
else
begin
tStr:=tStr+Source[1];
delete(Source,1,1);
end;
end;
DecodeQuotedP:=tStr;
end;

function DecodeBase64(Source:string):string;
var
i,ForI:Integer;
X1,X2,X3:Char;
Y1,Y2,Y3,Y4:Char;
function ISHB(CHA:Char):Byte;
begin
case CHA of
'A'..'Z':
ISHB:=Ord(CHA)-Ord('A');
'a'..'z':
ISHB:=Ord(CHA)-Ord('a')+26;
'0'..'9':
ISHB:=ord(CHA)-Ord('0')+52;
'+':
ISHB:=62;
'/':
ISHB:=63;
else
begin
ShowMessage('Err Char ! ');
ISHB:=255;
end;
end;
end;
begin
Result:='';
if (Length(Source) mod 4) <> 0 then
begin
ShowMessage('Err length in ('+Source+')');
exit;
end;
ForI:=Length(Source) div 4;
for i:=0 to ForI-1 do
begin
Y1:=Source[i*4+1];
Y2:=Source[i*4+2];
Y3:=Source[i*4+3];
Y4:=Source[i*4+4];
if (Y3='=') and (Y4='=') then
begin
X1:=char(((ISHB(Y1) shl 2) and 252) or ((ISHB(Y2) shr 4) and 3));
x2:=#0;
x3:=#0;
end else if (y4='=') then
begin
X1:=Char(((ISHB(Y1) shl 2) and 252) or ((ISHB(Y2) shr 4) and 3));
X2:=Char(((ISHB(Y2) shl 4) and 240) or ((ISHB(Y3) shr 2) and 15));
X3:=#0;
end
else
begin
X1:=Char(((ISHB(Y1) shl 2) and 252) or ((ISHB(Y2) shr 4) and 3));
X2:=Char(((ISHB(Y2) shl 4) and 240) or ((ISHB(Y3) shr 2) and 15));
X3:=Char(((ISHB(Y3) shl 6) and 192) or (ISHB(Y4) and 63));
end;
Result:=Result+X1+X2+X3;
end;
end;

procedure DeleteTempFile(PathName:string);
var
pn:string;
sr: TSearchRec;
begin
pn:=trim(PathName);
if pn[length(pn)]<>'/' then
pn:=pn+'/';
if FindFirst(pn+'*.mme', faAnyFile, sr) = 0 then
begin
DeleteFile(PathName+sr.Name);
while FindNext(sr) = 0 do
begin
DeleteFile(PathName+sr.Name);
end;
FindClose(sr);
end;
end;

function ExtAtt(SourceName,SourcePath,Divide:string;SourceNum:Integer;var tStrs:TStringList):Boolean;
var
i,Num:Integer;
tStr:string;
tSrc:string;
tSrcP:string;
begin
ExtAtt:=True;
tStrs.Clear;
Num:=0;
tSrc:=Trim(SourceName);
tSrcP:=Trim(SourcePath);
if tSrcP[Length(tSrcP)]<>'/' then
tSrcP:=tSrcP+'/';
while pos(Divide,tSrc)>0 do
begin
i:=Pos(Divide,tSrc);
tStr:=Copy(tSrc,1,i-1);
tStrs.Add(tSrcP+tStr);
Inc(Num);
Delete(tSrc,1,i);
end;
tStrs.Add(tSrcP+tSrc);
Inc(Num);
if Num<>SourceNum then
ExtAtt:=False;
end;

function StrSToStr(Source:TStrings;divide:string;var tStr:string):Boolean;
var
i,Num:Integer;
begin
StrSToStr:=True;
Num:=Source.Count-1;
tStr:='';
for i:=0 to Num-1 do
begin
tStr:=tStr+Source+Divide;
end;
tStr:=tStr+Source[Num];
end;

function StrToStrS(Source:string;divide:string;var tStrs:TStringList):Boolean;
var
i:Integer;
tStr:string;
tSrc:string;
begin
StrToStrS:=True;
tStrs.Clear;
tSrc:=Trim(Source);
while pos(Divide,tSrc)>0 do
begin
i:=Pos(Divide,tSrc);
tStr:=Copy(tSrc,1,i-1);
tStrs.Add(tStr);
Delete(tSrc,1,i);
end;
tStrs.Add(tSrc);
end;

function EncodeBase64(Source:string):string;
const
BaseTable = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';
var
Times, LenSrc, i: Integer;
x1, x2, x3, x4: Char;
xt: Byte;
begin
Result := '';
LenSrc := Length(Source);
if LenSrc mod 3 = 0 then
Times := LenSrc div 3
else
Times := LenSrc div 3 + 1;
for i := 0 to Times - 1 do
begin
if LenSrc >= (3 + i * 3) then
begin
x1 := BaseTable[(ord(Source[1 + i * 3]) shr 2)+1];
xt := (ord(Source[1 + i * 3]) shl 4) and 48;
xt := xt or (ord(Source[2 + i * 3]) shr 4);
x2 := BaseTable[xt + 1];
xt := (Ord(Source[2 + i * 3]) shl 2) and 60;
xt := xt or (Ord(Source[3 + i * 3]) shr 6);
x3 := BaseTable[xt + 1];
xt := (ord(Source[3 + i * 3]) and 63);
x4 := BaseTable[xt + 1];
end
else if LenSrc >= (2 + i * 3) then
begin
x1 := BaseTable[(Ord(Source[1 + i * 3]) shr 2) + 1];
xt := (Ord(Source[1 + i * 3]) shl 4) and 48;
xt := xt or (Ord(Source[2 + i * 3]) shr 4);
x2 := BaseTable[xt + 1];
xt := (Ord(Source[2 + i * 3]) shl 2) and 60;
x3 := BaseTable[xt + 1];
x4 := '=';
end else
begin
x1 := BaseTable[(Ord(Source[1 + i * 3]) shr 2)+1];
xt := (Ord(Source[1 + i * 3]) shl 4) and 48;
x2 := BaseTable[xt + 1];
x3 := '=';
x4 := '=';
end;
Result := Result + x1 + x2 + x3 + x4;
end;
end;

constructor TLOGFile.Create;
var
i:Integer;
begin
mReady:=False;
try
mIniFile:=TIniFile.Create(gAppPath+'EmailLog.Log');
for i:=1 to 10 do
begin
if not mIniFile.ValueExists('Count Of Levels','Level'+IntToStr(i)) then
mIniFile.WriteInteger('Count Of Levels','Level'+IntToStr(i),0);
mTypeNum:=mIniFile.ReadInteger('Count Of Levels','Level'+IntToStr(i),0);
end;
mReady:=True;
except
ShowMessage('Can not create/access ' + gAppPath+'EmailLog.Log ! ');
end;
end;

destructor TLOGFile.Destroy;
begin
mIniFile.Free;
inherited Destroy;
end;

function TLOGFile.WriteLog(mLevel:Integer;mString:String):Boolean;
begin
WriteLog:=False;
if mReady and (mLevel<=gAccessErr) then
begin
try
mTypeNum[mLevel]:=mIniFile.ReadInteger('Count Of Levels','Level'+IntToStr(mLevel),mTypeNum[mLevel]);
Inc(mTypeNum[mLevel]);
mIniFile.WriteInteger('Count Of Levels','Level'+IntToStr(mLevel),mTypeNum[mLevel]);
mIniFile.WriteString('Level'+IntToStr(mLevel),intToStr(mTypeNum[mLevel])+'('+DateToStr(Date)+'|'+TimeToStr(Time)+')','> '+mString);
WriteLog:=True;
except
;
end;
end;
end;

constructor TPOPOffice.Create;
var
i:Integer;
begin
mIsOK:=True;
try
if InDebug then
mLog:=TLogFile.Create;
if FileExists(gAppPath+'/POP3Server.ini') then
begin
mIniFile:=TIniFile.Create(gAppPath+'POP3Server.ini');
mPOPONum:=REadPOPONum;
for i:=0 to mPOPONum-1 do
begin
if not GetPOPInfo(i,mPOPOffice) then
mIsOk:=False;
end;
end
else
begin
mIsOK:=False;
if InDebug then
mLog.WriteLog(gErr1,'Cannot find '+gAppPath+'POP3Server.ini');
end;
except
mIsOK:=False;
if InDebug then
mLog.WriteLog(gErr1,'Cannot access '+gAppPath+'POP3Server.ini');
end;
end;

destructor TPOPOffice.Destroy;
begin
mIniFile.Free;
if InDebug then
mLog.Free;
inherited Destroy;
end;

function TPOPOffice.ReadPOPONum:Integer;
begin
ReadPOPONum:=0;
try
ReadPOPONum:=mIniFile.ReadInteger('PostOffice','PostOfficeNum',1);
except
if InDebug then
mLog.WriteLog(gErr1,'Cannot read value of PostOfficeNum ! ');
end;
end;

function TPOPOffice.GetPOPInfo(nIndex:Integer;var pInfo:RPOPInfo):Boolean;
var
nSize:Integer;
begin
GetPOPInfo:=False;
nSize:=ReadPOPONum;
if (nIndex>=0) and (nIndex<10) then
begin
if (nSize>=0) and (nSize<10) then
if nIndex<nSize then
begin
pInfo.mServer:=mIniFile.ReadString('MailBox'+IntToStr(nIndex),'POP3ServerName','Pop.163.net');
pInfo.mUser:=mIniFile.ReadString('MailBox'+IntToStr(nIndex),'UserName','duxiaoqiang');
pInfo.mPassWord:=mIniFile.ReadString('MailBox'+IntToStr(nIndex),'Password','dxqzj');
pInfo.mAttchPath:=mIniFile.ReadString('MailBox'+IntToStr(nIndex),'AttachPath','c:/outbox/');
pInfo.mPort:=mIniFile.ReadInteger('MailBox'+IntToStr(nIndex),'Port',110);
GetPOPInfo:=True;
end;
end
else
if InDebug then
mLog.WriteLog(gErr1,'GetPOPInfo boundary error ! ');
end;

function TSMTPOffice.GetSMTPInfo(var pInfo:RSMTPInfo):Boolean;
begin
GetSMTPInfo:=False;
try
pInfo.mServer:=mIniFile.ReadString('SMTPOffice','SMTPServerName','smtp.163.net');
pInfo.mUser:=mIniFile.ReadString('SMTPOffice','UserName','duxiaoqiang');
pInfo.mPassWord:=mIniFile.ReadString('SMTPOffice','Password','dxqzj');
pInfo.mPort:=mIniFile.ReadInteger('SMTPOffice','Port',25);
pInfo.mMailBox:=mIniFile.ReadString('SMTPOffice','MailBoxName','duxiaoqiang.163.net');
GetSMTPInfo:=True;
except
if InDebug then
mLog.WriteLog(gErr1,'Cannot read '+gAppPath+'SMTPServer.ini');
end;
end;

constructor TSMTPOffice.Create;
begin
mIsOK:=True;
try
if InDebug then
mLog:=TLogFile.Create;
if FileExists(gAppPath+'/SMTPServer.ini') then
begin
mIniFile:=TIniFile.Create(gAppPath+'SMTPServer.ini');
if not GetSmtpInfo(mSMTPOffice) then
mIsOK:=False;;
end
else
begin
mIsOK:=False;
if InDebug then
mLog.WriteLog(gErr1,'Cannot find '+gAppPath+'SMTPServer.ini');
end;
except
if InDebug then
mLog.WriteLog(gErr1,'Cannot access '+gAppPath+'SMTPServer.ini');
mIsOK:=False;
end;
end;

destructor TSMTPOffice.Destroy;
begin
if InDebug then
mLog.Free;
mIniFile.Free;
inherited Destroy;
end;

initialization
gAccessErr:=10;
gAppPath:=ExtractFilePath(ParamStr(0));
end.

to TangDL:
你好，你的邮件程序中的unit1,unit2分别有什么内容？能不能把内容贴出来，或者把整个程序
包可运行的界面程序，我的邮箱为：xhyqp@hotmail.com，谢谢！！！

老大，都什么时候了，我工作都换了几家了，哪儿找源代码，
这样吧，有啥问题问出来，我看能不能帮你一下

你好！
我正在作一个关于网上单据申报系统：各个县的数据通过电子邮件向市上发送，
每一张单据至多有4笔记录，为了申报数据安全，把申报数据写入邮件正文，
但写入之前必须加密后发送到电子邮箱yqp_105@163.com；然后，
在市俯服务器端使用sql server数据库服务器，必须做一个从yqp_105@163.com接受各个县发送来的数据的软件，
要求能够每天每隔30分钟检测信箱，若有邮件则接受下来，
解包留下申报记录数据更新入市俯数据库并自动回复信息告诉用户申报成功。
由于邮件方面的编程接触比较少，还有对记录数据加解密算法很难实现，
你能不能给我详细解决方案和实现程序，thanks!!!