Email服务器

开发平台：
Delphi

ufrmAttchMgr.pas：源码内容
							unit ufrmAttchMgr;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, cxCustomData, cxGraphics, 
  cxDataStorage, cxEdit, DB, cxDBData, dxBar, cxGridLevel, cxClasses,
  cxControls, cxGridCustomView, cxGridCustomTableView, cxGridTableView,
  cxGridDBTableView, cxGrid, cxContainer, ExtCtrls,
  dxBarExtItems, ADODB, ComCtrls, cxTreeView,uMyXml, cxStyles, cxFilter,
  cxData, dxSkinsCore, dxSkinBlack, dxSkinBlue, dxSkinCaramel,
  dxSkinCoffee, {dxSkinDarkRoom,} dxSkinDarkSide, {dxSkinFoggy,}
  dxSkinGlassOceans, dxSkiniMaginary, dxSkinLilian, dxSkinLiquidSky,
  dxSkinLondonLiquidSky, dxSkinMcSkin, dxSkinMoneyTwins,
  dxSkinOffice2007Black, dxSkinOffice2007Blue, dxSkinOffice2007Green,
  dxSkinOffice2007Pink, dxSkinOffice2007Silver, dxSkinPumpkin, {dxSkinSeven,}
  {dxSkinSharp,} dxSkinSilver, {dxSkinSpringTime,} dxSkinStardust,
  dxSkinSummer2008, dxSkinsDefaultPainters, dxSkinValentine,
  dxSkinXmas2008Blue, dxSkinscxPCPainter, dxSkinsdxBarPainter;
type
  TfrmAttchMgr = class(TForm)
    pnl1: TPanel;
    cxgrdlvlGrid1Level1: TcxGridLevel;
    cxGrid1: TcxGrid;
    dxbrmngr1: TdxBarManager;
    dxbrBar: TdxBar;
    lbl1: TdxBarStatic;
    dxbrdt1: TdxBarEdit;
    dxbrbtn1: TdxBarButton;
    dxbrbtn2: TdxBarButton;
    lbl2: TdxBarStatic;
    tvAttchs: TcxGridTableView;
    tvGrid1TableView2: TcxGridTableView;
    ds1: TDataSource;
    con1: TADOConnection;
    qry1: TADOQuery;
    tvEMail: TcxTreeView;
    gtvColName: TcxGridColumn;
    gtvColInEmail: TcxGridColumn;
    gtvColSize: TcxGridColumn;
    gtvColDate: TcxGridColumn;
    gtvColSender: TcxGridColumn;
    gtvColFuulPath: TcxGridColumn;
    gtvColEmailPath: TcxGridColumn;
    pm1: TdxBarPopupMenu;
    dxbrbtn3: TdxBarButton;
    dxbrbtn4: TdxBarButton;
    dxbrbtn5: TdxBarButton;
    dxbrbtn6: TdxBarButton;
    dlgSave: TSaveDialog;
    lbl3: TdxBarStatic;
    btnOpnDir: TdxBarButton;
    gtvColEMailAddr: TcxGridColumn;
    procedure FormCreate(Sender: TObject);
    procedure tvEMailClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure dxbrbtn3Click(Sender: TObject);
    procedure dxbrbtn6Click(Sender: TObject);
    procedure dxbrbtn5Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure btnOpnDirClick(Sender: TObject);
    procedure dxbrbtn4Click(Sender: TObject);
    procedure tvEMailDeletion(Sender: TObject; Node: TTreeNode);
  private
    { Private declarations }
    FSelectedEmailAddr:String; //保存当前选中的节点的邮箱信息。
    FXml:TAppXml;
    FFiles:TStrings;
    procedure LoadRecvEmailAttch(EmailAddr:string);
    procedure LoadSendEmailAttch(EmailAddr:string);
    procedure LoadDraftAttch(EmailAddr:string);
    procedure LoadAttampAttch(EmailAddr:string);
    procedure ShowAttchInfo(List:TStrings);
  public
    { Public declarations }
  end;
var
  frmAttchMgr: TfrmAttchMgr;
implementation
uses ufrmMain, UEmailFile,uCommon,ShellAPI, ufrmViewEmail;
{$R *.dfm}
procedure TfrmAttchMgr.FormCreate(Sender: TObject);
begin
  frmMain.LoadEmails(tvEMail);
  FFiles :=TStringList.Create;
