Email服务器

开发平台：
Delphi

uMyXml.~pas：源码内容
							unit uMyXml;
interface
uses Classes,SysUtils,nativexml,uEncrypt,Windows,Dialogs;
type
  TEmailBox=(ebRecv,ebSend,ebDraft,ebAttamp);
  TBaseMyXml=class
    private
      FCipher:ICipher;
      
      function GetRoot: TXmlNode;
    protected
      FXml:TNativeXml;
      FXmlFileName:string;
    public
      constructor Create(XmlFileName:string);
      destructor Destroy;override;
      property  Cipher:ICipher  read FCipher write FCipher;
      property  Root:TXmlNode  read GetRoot ;
      property Xml:TNativeXml read  FXml write FXml;
  end;
  TMyXml=class(TBaseMyXml)
    private
    public
      function GetRulesFilePath:string;
      function Pop3sNode:TXmlNode;
      procedure Pop3Nodes(var List:TList);
      function FindPop3(EmailAddr:string):TXmlNode;
      function FindPOP3EmailAddrNode(EmailAddr:string):TXmlNode;  //在所有pop3节点中查找，值为EmailAddr:string的emailaddr节点。
      function RecvsNode(EmailAddr:string):TXmlNode;
      function SentNode(EmailAddr:string):TXmlNode;
      function SendingNode(EmailAddr:string):TXmlNode;
      function AttampNode(EmailAddr:string):TXmlNode;
      Function DraftNode(EmailAddr:String):TXmlNode;
      procedure AddNewEmail(EmailAddr:string;contentFileName:string;UIDL:string); //保存接收到的邮件
      procedure GetAllEmail(EmailAddr:string;contentFileName,Readed,UIDLs:TStrings);// 获取EmailAddr帐号下已经接收的的所有邮件及其附件
      procedure DeleteAllEmail(EmailAddr:string);// 删除EmailAddr帐号下已经接收的的所有邮件
      procedure SetEmailReaded(Emailaddr,UIDL:string);    //设置邮件已读标志
      procedure SetEmailUnreaded(Emailaddr,UIDL:string);
      procedure NewPop3(pop3server,emailaddr,pwd,emailsaveto:string);
      procedure SaveNewEmail(EmailAddr:string;Path:string);
      procedure SaveAsDraft(EmailAddr:string;Path:string);
      procedure SaveAsAttampter(EmailAddr:string;Path:string;attampTime:TDateTime);
      procedure GetAllNotSendEmail(EmailAddr:string;List:TStrings);  //已写未发的邮件
      function GetEMailPwd(EMailAddr:string):string;
      procedure AddSentEmail(EmailAddr:string;path:string); overload; //已发送的邮件
      procedure AddSentEmail(EmailAddr: string; List: TStrings); overload;
      Procedure GetAllSentEmail(EmailAddr:string;List:TStrings);
      procedure AddSendingEmail(EmailAddr:string;path:string); overload; //已发送的邮件
      procedure AddSendingEmail(EmailAddr: string; List: TStrings); overload;
      Procedure GetAllSendingEmail(EmailAddr:string;List:TStrings;bClear:Boolean=true);
      procedure DeleteSendingEmail(EmailAddr:string;path:string);
      
      Procedure DeleteAllSentEmail(EmailAddr:string );
      procedure GetAllDraft(EmailAddr:string;List:TStrings);
      procedure GetAllAttamp(EmailAddr:string;List:TStrings);overLoad;
      procedure GetAllAttamp(sList:TStringList); overLoad;
      
      procedure GetAllTips(TipList:TStrings;var loadonstatup:Boolean;var actual:Integer);
      procedure GetUIDLS(List:TStrings);
      procedure AddBlackList(List:TStrings); //向黑名单添加成员
      procedure AddWhiteList(List:TStrings); //向白名单添加成员
      procedure GetBlackList(List:TStrings); //获得黑名单的成员
      procedure GetWhiteList(List:TStrings);
      procedure DeleteBlackList(List:TStrings); //删除黑名单中的成员
      procedure DeleteWhiteList(List:TStrings); //
      procedure  WriteEmailDetect(EmailAddr:string;Option:Integer);
      function ReadEmailDetect(EmailAddr:string):Integer;
      procedure GetAllEmailDetectOptions(List:TList);
      Function GetEmailsSavePath:string; //Email 保存路径
      Function GetAttchsSavePath:string; //附件保存路径
      procedure SetEmailSavePath(APath:string);
      procedure SetAttchsSavePath(APath:string);
      procedure CleanSents(EmailAddr:String); //清除发件箱
      procedure CleanRecvs(EmailAddr:String);
      procedure CleanDraft(EmailAddr:String);
      procedure CleanAttmp(EmailAddr:String);
      function DeleteAEmail(EmailAddr, EmailFileName: string):boolean;  //删除一封邮件
      //function DeleteEmailInBox(EmailAddr, EmailFileName: string):Boolean;
      function DeleteEmailAwake(EmailAddr,ContentFile:String):boolean;
      procedure AddContact(EMailAddr,ContactName,Remark:string);
      function  EditContact(EMailAddr,ContactName,Remark:string):Boolean;
      procedure DeleteContact(EMailAddr:string);
      procedure LoadContacts(ListAddr,ListName:TStringList);
  end;
  TAppXml=class(TMyXml)
  public
    constructor Create;
  end;
