开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Internet/网络编程 > Email服务器 > 查看源码
ufrmEmailBoxProperty.pas
资源名称：EMailMasterbysuperroyor.rar　[点击查看]
上传用户：yjb1804
上传日期：2021-01-30
资源大小：3105k
文件大小：12k
源码类别：

Email服务器

开发平台：

Delphi

ufrmEmailBoxProperty.pas：源码内容
  1. unit ufrmEmailBoxProperty;
  3. interface
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, RzTabs, cxTextEdit, cxControls, cxContainer, cxEdit, cxLabel,
  8.   cxMaskEdit, cxButtonEdit, Menus, cxLookAndFeelPainters, StdCtrls,
  9.   cxButtons, ExtCtrls, cxListBox, cxRadioGroup, cxCheckBox, cxGraphics,
  10.   cxDropDownEdit, cxImageComboBox, cxSpinEdit, RzShellDialogs, uMyXml,IniFiles,
  11.   ActnList;
  13. type
  14.   TfrmEmailBoxProperty = class(TForm)
  15.     RzPageControl1: TRzPageControl;
  16.     TabSheet2: TRzTabSheet;
  17.     TabSheet3: TRzTabSheet;
  18.     cxLabel4: TcxLabel;
  19.     pnl1: TPanel;
  20.     btnOk: TcxButton;
  21.     btnCancel: TcxButton;
  22.     lblEmailRecvCount: TLabel;
  23.     btnRecvClear: TcxButton;
  24.     lblBoxName: TLabel;
  25.     rztbshtTabSheet4: TRzTabSheet;
  26.     lstBlack: TcxListBox;
  27.     lstWhite: TcxListBox;
  28.     cxLabel11: TcxLabel;
  29.     cxLabel12: TcxLabel;
  30.     btnAddBlack: TcxButton;
  31.     btnDeleteBlack: TcxButton;
  32.     edtRecvPlaySound: TcxButtonEdit;
  33.     edtRecvRunExe: TcxButtonEdit;
  34.     cxLabel13: TcxLabel;
  35.     cxLabel14: TcxLabel;
  36.     rbAtuoDetect: TcxRadioButton;
  37.     rbMinDetect: TcxRadioButton;
  38.     rbRunDetect: TcxRadioButton;
  39.     rbNeverDetect: TcxRadioButton;
  40.     btnAddWhite: TcxButton;
  41.     btnDeleteWhite: TcxButton;
  42.     btnRuleSet: TcxButton;
  43.     chkReDownload: TcxCheckBox;
  44.     rztbshtTabSheet5: TRzTabSheet;
  45.     cbServerType: TcxImageComboBox;
  46.     cxLabel5: TcxLabel;
  47.     cxLabel8: TcxLabel;
  48.     edtUserName: TcxTextEdit;
  49.     cxLabel9: TcxLabel;
  50.     edtPass: TcxTextEdit;
  51.     edtServerRecv: TcxTextEdit;
  52.     cxlbl1: TcxLabel;
  53.     cxlbl2: TcxLabel;
  54.     edtServerSend: TcxTextEdit;
  55.     cxlbl3: TcxLabel;
  56.     lblEmailSendCount: TcxLabel;
  57.     btnSendClear: TcxButton;
  58.     edtRecvSaveTo: TcxButtonEdit;
  59.     cxlbl5: TcxLabel;
  60.     edtSendSaveTo: TcxButtonEdit;
  61.     chkSendLog: TcxCheckBox;
  62.     chkRecvLog: TcxCheckBox;
  63.     cxlbl6: TcxLabel;
  64.     edtDisplayName: TcxTextEdit;
  65.     lbl1: TcxLabel;
  66.     lbl2: TcxLabel;
  67.     edRecvPort: TcxSpinEdit;
  68.     edSendPort: TcxSpinEdit;
  69.     dlgSave: TRzSaveDialog;
  70.     dlgOpen: TRzOpenDialog;
  71.     lbl3: TcxLabel;
  72.     edt1: TcxButtonEdit;
  73.     actlst1: TActionList;
  74.     actWriteCheckEmailOption: TAction;
  75.     procedure btnRuleSetClick(Sender: TObject);
  76.     procedure btnCancelClick(Sender: TObject);
  77.     procedure edt1PropertiesButtonClick(Sender: TObject;
  78.       AButtonIndex: Integer);
  79.     procedure chkReDownloadClick(Sender: TObject);
  80.     procedure edtRecvPlaySoundPropertiesButtonClick(Sender: TObject;
  81.       AButtonIndex: Integer);
  82.     procedure edtRecvRunExePropertiesButtonClick(Sender: TObject;
  83.       AButtonIndex: Integer);
  84.     procedure btnSendClearClick(Sender: TObject);
  85.     procedure btnRecvClearClick(Sender: TObject);
  86.     procedure btnAddBlackClick(Sender: TObject);
  87.     procedure btnDeleteBlackClick(Sender: TObject);
  88.     procedure btnAddWhiteClick(Sender: TObject);
  89.     procedure btnDeleteWhiteClick(Sender: TObject);
  90.     procedure btnOkClick(Sender: TObject);
  91.     procedure FormCreate(Sender: TObject);
  92.     procedure FormDestroy(Sender: TObject);
  93.     procedure actWriteCheckEmailOptionExecute(Sender: TObject);
  94.     procedure edtRecvSaveToPropertiesButtonClick(Sender: TObject;
  95.       AButtonIndex: Integer);
  96.   private
  97.     { Private declarations }
  98.     FEmailAddr:string;
  99.     FMyxml:TMyXml;
  100.     FAddBlack,
  101.     FDelBlack,
  102.     FAddWhite,
  103.     FDelWhite:TStrings;
  104.     //procedure WriteCheckEmailOption(Option:Integer); 
  105.   public
  106.     { Public declarations }
  107.     procedure LoadDefault(EMailAddr:string);
  108.     procedure ShowPage(index:Integer=0);
  109.   end;
  111. var
  112.   frmEmailBoxProperty: TfrmEmailBoxProperty;
  114. implementation
  116. uses ufrmRule, ufrmMain, uCommon, NativeXml,{$WARNINGS OFF} FileCtrl {$WARNINGS ON} ;
  118. {$R *.dfm}
  120. procedure TfrmEmailBoxProperty.btnRuleSetClick(Sender: TObject);
  121. begin
  122.   with TfrmRule.Create(Application) do
  123.   try
  124.     if ShowModal=mrOk then ufrmMain.frmMain.LoadRules;
  125.   finally
  126.     free;
  127.   end;
  128. end;
  130. procedure TfrmEmailBoxProperty.LoadDefault(EMailAddr:string);
  131. var
  132.   MyXml:TMyXml;
  133.   L:TStringList;
  134.   Node:TXmlNode;
  135.   Str:string;
  136. begin
  137.   FEmailAddr:=EMailAddr;
  138.   myxml:=TMyXml.Create(AppPath+'EmailServers.xml');
  139.   try
  140.     L:=TStringList.Create;
  141.     MyXml.GetAllEmail(FEmailAddr,L,nil,nil);
  142.     lblEmailRecvCount.Caption:=Format('共有%D封邮件',[L.Count]);
  143.     L.Clear;
  144.     MyXml.GetAllSentEmail(FEmailAddr,L);
  145.     lblEmailSendCount.Caption:=Format('共有%D封邮件',[L.Count]);
  146.     L.Free;
  147.     
  148.     Node:=MyXml.FindPop3(FEmailAddr);
  149.     if Node<>nil then
  150.     begin
  151.       chkRecvLog.Checked:=StrToBoolDef(Node.AttributeByName['RecvLog'],True);
  152.       chkSendLog.Checked:=StrToBoolDef(Node.AttributeByName['SendLog'],True);
  153.       chkReDownload.Checked:=StrToBoolDef(Node.AttributeByName['ReDownload'],True);
  155.       case  StrToIntDef(Node.AttributeByName['Detect'],0)  of
  156.         0: rbAtuoDetect.Checked:=True;
  157.         1: rbMinDetect.Checked:=True;
  158.         2: rbRunDetect.Checked:=True;
  159.         3: rbNeverDetect.Checked:=True;
  160.         else ;
  161.       end;
  163.       edtRecvPlaySound.Text:=Node.AttributeByName['newemailwav'];
  164.       edtRecvRunExe.Text:=Node.AttributeByName['newemailexe'];
  165.       edtRecvSaveTo.Text:=Node.AttributeByName['SrcEmailSaveTo'];
  166.       edtSendSaveTo.Text:=Node.AttributeByName['SendEmailSaveTo'];
  167.     end;
  168.              
  169.     Str:=Node.ReadString('pop3server','');
  170.     if CompareText('pop',Copy(Str,1,3))=0 then cbServerType.ItemIndex:=0;
  171.     //add more
  173.     edtUserName.Text:=FEmailAddr;
  174.                        
  175.     edtServerRecv.Text:=Node.ReadString('pop3server','');
  176.     edtServerSend.Text:=TEMailAddress.SMTPEmailSever(FEmailAddr);
  177.     edtPass.Text:=Node.ReadString('pwd','');
  178.     edtDisplayName.Text:=Node.ReadString('displayname','');
  179.     edRecvPort.Value:=StrToInt(Node.ReadString('popPort','110')) ;
  180.     edSendPort.Value:=StrToInt(Node.ReadString('SMTPPort','25')) ;
  181.   finally
  182.     MyXml.Free;
  183.   end;
  185.   //LoadRules;
  186. end;
  188. procedure TfrmEmailBoxProperty.btnCancelClick(Sender: TObject);
  189. begin
  190.   ModalResult:=mrCancel;
  191. end;
  193. procedure TfrmEmailBoxProperty.edt1PropertiesButtonClick(Sender: TObject;
  194.   AButtonIndex: Integer);
  195. begin
  196.   dlgSave.Filter:='XML文件|*.xml';
  197.   dlgSave.Options:=dlgSave.Options-[osoFilesCanBeFolders];
  198.   if dlgSave.Execute then
  199.   begin
  200.     FMyxml:=TMyXml.Create(AppPath+'EmailServers.xml');
  201.     try
  202.       FMyXml.Root.FindNode('Rules').AttributeByName['RulesSaveTo']:=dlgSave.FileName;
  203.     finally
  204.       FMyxml.Free;
  205.     end;
  206.     frmMain.FRuleSaveTo:=dlgSave.FileName;
  207.   end;
  208. end;
  210. procedure TfrmEmailBoxProperty.chkReDownloadClick(Sender: TObject);
  211. begin
  212.   frmMain.FRetryAgain:=chkReDownload.Checked;
  213. end;
  215. procedure TfrmEmailBoxProperty.edtRecvPlaySoundPropertiesButtonClick(
  216.   Sender: TObject; AButtonIndex: Integer);
  217. var
  218.   FMyXml:TMyXml;
  219. begin
  220.   dlgOpen.Filter:='声音文件|*.mp3;*.mp4;*.rm;*.rmvb;*.wav;*.avi;|所有文件|*.*';
  221.   if dlgOpen.Execute then
  222.   begin
  223.     FMyxml:=TMyXml.Create(AppPath+'EmailServers.xml');
  224.     try
  225.       if FMyXml.FindPop3(FEmailAddr)<>nil then
  226.         FMyXml.FindPop3(FEmailAddr).AttributeByName['newemailwav']  :=dlgSave.FileName;
  227.     finally
  228.       FMyxml.Free;
  229.     end;
  230.     frmMain.FEmailArrivedPlaySound:=dlgOpen.FileName;
  231.   end;
  232. end;
  234. procedure TfrmEmailBoxProperty.edtRecvRunExePropertiesButtonClick(
  235.   Sender: TObject; AButtonIndex: Integer);
  236. var
  237.   FMyXml:TMyXml;
  238. begin
  239.   dlgOpen.Filter:='可执行文件|*.exe;*.Bat';
  240.   if dlgOpen.Execute then
  241.   begin
  242.     FMyxml:=TMyXml.Create(AppPath+'EmailServers.xml');
  243.     try
  244.       if FMyXml.FindPop3(FEmailAddr)<>nil then
  245.         FMyXml.FindPop3(FEmailAddr).AttributeByName['newemailexe']:=dlgSave.FileName;
  246.     finally
  247.       FMyxml.Free;
  248.     end;
  249.     frmMain.FEmailArrivedPlaySound:=dlgOpen.FileName;
  250.   end;
  251. end;
  253. procedure TfrmEmailBoxProperty.btnSendClearClick(Sender: TObject);  //清空发件箱
  254. var
  255.   L:TStrings;
  256.   I:Integer;
  257. begin
  258.   FMyxml:=TMyXml.Create(AppPath+'EmailServers.xml');
  259.   try
  260.     L:=TStringList.Create;
  261.     try
  262.       FMyxml.GetAllSentEmail(FEmailAddr,L);
  263.       for i:=0 to L.Count-1 do
  264.         if FileExists(L[I]) then DeleteFile(L[I]);
  266.       FMyxml.DeleteAllSentEmail(FEmailAddr);
  267.     finally
  268.       L.Free;
  269.     end;
  270.   finally
  271.     FMyxml.free;
  272.   end;
  273. end;
  275. procedure TfrmEmailBoxProperty.btnRecvClearClick(Sender: TObject); //清空收件箱
  276. var
  277.   L:TStrings;
  278.   I:Integer;
  279. begin
  280.   FMyxml:=TMyXml.Create(AppPath+'EmailServers.xml');
  281.   try
  282.     L:=TStringList.Create;
  283.     try
  284.       FMyxml.GetAllEmail(FEmailAddr,L,nil,nil);
  285.       for i:=0 to L.Count-1 do
  286.         if FileExists(L[I]) then DeleteFile(L[I]);
  288.       FMyxml.DeleteAllEmail(FEmailAddr);
  289.     finally
  290.       L.Free;
  291.     end;
  292.   finally
  293.     FMyxml.free;
  294.   end;
  295. end;
  297. procedure TfrmEmailBoxProperty.btnAddBlackClick(Sender: TObject);
  298. var
  299.   account:string;
  300. begin
  301.   account:=Dialogs.InputBox('添加黑名单','请输入黑名单成员的Email账号：','');
  302.   //if  trim(account)='' then Exit;
  303.   if not TEMailAddress.IsEmail(account) then
  304.   begin
  305.     MsgBoxError('Email账号不合法.合法的账号格式是：username@server');
  306.     Exit;
  307.   end;
  308.   lstBlack.Items.Add(Trim(account));
  309.   FAddBlack.Add(account);
  310. end;
  312. procedure TfrmEmailBoxProperty.btnDeleteBlackClick(Sender: TObject);
  313. begin
  314.   FDelBlack.Add(lstBlack.Items[lstBlack.ItemIndex])   ;
  315.   lstBlack.Items.Delete(lstBlack.ItemIndex);
  316. end;
  318. procedure TfrmEmailBoxProperty.btnAddWhiteClick(Sender: TObject);
  319. var
  320.   account:string;
  321. begin
  322.   account:=Dialogs.InputBox('添加白名单','请输入白名单成员的Email账号：','');
  323.   //if  trim(account)='' then Exit;
  324.   if not TEMailAddress.IsEmail(account) then
  325.   begin
  326.     MsgBoxError('Email账号不合法.合法的账号格式是：username@server');
  327.     Exit;
  328.   end;
  329.   lstWhite.Items.Add(Trim(account));
  330.   FAddWhite.Add(account);
  331. end;
  333. procedure TfrmEmailBoxProperty.btnDeleteWhiteClick(Sender: TObject);
  334. begin
  335.   FDelWhite.Add(lstWhite.Items[lstWhite.ItemIndex]);
  336.   lstWhite.Items.Delete(lstWhite.ItemIndex);
  337. end;
  339. procedure TfrmEmailBoxProperty.btnOkClick(Sender: TObject);
  340. var
  341.   MyXml:TMyXml;
  342. begin
  343.   MyXml:=TMyXml.Create(AppPath+'EmailServers.xml');
  344.   try
  345.     MyXml.AddBlackList(FAddBlack);
  346.     MyXml.AddWhiteList(FAddWhite);
  347.     MyXml.DeleteBlackList(FDelBlack);
  348.     MyXml.DeleteWhiteList(FDelWhite);
  350.     frmMain.FBlackList.Assign(lstBlack.Items);
  351.     frmMain.FWhiteList.Assign(lstWhite.Items);
  352.   finally
  353.     MyXml.Free;
  354.   end;
  356.   ModalResult:=mrOk;
  357. end;
  359. procedure TfrmEmailBoxProperty.FormCreate(Sender: TObject);
  360. var
  361.   MyXml:TMyXml;
  362. begin
  363.   FAddBlack:=THashedStringList.Create;
  364.   FDelBlack:=THashedStringList.Create;
  365.   FAddWhite:=THashedStringList.Create;
  366.   FDelWhite:=THashedStringList.Create;
  368.   MyXml:=TMyXml.Create(AppPath+'EmailServers.xml');
  369.   try
  370.     MyXml.GetBlackList(lstBlack.Items);
  371.     MyXml.GetWhiteList(lstWhite.Items);
  372.   finally
  373.     MyXml.Free;
  374.   end;
  375. end;
  377. procedure TfrmEmailBoxProperty.FormDestroy(Sender: TObject);
  378. begin
  379.   FAddBlack.Free;
  380.   FDelBlack.Free;
  381.   FAddWhite.Free;
  382.   FDelWhite.Free;
  383. end;
  385. procedure TfrmEmailBoxProperty.ShowPage(index: Integer);
  386. begin
  387.   RzPageControl1.TabIndex:=index;
  388. end;
  390. procedure TfrmEmailBoxProperty.actWriteCheckEmailOptionExecute(
  391.   Sender: TObject);
  392. var
  393.   myXml:TMyXml;
  394. begin
  395.   MyXml:=TMyXml.Create(AppPath+'EmailServers.xml');
  396.   try
  397.     MyXml.WriteEmailDetect(FEmailAddr,TcxRadioButton(sender).Tag);
  398.   finally
  399.     MyXml.Free;
  400.   end;
  401. end;
  403. procedure TfrmEmailBoxProperty.edtRecvSaveToPropertiesButtonClick(
  404.   Sender: TObject; AButtonIndex: Integer);
  405. var
  406.   Dir:String;
  407.   Xml:TAppXml;
  408. begin
  409.   if SelectDirectory('',AppPath,Dir) then
  410.   begin
  411.     Xml:=TAppXml.Create;
  412.     try
  413.       Xml.SetEmailSavePath(Dir);
  414.     finally
  415.       Xml.free;
  416.     end;
  417.   end;
  418. end;
  420. end.