end;
procedure TfrmAttchMgr.LoadAttampAttch(EmailAddr:string);
begin
  if tvEMail.Selected.Text<>'定时邮件' then Exit;
  FFiles.Clear;
  FXml:=TAppXml.Create;
  try
    FXml.GetAllAttamp(EmailAddr,FFiles);
  finally
    FXml.Free;
  end;
end;
procedure TfrmAttchMgr.LoadDraftAttch(EmailAddr:string);
begin
  if tvEMail.Selected.Text<>'草稿箱' then Exit;
  FFiles.Clear;
  FXml:=TAppXml.Create;
  try
    FXml.GetAllDraft(EmailAddr,FFiles);
  finally
    FXml.Free;
  end;
end;
procedure TfrmAttchMgr.LoadRecvEmailAttch(EmailAddr:string);
begin
  if tvEMail.Selected.Text<>'收件箱' then Exit;
  FFiles.Clear;
  FXml:=TAppXml.Create;
  try
    FXml.GetAllEmail(EmailAddr,FFiles,nil,nil);
  finally
    FXml.Free;
  end;
end;
procedure TfrmAttchMgr.LoadSendEmailAttch(EmailAddr:string);
begin
  if tvEMail.Selected.Text<>'发件箱' then Exit;
  FFiles.Clear;
  FXml:=TAppXml.Create;
  try
    FXml.GetAllSentEmail(EmailAddr,FFiles);
  finally
    FXml.Free;
  end;
end;
procedure TfrmAttchMgr.tvEMailClick(Sender: TObject);
begin
  if (tvEMail.Selected=nil) or (tvEMail.Selected.Level<>1) then Exit;
  FSelectedEmailAddr:=PPopInfo(tvEMail.Selected.Parent.data).EMailAddr;
  frmMain.ClearTableView(tvAttchs);
  LoadRecvEmailAttch(FSelectedEmailAddr);
  LoadSendEmailAttch(FSelectedEmailAddr);
  LoadDraftAttch(FSelectedEmailAddr);
  LoadAttampAttch(FSelectedEmailAddr);
  ShowAttchInfo(FFiles);
end;
procedure TfrmAttchMgr.FormDestroy(Sender: TObject);
begin
  FFiles.free;
end;
procedure TfrmAttchMgr.ShowAttchInfo(List: TStrings);
var
  EMail:TEmailFile;
  I,J,idx:Integer;
begin
  tvAttchs.BeginUpdate;
  try
    for I:=0 to List.Count-1 do
    begin
      if not fileexists(List[I]) then continue;
      EMail:=TEmailFile.Create(List[I]);
      EMail.GetEmail;
      for J:=0 to EMail.Attchs.Count-1 do
      begin
        if not FileExists(EMail.Attchs[J]) then Continue;
        idx:=tvAttchs.DataController.AppendRecord;
        tvAttchs.DataController.SetValue(idx,gtvColName.Index,ExtractFileName(EMail.Attchs[J]));
        tvAttchs.DataController.SetValue(idx,gtvColFuulPath.Index,EMail.Attchs[J]);
        tvAttchs.DataController.SetValue(idx,gtvColSize.Index,FileSizeInKB(EMail.Attchs[J]));
        tvAttchs.DataController.SetValue(idx,gtvColInEmail.Index,EMail.Subject);
        tvAttchs.DataController.SetValue(idx,gtvColSender.Index,EMail.Sender);
        tvAttchs.DataController.SetValue(idx,gtvColEmailPath.Index,EMail.FilePath);
        tvAttchs.DataController.SetValue(idx,gtvColDate.Index,EMail.Date);
        tvAttchs.DataController.SetValue(idx,gtvColEMailAddr.Index,FSelectedEmailAddr);
        tvAttchs.DataController.Post;
      end;
      EMail.Free;
    end;
  finally
    tvAttchs.EndUpdate;
  end;
end;
procedure TfrmAttchMgr.dxbrbtn3Click(Sender: TObject);  //open attch
var
  FilePath:string;