implementation
uses uCommon, uCheckEmail, Variants, UEmailFile,syncObjs;
var
  CS:TCriticalSection;
{ TBaseMyXml }
constructor TBaseMyXml.Create(XmlFileName: string);
var
  mStrm:TMemoryStream;
begin
  CS.Enter;
  FXmlFileName:=XmlFileName;
  Fxml:=TNativeXml.Create;
  if FCipher<>nil then
  begin
    mStrm:=TMemoryStream.Create;
    try
       mStrm.Position:=0;
       mStrm.LoadFromFile(XmlFileName);
       FCipher.DecodeStream(mStrm);
       Fxml.LoadFromStream(mStrm);
    finally
      mStrm.Free;
    end;
  end
  else
    FXml.LoadFromFile(XmlFileName);
  Fxml.IndentString:='  ';
end;
destructor TBaseMyXml.Destroy;
var
  mStrm:TMemoryStream;
begin
  if FCipher<>nil then
  begin
    mStrm:=TMemoryStream.Create;
    try
       mStrm.Position:=0;
       Fxml.SaveToStream(mStrm);
       FCipher.EncodeStream(mStrm);
       mStrm.SaveToFile(FXmlFileName);
    finally
      mStrm.Free;
    end;
  end
  else
    FXml.SaveToFile(FXmlFileName);
  FXml.Free;
  CS.Leave;
  inherited;  
end;
function TBaseMyXml.GetRoot: TXmlNode;
begin
  Result:=FXml.Root;
end;
{ TMyXml }
procedure TMyXml.AddBlackList(List: TStrings);
var
  N:TXmlNode;
  I:Integer;
begin
  N:=Root.FindNode('BlackList');
  if N=nil then
    N:=Root.NodeNew('BlackList');
  for I:=0 to List.Count-1 do
    N.NodeNew('List').ValueAsString:=List[I];
end;
procedure TMyXml.AddNewEmail(EmailAddr, contentFileName,UIDL:string);
var
  Node:TXmlNode;
begin
  node:=RecvsNode(EmailAddr);
  if Node=nil then Exit;
  node:=Node.NodeNew('recvedemail');
  Node.WriteAttributeBool('read',False);
  Node.WriteAttributeString('UIDL',UIDL);
  Node.WriteString('contentfile',contentFileName);
  //Node.WriteString('attchs',AttchFileName);
end;
procedure TMyXml.AddSentEmail(EmailAddr:string;path: string);
var
  Node:TXmlNode;
begin
  node:=SentNode(EmailAddr);
  if Node=nil then Exit;
  Node.NodeNew('sentemail').ValueAsString :=path;
end;
procedure TMyXml.AddWhiteList(List: TStrings);
var
  N:TXmlNode;
  I:Integer;
begin
  N:=Root.FindNode('WhiteList');
  if N=nil then
    N:=Root.NodeNew('WhiteList');
  for I:=0 to List.Count-1 do
    N.NodeNew('List').ValueAsString:=List[I];
end;
function TMyXml.AttampNode(EmailAddr: string): TXmlNode;
var
  I:Integer;
  List:TList;
  Node:TXmlNode;
begin
  Result:=nil;
  list:=TList.Create;
  try
    Pop3Nodes(List);
    for I:=0 to List.Count-1 do
    begin
      Node:=TXmlNode(List[I]).FindNode('emailaddr');
      if Node<>nil   then
      begin
         if Trim(Node.ValueAsString)=Trim(EmailAddr) then
         begin
           Result:=TXmlNode(List[I]).FindNode('attamp');
           if Result=nil then Result:=TXmlNode(List[I]).NodeNew('attamp');
           Break;
         end;
      end;
    end;
  finally
    List.Free;
  end;
end;
procedure TMyXml.CleanAttmp(EmailAddr:String);
var
  I:Integer;
  List:TStrings;
  N:TXmlNode;
