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>.<CRLF>' + 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));