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

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

Email服务器

开发平台：

Delphi

ufrmMain.~pas：源码内容
  1. unit ufrmMain;
  3. interface
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs,uSendMail, Menus, ExtCtrls, ComCtrls,
  8.   ImgList,dxBarExtItems, dxBar, cxClasses, cxControls, cxSplitter,
  9.   cxContainer, cxTreeView, msxmldom, JvExControls,
  10.   JvNavigationPane, JvExExtCtrls, Mail2000, cxGraphics,
  11.   cxCustomData, cxStyles, cxTL, cxInplaceContainer,uRecvEmail,
  12.   cxTextEdit, cxCheckBox, OleServer,
  13.   ActnList, cxDataStorage, cxEdit, cxGridCustomTableView,
  14.   cxGridTableView, cxGridCustomView, DB, cxGridLevel, cxGrid,
  15.   cxDBData, cxGridDBTableView, OleCtrls, OALib_TLB, JvComponentBase,
  16.   JvCipher, RzTray, cxGroupBox, CommCtrl, cxLabel, cxCalendar, SHDocVw, IniFiles,
  17.   cxImage,uRulerMgr,idSMTP, uCheckEmail, cxFilter, cxData, uHtmlEdit,
  18.   dxStatusBar, dxSkinsCore, dxSkinBlack, dxSkinBlue, dxSkinCaramel,
  19.   dxSkinCoffee, {dxSkinDarkRoom,} dxSkinDarkSide, {dxSkinFoggy,}
  20.   dxSkinGlassOceans, dxSkiniMaginary, dxSkinLilian, dxSkinLiquidSky,
  21.   dxSkinLondonLiquidSky, dxSkinMcSkin, dxSkinMoneyTwins,
  22.   dxSkinOffice2007Black, dxSkinOffice2007Blue, dxSkinOffice2007Green,
  23.   dxSkinOffice2007Pink, dxSkinOffice2007Silver, dxSkinPumpkin, {dxSkinSeven,}
  24.   {dxSkinSharp,} dxSkinSilver, {dxSkinSpringTime,} dxSkinStardust,
  25.   dxSkinSummer2008, dxSkinsDefaultPainters, dxSkinValentine,
  26.   dxSkinXmas2008Blue, {cxTLdxBarBuiltInMenu,} dxSkinscxPCPainter,
  27.   cxLookAndFeelPainters, dxSkinsdxBarPainter, OutlookXP;
  29. type
  31.   TfrmMain = class(TForm)
  32.     dxBarManager1: TdxBarManager;
  33.     dxBarManager1Bar1: TdxBar;
  34.     dxBarManager1Bar2: TdxBar;
  35.     dxBarManager1Bar5: TdxBar;
  36.     dxBarSubItem1: TdxBarSubItem;
  37.     dxBarSubItem2: TdxBarSubItem;
  38.     dxBarSubItem3: TdxBarSubItem;
  39.     dxBarSubItem4: TdxBarSubItem;
  40.     dxBarSubItem5: TdxBarSubItem;
  41.     dxBarSubItem6: TdxBarSubItem;
  42.     dxBarButton1: TdxBarLargeButton;
  43.     dxBarButton3: TdxBarLargeButton;
  44.     dxBarButton4: TdxBarLargeButton;
  45.     dxBarButton5: TdxBarLargeButton;
  46.     dxBarButton6: TdxBarLargeButton;
  47.     dxBarButton7: TdxBarLargeButton;
  48.     dxBarButton8: TdxBarLargeButton;
  49.     dxBarButton9: TdxBarLargeButton;
  50.     dxBarButton10: TdxBarLargeButton;
  51.     dxBarButton11: TdxBarLargeButton;
  52.     dxBarLargeButton1: TdxBarLargeButton;
  53.     btnSendAll: TdxBarLargeButton;
  54.     dxBarLargeButton3: TdxBarLargeButton;
  55.     dxBarLargeButton4: TdxBarLargeButton;
  56.     btnRecp: TdxBarLargeButton;
  57.     dxBarLargeButton6: TdxBarLargeButton;
  58.     dxBarLargeButton7: TdxBarLargeButton;
  59.     dxBarButton15: TdxBarButton;
  60.     dxBarColorCombo1: TdxBarColorCombo;
  61.     dxBarFontNameCombo1: TdxBarFontNameCombo;
  62.     dxBarDateCombo1: TdxBarDateCombo;
  63.     dxBarSpinEdit1: TdxBarSpinEdit;
  64.     BarProgress: TdxBarProgressItem;
  65.     lblProgress: TdxBarStatic;
  66.     dxBarLargeButton9: TdxBarLargeButton;
  67.     dxBarLargeButton10: TdxBarLargeButton;
  68.     btnNewWindow: TdxBarLargeButton;
  69.     btnArrangeAll: TdxBarLargeButton;
  70.     btnSplit: TdxBarLargeButton;
  71.     btnNew: TdxBarLargeButton;
  72.     btnOpen: TdxBarLargeButton;
  73.     btnSendAndRecv: TdxBarLargeButton;
  74.     btnClose: TdxBarLargeButton;
  75.     btnPrint: TdxBarLargeButton;
  76.     btnSaveAs: TdxBarLargeButton;
  77.     btnSaveAll: TdxBarLargeButton;
  78.     dxBarSubItem7: TdxBarSubItem;
  79.     dxBarLargeButton8: TdxBarLargeButton;
  80.     dxBarButton2: TdxBarButton;
  81.     dxBarButton12: TdxBarButton;
  82.     dxbrbtn1: TdxBarButton;
  83.     dxbrbtn2: TdxBarButton;
  84.     Panel1: TPanel;
  85.     cxSplitter1: TcxSplitter;
  86.     Panel2: TPanel;
  87.     Panel3: TPanel;
  88.     PnlAddr: TPanel;
  89.     il1: TImageList;
  90.     JvNavPaneToolPanel1: TJvNavPaneToolPanel;
  91.     JvNavPaneToolPanel3: TJvNavPaneToolPanel;
  92.     Panel4: TPanel;
  93.     Panel5: TPanel;
  94.     cxSplitter2: TcxSplitter;
  95.     cxSplitter3: TcxSplitter;
  96.     lblMsgProgress: TdxBarStatic;
  97.     BarProgressMsg: TdxBarProgressItem;
  98.     lblError: TdxBarStatic;
  99.     cxStyleRepository1: TcxStyleRepository;
  100.     cxStyle1: TcxStyle;
  101.     dxBarButton13: TdxBarButton;
  102.     pm1: TdxBarPopupMenu;
  103.     dxBarSubItem8: TdxBarSubItem;
  104.     dxBarButton14: TdxBarButton;
  105.     dxBarButton16: TdxBarButton;
  106.     dxBarButton17: TdxBarButton;
  107.     dxBarButton18: TdxBarButton;
  108.     dxBarButton19: TdxBarButton;
  109.     dxbrbtn3: TdxBarButton;
  110.     dxbrbtn4: TdxBarButton;
  111.     dxbrbtn5: TdxBarButton;
  112.     dxbrbtn6: TdxBarButton;
  113.     dxbrbtn7: TdxBarButton;
  114.     dxbrbtn8: TdxBarButton;
  115.     dxbrbtn9: TdxBarButton;
  116.     dxbrbtn10: TdxBarButton;
  117.     dxbrbtn11: TdxBarButton;
  118.     dxBarSpinEdit2: TdxBarSpinEdit;
  119.     dxBarToolbarsListItem1: TdxBarToolbarsListItem;
  120.     dxbrtlbrslstm1: TdxBarToolbarsListItem;
  121.     dxbrtlbrslstm2: TdxBarToolbarsListItem;
  122.     dxbrtlbrslstm3: TdxBarToolbarsListItem;
  123.     ActionList1: TActionList;
  124.     actRecvCur: TAction;
  125.     actRecvAll: TAction;
  126.     actRecvThenDelete: TAction;
  127.     dxBarToolbarsListItem2: TdxBarToolbarsListItem;
  128.     dxBarControlContainerItem1: TdxBarControlContainerItem;
  129.     dxbrbtn12: TdxBarButton;
  130.     dxbrlrgbtn1: TdxBarLargeButton;
  131.     dxBarButton20: TdxBarButton;
  132.     btnRecpOne: TdxBarButton;
  133.     dxbrbtn14: TdxBarButton;
  134.     dxBarButton21: TdxBarButton;
  135.     lblTotal: TdxBarStatic;
  136.     cxGrid1Level1: TcxGridLevel;
  137.     cxGrid1: TcxGrid;
  138.     tvTableView: TcxGridTableView;
  139.     gtvColReaded: TcxGridColumn;
  140.     gtvColSender: TcxGridColumn;
  141.     gtvColSubject: TcxGridColumn;
  142.     gtvColDate: TcxGridColumn;
  143.     gtvColSize: TcxGridColumn;
  144.     gtvColAttch: TcxGridColumn;
  145.     actNewEmail: TAction;
  146.     actAddrBook: TAction;
  147.     ltAddr: TcxTreeList;
  148.     cxtrlstclmnAddrcxTreeListColumn1: TcxTreeListColumn;
  149.     cxtrlstclmnAddrcxTreeListColumn2: TcxTreeListColumn;
  150.     cxtrlstclmnAddrcxTreeListColumn3: TcxTreeListColumn;
  151.     tvEMail: TcxTreeView;
  152.     dxbrbtn15: TdxBarButton;
  153.     actSuspend: TAction;
  154.     actStop: TAction;
  155.     dxbrbtn16: TdxBarButton;
  156.     TrayIcon: TRzTrayIcon;
  157.     cxgrpbx1: TcxGroupBox;
  158.     pnlAttch: TPanel;
  159.     gtvColContentFilename: TcxGridColumn;
  160.     lv1: TListView;
  161.     gtvColUIDL: TcxGridColumn;
  162.     gtvColMyAddr: TcxGridColumn;
  163.     gtvColAttchFullName: TcxGridColumn;
  164.     btnTurn: TdxBarLargeButton;
  165.     btnDeleteEmail: TdxBarLargeButton;
  166.     dxbrlrgbtn4: TdxBarLargeButton;
  167.     dxbrlrgbtn5: TdxBarLargeButton;
  168.     pm2: TdxBarPopupMenu;
  169.     dxbrbtn17: TdxBarButton;
  170.     dxbrbtn18: TdxBarButton;
  171.     btnUnRead: TdxBarButton;
  172.     actReply: TAction;
  173.     actResend: TAction;
  174.     actDeleteCurEmail: TAction;
  175.     dxbrbtn21: TdxBarButton;
  176.     dxbrbtn22: TdxBarButton;
  177.     dxbrbtn23: TdxBarButton;
  178.     actSendPendingEmail: TAction;
  179.     actRename: TAction;
  180.     actDeletePop: TAction;
  181.     dxbrbtn24: TdxBarButton;
  182.     dxbrbtn25: TdxBarButton;
  183.     dxbrbtn26: TdxBarButton;
  184.     dxbrbtn27: TdxBarButton;
  185.     dxbrbtn28: TdxBarButton;
  186.     actProperty: TAction;
  187.     dxbrbtn29: TdxBarButton;
  188.     actNewAccunt: TAction;
  189.     cxstyl1: TcxStyle;
  190.     cxstyl2: TcxStyle;
  191.     cxstyl3: TcxStyle;
  192.     cxstyl4: TcxStyle;
  193.     cxstyl5: TcxStyle;
  194.     imgFlag: TImage;
  195.     imgRecyle: TImage;
  196.     imgBoxNotOpen: TImage;
  197.     imgBoxOpen: TImage;
  198.     imgAttch: TImage;
  199.     gtvColUnUsed: TcxGridColumn;
  200.     tmrAttamp: TTimer;
  201.     btn1: TdxBarLargeButton;
  202.     btn2: TdxBarLargeButton;
  203.     pmLeft: TdxBarPopupMenu;
  204.     pmRight: TdxBarPopupMenu;
  205.     dxbrbtnAdd: TdxBarButton;
  206.     dxbrbtn31: TdxBarButton;
  207.     dxbrbtnEdit: TdxBarButton;
  208.     dxbrbtnDel: TdxBarButton;
  209.     dxbrbtn34: TdxBarButton;
  210.     dxbrbtn35: TdxBarButton;
  211.     dxbrbtn36: TdxBarButton;
  212.     dxbrbtn37: TdxBarButton;
  213.     dxbrbtn38: TdxBarButton;
  214.     dxbrbtn39: TdxBarButton;
  215.     dxbrbtn40: TdxBarButton;
  216.     dxbrbtn41: TdxBarButton;
  217.     tmrEmailAwake: TTimer;
  218.     btnDetectEmail: TdxBarLargeButton;
  219.     btn4: TdxBarLargeButton;
  220.     lblDetect: TdxBarStatic;
  221.     btnCleanRecvs: TdxBarButton;
  222.     btnCleanAttamp: TdxBarButton;
  223.     btnCleanSents: TdxBarButton;
  224.     btnCleanDraft: TdxBarButton;
  225.     actCleanRecvs: TAction;
  226.     actCleanSents: TAction;
  227.     actCleanDraft: TAction;
  228.     actCleanAttamp: TAction;
  229.     btnDeleteOneEmail: TdxBarButton;
  230.     btn3: TdxBarButton;
  231.     actTurn: TAction;
  232.     HtmlEdit: THtmlEdit;
  233.     btn5: TdxBarButton;
  234.     cxstylrpstry1: TcxStyleRepository;
  235.     cxstyl6: TcxStyle;
  236.     cxstyl7: TcxStyle;
  237.     cxstyl8: TcxStyle;
  238.     btn6: TdxBarButton;
  239.     btn7: TdxBarButton;
  240.     btn8: TdxBarButton;
  241.     btn9: TdxBarButton;
  242.     btn10: TdxBarButton;
  243.     btn11: TdxBarButton;
  244.     btn12: TdxBarButton;
  245.     btn13: TdxBarButton;
  246.     btn14: TdxBarButton;
  247.     btn15: TdxBarButton;
  248.     actViewEmail: TAction;
  249.     dxbrsbtm1: TdxBarSubItem;
  250.     pm3: TdxBarPopupMenu;
  251.     btn16: TdxBarButton;
  252.     btn17: TdxBarButton;
  253.     btn18: TdxBarButton;
  254.     btn19: TdxBarButton;
  255.     pm4: TdxBarPopupMenu;
  256.     btn20: TdxBarButton;
  257.     btn21: TdxBarButton;
  258.     btn22: TdxBarButton;
  259.     lbl1: TdxBarStatic;
  260.     dxbrprgrstm1: TdxBarProgressItem;
  261.     dxbrprgrstm2: TdxBarProgressItem;
  262.     dxbrpmn1: TdxBarPopupMenu;
  263.     dxBarButton22: TdxBarButton;
  264.     dxBarButton23: TdxBarButton;
  265.     dxBarButton24: TdxBarButton;
  266.     dxBarButton25: TdxBarButton;
  267.     dxBarButton26: TdxBarButton;
  268.     dxBarButton27: TdxBarButton;
  269.     ol1: TContactItem;
  270.     dxbrbtn13: TdxBarButton;
  271.     procedure JvNavPaneToolPanel1ButtonClick(Sender: TObject;
  272.       Index: Integer);
  273.     procedure FormCreate(Sender: TObject);
  274.     procedure tvEMailDeletion(Sender: TObject; Node: TTreeNode);
  275.     procedure popEmailProgress(Sender: TObject; Total, Current: Integer);
  276.     procedure MSGProgress(Sender: TObject; Total, Current: Integer);
  277.     procedure FormDestroy(Sender: TObject);
  278.     procedure actRecvAllExecute(Sender: TObject);
  279.     procedure actRecvThenDeleteExecute(Sender: TObject);
  280.     procedure actRecvCurExecute(Sender: TObject);
  281.     procedure actNewEmailExecute(Sender: TObject);
  282.     procedure actAddrBookExecute(Sender: TObject);
  283.     procedure actSuspendExecute(Sender: TObject);
  284.     procedure actStopExecute(Sender: TObject);
  285.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  286.     procedure tvEMailClick(Sender: TObject);
  287.     procedure lv1DblClick(Sender: TObject);
  288.     procedure gtvColReadedGetDisplayText(
  289.       Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord;
  290.       var AText: String);
  291.     procedure actDeleteCurEmailExecute(Sender: TObject);
  292.     procedure actSendPendingEmailExecute(Sender: TObject);
  293.     procedure dxBarLargeButton9Click(Sender: TObject);
  294.     procedure actRenameExecute(Sender: TObject);
  295.     procedure tvEMailExit(Sender: TObject);
  296.     procedure tvEMailEdited(Sender: TObject; Node: TTreeNode;
  297.       var S: String);
  298.     procedure tvEMailEditing(Sender: TObject; Node: TTreeNode;
  299.       var AllowEdit: Boolean);
  300.     procedure actDeletePopExecute(Sender: TObject);
  301.     procedure btnSendAndRecvClick(Sender: TObject);
  302.     procedure FormShow(Sender: TObject);
  303.     procedure actNewAccuntExecute(Sender: TObject);
  304.     procedure tvEMailMouseUp(Sender: TObject; Button: TMouseButton;
  305.       Shift: TShiftState; X, Y: Integer);
  306.     procedure tvTableViewMouseUp(Sender: TObject; Button: TMouseButton;
  307.       Shift: TShiftState; X, Y: Integer);
  308.     procedure actPropertyExecute(Sender: TObject);
  309.     procedure tmrAttampTimer(Sender: TObject);
  310.     procedure TrayIconLButtonDown(Sender: TObject);
  311.     procedure TrayIconRButtonDown(Sender: TObject);
  312.     procedure dxbrbtn34Click(Sender: TObject);
  313.     procedure dxbrbtn37Click(Sender: TObject);
  314.     procedure dxbrbtn39Click(Sender: TObject);
  315.     procedure btn1Click(Sender: TObject);
  316.     procedure dxBarButton3Click(Sender: TObject);
  317.     procedure dxbrbtn41Click(Sender: TObject);
  318.     procedure TrayIconMinimizeApp(Sender: TObject);
  319.     procedure TrayIconRestoreApp(Sender: TObject);
  320.     procedure btnDetectEmailClick(Sender: TObject);
  321.     procedure dxbrbtn35Click(Sender: TObject);
  322.     procedure btn4Click(Sender: TObject);
  323.     procedure dxbrlrgbtn4Click(Sender: TObject);
  324.     procedure dxbrbtn18Click(Sender: TObject);
  325.     procedure actCleanRecvsExecute(Sender: TObject);
  326.     procedure btnCleanSentsClick(Sender: TObject);
  327.     procedure btnCleanDraftClick(Sender: TObject);
  328.     procedure btnCleanAttampClick(Sender: TObject);
  329.     procedure btnUnReadClick(Sender: TObject);
  330.     procedure actReplyExecute(Sender: TObject);
  331.     procedure actTurnExecute(Sender: TObject);
  332.     procedure tvTableViewFocusedRecordChanged(
  333.       Sender: TcxCustomGridTableView; APrevFocusedRecord,
  334.       AFocusedRecord: TcxCustomGridRecord;
  335.       ANewItemRecordFocusingChanged: Boolean);
  336.     procedure tvTableViewCellDblClick(Sender: TcxCustomGridTableView;
  337.       ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
  338.       AShift: TShiftState; var AHandled: Boolean);
  339.     procedure lv1Deletion(Sender: TObject; Item: TListItem);
  340.     procedure actCleanSentsExecute(Sender: TObject);
  341.     procedure actCleanDraftExecute(Sender: TObject);
  342.     procedure actCleanAttampExecute(Sender: TObject);
  343.     procedure JvNavPaneToolPanel3Close(Sender: TObject);
  344.     procedure btn12Click(Sender: TObject);
  345.     procedure tmrEmailAwakeTimer(Sender: TObject);
  346.     procedure actViewEmailExecute(Sender: TObject);
  347.     procedure btn2Click(Sender: TObject);
  348.     procedure btn9Click(Sender: TObject);
  349.     procedure btn10Click(Sender: TObject);
  350.     procedure dxBarButton2Click(Sender: TObject);
  351.     procedure btnSaveAllClick(Sender: TObject);
  352.     procedure btn17Click(Sender: TObject);
  353.     procedure dxBarButton22Click(Sender: TObject);
  354.     procedure dxBarButton23Click(Sender: TObject);
  355.     procedure dxBarButton24Click(Sender: TObject);
  356.     procedure dxBarButton27Click(Sender: TObject);
  357.     procedure ltAddrDblClick(Sender: TObject);
  358.     procedure dxbrbtnAddClick(Sender: TObject);
  359.     procedure dxbrbtnDelClick(Sender: TObject);
  360.     procedure dxbrbtnEditClick(Sender: TObject);
  361.     procedure dxBarLargeButton10Click(Sender: TObject);
  362.     procedure dxBarButton25Click(Sender: TObject);
  363.     procedure dxBarButton12Click(Sender: TObject);
  364.   private
  365.     { Private declarations }
  366.     //FEmailCount:Integer;
  367.     //FCurrent:Integer;
  368.     FEmailChecker:TCheckEmail;  //检查新邮件
  369.     FShowEmailSending:Boolean; //是否正在显示 未发邮件表格
  371.     FEmailPropertyPageIndex:Integer;
  372.     FUserName,
  373.     FpopServer,
  374.     FPwd:string;
  376.     FRecvEMail:TRecvEmail;  //pop3
  377.     FFilter:TRuleItems;   //过滤设置
  379.     FSendEmailBox:boolean;
  380.     FOldNodeText:string;
  382.     FMutex:THandle;
  383.     FUIDLList:THashedStringList;  //保存已经接收的邮件的uidl
  384.     FNewEmailUIDLList:THashedStringList; //保存新邮件UIDL
  386.     procedure MyOnRecvEMailProgress(Sender: TObject; Total, Current: Integer) ;
  387.     procedure MyOnRecvMsgProgress(Sender: TObject; Total, Current: Integer) ;
  388.     procedure OnError(Sender:TObject;ErrMsg:string);
  389.     procedure OnRetrieveed(sender: TObject;CurNum,Total:Integer;UIDL:String);
  390.     procedure OnRecvAttch(sender:TObject; FileName:string;FileStream:TMemoryStream;CurNum,Total:Integer);
  391.     procedure RecvComplete(Sender:TObject);
  392.     procedure OnGetUIDL(Sender:TObject;uidl:String;var Handle:Boolean);
  393.     procedure OnFilter(Sender:TObject;Action:TRuleAction;EmailSubject:string;EmailFrom:string;var DeleteIt:Boolean;var Ignore:Boolean);
  394.     procedure BeginRecv(Sender:TObject);
  395.     procedure EndRecv(Sender:TObject);
  396.     procedure OnTerminate(Sender:TObject);
  399.     procedure OnOneSend(Sender:TObject;Email:TEmailInfo);
  400.     procedure OnOneSendEnd(Sender:TObject;Email:TEmailInfo);
  401.     
  402.     procedure DetectingEmail(Sender:TObject;Runing:Boolean) ;
  404.     procedure OnNewEmailArrive(Sender:TObject;NewEmailUIDLs:TStrings);
  406.     procedure MultiThreadSendComplete(Sender:TObject);
  407.     procedure  MultiThreadSendError(Sender:TObject;Email:TEmailInfo;ErrMsg:string);
  409.     procedure AttachEvent;
  410.     procedure GetUIDLS;
  412.     function GetSeletedEmailAddr:string;
  414.     procedure LoadDefaultSavePath;
  415.   protected
  416.     procedure WndProc(var Message: TMessage); override;
  418.     procedure AddFileRelation(lv: TListView; filename: string);
  419.     procedure MegerOpenIcon(var bitmap:TBitmap); //合并2张icon图片
  420.     procedure MegerCloseIcon(var bitmap:TBitmap); //合并2张icon图片
  421.   public
  422.     { Public declarations }
  423.     FRuleSaveTo,
  424.     FEmailSaveTo,
  425.     FAttchSaveTo:string;
  427.     FRetryAgain:Boolean; //是否重复接收
  428.     FEmailArrivedPlaySound:string; // 新邮件到来播放的声音文件路径
  430.     FBlackList,
  431.     FWhiteList:TStrings; //黑白名单
  433.     FEmailDetect:TEmailDetectOption;
  435.     EmailSenderMgr:TEmailSenderMgr;
  437.     procedure GetCurPop3EMail(delete:Boolean=False);
  438.     procedure GetAllPop3EMail(delete:Boolean=False);
  439.     procedure LoadEmails(TreeView:TcxTreeView);
  440.     procedure LoadAddrs;
  442.     procedure ClearTableView(tv:TcxGridTableView);
  443.     procedure LoadRecvEmail;
  444.     procedure LoadSendEmail;
  445.     procedure LoadDraft;
  446.     procedure LoadAttamp;
  447.     procedure LoadRules;
  448.     procedure LoadFromFile(EmailAddr:string;Files:TStringList);
  449.     procedure SendEmailFromFile(FilePath:string);
  450.     procedure CreateDirs;
  452.     procedure LoadSending;
  453.     procedure LoadContact;
  454.   end;
  456. var
  457.   frmMain: TfrmMain;
  459. implementation
  461. uses ufrmNewSMTP, NativeXml, uCommon, ufrmCloseTip,ShellApi, ActiveX,
  462.   uMyXml, FMTips, ufrmEmailBoxProperty, UEmailFile, ufrmRule,
  463.   ufrmFilterPopTip, ufrmAttchMgr, uBaseEditorForm, ufrmWriteEmail,
  464.   ufrmViewEmail, ufrmAwake, uEmailAwake, ufrmEmailAwaked, ufrmSingnals,ufrmAddr,ufrmAbout,ComObj;
  466. {$R *.dfm}
  468. procedure TfrmMain.MegerCloseIcon(var bitmap:TBitmap);
  469. begin
  470.   bitmap.Canvas.Draw(0,0,imgBoxNotOpen.Picture.Graphic);
  471.   bitmap.Canvas.Draw(imgBoxOpen.Width,0,imgAttch.Picture.Graphic);
  472. end;
  474. procedure TfrmMain.MegerOpenIcon(var bitmap:TBitmap); //合并2张icon图片
  475. begin
  476.   bitmap.Canvas.Draw(0,0,imgBoxOpen.Picture.Graphic);
  477.   bitmap.Canvas.Draw(imgBoxOpen.Width,0,imgAttch.Picture.Graphic);
  478. end;
  480. procedure TfrmMain.JvNavPaneToolPanel1ButtonClick(Sender: TObject;
  481.   Index: Integer);
  482. begin
  483.   PnlAddr.Visible:=not PnlAddr.Visible
  484. end;
  486. procedure TfrmMain.LoadAddrs;
  487. {var
  488.   xml:TMyXml;
  489.   Lst:TList;
  490.   I:Integer;   }
  491. begin
  492.  { xml:=TMyXml.Create(AppPath+'EmailServers.xml');
  493.   try
  494.     lst:=TList.Create;
  495.     try
  496.       if  xml.Root.FindNode('emails')=nil then Exit;
  497.       Lst.Clear;
  498.       xml.Root.FindNode('emails').NodesByName('email',lst);
  499.       for I:=0 to Lst.Count-1 do
  500.       begin
  501.         with ltAddr.Add do
  502.         begin
  503.           Values[0]:=False;
  504.           Values[1]:=TXmlNode(Lst[I]).ReadString('displayname');
  505.           Values[2]:=TXmlNode(Lst[I]).ReadString('addr');
  506.         end;
  507.       end;
  508.     finally
  509.       Lst.Free;
  510.     end;
  511.   finally
  512.     xml.Free;
  513.   end;   }
  514. end;
  516. procedure TfrmMain.LoadEmails(TreeView:TcxTreeView);
  517. var
  518.   xml:TMyXml;
  519.   Lst:TList;
  520.   tvNode:TTreeNode;
  521.   info:PPopInfo;
  522.   I:Integer;
  523. begin
  524.   xml:=TMyXml.Create(AppPath+'EmailServers.xml');
  525.   try
  526.     if  (xml.Root.FindNode('pop3s')=nil)  then Exit;
  528.     //加载所有的pop3服务器到treeview
  529.     lst:=TList.Create;
  530.     try
  531.       xml.Root.FindNode('pop3s').NodesByName('pop3',lst);
  532.       TreeView.Items.Clear;
  533.       for I:=0 to Lst.Count-1 do
  534.       begin
  535.         tvNode:= TreeView.Items.Add(nil,TXmlNode(Lst[I]).ReadString('displayname'));
  536.         tvNode.ImageIndex:=109;
  537.         tvNode.SelectedIndex:=36;
  538.         tvNode.StateIndex:=104;
  540.         New(info);
  541.         ZeroMemory(info,SizeOf(TPopInfo));
  542.         info.EMailAddr:=TXmlNode(Lst[I]).ReadString('emailaddr');
  543.         info.pwd:=TXmlNode(Lst[I]).ReadString('pwd');
  544.         info.saveto:= TXmlNode(Lst[I]).ReadString('emailsaveto');
  545.         info.pop3Server:=  TXmlNode(Lst[I]).ReadString('pop3server');
  546.         tvnode.Data:=info;
  548.         with TreeView.Items.AddChild(tvNode,'收件箱')  do
  549.         begin
  550.           ImageIndex:=109;
  551.           SelectedIndex:=36;
  552.           StateIndex:=104;
  553.         end;
  555.         with TreeView.Items.AddChild(tvNode,'已发邮件') do
  556.         begin
  557.           ImageIndex:=109;
  558.           SelectedIndex:=36;
  559.           StateIndex:=104;
  560.         end;
  562.         with TreeView.Items.AddChild(tvNode,'发件箱') do
  563.         begin
  564.           ImageIndex:=109;
  565.           SelectedIndex:=36;
  566.           StateIndex:=104;
  567.         end;
  569.         with TreeView.Items.AddChild(tvNode,'草稿箱')do
  570.         begin
  571.           ImageIndex:=52;
  572.           SelectedIndex:=48;
  573.           StateIndex:=48;
  574.         end;
  576.         with TreeView.Items.AddChild(tvNode,'定时邮件') do
  577.         begin
  578.           ImageIndex:=86;
  579.           SelectedIndex:=87;
  580.           StateIndex:=87;
  581.         end;
  582.       end;
  583.     finally
  584.       Lst.Free;
  585.     end;
  586.   finally
  587.     xml.Free;
  588.   end;
  589. end;
  591. procedure TfrmMain.FormCreate(Sender: TObject);
  592. var
  593.   Xml:TAppXml;
  594. begin
  595.   //备份xml文件
  596.   DeleteFile(PAnsiChar(ExtractFilePath(ParamStr(0))+'EmailServers_Backup.xml')) ;
  597.   CopyFile(PAnsiChar(ExtractFilePath(ParamStr(0))+App_Xml),
  598.                     PAnsiChar(ExtractFilePath(ParamStr(0))+'EmailServers_Backup.xml'),
  599.                     False);
  601.   EmailSenderMgr:=TEmailSenderMgr.Create;
  602.   EmailSenderMgr.OnComplete:=Self.MultiThreadSendComplete;
  603.   EmailSenderMgr.OnSendError:=Self.MultiThreadSendError;
  604.   EmailSenderMgr.OnOneSend:=self.OnOneSend;
  605.   EmailSenderMgr.OnOneSend:=OnOneSendEnd;
  607.   FEmailPropertyPageIndex:=0;
  609.   FNewEmailUIDLList:=THashedStringList.Create;
  610.   FUIDLList:=THashedStringList.Create;
  611.   GetUIDLS;
  613.   FFilter:=TRuleItems.Create;
  614.   LoadRules;
  616.   FMutex:=0;
  617.   pnlAttch.Visible:=false;
  619.   FRecvEmail:=nil;
  620.   LoadEmails(tvEMail);
  621.   LoadAddrs;
  622.   LoadRules;
  623.   LoadContact;
  625.   FBlackList:=THashedStringList.Create;
  626.   FWhiteList:=THashedStringList.Create;
  628.   LoadDefaultSavePath;
  629.   CreateDirs;
  631.   FEmailChecker:=TCheckEmail.Create;
  632.   xml:=TAppXml.Create;
  633.   try
  634.     xml.GetUIDLS(FEmailChecker.OldUIDLs);
  635.   finally
  636.     xml.Free;
  637.   end;
  638.   FEmailChecker.OnNewEmailArrive:=OnNewEmailArrive;
  639.   FEmailChecker.OnEnterState :=DetectingEmail;
  640.   FEmailChecker.CreateChecker;
  641.   FEmailChecker.EnterState(asInit);
  642. end;
  644. procedure TfrmMain.tvEMailDeletion(Sender: TObject; Node: TTreeNode);
  645. begin
  646.   if Node.Data<>nil then Dispose(Node.Data) ;
  647. end;
  649. procedure TfrmMain.GetCurPop3EMail(delete:Boolean=False);
  650. var
  651.   N:TTreeNode;
  652. begin
  653.   N:=tvEMail.Selected;
  654.   if (N=nil)  then
  655.   begin
  656.     ShowMessage('请选择一个邮箱');
  657.     Exit;
  658.   end;
  659.   if N.Level=1 then N:=N.Parent;
  661.   //菜单不可用
  662.   actRecvCur.Enabled:=False;
  663.   actRecvAll.Enabled:=False;
  664.   actRecvThenDelete.Enabled:=False;
  665.   actStop.Enabled:=True;
  666.   actSuspend.Enabled:=True;
  667.   //获取当前选中的pop3的设置
  668.   FpopServer:=PPopInfo(N.Data).pop3Server;
  669.   FPwd :=PPopInfo(N.Data).pwd ;
  670.   FUserName:=PPopInfo(N.Data).EMailAddr;
  672.   if FRecvEMail<>nil then
  673.   begin
  674.     FRecvEMail.Terminate;
  675.     FRecvEMail.WaitFor;
  676.     FRecvEMail:=nil;
  677.   end;
  678.     //TerminateThread(FRecvEMail.Handle,0);
  680.   FRecvEmail:=TRecvEmail.Create(FpopServer,FUserName,FPwd);
  681.   AttachEvent;
  682.   FRecvEMail.DeleteAfterRecv:=Delete;
  683.   FRecvEMail.RetrieveAllMessage:=True;
  685.   FRecvEMail.Filter:=FFilter;
  686.   FRecvEMail.OnFilter:=OnFilter;
  687.   FRecvEMail.Resume;
  688. end;
  690. procedure TfrmMain.popEmailProgress(Sender: TObject; Total,
  691.   Current: Integer);
  692. begin
  693.   BarProgress.Min:=0;
  694.   BarProgress.Max:=Total;
  695.   BarProgress.Position:=Current;
  696.   if Total=Current then BarProgress.Position:=0;
  697. end;
  699. procedure TfrmMain.MSGProgress(Sender: TObject; Total, Current: Integer);
  700. begin
  701.  { BarProgressMsg.Min:=0;
  702.   BarProgressMsg.Max:=Total;
  703.   BarProgressMsg.Position:=Current;
  704.   if Total=Current then BarProgressMsg.Position:=0;   }
  705. end;
  707. procedure TfrmMain.FormDestroy(Sender: TObject);
  708. begin
  709.   FEmailChecker.Free;
  710.   if FRecvEMail<>nil then TerminateThread(FRecvEMail.Handle,0);
  712.   if FMutex<>0 then CloseHandle(FMutex);
  713.   FUIDLList.Free;
  715.   FFilter.Free;
  717.   FNewEmailUIDLList.Free;
  718.   FBlackList.Free;
  719.   FWhiteList.Free;
  720.   EmailSenderMgr.Free;
  721. end;
  723. procedure TfrmMain.MyOnRecvEMailProgress(Sender: TObject; Total,
  724.   Current: Integer);
  725. begin
  726.   BarProgress.Min:=0;
  727.   BarProgress.Max:=Total;
  728.   BarProgress.Position:=Current;
  729.   if Total=Current then BarProgress.Position:=0;
  730. end;
  732. procedure TfrmMain.MyOnRecvMsgProgress(Sender: TObject; Total,
  733.   Current: Integer);
  734. begin
  735.   BarProgressMsg.Min:=0;
  736.   BarProgressMsg.Max:=Total;
  737.   BarProgressMsg.Position:=Current;
  738.   if Total=Current then BarProgressMsg.Position:=0;
  739. end;
  741. procedure TfrmMain.OnError(Sender: TObject; ErrMsg: string);
  742. begin
  743.   lblError.Style:=cxStyle1;
  744.   lblError.Caption:=ErrMsg;
  745.   lblTotal.Caption:='接收邮件出错';
  746. end;
  748. procedure TfrmMain.OnRetrieveed(sender: TObject;CurNum,Total:Integer;UIDL:String);
  749. var
  750.   pop:TPOP2000;
  751.   I:Integer;
  752.   myXml:TMyXml;
  753.   FileName:string;
  754.   EMailFile:TEmailFile;
  755. begin
  756.   lblTotal.Caption:=Format('正在接收邮件:%D/%D',[CurNum,Total]);
  757.   pop:=TRecvEmail(sender).Pop3;
  758.   pop.MailMessage.RebuildBody;
  759.   //保存邮件正文
  760.   FileName:=AppPath+'recved'+GenalFileName+'.ema';
  761.   EMailFile:=TEmailFile.Create(FileName);
  762.   try
  763.     EMailFile.Subject:=pop.MailMessage.Subject;
  764.     EMailFile.Sender:=pop.MailMessage.FromAddress;
  765.     EMailFile.Recver:=pop.MailMessage.ReceiptAddress;//pop.MailMessage.ReplyToAddress;
  766.     EMailFile.Date:=DateTimeToStr(pop.MailMessage.Date);
  767.     EMailFile.Size:=IntToStr(Length(pop.MailMessage.PartSource));
  768.     EMailFile.Content:=pop.MailMessage.TextHtml.Text;
  770.     for I:=0 to pop.MailMessage.AttachList.Count-1 do
  771.       EMailFile.Attchs.Add(FAttchSaveto+pop.MailMessage.AttachList[I].FileName);
  772.     EMailFile.SaveEmail;
  773.   finally
  774.     EMailFile.Free;
  775.   end;
  777.   myXml:=TAppXml.Create;
  778.   try
  779.     myXml.AddNewEmail(pop.UserName,FileName,UIDL);
  780.   finally
  781.     myXml.Free;
  782.   end;
  783. end;
  785. procedure TfrmMain.OnRecvAttch(sender: TObject; FileName: string;
  786.   FileStream: TMemoryStream;CurNum,Total:Integer);
  787. begin
  788.   BarProgressMsg.Caption:=Format('附件%D/%D',[CurNum,Total]);
  790.   FileStream.SaveToFile(FAttchSaveTo+FileName);   //保存附件
  791. end;
  793. procedure TfrmMain.actRecvAllExecute(Sender: TObject);
  794. begin
  795.   GetAllPop3EMail;
  796. end;
  798. procedure TfrmMain.GetAllPop3EMail(delete:Boolean=False);
  799. var
  800.   I:Integer;
  801.   arr:array of string;
  802.   S:string;
  803. begin
  804.   actRecvCur.Enabled:=false;
  805.   actRecvThenDelete.Enabled:=false;
  806.   actStop.Enabled:=True;
  807.   actSuspend.Enabled:=True;
  809.   for I:=0 to tvEMail.Items.Count-1 do
  810.   begin
  811.     if tvEMail.Items[I].Level=1 then
  812.     begin
  813.       S:=PPopInfo(tvEMail.Items[I].Data).pop3Server+';';
  814.       S:= S+PPopInfo(tvEMail.Items[I].Data).EMailAddr+';';
  815.       S:= S+PPopInfo(tvEMail.Items[I].Data).pwd ;
  817.       SetLength(arr,Length(arr)+1);
  818.       arr[Length(arr)]:=S;
  819.     end;
  820.   end;
  822.   if FRecvEMail<>nil then TerminateThread(FRecvEMail.Handle,0);
  824.   FRecvEmail:=TRecvEmail.Create(arr);
  825.   AttachEvent;
  826.   FRecvEMail.DeleteAfterRecv:=Delete;
  827.   FRecvEMail.RetrieveAllMessage:=True;
  828.   FRecvEMail.Filter:=FFilter;
  829.   FRecvEMail.OnFilter:=OnFilter;
  830.   FRecvEMail.Resume;
  831. end;
  833. procedure TfrmMain.actRecvThenDeleteExecute(Sender: TObject);
  834. begin
  835.   GetCurPop3EMail(True);
  836. end;
  838. procedure TfrmMain.actRecvCurExecute(Sender: TObject);
  839. begin
  840.   lblTotal.Caption:='正在接收邮件，请稍候。';
  841.   lblError.Caption:='';
  842.   GetCurPop3EMail;
  843. end;
  845. procedure TfrmMain.actNewEmailExecute(Sender: TObject);
  846. begin
  847.   with TfrmWriteEMail.Create(Application) do
  848.   try
  849.     ShowModal;
  850.   finally
  851.     Free;
  852.   end;
  853. end;
  855. procedure TfrmMain.actAddrBookExecute(Sender: TObject);
  856. begin
  857.   PnlAddr.Visible:=not  PnlAddr.Visible;
  858. end;
  860. procedure TfrmMain.AttachEvent;
  861. begin
  862.   FRecvEMail.OnRecvEMailProgress:=MyOnRecvEMailProgress;
  863.   FRecvEMail.OnRecvMsgProgress:=MyOnRecvMsgProgress;
  864.   FRecvEMail.OnError:=OnError;
  865.   FRecvEMail.OnRetrieveed:=OnRetrieveed;
  866.   FRecvEMail.OnAttachFileRetrieveed:=OnRecvAttch;
  867.   FRecvEMail.OnComplete:=RecvComplete;
  868.   FRecvEMail.OnGetUIDL:=OnGetUIDL;
  869.   FRecvEMail.BeginWork:=Self.BeginRecv;
  870.   FRecvEMail.EndWork:=Self.EndRecv;
  871.   FRecvEMail.OnTerminate:=Self.OnTerminate;
  873.   FRecvEMail.BlackList:=FBlackList;
  874.   FRecvEMail.WhiteList:=FWhiteList;
  875. end;
  877. procedure TfrmMain.RecvComplete(Sender: TObject);
  878. begin
  879.   actRecvThenDelete.Enabled:=True;
  880.   actRecvCur.Enabled:=True;
  881.   actRecvAll.Enabled:=True;
  882. end;
  884. procedure TfrmMain.actSuspendExecute(Sender: TObject);
  885. begin
  886.   FRecvEMail.Suspend;
  887.   lblTotal.Caption:='收取邮件已暂停';
  888. end;
  890. procedure TfrmMain.actStopExecute(Sender: TObject);
  891. begin
  892.   if (FRecvEMail<>nil) then FRecvEMail.IsBusy=False;
  893.   TerminateThread(FRecvEMail.Handle,0);
  894.   actRecvThenDelete.Enabled:=True;
  895.   actRecvCur.Enabled:=True;
  896.   actRecvAll.Enabled:=True;
  897.   actSuspend.Enabled:=False;
  898.   actStop.Enabled:=False;
  900.   lblTotal.Caption:='收取邮件已停止';
  901.   BarProgress.Position:=0;
  902.   BarProgressMsg.Caption:='附件';
  903.   BarProgressMsg.Position:=0;
  904. end;
  906. procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
  907. var
  908.   frm:TfrmCloseTip;
  909.   r:TModalResult;
  910.   b:Boolean;
  911. begin
  912.   b:=false;
  913.   if FRecvEMail<>nil then   b:=FRecvEMail.IsBusy;
  915.   if b or EmailSenderMgr.HasEmail then
  916.   begin
  917.     //正在发送,收取邮件，提示是终止还是最小化。
  918.     frm:=TfrmCloseTip.Create(Application);
  919.     try
  920.       if b and EmailSenderMgr.HasEmail then
  921.         frm.lblTip.Caption:='您正在发送和收取邮件。'
  922.       else if b then
  923.         frm.lblTip.Caption:='您正在收取邮件。'
  924.       else
  925.         frm.lblTip.Caption:='您正在发送邮件。';
  927.       r:= frm.ShowModal ;
  928.     finally
  929.       frm.Free;
  930.     end;
  932.     if r=mrok then
  933.     begin
  934.       Action :=caNone;
  935.       TrayIcon.MinimizeApp;
  936.     end
  937.     else
  938.       Action:=cafree;
  939.   end
  940. end;
  942. procedure TfrmMain.AddFileRelation(lv: TListView; filename: string);
  943. var
  944.   ImageListHandle: THandle;
  945.   FileInfo: TSHFileInfo;
  946.   sfi: TSHFileInfoA;
  947.   PFileName:PAnsiChar;
  948. begin
  949.   // 小图标
  950.   ImageListHandle := SHGetFileInfo('', 0, FileInfo, SizeOf(FileInfo), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  951.   // 同ImageList关联
  952.   SendMessage(lv.Handle, LVM_SETIMAGELIST, LVSIL_SMALL, ImageListHandle);
  953.   // 大图标
  954.   ImageListHandle := SHGetFileInfo('', 0, FileInfo, SizeOf(FileInfo), SHGFI_SYSICONINDEX or SHGFI_LARGEICON);
  955.   SendMessage(lv.Handle, LVM_SETIMAGELIST, LVSIL_NORMAL, ImageListHandle);
  957.   SHGetFileInfo(PChar(FileName), 0, sfi, SizeOf(sfi),
  958.   SHGFI_DISPLAYNAME or SHGFI_TYPENAME or SHGFI_SMALLICON or SHGFI_ICON);
  959.   with lv.Items.Add do
  960.   begin
  961.     Caption := sfi.szDisplayName;
  962.     ImageIndex := sfi.iIcon;
  963.     GetMem(PFileName,length(FileName)+1) ;
  964.     fillchar(PFileName^,length(FileName)+1,0);
  965.     CopyMemory(PFileName,PAnsiChar(FileName),length(FileName));
  966.     Data:=PFileName;
  967.   end;
  968. end;
  970. procedure TfrmMain.tvEMailClick(Sender: TObject);
  971. begin
  972.   if TcxTreeView(Sender).Selected=nil then Exit;
  973.   btnUnRead.Enabled:=tvEMail.Selected.Text='收件箱';
  974.   ClearTableView(tvTableView);//清除已有记录
  975.   FShowEmailSending:=false;
  976.   LoadRecvEmail; //载入收件箱邮件
  977.   LoadSendEmail; //载入已发邮件邮件
  978.   LoadDraft;  //载入草稿箱邮件
  979.   LoadAttamp; // 载入定时邮件
  980.   LoadSending;
  981. end;
  983. procedure TfrmMain.lv1DblClick(Sender: TObject);
  984. begin
  985. if LV1.Selected <> nil then
  986.    if ShellExecute(0, 'open', LV1.Selected.Data, '', '', SW_NORMAL)<=32 then
  987.      ShellExecute(Handle,
  988.                  'OPEN',
  989.                  PChar('explorer.exe'),
  990.                  PChar('/select, "' + PChar(LV1.Selected.Data) + '"'),
  991.                  nil,
  992.                  SW_NORMAL) ;
  993. end;
  995. procedure TfrmMain.gtvColReadedGetDisplayText(
  996.   Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord;
  997.   var AText: String);
  998. begin
  999.   if ARecord.Values[0]=true then
  1000.     AText:='已读'
  1001.   else
  1002.     AText:='未读' ;
  1003. end;
  1005. procedure TfrmMain.MultiThreadSendComplete(Sender: TObject);
  1006. begin
  1007.   btnSendAll.Enabled:=true;
  1008.   MsgBoxWarn('邮件发送完毕！');
  1009. end;
  1011. procedure TfrmMain.MultiThreadSendError(Sender: TObject;Email:TEmailInfo; ErrMsg: string);
  1012. var
  1013.   Xml:TAppXml;
  1014. begin
  1015.   Email.IsError:=True;
  1016.   Xml:=TAppXml.Create;
  1017.   try
  1018.     //从xml文件中删除
  1019.     Xml.DeleteSendingEmail(Email.Send.UserName,Email.Id);
  1020.     //从表格中删除数据
  1022.     
  1023.   finally
  1024.     xml.Free;
  1025.   end;
  1026.   MsgBoxError(ErrMsg);
  1027. end;
  1029. procedure TfrmMain.actDeleteCurEmailExecute(Sender: TObject);
  1030. var
  1031.   xml:TAppXml;
  1032. begin
  1033.   with tvTableView.DataController do
  1034.   begin
  1035.     if FocusedRecordIndex<0 then
  1036.     begin
  1037.       MsgBoxError('请您选中表格中的一封邮件，再执行删除操作！');
  1038.       exit;
  1039.     end;
  1040.     if MsgBoxYesOrNo(Format('您确定要删除邮件"%S"吗？',[VarToStr(Values[FocusedRecordIndex,gtvColSubject.index])]))=mrOK then
  1041.     begin
  1042.       xml:=TAppXml.Create;
  1043.       try
  1044.         xml.DeleteAEmail(VarToStr(Values[FocusedRecordIndex,gtvColMyAddr.Index]),VarToStr(Values[FocusedRecordIndex,gtvColContentFilename.Index]));
  1045.         DeleteRecord(FocusedRecordIndex);
  1046.       finally
  1047.         xml.Free;
  1048.       end;
  1049.     end;
  1050.   end;
  1051. end;
  1053. procedure TfrmMain.actSendPendingEmailExecute(Sender: TObject);
  1054. var
  1055.   L,Attch:TStringList;
  1056.   xml:TMyXml;
  1057.   I:integer;
  1058.   EmailFile:TEmailFile;
  1059.   pwd:String;
  1060.   dest: TDestinationPart;
  1061.   Orig:TOriginPart;
  1062.   Email:TEmailInfo;
  1063.   Node:TTreeNode;
  1064.   Str:String;
  1065. begin
  1066.   Node:=tvEMail.Selected;
  1067.   if Node=nil then Exit;
  1068.   if Node.Level=1 then Node:=Node.Parent;
  1069.   Str:=PPopInfo(Node.Data).EMailAddr;
  1070.   
  1071.   L:=TStringList.Create;
  1072.   xml:=TAppXml.Create;  //获取所有未发邮件
  1073.   try
  1074.     xml.GetAllNotSendEmail(PPopInfo(Node.Data).EMailAddr,L);
  1075.     xml.GetAllSendingEmail(PPopInfo(Node.Data).EMailAddr,L,false);
  1076.     if L.Count=0 then
  1077.     begin
  1078.       L.Free;
  1079.       MsgBoxError('没有未发邮件');
  1080.       Exit;
  1081.     end;
  1083.     xml.AddSendingEmail(PPopInfo(Node.Data).EMailAddr,L);
  1084.   finally
  1085.     xml.Free;
  1086.   end;
  1087.   
  1088.   Attch:=TStringList.Create;
  1089.   Email:=TEmailInfo.Create;
  1090.   try
  1091.     for I:=0 to L.Count-1 do
  1092.     begin
  1093.       EmailFile:=TEmailFile.Create(L[I]);
  1094.       try
  1095.         Email.Id:=L[I];
  1096.         EmailFile.GetEmail;
  1097.         Attch.Assign(EmailFile.Attchs);
  1099.         Dest:=TDestinationPart.Create(Trim(EmailFile.Recver),Trim(EmailFile.Recver),Trim(EmailFile.Recver),'',EmailFile.Subject,EmailFile.Content,Attch);
  1100.         try
  1101.           Email.Recv:=Dest;
  1102.         finally
  1103.           Dest.Free;
  1104.         end;
  1105.         
  1106.         xml:=TAppXml.Create;
  1107.         try
  1108.           pwd:=xml.GetEMailPwd(EmailFile.Sender);
  1109.         finally
  1110.           xml.Free;
  1111.         end;
  1113.         Orig:=TOriginPart.Create(atDefault,Trim(EmailFile.Sender),Trim(EmailFile.Sender),Trim(pwd),TEMailAddress.SMTPEmailSever(Trim(EmailFile.Sender)),25);
  1114.         try
  1115.           Email.Send:=Orig;
  1116.         finally
  1117.           Orig.Free;
  1118.         end;
  1119.       finally
  1120.         EmailFile.Free;
  1121.       end;
  1122.       EmailSenderMgr.Push(Email);  //加入到发送列表
  1123.     end;
  1124.   finally
  1125.     Attch.free;
  1126.     Email.Free;
  1127.     L.free;
  1128.   end;
  1129.   EmailSenderMgr.Send;
  1131. end;
  1134. procedure TfrmMain.dxBarLargeButton9Click(Sender: TObject);
  1135. begin
  1136.   with  TTipsForm.Create(Application) do
  1137.   try
  1138.     ShowModal;
  1139.   finally
  1140.     free;
  1141.   end;
  1142. end;
  1144. procedure TfrmMain.actRenameExecute(Sender: TObject);
  1145. var
  1146.   N:TTreeNode;
  1147. begin
  1148.   N:=tvEMail.Selected;
  1149.   if (N=nil)  then Exit;
  1150.   if (N.Level=1) then N:=N.Parent;
  1151.   //if (tvEMail.Selected.Text='草稿箱') or (tvEMail.Selected.Text='定时邮件') then Exit;
  1153.   tvEMail.ReadOnly:=False;
  1154.   N.EditText;
  1156. end;
  1158. procedure TfrmMain.tvEMailExit(Sender: TObject);
  1159. begin
  1160.   tvEMail.ReadOnly:=True;
  1161. end;
  1163. procedure TfrmMain.tvEMailEdited(Sender: TObject; Node: TTreeNode;
  1164.   var S: String);
  1165. var
  1166.   MyXml:TMyXml;
  1167.   xmlNode:TXmlNode;
  1168. begin
  1169.   if  (Node.Level<>0) and (Node.Text='草稿箱') or (Node.Text='定时邮件') then Exit;
  1170.   MyXml:=TMyXml.Create(AppPath+'EmailServers.xml');
  1171.   try
  1172.     xmlNode:=MyXml.FindPOP3EmailAddrNode(FOldNodeText);
  1173.     if xmlNode=nil then Exit;
  1174.     xmlNode.ValueAsString:=S;
  1175.   finally
  1176.     MyXml.Free;
  1177.   end;
  1178. end;
  1180. procedure TfrmMain.tvEMailEditing(Sender: TObject; Node: TTreeNode;
  1181.   var AllowEdit: Boolean);
  1182. begin
  1183.   FOldNodeText:=Node.Text;
  1184. end;
  1186. procedure TfrmMain.actDeletePopExecute(Sender: TObject);
  1187. var
  1188.   text:string;
  1189.   MyXml:TMyXml;
  1190.   xmlNode:TXmlNode;
  1191.   N:TTreeNode;
  1192. begin
  1193.   N:=tvEmail.Selected;
  1194.   if (N=nil)  then Exit;
  1195.   if N.Level=1 then N:=N.Parent;
  1197.   text:=GetSeletedEmailAddr;
  1198.   if Dialogs.MessageDlg(format('你确定要删除邮箱"%S"吗?',[N.Text]),mtConfirmation,[mbYes, mbNo],0)=mrNo then  Exit;
  1200.   tvEMail.Items.Delete(N);
  1201.   MyXml:=TMyXml.Create(AppPath+'EmailServers.xml');
  1202.   try
  1203.     xmlNode:=MyXml.FindPOP3EmailAddrNode(text);
  1204.     if xmlNode=nil then Exit;
  1205.     xmlNode.Parent.Delete;
  1206.   finally
  1207.     MyXml.Free;
  1208.   end;
  1210. end;
  1212. procedure TfrmMain.btnSendAndRecvClick(Sender: TObject);
  1213. begin
  1214.   try
  1215.     actSendPendingEmailExecute(nil);
  1216.   finally
  1217.     actRecvAllExecute(nil);
  1218.   end;
  1219. end;
  1221. procedure TfrmMain.FormShow(Sender: TObject);
  1222. var
  1223.   MyXml:TMyXml;
  1224.   loadonstatup:Boolean;
  1225. begin
  1226.   MyXml:=TMyXml.Create(AppPath+'EmailServers.xml');
  1227.   try
  1228.      loadonstatup:=StrToBool(MyXml.Root.FindNode('tips').AttributeByName['loadonstatup']);
  1229.   finally
  1230.      MyXml.free;
  1231.   end;
  1233.   if loadonstatup then  PostMessage(Self.Handle,WM_SHOW_TIP_FORM,0,0);  //显示每日提示
  1234. end;
  1236. procedure TfrmMain.WndProc(var Message: TMessage);
  1237. begin
  1238.   case Message.Msg  of
  1239.     WM_PREVINSTRUN:
  1240.     begin
  1241.       FMutex:=THandle(Message.WParam);
  1242.       TrayIcon.RestoreApp;
  1243.       TrayIcon.ShowBalloonHint('提醒您','《邮件收发系统》已经运行了');
  1244.     end;
  1246.     WM_SHOW_TIP_FORM:
  1247.     with TTipsForm.Create(Application)do
  1248.     try
  1249.       ShowModal;
  1250.     finally
  1251.       Free;
  1252.     end;
  1253.   else
  1254.     inherited;
  1255.   end;
  1256. end;
  1258. procedure TfrmMain.actNewAccuntExecute(Sender: TObject);
  1259. begin
  1260.   with TfrmNewSMTP.Create(Application) do
  1261.   try
  1262.     ShowModal;
  1263.   finally
  1264.     Free;
  1265.   end;
  1266. end;
  1268. procedure TfrmMain.tvEMailMouseUp(Sender: TObject; Button: TMouseButton;
  1269.   Shift: TShiftState; X, Y: Integer);
  1270. var
  1271.   P,pt:TPoint;
  1272.   Node:TTreeNode;
  1273. begin
  1274.   if Button= mbRight then
  1275.   begin
  1276.     GetCursorPos(p);
  1277.     pt:=tvEMail.ScreenToClient(p);
  1278.     Node:=tvEMail.GetNodeAt(pt.x,Pt.Y);
  1279.     if Node=nil then Exit;
  1281.     pm2.Popup(p.X,p.Y);
  1284.   end;
  1285. end;
  1287. procedure TfrmMain.tvTableViewMouseUp(Sender: TObject;
  1288.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1289. var
  1290.   P:TPoint;
  1291. begin
  1292.   if Button= mbRight then
  1293.   begin
  1294.     if tvTableView.DataController.GetFocusedRecordIndex>=0 then
  1295.     begin
  1296.       GetCursorPos(p);
  1297.       pm1.Popup(p.X,p.Y);
  1298.     end;
  1299.   end;
  1300. end;
  1302. procedure TfrmMain.actPropertyExecute(Sender: TObject);
  1303. var
  1304.   N:TTreeNode;
  1305.   PScr:TPoint;
  1306. begin
  1307.   N:=tvEMail.Selected ;
  1308.   if N=nil then Exit;
  1309.   if N.Level=1 then  N:=N.Parent;
  1311.   with TfrmEmailBoxProperty.Create(Application) do
  1312.   try
  1313.     ShowPage(FEmailPropertyPageIndex);
  1314.     LoadDefault(PPopInfo(N.Data).EMailAddr);
  1315.     GetCursorPos(PScr);
  1316.     if PScr.Y+Height>Screen.Height then
  1317.       PScr.Y:=Screen.Height-Height;
  1318.     Self.ScreenToClient(Pscr);
  1319.     Left:=PScr.X;
  1320.     Top:=PScr.Y;  
  1321.     ShowModal;
  1322.   finally
  1323.     free;
  1324.   end;
  1325. end;
  1327. procedure TfrmMain.tmrAttampTimer(Sender: TObject);
  1328. var
  1329.   MyXml:TMyXml;
  1330.   files:TStringList;
  1331. begin
  1332.   //检测定时邮件
  1333.   files:=TStringList.Create;
  1334.   try
  1335.     MyXml:=TAppXml.Create;
  1336.     try
  1337.       myxml.GetAllAttamp(files);
  1338.     finally
  1339.       MyXml.Free;
  1340.     end;
  1342.     if files.Count>=0 then
  1343.     begin
  1344.        //有定时邮件需要发送
  1345.     end;
  1346.   finally
  1347.     files.Free;
  1348.   end;
  1349. end;
  1351. procedure TfrmMain.ClearTableView(tv:TcxGridTableView);
  1352. var
  1353.   I:Integer;
  1354. begin
  1355.   tv.BeginUpdate;
  1356.   try
  1357.     for I:=tv.DataController.RecordCount-1 downto 0 do
  1358.     begin
  1359.       tv.DataController.DeleteRecord(I);
  1360.       tv.DataController.Post;
  1361.     end;
  1362.   finally
  1363.     tv.EndUpdate;
  1364.   end;
  1365. end;
  1367. procedure TfrmMain.LoadAttamp;
  1368. var
  1369.   MyXml:TMyXml;
  1370.   Str:string;
  1371.   contentFileName:TStringList;
  1372. begin
  1373.   if tvEMail.Selected.Text<>'定时邮件' then Exit;
  1374.   WriteLog('LoadAttamp run');
  1375.   FSendEmailBox:=false;
  1376.   gtvColAttch.Visible:=True;
  1377.   gtvColMyAddr.Visible:=False;
  1378.   pnlAttch.Visible:=False;
  1379.   actReply.Enabled:=False;
  1380.   Str:=GetSeletedEmailAddr;
  1381.   gtvColSender.Caption:='收件人';
  1382.   gtvColSender.Visible:=true;
  1383.   gtvColReaded.Visible:=False;
  1384.   gtvColSubject.Visible:=true;
  1385.   gtvColSubject.Caption:='定时发送时间';
  1387.   contentFileName:=TStringList.Create;
  1388.   myXml:=TMyXml.Create(AppPath+'EmailServers.xml');
  1389.   try
  1390.     myXml.GetAllAttamp(Str,contentFileName);
  1391.   finally
  1392.     myXml.Free;
  1393.   end;
  1394.   LoadFromFile(Str,contentFileName);
  1395.   contentFileName.Free;
  1396. end;
  1398. procedure TfrmMain.LoadDraft;
  1399. var
  1400.   MyXml:TMyXml;
  1401.   Str:string;
  1402.   contentFileName:TStringList;
  1403. begin
  1404.   if tvEMail.Selected.Text<>'草稿箱' then Exit;
  1405.   WriteLog('LoadDraft run');
  1406.   FSendEmailBox:=false;
  1407.   gtvColAttch.Visible:=True;
  1408.   gtvColMyAddr.Visible:=False;
  1409.   btnUnRead.Enabled:=false;
  1410.   pnlAttch.Visible:=False;
  1411.   actReply.Enabled:=False;
  1412.   Str:=GetSeletedEmailAddr;
  1413.   gtvColSender.Caption:='收件人';
  1414.   gtvColSender.Visible:=true;
  1415.   gtvColReaded.Visible:=False;
  1416.   gtvColDate.Visible:=true;
  1417.   gtvColDate.Caption:='邮件撰写时间';
  1419.   contentFileName:=TStringList.Create;
  1420.   myXml:=TMyXml.Create(AppPath+'EmailServers.xml');
  1421.   try
  1422.     myXml.GetAllDraft(Str,contentFileName);
  1423.   finally
  1424.     myXml.Free;
  1425.   end;
  1426.   LoadFromFile(Str,contentFileName);
  1427.   contentFileName.Free;
  1428. end;
  1430. procedure TfrmMain.LoadRecvEmail;
  1431. var
  1432.   contentFileName,
  1433.   Readed,
  1434.   Attch,
  1435.   uidlList,
  1436.   FileShortName:TStringList;
  1437.   Str:string;
  1438.   MyXml:TMyXml;
  1439.   I,J:Integer;
  1440.   EmailFile:TEmailFile;
  1441.   recCount:Integer;
  1442. begin
  1443.   if tvEMail.Selected.Text<>'收件箱' then Exit;
  1444.   WriteLog('LoadRecvEmail run');
  1445.   gtvColAttch.Visible:=True;
  1446.   gtvColMyAddr.Visible:=False;
  1447.   FSendEmailBox:=false;
  1448.   pnlAttch.Visible:=False;
  1449.   actReply.Enabled:=True;
  1450.   Str:=GetSeletedEmailAddr;
  1451.   btnUnRead.Enabled:=true;
  1452.   gtvColSender.Caption:='发件人';
  1453.   gtvColSender.Visible:=true;
  1454.   gtvColReaded.Visible:=true;
  1455.   gtvColDate.Visible:=true;
  1456.   gtvColDate.Caption:='收件时间';
  1457.   contentFileName:=TStringList.Create;
  1458.   Readed:=TStringList.Create;
  1459.   Attch:=TStringList.Create;
  1460.   uidlList:=TStringList.Create;
  1461.   FileShortName:=TStringList.Create;
  1462.   try
  1463.     myXml:=TAppXml.Create;
  1464.     try
  1465.       myXml.GetAllEmail(Str,contentFileName,Readed,uidlList);
  1466.     finally
  1467.       myXml.Free;
  1468.     end;
  1470.     tvTableView.BeginUpdate;
  1471.     try
  1472.       WriteLog('recvEmail count:'+inttostr(contentFileName.Count));
  1473.       for I:=0 to contentFileName.Count-1 do
  1474.       begin
  1475.         if not FileExists(contentFileName.Strings[I]) then Continue;
  1476.         EMailFile:=TEmailFile.Create(contentFileName[I]);
  1477.         EMailFile.Attchs.Clear;
  1478.         try
  1479.           EMailFile.GetEmail;
  1480.           with tvTableView.DataController do
  1481.           begin
  1482.             recCount:=AppendRecord;
  1483.             //SetValue(recCount, 0,StrToBool(Readed[I]) );
  1484.             if FSendEmailBox then
  1485.               SetValue(recCount, gtvColSender.Index,EMailFile.Recver )
  1486.             else
  1487.               SetValue(recCount, gtvColSender.Index,EMailFile.Sender );
  1488.             SetValue(recCount, gtvColSubject.Index,EMailFile.Subject );
  1489.             SetValue(recCount,gtvColDate.Index,EMailFile.Date );
  1490.             if EMailFile.Size='' then EMailFile.Size:='0';
  1491.             if StrToInt(EMailFile.Size)>1024 then
  1492.               SetValue(recCount, gtvColSize.Index,IntToStr(StrToInt(EMailFile.Size) div 1024)+' KB')
  1493.             else
  1494.               SetValue(recCount, gtvColSize.Index,EMailFile.Size+' Bytes') ;
  1496.             SetValue(recCount, gtvColContentFilename.Index,contentFileName[I] );
  1497.             SetValue(recCount, gtvColUIDL.Index,uidlList[I] );
  1498.             SetValue(recCount, gtvColMyAddr.Index,Str);
  1499.             SetValue(recCount, gtvColAttchFullName.Index,Join(';',EMailFile.Attchs));
  1500.             WriteLog('Email '+inttostr(I)+' attchs:'+trim(EMailFile.Attchs.Text));
  1501.             WriteLog('cxGrid Show: '+Values[recCount, 9]);
  1502.             WriteLog('Join('';'',EMailFile.Attchs): '+Join(';',EMailFile.Attchs));
  1503.             WriteLog('--------------------------------------------------------') ;
  1504.             FileShortName.Clear;
  1505.             for J:=0 to  EMailFile.Attchs.Count-1 do
  1506.               FileShortName.Add(ExtractFileName(EMailFile.Attchs[J]));
  1508.             SetValue(recCount, gtvColAttch.Index,Join(';',FileShortName) );
  1509.             SetValue(recCount, gtvColReaded.Index,StrToBoolDef(Readed[I],False) );
  1510.             Post;
  1511.           end;
  1512.         finally
  1513.           EMailFile.Free;
  1514.         end;
  1515.       end;
  1516.     finally
  1517.       tvTableView.EndUpdate;
  1518.     end;
  1519.   finally
  1520.     FileShortName.free;
  1521.     uidlList.free;
  1522.     contentFileName.free;
  1523.     Readed.free;
  1524.     Attch.free;
  1525.   end;
  1526. end;
  1528. procedure TfrmMain.LoadSendEmail;
  1529. var
  1530.   contentFileName:TStringList;
  1531.   MyXml:TAppXml;
  1532.   Str:string;
  1533. begin
  1534.   if tvEMail.Selected.Text<>'已发邮件' then Exit; //显示所有已发送的邮件
  1535.   WriteLog('LoadSendEmail run');
  1536.   gtvColAttch.Visible:=True;
  1537.   gtvColMyAddr.Visible:=False;
  1538.   btnRecpOne.Enabled:=false;
  1539.   btnUnRead.Enabled:=True;
  1540.   FSendEmailBox:=true;
  1541.   actReply.Enabled:=False;
  1542.   Str:=PPopInfo(tvEMail.Selected.Parent.Data).EMailAddr;
  1543.   gtvColSender.Caption:='收件人';
  1544.   gtvColReaded.Visible:=false;
  1545.   gtvColDate.Visible:=True;
  1546.   gtvColDate.Caption:='发件时间';
  1548.   contentFileName:=TStringList.Create;
  1549.   MyXml:=TAppXml.Create;
  1550.   try
  1551.     MyXml.GetAllSentEmail(Str,contentFileName);
  1552.   finally
  1553.     MyXml.Free;
  1554.   end;
  1555.   LoadFromFile(Str,contentFileName);
  1556.   contentFileName.Free;
  1557. end;
  1559. procedure TfrmMain.SendEmailFromFile(FilePath: string);
  1560. begin
  1562. end;
  1564. procedure TfrmMain.LoadFromFile(EmailAddr:string;Files: TStringList);
  1565. var
  1566.   FileShortName:TStringList;
  1567.   I,J:Integer;
  1568.   EmailFile:TEmailFile;
  1569.   recCount:Integer;
  1570. begin
  1571.   FileShortName:=TStringList.Create;
  1572.   tvTableView.BeginUpdate;
  1573.   try
  1574.     recCount:=0;
  1575.     for I:=0 to Files.Count-1 do
  1576.     begin
  1577.       if not FileExists(Files.Strings[I]) then Continue;
  1578.       EMailFile:=TEmailFile.Create(Files[I]);
  1579.       EMailFile.GetEmail;
  1580.       with tvTableView.DataController do
  1581.       begin
  1582.         AppendRecord;
  1583.         //SetValue(recCount, 0,StrToBool(Readed[I]) );
  1584.         if FSendEmailBox then
  1585.           SetValue(recCount, gtvColSender.Index,EMailFile.Recver )
  1586.         else
  1587.           SetValue(recCount, gtvColSender.Index,EMailFile.Sender );
  1589.         SetValue(recCount, gtvColSubject.Index,EMailFile.Subject );
  1590.         SetValue(recCount, gtvColDate.Index,EMailFile.Date );
  1591.         if EMailFile.Size='' then EMailFile.Size:='0';
  1592.         if StrToInt(EMailFile.Size)>1024 then
  1593.           SetValue(recCount, gtvColSize.Index,IntToStr(StrToInt(EMailFile.Size) div 1024)+' KB')
  1594.         else
  1595.           SetValue(recCount, gtvColSize.Index,EMailFile.Size+' Btyes');
  1596.         //
  1597.         SetValue(recCount, gtvColContentFilename.Index,Files[I] );
  1598.         SetValue(recCount, gtvColUIDL.Index,'' );
  1599.         SetValue(recCount, gtvColMyAddr.Index,EmailAddr);
  1600.         SetValue(recCount, gtvColAttchFullName.Index,Join(';',EMailFile.Attchs));
  1602.         FileShortName.Clear;
  1603.         for J:=0 to  EMailFile.Attchs.Count-1 do
  1604.           FileShortName.Add(ExtractFileName(EMailFile.Attchs[J]));
  1606.         EMailFile.Free;
  1608.         SetValue(recCount, gtvColAttch.Index,Join(';',FileShortName) );
  1610.         SetValue(recCount, gtvColReaded.Index,False );
  1611.         Post;
  1612.       end;
  1613.       Inc(recCount);
  1614.     end;
  1615.   finally
  1616.     tvTableView.EndUpdate;
  1617.   end;
  1618.   FileShortName.free;
  1619. end;
  1621. procedure TfrmMain.OnGetUIDL(Sender: TObject; uidl: String;
  1622.   var Handle: Boolean);
  1623. var
  1624.  idx:integer;
  1625. begin
  1626.   idx:=FUIDLList.IndexOf(uidl);
  1627.   if idx=-1 then FUIDLList.Add(uidl);
  1628.   handle:=(FRetryAgain) and (idx>-1);
  1629.   writelog(#$D#$A'uidl:'+uidl+#$D#$A'FUIDLList:'+FUIDLList.Text+#$D#$A);
  1630. end;
  1632. procedure TfrmMain.GetUIDLS;
  1633. var
  1634.   AppXml:TAppXml;
  1635. begin
  1636.   AppXml:=TAppXml.Create;
  1637.   try
  1638.     AppXml.GetUIDLS(FUIDLList);
  1639.   finally
  1640.     AppXml.Free;
  1641.   end;
  1642. end;
  1644. procedure TfrmMain.LoadRules;
  1645. var
  1646.   MyXml:TMyXml;
  1647. begin
  1648.   MyXml:=TMyXml.Create(AppPath+'EmailServers.xml');
  1649.   try
  1650.     if FileExists(MyXml.GetRulesFilePath ) then
  1651.       FFilter.ReadFromFile(MyXml.GetRulesFilePath,FFilter);
  1652.   finally
  1653.     MyXml.Free;
  1654.   end;
  1655. end;
  1657. procedure TfrmMain.OnFilter(Sender: TObject;Action:TRuleAction; EmailSubject,
  1658.   EmailFrom: string;var DeleteIt:Boolean;var Ignore:Boolean);
  1659. begin
  1660.   DeleteIt:=Action.DeleteOnServer;
  1661.   Ignore:=Action.IgnoreNotRecv;
  1663.   try
  1664.     if FileExists(Action.PlaySound) then
  1665.       WinExec(PAnsiChar(Action.PlaySound),SW_SHOW);
  1666.     if FileExists(Action.RunExe) then
  1667.       WinExec(PAnsiChar(Action.RunExe),SW_SHOW);
  1668.   except
  1669.   end;
  1671.   if Action.PopTip then
  1672.   with TfrmFilterPopTip.Create(Application) do
  1673.   begin
  1674.     ShowInfo('过滤系统拦截到一封邮件',format('邮件主题是%S。'#$D#$A'邮件来自%S。'#$D#$A#$D#$A'你希望执行下列哪项操作？',[EmailSubject,EmailFrom]));
  1675.     try
  1676.       case ShowModal of
  1677.       mrYes:   //接收邮件
  1678.         Ignore:=False;
  1679.       mrNo:    //不接收
  1680.         Ignore:=True;
  1681.       mrCancel:  //从服务器上删除
  1682.         DeleteIt:=True;
  1683.       else; // Exception.Create('未定义返回值');
  1684.       end;
  1685.     finally
  1686.       Free;
  1687.     end;
  1688.   end;
  1689. end;
  1691. procedure TfrmMain.TrayIconLButtonDown(Sender: TObject);  //弹出左键菜单
  1692. begin
  1693.   //SendMessage(Self.Handle,WM_CANCELMODE,0,0);
  1694.   //pmleft.PopupFromCursorPos;
  1695. end;
  1697. procedure TfrmMain.TrayIconRButtonDown(Sender: TObject);  //弹出右键菜单
  1698. begin
  1699.   SendMessage(Self.Handle,WM_CANCELMODE,0,0);
  1700.   pmRight.PopupFromCursorPos;
  1701. end;
  1703. procedure TfrmMain.dxbrbtn34Click(Sender: TObject);
  1704. begin
  1705.   TrayIcon.RestoreApp;
  1706. end;
  1708. procedure TfrmMain.dxbrbtn37Click(Sender: TObject);
  1709. begin
  1710.   TrayIcon.MinimizeApp;
  1711. end;
  1713. procedure TfrmMain.dxbrbtn39Click(Sender: TObject);
  1714. begin
  1715.   Self.Close;
  1716. end;
  1718. procedure TfrmMain.CreateDirs;
  1719. begin
  1720.   if not DirectoryExists(FRuleSaveTo) then
  1721.   begin
  1722.     FRuleSaveTo:=IncludeTrailingPathDelimiter(AppPath+'Rules');
  1723.     CreateDir(FRuleSaveTo) ;
  1724.   end;
  1726.   if not DirectoryExists(FEmailSaveTo) then
  1727.   begin
  1728.     FEmailSaveTo:=IncludeTrailingPathDelimiter(AppPath+'emailsaveto');
  1729.     CreateDir(FEmailSaveTo) ;
  1730.   end;
  1732.   if not DirectoryExists(FAttchSaveTo) then
  1733.   begin
  1734.     FAttchSaveTo:=IncludeTrailingPathDelimiter(AppPath+'emailattchsaveto');
  1735.     CreateDir(FAttchSaveTo) ;
  1736.   end;
  1737. end;
  1739. procedure TfrmMain.LoadDefaultSavePath;
  1740. var
  1741.   MyXml:TMyXml;
  1742. begin
  1743.   MyXml:=TMyXml.Create(AppPath+'EmailServers.xml');
  1744.   try
  1745.     FEmailSaveTo :=IncludeTrailingPathDelimiter(VarToStr(MyXml.Pop3sNode.AttributeByName['emailsaveto']));
  1746.     FEmailSaveTo:=GetFullPath(FEmailSaveTo);
  1747.     
  1748.     FAttchSaveTo:=IncludeTrailingPathDelimiter(VarToStr(MyXml.Pop3sNode.AttributeByName['emailattchsaveto']));
  1749.     FAttchSaveTo:=GetFullPath(FAttchSaveTo);
  1751.     FRuleSaveTo:=IncludeTrailingPathDelimiter(MyXml.Root.FindNode('Rules').AttributeByName['RulesSaveTo']);
  1752.     FRuleSaveTo:=GetFullPath(FRuleSaveTo);
  1754.     MyXml.GetBlackList(FBlackList);
  1755.     MyXml.GetWhiteList(FWhiteList);
  1756.   finally
  1757.     MyXml.Free;
  1758.   end;
  1759. end;
  1761. procedure TfrmMain.BeginRecv(Sender: TObject); //开始接收
  1762. var
  1763.   myxml:TMyXml;
  1764. begin
  1765.   actRecvCur.Enabled:=False;
  1766.   actRecvThenDelete.Enabled:=False;
  1767.   actSuspend.Enabled:=True;
  1768.   actStop.Enabled:=True;
  1770.   MyXml:=TMyXml.Create(AppPath+'EmailServers.xml');
  1771.   try
  1772.     if myxml.FindPop3(FRecvEMail.Pop3.UserName)<>nil then
  1773.       FRetryAgain:=StrToBoolDef(myxml.FindPop3(FRecvEMail.Pop3.UserName).AttributeByName['ReDownload'],False);
  1774.   finally
  1775.     MyXml.Free;
  1776.   end;
  1777. end;
  1779. procedure TfrmMain.EndRecv(Sender: TObject); //接收完毕（不管是否发生错误，该事件都被触发）
  1780. begin
  1781.   BarProgress.Position:=0;
  1782.   BarProgressMsg.Position:=0;
  1784.   actSuspend.Enabled:=False;
  1785.   actStop.Enabled:=False;
  1786.   actRecvThenDelete.Enabled:=True;
  1787.   actRecvCur.Enabled:=True;
  1788.   actRecvAll.Enabled:=True;
  1789.   lblTotal.Caption:='收取完毕';
  1790. end;
  1792. procedure TfrmMain.OnTerminate(Sender: TObject);
  1793. begin
  1794.   FRecvEMail:=nil;
  1795. end;
  1797. procedure TfrmMain.btn1Click(Sender: TObject);
  1798. begin
  1799.   with TfrmRule.Create(Application) do
  1800.   try
  1801.     if ShowModal=mrOk then LoadRules;
  1802.   finally
  1803.     free;
  1804.   end;
  1805. end;
  1807. procedure TfrmMain.dxBarButton3Click(Sender: TObject);
  1808. begin
  1809.   FEmailPropertyPageIndex:=3;
  1810.   actPropertyExecute(nil);
  1811. end;
  1813. procedure TfrmMain.dxbrbtn41Click(Sender: TObject);
  1814. begin
  1815.   FEmailPropertyPageIndex:=2;
  1816.   actPropertyExecute(nil);
  1817. end;
  1819. procedure TfrmMain.OnNewEmailArrive(Sender: TObject;
  1820.   NewEmailUIDLs: TStrings);
  1821. begin
  1822.   with TfrmFilterPopTip.Create(Application)do
  1823.   try
  1824.     AlignButtons;
  1825.     ShowInfo('有封新邮件啦',format('您有%D封新邮件'#$D#$A#$D#$A'您希望执行下面的哪项操作？',[NewEmailUIDLs.Count]));
  1826.     if ShowModal <>mrYes then Exit;
  1827.   finally
  1828.     free;
  1829.   end;
  1831.   actRecvCur.Enabled:=false;
  1832.   actRecvThenDelete.Enabled:=false;
  1833.   actStop.Enabled:=True;
  1834.   actSuspend.Enabled:=True;
  1836.   if FRecvEMail<>nil then TerminateThread(FRecvEMail.Handle,0);
  1838.   FRecvEmail:=TRecvEmailExt.Create;
  1839.   AttachEvent;
  1840.   FRecvEMail.DeleteAfterRecv:=False;
  1841.   FRecvEMail.RetrieveAllMessage:=True;
  1842.   FRecvEMail.Filter:=FFilter;
  1843.   FRecvEMail.OnFilter:=OnFilter;
  1844.   TRecvEmailExt(FRecvEmail).NewEmailUIDLS:=NewEmailUIDLs;
  1845.   FRecvEMail.Resume;
  1846. end;
  1848. procedure TfrmMain.TrayIconMinimizeApp(Sender: TObject);
  1849. begin
  1850.   FEmailChecker.EnterState(asMin);
  1851. end;
  1853. procedure TfrmMain.TrayIconRestoreApp(Sender: TObject);
  1854. begin
  1855.   FEmailChecker.EnterState(asRestore);
  1856. end;
  1858. procedure TfrmMain.btnDetectEmailClick(Sender: TObject);
  1859. begin
  1860.   FEmailChecker.EnterState(asInit);
  1861. end;
  1863. procedure TfrmMain.dxbrbtn35Click(Sender: TObject);
  1864. begin
  1865.   FEmailChecker.EnterState(asInit);
  1866. end;
  1868. procedure TfrmMain.btn4Click(Sender: TObject);
  1869. begin
  1870.   with TfrmAttchMgr.Create(Application) do
  1871.   try
  1872.     ShowModal;
  1873.   finally
  1874.     free;
  1875.   end;
  1876. end;
  1878. procedure TfrmMain.dxbrlrgbtn4Click(Sender: TObject);  //test
  1879. begin
  1880.   if tvTableView.DataController.FocusedRecordIndex<0 then
  1881.   begin
  1882.     MsgBoxError('请在表格中选一封邮件。');
  1883.     exit;
  1884.   end;
  1885.   
  1886.   with TfrmAwake.Create(Application)do
  1887.   try
  1888.     with tvTableView.DataController do
  1889.     begin
  1890.       FEmailAddr:=VarToStr(Values[FocusedRecordIndex,gtvColMyAddr.Index]);
  1891.       FContentFilePath:=VarToStr(Values[FocusedRecordIndex,gtvColContentFilename.Index])
  1892.     end;
  1893.     ShowModal;
  1894.   finally
  1895.     Free;
  1896.   end;
  1897. end;
  1899. procedure TfrmMain.DetectingEmail(Sender: TObject; Runing: Boolean);
  1900. begin
  1901.   btnDetectEmail.Enabled:=not Runing;
  1902.   if Runing then
  1903.     LblDetect.Caption:='正在检测新邮件'
  1904.   else
  1905.     LblDetect.Caption:='';
  1906. end;
  1908. procedure TfrmMain.dxbrbtn18Click(Sender: TObject);  //作为附件发送
  1909. var
  1910.   contfile:string;
  1911.   EmailFile:TEmailFile;
  1912.   tempFileName:string;
  1913.   Strm:TMemoryStream;
  1914.   I:integer;
  1915. begin
  1916.   contfile:=VarToStr(tvTableView.DataController.GetValue(tvTableView.DataController.GetFocusedRecordIndex,gtvColContentFilename.Index));
  1917.   if not FileExists(contfile) then exit;
  1919.   tempFileName:=SysTempDir+GenalFilename+'.html';
  1921.   with TfrmWriteEMail.Create(Application) do
  1922.   try
  1923.     Caption:='发送邮件--作为附件发送';
  1924.     FSetDoc:=false;
  1925.     pnl1.Height:=234;
  1926.     
  1927.     EmailFile:=TEmailFile.Create(contfile);
  1928.     try
  1929.       EmailFile.GetEmail;
  1931.       with lstAttch.Items.Add do
  1932.       begin
  1933.         Text:=tempFileName;
  1934.         Checked:=True;
  1935.       end;
  1937.       for I:=0 to EmailFile.Attchs.Count-1 do
  1938.       begin
  1939.         with lstAttch.Items.Add do
  1940.         begin
  1941.           if FileExists(EmailFile.Attchs[I]) then
  1942.           begin
  1943.           Text:=EmailFile.Attchs[I];
  1944.           Checked:=True;
  1945.           end
  1946.           else
  1947.           begin
  1948.             Checked:=False;
  1949.             Text:='[文件不存在] '+lstAttch.Items[I].Text;
  1950.           end;
  1951.         end;
  1952.       end;
  1954.       Strm:=TMemoryStream.Create;
  1955.       Strm.Position:=0;
  1956.       Strm.WriteBuffer(EmailFile.Content[1],Length(EmailFile.Content));
  1957.       try
  1958.         Strm.SaveToFile(tempFileName);
  1959.       finally
  1960.         Strm.Free;
  1961.       end;
  1962.     finally
  1963.       EmailFile.Free;
  1964.     end;
  1966.     ShowModal;
  1967.   finally
  1968.     SysUtils.DeleteFile(tempFileName);
  1969.     Free;
  1970.   end;
  1971. end;
  1973. procedure TfrmMain.actCleanRecvsExecute(Sender: TObject);
  1974. var
  1975.   Xml:TAppXml;
  1976. begin
  1977.   if MsgBoxYesOrNo('您确定要清空收件箱吗？')=mrOK  then
  1978.   begin
  1979.     xml:=TAppXml.Create;
  1980.     try
  1981.       xml.CleanRecvs(GetSeletedEmailAddr);
  1982.     finally
  1983.       Xml.Free;
  1984.     end;
  1985.   end;
  1986. end;
  1988. function TfrmMain.GetSeletedEmailAddr: string;
  1989. var
  1990.   N:TTreeNode;
  1991. begin
  1992.   Result:='';
  1993.   N:=tvEmail.Selected;
  1994.   if N=nil then  exit ;
  1995.   if N.Level=1 then  N:=N.Parent;
  1996.   Result:=PPopInfo(N.Data).EMailAddr
  1997. end;
  1999. procedure TfrmMain.btnCleanSentsClick(Sender: TObject);
  2000. var
  2001.   Xml:TAppXml;
  2002. begin
  2003.   xml:=TAppXml.Create;
  2004.   try
  2005.     xml.CleanSents(GetSeletedEmailAddr);
  2006.   finally
  2007.     Xml.Free;
  2008.   end;
  2009. end;
  2011. procedure TfrmMain.btnCleanDraftClick(Sender: TObject);
  2012. var
  2013.   Xml:TAppXml;
  2014. begin
  2015.   xml:=TAppXml.Create;
  2016.   try
  2017.     xml.CleanDraft(GetSeletedEmailAddr);
  2018.   finally
  2019.     Xml.Free;
  2020.   end;
  2021. end;
  2023. procedure TfrmMain.btnCleanAttampClick(Sender: TObject);
  2024.   var
  2025.   Xml:TAppXml;
  2026. begin
  2027.   xml:=TAppXml.Create;
  2028.   try
  2029.     xml.CleanAttmp(GetSeletedEmailAddr);
  2030.   finally
  2031.     Xml.Free;
  2032.   end;
  2033. end;
  2036. procedure TfrmMain.btnUnReadClick(Sender: TObject);
  2037. var
  2038.   Xml:TAppXml;
  2039.   I:integer;
  2040. begin
  2041.   I:= tvTableView.DataController.FocusedRecordIndex;
  2042.   if I<0 then exit;
  2043.   Xml:=TAppXml.Create;
  2044.   try
  2045.     Xml.SetEmailUnreaded(VarToStr(tvTableView.DataController.Values[I,gtvColMyAddr.index]),VarToStr(tvTableView.DataController.Values[I,gtvColUIDL.Index]));
  2046.   finally
  2047.     Xml.Free;
  2048.   end;
  2049.   tvTableView.DataController.SetValue(I,gtvColReaded.Index,False);
  2050.   tvTableView.DataController.Post;
  2051. end;
  2053. procedure TfrmMain.actReplyExecute(Sender: TObject);
  2054. begin
  2055.   if tvTableView.DataController.GetFocusedRecordIndex =-1 then
  2056.   begin
  2057.     MsgBoxError('请选中表格中的一封邮件');
  2058.     Exit;
  2059.   end;
  2060.   
  2061.   with TfrmWriteEMail.Create(nil) do
  2062.   try
  2063.     Caption:='回复邮件';
  2064.     pnl1.Height:=130;
  2065.     with tvTableView.DataController do
  2066.     begin
  2067.       cbRecver.Properties.Items.Insert(0,VarToStr(GetValue(GetFocusedRecordIndex,gtvColSender.Index))) ;
  2069.       if cbSender.Properties.Items.IndexOf(VarToStr(GetValue(GetFocusedRecordIndex,gtvColMyAddr.Index))) <>-1 then
  2070.         cbSender.ItemIndex:=cbSender.Properties.Items.IndexOf(VarToStr(GetValue(GetFocusedRecordIndex,gtvColMyAddr.Index)));
  2071.     end;
  2072.     cbRecver.ItemIndex:=0;
  2073.     ShowModal;
  2074.   finally
  2075.     Free;
  2076.   end;
  2077. end;
  2079. procedure TfrmMain.actTurnExecute(Sender: TObject);
  2080. var
  2081.   contfile:string;
  2082.   EmailFile:TEmailFile;
  2083. begin
  2084.   contfile:=VarToStr(tvTableView.DataController.GetValue(tvTableView.DataController.GetFocusedRecordIndex,gtvColContentFilename.Index));
  2085.   if not FileExists(contfile) then exit;
  2087.   with TfrmWriteEMail.Create(Application) do
  2088.   try
  2089.     Caption:='转发邮件';
  2090.     FSetDoc:=True;
  2092.     
  2093.     EmailFile:=TEmailFile.Create(contfile);
  2094.     try
  2095.       EmailFile.GetEmail;
  2096.       AddAttch(EmailFile.Attchs);
  2097.       if EmailFile.Attchs.Count>0 then pnl1.Height:=234;
  2098.       //cbAttch.Properties.Items.Assign(EmailFile.Attchs);
  2099.       FStr:=EmailFile.Content;
  2100.     finally
  2101.       EmailFile.Free;
  2102.     end;
  2104.     ShowModal;
  2105.   finally
  2106.     Free;
  2107.   end;
  2108. end;
  2110. procedure TfrmMain.tvTableViewFocusedRecordChanged(
  2111.   Sender: TcxCustomGridTableView; APrevFocusedRecord,
  2112.   AFocusedRecord: TcxCustomGridRecord;
  2113.   ANewItemRecordFocusingChanged: Boolean);
  2114. begin
  2115.   actTurn.Enabled:= (tvTableView.DataController.RecordCount>0) and (tvTableView.DataController.FocusedRecordIndex>=0);
  2116.   if not btnTurn.Enabled then actReply.Enabled:=False;
  2117.   actDeleteCurEmail.Enabled:=(tvTableView.DataController.RecordCount>0) and (tvTableView.DataController.FocusedRecordIndex>=0)
  2118. end;
  2120. procedure TfrmMain.tvTableViewCellDblClick(Sender: TcxCustomGridTableView;
  2121.   ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
  2122.   AShift: TShiftState; var AHandled: Boolean);
  2123. var
  2124.   I:Integer;
  2125.   S:string;
  2126.   list:TStrings;
  2127.   hasAttch:Boolean;
  2128.   MyXml:TMyXml;
  2129.   EMailFile:TEmailFile;
  2130. begin
  2131.   pnlAttch.Visible:=False;
  2132.   //显示邮件正文
  2133.   HtmlEdit.Clear;
  2134.   with ACellViewInfo.GridView.DataController do
  2135.   begin
  2136.     I:=GetFocusedRecordIndex ;
  2138.     S:=VarToStr(GetValue(I,gtvColContentFilename.Index));
  2139.     if not FileExists(S) then Exit;
  2141.     EMailFile:=TEmailFile.Create(S);   
  2142.     try
  2143.       EMailFile.GetEmail;
  2144.       HtmlEdit.HTML:=EMailFile.Content;
  2145.       //SetHtml(Web,);
  2146.     finally
  2147.       EMailFile.Free;
  2148.     end;
  2150.     if (not FSendEmailBox ) then
  2151.     begin
  2152.       if  (GetValue(I,gtvColReaded.Index)=false) then
  2153.       begin
  2154.         myxml:=TMyXml.Create(AppPath+'EmailServers.xml');
  2155.         try
  2156.           myxml.SetEmailReaded(GetValue(I,gtvColMyAddr.Index),GetValue(I,gtvColContentFilename.Index));
  2157.         finally
  2158.           myxml.Free;
  2159.         end;
  2160.         SetValue(I,gtvColReaded.Index,True)
  2161.       end;
  2162.     end;
  2163.     
  2164.     S:=VarToStr(GetValue(I,gtvColAttchFullName.Index));
  2165.   end;
  2167.   //显示附件
  2168.   lv1.Items.Clear;
  2169.   if s='' then Exit;
  2170.   hasAttch:=False;
  2171.   list:=TStringList.Create;
  2172.   try
  2173.     Split(';',S,list);
  2174.     for I:=0 to list.Count-1 do
  2175.     begin
  2176.       if FileExists(list[I]) then
  2177.       begin
  2178.         AddFileRelation(lv1,list[I]);
  2179.         hasAttch:=True;
  2180.       end;
  2181.     end;
  2182.   finally
  2183.     list.Free;
  2184.   end;
  2185.   pnlAttch.Visible:=hasAttch;
  2186. end;
  2188. procedure TfrmMain.lv1Deletion(Sender: TObject; Item: TListItem);
  2189. begin
  2190.   if( Item.Data<>nil) then FreeMem(PAnsiChar(Item.Data));
  2191. end;
  2193. procedure TfrmMain.actCleanSentsExecute(Sender: TObject);
  2194. var
  2195.   Xml:TAppXml;
  2196. begin
  2197.   if MsgBoxYesOrNo('您确定要清空所有''已发邮件''吗？')=mrOK  then
  2198.   begin
  2199.     xml:=TAppXml.Create;
  2200.     try
  2201.       xml.CleanSents(GetSeletedEmailAddr);
  2202.     finally
  2203.       Xml.Free;
  2204.     end;
  2205.   end;
  2206. end;
  2208. procedure TfrmMain.actCleanDraftExecute(Sender: TObject);
  2209. var
  2210.   Xml:TAppXml;
  2211. begin
  2212.   if MsgBoxYesOrNo('您确定要清空草稿箱吗？')=mrOK  then
  2213.   begin
  2214.     xml:=TAppXml.Create;
  2215.     try
  2216.       xml.CleanDraft(GetSeletedEmailAddr);
  2217.     finally
  2218.       Xml.Free;
  2219.     end;
  2220.   end;
  2221. end;
  2223. procedure TfrmMain.actCleanAttampExecute(Sender: TObject);
  2224. var
  2225.   Xml:TAppXml;
  2226. begin           
  2227.   if MsgBoxYesOrNo('您确定要清空定时邮件吗？')=mrOK  then
  2228.   begin
  2229.     xml:=TAppXml.Create;
  2230.     try
  2231.       xml.CleanAttmp(GetSeletedEmailAddr);
  2232.     finally
  2233.       Xml.Free;
  2234.     end;
  2235.   end;
  2236. end;
  2238. procedure TfrmMain.JvNavPaneToolPanel3Close(Sender: TObject);
  2239. begin
  2240.   cxSplitter1.State:=ssClosed;
  2241.   btn12.Down:=False;
  2242. end;
  2244. procedure TfrmMain.btn12Click(Sender: TObject);
  2245. begin
  2246.   if btn12.Down then
  2247.     cxSplitter1.State:=ssOpened
  2248.   else
  2249.     cxSplitter1.State:=ssClosed;
  2250. end;
  2252. procedure TfrmMain.tmrEmailAwakeTimer(Sender: TObject);
  2253. var
  2254.   Awake:TEmailAwakeCollection;
  2255.   I:integer;
  2256.   hMutex:THandle;
  2257. begin
  2258.   hMutex:=CreateMutex(nil,false,'TfrmEmailAwaked_One_Inst');
  2259.   if GetLastError=ERROR_ALREADY_EXISTS  then
  2260.   begin
  2261.     CloseHandle(hMutex);
  2262.     Exit;
  2263.   end;
  2264.   CloseHandle(hMutex);
  2265.   
  2266.   Awake:=TEmailAwakeCollection.Create;
  2267.   try
  2268.     LoadAwakeCollectionFromXml(Awake);
  2269.     for i:=pred(Awake.Count) downto 0  do
  2270.     begin
  2271.       if TEmailAwakeItem(Awake.Items[I]).Awake.IsAwake then //该邮件需要提醒了
  2272.       begin
  2273.         with TfrmEmailAwaked.Create(Application)do
  2274.         try
  2275.           lblTitle.Caption:=TEmailAwakeItem(Awake.Items[I]).Awake.Title;
  2276.           edMemo.lines.Text:=TEmailAwakeItem(Awake.Items[I]).Awake.Memo;
  2277.           FEmailAddr:=TEmailAwakeItem(Awake.Items[I]).Awake.EmailAddr;
  2278.           FContentFilePath:= TEmailAwakeItem(Awake.Items[I]).Awake.ContentFilePath;
  2279.           TEmailAwakeItem(Awake.Items[I]).Awake.BaseTime:=TEmailAwakeItem(Awake.Items[I]).Awake.NextAwake;
  2280.           case  ShowModal of
  2281.           mrOK: //打开
  2282.           Begin
  2283.             with TfrmViewEmail.Create(Application)do
  2284.             try
  2285.               FEmailAddr:=TEmailAwakeItem(Awake.Items[I]).Awake.EmailAddr;
  2286.               FContentFilePath:=TEmailAwakeItem(Awake.Items[I]).Awake.ContentFilePath;
  2287.               ShowModal;
  2288.             finally
  2289.               Awake.Delete(I);
  2290.               Free;
  2291.             end;
  2292.           End;
  2294.           mrCancel: //清除
  2295.           Begin
  2296.             Awake.Delete(I);
  2297.             MsgBoxWarn('删除成功');
  2298.           End;
  2300.           mrRetry: //再次提醒
  2301.           begin
  2302.             TEmailAwakeItem(Awake.Items[I]).Awake.UserNextAwake:=true;
  2303.           End;
  2304.           
  2305.           MrNone:;
  2306.           else;
  2307.           end;
  2309.         finally
  2310.           Free;
  2311.         end;
  2312.         SaveAwakeCollectionFromXml(Awake);
  2313.       end;
  2314.     end;
  2315.   finally
  2316.     Awake.Free;
  2317.   end;
  2318. end;
  2320. procedure TfrmMain.actViewEmailExecute(Sender: TObject);
  2321. begin
  2322.   if tvTableView.DataController.FocusedRecordIndex<0 then exit;
  2323.   with TfrmViewEmail.Create(Application)do
  2324.   begin
  2325.     try
  2326.       FTableView:=tvTableView;
  2327.       FCurRecordIndex:=tvTableView.DataController.FocusedRecordIndex;
  2328.       FContentFileItemIndex:=gtvColContentFilename.Index;
  2329.       FSenderEmail:= VarToStr(tvTableView.DataController.Values[FCurRecordIndex, gtvColSender.Index]);
  2330.       FRecverEmail:= VarToStr(tvTableView.DataController.Values[FCurRecordIndex, gtvColMyAddr.Index]);
  2331.       ShowEmail;
  2332.       ShowModal;
  2333.     finally
  2334.       Free;
  2335.     end;
  2336.   end;
  2337. end;
  2339. procedure TfrmMain.btn2Click(Sender: TObject);
  2340. begin
  2341.   with TfrmSingnals.Create(Application)do
  2342.   begin
  2343.     try
  2344.       ShowModal;
  2345.     finally
  2346.       Free;
  2347.     end;
  2348.   end;
  2349. end;
  2351. procedure TfrmMain.btn9Click(Sender: TObject);
  2352. var
  2353.   xml:TAppXml;
  2354.   L:TStringList;
  2355. begin
  2356.   if tvTableView.DataController.FocusedRecordIndex=-1 then
  2357.   begin
  2358.     MsgBoxError('请选中表格中的一封邮件！');
  2359.     exit;
  2360.   end;
  2361.   xml:=TAppXml.Create;
  2362.   try
  2363.     L:=TStringList.Create;
  2364.     try
  2365.       L.Add(varTostr(tvTableView.DataController.Values[tvTableView.DataController.FocusedRecordIndex,gtvColSender.Index]));
  2366.       xml.AddBlackList(L);
  2367.     finally
  2368.       L.Free;
  2369.     end;
  2370.   finally
  2371.     Xml.Free;
  2372.   end;
  2373.   MsgBoxWarn(Format('发件人%S成功加入到黑名单',[vartostr(tvTableView.DataController.Values[tvTableView.DataController.FocusedRecordIndex,gtvColSender.Index])]));
  2374. end;
  2376. procedure TfrmMain.btn10Click(Sender: TObject);
  2377. var
  2378.   xml:TAppXml;
  2379.   L:TStringList;
  2380. begin
  2381.   if tvTableView.DataController.FocusedRecordIndex=-1 then
  2382.   begin
  2383.     MsgBoxError('请选中表格中的一封邮件！');
  2384.     exit;
  2385.   end;
  2386.   
  2387.   xml:=TAppXml.Create;
  2388.   try
  2389.     L:=TStringList.Create;
  2390.     try
  2391.       L.Add(tvTableView.DataController.Values[tvTableView.DataController.FocusedRecordIndex,gtvColSender.Index]);
  2392.       xml.AddWhiteList(L);
  2393.     finally
  2394.       L.Free;
  2395.     end;
  2396.   finally
  2397.     Xml.Free;
  2398.   end;
  2399.   MsgBoxWarn(Format('发件人%S成功加入到白名单',[vartostr(tvTableView.DataController.Values[tvTableView.DataController.FocusedRecordIndex,gtvColSender.Index])]));
  2400. end;
  2402. procedure TfrmMain.dxBarButton2Click(Sender: TObject);
  2403. begin
  2404.   HtmlEdit.PrintPageSetup;
  2405.   HtmlEdit.PrintPreview;
  2406. end;
  2408. procedure TfrmMain.btnSaveAllClick(Sender: TObject);
  2409. begin
  2410.   HtmlEdit.PrintPageSetup;
  2411.   HtmlEdit.Print;
  2412. end;
  2414. procedure TfrmMain.OnOneSend(Sender: TObject;Email:TEmailInfo);
  2415. begin
  2417. end;
  2419. procedure TfrmMain.OnOneSendEnd(Sender: TObject; Email: TEmailInfo);
  2420. var
  2421.   xml:TAppXml;
  2422.   idx:Integer;
  2423. begin
  2424.   if not email.IsError then
  2425.   begin
  2426.     xml:=TAppXml.Create;
  2427.     try
  2428.       xml.AddSentEmail(Email.Send.UserName,email.Id);
  2429.       Xml.DeleteSendingEmail(Email.Send.UserName,Email.Id);
  2430.     finally
  2431.       xml.free;
  2432.     end;
  2434.     if FShowEmailSending then //从表格中删除数据
  2435.     begin
  2436.       idx:=tvTableView.DataController.FindRecordIndexByText(0,gtvColContentFilename.Index,Email.Id,true,true,false);
  2437.       if idx>=0 then
  2438.        tvTableView.DataController.DeleteRecord(idx);
  2439.     end;
  2440.   end;
  2441. end;
  2443. procedure TfrmMain.LoadSending;
  2444. var
  2445.   contentFileName:TStringList;
  2446.   MyXml:TAppXml;
  2447.   Str:string;
  2448. begin
  2449.   if tvEMail.Selected.Text<>'发件箱' then Exit; //显示所有已发送的邮件
  2450.   //WriteLog('LoadSending run');
  2451.   FShowEmailSending:=True;
  2452.   btnRecpOne.Enabled:=false;
  2453.   btnUnRead.Enabled:=True;
  2454.   FSendEmailBox:=true;
  2455.   actReply.Enabled:=False;
  2456.   Str:=PPopInfo(tvEMail.Selected.Parent.Data).EMailAddr;
  2457.   gtvColSender.Caption:='收件人';
  2458.   gtvColMyAddr.Visible:=true;
  2459.   gtvColMyAddr.Caption:='发件人';
  2460.   gtvColReaded.Visible:=false;
  2461.   gtvColDate.Visible:=False;
  2462.   gtvColDate.Caption:='发件时间';
  2463.   gtvColAttch.Visible:=false;
  2464.   
  2465.   contentFileName:=TStringList.Create;
  2466.   MyXml:=TAppXml.Create;
  2467.   try
  2468.     MyXml.GetAllSendingEmail(Str,contentFileName);
  2469.   finally
  2470.     MyXml.Free;
  2471.   end;
  2472.   LoadFromFile(Str,contentFileName);
  2473.   contentFileName.Free;
  2474. end;
  2476. procedure TfrmMain.btn17Click(Sender: TObject);
  2477. begin
  2478.   //FEmailChecker.
  2479. end;
  2481. procedure TfrmMain.LoadContact;
  2482. var
  2483.   I:Integer;
  2484.   La,Ln:TStringList;
  2485. begin
  2486.   ltAddr.Clear;
  2487.   
  2488.   Ln:=TStringList.create;
  2489.   La:=TStringList.create;
  2490.   try
  2491.     with TAppXml.Create do
  2492.     try
  2493.       LoadContacts(La,ln);
  2494.     finally
  2495.       Free;
  2496.     end;
  2498.     for I:= 0 to La.Count-1 do
  2499.     begin
  2500.       with ltAddr.Add do
  2501.       begin
  2502.         Values[0]:=False;
  2503.         Values[1]:=Ln.Strings[I];
  2504.         Values[2]:=La.Strings[I];
  2505.       end;
  2506.     end;
  2507.   finally
  2508.     Ln.Free;
  2509.     La.Free;
  2510.   end;
  2511. end;
  2513. procedure TfrmMain.dxBarButton22Click(Sender: TObject);
  2514. begin
  2515.   with TfrmAddr.Create(nil) do
  2516.   try
  2517.     FContactModel:=cmAdd;
  2518.     ShowModal;
  2519.   finally
  2520.     Free;
  2521.   end;
  2522. end;
  2524. procedure TfrmMain.dxBarButton23Click(Sender: TObject);
  2525. begin
  2526.   with TfrmAddr.Create(nil) do
  2527.   try
  2528.     FContactModel:=cmDelete;
  2529.     ShowModal;
  2530.   finally
  2531.     Free;
  2532.   end;
  2533. end;
  2535. procedure TfrmMain.dxBarButton24Click(Sender: TObject);
  2536. begin
  2537.   with TfrmAddr.Create(nil) do
  2538.   try
  2539.     FContactModel:=cmEdit;
  2540.     ShowModal;
  2541.   finally
  2542.     Free;
  2543.   end;
  2544. end;
  2546. procedure TfrmMain.dxBarButton27Click(Sender: TObject);
  2547. var
  2548.   FCurRecordIndex:Integer;
  2549. begin
  2550.   FCurRecordIndex:= tvTableView.DataController.FocusedRecordIndex;
  2551.   if FCurRecordIndex<0 then exit;
  2552.   with TfrmAddr.Create(nil) do
  2553.   try
  2554.     FContactModel:=cmAdd;
  2555.     edAddr.Text:=VarToStr(tvTableView.DataController.Values[FCurRecordIndex, gtvColSender.Index]);
  2556.     ShowModal;
  2557.   finally
  2558.     Free;
  2559.   end;
  2560. end;
  2562. procedure TfrmMain.ltAddrDblClick(Sender: TObject);
  2563. begin
  2564.   if ltAddr.SelectionCount=1 then
  2565.   begin
  2566.     with TfrmAddr.Create(nil) do
  2567.     try
  2568.       FContactModel:=cmEdit;
  2569.       edAddr.Text:=ltAddr.Selections[0].Values[2];
  2570.       edName.Text:=ltAddr.Selections[0].Values[1];
  2571.       ShowModal;
  2572.     finally
  2573.       Free;
  2574.     end;
  2575.   end;
  2576. end;
  2578. procedure TfrmMain.dxbrbtnAddClick(Sender: TObject);
  2579. begin
  2580.   if ltAddr.SelectionCount=1 then
  2581.   begin
  2582.     with TfrmAddr.Create(nil) do
  2583.     try
  2584.       FContactModel:=cmAdd;
  2585.       //edAddr.Text:=ltAddr.Selections[0].Values[2];
  2586.       //edName.Text:=ltAddr.Selections[0].Values[1];
  2587.       ShowModal;
  2588.     finally
  2589.       Free;
  2590.     end;
  2591.   end;
  2592. end;
  2594. procedure TfrmMain.dxbrbtnDelClick(Sender: TObject);
  2595. begin
  2596.   if ltAddr.SelectionCount=1 then
  2597.   begin
  2598.     with TfrmAddr.Create(nil) do
  2599.     try
  2600.       FContactModel:=cmDelete;
  2601.       edAddr.Text:=ltAddr.Selections[0].Values[2];
  2602.       //edName.Text:=ltAddr.Selections[0].Values[1];
  2603.       ShowModal;
  2604.     finally
  2605.       Free;
  2606.     end;
  2607.   end;
  2608. end;
  2610. procedure TfrmMain.dxbrbtnEditClick(Sender: TObject);
  2611. begin
  2612.   ltAddrDblClick(nil);
  2613. end;
  2615. procedure TfrmMain.dxBarLargeButton10Click(Sender: TObject);
  2616. begin
  2617.   with TfrmAbout.Create(nil) do
  2618.   begin
  2619.     try
  2620.       ShowModal;
  2621.     finally
  2622.       Free;
  2623.     end;
  2624.   end;
  2625. end;
  2627. procedure TfrmMain.dxBarButton25Click(Sender: TObject);
  2628. var
  2629.   OutLook,Ns,Floder,It,Ct,oEnum:OleVariant;
  2630. begin
  2631.   try
  2632.     OutLook:=GetActiveOleObject('Outlook.Application');
  2633.   except
  2634.     try
  2635.       OutLook:=CreateOleObject('Outlook.Application');
  2636.     except
  2637.       MessageDlg('请确认你是否安装了OutLook。' + #13#10 +
  2638.               '如果没有安装，请安装之后再重试。' + #13#10#13#10#13#10,
  2639.               mtError, [mbOK], 0);
  2640.     end;
  2641.   end;
  2643.   try
  2644.     Ns:=OutLook.GetNamespace('MAPI');
  2645.     Floder:=Ns.GetDefaultFolder(oEnum);
  2646.     It:=Floder.Items;
  2647.     Ct:=It.GetFirst;
  2649.     with TAppXml.Create do
  2650.     try     //not  VarIsNull(ct)
  2651.       while (Ct<>NULL) do
  2652.       begin
  2653.          AddContact(ct.Email1Address,ct.FullName,'');
  2654.          ct:= it.GetNext;
  2655.       end;
  2656.       LoadContact;
  2657.     finally
  2658.       Free;
  2659.     end;
  2660.   except
  2661.       MessageDlg('未知的错误' + #13#10#13#10#13#10#13#10 +
  2662.         #13#10,  mtError, [mbOK], 0);
  2663.   end;
  2664.   ct:=null;
  2665.   it:=null;
  2666.   floder:=null;
  2667.   ns:=null;
  2668.   OutLook:=null;
  2669. end;
  2671. procedure TfrmMain.dxBarButton12Click(Sender: TObject);
  2672. begin
  2673.   dxbrbtn18Click(NIL);
  2674. end;
  2676. initialization
  2677.   CoInitialize(nil);
  2678. finalization
  2679.   CoUninitialize();
  2683. end.