begin
  if  EmailAddr='' then exit;
  List:=TStringList.Create;
  try
    GetAllAttamp(EmailAddr,List);
    for I:=0 to List.Count-1 do
      if FileExists(List[I]) then DeleteFile(PAnsiChar(List[I]))
  finally
    List.Free;
  end;
  N:= AttampNode(EmailAddr);
  if N<>nil then N.delete;
end;
procedure TMyXml.CleanDraft(EmailAddr:String);
var
  I:Integer;
  List:TStrings;
  N:TXmlNode;
begin
  if EmailAddr='' then exit;
  List:=TStringList.Create;
  try
    GetAllDraft(EmailAddr,List);
    for I:=0 to List.Count-1 do
      if FileExists(List[I]) then DeleteFile(PAnsiChar(List[I]))
  finally
    List.Free;
  end;
  N:= DraftNode(EmailAddr);
  if N<>nil then N.delete;
end;
procedure TMyXml.CleanRecvs(EmailAddr:String);
var
  I:Integer;
  List:TStrings;
  N:TXmlNode;
begin
  if EmailAddr='' then exit;
  List:=TStringList.Create;
  try
    GetAllEmail(EmailAddr,List,nil,nil);
    for I:=0 to List.Count-1 do
      if FileExists(List[I]) then DeleteFile(PAnsiChar(List[I]))
  finally
    List.Free;
  end;
  N:= RecvsNode(EmailAddr);
  if N<>nil then N.delete;
end;
procedure TMyXml.CleanSents(EmailAddr:String);
var
  I:Integer;
  List:TStrings;
begin
  if EmailAddr='' then exit;
  List:=TStringList.Create;
  try
    GetAllSentEmail(EmailAddr,List);
    for I:=0 to List.Count-1 do
      if FileExists(List[I]) then DeleteFile(PAnsiChar(List[I]))
  finally
    List.Free;
  end;
  DeleteAllSentEmail(EmailAddr);
end;
function TMyXml.DeleteAEmail(EmailAddr, EmailFileName: string):boolean;
var
  L:TStrings;
  function Find(FileName:string) :boolean;
  var
    I:integer;
  begin
    result:=false;
    for I:=0 to pred(L.Count) do
    begin
      if L[I]=EmailFileName then
      begin
        if FileExists(FileName) then
          deleteFile(PAnsiChar(FileName));
        Result:=true;
        exit;
      end;
    end;
  end;
begin
  L:=TStringList.Create;
  try
    GetAllEmail(EmailAddr,L,nil,nil);
    Result:=Find(EmailFileName);
    if Result then exit;
    L.Clear;
    GetAllSentEmail(EmailAddr,L);
    Result:=Find(EmailFileName);
    if Result then exit;
    L.Clear;
    GetAllDraft(EmailAddr,L);
    Result:=Find(EmailFileName);
    if Result then exit;
    L.Clear;
    GetAllAttamp(EmailAddr,L);
    Result:=Find(EmailFileName);
    L.Clear;
    GetAllSendingEmail(EmailAddr,L);
    Result:=Find(EmailFileName);
    if Result then exit;
  finally
    L.free;
  end;
end;
procedure TMyXml.DeleteAllEmail(EmailAddr: string);
var
  Node:TXmlNode;
begin
  node:=RecvsNode(EmailAddr);
  if node<>nil then Node.Delete;
end;
procedure TMyXml.DeleteAllSentEmail(EmailAddr: string);
begin
  if SentNode(EmailAddr)<>nil then SentNode(EmailAddr).Delete;
end;
procedure TMyXml.DeleteBlackList(List: TStrings);
var
  N:TXmlNode;
  I:Integer;
  L:TList;
begin
  N:=Root.FindNode('BlackList');
  if N=nil then  Exit;
  L:=TList.Create;
  try
    N.NodesByName('List',L);
    for I:=0 to L.Count-1 do
      if List.IndexOf(TXmlNode(L[I]).ValueAsString)<>-1 then TXmlNode(L[I]).Delete;
  finally
    L.Free;
  end;
end;
procedure TMyXml.DeleteWhiteList(List: TStrings);
var
  N:TXmlNode;
  I:Integer;
  L:TList;
begin
  N:=Root.FindNode('WhiteList');
  if N=nil then  Exit;
  L:=TList.Create;
  try
    N.NodesByName('List',L);
    for I:=0 to L.Count-1 do
      if List.IndexOf(TXmlNode(L[I]).ValueAsString)<>-1 then TXmlNode(L[I]).Delete;
  finally
    L.Free;
  end;
end;
function TMyXml.DraftNode(EmailAddr: String): TXmlNode;
var
  I:Integer;
  List:TList;
  Node:TXmlNode;
