Имеется список e-mail адресов. Имеется Edit в котором указывается путь к файлу вложения, но есть проблемка... Незнаю как сделать так чтобы для каждого адреса можно было выбирать свой файл. А то сейчас один файл рассылается по всем адресатам.
| Код |
unit SendForm;
interface
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, Menus,
StdCtrls, Dialogs, Buttons, Messages, ExtCtrls, ComCtrls,
IdComponent, IdTCPConnection, IdTCPClient,
IdMessageClient, IdSMTP, IdBaseComponent, IdMessage;
type
TMainForm = class(TForm)
Panel2: TPanel;
reMessageText: TRichEdit;
Panel1: TPanel;
Label1: TLabel;
eName: TEdit;
Splitter1: TSplitter;
ListLog: TListBox;
Label2: TLabel;
eSubject: TEdit;
Label3: TLabel;
BbtnAddToList: TButton;
ListAddr: TListBox;
BtnRemove: TButton;
BtnFind: TButton;
Label5: TLabel;
eFrom: TEdit;
BtnSendAll: TButton;
MailMessage: TIdMessage;
Mail: TIdSMTP;
DateTimePicker1: TDateTimePicker;
Label4: TLabel;
Button1: TButton;
Button2: TButton;
ListDirect: TListBox;
Button3: TButton;
OpenDialog1: TOpenDialog;
Edit1: TEdit;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure BtnSendAllClick(Sender: TObject);
procedure BbtnAddToListClick(Sender: TObject);
procedure BtnRemoveClick(Sender: TObject);
procedure BtnFindClick(Sender: TObject);
procedure MailConnected(Sender: TObject);
procedure MailDisconnected(Sender: TObject);
procedure MailStatus(axSender: TObject; const axStatus: TIdStatus;
const asStatusText: String);
procedure MailWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
procedure MailWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
FileName: string;
end;
var
MainForm: TMainForm;
implementation
{$R *.DFM}
procedure TMainForm.FormCreate(Sender: TObject);
begin
// load the list of addresses
FileName := ChangeFileExt (Application.ExeName, '.txt');
ListAddr.Items.LoadFromFile (FileName);
ListLog.Items.Add ('Addresses: ' + IntToStr (
ListAddr.Items.Count));
// select the first item
ListAddr.ItemIndex := 0;
end;
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// save the list of addresses
ListAddr.Items.SaveToFile (FileName);
end;
const
BccInMsg = 30;
procedure TMainForm.BtnSendAllClick(Sender: TObject);
var
i: integer;
curSendTo, curDir: string;
ADate: TDateTime ;
nItem: Integer;
Res: Word;
att: TIdAttachment;
sAttName: string;
begin
Res := MessageDlg ('Начать отправку почты на ' +
IntToStr (ListAddr.ItemIndex) + ' (' +
ListAddr.Items [ListAddr.ItemIndex] + ')?'#13 +
'(No starts form 0)' ,
mtConfirmation,
[mbYes, mbNo, mbCancel], 0);
if Res = mrCancel then
Exit;
if Res = mrYes then
nItem := ListAddr.ItemIndex
else
nItem := 0;
// connect
Mail.Host := 'serv';
Mail.Username := 'clientbank';
Mail.Password := 'clientbank';
Mail.AuthenticationType := atLogin;
Mail.Connect;
// send the messages, one by one, prepending a custom message
try
// set the fixed part of the header
MailMessage.From.Name := '[email protected]';
MailMessage.Subject := 'Vipiska';
MailMessage.Body.SetText (
reMessageText.Lines.GetText);
MailMessage.Body.Insert (0, 'Добрый день');
while nItem < ListAddr.Items.Count do
begin
sAttName:= Edit1.Text; // Я так понимаю что генерировать адресс файла нужно сдесь
if sAttName <> '' then
if FileExists(sAttName) then
att := TIdAttachment.Create( MailMessage.MessageParts, sAttName); // создаем вложение
// show the current selection
ListAddr.ItemIndex := nItem;
Application.ProcessMessages;
// ListAddr.ItemIndex := nItem;
MailMessage.Body [0] := 'Добрый день ' + ListAddr.Items [nItem];
MailMessage.Recipients.EMailAddresses := ListAddr.Items [nItem];
Mail.Send(MailMessage);
FreeAndNil( att ); // убираем вложение перед следующей отправкой
Inc (nItem);
end;
finally // we're done
Mail.Disconnect;
end;
end;
procedure TMainForm.BbtnAddToListClick(Sender: TObject);
begin
ListAddr.ItemIndex :=
ListAddr.Items.Add (eName.Text);
end;
procedure TMainForm.BtnRemoveClick(Sender: TObject);
begin
// copy the item to the name edit box and remove it
eName.Text := ListAddr.Items [ListAddr.ItemIndex];
ListAddr.Items.Delete (ListAddr.ItemIndex);
end;
procedure TMainForm.BtnFindClick(Sender: TObject);
var
I: Integer;
begin
for I := 0 to ListAddr.Items.Count - 1 do
if Pos (eName.Text, ListAddr.Items [I]) > 0 then
begin
ListAddr.ItemIndex := I;
Break;
end;
Beep;
end;
procedure TMainForm.MailConnected(Sender: TObject);
begin
ListLog.Items.Add ('Connected to host');
end;
procedure TMainForm.MailDisconnected(Sender: TObject);
begin
ListLog.Items.Add ('Disconnected from host');
end;
procedure TMainForm.MailStatus(axSender: TObject;
const axStatus: TIdStatus; const asStatusText: String);
begin
ListLog.Items.Add (asStatusText);
end;
procedure TMainForm.MailWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
begin
ListLog.Items.Add ('Sending to: ' +
MailMessage.Recipients.EMailAddresses);
end;
procedure TMainForm.MailWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
ListLog.Items.Add ('Done');
end;
procedure TMainForm.Button2Click(Sender: TObject);
begin
Close;
end;
procedure TMainForm.Button3Click(Sender: TObject);
var
n: Integer;
begin
if OpenDialog1.Execute then
for n:= 0 to OpenDialog1.Files.Count - 1 do
Edit1.Text:= OpenDialog1.Files[n];
end;
end.
|
|