Email服务器

开发平台：
Delphi

ufrmRule.~pas：源码内容
							unit ufrmRule;
interface
uses
  Windows, Messages, SysUtils,Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, cxGraphics, Menus,
  cxLookAndFeelPainters, cxButtons, cxCheckBox, cxTextEdit, cxMaskEdit,
  cxDropDownEdit, cxImageComboBox, cxLabel, cxControls, cxContainer,
  cxEdit, cxGroupBox, dxBar, cxClasses, cxCustomData, 
  cxDataStorage, cxGridCustomTableView, cxGridTableView,
  cxGridCustomView, cxGridLevel, cxGrid, cxButtonEdit, dxBarExtItems,uRulerMgr,
  RzShellDialogs, cxListBox, DB, cxDBData, cxGridDBTableView, cxStyles,
  cxFilter, cxData, dxSkinsCore, dxSkinBlack, dxSkinBlue, dxSkinCaramel,
  dxSkinCoffee, dxSkinDarkSide, dxSkinGlassOceans, dxSkiniMaginary,
  dxSkinLilian, dxSkinLiquidSky, dxSkinLondonLiquidSky, dxSkinMcSkin,
  dxSkinMoneyTwins, dxSkinOffice2007Black, dxSkinOffice2007Blue,
  dxSkinOffice2007Green, dxSkinOffice2007Pink, dxSkinOffice2007Silver,
  dxSkinPumpkin, dxSkinSilver, dxSkinStardust, dxSkinSummer2008,
  dxSkinsDefaultPainters, dxSkinValentine, dxSkinXmas2008Blue,
  dxSkinscxPCPainter, dxSkinsdxBarPainter,
  {dxSkinDarkRoom,dxSkinDarkSide,dxSkinGlassOceans, dxSkiniMaginary, dxSkinLilian, dxSkinLiquidSky,dxSkinLondonLiquidSky, dxSkinMcSkin, dxSkinMoneyTwins,}  {dxSkinFoggy,}
    {dxSkinPumpkin,dxSkinSeven,dxSkinOffice2007Black, dxSkinOffice2007Blue, dxSkinOffice2007Green,
  dxSkinOffice2007Pink, dxSkinOffice2007Silver,}
  {dxSkinSharp,dxSkinSilver,}  {dxSkinSpringTime,dxSkinStardust,
  dxSkinSummer2008, dxSkinsDefaultPainters, dxSkinValentine,
  dxSkinXmas2008Blue, dxSkinscxPCPainter, dxSkinsdxBarPainter} ;