begin
  Result:=nil;
  list:=TList.Create;
  try
    Pop3Nodes(List);
    for I:=0 to List.Count-1 do
    begin
      Node:=TXmlNode(List[I]).FindNode('emailaddr');
      if Node<>nil   then
      begin
         if Trim(Node.ValueAsString)=Trim(EmailAddr) then
         begin
           Result:=TXmlNode(List[I]).FindNode('draft');
           if Result=nil then Result:=TXmlNode(List[I]).NodeNew('draft');
           Break;
         end;
      end;
    end;
  finally
    List.Free;
  end;
end;
function TMyXml.FindPop3(EmailAddr: string): TXmlNode;
var
  L:TList;
  I:Integer;
begin
  Result:=nil;
  L:=TList.Create;
  try
    Pop3Nodes(L);
    for I:=0 to pred(L.Count) do
    begin
      if CompareText(TXmlNode(L[I]).ReadString('emailaddr',''),EmailAddr)=0 then
      begin
        Result:=L[I];
        Break;
      end;
    end;
  finally
      L.free;
  end;
end;
function TMyXml.FindPOP3EmailAddrNode(EmailAddr: string): TXmlNode;
var
  I:Integer;
  List:TList;
  Node:TXmlNode;
begin
  Result:=nil;
  list:=TList.Create;
  try
    Pop3Nodes(List);
    for I:=0 to List.Count-1 do
    begin
      Node:=TXmlNode(List[I]).FindNode('emailaddr');
      if Node<>nil   then
      begin
         if Trim(Node.ValueAsString)=Trim(EmailAddr) then
         begin
           Result:=Node;
           Break;
         end;
      end;
    end;
  finally
    List.Free;
  end;
end;
procedure TMyXml.GetAllAttamp(EmailAddr: string; List: TStrings);
var
  Node:TXmlNode;
  L:TList;
  I:integer;
begin
  node:=FindPOP3EmailAddrNode(EmailAddr);
  if Node =nil then Exit;
  node:=Node.Parent.FindNode('attamp');
  if Node =nil then Exit;
  L:=TList.create;
  try
    Node.NodesByName('contentfile',L);
    List.Clear;
    for I:=0 to L.Count-1 do
      if FileExists(TxmlNode(L[I]).ValueAsString) then List.Add(TxmlNode(L[I]).ValueAsString);
  finally
    L.Free;
  end;
end;
procedure TMyXml.GetAllAttamp(sList: TStringList);
var
  L,List:TList;
  I,J:integer;
  N:TXmlNode;
  sTime:string;
begin
    sList.clear;
    L:=TList.Create;
    try
      Pop3Nodes(L);
      for I:=0 to L.Count-1 do
      begin
        N:=TXmlNode(L[I]).FindNode('attamp');
        if N=nil then Continue;
        List:=TList.Create;
        try
          N.NodesByName('contentfile',List);
          for J:=0 to List.Count-1 do
          begin
            sTime:=TXmlNode(List[I]).AttributeByName['time'];
            if sTime='' then Continue;  //StrToDateTime()
            if StrToDateTime(sTime)<=Now then
              sList.Add(TXmlNode(List[I]).ValueAsString);
          end;
        finally
          List.Free;
        end;
      end;
    finally
      L.Free;
    end;
end;
procedure TMyXml.GetAllDraft(EmailAddr: string; List: TStrings);
var
  Node:TXmlNode;
  L:TList;
  I:integer;
begin
  node:=FindPOP3EmailAddrNode(EmailAddr);
  if Node =nil then Exit;
  node:=Node.Parent.FindNode('draft');
  if Node =nil then Exit;
  L:=TList.create;
  try
    Node.NodesByName('contentfile',L);
    List.Clear;
    for I:=0 to L.Count-1 do
      if FileExists(TxmlNode(L[I]).ValueAsString) then List.Add(TxmlNode(L[I]).ValueAsString);
  finally
    L.Free;
  end;
end;
procedure TMyXml.GetAllEmail(EmailAddr: string; contentFileName,
  Readed,UIDLs: TStrings);
var
  Node:TXmlNode;
  List:TList;
  I:Integer;
begin
  node:=RecvsNode(EmailAddr);
  if Node=nil then Exit;
  List:=TList.Create;
  try
    Node.NodesByName('recvedemail',List);
    for I:=0 to List.Count-1 do     
    begin
      if contentFileName<>nil then
        contentFileName.Add(TXmlNode(List[I]).ReadString('contentfile',''));
      if Readed<>nil then
        Readed.Add(TXmlNode(List[I]).AttributeByName['read']);
      if UIDLs<>nil then
        UIDLs.Add(TXmlNode(List[I]).AttributeByName['UIDL'])
    end;
  finally
    List.Free;
  end;
end;
procedure TMyXml.GetAllEmailDetectOptions(List:TList);
var
  L:TList;
  I:Integer;
  option:PEmailDetect;