begin
  if tvAttchs.DataController.FocusedRecordIndex<0 then Exit;
  FilePath:=tvAttchs.DataController.Values[tvAttchs.DataController.FocusedRecordIndex,gtvColFuulPath.Index];
  if FileExists(FilePath) then
    if ShellExecute(Self.Handle,PAnsiChar('open'),PAnsiChar(filepath),nil,nil,SW_SHOWNORMAL) <=32 then
      MsgBoxError('无法运行文件！请你手动运行！');
end;
procedure TfrmAttchMgr.dxbrbtn6Click(Sender: TObject);   //save as
var
  FilePath:string;
begin
  if tvAttchs.DataController.FocusedRecordIndex<0 then Exit;
  FilePath:=tvAttchs.DataController.Values[tvAttchs.DataController.FocusedRecordIndex,gtvColFuulPath.Index];
  if FileExists(FilePath) then
  begin
    if dlgSave.Execute then
      if CopyFile(PAnsiChar(FilePath),PAnsiChar(dlgSave.FileName),True)then
        MsgBoxWarn('保存成功！')
      else
        MsgBoxError('无法拷贝文件！请你手动保存！');
  end;
end;
procedure TfrmAttchMgr.dxbrbtn5Click(Sender: TObject);   //delete
var
  FilePath:string;
  xml:TAppXml;
begin
  with tvAttchs.DataController do
  begin
    if FocusedRecordIndex<0 then Exit;
    xml:=TAppXml.Create;
    try
      xml.DeleteAEmail(VarToStr(Values[FocusedRecordIndex,gtvColInEmail.Index]),VarToStr(Values[FocusedRecordIndex,gtvColEmailPath.Index]));
    finally
      xml.Free;
    end;
    
    FilePath:=VarToStr(Values[FocusedRecordIndex,gtvColFuulPath.Index]);
    DeleteRecord(FocusedRecordIndex);
    if FileExists(FilePath) then
      if DeleteFile(FilePath) then
        MsgBoxWarn('删除成功！')
      else
        MsgBoxError('无法删除附件！请你手动删除！'#$D#$A'附件路径：'+FilePath);
  end;
end;
procedure TfrmAttchMgr.FormResize(Sender: TObject);
begin
  lbl1.Width:=tvEMail.Width-2;
  lbl3.Width:= Self.Width-lbl1.Width-45;
end;
procedure TfrmAttchMgr.btnOpnDirClick(Sender: TObject);
var
  Dir,Path:string;
  ret:cardinal;
begin
  Path:=VarToStr(tvAttchs.DataController.Values[tvAttchs.DataController.FocusedRecordIndex,gtvColFuulPath.Index]);
  if path='' then exit;
  Dir:=ExtractFileDir(path);
  if FileExists(Path)   then
    ret:=ShellExecute(Handle,
                 'OPEN',
                 PChar('explorer.exe'),
                 PChar('/select, "' + Path + '"'),
                 nil,
                 SW_NORMAL)
  else                     
    ret:=ShellExecute(Handle,'open','Explorer.exe',PAnsiChar(Dir),nil,1);
  if ret<=32 then
    if (ret=ERROR_PATH_NOT_FOUND) or (ret=SE_ERR_PNF) then
      MsgBoxError(Format('目录%S不存在',[Dir]))
    else
      MsgBoxError(Format('无法打开目录%S，请您手动打开',[Dir]));
end;
procedure TfrmAttchMgr.dxbrbtn4Click(Sender: TObject);
begin
  if tvAttchs.DataController.FocusedRecordIndex<0 then exit;
  with TfrmViewEmail.Create(Application)do
  begin
    try
      FTableView:=tvAttchs;
      FCurRecordIndex:=tvAttchs.DataController.FocusedRecordIndex;
      FContentFileItemIndex:=gtvColEmailPath.Index;
      FRecverEmail:= tvAttchs.DataController.Values[tvAttchs.DataController.FocusedRecordIndex, gtvColEMailAddr.Index];
      FSenderEmail:= tvAttchs.DataController.Values[tvAttchs.DataController.FocusedRecordIndex, gtvColSender.Index];
      ShowEmail;
      ShowModal;
    finally
      Free;
    end;
  end;
end;
procedure TfrmAttchMgr.tvEMailDeletion(Sender: TObject; Node: TTreeNode);
begin
  if Node.Data<>nil then Dispose(Node.Data) ;
end;
end.

						