Email服务器

开发平台：
Delphi

uRulerMgr.pas：源码内容
							unit uRulerMgr;
interface
uses Classes,SysUtils,RegExpr,Dialogs;
type
  TRuleArea = (raSubject,raTo,raFrom,raCC,raCB,{raFromName,raFromAddress,raStatus,}raBody,raHeader);
  TRuleCompare = (rcContains,rcEquals,rcEmpty,rcRegExpr);                                   
  TRuleRow = class(TCollectionItem)
  private
    FArea : TRuleArea;
    FCompare : TRuleCompare;
    FText : string;
  protected
    procedure AssignTo(Dest: TPersistent); override;
  published
    property  Area:TRuleArea  read FArea write FArea;
    property  Compare:TRuleCompare  read FCompare write FCompare;
    property  Text:string  read FText write FText;
  end;
  //--------------------------------------------------------------- Rule Rows --
  TRuleRows = class(TCollection)
  private
    function GetItem(Index: Integer): TRuleRow;
    procedure SetItem(Index: Integer; Value: TRuleRow);
  public
    constructor Create;
    function Add: TRuleRow;
  
    property Items[Index: Integer]: TRuleRow read GetItem write SetItem; default;
  end;
  TRuleAction=class(TPersistent)
  private
    FDeleteOnServer:Boolean;
    FIgnoreNotRecv:Boolean;
    FPopTip:Boolean;
    FPlaySound:String;
    FRunExe:String;
  protected
    procedure AssignTo(Dest: TPersistent);override;
  published
    property  DeleteOnServer:Boolean  read FDeleteOnServer write FDeleteOnServer default false;
    property  IgnoreNotRecv:Boolean  read FIgnoreNotRecv write FIgnoreNotRecv default False;
    property  PopTip:Boolean read FPopTip write FPopTip default True ;
    property  PlaySound:String  read FPlaySound write FPlaySound;
    property  RunExe:String  read FRunExe write FRunExe;
  end;
  //--------------------------------------------------------------- Rule Item --
  TRuleItem = class(TCollectionItem)
  private
    FName : ShortString;   //规则名称
    FEnabled : boolean;    // 启用该规则
    FUseToNewEmail : boolean;    //用于新邮件
    FAccount : String; //只适用于该账号的邮件
    FAllAccount:Boolean; //使用于所有邮件
    FRulerAction:TRuleAction;
    FRows : TRuleRows;
    procedure SetRows(const Value: TRuleRows);
    procedure SetRulerAction(const Value: TRuleAction);
  protected
    procedure AssignTo(Dest: TPersistent); override;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy;override;
  published
    property  Name:ShortString  read FName write FName;
    property  Enabled : boolean  read FEnabled write FEnabled;
    property  UseToNewEmail : boolean read FUseToNewEmail write FUseToNewEmail;
    property  Account : String  read FAccount write FAccount;
    property  AllAccount:Boolean  read FAllAccount write FAllAccount;
    property  RulerAction:TRuleAction  read FRulerAction write SetRulerAction;
    property  Rows : TRuleRows read FRows write SetRows;
  end;
  //--------------------------------------------------------------- Rule Items --
  TRuleItems = class(TCollection)
  private
    function GetItem(Index: Integer): TRuleItem;
    procedure SetItem(Index: Integer; Value: TRuleItem);
  protected
    //procedure AssignTo(Dest: TPersistent); override;
  public
    constructor Create;
    function Add: TRuleItem;
    procedure Move(CurIndex, NewIndex: Integer);
    
    procedure SaveToFile(AFileName:string);
    class procedure ReadFromFile(AFileName:string;var Return:TRuleItems); // 从文件中载入规则
    class procedure AppendFromFile(AFileName:string;var Return:TRuleItems); // 从文件中载入规则 （不删除Return中以前存在的规则）
    property Items[Index: Integer]: TRuleItem read GetItem write SetItem; default;
    procedure Assign(Source: TPersistent); override;
  end;
implementation
uses NativeXmlObjectStorage, NativeXml, uCommon;
{ TRuleRow }
procedure TRuleRow.AssignTo(Dest: TPersistent);
begin
  if Dest is TRuleRow then
    with TRuleRow(Dest) do
    begin
      Area := self.Area;
      Compare := self.Compare;
      Text := self.Text;
    end
  else
    inherited AssignTo(Dest);
end;
{ TRuleRows }
constructor TRuleRows.Create;
begin
  inherited Create(TRuleRow);
end;
function TRuleRows.Add: TRuleRow;
begin
  Result := TRuleRow(inherited Add);
end;
function TRuleRows.GetItem(Index: Integer): TRuleRow;
begin
  Result := TRuleRow(inherited GetItem(Index));
end;
procedure TRuleRows.SetItem(Index: Integer; Value: TRuleRow);
begin
  inherited SetItem(Index, Value);
end;
{ TRuleItem }
constructor TRuleItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FRows := TRuleRows.Create;
  FRulerAction:=TRuleAction.Create;
end;
procedure TRuleItem.AssignTo(Dest: TPersistent);
var
  I:Integer;