begin
  L:=TList.Create;
  try
    Pop3Nodes(L);
    for i:=0 to L.Count-1 do
    begin
      New(option);
      option.EmailAccount.Pop3ServerAddr:=TXmlNode(L[I]).ReadString('pop3server');
      option.EmailAccount.SeverPort:=StrToIntDef(TXmlNode(L[I]).ReadString('port'),110);
      option.EmailAccount.EmailAccount:=TXmlNode(L[I]).ReadString('emailaddr');
      option.EmailAccount.EmailPwd:=TXmlNode(L[I]).ReadString('pwd');
      option.EmailDetectOption:=TEmailDetectOption(StrToIntDef(TXmlNode(L[I]).AttributeByName['Detect'],3));
      List.Add(option);
    end;
  finally
    L.Free;
  end;
end;
procedure TMyXml.GetAllNotSendEmail(EmailAddr:string;List: TStrings);
var
  L:TList;
  I:integer;
  Node:TXmlNode;
begin
  Node:=FindPOP3EmailAddrNode(EmailAddr);
  if Node=nil then Exit;
  Node:=Node.Parent;
  if Node.FindNode('NotSendEmail')=nil then Exit;
  
  L:=TList.Create;
  try
    Node.FindNode('NotSendEmail').NodesByName('contentfile',L);
    for I:=0 to L.Count-1 do
      if FileExists(TXmlNode(L[I]).ValueAsString) then List.add(TXmlNode(L[I]).ValueAsString);
  finally
    L.Free;
  end;
end;
procedure TMyXml.GetAllSentEmail(EmailAddr:string;List: TStrings);
var
  Node:TXmlNode;
  L:TList;
  I:integer;
begin
  node:=SentNode(EmailAddr);
  if Node=nil then Exit;
  L:=TList.create;
  try
    Node.NodesByName('sentemail',L);
    List.Clear;
    for I:=0 to L.Count-1 do
      if FileExists(TxmlNode(L[I]).ValueAsString) then List.Add(TxmlNode(L[I]).ValueAsString);
  finally
    L.Free;
  end;
end;
procedure TMyXml.GetAllTips(TipList:TStrings;var loadonstatup:Boolean;
            var actual:Integer);
var
  L:TList;
  I:Integer;
begin
  if Root.FindNode('tips')=nil then Exit;
  loadonstatup:=StrToBool(Root.FindNode('tips').AttributeByname['loadonstatup']);
  actual:=StrToInt(Root.FindNode('tips').AttributeByname['actual']);
  L:=TList.Create;
  try
    Root.FindNode('tips').NodesByName('tip',L);
    for I:=0 to L.Count-1 do
    begin
      TipList.Add(TXmlNode(L[I]).ValueAsString);
    end;
  finally
    L.free;
  end;
end;
function TMyXml.GetAttchsSavePath: string;
begin
  Result:=Pop3sNode.ReadString('emailattchsaveto',IncludeTrailingPathDelimiter(AppPath+'emailattchsaveto'));
end;
procedure TMyXml.GetBlackList(List: TStrings);
var
  N:TXmlNode;
  I:Integer;
  L:TList;
begin
  List.Clear;
  N:=Root.FindNode('BlackList');
  if N=nil then  Exit;
  L:=TList.Create;
  try
    N.NodesByName('List',L);
    for I:=0 to L.Count-1 do
      List.Add(TXmlNode(L[I]).ValueAsString);
  finally
    L.Free;
  end;
end;
function TMyXml.GetEMailPwd(EMailAddr: string): string;
var
  I:Integer;
  List:TList;
  Node:TXmlNode;
begin
  Result:='';
  list:=TList.Create;
  try
    Pop3Nodes(List);
    for I:=0 to List.Count-1 do
    begin
      Node:=TXmlNode(List[I]).FindNode('emailaddr');
      if Node<>nil   then
      begin
         if Trim(Node.ValueAsString)=Trim(EmailAddr) then
         begin
           Result:=TXmlNode(List[I]).ReadString('pwd','');
           Break;
         end;
      end;
    end;
  finally
    List.Free;
  end;
end;
function TMyXml.GetEmailsSavePath: string;
begin
  Result:=Pop3sNode.ReadString('emailsaveto',IncludeTrailingPathDelimiter(AppPath+'emailsaveto'));
end;
function TMyXml.GetRulesFilePath: string;
begin
  Result:='';
  if (Root.FindNode('Rules')<>nil) then
    Result:=Root.FindNode('Rules').AttributeByName['RulesSaveTo'];
end;
procedure TMyXml.GetUIDLS(List: TStrings);
var
  L,L1:TList;
  I,J:Integer;
  N:TXmlNode;
