ATB Códigos de la Fuente

Correo sistema v1.2 Show main.pas código fuente

Volver Descargar Correo sistema v1.2: Descargar main.pas Código fuente - Descargar Correo sistema v1.2 Código fuente - Tipo:.pas
  1. {邮件群发系统 v1.2
  2.  作者: 于志强
  3.  Email: matthew@apex-point.com
  4.  msn: protoss0@msn.com
  5.  QQ: 15693996 (验证:delphi)
  6.  需要指定SMTP服务器.
  7.  目前还没找到不需要SMTP服务器的方法,望哪位大侠可以告知;
  8.  您可以任意修改此软件,如果您对此软件有修改,希望能给我发一份。
  9. }
  10. unit main;
  11.  
  12. interface
  13.  
  14. uses
  15.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  16.   Dialogs, StdCtrls, RzEdit, Mask, ExtCtrls, RzPanel, RzTabs, RzButton,
  17.   ComCtrls, RzListVw, ImgList, RzPrgres, RzRadChk, IdComponent,
  18.   IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP, IdBaseComponent,
  19.   IdMessage, RzLstBox, XPMan, IniFiles, IdEmailAddress;
  20.  
  21. type
  22.   TfrmMain = class(TForm)
  23.     RzPageControl1: TRzPageControl;
  24.     TabSheet1: TRzTabSheet;
  25.     TabSheet2: TRzTabSheet;
  26.     RzGroupBox1: TRzGroupBox;
  27.     Label1: TLabel;
  28.     Edit1: TRzEdit;
  29.     Label2: TLabel;
  30.     Edit2: TRzEdit;
  31.     Label3: TLabel;
  32.     Edit3: TRzEdit;
  33.     RzGroupBox2: TRzGroupBox;
  34.     Label4: TLabel;
  35.     Edit4: TRzEdit;
  36.     Label5: TLabel;
  37.     Edit5: TRzEdit;
  38.     RzMemo1: TRzMemo;
  39.     RzPanel1: TRzPanel;
  40.     RzPanel2: TRzPanel;
  41.     RzToolbar1: TRzToolbar;
  42.     RzToolButton1: TRzToolButton;
  43.     RzToolButton2: TRzToolButton;
  44.     RzToolButton3: TRzToolButton;
  45.     ICOlist: TImageList;
  46.     ListView1: TRzListView;
  47.     RzSpacer2: TRzSpacer;
  48.     RzToolButton4: TRzToolButton;
  49.     RzToolButton5: TRzToolButton;
  50.     RzToolButton9: TRzToolButton;
  51.     RzSpacer1: TRzSpacer;
  52.     RzToolButton6: TRzToolButton;
  53.     RzToolButton7: TRzToolButton;
  54.     RzToolButton8: TRzToolButton;
  55.     Splitter1: TSplitter;
  56.     RzPanel3: TRzPanel;
  57.     Label6: TLabel;
  58.     Label7: TLabel;
  59.     Label8: TLabel;
  60.     Label9: TLabel;
  61.     RzPanel4: TRzPanel;
  62.     RzToolbar2: TRzToolbar;
  63.     RzToolButton10: TRzToolButton;
  64.     RzEdit6: TRzEdit;
  65.     RzEdit7: TRzEdit;
  66.     RzCheckBox1: TRzCheckBox;
  67.     RzEdit8: TRzEdit;
  68.     RzPanel5: TRzPanel;
  69.     Label10: TLabel;
  70.     MailMessage: TIdMessage;
  71.     Mail: TIdSMTP;
  72.     SaveDialog2: TSaveDialog;
  73.     SaveDialog1: TSaveDialog;
  74.     OpenDialog2: TOpenDialog;
  75.     Label11: TLabel;
  76.     RzEdit9: TRzEdit;
  77.     RzMemo2: TRzMemo;
  78.     RzBitBtn1: TRzBitBtn;
  79.     RzBitBtn2: TRzBitBtn;
  80.     RzPanel6: TRzPanel;
  81.     Label12: TLabel;
  82.     ListBox1: TRzListBox;
  83.     RzBitBtn3: TRzBitBtn;
  84.     RzBitBtn4: TRzBitBtn;
  85.     TabSheet3: TRzTabSheet;
  86.     OpenDialog1: TOpenDialog;
  87.     Label13: TLabel;
  88.     SuccessList: TRzMemo;
  89.     Label14: TLabel;
  90.     FailList: TRzMemo;
  91.     ProgressBar1: TProgressBar;
  92.     ImageList1: TImageList;
  93.     Label15: TLabel;
  94.     RzSpacer3: TRzSpacer;
  95.     RzToolButton11: TRzToolButton;
  96.     RzPanel7: TRzPanel;
  97.     Label16: TLabel;
  98.     RzBitBtn5: TRzBitBtn;
  99.     RzBitBtn6: TRzBitBtn;
  100.     RzBitBtn7: TRzBitBtn;
  101.     RzBitBtn8: TRzBitBtn;
  102.     RzBitBtn9: TRzBitBtn;
  103.     RzBitBtn10: TRzBitBtn;
  104.     Label17: TLabel;
  105.     Label18: TLabel;
  106.     TimerSend: TTimer;
  107.     procedure RzBitBtn3Click(Sender: TObject);
  108.     procedure RzBitBtn4Click(Sender: TObject);
  109.     procedure RzBitBtn1Click(Sender: TObject);
  110.     procedure RzBitBtn2Click(Sender: TObject);
  111.     procedure FormDestroy(Sender: TObject);
  112.     procedure FormCreate(Sender: TObject);
  113.     procedure RzToolButton1Click(Sender: TObject);
  114.     procedure RzToolButton2Click(Sender: TObject);
  115.     procedure RzToolButton3Click(Sender: TObject);
  116.     procedure RzToolButton4Click(Sender: TObject);
  117.     procedure RzToolButton5Click(Sender: TObject);
  118.     procedure RzToolButton6Click(Sender: TObject);
  119.     procedure RzToolButton7Click(Sender: TObject);
  120.     procedure RzToolButton8Click(Sender: TObject);
  121.     procedure RzToolButton9Click(Sender: TObject);
  122.     procedure RzToolButton10Click(Sender: TObject);
  123.     procedure RzToolButton11Click(Sender: TObject);
  124.     procedure RzBitBtn5Click(Sender: TObject);
  125.     procedure RzBitBtn6Click(Sender: TObject);
  126.     procedure RzBitBtn7Click(Sender: TObject);
  127.     procedure RzBitBtn8Click(Sender: TObject);
  128.     procedure RzBitBtn9Click(Sender: TObject);
  129.     procedure RzBitBtn10Click(Sender: TObject);
  130.     procedure TimerSendTimer(Sender: TObject);
  131.   private
  132.     function TrimMessage(AMessage, AIdent, AEmail: string): string;
  133.     function DigitalToTime(I: integer): string;
  134.     { Private declarations }
  135.   public
  136.     { Public declarations }
  137.     procedure SendEmail1;
  138.     procedure SendEmail2;
  139.     procedure SetAddrQty;
  140.     procedure FillAddrList(AMemo: TRzMemo);
  141.   end;
  142.  
  143. var
  144.   frmMain: TfrmMain;
  145.   iCount: integer;
  146. implementation
  147.  
  148. uses AddEmail, PubUnit, ImportFromDB;
  149.  
  150. {$R *.dfm}
  151.  
  152. procedure TfrmMain.RzBitBtn3Click(Sender: TObject);
  153. begin
  154.   if OpenDialog1.Execute then
  155.   begin
  156.     TIdAttachment.Create(MailMessage.MessageParts, OpenDialog1.FileName);
  157.     ListBox1.Items.Add(OpenDialog1.FileName);
  158.   end;
  159. end;
  160.  
  161. procedure TfrmMain.RzBitBtn4Click(Sender: TObject);
  162. var
  163.   I: integer;
  164. begin
  165.   ListBox1.DeleteSelected;
  166.   MailMessage.MessageParts.Clear;
  167.   for I := 0 to ListBox1.Items.Count - 1 do
  168.   begin
  169.      TIdAttachment.Create(MailMessage.MessageParts, ListBox1.Items[I]);
  170.   end;
  171. end;
  172. procedure TfrmMain.RzBitBtn1Click(Sender: TObject);
  173. begin
  174.   if OpenDialog1.Execute then
  175.     RzMemo2.Lines.LoadFromFile(OpenDialog1.FileName);
  176. end;
  177.  
  178. procedure TfrmMain.RzBitBtn2Click(Sender: TObject);
  179. begin
  180.   if SaveDialog2.Execute then
  181.     RzMemo2.Lines.SaveToFile(SaveDialog2.FileName);
  182. end;
  183.  
  184. procedure TfrmMain.FormDestroy(Sender: TObject);
  185. var
  186.   Ini: TIniFile;
  187. begin
  188.   Ini := TIniFile.Create(ExtractFilePath(ParamStr(0))+'Setup.ini');
  189.   try
  190.     Ini.WriteString('SETUP', 'SMTP', Edit1.Text);
  191.     Ini.WriteString('SETUP', 'USRNME', Edit2.Text);
  192.     Ini.WriteString('SETUP', 'USRPWD', Edit3.Text);
  193.     Ini.WriteString('SETUP', 'EMAIL', Edit4.Text);
  194.     Ini.WriteString('SETUP', 'SENDER', Edit5.Text);
  195.   finally
  196.     Ini.Free;
  197.   end;
  198.  
  199. end;
  200.  
  201.  
  202. procedure TfrmMain.FormCreate(Sender: TObject);
  203. var
  204.   Ini: TIniFile;
  205. begin
  206.   Ini := TIniFile.Create(ExtractFilePath(ParamStr(0))+'Setup.ini');
  207.   try
  208.     Edit1.Text := Ini.ReadString('SETUP', 'SMTP', '');
  209.     Edit2.Text := Ini.ReadString('SETUP','USRNME', '');
  210.     Edit3.Text := Ini.ReadString('SETUP', 'USRPWD', '');
  211.     Edit4.Text := Ini.ReadString('SETUP', 'EMAIL', '');
  212.     Edit5.Text := Ini.ReadString('SETUP', 'SENDER', '');
  213.   finally
  214.     Ini.Free;
  215.   end;
  216.  
  217. end;
  218.  
  219. procedure TfrmMain.RzToolButton1Click(Sender: TObject);
  220. var
  221.   AnItem: TListItem;
  222. begin
  223.   with TfrmAddEmail.Create(Application) do
  224.   begin
  225.     ShowModal;
  226.     if ModalResult = mrOk then
  227.     begin
  228.       AnItem := ListView1.Items.Add;
  229.       AnItem.Caption := PubUnit.NewUser;
  230.       AnItem.SubItems.Add(PubUnit.NewMail);
  231.       SetAddrQty;
  232.     end;
  233.   end;
  234. end;
  235.  
  236. procedure TfrmMain.RzToolButton2Click(Sender: TObject);
  237. var
  238.   AnItem: TListItem;
  239. begin
  240.   if ListView1.SelCount = 1 then
  241.   with TfrmAddEmail.Create(Application) do
  242.   begin
  243.     AnItem := ListView1.Selected;
  244.     Edit1.Text := AnItem.Caption;
  245.     Edit2.Text := AnItem.SubItems[0];
  246.     ShowModal;
  247.     if ModalResult = mrOK then
  248.     begin
  249.       AnItem.Caption := PubUnit.NewUser;
  250.       AnItem.SubItems[0] := PubUnit.NewMail;
  251.     end;
  252.     SetAddrQty;
  253.   end;
  254. end;
  255.  
  256. procedure TfrmMain.RzToolButton3Click(Sender: TObject);
  257. begin
  258.   if ListView1.SelCount > 0 then
  259.     if Application.MessageBox('是否删除选中的邮件地址!', '确认',
  260.       MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2) = IDYES then
  261.         ListView1.DeleteSelected;
  262.         SetAddrQty;
  263. end;
  264.  
  265. procedure TfrmMain.RzToolButton4Click(Sender: TObject);
  266. var
  267.   AList: TStringList;
  268.   AnItem: TListItem;
  269.   I, J: integer;
  270. begin
  271.   AList := TStringList.Create;
  272.   try
  273.     if OpenDialog2.Execute then
  274.     begin
  275.       AList.LoadFromFile(OpenDialog2.FileName);
  276.       ListView1.Items.Clear;
  277.       for I := 0 to AList.Count - 1 do
  278.       begin
  279.          if AnsiPos('<|>', AList[I]) > 0 then
  280.          begin
  281.            J := AnsiPos('<|>', AList[I]);
  282.            AnItem := ListView1.Items.Add;
  283.            AnItem.Caption := Copy(AList[I], 1, J - 1);
  284.            AnItem.SubItems.Add(Copy(AList[I], J + 3, Length(AList[I])));
  285.          end;
  286.       end;
  287.       SetAddrQty;
  288.     end;
  289.   finally
  290.     AList.Free;
  291.   end;
  292. end;
  293.  
  294. procedure TfrmMain.RzToolButton5Click(Sender: TObject);
  295. var
  296.   AList: TStringList;
  297.   I: integer;
  298.   AnItem: TListItem;
  299. begin
  300.   if SaveDialog1.Execute then
  301.   begin
  302.     AList := TStringList.Create;
  303.     try
  304.       for I := 0 to ListView1.Items.Count - 1 do
  305.       begin
  306.         AnItem := ListView1.Items[I];
  307.         AList.Add(AnItem.Caption + '<|>' + AnItem.SubItems[0]);
  308.       end;
  309.       AList.SaveToFile(SaveDialog1.FileName);
  310.       SetAddrQty;
  311.     finally
  312.       AList.Free;
  313.     end;
  314.   end;
  315. end;
  316.  
  317. procedure TfrmMain.RzToolButton6Click(Sender: TObject);
  318. var
  319.   I: integer;
  320. begin
  321.   for I := 0 to ListView1.Items.Count - 1 do
  322.   begin
  323.     ListView1.Items[I].Checked := True;
  324.   end;
  325. end;
  326.  
  327. procedure TfrmMain.RzToolButton7Click(Sender: TObject);
  328. var
  329.   I: integer;
  330. begin
  331.   for I := 0 to ListView1.Items.Count - 1 do
  332.   begin
  333.     ListView1.Items[I].Checked := False;
  334.   end;
  335. end;
  336.  
  337. procedure TfrmMain.RzToolButton8Click(Sender: TObject);
  338. var
  339.   I: integer;
  340. begin
  341.   for I := 0 to ListView1.Items.Count - 1 do
  342.   begin
  343.     ListView1.Items[I].Checked := not ListView1.Items[I].Checked;
  344.   end;
  345. end;
  346.  
  347. procedure TfrmMain.RzToolButton9Click(Sender: TObject);
  348. begin
  349.   frmImportFromDB.Show;
  350. end;
  351.  
  352. procedure TfrmMain.SendEmail1;
  353.   function GetMailQty: integer;
  354.   var
  355.     I, J: integer;
  356.   begin
  357.     J := 0;
  358.     for I := 0  to ListView1.Items.Count - 1 do
  359.     begin
  360.       ListView1.Items[I].Selected := False;
  361.       if ListView1.Items[I].Checked = True then
  362.       begin
  363.         ListView1.Items[I].ImageIndex := 0;
  364.         J := J + 1;
  365.       end;
  366.     end;
  367.     Result := J;
  368.   end;
  369. var
  370.   total, I, J: integer;
  371.   AnItem: TListItem;
  372.   MailAddr, X1: string;
  373. begin
  374.   X1 := '"'+Edit5.Text+'" ' + '<' + RzEdit8.Text + '>';
  375.   total := GetMailQty;
  376.   J := 0;
  377.   if total > 0 then
  378.   begin
  379.     if Application.MessageBox('是否现在发送邮件?', '确认', MB_YESNO+MB_ICONQUESTION+MB_DEFBUTTON2)=idyes then
  380.     begin
  381.       iCount := 0;
  382.       TimerSend.Enabled := True;
  383.       ListView1.MultiSelect := False;
  384.       ProgressBar1.Position := 0;
  385.       ProgressBar1.Max := total;
  386.       SuccessList.Lines.Clear;
  387.       FailList.Lines.Clear;
  388.       if (RzcheckBox1.Checked = True) and (Length(RzEdit8.Text) > 0) then
  389.        begin
  390.          MailMessage.ExtraHeaders.Clear;
  391.          MailMessage.ExtraHeaders.Add('Disposition-Notification-To: ' + X1);
  392.        end;
  393.       for I := 0 to ListView1.Items.Count - 1 do
  394.       begin
  395.         AnItem := ListView1.Items[I];
  396.         if AnItem.Checked = True then
  397.         begin
  398.           try
  399.  
  400.             J := J + 1;
  401.             MailAddr := AnItem.SubItems[0];
  402.             AnItem.ImageIndex := 3;
  403.             AnItem.Selected := True;
  404.             AnItem.MakeVisible(True);
  405.             //
  406.             Label15.Caption := Format('正在发送邮件:' + MailAddr + ', [%d / %d 封]', [J, Total]);
  407.             ProgressBar1.Position := ProgressBar1.Position + 1;
  408.             Application.ProcessMessages;
  409.             Mail.Disconnect;
  410.             Mail.Host := Edit1.Text;
  411.             Mail.Username := Edit2.Text;
  412.             Mail.Password := Edit3.Text;
  413.             Mail.AuthenticationType := atLogin;
  414.             Mail.Connect;
  415.             MailMessage.From.Name := Edit5.Text;
  416.             if Length(Edit2.Text) > 0 then
  417.             MailMessage.From.Address := Edit4.Text;
  418.             MailMessage.ContentType := RzEdit7.Text;
  419.             MailMessage.CharSet := RzEdit9.Text;
  420.             MailMessage.ReplyTo.Clear;
  421.  
  422.             MailMessage.Subject := RzEdit6.Text;
  423.             MailMessage.Body.SetText(Pchar(TrimMessage(RzMemo2.Lines.GetText, '<%mail%>', MailAddr)));
  424.             MailMessage.Recipients.EMailAddresses := MailAddr;
  425.             Mail.Send(MailMessage);
  426.             SuccessList.Lines.Add(AnItem.Caption + '<|>' + MailAddr);
  427.             AnItem.ImageIndex := 1;
  428.           except
  429.             on E: Exception do
  430.             begin
  431.               AnItem.ImageIndex := 2;
  432.               AnItem.Selected := True;
  433.               FailList.Lines.Add(AnItem.Caption + '<|>' + MailAddr);
  434.             end;
  435.           end;
  436.         end;
  437.       end;
  438.       progressbar1.Position := 0;
  439.       Label18.Caption := '剩余时间:00:00:00';
  440.       TimerSend.Enabled := False;
  441.       Label15.Caption := '邮件发送完毕!';
  442.       ListView1.MultiSelect := True;
  443.     end;
  444.   end
  445.   else
  446.   MessageDlg('未指定收件人!', mtInformation, [MBOK], 0);
  447. end;
  448.  
  449. procedure TfrmMain.RzToolButton10Click(Sender: TObject);
  450. begin
  451.   SendEmail1;
  452. end;
  453.  
  454. function TfrmMain.TrimMessage(AMessage, AIdent, AEmail: string): string;
  455. var
  456.   I: integer;
  457.   S1, S2: string;
  458.   S: string;
  459. begin
  460.   AIdent := '<%mail%>';
  461.   S := AMessage;
  462.   while AnsiPos(AIdent, S) > 0 do
  463.   begin
  464.     I := AnsiPos(AIdent, S);
  465.     if I > 0 then
  466.     begin
  467.       S1 := Copy(S, 1, I - 1);
  468.       S2 := Copy(S, I + 8, Length(S));
  469.       S := S1 + AEmail + S2;
  470.     end
  471.     else
  472.     begin
  473.       S := AMessage;
  474.     end;
  475.   end;
  476.   Result := S;
  477. end;
  478. procedure TfrmMain.SendEmail2;
  479.   function GetMailQty: integer;
  480.   var
  481.     I, J: integer;
  482.   begin
  483.     J := 0;
  484.     for I := 0  to ListView1.Items.Count - 1 do
  485.     begin
  486.       ListView1.Items[I].Selected := False;
  487.       if ListView1.Items[I].Checked = True then
  488.       begin
  489.         ListView1.Items[I].ImageIndex := 0;
  490.         J := J + 1;
  491.         //ListView1.Items[I].SubItems[1] := '';
  492.       end;
  493.     end;
  494.     Result := J;
  495.   end;
  496. var
  497.   total, I: integer;
  498.   AnItem: TListItem;
  499.   MailAddr, X1: string;
  500.   AD: TIdEMailAddressItem;
  501. begin
  502.   Label15.Caption := '';
  503.   X1 := '"'+Edit5.Text+'" ' + '<' + RzEdit8.Text + '>';
  504.   total := GetMailQty;
  505.   if total > 0 then
  506.   begin
  507.     if Application.MessageBox('是否现在发送邮件?', '确认', MB_YESNO+MB_ICONQUESTION+MB_DEFBUTTON2)=idyes then
  508.     begin
  509.       ProgressBar1.Position := 0;
  510.       ProgressBar1.Max := total;
  511.       SuccessList.Lines.Clear;
  512.       FailList.Lines.Clear;
  513.       //Memo2.Lines.Add('******SENT LIST ********');
  514.       if (RzcheckBox1.Checked = True) and (Length(RzEdit8.Text) > 0) then
  515.        begin
  516.          MailMessage.ExtraHeaders.Clear;
  517.          MailMessage.ExtraHeaders.Add('Disposition-Notification-To: ' + X1);
  518.        end;
  519.        MailMessage.Recipients.Clear;
  520.        for I := 0 to ListView1.Items.Count - 1 do
  521.        begin
  522.          AnItem := ListView1.Items[I];
  523.          if AnItem.Checked then
  524.          begin
  525.            AD := MailMessage.Recipients.Add;
  526.            AD.Name := AnItem.Caption;
  527.            AD.Address := AnItem.SubItems[0];
  528.          end;
  529.        end;
  530.        //发送邮件;
  531.        Mail.Disconnect;
  532.        Mail.Host := Edit1.Text;
  533.        Mail.Username := Edit2.Text;
  534.        Mail.Password := Edit3.Text;
  535.        Mail.AuthenticationType := atLogin;
  536.        Mail.Connect;
  537.        //MailMessage.Clear;
  538.        MailMessage.From.Name := Edit5.Text;
  539.        if Length(Edit2.Text) > 0 then
  540.        MailMessage.From.Address := Edit4.Text;
  541.        MailMessage.ContentType := RzEdit7.Text;
  542.        MailMessage.CharSet := RzEdit9.Text;
  543.        MailMessage.ReplyTo.Clear;
  544.  
  545.        MailMessage.Subject := RzEdit6.Text;
  546.        MailMessage.Body.SetText(Pchar(TrimMessage(RzMemo2.Lines.GetText, '<%mail%>', MailAddr)));
  547.        Mail.Send(MailMessage);
  548.      
  549.       progressbar1.Position := 0;
  550.       Label15.Caption := '邮件发送完毕!';
  551.     end;
  552.   end
  553.   else
  554.   MessageDlg('no recipients specified!', mtInformation, [MBOK], 0);
  555. end;
  556.  
  557. procedure TfrmMain.RzToolButton11Click(Sender: TObject);
  558. begin
  559.   Self.SendEmail2;
  560. end;
  561.  
  562. procedure TfrmMain.SetAddrQty;
  563. begin
  564.   Label16.Caption := '地址总数:' + IntToStr(ListView1.Items.Count);
  565. end;
  566.  
  567. procedure TfrmMain.RzBitBtn5Click(Sender: TObject);
  568. begin
  569.   if SaveDialog1.Execute then
  570.     SuccessList.Lines.SaveToFile(SaveDialog1.FileName);
  571. end;
  572.  
  573. procedure TfrmMain.RzBitBtn6Click(Sender: TObject);
  574. begin
  575.   if SaveDialog1.Execute then
  576.     FailList.Lines.SaveToFile(SaveDialog1.FileName);
  577. end;
  578.  
  579. procedure TfrmMain.FillAddrList(AMemo: TRzMemo);
  580. var
  581.   I, J: integer;
  582.   AnItem: TListItem;
  583. begin
  584.   if Application.MessageBox('此操作将清除当前发送列表的所有地址!是否继续?',
  585.     '确认', MB_YESNO + MB_ICONQUESTION) = IDYES then
  586.     begin
  587.       ListView1.Items.Clear;
  588.       for I := 0 to AMemo.Lines.Count - 1 do
  589.       begin
  590.         if AnsiPos('<|>', AMemo.Lines[I]) > 0 then
  591.          begin
  592.            J := AnsiPos('<|>', AMemo.Lines[I]);
  593.            AnItem := ListView1.Items.Add;
  594.            AnItem.Caption := Copy(AMemo.Lines[I], 1, J - 1);
  595.            AnItem.SubItems.Add(Copy(AMemo.Lines[I], J + 3, Length(AMemo.Lines[I])));
  596.          end;
  597.       end;
  598.     end;
  599. end;
  600.  
  601. procedure TfrmMain.RzBitBtn7Click(Sender: TObject);
  602. begin
  603.   FillAddrList(SuccessList);
  604. end;
  605.  
  606. procedure TfrmMain.RzBitBtn8Click(Sender: TObject);
  607. begin
  608.   FillAddrList(FailList);
  609. end;
  610.  
  611. procedure TfrmMain.RzBitBtn9Click(Sender: TObject);
  612. begin
  613.   if Application.MessageBox('确实要清除!',
  614.     '确认', MB_YESNO + MB_ICONQUESTION) = IDYES then
  615.       SuccessList.Lines.Clear;
  616. end;
  617.  
  618. procedure TfrmMain.RzBitBtn10Click(Sender: TObject);
  619. begin
  620.   if Application.MessageBox('确实要清除!',
  621.     '确认', MB_YESNO + MB_ICONQUESTION) = IDYES then
  622.       FailList.Lines.Clear;
  623. end;
  624.  
  625. function TfrmMain.DigitalToTime(I: integer): string;
  626.   function FrmStr(S: string): string;
  627.   begin
  628.     Result := S;
  629.     if Length(Result) = 1 then Result := '0' + Result;
  630.   end;
  631. var
  632.   A, B, C: integer;
  633.   H, M, S: string;
  634. begin
  635.   A := I div 3600;
  636.   B := (I - A * 3600) div 60;
  637.   C := I - (A * 3600 + B * 60);
  638.   H := IntToStr(A);
  639.   M := IntToStr(B);
  640.   S := IntToStr(C);
  641.   Result := FrmStr(H) + ':' + FrmStr(M) + ':' + FrmStr(S);
  642. end;
  643.  
  644. procedure TfrmMain.TimerSendTimer(Sender: TObject);
  645. var
  646.   TimeLeft: integer;
  647. begin
  648.   Inc(iCount);
  649.   if ProgressBar1.Max > 0 then
  650.   begin
  651.     TimeLeft := ProgressBar1.Max - iCount;
  652.     Label17.Caption := '已用时间:' + DigitalToTime(iCount);
  653.     Label18.Caption := '剩余时间:' + DigitalToTime(TimeLeft);
  654.     Application.ProcessMessages;
  655.   end;
  656. end;
  657.  
  658. end.
  659.  
