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

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

Email服务器

开发平台：

Delphi

ufrmViewEmail.pas：源码内容
  1. unit ufrmViewEmail;
  3. interface
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, uBaseEditorForm, ActnList, uHtmlEdit, dxBar, ImgList,
  8.   dxBarExtItems, cxClasses, OleCtrls, SHDocVw, ExtCtrls, cxGraphics,
  9.   cxControls, dxStatusBar, cxContainer, cxEdit, cxLabel, cxStyles,
  10.   cxCustomData, cxFilter, cxData, cxDataStorage, cxGridCustomView,
  11.   cxGridCustomTableView, cxGridTableView, cxGridLevel, cxGrid, dxSkinsCore,
  12.   dxSkinsdxBarPainter, dxSkinBlack, dxSkinBlue, dxSkinCaramel,
  13.   dxSkinCoffee, {dxSkinDarkRoom,} dxSkinDarkSide, {dxSkinFoggy,}
  14.   dxSkinGlassOceans, dxSkiniMaginary, dxSkinLilian, dxSkinLiquidSky,
  15.   dxSkinLondonLiquidSky, dxSkinMcSkin, dxSkinMoneyTwins,
  16.   dxSkinOffice2007Black, dxSkinOffice2007Blue, dxSkinOffice2007Green,
  17.   dxSkinOffice2007Pink, dxSkinOffice2007Silver, dxSkinPumpkin, {dxSkinSeven,}
  18.   {dxSkinSharp,} dxSkinSilver, {dxSkinSpringTime,} dxSkinStardust,
  19.   dxSkinSummer2008, dxSkinsDefaultPainters, dxSkinValentine,
  20.   dxSkinXmas2008Blue, dxSkinsdxStatusBarPainter;
  22. type
  23.   TfrmViewEmail = class(TBaseEditorForm)
  24.     pnl1: TPanel;
  25.     dxStatusBar1: TdxStatusBar;
  26.     dxbrsbtm4: TdxBarSubItem;
  27.     dxbrsbtm5: TdxBarSubItem;
  28.     dxbrsbtm6: TdxBarSubItem;
  29.     btn1: TdxBarButton;
  30.     btn2: TdxBarButton;
  31.     btn3: TdxBarButton;
  32.     btn4: TdxBarButton;
  33.     btn5: TdxBarButton;
  34.     btn6: TdxBarButton;
  35.     btn7: TdxBarButton;
  36.     btn8: TdxBarButton;
  37.     btn9: TdxBarButton;
  38.     btnNextUnread: TdxBarButton;
  39.     btn11: TdxBarButton;
  40.     btn12: TdxBarButton;
  41.     btn13: TdxBarButton;
  42.     dxbrsbtm7: TdxBarSubItem;
  43.     btn14: TdxBarButton;
  44.     btn15: TdxBarButton;
  45.     btn16: TdxBarButton;
  46.     btn17: TdxBarButton;
  47.     btn18: TdxBarButton;
  48.     btn19: TdxBarButton;
  49.     btn20: TdxBarButton;
  50.     btn21: TdxBarButton;
  51.     btn22: TdxBarButton;
  52.     btn23: TdxBarButton;
  53.     btn24: TdxBarButton;
  54.     lbl2: TcxLabel;
  55.     lbl3: TcxLabel;
  56.     lbl4: TcxLabel;
  57.     lbl5: TcxLabel;
  58.     lblSender: TcxLabel;
  59.     lblRecver: TcxLabel;
  60.     lblRecvDate: TcxLabel;
  61.     lblSubject: TcxLabel;
  62.     btnRecp: TdxBarLargeButton;
  63.     btnPrior: TdxBarLargeButton;
  64.     btnTurn: TdxBarLargeButton;
  65.     btnSucc: TdxBarLargeButton;
  66.     btnDeleteEmail: TdxBarLargeButton;
  67.     btnPreview: TdxBarLargeButton;
  68.     btnPrint: TdxBarLargeButton;
  69.     btnExit: TdxBarLargeButton;
  70.     procedure FormCreate(Sender: TObject);
  71.     procedure FormDestroy(Sender: TObject);
  72.     procedure btnRecpClick(Sender: TObject);
  73.     procedure btnTurnClick(Sender: TObject);
  74.     procedure btnDeleteEmailClick(Sender: TObject);
  75.     procedure btnPriorClick(Sender: TObject);
  76.     procedure btnSuccClick(Sender: TObject);
  77.     procedure btnPreviewClick(Sender: TObject);
  78.     procedure btnPrintClick(Sender: TObject);
  79.     procedure btnExitClick(Sender: TObject);
  80.     procedure btn1Click(Sender: TObject);
  81.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  82.     procedure btnNextUnreadClick(Sender: TObject);
  83.     procedure btn6Click(Sender: TObject);
  84.     procedure btn9Click(Sender: TObject);
  85.     procedure btn11Click(Sender: TObject);
  86.   private
  87.     { Private declarations }
  88.     FAttchs:TStrings;
  89.     FOneEmail:Boolean;//只显示一封邮件
  90.   public
  91.     { Public declarations }
  92.     FTableView:TcxGridTableView; //删除邮件时，在创建窗体之后，必须设置这5个值
  93.     FCurRecordIndex,
  94.     FContentFileItemIndex:Integer;
  95.     FRecverEmail,    //接收者
  96.     FSenderEmail:string;     //发送者
  99.     FEmailAddr,
  100.     FContentFilePath:string;
  102.     procedure ShowEmail;
  104.     procedure ShowOneEmail;
  105.     {调用方法：
  106.     1,创建窗体  Create.
  107.     2，设置以下变量的值
  108.         FTableView:TcxGridTableView;  //从那个Grid中读取数据
  109.         FCurRecordIndex,              //记录集当前记录位置
  110.         FContentFileItemIndex,        //    email保存位置在记录集的第几个字段.
  111.         FRecverEMailAddrItemIndex:Integer;  //   email地址在记录集的第几个字段.
  112.         FSenderEmail:string;
  113.     3，调用 ShowEmail
  114.     }
  116.     { 显示一封邮件时的调用方法：
  117.       1，设置FEmailAddr,
  118.       2，设置FContentFilePath:string;
  119.       3，调用ShowOneEmail;
  120.     }
  121.   end;
  123. var
  124.   frmViewEmail: TfrmViewEmail;
  126. implementation
  128. uses UEmailFile, ufrmWriteEmail, uMyXml, uCommon, cxCheckListBox;
  130. {$R *.dfm}
  132. { TfrmViewEmail }
  134. procedure TfrmViewEmail.ShowEmail;
  135. var
  136.   EMail:TEMailFile;
  137. begin
  138.   if (FCurRecordIndex<0) then
  139.     FCurRecordIndex:=FTableView.DataController.RecordCount-1 ;
  140.   if FCurRecordIndex>FTableView.DataController.RecordCount-1 then
  141.      FCurRecordIndex:=0;
  142.   btnNextUnread.Enabled:=FCurRecordIndex<FTableView.DataController.RecordCount-1;
  143.   btnPrior.Enabled:=FCurRecordIndex>0;
  144.   btnSucc.Enabled:=FCurRecordIndex<FTableView.DataController.RecordCount-1;
  145.   btnNextUnread.Enabled:=FCurRecordIndex<FTableView.DataController.RecordCount-1;
  146.   
  147.   FContentFilePath:=VarToStr(FTableView.DataController.Values[FCurRecordIndex,FContentFileItemIndex]);
  148.   EMail:=TEMailFile.Create(FContentFilePath);
  149.   try
  150.     EMail.GetEmail;
  151.     lblSender.Caption:=Email.Sender;
  152.     lblRecver.Caption:=FRecverEmail;
  153.     lblRecvDate.Caption:=Email.Date;
  154.     lblSubject.Caption:=Email.Subject;
  155.     HtmlEdit.Clear;
  156.     HtmlEdit.Insert(Email.Content);
  157.     FAttchs.Assign(EMail.Attchs);
  158.   finally
  159.     EMail.Free;
  160.   end;
  161. end;
  163. procedure TfrmViewEmail.FormCreate(Sender: TObject);
  164. begin
  165.   inherited;
  166.   FOneEmail:=false;
  167.   FAttchs:=TStringList.Create;
  168. end;
  170. procedure TfrmViewEmail.FormDestroy(Sender: TObject);
  171. begin
  172.   FAttchs.Free;
  173.   inherited;
  174. end;
  176. procedure TfrmViewEmail.btnRecpClick(Sender: TObject);
  177. var
  178.   Email:TEmailFile;
  179.   idx:Integer;
  180. begin
  181.   if FOneEmail then
  182.   begin
  183.     with TfrmWriteEMail.Create(Application) do
  184.     begin
  185.       try
  186.         Caption:='回复邮件';
  187.         Email:=TEmailFile.Create(FContentFilePath);
  188.         try
  189.           Email.GetEmail;
  190.         finally
  191.           idx:=cbSender.Properties.Items.IndexOf(Email.Recver);
  192.           if idx>=0 then
  193.             cbSender.ItemIndex:=idx  //cbSender.Properties.Items.IndexOf(FEmailAddr)
  194.           else
  195.             cbSender.Properties.Items.Insert(0,Email.Recver);
  197.           idx:=cbRecver.Properties.Items.IndexOf(Email.Sender) ;
  198.           if idx>=0 then
  199.              cbRecver.ItemIndex:=idx
  200.             //cbRecver.Properties.Items.Delete(cbRecver.Properties.Items.IndexOf(Email.Sender));
  201.           else
  202.             cbRecver.Properties.Items.Insert(0,Email.Sender);
  204.           //cbRecver.ItemIndex:=0;
  205.         end;
  206.         ShowModal;
  207.       finally
  208.         Free;
  209.       end;
  210.     end;
  211.     Exit;
  212.   end;
  214.   with TfrmWriteEMail.Create(Application) do
  215.   try
  216.     Caption:='回复邮件';
  217.     with FTableView.DataController do
  218.     begin
  219.       cbRecver.Properties.Items.Insert(0,FSenderEmail) ;
  220.       if cbSender.Properties.Items.IndexOf(FRecverEmail)<>-1 then
  221.         cbSender.ItemIndex:=cbSender.Properties.Items.IndexOf(FRecverEmail);
  222.     end;
  223.     cbRecver.ItemIndex:=0;
  224.     ShowModal;
  225.   finally
  226.     Free;
  227.   end;
  229. end;
  231. procedure TfrmViewEmail.btnTurnClick(Sender: TObject);
  232. var
  233.   EmailFile:TEmailFile;
  234.   Path:string;
  235.   I:Integer;
  236. begin
  237.   if FOneEmail then
  238.     Path:=FContentFilePath
  239.   else
  240.   begin
  241.     if not FileExists(VarToStr(FTableView.DataController.Values[FCurRecordIndex,FContentFileItemIndex])) then exit;
  242.     Path:=VarToStr(FTableView.DataController.Values[FCurRecordIndex,FContentFileItemIndex]);
  243.   end;
  245.   with TfrmWriteEMail.Create(Application) do
  246.   try
  247.     Caption:='转发邮件';
  248.     FSetDoc:=True;
  249.     pnl1.Height:=234;
  250.     
  251.     EmailFile:=TEmailFile.Create(Path);
  252.     try
  253.       EmailFile.GetEmail;
  254.       for I:=0 to EmailFile.Attchs.Count-1 do
  255.       begin
  256.         with lstAttch.Items.Add do
  257.         begin
  258.           Text:=EmailFile.Attchs[I];
  259.           Checked:=True;
  260.         end;
  261.       end;
  262.       //cbAttch.Properties.Items.Assign(EmailFile.Attchs);
  263.       if FOneEmail then
  264.       begin
  265.         if  cbSender.Properties.Items.IndexOf(FEmailAddr)<>-1 then
  266.           cbSender.ItemIndex:=cbSender.Properties.Items.IndexOf(FEmailAddr);
  267.         cbSender.ItemIndex:=0;
  268.       end;
  269.       FStr:=EmailFile.Content;
  270.     finally
  271.       EmailFile.Free;
  272.     end;
  274.     ShowModal;
  275.   finally
  276.     Free;
  277.   end;
  278. end;
  280. procedure TfrmViewEmail.btnDeleteEmailClick(Sender: TObject);
  281. var
  282.   xml:TAppXml;
  283. begin
  284.   if MessageDlg('你确定要删除当前邮件吗？' + #13#10#13#10#13#10#13#10 +
  285.     #13#10,  mtConfirmation, mbOKCancel, 0)=mrCancel then Exit;
  288.   xml:=TAppXml.Create;
  289.   try
  290.     if FOneEmail then
  291.     begin
  292.       xml.DeleteEmailAwake(FEmailAddr,FContentFilePath);
  293.       MsgBoxWarn('删除成功！');
  294.     end
  295.     else
  296.     begin
  297.       if xml.DeleteAEmail(FRecverEmail,VarToStr(FTableView.DataController.Values[FCurRecordIndex,FContentFileItemIndex])) then
  298.         MsgBoxWarn('删除成功！')
  299.       else
  300.         MsgBoxError('无法删除邮件！');
  301.     end;
  302.   finally
  303.     xml.Free;
  304.   end;
  305.   lblSender.Caption:='';
  306.   lblRecver.Caption:='';
  307.   lblRecvDate.Caption:='';
  308.   lblSubject.Caption:='';
  309.   HtmlEdit.Clear;
  310.   if not FOneEmail then
  311.   begin
  312.     FTableView.DataController.DeleteRecord(FCurRecordIndex);
  313.     btnSuccClick(nil);
  314.   end;
  315. end;
  317. procedure TfrmViewEmail.btnPriorClick(Sender: TObject);
  318. begin
  319.   Dec(FCurRecordIndex);
  320.   ShowEmail;
  321. end;
  323. procedure TfrmViewEmail.btnSuccClick(Sender: TObject);
  324. begin
  325.   Inc(FCurRecordIndex);
  326.   ShowEmail;
  327. end;
  329. procedure TfrmViewEmail.btnPreviewClick(Sender: TObject);
  330. begin
  331.   HtmlEdit.PrintPageSetup;
  332.   HtmlEdit.PrintPreview;
  333. end;
  335. procedure TfrmViewEmail.btnPrintClick(Sender: TObject);
  336. begin
  337.   HtmlEdit.PrintPageSetup;
  338.   HtmlEdit.Print;
  339. end;
  341. procedure TfrmViewEmail.btnExitClick(Sender: TObject);
  342. begin
  343.   close;
  344. end;
  346. procedure TfrmViewEmail.btn1Click(Sender: TObject);
  347. begin
  348.   if dlgSave.Execute then
  349.     HtmlEdit.SaveToFile(dlgSave.FileName);
  350. end;
  352. procedure TfrmViewEmail.FormClose(Sender: TObject;
  353.   var Action: TCloseAction);
  354. begin
  355.   Action:=caFree;
  356. end;
  358. procedure TfrmViewEmail.btnNextUnreadClick(Sender: TObject);
  359. begin
  360.   repeat
  361.     Inc(FCurRecordIndex);
  362.     if  FCurRecordIndex>=FTableView.DataController.RecordCount then
  363.     begin
  364.       MsgBoxWarn('没有未读邮件');
  365.       exit;
  366.     end;
  367.   until (FTableView.DataController.Values[FCurRecordIndex,0]=false);
  368.   ShowEmail;
  369. end;
  371. procedure TfrmViewEmail.btn6Click(Sender: TObject);
  372. begin
  373.   dxbrmngr1Bar1.visible:=btn6.Down;
  374. end;
  376. procedure TfrmViewEmail.btn9Click(Sender: TObject);
  377. begin
  378.   dxStatusBar1.visible:=btn9.Down;
  379. end;
  381. procedure TfrmViewEmail.btn11Click(Sender: TObject);
  382. begin
  383.   pnl1.visible:=btn11.Down;
  384. end;
  386. procedure TfrmViewEmail.ShowOneEmail;
  387. var
  388.   EMail:TEMailFile;
  389. begin
  390.   FOneEmail:=True;
  391.   btn12.Visible:=ivNever;
  392.   btn13.Visible:=ivNever;
  393.   btnNextUnread.Visible:=ivNever;
  394.   btnPrior.Visible:=ivNever;
  395.   btnSucc.Visible:=ivNever;
  396.   EMail:=TEMailFile.Create(VarToStr(FTableView.DataController.Values[FCurRecordIndex,FContentFileItemIndex]));
  397.   try
  398.     EMail.GetEmail;
  399.     lblSender.Caption:=Email.Sender;
  400.     lblRecver.Caption:=FEmailAddr;
  401.     lblRecvDate.Caption:=Email.Date;
  402.     lblSubject.Caption:=Email.Subject;
  403.     HtmlEdit.Clear;
  404.     HtmlEdit.Insert(Email.Content);
  405.     FAttchs.Assign(EMail.Attchs);
  406.   finally
  407.     EMail.Free;
  408.   end;
  409. end;
  411. end.