begin
  L:=TList.Create;
  try
    Pop3Nodes(L);
    for I:=0 to L.Count-1 do
    begin
      N:=TXmlNode(L[I]).FindNode('recvs');
      if N=nil then Continue;
      L1:=TList.Create;
      try
        N.NodesByName('recvedemail',L1);
        for J:=0 to L1.Count-1 do
          if TXmlNode(L1[J]).AttributeByName['UIDL']<>'' then
            List.Add(TXmlNode(L1[J]).AttributeByName['UIDL']) ;
      finally
        L1.Free;
      end;
    end;
  finally
    L.Free;
  end;
end;
procedure TMyXml.GetWhiteList(List: TStrings);
var
  N:TXmlNode;
  I:Integer;
  L:TList;
begin
  List.Clear;
  N:=Root.FindNode('WhiteList');
  if N=nil then  Exit;
  L:=TList.Create;
  try
    N.NodesByName('List',L);
    for I:=0 to L.Count-1 do
      List.Add(TXmlNode(L[I]).ValueAsString);
  finally
    L.Free;
  end;
end;
function TMyXml.DeleteEmailAwake(EmailAddr, ContentFile: String): boolean;
var
    N:TXmlNode;
    L:TList;
    I:integer;
begin
  Result:=false;
  N:=Xml.Root.FindNode('EmailAwake');
  if N=nil then exit;
  L:=TList.Create;
  try
    N.NodesByName('Eamil',L);
    for I:=0 to L.Count-1 do
    begin
      if (TXmlNode(L[I]).AttributeByName['EmailAddr']=EmailAddr) and  (TXmlNode(L[I]).AttributeByName['ContentFile']=ContentFile) then
        TXmlNode(L[I]).Delete;
    end;
  finally
    L.free;
  end;
end;
procedure TMyXml.NewPop3(pop3server, emailaddr, pwd, emailsaveto: string);
begin
  with FXml.Root.NodeByName('pop3s').NodeNew('pop3') do
  begin
     WriteString('emailaddr',Trim(emailaddr));
     WriteString('pwd',Trim(pwd));
     FXml.Root.NodeByName('pop3s').AttributeByName['emailsaveto']:=Trim(emailsaveto);
     //WriteString('emailsaveto',Trim(emailsaveto));
     WriteString('pop3server',Trim(pop3server));
  end;
end;
procedure TMyXml.Pop3Nodes(var List: TList);
begin
  Pop3sNode.NodesByName('pop3',List);
end;
function TMyXml.Pop3sNode: TXmlNode;
begin
  if Root=nil then   raise Exception.Create('没有根节点');
  Result :=Root.FindNode('pop3s');
  if Result=nil then raise Exception.Create('没有pop3s节点');
end;
function TMyXml.ReadEmailDetect(EmailAddr: string): Integer;
var
  N:TXmlNode;
begin
  Result:=-1;
  N:=FindPop3(EmailAddr);
  if N<>nil then
     Result:=StrToIntDef(N.AttributeByName['Detect'],-1);
end;
function TMyXml.RecvsNode(EmailAddr: string): TXmlNode;
var
  I:Integer;
  List:TList;
  Node:TXmlNode;
begin
  Result:=nil;
  list:=TList.Create;
  try
    Pop3Nodes(List);
    for I:=0 to List.Count-1 do
    begin
      Node:=TXmlNode(List[I]).FindNode('emailaddr');
      if Node<>nil   then
      begin
         if Trim(Node.ValueAsString)=Trim(EmailAddr) then
         begin
           Result:=TXmlNode(List[I]).FindNode('recvs');
           if Result=nil then Result:=TXmlNode(List[I]).NodeNew('recvs');
           Break;
         end;
      end;
    end;
  finally
    List.Free;
  end;
end;
procedure TMyXml.SaveAsAttampter(EmailAddr, Path: string;attampTime:TDateTime);
var
  Node:TXmlNode;
begin
  if Pop3sNode=nil then exit;
  Node:=FindPOP3EmailAddrNode(EmailAddr);
  if Node=nil then Exit;
  Node:=Node.Parent;
  if Node.FindNode('attamp')=nil then
    Node.NodeNew('attamp');
  Node:=Node.FindNode('attamp');
  with  Node.NodeNew('contentfile') do
  begin
    ValueAsString:=Path;
    AttributeByName['time']:=DateTimeToStr(attampTime);
  end;
end;
procedure TMyXml.SaveAsDraft(EmailAddr, Path: string);
var
  Node:TXmlNode;
begin
  if Pop3sNode=nil then exit;
  Node:=FindPOP3EmailAddrNode(EmailAddr);
  if Node=nil then Exit;
  Node:=Node.Parent;
  if Node.FindNode('draft')=nil then Node.NodeNew('draft');
  Node:=Node.FindNode('draft');
  Node.NodeNew('contentfile').ValueAsString:= Path;
