Code:

type

TMailClient = class(TCollectionItem)

private

FName: string;

FAddress: string;

FEnabled: boolean;

FFolders: TStringList;

public

Files: TStringList; // список файлов к рассылке. заполняется в run-time. Сохранению не подлежит

constructor Create(Collection: TCollection); override;

destructor Destroy; override;

procedure PickFiles;

published

propertyName: stringread FName write FName; // имя адресата

property Address: stringread FAddress write FAddress; // почтовый адрес

property Enabled: boolean read FEnabled write FEnabled default true;

property Folders: TStringList read FFolders write FFolders; // список папок (тем) подписки

end;

Code:

TMailList = class(TCollection)

public

function GetMailClient(Index: Integer): TMailClient;

procedure SetMailClient(Index: Integer; Value: TMailClient);

public

function Add: TMailClient;

property Items[Index: Integer]: TMailClient read GetMailClient write SetMailClient; default;

end;

Code:

TMailer = class(TComponent)

private

FMailList: TMailList;

public

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

published

property MailList: TMailList read FMailList write FMailList; // коллекция - список рассылки.

// здесь можно поместить, к примеру, данные о соединении с почтовым сервером

end;

Code:

constructor TMailClient.Create(Collection: TCollection);

begin

inherited;

Folders := TStringList.Create;

Files := TStringList.Create;

FEnabled := true;

end;

destructor TMailClient.Destroy;

begin

Folders.Free;

Files.Free;

inherited;

end;

// здесь во всех каталогах Folders ищем файлы для рассылки и помещаем их в Files.

procedure TMailClient.PickFiles;

var i: integer;

begin

for i:=0to Folders.Count-1do CreateFileList(Files, Folders[i]);

end;

// Стандартный код при наследовании от класса коллекции: переопределяем тип

function TMailList.GetMailClient(Index: Integer): TMailClient;

begin

Result := TMailClient(inherited Items[Index]);

end;

// Стандартный код при наследовании от класса коллекции

procedure TMailList.SetMailClient(Index: Integer; Value: TMailClient);

begin

Items[Index].Assign(Value);

end;

// Стандартный код при наследовании от класса коллекции: переопределяем тип

function TMailList.Add: TMailClient;

begin

Result := TMailClient(inherited Add);

end;

// создаем коллекцию адресатов рассылки TMailList

constructor TMailer.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

MailList := TMailList.Create(TMailClient);

end;

destructor TMailer.Destroy;

begin

MailList.Free;

inherited;

end;

//---------------------

Code:

procedure CreateFileList(sl: TStringList; const FilePath: string);

var

sr: TSearchRec;

procedure ProcessFile;

begin

if (sr.Name = '.')or(sr.Name = '..') then exit;

if sr.Attr <> faDirectory then

sl.Add(FilePath + '\' + sr.Name);

if sr.Attr = faDirectory then

begin

CreateFileList(sl, FilePath + '\' + sr.Name);

end;

end;

begin

ifnot DirectoryExists(FilePath) then exit;

if FindFirst(FilePath + '\' + '*.*', faAnyFile , sr) = 0then ProcessFile;

while FindNext(sr) = 0do ProcessFile;

FindClose(sr);

end;

Code:

var

Mailer: TMailer; // это наш объект для хранения данных о почтовой рассылки

// Процедура загрузки данных в объект. Может быть процедурой OnCreate() главной формы.

procedure TfMain.FormCreate(Sender: TObject);

var

sDataFile, sTmp: string;

i, j: integer;

begin

Mailer := TMailer.Create(self);

// будем считать, что данные были сохранены в файл users.dat в каталоге программы

sDataFile := ExtractFilePath(ParamStr(0)) + 'users.dat';

//...загрузка данных из файла

if FileExists(sDataFile) then

LoadComponentFromTextFile(Mailer, sDataFile);

{ здесь данные из файла загружены }

//...перебор подписчиков

for i:=0to Mailer.MailList.Count-1do

begin

sTmp := Mailer.MailList[i].Name; //...обращение к имени

sTmp := Mailer.MailList[i].Address; //...обращение к адресу

//... sTmp - фиктивная переменная. Поменяйте ее на свои.

Mailer.MailList[i].PickFiles; //... поиск файлов для отправки очередному подписчику.

//...перебор найденных файлов к отправке

for j:=0to Mailer.MailList[i].Files.Count-1do

begin

sTmp := Mailer.MailList[i].Files[j];

end;

end;

end;

Code:

// Процедура сохранения данных из объекта в файл. Может быть процедурой OnDestroy() главной формы.

procedure TfMain.OnDestroy;

begin

//...сохранение данных в файл users.dat

SaveComponentToTextFile(Mailer, ExtractFilePath(ParamStr(0)) + 'users.dat');

end;

Code:

//...процедура загружает(инициализирует) компонент из текстового файла с ресурсом

procedure LoadComponentFromTextFile(Component: TComponent; const FileName: string);

var

ms: TMemoryStream;

fs: TFileStream;

begin

fs := TFileStream.Create(FileName, fmOpenRead);

ms := TMemoryStream.Create;

try

ObjectTextToBinary(fs, ms);

ms.position := 0;

ms.ReadComponent(Component);

finally

ms.Free;

fs.free;

end;

end;

//...процедура сохраняет компонент в текстовый файл

procedure SaveComponentToTextFile(Component: TComponent; const FileName: string);

var

ms: TMemoryStream;

fs: TFileStream;

begin

fs := TFileStream.Create(FileName, fmCreate or fmOpenWrite);

ms := TMemoryStream.Create;

try

ms.WriteComponent(Component);

ms.position := 0;

ObjectBinaryToText(ms, fs);

finally

ms.Free;

fs.free;

end;

end;