www.pudn.com > MailServer.rar > cMain.pas
unit cMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Sockets, ScktComp, KsSkinEngine, se_controls,
KsSkinForms, ksskinstdcontrol, ActnList, KsSkinItems, Menus, KsSkinMenus,
ExtCtrls, KsSkinButtons, KsSkinLabels, KsSkinGroupBoxs, DataSet, ComCtrls,
ksskinmessages;
type
SessionState = (stInit, stAuthorization, stTransaction, stUpdate );
PMailList = ^AMailList;
AMailList = record
UserName, PassWord,Domain,Power,Size,MailBoxPath: string; //用户名和密码
SessionState: SessionState; //会话状态
MailFrom: string[65]; //发送者
RcptTo: Tstrings; //SMTP发送时为接收者表，限制由自己定
//POP收信时为删除标记，-表示已作删除标记，+表示未作删除标记
//index=0的项为总信件数（字符型数字）
Data: string; //邮件内容
SockHandle: integer; //会话使用的soket句柄，用于区分是那一个会话的标记
P: TextFile; //读写文件的指针
success: Boolean; //整个过程是否正常结束
end;
function CheckUser(UserName:string):boolean;
function CheckPass(UserName,UserPass:string;var MailRecord:PMailList):boolean;
type
TfrmMain = class(TForm)
SeSkinForm1: TSeSkinForm;
SeSkinPopupMenu1: TSeSkinPopupMenu;
CustomItem1: TSeSkinItem;
CustomItem2: TSeSkinItem;
CustomItem3: TSeSkinItem;
CustomItem4: TSeSkinItem;
actList: TActionList;
actviewlog: TAction;
actsetup: TAction;
actclose: TAction;
Image1: TImage;
GroupBox1: TSeSkinGroupBox;
lbl_company: TSeSkinLabel;
Label2: TSeSkinLabel;
btnClose: TSeSkinButton;
mnuSkin: TSeSkinItem;
SeSkinEngine1: TSeSkinEngine;
actAbout: TAction;
CustomItem5: TSeSkinItem;
SeMsg: TSeSkinMessage;
sckSmtp: TServerSocket;
sckPop3: TServerSocket;
lbl_jcompany: TSeSkinLabel;
procedure sckSmtpListen(Sender: TObject;
Socket: TCustomWinSocket);
procedure sckSmtpAccept(Sender: TObject;
Socket: TCustomWinSocket);
procedure sckSmtpClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure sckSmtpClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure sckSmtpClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure sckPop3Accept(Sender: TObject;
Socket: TCustomWinSocket);
procedure sckPop3ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure sckPop3ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure sckPop3Listen(Sender: TObject;
Socket: TCustomWinSocket);
procedure sckPop3ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure outmsg(instr:string);
procedure actcloseExecute(Sender: TObject);
procedure actviewlogExecute(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
procedure sckSmtpClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure sckPop3ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure AppException(Sender: TObject; E: Exception);
procedure SkinClick(Sender: TObject);
procedure actAboutExecute(Sender: TObject);
procedure actsetupExecute(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private declarations }
public
{ Public declarations }
SkinFile:string;
end;
//SMTP接收处理类
type
TSMTPEngin = class(TThread)
private
socket: TCustomWinSocket;
text: string;
protected
procedure execute; override;
function SaveMail(Socket: TCustomWinSocket): boolean;
procedure SMTPMailEngin;
end;
//POP3接收处理类
type
TPOP3Engin = class(TThread)
private
socket: TCustomWinSocket;
text: string;
protected
procedure execute; override;
procedure POP3MailEngin;
end;
var
frmMain: TfrmMain;
SMTPList: TList;
POP3List: TList;
root :string;
implementation
uses Functions, cLog, ADODB_TLB, Utility, cSet;
{$R *.dfm}
////////////////////////////////////////////邮件接收/处理线程类开始//////////////////////////////////////
//SMTP类
procedure TSMTPEngin.execute;
begin
synchronize(SMTPMailEngin);
end;
procedure TSMTPEngin.SMTPMailEngin;
var
i: integer;
MailRecord: PMailList;
sendecho:string;
begin
Text := socket.ReceiveText;
//查找相应记录
MailRecord := nil;
for i := 0 to SMTPList.Count - 1 do
begin
MailRecord := SMTPList.Items[i];
if MailRecord.SockHandle = socket.SocketHandle then
break;
end;
case MailRecord.SessionState of
stInit:
begin
text := trim(DeleteSubString(text, CRLF, -1, False));
if (pos('HELO', uppercase(text)) = 1) or (pos('EHLO', uppercase(text)) = 1) then
begin
MailRecord.SessionState := stAuthorization; //状态改为验证会话状态
sendecho:='250-SMTP server ready' + CRLF;
sendecho:=sendecho+'250-AUTH LOGIN' + CRLF;
sendecho:=sendecho+'250 8BITMIME' + CRLF;
end
else
sendecho:='500 cmd line invalidate' + CRLF;
end;
stAuthorization:
begin
text := trim(DeleteSubString(text, CRLF, -1, False));
if uppercase(text) = 'AUTH LOGIN' then
sendecho:='334 VXNlcm5hbWU6' + CRLF
else if MailRecord.UserName = '' then
begin
if CheckUser(DecodeBase64(text)) then
//if DirectoryExists(DecodeBase64(text)) then //检查是否有相应的邮箱路径,检查是否是合法用户
begin
MailRecord.UserName := DecodeBase64(text); //存入用户名
sendecho:='334 UGFzc3dvcmQ6'+ CRLF;
end
else
sendecho:='555 AUTH LOGIN failed,invalid User' + CRLF; //不是合法用户
end
else if (MailRecord.PassWord = '') and (text <> '') then
begin
if CheckPass(MailRecord.UserName,DecodeBase64(text),MailRecord) then
//if text = MailRecord.UserName then //根据用户名找到相应的密码并比较认证,这里让它等于用户名
begin
MailRecord.PassWord := DecodeBase64(text);
MailRecord.SessionState := stTransaction; //通过验证，会话进入stTransaction传输状态
sendecho:='235 ' + text + CRLF;
end
else
sendecho:='535 AUTH LOGIN failed,PassWord Error' + MailRecord.UserName + CRLF
end
else if text <> '' then
sendecho:='500 cmd line invalidate ' + CRLF;
end;
stTransaction:
begin
if pos('MAIL FROM:', uppercase(text)) = 1 then
begin
MailRecord.MailFrom := trim(copy(text, 11, length(text) - 10));
sendecho:='250 RCPT TO to enter receiver(s)' + CRLF;
end
else if pos('RCPT TO:', uppercase(text)) = 1 then //接收者
begin
if MailRecord.RcptTo.Count < 10 then //最大一次可转发人数为9，共发给10人（这里可以自己定制）
begin
MailRecord.RcptTo.Add(trim(copy(text, 9, length(text) - 8)));
sendecho:='250 receiver(s) ' + trim(copy(text, 9, length(text) - 8)) + ' accepted' + CRLF;
end
else
sendecho:='502 receiver(s) overload, Max is 10' + CRLF;
end
else if UpperCase(text) = 'DATA' + CRLF then
begin
if MailRecord.RcptTo.Count > 0 then //检测接收者是否为空
sendecho:='354 Start mail input; end with .' + CRLF
else
sendecho:='502 receiver buffer empty' + CRLF;
end
else if pos(CRLF + '.' + CRLF, text) > 0 then //结束邮件内容
begin
MailRecord.Data := MailRecord.Data + copy(text, 0, Pos(CRLF + '.' + CRLF, text) - 1);
text:='';
MailRecord.success := True;
if SaveMail(socket) then
sendecho:='250 message accepted' + CRLF
else
sendecho:='500 write message failed' + CRLF;
end
else if UpperCase(text) = 'QUIT' + CRLF then //结束会话，进入更新状态
begin
MailRecord.SessionState := stUpdate;
sendecho:='250 bye' + CRLF;
end
else if pos('RSET', uppercase(text)) = 1 then
begin
MailRecord.success := False;
sendecho:='250 SMTP server have reset OK' + CRLF;
end
else
begin
MailRecord.Data := MailRecord.Data + text;
text:='';
end;
end;
stUpdate:
begin
sendecho:='250 Session Close' + CRLF;
socket.Close;
end;
else
sendecho:='500 cmd line invalidate' + CRLF;
end; //end of case;
if sendecho<>'' then
begin
socket.SendText(sendecho);
frmMain.outmsg(sendecho);
end;
if text<>'' then frmMain.outmsg(text+CRLF);
sleep(50);
if MailRecord.SessionState = stUpdate then socket.Close;
end;
procedure TfrmMain.outmsg(instr:string);
begin
FrmLog.AddMsg(inStr);
end;
function TSMTPEngin.SaveMail(Socket: TCustomWinSocket): boolean;
var
i, j: integer;
MailRecord: PMailList;
recever, filename: string;
root:string;
begin
result := true;
root:=ExtractFilePath(Application.ExeName);
for i := 0 to SMTPList.Count - 1 do
begin
MailRecord := SMTPList.Items[i];
if MailRecord.SockHandle = socket.SocketHandle then
begin
if MailRecord.success then //如果接收正常，就分发邮件
begin
try
for j := 0 to MailRecord.RcptTo.Count - 1 do
begin
recever := MailRecord.RcptTo.Strings[j];
recever := copy(recever, pos('<', recever) + 1, pos('>', recever) - pos('<', recever) - 1); //得到<>内的邮件地址
recever := trim(copy(recever, 1, pos('@', recever) - 1)); //得到用户名
MailRecord.MailBoxPath := root + 'Domain\' + MailRecord.Domain + '\' + recever + '\'; //邮箱路径
ForceDirectories(MailRecord.MailBoxPath);
SetCurrentDir(MailRecord.MailBoxPath);
filename := getuserid; //产生一个20位数字文件名，也作为它的邮件独立-ID表
assignfile(MailRecord.P,filename+'.txt');
rewrite(MailRecord.P); //建立邮件文件
write(MailRecord.P, 'S'+CRLF+MailRecord.Data);
closefile(MailRecord.P);
assignfile(MailRecord.P,'index.txt');
if fileExists('index.txt') then
append(MailRecord.P) //如果存在索引，追加记录
else
rewrite(MailRecord.P); //建立索引文件
writeln(MailRecord.P, '+' + filename); //写内容,+号位是删除标记位，表示未删除
Flush(MailRecord.P);
closefile(MailRecord.P);
SetCurrentDir(root);
end;
except
result := false;
end;
end;
MailRecord.success := False;
MailRecord.UserName := '';
MailRecord.PassWord := '';
MailRecord.MailFrom := '';
MailRecord.RcptTo.Clear;
break;
end;
end;
end;
function CheckPass(UserName,UserPass:string;var MailRecord:PMailList): boolean;
var
tRs:TRecordSet;
lsql:string;
ErrText:string;
begin
Result:=false;
lsql:='select * from MailUser where 1=1 '
+ ' and UserName='''+CorrectStr(UserName)+''''
+ ' and UserPass='''+CorrectStr(UserPass)+'''';
tRs:=MailDataSet.GetData(lsql,ErrText);
if not tRs.EOF then
begin
MailRecord.UserName:=UserName;
MailRecord.PassWord:=UserPass;
if SDomain then
MailRecord.Domain:='local'
else
MailRecord.Domain:=tRs.Fields['Domain'].Value;
MailRecord.Power:=tRs.Fields['Power'].Value;
MailRecord.Size:=tRs.Fields['Size'].Value;
Result:=true;
end;
end;
function CheckUser(UserName:string): boolean;
var
tRs:TRecordSet;
lsql:string;
ErrText:string;
begin
Result:=false;
lsql:='select * from MailUser where UserName='''+CorrectStr(UserName)+'''';
tRs:=MailDataSet.GetData(lsql,ErrText);
if not tRs.EOF then
Result:=true;
end;
//POP3类
procedure TPOP3Engin.execute;
begin
synchronize(POP3MailEngin);
end;
procedure TPOP3Engin.POP3MailEngin;
var
i, totalmailbytes: integer;
MailRecord: PMailList;
sendecho: string;
readmailbody: Tstrings;
tUserName,tUserPass:string;
tmpFile:string;
begin
totalmailbytes := 0;
if not socket.Connected then exit;
Text := socket.ReceiveText;
//查找相应记录
MailRecord := nil;
for i := 0 to POP3List.Count - 1 do
begin
MailRecord := POP3List.Items[i];
if MailRecord.SockHandle = socket.SocketHandle then
break;
end;
case MailRecord.SessionState of
stInit:
begin //验证是否有此邮箱名
text := trim(DeleteSubString(text, CRLF, -1, False));
if pos('USER', uppercase(text)) = 1 then
begin
tUserName := trim(copy(text, 6, length(text) - 5));
if CheckUser(tUserName) then //是否存在用户
begin
MailRecord.SessionState := stAuthorization; //状态改为验证会话状态
MailRecord.UserName := tUserName; //记录用户名
sendecho:='+OK ' + tUserName + ' mailbox accepted' + CRLF
end
else
sendecho:='-ERR sorry, no mailbox for ' + tUserName + ' here' + CRLF;
end
else
if UpperCase(text) = 'QUIT' then
sendecho:='+OK POP3 server signing off' + CRLF
else
sendecho:='-ERR cmd line invalidate' + CRLF;
end;
stAuthorization: //验证密码
begin
text := trim(DeleteSubString(text, CRLF, -1, False));
if pos('PASS', uppercase(text)) = 1 then
begin
tUserPass := trim(copy(text, 6, length(text) - 5));
if CheckPass(MailRecord.UserName,tUserPass,MailRecord) then //验证密码是否正确
begin
MailRecord.MailBoxPath := root + 'Domain\' + MailRecord.Domain + '\' + MailRecord.UserName + '\'; //邮箱路径
ForceDirectories(MailRecord.MailBoxPath);
if not fileExists(MailRecord.MailBoxPath+'index.txt') then
FileClose(FileCreate(MailRecord.MailBoxPath+'index.txt'));
SetCurrentDir(root);
MailRecord.SessionState := stTransaction; //状态改为传输会话状态
MailRecord.PassWord := tUserPass;
sendecho:='+OK you are welcome' + CRLF
end
else
sendecho:='-ERR sorry,LOGIN failed,PassWord Error' + CRLF;
end
else
if UpperCase(text) = 'QUIT' then
sendecho:='+OK POP3 server signing off' + CRLF
else
sendecho:='-ERR cmd line invalidate' + CRLF;
end;
stTransaction:
begin
text := trim(DeleteSubString(text, CRLF, -1, False));
if uppercase(text) = 'STAT' then
begin
//处理邮件列表
MailRecord.RcptTo.LoadFromFile(MailRecord.MailBoxPath + 'index.txt');
for i := 0 to MailRecord.RcptTo.Count - 1 do
totalmailbytes := totalmailbytes + getfilesize(MailRecord.MailBoxPath + copy(MailRecord.RcptTo.Strings[i], 2, length(MailRecord.RcptTo.Strings[i]) - 1) + '.txt');
sendecho:='+OK ' + inttostr(MailRecord.RcptTo.Count) + ' ' + InttoStr(totalmailbytes) + CRLF;
end
else
if uppercase(text) = 'UIDL' then //列所有邮件独立-ID表（由0x21到0x7E字符组成，这个符号在给定的存储邮件中不会重复）
begin
sendecho:='+OK' + CRLF;
for i := 0 to MailRecord.RcptTo.Count - 1 do
sendecho:=sendecho+inttostr(i + 1) + ' ' + copy(MailRecord.RcptTo.Strings[i], 2, length(MailRecord.RcptTo.Strings[i]) - 1) + CRLF;
sendecho:=sendecho+'.' + CRLF;
end
else
if pos('UIDL', uppercase(text)) = 1 then //列指定邮件独立-ID表
begin
i := strtoint(copy(text, 5, length(text) - 4));
if i <= MailRecord.RcptTo.Count then
sendecho:='+OK ' + inttostr(i) + ' ' + copy(MailRecord.RcptTo.Strings[i - 1], 2, length(MailRecord.RcptTo.Strings[i - 1]) - 1) + CRLF
else
sendecho:='-ERR no such message found' + CRLF;
end
else
if uppercase(text) = 'LIST' then //列所有邮件
begin
for i := 0 to MailRecord.RcptTo.Count - 1 do
totalmailbytes := totalmailbytes + getfilesize(MailRecord.MailBoxPath + copy(MailRecord.RcptTo.Strings[i], 2, length(MailRecord.RcptTo.Strings[i]) - 1) + '.txt');
sendecho:='+OK ' + inttostr(MailRecord.RcptTo.Count) + ' messages (' + InttoStr(totalmailbytes) + ' bytes)' + CRLF;
for i := 0 to MailRecord.RcptTo.Count - 1 do
sendecho:=sendecho+inttostr(i + 1) + ' ' + Inttostr(getfilesize(MailRecord.MailBoxPath + copy(MailRecord.RcptTo.Strings[i], 2, length(MailRecord.RcptTo.Strings[i]) - 1) + '.txt')) + CRLF;
sendecho:=sendecho+'.' + CRLF;
end
else
if pos('LIST', uppercase(text)) = 1 then //列指定邮件
begin
i := strtoint(copy(text, 5, length(text) - 4));
if i <= MailRecord.RcptTo.Count then
sendecho:='+OK ' + inttostr(i) + ' ' + InttoStr(getfilesize(MailRecord.MailBoxPath + copy(MailRecord.RcptTo.Strings[i - 1], 2, length(MailRecord.RcptTo.Strings[i - 1]) - 1) + '.txt')) + CRLF
else
sendecho:='-ERR no such message found' + CRLF;
end
else
if pos('RETR', uppercase(text)) = 1 then
begin
i := strtoint(copy(text, 5, length(text) - 4));
if i <= MailRecord.RcptTo.Count then
begin
sendecho:='+OK ' + Inttostr(getfilesize(MailRecord.MailBoxPath + copy(MailRecord.RcptTo.Strings[i - 1], 2, length(MailRecord.RcptTo.Strings[i - 1]) - 1) + '.txt')) + ' bytes' + CRLF;
readmailbody:=TStringList.Create;
tmpFile:=MailRecord.MailBoxPath + copy(MailRecord.RcptTo.Strings[i - 1], 2, length(MailRecord.RcptTo.Strings[i - 1]) - 1) + '.txt';
readmailbody.LoadFromFile(tmpFile);
socket.SendText(sendecho+readmailbody.Text+CRLF+ '.' + CRLF);
sendecho:='';
readmailbody.Free;
end
else
sendecho:='-ERR no such message found' + CRLF;
end
else
if pos('DELE', uppercase(text)) = 1 then
begin
i := strtoint(copy(text, 5, length(text) - 4));
if i <= MailRecord.RcptTo.Count then
begin
MailRecord.RcptTo.Strings[i - 1] := replacing(MailRecord.RcptTo.Strings[i - 1], '+', '-', 1);
sendecho:='+OK message ' + copy(text, 5, length(text) - 4) + ' deleted' + CRLF;
end
else
sendecho:='-ERR no such message found' + CRLF;
end
else
if uppercase(text) = 'QUIT' then
begin
MailRecord.SessionState := stUpdate; //状态改为结束会话状态
MailRecord.success := True;
sendecho:='+OK POP3 server signing off (maildrop empty)' + CRLF;
end
else
if uppercase(text) = 'NOOP' then
sendecho:='+OK POP3 server ready' + CRLF
else
if uppercase(text) = 'RSET' then
begin
for i := 0 to MailRecord.RcptTo.Count - 1 do
MailRecord.RcptTo.Strings[i] := replacing(MailRecord.RcptTo.Strings[i], '-', '+', 1);
sendecho:='+OK maildrop has ' + inttostr(MailRecord.RcptTo.Count) + ' messages';
end;
end;
stUpdate:
begin
sendecho:='+OK POP3 server signing off' + CRLF;
socket.Close;
end;
else
sendecho:='500-cmd line invalidate' + CRLF;
end; //end of case;
if sendecho<>'' then
begin
socket.SendText(sendecho);
frmMain.outmsg(sendecho);
end;
frmMain.outmsg(text+CRLF);
sleep(50);
if MailRecord.SessionState = stUpdate then socket.Close;
end;
////////////////////////////////////////////邮件接收/处理线程类结束//////////////////////////////////////
procedure TfrmMain.sckSmtpListen(Sender: TObject;
Socket: TCustomWinSocket);
begin
outmsg('SMTP Socket(' + inttostr(socket.SocketHandle)+') 开始侦听.......');
end;
procedure TfrmMain.sckSmtpAccept(Sender: TObject;
Socket: TCustomWinSocket);
var
MailRecord: PMailList;
begin
outmsg('SMTP Socket(' + inttostr(socket.SocketHandle)+ ') ' + '已接受'+Socket.RemoteHost+'连接');
outmsg('220 SMTP server ready' + CRLF);
Socket.SendText('220 SMTP server ready' + CRLF);
MailRecord := New(PMailList);
MailRecord.SockHandle := Socket.SocketHandle;
MailRecord.SessionState := stInit;
MailRecord.success := False;
MailRecord.RcptTo := Tstringlist.Create;
MailRecord.UserName := '';
MailRecord.PassWord := '';
MailRecord.MailFrom := '';
SMTPList.Add(MailRecord);
end;
procedure TfrmMain.sckSmtpClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
outmsg('SMTP Socket(' + inttostr(socket.SocketHandle)+ ') ' + '与' + Socket.RemoteHost + '连接成功!');
end;
procedure TfrmMain.sckSmtpClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
th: TSMTPEngin;
begin
th := TSMTPEngin.Create(True);
th.FreeOnTerminate := true;
th.socket := socket;
th.Resume;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
var
tCitem:TSeSkinItem;
tmpList:Tstrings;
tmpi,tmpj:integer;
tmpSkin:string;
connstr:string;
begin
connstr:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source="'
+ ExtractFilePath(Application.ExeName)+'database\MailDB.mdb";Persist Security Info=False';
MailDataSet:=TdataSet.Create;
MailDataSet.OpenDb(connstr);
Company:=rGetValue('Company','奇易');
LCompany:=rGetValue('LCompany','上海奇易科技');
Application.Title:=Company+'邮件服务器';
SDomain:=true;
lbl_company.Caption:=LCompany;
Jcompany:=CorrectStr(rGetValue('JCompany','(c)'+lCompany),'|');
//mo_jcompany.text:=CorrectStr(jcompany,'|');
lbl_jcompany.Caption:=Jcompany;
Self.Caption:=Application.Title;
SMTPList := TList.Create;
POP3List := TList.Create;
root := ExtractFilePath(Application.ExeName);
if not Assigned(FrmLog) then
FrmLog := TfrmLog.Create(Application);
Application.OnException := AppException;
tmpSkin:=rGetValue('SkinFile','');
tmplist:=SearchFile;
for tmpj:=0 to SeSkinPopupMenu1.Items.count -1 do
if SeSkinPopupMenu1.Items[tmpj].Name='mnuSkin' then break;
if tmplist<>nil then
begin
for tmpi:=0 to tmplist.count-1 do
begin
tCitem:=TSeSkinItem.Create(SeSkinPopupMenu1.Items[tmpj]);
tCitem.OnClick:=SkinClick;
tCitem.Caption:=copy(tmplist[tmpi],1,length(tmplist[tmpi])-5);
SeSkinPopupMenu1.Items[tmpj].Add(tCitem);
if tmpSkin='' then tmpSkin:=tCitem.Caption;
end;
for tmpi:=0 to mnuSkin.Count-1 do
if lowercase(tmpSkin)=lowercase(mnuSkin.Items[tmpi].Caption) then
mnuSkin.Items[tmpi].Checked:=true;
end;
SkinFile:=ExtractFilePath(Application.ExeName)+'skins\' + tmpSkin +'.mskn';
sckSmtp.Port:=25;
sckPop3.Port:=110;
sckSmtp.Open;
sckPop3.Open;
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
SMTPList.Free;
POP3List.Free;
end;
procedure TfrmMain.sckSmtpClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
var
i: integer;
MailRecord: PMailList;
begin
for i := 0 to SMTPList.Count - 1 do
begin
MailRecord := SMTPList.Items[i];
if MailRecord.SockHandle = socket.SocketHandle then
begin
MailRecord.RcptTo.Free;
Dispose(MailRecord);
SMTPList.Delete(i);
break;
end;
end;
outmsg('SMTP Socket(' + inttostr(socket.SocketHandle)+')与'+socket.RemoteHost + '断开连接');
end;
procedure TfrmMain.sckPop3Accept(Sender: TObject;
Socket: TCustomWinSocket);
var
MailRecord: PMailList;
begin
outmsg('SMTP Socket(' + inttostr(socket.SocketHandle)+ ') ' + '已接受'+Socket.RemoteHost+'连接');
outmsg('+OK POP3 server ready' + CRLF);
Socket.SendText('+OK POP3 server ready' + CRLF);
MailRecord := New(PMailList);
MailRecord.SockHandle := Socket.SocketHandle;
MailRecord.SessionState := stInit;
MailRecord.success := False;
MailRecord.RcptTo := Tstringlist.Create;
MailRecord.UserName := '';
MailRecord.PassWord := '';
MailRecord.MailFrom := '';
POP3List.Add(MailRecord);
end;
procedure TfrmMain.sckPop3ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
outmsg('POP3 Socket(' + inttostr(socket.SocketHandle)+ ') ' + '与' + Socket.RemoteHost + '连接成功!');
end;
procedure TfrmMain.sckPop3ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
var
i, j: integer;
MailRecord: PMailList;
begin
for i := 0 to POP3List.Count - 1 do
begin
MailRecord := POP3List.Items[i];
if MailRecord.SockHandle = socket.SocketHandle then
begin
if MailRecord.success then //如果接收正常，删除作了标记的邮件
begin
for j := MailRecord.RcptTo.Count - 1 downto 0 do
if pos('-', MailRecord.RcptTo.Strings[j]) = 1 then
begin
deletefile(MailRecord.MailBoxPath + copy(MailRecord.RcptTo.Strings[j], 2, length(MailRecord.RcptTo.Strings[j]) - 1) + '.txt');
MailRecord.RcptTo.Delete(j);
end;
MailRecord.RcptTo.SaveToFile(MailRecord.MailBoxPath + 'index.txt'); //存未删除的索引
end;
MailRecord.RcptTo.Free;
Dispose(MailRecord);
POP3List.Delete(i);
break;
end;
end;
outmsg('POP3 Socket(' + inttostr(socket.SocketHandle)+')与'+socket.RemoteHost + '断开连接');
end;
procedure TfrmMain.sckPop3Listen(Sender: TObject;
Socket: TCustomWinSocket);
begin
outmsg('POP3 Socket(' + inttostr(socket.SocketHandle)+') 开始侦听.......');
end;
procedure TfrmMain.sckPop3ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
th: TPOP3Engin;
begin
th := TPOP3Engin.Create(True);
th.FreeOnTerminate := true;
th.socket := socket;
th.Resume;
end;
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
sckSmtp.Close;
sckPop3.Close;
end;
procedure TfrmMain.actcloseExecute(Sender: TObject);
begin
close;
end;
procedure TfrmMain.actviewlogExecute(Sender: TObject);
begin
actviewlog.Checked := not actviewlog.Checked;
if actviewlog.Checked then
frmlog.Show
else
frmlog.Hide ;
end;
procedure TfrmMain.btnCloseClick(Sender: TObject);
begin
self.SeSkinForm1.MinToTray;
end;
procedure TfrmMain.sckSmtpClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
showmessage(inttostr(errorcode));
end;
procedure TfrmMain.sckPop3ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
showmessage(inttostr(errorcode));
end;
procedure TfrmMain.AppException(Sender: TObject; E: Exception);
begin
showmessage(e.Message);
end;
procedure TfrmMain.SkinClick(Sender: TObject);
var
tmpi:integer;
begin
SkinFile:=ExtractFilePath(Application.ExeName)+'skins\' + lowercase(TSeSkinItem(Sender).Caption) +'.mskn';
frmMain.SeSkinEngine1.SkinFile:=SkinFile;
for tmpi:=0 to mnuSkin.Count -1 do
mnuSkin.items[tmpi].checked:=false;
TSeSkinItem(Sender).Checked:=true;
rPutValue('SkinFile',TSeSkinItem(Sender).Caption);
end;
procedure TfrmMain.actAboutExecute(Sender: TObject);
begin
frmMain.Show;
if frmMain.SeSkinForm1.WindowState = kwsTray then //kwsNormal
frmMain.SeSkinForm1.MinToTray;
end;
procedure TfrmMain.actsetupExecute(Sender: TObject);
begin
frmSet.show;
end;
procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose:=false;
if self.SeMsg.MessageDlg('确认退出？ ',mtConfirmation,[mbYes, mbNo],0)=mrYes then CanClose:=True;
end;
end.