end;
procedure TMyXml.SaveNewEmail(EmailAddr:string;Path: string);
var
  Node:TXmlNode;
begin
  if Pop3sNode=nil then exit;
  Node:=FindPOP3EmailAddrNode(EmailAddr);
  if Node=nil then Exit;
  Node:=Node.Parent;
  if Node.FindNode('NotSendEmail')=nil then
    Node.NodeNew('NotSendEmail');
  Node:=Node.FindNode('NotSendEmail');
  Node.WriteString('contentfile',Path);
end;
function TMyXml.SentNode(EmailAddr: string): TXmlNode;
var
  I:Integer;
  List:TList;
  Node:TXmlNode;
begin
  Result:=nil;
  list:=TList.Create;
  try
    Pop3Nodes(List);
    for I:=0 to List.Count-1 do
    begin
      Node:=TXmlNode(List[I]).FindNode('emailaddr');
      if Node<>nil   then
      begin
         if Trim(Node.ValueAsString)=Trim(EmailAddr) then
         begin
           Result:=TXmlNode(List[I]).FindNode('sending');
           if Result=nil then Result:=TXmlNode(List[I]).NodeNew('sending');
           Break;
         end;
      end;
    end;
  finally
    List.Free;
  end;
end;
procedure TMyXml.SetAttchsSavePath(APath: string);
begin
  Pop3sNode.ReadString('emailattchsaveto',APath);
end;
procedure TMyXml.SetEmailReaded(Emailaddr, UIDL: string);
var
  Node:TXmlNode;
  List:TList;
  I:integer;
begin
  node:=RecvsNode(EmailAddr);
  if Node=nil then Exit;
  list:=TList.create;
  try
    Node.NodesByName('recvedemail',List);
    for I:=0 to list.count-1 do
    begin
      if TXmlNode(List[I]).ReadAttributeString('UIDL')=UIDL then
      begin
        TXmlNode(List[I]).AttributeByName['read']:='True';
        break;
      end;
    end;
  finally
    List.Free;
  end;
end;
procedure TMyXml.SetEmailSavePath(APath: string);
begin
  Pop3sNode.WriteString('emailsaveto',APath);
end;
procedure TMyXml.SetEmailUnreaded(Emailaddr, UIDL: string);
var
  Node:TXmlNode;
  List:TList;
  I:integer;
begin
  node:=RecvsNode(EmailAddr);
  if Node=nil then Exit;
  list:=TList.create;
  try
    Node.NodesByName('recvedemail',List);
    for I:=0 to list.count-1 do
    begin
      if TXmlNode(List[I]).ReadAttributeString('UIDL')=UIDL then
      begin
        TXmlNode(List[I]).AttributeByName['read']:='False';
        break;
      end;
    end;
  finally
    List.Free;
  end;
end;
procedure TMyXml.WriteEmailDetect(EmailAddr:string;Option: Integer);
var
  N:TXmlNode;
begin
  N:=FindPop3(EmailAddr);
  if N<>nil then
     N.AttributeByName['Detect']:=IntToStr(Option);
end;
procedure TMyXml.AddSentEmail(EmailAddr: string; List: TStrings);
var
  Node:TXmlNode;
  I:integer;
begin
  node:=SentNode(EmailAddr);
  if Node=nil then Exit;
  for I:=0 to List.Count-1 do
      if FileExists(List[I]) then node.WriteString('sentemail',List[I]);// List.Add(TxmlNode(L[I]).ValueAsString);
end;
procedure TMyXml.AddSendingEmail(EmailAddr, path: string);
var
  Node:TXmlNode;
begin
  node:=SendingNode(EmailAddr);
  if Node=nil then Exit;
  Node.NodeNew('SendingEmail').ValueAsString :=path;
end;
procedure TMyXml.AddSendingEmail(EmailAddr: string; List: TStrings);
var
  Node:TXmlNode;
  I:integer;
begin
  node:=SendingNode(EmailAddr);
  if Node=nil then Exit;
  for I:=0 to List.Count-1 do
      if FileExists(List[I]) then node.WriteString('Sendingemail',List[I]);// List.Add(TxmlNode(L[I]).ValueAsString);
end;
procedure TMyXml.GetAllSendingEmail(EmailAddr: string; List: TStrings;bClear:Boolean);
var
  Node:TXmlNode;
  L:TList;
  I:integer;
