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

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
SendForm.pas
资源名称：delphi.rar　[点击查看]
上传用户：fh681027
上传日期：2022-07-23
资源大小：1959k
文件大小：5k
源码类别：

Delphi控件源码

开发平台：

Delphi

SendForm.pas：源码内容
  1. unit SendForm;
  3. interface
  5. uses Windows, SysUtils, Classes, Graphics, Forms, Controls, Menus,
  6.   StdCtrls, Dialogs, Buttons, Messages, ExtCtrls, ComCtrls,
  7.   Psock, NMsmtp, IdComponent, IdTCPConnection, IdTCPClient,
  8.   IdMessageClient, IdSMTP, IdBaseComponent, IdMessage;
  10. type
  11.   TMainForm = class(TForm)
  12.     Panel2: TPanel;
  13.     reMessageText: TRichEdit;
  14.     Panel1: TPanel;
  15.     Label1: TLabel;
  16.     eName: TEdit;
  17.     Splitter1: TSplitter;
  18.     ListLog: TListBox;
  19.     Label2: TLabel;
  20.     eSubject: TEdit;
  21.     Label3: TLabel;
  22.     BbtnAddToList: TButton;
  23.     ListAddr: TListBox;
  24.     BtnRemove: TButton;
  25.     BtnFind: TButton;
  26.     Label5: TLabel;
  27.     eFrom: TEdit;
  28.     BtnSendAll: TButton;
  29.     eServer: TEdit;
  30.     MailMessage: TIdMessage;
  31.     Mail: TIdSMTP;
  32.     Label4: TLabel;
  33.     Label6: TLabel;
  34.     eUserName: TEdit;
  35.     Password: TLabel;
  36.     ePassword: TEdit;
  37.     procedure FormCreate(Sender: TObject);
  38.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  39.     procedure BtnSendAllClick(Sender: TObject);
  40.     procedure BbtnAddToListClick(Sender: TObject);
  41.     procedure BtnRemoveClick(Sender: TObject);
  42.     procedure BtnFindClick(Sender: TObject);
  43.     procedure MailConnected(Sender: TObject);
  44.     procedure MailDisconnected(Sender: TObject);
  45.     procedure MailStatus(axSender: TObject; const axStatus: TIdStatus;
  46.       const asStatusText: String);
  47.     procedure MailWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  48.       const AWorkCountMax: Integer);
  49.     procedure MailWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
  50.   private
  51.     FileName: string;
  52.   end;
  54. var
  55.   MainForm: TMainForm;
  57. implementation
  59. {$R *.DFM}
  61. procedure TMainForm.FormCreate(Sender: TObject);
  62. begin
  63.   // load the list of addresses
  64.   FileName := ChangeFileExt (Application.ExeName, '.txt');
  65.   ListAddr.Items.LoadFromFile (FileName);
  66.   ListLog.Items.Add ('Addresses: ' + IntToStr (
  67.     ListAddr.Items.Count));
  68.   // select the first item
  69.   ListAddr.ItemIndex := 0;
  70. end;
  72. procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
  73. begin
  74.   // save the list of addresses
  75.   ListAddr.Items.SaveToFile (FileName);
  76. end;
  78. const
  79.   BccInMsg = 30;
  81. procedure TMainForm.BtnSendAllClick(Sender: TObject);
  82. var
  83.   nItem: Integer;
  84.   Res: Word;
  85. begin
  86.   Res := MessageDlg ('Start sending from item ' +
  87.       IntToStr (ListAddr.ItemIndex) + ' (' +
  88.       ListAddr.Items [ListAddr.ItemIndex] + ')?'#13 +
  89.       '(No starts form 0)',
  90.       mtConfirmation,
  91.       [mbYes, mbNo, mbCancel], 0);
  92.   if Res = mrCancel then
  93.     Exit;
  94.   if Res = mrYes then
  95.     nItem := ListAddr.ItemIndex
  96.   else
  97.     nItem := 0;
  99.   // connect
  100.   Mail.Host := eServer.Text;
  101.   Mail.UserID := eUserName.Text;
  102.   if ePassword.Text <> '' then
  103.   begin
  104.     Mail.Password := ePassword.Text;
  105.     Mail.AuthenticationType := atLogin;
  106.   end;
  107.   Mail.Connect;
  109.   // send the messages, one by one, prepending a custom message
  110.   try
  111.     // set the fixed part of the header
  112.     MailMessage.From.Name := eFrom.Text;
  113.     MailMessage.Subject := eSubject.Text;
  114.     MailMessage.Body.SetText (
  115.       reMessageText.Lines.GetText);
  116.     MailMessage.Body.Insert (0, 'Hello');
  118.     while nItem < ListAddr.Items.Count do
  119.     begin
  120.       // show the current selection
  121.       Application.ProcessMessages;
  122.       ListAddr.ItemIndex := nItem;
  123.       MailMessage.Body [0] := 'Hello ' + ListAddr.Items [nItem];
  124.       MailMessage.Recipients.EMailAddresses := ListAddr.Items [nItem];
  125.       Mail.Send(MailMessage);
  126.       Inc (nItem);
  127.     end;
  128.   finally // we're done
  129.     Mail.Disconnect;
  130.   end;
  131. end;
  133. procedure TMainForm.BbtnAddToListClick(Sender: TObject);
  134. begin
  135.   ListAddr.ItemIndex :=
  136.     ListAddr.Items.Add (eName.Text);
  137. end;
  139. procedure TMainForm.BtnRemoveClick(Sender: TObject);
  140. begin
  141.   // copy the item to the name edit box and remove it
  142.   eName.Text := ListAddr.Items [ListAddr.ItemIndex];
  143.   ListAddr.Items.Delete (ListAddr.ItemIndex);
  144. end;
  146. procedure TMainForm.BtnFindClick(Sender: TObject);
  147. var
  148.   I: Integer;
  149. begin
  150.   for I := 0 to ListAddr.Items.Count - 1 do
  151.     if Pos (eName.Text, ListAddr.Items [I]) > 0 then
  152.     begin
  153.       ListAddr.ItemIndex := I;
  154.       Break;
  155.     end;
  156.   Beep;
  157. end;
  159. procedure TMainForm.MailConnected(Sender: TObject);
  160. begin
  161.   ListLog.Items.Add ('Connected to host');
  162. end;
  164. procedure TMainForm.MailDisconnected(Sender: TObject);
  165. begin
  166.   ListLog.Items.Add ('Disconnected from host');
  167. end;
  169. procedure TMainForm.MailStatus(axSender: TObject;
  170.   const axStatus: TIdStatus; const asStatusText: String);
  171. begin
  172.   ListLog.Items.Add (asStatusText);
  173. end;
  175. procedure TMainForm.MailWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  176.   const AWorkCountMax: Integer);
  177. begin
  178.   ListLog.Items.Add ('Sending to: ' +
  179.     MailMessage.Recipients.EMailAddresses);
  180. end;
  182. procedure TMainForm.MailWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
  183. begin
  184.   ListLog.Items.Add ('Done');
  185. end;
  187. end.