begin
  if Dest is TRuleItem then
  begin
    TRuleItem(Dest).Name := Self.Name;
    TRuleItem(Dest).Enabled := Self.Enabled;    // 启用该规则
    TRuleItem(Dest).UseToNewEmail:= Self.UseToNewEmail;    //用于新邮件
    TRuleItem(Dest).Account:= Self.Account; //只适用于次邮件
    TRuleItem(Dest).AllAccount:= Self.AllAccount; //使用于所有邮件
    TRuleItem(Dest).RulerAction.Assign(Self.RulerAction);
    for I:=0 to Self.Rows.Count-1 do
      TRuleItem(Dest).Rows.Add.Assign(FRows.Items[I]);
    //Rows.Assign(FRows);
  end
  else inherited AssignTo(Dest);
end;
destructor TRuleItem.Destroy;
begin
  FRows.Free;
  FRulerAction.Free;
  inherited;
end;
procedure TRuleItem.SetRows(const Value: TRuleRows);
begin
  if FRows<>Value then   FRows.Assign(Value);
end;
procedure TRuleItem.SetRulerAction(const Value: TRuleAction);
begin
  if FRulerAction <>Value then  FRulerAction.Assign(Value);
end;
{ TRuleItems }
constructor TRuleItems.Create;
begin
  inherited Create(TRuleItem);
end;
function TRuleItems.Add: TRuleItem;
begin
  Result := TRuleItem(inherited Add);
end;
function TRuleItems.GetItem(Index: Integer): TRuleItem;
begin
  Result := TRuleItem(inherited GetItem(Index));
end;
procedure TRuleItems.SetItem(Index: Integer; Value: TRuleItem);
begin
  inherited SetItem(Index, Value);
end;
procedure TRuleItems.Move(CurIndex, NewIndex: Integer);
var
  TempItem: TRuleItem;
begin
  if CurIndex <> NewIndex then
  begin
    BeginUpdate;
    try
      TempItem := TRuleItem.Create(nil);
      try
        TempItem.Assign(GetItem(CurIndex));
        Delete(CurIndex);
        Insert(NewIndex);
        SetItem(NewIndex,TempItem);
      finally
        TempItem.Free;
      end;
    finally
      EndUpdate;
    end;
  end;
end;
class procedure TRuleItems.ReadFromFile(AFileName: string;var Return:TRuleItems );
var
  AReader :TsdXmlObjectReader;
  xml:TNativeXml;
  Item:TRuleItem;
  I:Integer;
  Node:TXmlNode;
begin
  Return.Clear;
  xml := TNativeXml.Create;
  try
    try
      xml.LoadFromFile(AFileName);
      AReader := TsdXmlObjectReader.Create;
      try
        AReader.ReadObject(xml.Root, Return, nil);
        I:=0;
        Node:=xml.Root.FindNode('TRuleItem'+inttostr(I));
        while Node<>nil do
        begin
          Item:=Return.Add;
          AReader.ReadObject(Node, Item, nil);
          WriteLog('read object TRuleItem. Rows Count:' +inttostr(Return.Items[I].Rows.Count));
          Inc(I);
          Node:=xml.Root.FindNode('TRuleItem'+inttostr(I));
        end;
      finally
        AReader.Free;
      end;
    except
      raise Exception.Create(Format('文件%S'#$D#$A'不是规则文件，或者已经被破坏或篡改。',[AFileName]));
    end;
  finally
    xml.Free;
  end;
end;
procedure TRuleItems.SaveToFile(AFileName: string);
var
  AWriter:TsdXmlObjectWriter;
  xml:TNativeXml;
  I:Integer;
  Item:TRuleItem;
  Node:TXmlNode;
begin
  xml := TNativeXml.CreateName('Root');
  try
    //xml.Utf8Encoded := True;
    xml.EncodingString := 'GB2312';
    
    AWriter := TsdXmlObjectWriter.Create;
    try
      AWriter.WriteObject(xml.Root, Self, nil);
      for I:=0 to Self.Count-1 do
      begin
        Item:=TRuleItem(Self.Items[I]);
        Node:=xml.Root.NodeNew('TRuleItem'+InttoStr(I));
        AWriter.WriteObject(Node, Item,nil);
      end;  
    finally
      AWriter.Free;
    end;
    xml.SaveToFile(AFileName);
  finally
    xml.Free;
  end;
end;
class procedure TRuleItems.AppendFromFile(AFileName: string;
  var Return: TRuleItems);
var
   temp: TRuleItems;
   I:Integer;
begin
  temp:=TRuleItems.Create;
  try
    TRuleItems.ReadFromFile(AFileName,temp);
    for I:=0 to temp.Count-1 do
    begin
      with Return.Add do
        Assign(temp.Items[I]);
    end;
  finally
    temp.Free;
  end;
end;
procedure TRuleItems.Assign(Source: TPersistent);
var
  I: Integer;
  ri:TRuleItem ;
begin
  if Source is TCollection then
  begin
    BeginUpdate;
    try
      Clear;
      for I := 0 to TCollection(Source).Count - 1 do
      begin
        ri:=TRuleItem(Add);
        ri.Assign(TRuleItems(Source).Items[I]);
      end;
    finally
      EndUpdate;
    end;
    Exit;
  end;
  inherited Assign(Source);
end;
{ TRuleAction }
procedure TRuleAction.AssignTo(Dest: TPersistent);
begin
  if Dest is TRuleAction then
  begin
    TRuleAction(Dest).DeleteOnServer:=DeleteOnServer;
    TRuleAction(Dest).IgnoreNotRecv:=IgnoreNotRecv;
    TRuleAction(Dest).PopTip:=PopTip;
    TRuleAction(Dest).PlaySound:=PlaySound;
    TRuleAction(Dest).RunExe:=RunExe;
  end
  else
    inherited;
end;
end.

						