begin
  node:=SendingNode(EmailAddr);
  if Node=nil then Exit;
  L:=TList.create;
  try
    Node.NodesByName('Sendingemail',L);
    if bClear then  List.Clear;
    for I:=0 to L.Count-1 do
      if FileExists(TxmlNode(L[I]).ValueAsString) then List.Add(TxmlNode(L[I]).ValueAsString);
  finally
    L.Free;
  end;
end;
function TMyXml.SendingNode(EmailAddr: string): TXmlNode;
var
  I:Integer;
  List:TList;
  Node:TXmlNode;
begin
  Result:=nil;
  list:=TList.Create;
  try
    Pop3Nodes(List);
    for I:=0 to List.Count-1 do
    begin
      Node:=TXmlNode(List[I]).FindNode('emailaddr');
      if Node<>nil   then
      begin
         if Trim(Node.ValueAsString)=Trim(EmailAddr) then
         begin
           Result:=TXmlNode(List[I]).FindNode('Sending');
           if Result=nil then Result:=TXmlNode(List[I]).NodeNew('Sending');
           Break;
         end;
      end;
    end;
  finally
    List.Free;
  end;
end;
procedure TMyXml.DeleteSendingEmail(EmailAddr, path: string);
var
  Node:TXmlNode;
  L:TList;
  I:integer;
begin
  node:=SendingNode(EmailAddr);
  if Node=nil then Exit;
  L:=TList.Create;
  try
    Node.NodesByName('SendingEmail',L);
    for I:=0 to L.Count-1 do
    begin
      if UpperCase(TXmlNode(L[I]).ValueAsString)=UpperCase(path) then
      begin
        TXmlNode(L[I]).Delete;
        Break;
      end;
    end;
  finally
    L.Free;
  end;
end;
procedure TMyXml.AddContact(EMailAddr, ContactName, Remark: string);
var
  N:TXmlNode;
begin
  N:=Root.FindNode('Contact');
  if N=nil then N:=Root.NodeNew('Contact');
  with N.NodeNew('EMailAddr') do
  begin
    ValueAsString:=EMailAddr;
    AttributeAdd('ContactName',ContactName);
    AttributeAdd('Remark',Remark);
  end;
end;
procedure TMyXml.DeleteContact(EMailAddr: string);
var
  N:TXmlNode;
  L:TList;
  I:Integer;
begin
  N:=Root.FindNode('Contact');
  if n=nil then Exit;
  L:=TList.Create;
  try
    N.FindNodes('EMailAddr',L);
    for i:=0 to L.Count-1 do
    begin
      if LowerCase(EMailAddr)=LowerCase(TXmlNode(L[I]).ValueAsString) then
      begin
        TXmlNode(L[I]).Delete;
        Break;
      end;
    end;
  finally
    L.Free;
  End;
end;
function TMyXml.EditContact(EMailAddr, ContactName,
  Remark: string): Boolean;
var
  N:TXmlNode;
  L:TList;
  I:Integer;
begin
  Result :=false;
  N:=Root.FindNode('Contact');
  if n=nil then Exit;
  L:=TList.Create;
  try
    N.FindNodes('EMailAddr',L);
    for i:=0 to L.Count-1 do
    begin
      if LowerCase(EMailAddr)=LowerCase(TXmlNode(L[I]).ValueAsString) then
      begin
        TXmlNode(L[I]).AttributeByName['ContactName']:=ContactName;
        TXmlNode(L[I]).AttributeByName['Remark']:=Remark;
        Result:=True;
        Break;
      end;
    end;
  finally
    L.Free;
  End;
end;
procedure TMyXml.LoadContacts(ListAddr, ListName: TStringList);
var
  N:TXmlNode;
  L:TList;
  I:Integer;
begin
  N:=Root.FindNode('Contact');
  if n=nil then Exit;
  L:=TList.Create;
  try
    N.FindNodes('EMailAddr',L);
    for i:=0 to L.Count-1 do
    begin
      ListAddr.Add(TXmlNode(L[I]).ValueAsString) ;
      ListName.Add(TXmlNode(L[I]).AttributeByName['ContactName'])
    end;
  finally
    L.Free;
  End;
end;
{ TAppXml }
constructor TAppXml.Create;
begin
  try
    inherited Create(AppPath+'EmailServers.xml');
  except
    on e:EFOpenError do
    begin
      DeleteFile(PAnsiChar(ExtractFilePath(ParamStr(0))+App_Xml));
      CopyFile(PAnsiChar(ExtractFilePath(ParamStr(0))+'EmailServers_Backup.xml'),
                      PAnsiChar(ExtractFilePath(ParamStr(0))+App_Xml),
                      False);
      inherited Create(AppPath+'EmailServers.xml');
    end;
    on e:EFilerError do
    begin
    end;
  end;
end;
initialization
  CS:=TCriticalSection.Create;
finalization
  CS.Free;
end.

						