descargarmain.pas Código fuente - Descargar Correo sistema v1.2 Código fuente
Códigos/Software de fuente relacionados:
Acuario FLASH humor diario v1.0 - Modifica la carpeta admin\\data en el nombre de "g... 2.28KB
Enrejado pabellón enrejado sitio v2.0 - Base de datosadminadmin 940byte
Geeklog v1.4.1 versión multi-idioma - Libre open source software WEBLOG que permite a lo... 3.47KB
SI-Ting de dominio nombre red comercial v2.0 - Directorio admin admin admin admin password admin 1.27KB
Mini BBS v2.2 acceso GB2312 - Interfaz es limpia, sencilla, arquitectura DIV + C... 2.79KB
Cliente SQL v1.0 - Cliente SQL v1.0 1.64KB
MyReminder V1.0 (recordatorio) - MyReminder V1.0 (recordatorio) 2.29KB
Pared de la fruta v1.0 (año de la nueva edición) - Fruta ASPK pared basado en la versión 1.5, utiliza... 688byte
Palabra clave sitio construir sistema PHP versión v1.4 - Un generador automático de sitio Web, puede propor... 104byte
China 2008 (signo + voto) - 2008 China mantenga fuenteInstrucciones de ins... 496byte
Nueva nube sitio Web content management sistema v4.0.0 - Este sistema es un conjunto de sistema de gestión ... 5.85KB
Un Add-ins de la VB. El proyecto puede ser... - Un Add-ins de la VB. Su proyecto puede ser comprim... 52byte
Sistema de circulación de documentos (c#) - C# + estructura MSSQL, en gran parte basado en la ... 38.16KB
NET Netmao_Movie gato televisión widescreen sistema v1.0 - Estación total genera HTML, reducir la carga del s... 1.46KB
A través de Windows IPHelper... - Un tráfico de red a través de programa de sistema ... 204byte
Enshidiqu Internet IP gestión sistema v1.0 - 1. la adhesión a las tablas de dos datos, un ofici... 392byte
Envía una herramienta de mensaje de red - Envía una herramienta de mensaje de red 48byte
NaviWhois dominio nombre búsqueda v2.0 - 1) programas desarrollados utilizando Visual Studi... 184byte
NTsky comunicado de prensa v1.0 (proporcionar un JavaBean) - En dos partes de la administración del sistema, re... 2.77KB

 Volver arriba