cmain.pas

邮件系统的代码

        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.