uMyXml.pas
上传用户:yjb1804
上传日期:2021-01-30
资源大小:3105k
文件大小:30k
源码类别:

Email服务器

开发平台:

Delphi

  1. unit uMyXml;
  2. interface
  3. uses Classes,SysUtils,nativexml,uEncrypt,Windows,Dialogs,Forms;
  4. type
  5.   TEmailBox=(ebRecv,ebSend,ebDraft,ebAttamp);
  6.   TBaseMyXml=class
  7.     private
  8.       FCipher:ICipher;
  9.       
  10.       function GetRoot: TXmlNode;
  11.     protected
  12.       FXml:TNativeXml;
  13.       FXmlFileName:string;
  14.     public
  15.       constructor Create(XmlFileName:string);
  16.       destructor Destroy;override;
  17.       property  Cipher:ICipher  read FCipher write FCipher;
  18.       property  Root:TXmlNode  read GetRoot ;
  19.       property Xml:TNativeXml read  FXml write FXml;
  20.   end;
  21.   TMyXml=class(TBaseMyXml)
  22.     private
  23.     public
  24.       function GetRulesFilePath:string;
  25.       function Pop3sNode:TXmlNode;
  26.       procedure Pop3Nodes(var List:TList);
  27.       function FindPop3(EmailAddr:string):TXmlNode;
  28.       function FindPOP3EmailAddrNode(EmailAddr:string):TXmlNode;  //在所有pop3节点中查找,值为EmailAddr:string的emailaddr节点。
  29.       function RecvsNode(EmailAddr:string):TXmlNode;
  30.       function SentNode(EmailAddr:string):TXmlNode;
  31.       function SendingNode(EmailAddr:string):TXmlNode;
  32.       function AttampNode(EmailAddr:string):TXmlNode;
  33.       Function DraftNode(EmailAddr:String):TXmlNode;
  34.       procedure AddNewEmail(EmailAddr:string;contentFileName:string;UIDL:string); //保存接收到的邮件
  35.       procedure GetAllEmail(EmailAddr:string;contentFileName,Readed,UIDLs:TStrings);// 获取EmailAddr帐号下已经接收的的所有邮件及其附件
  36.       procedure DeleteAllEmail(EmailAddr:string);// 删除EmailAddr帐号下已经接收的的所有邮件
  37.       procedure SetEmailReaded(Emailaddr,UIDL:string);    //设置邮件已读标志
  38.       procedure SetEmailUnreaded(Emailaddr,UIDL:string);
  39.       procedure NewPop3(pop3server,emailaddr,pwd,emailsaveto:string);
  40.       procedure SaveNewEmail(EmailAddr:string;Path:string);
  41.       procedure SaveAsDraft(EmailAddr:string;Path:string);
  42.       procedure SaveAsAttampter(EmailAddr:string;Path:string;attampTime:TDateTime);
  43.       procedure GetAllNotSendEmail(EmailAddr:string;List:TStrings);  //已写未发的邮件
  44.       function GetEMailPwd(EMailAddr:string):string;
  45.       procedure AddSentEmail(EmailAddr:string;path:string); overload; //已发送的邮件
  46.       procedure AddSentEmail(EmailAddr: string; List: TStrings); overload;
  47.       Procedure GetAllSentEmail(EmailAddr:string;List:TStrings);
  48.       procedure AddSendingEmail(EmailAddr:string;path:string); overload; //已发送的邮件
  49.       procedure AddSendingEmail(EmailAddr: string; List: TStrings); overload;
  50.       Procedure GetAllSendingEmail(EmailAddr:string;List:TStrings;bClear:Boolean=true);
  51.       procedure DeleteSendingEmail(EmailAddr:string;path:string);
  52.       
  53.       Procedure DeleteAllSentEmail(EmailAddr:string );
  54.       procedure GetAllDraft(EmailAddr:string;List:TStrings);
  55.       procedure GetAllAttamp(EmailAddr:string;List:TStrings);overLoad;
  56.       procedure GetAllAttamp(sList:TStringList); overLoad;
  57.       
  58.       procedure GetAllTips(TipList:TStrings;var loadonstatup:Boolean;var actual:Integer);
  59.       procedure GetUIDLS(List:TStrings);
  60.       procedure AddBlackList(List:TStrings); //向黑名单添加成员
  61.       procedure AddWhiteList(List:TStrings); //向白名单添加成员
  62.       procedure GetBlackList(List:TStrings); //获得黑名单的成员
  63.       procedure GetWhiteList(List:TStrings);
  64.       procedure DeleteBlackList(List:TStrings); //删除黑名单中的成员
  65.       procedure DeleteWhiteList(List:TStrings); //
  66.       procedure  WriteEmailDetect(EmailAddr:string;Option:Integer);
  67.       function ReadEmailDetect(EmailAddr:string):Integer;
  68.       procedure GetAllEmailDetectOptions(List:TList);
  69.       Function GetEmailsSavePath:string; //Email 保存路径
  70.       Function GetAttchsSavePath:string; //附件保存路径
  71.       procedure SetEmailSavePath(APath:string);
  72.       procedure SetAttchsSavePath(APath:string);
  73.       procedure CleanSents(EmailAddr:String); //清除发件箱
  74.       procedure CleanRecvs(EmailAddr:String);
  75.       procedure CleanDraft(EmailAddr:String);
  76.       procedure CleanAttmp(EmailAddr:String);
  77.       function DeleteAEmail(EmailAddr, EmailFileName: string):boolean;  //删除一封邮件
  78.       //function DeleteEmailInBox(EmailAddr, EmailFileName: string):Boolean;
  79.       function DeleteEmailAwake(EmailAddr,ContentFile:String):boolean;
  80.       procedure AddContact(EMailAddr,ContactName,Remark:string);
  81.       function  EditContact(EMailAddr,ContactName,Remark:string):Boolean;
  82.       procedure DeleteContact(EMailAddr:string);
  83.       procedure LoadContacts(ListAddr,ListName:TStringList);
  84.   end;
  85.   TAppXml=class(TMyXml)
  86.   public
  87.     constructor Create;
  88.   end;
  89. implementation
  90. uses uCommon, uCheckEmail, Variants, UEmailFile,syncObjs;
  91. var
  92.   CS:TCriticalSection;
  93. { TBaseMyXml }
  94. constructor TBaseMyXml.Create(XmlFileName: string);
  95. var
  96.   mStrm:TMemoryStream;
  97. begin
  98.   CS.Enter;
  99.   FXmlFileName:=XmlFileName;
  100.   Fxml:=TNativeXml.Create;
  101.   if FCipher<>nil then
  102.   begin
  103.     mStrm:=TMemoryStream.Create;
  104.     try
  105.        mStrm.Position:=0;
  106.        mStrm.LoadFromFile(XmlFileName);
  107.        FCipher.DecodeStream(mStrm);
  108.        Fxml.LoadFromStream(mStrm);
  109.     finally
  110.       mStrm.Free;
  111.     end;
  112.   end
  113.   else
  114.     FXml.LoadFromFile(XmlFileName);
  115.   Fxml.IndentString:='  ';
  116. end;
  117. destructor TBaseMyXml.Destroy;
  118. var
  119.   mStrm:TMemoryStream;
  120. begin
  121.   if FCipher<>nil then
  122.   begin
  123.     mStrm:=TMemoryStream.Create;
  124.     try
  125.        mStrm.Position:=0;
  126.        Fxml.SaveToStream(mStrm);
  127.        FCipher.EncodeStream(mStrm);
  128.        mStrm.SaveToFile(FXmlFileName);
  129.     finally
  130.       mStrm.Free;
  131.     end;
  132.   end
  133.   else
  134.     FXml.SaveToFile(FXmlFileName);
  135.   FXml.Free;
  136.   CS.Leave;
  137.   inherited;  
  138. end;
  139. function TBaseMyXml.GetRoot: TXmlNode;
  140. begin
  141.   Result:=FXml.Root;
  142. end;
  143. { TMyXml }
  144. procedure TMyXml.AddBlackList(List: TStrings);
  145. var
  146.   N:TXmlNode;
  147.   I:Integer;
  148. begin
  149.   N:=Root.FindNode('BlackList');
  150.   if N=nil then
  151.     N:=Root.NodeNew('BlackList');
  152.   for I:=0 to List.Count-1 do
  153.     N.NodeNew('List').ValueAsString:=List[I];
  154. end;
  155. procedure TMyXml.AddNewEmail(EmailAddr, contentFileName,UIDL:string);
  156. var
  157.   Node:TXmlNode;
  158. begin
  159.   node:=RecvsNode(EmailAddr);
  160.   if Node=nil then Exit;
  161.   node:=Node.NodeNew('recvedemail');
  162.   Node.WriteAttributeBool('read',False);
  163.   Node.WriteAttributeString('UIDL',UIDL);
  164.   Node.WriteString('contentfile',contentFileName);
  165.   //Node.WriteString('attchs',AttchFileName);
  166. end;
  167. procedure TMyXml.AddSentEmail(EmailAddr:string;path: string);
  168. var
  169.   Node:TXmlNode;
  170. begin
  171.   node:=SentNode(EmailAddr);
  172.   if Node=nil then Exit;
  173.   Node.NodeNew('sentemail').ValueAsString :=path;
  174. end;
  175. procedure TMyXml.AddWhiteList(List: TStrings);
  176. var
  177.   N:TXmlNode;
  178.   I:Integer;
  179. begin
  180.   N:=Root.FindNode('WhiteList');
  181.   if N=nil then
  182.     N:=Root.NodeNew('WhiteList');
  183.   for I:=0 to List.Count-1 do
  184.     N.NodeNew('List').ValueAsString:=List[I];
  185. end;
  186. function TMyXml.AttampNode(EmailAddr: string): TXmlNode;
  187. var
  188.   I:Integer;
  189.   List:TList;
  190.   Node:TXmlNode;
  191. begin
  192.   Result:=nil;
  193.   list:=TList.Create;
  194.   try
  195.     Pop3Nodes(List);
  196.     for I:=0 to List.Count-1 do
  197.     begin
  198.       Node:=TXmlNode(List[I]).FindNode('emailaddr');
  199.       if Node<>nil   then
  200.       begin
  201.          if Trim(Node.ValueAsString)=Trim(EmailAddr) then
  202.          begin
  203.            Result:=TXmlNode(List[I]).FindNode('attamp');
  204.            if Result=nil then Result:=TXmlNode(List[I]).NodeNew('attamp');
  205.            Break;
  206.          end;
  207.       end;
  208.     end;
  209.   finally
  210.     List.Free;
  211.   end;
  212. end;
  213. procedure TMyXml.CleanAttmp(EmailAddr:String);
  214. var
  215.   I:Integer;
  216.   List:TStrings;
  217.   N:TXmlNode;
  218. begin
  219.   if  EmailAddr='' then exit;
  220.   List:=TStringList.Create;
  221.   try
  222.     GetAllAttamp(EmailAddr,List);
  223.     for I:=0 to List.Count-1 do
  224.       if FileExists(List[I]) then DeleteFile(PAnsiChar(List[I]))
  225.   finally
  226.     List.Free;
  227.   end;
  228.   N:= AttampNode(EmailAddr);
  229.   if N<>nil then N.delete;
  230. end;
  231. procedure TMyXml.CleanDraft(EmailAddr:String);
  232. var
  233.   I:Integer;
  234.   List:TStrings;
  235.   N:TXmlNode;
  236. begin
  237.   if EmailAddr='' then exit;
  238.   List:=TStringList.Create;
  239.   try
  240.     GetAllDraft(EmailAddr,List);
  241.     for I:=0 to List.Count-1 do
  242.       if FileExists(List[I]) then DeleteFile(PAnsiChar(List[I]))
  243.   finally
  244.     List.Free;
  245.   end;
  246.   N:= DraftNode(EmailAddr);
  247.   if N<>nil then N.delete;
  248. end;
  249. procedure TMyXml.CleanRecvs(EmailAddr:String);
  250. var
  251.   I:Integer;
  252.   List:TStrings;
  253.   N:TXmlNode;
  254. begin
  255.   if EmailAddr='' then exit;
  256.   List:=TStringList.Create;
  257.   try
  258.     GetAllEmail(EmailAddr,List,nil,nil);
  259.     for I:=0 to List.Count-1 do
  260.       if FileExists(List[I]) then DeleteFile(PAnsiChar(List[I]))
  261.   finally
  262.     List.Free;
  263.   end;
  264.   N:= RecvsNode(EmailAddr);
  265.   if N<>nil then N.delete;
  266. end;
  267. procedure TMyXml.CleanSents(EmailAddr:String);
  268. var
  269.   I:Integer;
  270.   List:TStrings;
  271. begin
  272.   if EmailAddr='' then exit;
  273.   List:=TStringList.Create;
  274.   try
  275.     GetAllSentEmail(EmailAddr,List);
  276.     for I:=0 to List.Count-1 do
  277.       if FileExists(List[I]) then DeleteFile(PAnsiChar(List[I]))
  278.   finally
  279.     List.Free;
  280.   end;
  281.   DeleteAllSentEmail(EmailAddr);
  282. end;
  283. function TMyXml.DeleteAEmail(EmailAddr, EmailFileName: string):boolean;
  284. var
  285.   L:TStrings;
  286.   function Find(FileName:string) :boolean;
  287.   var
  288.     I:integer;
  289.   begin
  290.     result:=false;
  291.     for I:=0 to pred(L.Count) do
  292.     begin
  293.       if L[I]=EmailFileName then
  294.       begin
  295.         if FileExists(FileName) then
  296.           deleteFile(PAnsiChar(FileName));
  297.         Result:=true;
  298.         exit;
  299.       end;
  300.     end;
  301.   end;
  302. begin
  303.   L:=TStringList.Create;
  304.   try
  305.     GetAllEmail(EmailAddr,L,nil,nil);
  306.     Result:=Find(EmailFileName);
  307.     if Result then exit;
  308.     L.Clear;
  309.     GetAllSentEmail(EmailAddr,L);
  310.     Result:=Find(EmailFileName);
  311.     if Result then exit;
  312.     L.Clear;
  313.     GetAllDraft(EmailAddr,L);
  314.     Result:=Find(EmailFileName);
  315.     if Result then exit;
  316.     L.Clear;
  317.     GetAllAttamp(EmailAddr,L);
  318.     Result:=Find(EmailFileName);
  319.     L.Clear;
  320.     GetAllSendingEmail(EmailAddr,L);
  321.     Result:=Find(EmailFileName);
  322.     if Result then exit;
  323.   finally
  324.     L.free;
  325.   end;
  326. end;
  327. procedure TMyXml.DeleteAllEmail(EmailAddr: string);
  328. var
  329.   Node:TXmlNode;
  330. begin
  331.   node:=RecvsNode(EmailAddr);
  332.   if node<>nil then Node.Delete;
  333. end;
  334. procedure TMyXml.DeleteAllSentEmail(EmailAddr: string);
  335. begin
  336.   if SentNode(EmailAddr)<>nil then SentNode(EmailAddr).Delete;
  337. end;
  338. procedure TMyXml.DeleteBlackList(List: TStrings);
  339. var
  340.   N:TXmlNode;
  341.   I:Integer;
  342.   L:TList;
  343. begin
  344.   N:=Root.FindNode('BlackList');
  345.   if N=nil then  Exit;
  346.   L:=TList.Create;
  347.   try
  348.     N.NodesByName('List',L);
  349.     for I:=0 to L.Count-1 do
  350.       if List.IndexOf(TXmlNode(L[I]).ValueAsString)<>-1 then TXmlNode(L[I]).Delete;
  351.   finally
  352.     L.Free;
  353.   end;
  354. end;
  355. procedure TMyXml.DeleteWhiteList(List: TStrings);
  356. var
  357.   N:TXmlNode;
  358.   I:Integer;
  359.   L:TList;
  360. begin
  361.   N:=Root.FindNode('WhiteList');
  362.   if N=nil then  Exit;
  363.   L:=TList.Create;
  364.   try
  365.     N.NodesByName('List',L);
  366.     for I:=0 to L.Count-1 do
  367.       if List.IndexOf(TXmlNode(L[I]).ValueAsString)<>-1 then TXmlNode(L[I]).Delete;
  368.   finally
  369.     L.Free;
  370.   end;
  371. end;
  372. function TMyXml.DraftNode(EmailAddr: String): TXmlNode;
  373. var
  374.   I:Integer;
  375.   List:TList;
  376.   Node:TXmlNode;
  377. begin
  378.   Result:=nil;
  379.   list:=TList.Create;
  380.   try
  381.     Pop3Nodes(List);
  382.     for I:=0 to List.Count-1 do
  383.     begin
  384.       Node:=TXmlNode(List[I]).FindNode('emailaddr');
  385.       if Node<>nil   then
  386.       begin
  387.          if Trim(Node.ValueAsString)=Trim(EmailAddr) then
  388.          begin
  389.            Result:=TXmlNode(List[I]).FindNode('draft');
  390.            if Result=nil then Result:=TXmlNode(List[I]).NodeNew('draft');
  391.            Break;
  392.          end;
  393.       end;
  394.     end;
  395.   finally
  396.     List.Free;
  397.   end;
  398. end;
  399. function TMyXml.FindPop3(EmailAddr: string): TXmlNode;
  400. var
  401.   L:TList;
  402.   I:Integer;
  403. begin
  404.   Result:=nil;
  405.   L:=TList.Create;
  406.   try
  407.     Pop3Nodes(L);
  408.     for I:=0 to pred(L.Count) do
  409.     begin
  410.       if CompareText(TXmlNode(L[I]).ReadString('emailaddr',''),EmailAddr)=0 then
  411.       begin
  412.         Result:=L[I];
  413.         Break;
  414.       end;
  415.     end;
  416.   finally
  417.       L.free;
  418.   end;
  419. end;
  420. function TMyXml.FindPOP3EmailAddrNode(EmailAddr: string): TXmlNode;
  421. var
  422.   I:Integer;
  423.   List:TList;
  424.   Node:TXmlNode;
  425. begin
  426.   Result:=nil;
  427.   list:=TList.Create;
  428.   try
  429.     Pop3Nodes(List);
  430.     for I:=0 to List.Count-1 do
  431.     begin
  432.       Node:=TXmlNode(List[I]).FindNode('emailaddr');
  433.       if Node<>nil   then
  434.       begin
  435.          if Trim(Node.ValueAsString)=Trim(EmailAddr) then
  436.          begin
  437.            Result:=Node;
  438.            Break;
  439.          end;
  440.       end;
  441.     end;
  442.   finally
  443.     List.Free;
  444.   end;
  445. end;
  446. procedure TMyXml.GetAllAttamp(EmailAddr: string; List: TStrings);
  447. var
  448.   Node:TXmlNode;
  449.   L:TList;
  450.   I:integer;
  451. begin
  452.   node:=FindPOP3EmailAddrNode(EmailAddr);
  453.   if Node =nil then Exit;
  454.   node:=Node.Parent.FindNode('attamp');
  455.   if Node =nil then Exit;
  456.   L:=TList.create;
  457.   try
  458.     Node.NodesByName('contentfile',L);
  459.     List.Clear;
  460.     for I:=0 to L.Count-1 do
  461.       if FileExists(TxmlNode(L[I]).ValueAsString) then List.Add(TxmlNode(L[I]).ValueAsString);
  462.   finally
  463.     L.Free;
  464.   end;
  465. end;
  466. procedure TMyXml.GetAllAttamp(sList: TStringList);
  467. var
  468.   L,List:TList;
  469.   I,J:integer;
  470.   N:TXmlNode;
  471.   sTime:string;
  472. begin
  473.     sList.clear;
  474.     L:=TList.Create;
  475.     try
  476.       Pop3Nodes(L);
  477.       for I:=0 to L.Count-1 do
  478.       begin
  479.         N:=TXmlNode(L[I]).FindNode('attamp');
  480.         if N=nil then Continue;
  481.         List:=TList.Create;
  482.         try
  483.           N.NodesByName('contentfile',List);
  484.           for J:=0 to List.Count-1 do
  485.           begin
  486.             sTime:=TXmlNode(List[I]).AttributeByName['time'];
  487.             if sTime='' then Continue;  //StrToDateTime()
  488.             if StrToDateTime(sTime)<=Now then
  489.               sList.Add(TXmlNode(List[I]).ValueAsString);
  490.           end;
  491.         finally
  492.           List.Free;
  493.         end;
  494.       end;
  495.     finally
  496.       L.Free;
  497.     end;
  498. end;
  499. procedure TMyXml.GetAllDraft(EmailAddr: string; List: TStrings);
  500. var
  501.   Node:TXmlNode;
  502.   L:TList;
  503.   I:integer;
  504. begin
  505.   node:=FindPOP3EmailAddrNode(EmailAddr);
  506.   if Node =nil then Exit;
  507.   node:=Node.Parent.FindNode('draft');
  508.   if Node =nil then Exit;
  509.   L:=TList.create;
  510.   try
  511.     Node.NodesByName('contentfile',L);
  512.     List.Clear;
  513.     for I:=0 to L.Count-1 do
  514.       if FileExists(TxmlNode(L[I]).ValueAsString) then List.Add(TxmlNode(L[I]).ValueAsString);
  515.   finally
  516.     L.Free;
  517.   end;
  518. end;
  519. procedure TMyXml.GetAllEmail(EmailAddr: string; contentFileName,
  520.   Readed,UIDLs: TStrings);
  521. var
  522.   Node:TXmlNode;
  523.   List:TList;
  524.   I:Integer;
  525. begin
  526.   node:=RecvsNode(EmailAddr);
  527.   if Node=nil then Exit;
  528.   List:=TList.Create;
  529.   try
  530.     Node.NodesByName('recvedemail',List);
  531.     for I:=0 to List.Count-1 do     
  532.     begin
  533.       if contentFileName<>nil then
  534.         contentFileName.Add(TXmlNode(List[I]).ReadString('contentfile',''));
  535.       if Readed<>nil then
  536.         Readed.Add(TXmlNode(List[I]).AttributeByName['read']);
  537.       if UIDLs<>nil then
  538.         UIDLs.Add(TXmlNode(List[I]).AttributeByName['UIDL'])
  539.     end;
  540.   finally
  541.     List.Free;
  542.   end;
  543. end;
  544. procedure TMyXml.GetAllEmailDetectOptions(List:TList);
  545. var
  546.   L:TList;
  547.   I:Integer;
  548.   option:PEmailDetect;
  549. begin
  550.   L:=TList.Create;
  551.   try
  552.     Pop3Nodes(L);
  553.     for i:=0 to L.Count-1 do
  554.     begin
  555.       New(option);
  556.       option.EmailAccount.Pop3ServerAddr:=TXmlNode(L[I]).ReadString('pop3server');
  557.       option.EmailAccount.SeverPort:=StrToIntDef(TXmlNode(L[I]).ReadString('port'),110);
  558.       option.EmailAccount.EmailAccount:=TXmlNode(L[I]).ReadString('emailaddr');
  559.       option.EmailAccount.EmailPwd:=TXmlNode(L[I]).ReadString('pwd');
  560.       option.EmailDetectOption:=TEmailDetectOption(StrToIntDef(TXmlNode(L[I]).AttributeByName['Detect'],3));
  561.       List.Add(option);
  562.     end;
  563.   finally
  564.     L.Free;
  565.   end;
  566. end;
  567. procedure TMyXml.GetAllNotSendEmail(EmailAddr:string;List: TStrings);
  568. var
  569.   L:TList;
  570.   I:integer;
  571.   Node:TXmlNode;
  572. begin
  573.   Node:=FindPOP3EmailAddrNode(EmailAddr);
  574.   if Node=nil then Exit;
  575.   Node:=Node.Parent;
  576.   if Node.FindNode('NotSendEmail')=nil then Exit;
  577.   
  578.   L:=TList.Create;
  579.   try
  580.     Node.FindNode('NotSendEmail').NodesByName('contentfile',L);
  581.     for I:=0 to L.Count-1 do
  582.       if FileExists(TXmlNode(L[I]).ValueAsString) then List.add(TXmlNode(L[I]).ValueAsString);
  583.   finally
  584.     L.Free;
  585.   end;
  586. end;
  587. procedure TMyXml.GetAllSentEmail(EmailAddr:string;List: TStrings);
  588. var
  589.   Node:TXmlNode;
  590.   L:TList;
  591.   I:integer;
  592. begin
  593.   node:=SentNode(EmailAddr);
  594.   if Node=nil then Exit;
  595.   L:=TList.create;
  596.   try
  597.     Node.NodesByName('sentemail',L);
  598.     List.Clear;
  599.     for I:=0 to L.Count-1 do
  600.       if FileExists(TxmlNode(L[I]).ValueAsString) then List.Add(TxmlNode(L[I]).ValueAsString);
  601.   finally
  602.     L.Free;
  603.   end;
  604. end;
  605. procedure TMyXml.GetAllTips(TipList:TStrings;var loadonstatup:Boolean;
  606.             var actual:Integer);
  607. var
  608.   L:TList;
  609.   I:Integer;
  610. begin
  611.   if Root.FindNode('tips')=nil then Exit;
  612.   loadonstatup:=StrToBool(Root.FindNode('tips').AttributeByname['loadonstatup']);
  613.   actual:=StrToInt(Root.FindNode('tips').AttributeByname['actual']);
  614.   L:=TList.Create;
  615.   try
  616.     Root.FindNode('tips').NodesByName('tip',L);
  617.     for I:=0 to L.Count-1 do
  618.     begin
  619.       TipList.Add(TXmlNode(L[I]).ValueAsString);
  620.     end;
  621.   finally
  622.     L.free;
  623.   end;
  624. end;
  625. function TMyXml.GetAttchsSavePath: string;
  626. begin
  627.   Result:=Pop3sNode.ReadString('emailattchsaveto',IncludeTrailingPathDelimiter(AppPath+'emailattchsaveto'));
  628. end;
  629. procedure TMyXml.GetBlackList(List: TStrings);
  630. var
  631.   N:TXmlNode;
  632.   I:Integer;
  633.   L:TList;
  634. begin
  635.   List.Clear;
  636.   N:=Root.FindNode('BlackList');
  637.   if N=nil then  Exit;
  638.   L:=TList.Create;
  639.   try
  640.     N.NodesByName('List',L);
  641.     for I:=0 to L.Count-1 do
  642.       List.Add(TXmlNode(L[I]).ValueAsString);
  643.   finally
  644.     L.Free;
  645.   end;
  646. end;
  647. function TMyXml.GetEMailPwd(EMailAddr: string): string;
  648. var
  649.   I:Integer;
  650.   List:TList;
  651.   Node:TXmlNode;
  652. begin
  653.   Result:='';
  654.   list:=TList.Create;
  655.   try
  656.     Pop3Nodes(List);
  657.     for I:=0 to List.Count-1 do
  658.     begin
  659.       Node:=TXmlNode(List[I]).FindNode('emailaddr');
  660.       if Node<>nil   then
  661.       begin
  662.          if Trim(Node.ValueAsString)=Trim(EmailAddr) then
  663.          begin
  664.            Result:=TXmlNode(List[I]).ReadString('pwd','');
  665.            Break;
  666.          end;
  667.       end;
  668.     end;
  669.   finally
  670.     List.Free;
  671.   end;
  672. end;
  673. function TMyXml.GetEmailsSavePath: string;
  674. begin
  675.   Result:=Pop3sNode.ReadString('emailsaveto',IncludeTrailingPathDelimiter(AppPath+'emailsaveto'));
  676. end;
  677. function TMyXml.GetRulesFilePath: string;
  678. begin
  679.   Result:='';
  680.   if (Root.FindNode('Rules')<>nil) then
  681.     Result:=Root.FindNode('Rules').AttributeByName['RulesSaveTo'];
  682. end;
  683. procedure TMyXml.GetUIDLS(List: TStrings);
  684. var
  685.   L,L1:TList;
  686.   I,J:Integer;
  687.   N:TXmlNode;
  688. begin
  689.   L:=TList.Create;
  690.   try
  691.     Pop3Nodes(L);
  692.     for I:=0 to L.Count-1 do
  693.     begin
  694.       N:=TXmlNode(L[I]).FindNode('recvs');
  695.       if N=nil then Continue;
  696.       L1:=TList.Create;
  697.       try
  698.         N.NodesByName('recvedemail',L1);
  699.         for J:=0 to L1.Count-1 do
  700.           if TXmlNode(L1[J]).AttributeByName['UIDL']<>'' then
  701.             List.Add(TXmlNode(L1[J]).AttributeByName['UIDL']) ;
  702.       finally
  703.         L1.Free;
  704.       end;
  705.     end;
  706.   finally
  707.     L.Free;
  708.   end;
  709. end;
  710. procedure TMyXml.GetWhiteList(List: TStrings);
  711. var
  712.   N:TXmlNode;
  713.   I:Integer;
  714.   L:TList;
  715. begin
  716.   List.Clear;
  717.   N:=Root.FindNode('WhiteList');
  718.   if N=nil then  Exit;
  719.   L:=TList.Create;
  720.   try
  721.     N.NodesByName('List',L);
  722.     for I:=0 to L.Count-1 do
  723.       List.Add(TXmlNode(L[I]).ValueAsString);
  724.   finally
  725.     L.Free;
  726.   end;
  727. end;
  728. function TMyXml.DeleteEmailAwake(EmailAddr, ContentFile: String): boolean;
  729. var
  730.     N:TXmlNode;
  731.     L:TList;
  732.     I:integer;
  733. begin
  734.   Result:=false;
  735.   N:=Xml.Root.FindNode('EmailAwake');
  736.   if N=nil then exit;
  737.   L:=TList.Create;
  738.   try
  739.     N.NodesByName('Eamil',L);
  740.     for I:=0 to L.Count-1 do
  741.     begin
  742.       if (TXmlNode(L[I]).AttributeByName['EmailAddr']=EmailAddr) and  (TXmlNode(L[I]).AttributeByName['ContentFile']=ContentFile) then
  743.         TXmlNode(L[I]).Delete;
  744.     end;
  745.   finally
  746.     L.free;
  747.   end;
  748. end;
  749. procedure TMyXml.NewPop3(pop3server, emailaddr, pwd, emailsaveto: string);
  750. begin
  751.   with FXml.Root.NodeByName('pop3s').NodeNew('pop3') do
  752.   begin
  753.      WriteString('emailaddr',Trim(emailaddr));
  754.      WriteString('pwd',Trim(pwd));
  755.      FXml.Root.NodeByName('pop3s').AttributeByName['emailsaveto']:=Trim(emailsaveto);
  756.      //WriteString('emailsaveto',Trim(emailsaveto));
  757.      WriteString('pop3server',Trim(pop3server));
  758.   end;
  759. end;
  760. procedure TMyXml.Pop3Nodes(var List: TList);
  761. begin
  762.   Pop3sNode.NodesByName('pop3',List);
  763. end;
  764. function TMyXml.Pop3sNode: TXmlNode;
  765. begin
  766.   if Root=nil then   raise Exception.Create('没有根节点');
  767.   Result :=Root.FindNode('pop3s');
  768.   if Result=nil then raise Exception.Create('没有pop3s节点');
  769. end;
  770. function TMyXml.ReadEmailDetect(EmailAddr: string): Integer;
  771. var
  772.   N:TXmlNode;
  773. begin
  774.   Result:=-1;
  775.   N:=FindPop3(EmailAddr);
  776.   if N<>nil then
  777.      Result:=StrToIntDef(N.AttributeByName['Detect'],-1);
  778. end;
  779. function TMyXml.RecvsNode(EmailAddr: string): TXmlNode;
  780. var
  781.   I:Integer;
  782.   List:TList;
  783.   Node:TXmlNode;
  784. begin
  785.   Result:=nil;
  786.   list:=TList.Create;
  787.   try
  788.     Pop3Nodes(List);
  789.     for I:=0 to List.Count-1 do
  790.     begin
  791.       Node:=TXmlNode(List[I]).FindNode('emailaddr');
  792.       if Node<>nil   then
  793.       begin
  794.          if Trim(Node.ValueAsString)=Trim(EmailAddr) then
  795.          begin
  796.            Result:=TXmlNode(List[I]).FindNode('recvs');
  797.            if Result=nil then Result:=TXmlNode(List[I]).NodeNew('recvs');
  798.            Break;
  799.          end;
  800.       end;
  801.     end;
  802.   finally
  803.     List.Free;
  804.   end;
  805. end;
  806. procedure TMyXml.SaveAsAttampter(EmailAddr, Path: string;attampTime:TDateTime);
  807. var
  808.   Node:TXmlNode;
  809. begin
  810.   if Pop3sNode=nil then exit;
  811.   Node:=FindPOP3EmailAddrNode(EmailAddr);
  812.   if Node=nil then Exit;
  813.   Node:=Node.Parent;
  814.   if Node.FindNode('attamp')=nil then
  815.     Node.NodeNew('attamp');
  816.   Node:=Node.FindNode('attamp');
  817.   with  Node.NodeNew('contentfile') do
  818.   begin
  819.     ValueAsString:=Path;
  820.     AttributeByName['time']:=DateTimeToStr(attampTime);
  821.   end;
  822. end;
  823. procedure TMyXml.SaveAsDraft(EmailAddr, Path: string);
  824. var
  825.   Node:TXmlNode;
  826. begin
  827.   if Pop3sNode=nil then exit;
  828.   Node:=FindPOP3EmailAddrNode(EmailAddr);
  829.   if Node=nil then Exit;
  830.   Node:=Node.Parent;
  831.   if Node.FindNode('draft')=nil then Node.NodeNew('draft');
  832.   Node:=Node.FindNode('draft');
  833.   Node.NodeNew('contentfile').ValueAsString:= Path;
  834. end;
  835. procedure TMyXml.SaveNewEmail(EmailAddr:string;Path: string);
  836. var
  837.   Node:TXmlNode;
  838. begin
  839.   if Pop3sNode=nil then exit;
  840.   Node:=FindPOP3EmailAddrNode(EmailAddr);
  841.   if Node=nil then Exit;
  842.   Node:=Node.Parent;
  843.   if Node.FindNode('NotSendEmail')=nil then
  844.     Node.NodeNew('NotSendEmail');
  845.   Node:=Node.FindNode('NotSendEmail');
  846.   Node.WriteString('contentfile',Path);
  847. end;
  848. function TMyXml.SentNode(EmailAddr: string): TXmlNode;
  849. var
  850.   I:Integer;
  851.   List:TList;
  852.   Node:TXmlNode;
  853. begin
  854.   Result:=nil;
  855.   list:=TList.Create;
  856.   try
  857.     Pop3Nodes(List);
  858.     for I:=0 to List.Count-1 do
  859.     begin
  860.       Node:=TXmlNode(List[I]).FindNode('emailaddr');
  861.       if Node<>nil   then
  862.       begin
  863.          if Trim(Node.ValueAsString)=Trim(EmailAddr) then
  864.          begin
  865.            Result:=TXmlNode(List[I]).FindNode('sending');
  866.            if Result=nil then Result:=TXmlNode(List[I]).NodeNew('sending');
  867.            Break;
  868.          end;
  869.       end;
  870.     end;
  871.   finally
  872.     List.Free;
  873.   end;
  874. end;
  875. procedure TMyXml.SetAttchsSavePath(APath: string);
  876. begin
  877.   Pop3sNode.ReadString('emailattchsaveto',APath);
  878. end;
  879. procedure TMyXml.SetEmailReaded(Emailaddr, UIDL: string);
  880. var
  881.   Node:TXmlNode;
  882.   List:TList;
  883.   I:integer;
  884. begin
  885.   node:=RecvsNode(EmailAddr);
  886.   if Node=nil then Exit;
  887.   list:=TList.create;
  888.   try
  889.     Node.NodesByName('recvedemail',List);
  890.     for I:=0 to list.count-1 do
  891.     begin
  892.       if TXmlNode(List[I]).ReadAttributeString('UIDL')=UIDL then
  893.       begin
  894.         TXmlNode(List[I]).AttributeByName['read']:='True';
  895.         break;
  896.       end;
  897.     end;
  898.   finally
  899.     List.Free;
  900.   end;
  901. end;
  902. procedure TMyXml.SetEmailSavePath(APath: string);
  903. begin
  904.   Pop3sNode.WriteString('emailsaveto',APath);
  905. end;
  906. procedure TMyXml.SetEmailUnreaded(Emailaddr, UIDL: string);
  907. var
  908.   Node:TXmlNode;
  909.   List:TList;
  910.   I:integer;
  911. begin
  912.   node:=RecvsNode(EmailAddr);
  913.   if Node=nil then Exit;
  914.   list:=TList.create;
  915.   try
  916.     Node.NodesByName('recvedemail',List);
  917.     for I:=0 to list.count-1 do
  918.     begin
  919.       if TXmlNode(List[I]).ReadAttributeString('UIDL')=UIDL then
  920.       begin
  921.         TXmlNode(List[I]).AttributeByName['read']:='False';
  922.         break;
  923.       end;
  924.     end;
  925.   finally
  926.     List.Free;
  927.   end;
  928. end;
  929. procedure TMyXml.WriteEmailDetect(EmailAddr:string;Option: Integer);
  930. var
  931.   N:TXmlNode;
  932. begin
  933.   N:=FindPop3(EmailAddr);
  934.   if N<>nil then
  935.      N.AttributeByName['Detect']:=IntToStr(Option);
  936. end;
  937. procedure TMyXml.AddSentEmail(EmailAddr: string; List: TStrings);
  938. var
  939.   Node:TXmlNode;
  940.   I:integer;
  941. begin
  942.   node:=SentNode(EmailAddr);
  943.   if Node=nil then Exit;
  944.   for I:=0 to List.Count-1 do
  945.       if FileExists(List[I]) then node.WriteString('sentemail',List[I]);// List.Add(TxmlNode(L[I]).ValueAsString);
  946. end;
  947. procedure TMyXml.AddSendingEmail(EmailAddr, path: string);
  948. var
  949.   Node:TXmlNode;
  950. begin
  951.   node:=SendingNode(EmailAddr);
  952.   if Node=nil then Exit;
  953.   Node.NodeNew('SendingEmail').ValueAsString :=path;
  954. end;
  955. procedure TMyXml.AddSendingEmail(EmailAddr: string; List: TStrings);
  956. var
  957.   Node:TXmlNode;
  958.   I:integer;
  959. begin
  960.   node:=SendingNode(EmailAddr);
  961.   if Node=nil then Exit;
  962.   for I:=0 to List.Count-1 do
  963.       if FileExists(List[I]) then node.WriteString('Sendingemail',List[I]);// List.Add(TxmlNode(L[I]).ValueAsString);
  964. end;
  965. procedure TMyXml.GetAllSendingEmail(EmailAddr: string; List: TStrings;bClear:Boolean);
  966. var
  967.   Node:TXmlNode;
  968.   L:TList;
  969.   I:integer;
  970. begin
  971.   node:=SendingNode(EmailAddr);
  972.   if Node=nil then Exit;
  973.   L:=TList.create;
  974.   try
  975.     Node.NodesByName('Sendingemail',L);
  976.     if bClear then  List.Clear;
  977.     for I:=0 to L.Count-1 do
  978.       if FileExists(TxmlNode(L[I]).ValueAsString) then List.Add(TxmlNode(L[I]).ValueAsString);
  979.   finally
  980.     L.Free;
  981.   end;
  982. end;
  983. function TMyXml.SendingNode(EmailAddr: string): TXmlNode;
  984. var
  985.   I:Integer;
  986.   List:TList;
  987.   Node:TXmlNode;
  988. begin
  989.   Result:=nil;
  990.   list:=TList.Create;
  991.   try
  992.     Pop3Nodes(List);
  993.     for I:=0 to List.Count-1 do
  994.     begin
  995.       Node:=TXmlNode(List[I]).FindNode('emailaddr');
  996.       if Node<>nil   then
  997.       begin
  998.          if Trim(Node.ValueAsString)=Trim(EmailAddr) then
  999.          begin
  1000.            Result:=TXmlNode(List[I]).FindNode('Sending');
  1001.            if Result=nil then Result:=TXmlNode(List[I]).NodeNew('Sending');
  1002.            Break;
  1003.          end;
  1004.       end;
  1005.     end;
  1006.   finally
  1007.     List.Free;
  1008.   end;
  1009. end;
  1010. procedure TMyXml.DeleteSendingEmail(EmailAddr, path: string);
  1011. var
  1012.   Node:TXmlNode;
  1013.   L:TList;
  1014.   I:integer;
  1015. begin
  1016.   node:=SendingNode(EmailAddr);
  1017.   if Node=nil then Exit;
  1018.   L:=TList.Create;
  1019.   try
  1020.     Node.NodesByName('SendingEmail',L);
  1021.     for I:=0 to L.Count-1 do
  1022.     begin
  1023.       if UpperCase(TXmlNode(L[I]).ValueAsString)=UpperCase(path) then
  1024.       begin
  1025.         TXmlNode(L[I]).Delete;
  1026.         Break;
  1027.       end;
  1028.     end;
  1029.   finally
  1030.     L.Free;
  1031.   end;
  1032. end;
  1033. procedure TMyXml.AddContact(EMailAddr, ContactName, Remark: string);
  1034. var
  1035.   N:TXmlNode;
  1036. begin
  1037.   N:=Root.FindNode('Contact');
  1038.   if N=nil then N:=Root.NodeNew('Contact');
  1039.   with N.NodeNew('EMailAddr') do
  1040.   begin
  1041.     ValueAsString:=EMailAddr;
  1042.     AttributeAdd('ContactName',ContactName);
  1043.     AttributeAdd('Remark',Remark);
  1044.   end;
  1045. end;
  1046. procedure TMyXml.DeleteContact(EMailAddr: string);
  1047. var
  1048.   N:TXmlNode;
  1049.   L:TList;
  1050.   I:Integer;
  1051. begin
  1052.   N:=Root.FindNode('Contact');
  1053.   if n=nil then Exit;
  1054.   L:=TList.Create;
  1055.   try
  1056.     N.FindNodes('EMailAddr',L);
  1057.     for i:=0 to L.Count-1 do
  1058.     begin
  1059.       if LowerCase(EMailAddr)=LowerCase(TXmlNode(L[I]).ValueAsString) then
  1060.       begin
  1061.         TXmlNode(L[I]).Delete;
  1062.         Break;
  1063.       end;
  1064.     end;
  1065.   finally
  1066.     L.Free;
  1067.   End;
  1068. end;
  1069. function TMyXml.EditContact(EMailAddr, ContactName,
  1070.   Remark: string): Boolean;
  1071. var
  1072.   N:TXmlNode;
  1073.   L:TList;
  1074.   I:Integer;
  1075. begin
  1076.   Result :=false;
  1077.   N:=Root.FindNode('Contact');
  1078.   if n=nil then Exit;
  1079.   L:=TList.Create;
  1080.   try
  1081.     N.FindNodes('EMailAddr',L);
  1082.     for i:=0 to L.Count-1 do
  1083.     begin
  1084.       if LowerCase(EMailAddr)=LowerCase(TXmlNode(L[I]).ValueAsString) then
  1085.       begin
  1086.         TXmlNode(L[I]).AttributeByName['ContactName']:=ContactName;
  1087.         TXmlNode(L[I]).AttributeByName['Remark']:=Remark;
  1088.         Result:=True;
  1089.         Break;
  1090.       end;
  1091.     end;
  1092.   finally
  1093.     L.Free;
  1094.   End;
  1095. end;
  1096. procedure TMyXml.LoadContacts(ListAddr, ListName: TStringList);
  1097. var
  1098.   N:TXmlNode;
  1099.   L:TList;
  1100.   I:Integer;
  1101. begin
  1102.   N:=Root.FindNode('Contact');
  1103.   if n=nil then Exit;
  1104.   L:=TList.Create;
  1105.   try
  1106.     N.FindNodes('EMailAddr',L);
  1107.     for i:=0 to L.Count-1 do
  1108.     begin
  1109.       ListAddr.Add(TXmlNode(L[I]).ValueAsString) ;
  1110.       ListName.Add(TXmlNode(L[I]).AttributeByName['ContactName'])
  1111.     end;
  1112.   finally
  1113.     L.Free;
  1114.   End;
  1115. end;
  1116. { TAppXml }
  1117. constructor TAppXml.Create;
  1118. begin
  1119.   try
  1120.     inherited Create(AppPath+'EmailServers.xml');
  1121.   except
  1122.     on e:EFOpenError do
  1123.     begin
  1124.       DeleteFile(PAnsiChar(ExtractFilePath(ParamStr(0))+App_Xml));
  1125.       CopyFile(PAnsiChar(ExtractFilePath(ParamStr(0))+'EmailServers_Backup.xml'),
  1126.                       PAnsiChar(ExtractFilePath(ParamStr(0))+App_Xml),
  1127.                       False);
  1128.       inherited Create(AppPath+'EmailServers.xml');
  1129.     end;
  1130.     on e:EFilerError do
  1131.     begin
  1132.       ShowMessage(e.Message);
  1133.       Application.terminate;
  1134.     end;
  1135.   end;
  1136. end;
  1137. initialization
  1138.   CS:=TCriticalSection.Create;
  1139. finalization
  1140.   CS.Free;
  1141. end.