type
  TfrmRule = class(TForm)
    pnl1: TPanel;
    pnl3: TPanel;
    dxbrmngr1: TdxBarManager;
    dxbrmngr1Bar1: TdxBar;
    dxbrbtn1: TdxBarButton;
    dxbrbtn2: TdxBarButton;
    dxbrbtn3: TdxBarButton;
    dxbrbtn4: TdxBarButton;
    pnl2: TPanel;
    btnCancel: TcxButton;
    btnSave: TcxButton;
    btn3: TdxBarLargeButton;
    btn4: TdxBarLargeButton;
    btn5: TdxBarLargeButton;
    btn6: TdxBarLargeButton;
    dlgOpen: TRzOpenDialog;
    lstRules: TcxListBox;
    cxEditStyleController1: TcxEditStyleController;
    dlgSave: TRzSaveDialog;
    pnl4: TPanel;
    cxgrpbx1: TcxGroupBox;
    cxGrid1: TcxGrid;
    tvRules: TcxGridTableView;
    gtvColGrid1TableView1Column1: TcxGridColumn;
    gtvColGrid1TableView1Column2: TcxGridColumn;
    gtvColGrid1TableView1Column3: TcxGridColumn;
    cxgrdbtblvwGrid1DBTableView1: TcxGridDBTableView;
    cxgrdbtblvwGrid1DBTableView1Area: TcxGridDBColumn;
    cxgrdbtblvwGrid1DBTableView1Compare: TcxGridDBColumn;
    cxgrdbtblvwGrid1DBTableView1Text: TcxGridDBColumn;
    cxgrdbtblvwGrid1DBTableView1RecId: TcxGridDBColumn;
    tvRule: TcxGridTableView;
    gtvColGrid1TableView1Column4: TcxGridColumn;
    gtvColGrid1TableView1Column5: TcxGridColumn;
    gtvColGrid1TableView1Column6: TcxGridColumn;
    cxgrdlvlGrid1Level1: TcxGridLevel;
    cxgrpbx2: TcxGroupBox;
    chkDeleteOnServer: TcxCheckBox;
    chkIgnore: TcxCheckBox;
    chkPopTip: TcxCheckBox;
    chkPlaySound: TcxCheckBox;
    chkRunExe: TcxCheckBox;
    edtPlaySound: TcxButtonEdit;
    edtRunExe: TcxButtonEdit;
    pnl5: TPanel;
    lbl1: TcxLabel;
    lbl2: TcxLabel;
    cbAccount: TcxImageComboBox;
    edtRuleName: TcxTextEdit;
    chkEnable: TcxCheckBox;
    chkUseToNew: TcxCheckBox;
    btnAddRow: TcxButton;
    btnDeleteRow: TcxButton;
    btnSaveRecord: TcxButton;
    btn1: TdxBarLargeButton;
    btn2: TdxBarLargeButton;
    procedure btnCancelClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure lstRulesMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure chkPlaySoundClick(Sender: TObject);
    procedure chkRunExeClick(Sender: TObject);
    procedure edtPlaySoundPropertiesButtonClick(Sender: TObject;
      AButtonIndex: Integer);
    procedure edtRunExePropertiesButtonClick(Sender: TObject;
      AButtonIndex: Integer);
    procedure chkEnableClick(Sender: TObject);
    procedure btnAddRowClick(Sender: TObject);
    procedure btnDeleteRowClick(Sender: TObject);
    procedure btn3Click(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure btn6Click(Sender: TObject);
    procedure btn4Click(Sender: TObject);
    procedure edtRuleNamePropertiesEditValueChanged(Sender: TObject);
    procedure chkUseToNewClick(Sender: TObject);
    procedure chkDeleteOnServerClick(Sender: TObject);
    procedure chkIgnoreClick(Sender: TObject);
    procedure chkPopTipClick(Sender: TObject);
    procedure cbAccountPropertiesCloseUp(Sender: TObject);
    procedure tvRulesDataControllerRecordChanged(
      ADataController: TcxCustomDataController; ARecordIndex,
      AItemIndex: Integer);
    procedure btnSaveRecordClick(Sender: TObject);
    procedure btn5Click(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    FRuleItems:TRuleItems;
    FRulesSaveTo:string;
    FIndex:Integer;
    procedure LoadRules;
    procedure ShowRules;
    procedure LoadAccount;
    procedure LoadRuleRows;
    procedure ShowRuleRows;
  public
    { Public declarations }
  end;
var
  frmRule: TfrmRule;
const
  CONST_AREA:array[0..5] of ShortString=('主题','收件人','发件人','抄送','暗送','邮件正文');
  CONST_COMPARE:array[0..3] of ShortString=('包含','相等','空','使用正则表达式');
implementation
uses ufrmMain, uMyXml, NativeXml, uCommon;
{$R *.dfm}
procedure TfrmRule.btnCancelClick(Sender: TObject);
begin
  self.close;
  ModalResult:=mrCancel;
end;
procedure TfrmRule.FormCreate(Sender: TObject);
var
  MyXml:TMyxml;
begin
  tvRule.DataController.Options:=tvRule.DataController.Options+[ dcoImmediatePost,dcoInsertOnNewItemRowFocusing]; //立即自动提交新记录
  FRuleItems:=TRuleItems.Create;
  LoadAccount;
  MyXml:=TMyXml.Create(AppPath+'EmailServers.xml');
  try
    if MyXml.Root.FindNode('Rules')<> nil then
    begin
      FRulesSaveTo:=MyXml.Root.FindNode('Rules').AttributeByName['RulesSaveTo'];
      FRulesSaveTo:=GetFullPath(FRulesSaveTo);
      if FileExists(FRulesSaveTo) then  TRuleItems.ReadFromFile(FRulesSaveTo,FRuleItems);
    end;
    LoadRules;
  finally
    MyXml.Free;
  end;  
end;
procedure TfrmRule.FormDestroy(Sender: TObject);
begin
  FRuleItems.Free;
end;
procedure TfrmRule.LoadAccount;
var
  myxml:TMyXml;
  L:TList;
  I:Integer;
begin
  cbAccount.Properties.Items.Clear;
  with cbAccount.Properties.Items.Add do
  begin
    ImageIndex:=0;
    Description:='所有账号';
    Value:='All';
  end;
  MyXml:=TMyXml.Create(AppPath+'EmailServers.xml');
  try
    L:=TList.Create;
    myxml.Pop3Nodes(L);
    for I:=0 to L.Count-1 do
      with cbAccount.Properties.Items.Add do
      begin
        ImageIndex:=I;
        Description:=TXmlNode(L[I]).ReadString('displayname');
        Value:=TXmlNode(L[I]).ReadString('emailaddr');
      end;
    L.Free;
  finally
    myxml.Free;
  end;
end;
procedure TfrmRule.LoadRules;
var
  I:Integer;
begin
  lstRules.Items.Clear;
  for I:=0 to FRuleItems.Count-1 do
    lstRules.AddItem(TRuleItem(FRuleItems[I]).Name,TObject(FRuleItems.Items[I]));
  if lstRules.Items.Count=0 then
  begin
    FIndex:=-1;
    edtRuleName.Enabled:=False;
  end
  else
  begin
    lstRules.ItemIndex:=0;
    FIndex:=0;
    ShowRules;
  end;
end;
procedure TfrmRule.lstRulesMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  P:TPoint;
begin
  p.X:=X; P.Y:=Y;
  FIndex:=TcxListBox(Sender).ItemAtPos(P,True);
  if FIndex<0 then Exit;
  
  ShowRules;
  //while tvRule.DataController.RecordCount>0 do tvRule.DataController.DeleteRecord(0);
end;
procedure TfrmRule.chkPlaySoundClick(Sender: TObject);
begin
 edtPlaySound.Visible:=TcxCheckBox(Sender).Checked;
end;
procedure TfrmRule.chkRunExeClick(Sender: TObject);
begin
  edtRunExe.Visible:=TcxCheckBox(Sender).Checked;
end;
procedure TfrmRule.edtPlaySoundPropertiesButtonClick(Sender: TObject;
  AButtonIndex: Integer);
begin
  dlgOpen.Filter:='WAV|*.WAV|MP3|*.MP3|MP3|*.MP4|RM|*.RM|WMA|*.WMA|RA|*.RA|RMX|*.RMX|aif|*.aif|AU|*.AU|MPEG|*.MPEG|MPG|*.MPG|*.*|*.*';
  if dlgOpen.Execute then
  begin
    edtPlaySound.Text:=dlgOpen.FileName;
    TRuleItem(FRuleItems[FIndex]).RulerAction.PlaySound:=edtPlaySound.Text;
  end;
end;
procedure TfrmRule.edtRunExePropertiesButtonClick(Sender: TObject;
  AButtonIndex: Integer);
begin
  dlgOpen.Filter:='EXE|*.exe|BAT|*.bat|*.*|*.*';
  if dlgOpen.Execute then
  begin
    edtRunExe.Text:=dlgOpen.FileName;
    TRuleItem(FRuleItems[FIndex]).RulerAction.RunExe:=edtRunExe.Text;
  end;
end;
procedure TfrmRule.chkEnableClick(Sender: TObject);
begin
  FRuleItems.Items[FIndex].Enabled:=chkEnable.Checked;
end;
procedure TfrmRule.btnAddRowClick(Sender: TObject);
begin
  tvRule.DataController.AppendRecord;
end;
procedure TfrmRule.btnDeleteRowClick(Sender: TObject);
begin
  if not tvRule.DataController.IsEOF then
    tvRule.DataController.DeleteFocused;
end;
procedure TfrmRule.btn3Click(Sender: TObject);
var
  item:TRuleItem;
begin
  item:=FRuleItems.Add;
  item.Name:='新规则';
  lstRules.Items.InsertObject(lstRules.Items.Count,'新规则',TObject(item));
  lstRules.ItemIndex:=lstRules.Count-1;
  FIndex:=lstRules.ItemIndex;
  ShowRules;
end;
procedure TfrmRule.btnSaveClick(Sender: TObject);
begin
  if FIndex<0 then
  begin
    MessageDlg('请选中一个规则，再保存！' + #13#10#13#10#13#10,  
      mtError, [mbOK], 0);
    Exit;
  end;
  //if not FileExists(FRulesSaveTo) then
    FRuleItems.SaveToFile(FRulesSaveTo);
  //else raise Exception.Create('');
  ModalResult:=mrOk;
end;
procedure TfrmRule.ShowRules;
var
  I:Integer;
begin
  if FIndex>=0 then
  begin
    edtRuleName.Enabled:=True;
    edtRuleName.Text:=TRuleItem(FRuleItems[FIndex]).Name;
    chkEnable.Checked:=TRuleItem(FRuleItems[FIndex]).Enabled;
    chkUseToNew.Checked:=TRuleItem(FRuleItems[FIndex]).UseToNewEmail;
    chkDeleteOnServer.Checked:=TRuleItem(FRuleItems[FIndex]).RulerAction.DeleteOnServer;
    chkIgnore.Checked:=TRuleItem(FRuleItems[FIndex]).RulerAction.IgnoreNotRecv;
    chkPopTip.Checked:=TRuleItem(FRuleItems[FIndex]).RulerAction.PopTip;
    chkPlaySound.Checked:=FileExists(TRuleItem(FRuleItems[FIndex]).RulerAction.PlaySound);
    if chkPlaySound.Checked then
    begin
      edtPlaySound.Visible:=chkPlaySound.Checked;
      edtPlaySound.Text:=TRuleItem(FRuleItems[FIndex]).RulerAction.PlaySound;
    end;
    chkRunExe.Checked:=FileExists(TRuleItem(FRuleItems[FIndex]).RulerAction.RunExe);
    if chkRunExe.Checked then
    begin
      edtRunExe.Visible:=chkRunExe.Checked;
      edtRunExe.Text:=TRuleItem(FRuleItems[FIndex]).RulerAction.RunExe;
    end;
    if TRuleItem(FRuleItems[FIndex]).AllAccount then
      cbAccount.ItemIndex:=0
    else
      for I:=0 to cbAccount.Properties.Items.Count-1 do
      begin
        if CompareText(cbAccount.Properties.Items[I].Value,TRuleItem(FRuleItems[FIndex]).Account)=0 then
        begin
          cbAccount.ItemIndex:=I;
          Break;
        end;
      end;
    ShowRuleRows;
  end;
end;
procedure TfrmRule.btn6Click(Sender: TObject);
begin
  dlgSave.Filter:='xml file|*.xml';
  if dlgSave.Execute then
    FRuleItems.SaveToFile(dlgSave.FileName);
end;
procedure TfrmRule.btn4Click(Sender: TObject);
begin
  FRuleItems.Delete(lstRules.ItemIndex);
  lstRules.Items.Delete(lstRules.ItemIndex);
  FIndex:=lstRules.ItemIndex;
  ShowRules;
end;
procedure TfrmRule.edtRuleNamePropertiesEditValueChanged(Sender: TObject);
begin
  lstRules.Items[FIndex]:=edtRuleName.Text;
  FRuleItems.Items[FIndex].Name:=edtRuleName.Text;
end;
procedure TfrmRule.chkUseToNewClick(Sender: TObject);
begin
  FRuleItems.Items[FIndex].UseToNewEmail:=chkUseToNew.Checked;
end;
procedure TfrmRule.chkDeleteOnServerClick(Sender: TObject);
begin
  FRuleItems.Items[FIndex].RulerAction.DeleteOnServer:=chkDeleteOnServer.Checked;
end;
procedure TfrmRule.chkIgnoreClick(Sender: TObject);
begin
  FRuleItems.Items[FIndex].RulerAction.IgnoreNotRecv:=chkIgnore.Checked;
end;
procedure TfrmRule.chkPopTipClick(Sender: TObject);
begin
  FRuleItems.Items[FIndex].RulerAction.PopTip:=chkPopTip.Checked;
end;
procedure TfrmRule.cbAccountPropertiesCloseUp(Sender: TObject);
begin
  if FIndex>=0 then
  begin
    FRuleItems.Items[FIndex].AllAccount:=cbAccount.ItemIndex=0;
    FRuleItems.Items[FIndex].Account:=cbAccount.Properties.Items[cbAccount.ItemIndex].Value;
  end;
end;
procedure TfrmRule.tvRulesDataControllerRecordChanged(
  ADataController: TcxCustomDataController; ARecordIndex,
  AItemIndex: Integer);
//var
//  I:Integer;
//const
//  tips:array[0..2] of string=('区域选项不允许空值','比较选项不允许空值','文本不允许空值');
begin
//  for I:=0 to 2 do
//    if ((I<>3) and VarIsNull(ADataController.Values[ADataController.FocusedRecordIndex,I])) and
//        ((I=3) and VarIsNull(ADataController.Values[ADataController.FocusedRecordIndex,I]) and
//        (ADataController.Values[ADataController.FocusedRecordIndex,2]<>'空')) then
//    begin
//      ADataController.Cancel;
//      MsgBox('出错啦',tips[I]);
//    end;
end;
procedure TfrmRule.LoadRuleRows;
var
  I:Integer;
begin
  FRuleItems.Items[FIndex].Rows.Clear;
  for I:=0 to tvRule.DataController.RecordCount-1 do
  begin
    with FRuleItems.Items[FIndex].Rows.Add do
    begin
      Text:=VarToStr(tvRule.DataController.Values[I,2]);
      Area:=TRuleArea(tvRule.DataController.Values[I,0]);
      Compare:=TRuleCompare(tvRule.DataController.Values[I,1]);
//      if VarToStr(tvRule.DataController.Values[I,0])='主题' then  {主题,收件人,发件人,抄送,暗送,邮件正文}
//        Area:=raSubject
//      else if VarToStr(tvRule.DataController.Values[I,0])='收件人' then
//        Area:=raTo
//      else if VarToStr(tvRule.DataController.Values[I,0])='发件人' then
//        Area:=raFrom
//      else if VarToStr(tvRule.DataController.Values[I,0])='抄送' then
//        Area:=raCC
//      else if VarToStr(tvRule.DataController.Values[I,0])='暗送' then
//        Area:=raCB
//      else if VarToStr(tvRule.DataController.Values[I,0])='邮件正文' then
//        Area:=raBody
//      else {Error!} ;
//
//      if VarToStr(tvRule.DataController.Values[I,1])='包含' then    {包含,相等,空,使用正则表达式}
//        Compare:=rcContains
//      else if VarToStr(tvRule.DataController.Values[I,1])='相等' then
//        Compare:=rcEquals
//      else if VarToStr(tvRule.DataController.Values[I,1])='空' then
//      begin
//        Compare:=rcEmpty;
//        Text:='';
//      end
//      else if VarToStr(tvRule.DataController.Values[I,1])='使用正则表达式' then
//         Compare:=rcRegExpr
//      else {Error!} ;
    end;
  end;
end;
procedure TfrmRule.ShowRuleRows;
var
  I,idx:Integer;
begin
  while tvRule.DataController.RecordCount>0  do tvRule.DataController.DeleteRecord(0);
  
  tvRule.DataController.BeginUpdate;
  try
    for I:=0 to FRuleItems.Items[FIndex].Rows.Count-1 do
    begin
      if not(VarIsOrdinal(FRuleItems.Items[FIndex].Rows.Items[I].Area) and VarIsOrdinal(FRuleItems.Items[FIndex].Rows.Items[I].Compare)) then
        Continue; //忽略无效的值
      idx:=tvRule.DataController.AppendRecord;
      tvRule.DataController.Values[idx,0]:=Ord(FRuleItems.Items[FIndex].Rows.Items[I].Area);
      tvRule.DataController.Values[idx,1]:=Ord(FRuleItems.Items[FIndex].Rows.Items[I].Compare);
      tvRule.DataController.Values[idx,2]:=FRuleItems.Items[FIndex].Rows.Items[I].Text;
      tvRule.DataController.Post;
      //tvRule.DataController.PostEditingData;
    end;
  finally
    tvRule.DataController.EndUpdate;
  end;
end;
procedure TfrmRule.btnSaveRecordClick(Sender: TObject);
var
  I:Integer;
  item:TRuleRow;
begin
  if FIndex<0 then Exit;
  FRuleItems.Items[FIndex].Rows.Clear;
  with tvRule.DataController do
    for I:=0 to RecordCount -1 do
    begin
      if (not VarIsOrdinal(Values[I,0])) or  (not VarIsOrdinal(Values[I,1])) then
        Continue;  //检查数据合法性
        item:=FRuleItems.Items[FIndex].Rows.Add;
      //begin
        item.Area:=TRuleArea(Values[I,0]);
        item.Compare:=TRuleCompare(Values[I,1]);
        item.Text:=VarToStr(Values[I,2]);
     // end;
    end;
end;
procedure TfrmRule.btn5Click(Sender: TObject);
var
  count,I:Integer;
begin
  dlgOpen.Filter:='xml file|*.xml';
  if dlgOpen.Execute then
  begin
    count:=FRuleItems.Count;
    TRuleItems.AppendFromFile(dlgOpen.FileName,FRuleItems);
    for I:=count to  FRuleItems.Count-1 do
      lstRules.AddItem(FRuleItems.Items[I].Name,TObject(FRuleItems.Items[I]));
  end;
end;
procedure TfrmRule.btn2Click(Sender: TObject);
begin
  close;
end;
procedure TfrmRule.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:=caFree;
end;
end.

						