A very long time ago, I was floundering with the concept of developing
an object that could retain an array of child objects. The idea was to
allow the parent object to save its children to disk, and then recall
them when necessary. Many e-mails to this group have produced the
solution below…
The repository component has been designed so that you hand it a
template object once instantiated. This template object will be the…
template for your child objects of course. As long as the child objects
are derived from TPersistent, you won’t have a problem.
I designed the Repository in Delphi 5 to be used as a ‘poor man’s
database.’ Something that could hold a few thousand records of
information with as small a resource footprint as possible. It’s more
flexible than a record, because the child objects don’t have the
limitation of fixed dimensions. If the template object were say a
TBitmap, you could retain a single data file for hundreds of images.
I’d like to thank everyone in the Delphi Digest who replied to my
earlier e-mails. Without their help, this component wouldn’t exist. I
have no idea if anyone will find this useful, but if they do, feel free
to let me know. As for the terms of use (smile), butcher it, rip it off,
hack it to pieces… It was made for learning purposes.
Although I’d love it if you gave me credit of course (grin).
----- Code As Follows -----
unit Repository;
interface
{declare the libraries required by this unit}
uses
SysUtils, Classes, Controls, Forms, TypInfo;
type
{declare the repository used for storing data objects}
TRepository = class(TComponent)
private
{declare the property class fields}
FTemplate: TComponent;
{declare the array used for storing data objects}
DataObjects: array of TComponent;
{declare the method used for getting the data object template}
procedure SetTemplate(ADataObject: TComponent);
public
{declare the constructor and destructor}
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
{declare the methods used for passing a reference to data objects}
function PointToDataObject(Position: integer): Pointer; overload;
function PointToDataObject(PropName, PropValue: string): Pointer; overload;
{declare the methods used for loading, saving and deleting data objects}
function CreateDataObject: Pointer;
function DeleteDataObject(PDataObject: Pointer): boolean;
function LoadDataObject(ADataObject: TComponent): boolean;
function SaveDataObject(ADataObject: TComponent): boolean;
{declare the methods used for loading and saving the repository file}
function Load(FilePath: string): boolean;
function Save(FilePath: string): boolean;
{declare the methods used for miscellanious handling of data objects}
function Clear: boolean;
function Count: integer;
published
{declare the properties}
property Template: TComponent write SetTemplate;
end;
implementation
{------------------------------------------------------------------------------}
{define the method used for getting the data object template}
{------------------------------------------------------------------------------}
procedure TRepository.SetTemplate(ADataObject: TComponent);
begin
{instantiate a data object template from the passed data object}
FTemplate := TComponent(ADataObject.ClassType.Create);
end;
{------------------------------------------------------------------------------}
{define the constructor and destructor}
{------------------------------------------------------------------------------}
{define the constructor}
constructor TRepository.Create(AOwner: TComponent);
begin
{inherit the ancestors constructor}
inherited Create(AOwner);
end;
{define the destructor}
destructor TRepository.Destroy;
begin
{if a data object template has been defined, destroy it}
if FTemplate <> nil then
FTemplate.Free;
{inherit the ancestors destructor}
inherited Destroy;
end;
{------------------------------------------------------------------------------}
{define the methods for passing a reference to data objects}
{------------------------------------------------------------------------------}
{define the 'PointToDataObject' overloaded method used for locating a
specific
data object with its index value}
function TRepository.PointToDataObject(Position: integer): Pointer;
begin
{set the default result}
Result := nil;
{if the data object template has been specified, continue}
if FTemplate <> nil then
begin
{if the passed position is valid, continue}
if Position < Length(DataObjects) then
begin
{return a reference to the specified data object}
Result := @DataObjects[Position];
end;
end;
end;
{define the 'PointToDataObject' overloaded method used for locating a
specific
data object by searching with a property name and value}
function TRepository.PointToDataObject(PropName, PropValue: string):
Pointer;
var
IncX, IncY: integer;
ObjectName: TObject;
PropList: PPropList;
TypeData: PTypeData;
TypeInfo: PTypeInfo;
begin
{set the default result}
Result := nil;
{if the data object template has been specified, continue}
if FTemplate <> nil then
begin
{increment through each data object in the array}
for IncX := 0 to Length(DataObjects) - 1 do
begin
{get the data object to be accessed}
ObjectName := DataObjects[IncX];
{get a pointer to the RTTI table for the data object's type}
TypeInfo := ObjectName.ClassInfo;
{get a pointer to the RTTI table for the data object's data}
TypeData := GetTypeData(TypeInfo);
{instantiate the property list}
New(PropList);
{get a list of the data object's properties}
GetPropInfos(TypeInfo, PropList);
{increment through each of the data object's properties}
for IncY := 0 to TypeData^.PropCount - 1 do
begin
{if the property is not an event or method then continue}
if PropList^[IncY].PropType^.Kind <> tkMethod then
begin
{if the property name matches the passed name, continue}
if PropList^[IncY].Name = PropName then
begin
{handle the property value type}
case PropList^[IncY].PropType^.Kind of
{any properties containing string values}
tkString, tkLString, tkWString:
begin
{if the property value matches the passed value, continue}
if GetStrProp(ObjectName, PropList^[IncY].Name) = PropValue then
begin
{return a reference to the specified data object}
Result := @DataObjects[IncX];
{terminate the method}
Exit;
end;
end;
end;
end;
end;
end;
end;
end;
end;
{------------------------------------------------------------------------------}
{define the methods used for loading, saving and deleting data objects}
{------------------------------------------------------------------------------}
{define the 'CreateDataObject' method used for creating stored data objects}
function TRepository.CreateDataObject: Pointer;
begin
{set the default result}
Result := nil;
{if the data object template has been specified, continue}
if FTemplate <> nil then
begin
{create a new data object in the array}
SetLength(DataObjects, Length(DataObjects) + 1);
{try to instantiate and store the passed data object, then return a positive
result}
try
{instantiate the new data object in the array}
DataObjects[Length(DataObjects) - 1] :=
TComponentClass(FTemplate.ClassType).Create(Self);
Result := @DataObjects[Length(DataObjects) - 1];
{otherwise, return a negative result}
except
Result := nil;
end;
end;
end;
{define the 'DeleteDataObject' method used for deleting stored data objects}
function TRepository.DeleteDataObject(PDataObject: Pointer): boolean;
var
Inc: integer;
begin
{set the default result}
Result := False;
{if the data object template and pointer are valid, continue}
if (FTemplate <> nil) and (PDataObject <> nil) then
begin
{increment through each data object in the array}
for Inc := 0 to Length(DataObjects) - 1 do
begin
{if the data object matches the data object pointer, continue}
if DataObjects[Inc] = TComponent(PDataObject^) then
begin
{destroy the data object}
DataObjects[Inc].Free;
{move the other data objects accordingly}
System.Move(DataObjects[Inc + 1], DataObjects[Inc],
(Length(DataObjects) - Inc - 1) * SizeOf(FTemplate) + 1);
{set the array's new length}
SetLength(DataObjects, Length(DataObjects) - 1);
{return a positive result}
Result := True;
{terminate the method}
Exit;
end;
end;
end;
end;
{define the 'LoadDataObject' method used for returning stored data objects}
function TRepository.LoadDataObject(ADataObject: TComponent): boolean;
var
Inc: integer;
MemoryStream: TMemoryStream;
begin
{set the default result}
Result := False;
{if the data object template has been specified, continue}
if FTemplate <> nil then
begin
{increment through each data object in the array}
for Inc := 0 to Length(DataObjects) - 1 do
begin
{if the stored data object name matches the passed data object name, try
the following}
if DataObjects[Inc].Name = ADataObject.Name then
try
{instantiate the memory stream}
MemoryStream := TMemoryStream.Create;
{do the following with the memory stream}
with MemoryStream do
begin
{write the stored data object into the memory stream}
WriteComponent(DataObjects[Inc]);
Seek(0, soFromBeginning);
{write the memory stream into the passed data object}
ADataObject := ReadComponent(ADataObject);
end;
{destroy the memory stream}
MemoryStream.Free;
{return a positive response}
Result := True;
{otherwise, return a negative result}
except
Result := False;
end;
end;
end;
end;
{define the 'SaveDataObject' method used for storing data objects}
function TRepository.SaveDataObject(ADataObject: TComponent): boolean;
var
MemoryStream: TMemoryStream;
begin
{set the default result}
Result := False;
{if the data object template has been specified, continue}
if FTemplate <> nil then
begin
{create a new data object in the array}
SetLength(DataObjects, Length(DataObjects) + 1);
{try to instantiate and store the passed data object, then return a positive
result}
try
{instantiate the memory stream}
MemoryStream := TMemoryStream.Create;
{instantiate the new data object in the array}
DataObjects[Length(DataObjects) - 1] :=
TComponentClass(FTemplate.ClassType).Create(Self);
{do the following with the memory stream}
with MemoryStream do
begin
{write the passed data object into the memory stream}
WriteComponent(ADataObject);
Seek(0, soFromBeginning);
{write the memory stream into the array}
DataObjects[Length(DataObjects) - 1] :=
ReadComponent(DataObjects[Length(DataObjects) - 1]);
end;
Result := True;
{otherwise, return a negative result}
except
Result := False;
end;
end;
end;
{------------------------------------------------------------------------------}
{define the methods used for loading and saving the repository file}
{------------------------------------------------------------------------------}
{define the 'Load' method used for loading the repository from disk}
function TRepository.Load(FilePath: string): boolean;
var
Inc: integer;
FileStream: TFileStream;
MemoryStream: TMemoryStream;
Reader: TReader;
begin
{set the default result}
Result := False;
{if the data object template has been specified, continue}
if FTemplate <> nil then
begin
{if the specified filename exists, try the following}
if FileExists(FilePath) = True then
try
{instantiate the file stream}
FileStream := TFileStream.Create(FilePath, fmOpenRead or
fmShareDenyWrite);
{instantiate the memory stream and copy the data from the file stream}
MemoryStream := TMemoryStream.Create;
MemoryStream.LoadFromStream(FileStream);
{instantiate the reader}
Reader := TReader.Create(MemoryStream, 1);
{get the 'start-of-list' marker from the file stream}
Reader.ReadListBegin;
{create the list of objects within the file stream}
Reader.BeginReferences;
{set the default incrementing value}
Inc := 0;
{while the 'end-of-list' marker has not been reached, continue}
while Reader.EndOfList = False do
begin
{increment through to the next data object}
Inc := Inc + 1;
{if the current data object sits outside the array's length, continue}
if Inc > Length(DataObjects) then
begin
{allow room for the new data object}
SetLength(DataObjects, Length(DataObjects) + 1);
{instantiate the new data object in the array}
DataObjects[Length(DataObjects) - 1] :=
TComponentClass(FTemplate.ClassType).Create(Self);
end;
{store the data object in the array}
Reader.ReadComponent(DataObjects[Inc - 1]);
{allow processing to take place}
Application.ProcessMessages;
end;
{destroy the list of objects within the file stream}
Reader.EndReferences;
{destroy the reader and memory stream}
Reader.Free;
MemoryStream.Free;
{destroy the file stream}
FileStream.Free;
{return a positive result}
Result := True;
{otherwise, return a negative result}
except
Result := False;
end;
end;
end;
{define the 'Save' method used for saving the repository to disk}
function TRepository.Save(FilePath: string): boolean;
var
Inc: integer;
FileStream: TFileStream;
Writer : TWriter;
begin
{set the default result}
Result := False;
{if the data object template has been specified, continue}
if FTemplate <> nil then
begin
{try the following}
try
{instantiate the file stream and writer}
FileStream := TFileStream.Create(FilePath, fmCreate or
fmShareDenyWrite);
Writer := TWriter.Create(FileStream, 1);
{insert a 'start-of-list' marker into the file stream}
Writer.WriteListBegin;
{increment through each data object, saving them into the file stream}
for Inc := 0 to Length(DataObjects) - 1 do
begin
Writer.WriteComponent(DataObjects[Inc]);
{allow processing to take place}
Application.ProcessMessages;
end;
{insert an 'end-of-list' marker into the file stream}
Writer.WriteListEnd;
{destroy the writer and file stream}
Writer.Free;
FileStream.Free;
{return a positive result}
Result := True;
{otherwise, return a negative result}
except
Result := False;
end;
end;
end;
{------------------------------------------------------------------------------}
{define the methods used for miscellanious handling of data objects}
{------------------------------------------------------------------------------}
{define the 'Clear' method used for removing all the data objects}
function TRepository.Clear: boolean;
var
Inc: integer;
begin
{destroy the data objects in the data objects repository}
if Length(DataObjects) > 0 then
for Inc := 0 to Length(DataObjects) - 1 do
DataObjects[Inc].Free;
{clear the data objects repository of all the data objects}
SetLength(DataObjects, 0);
{if the data object repository has no data objects, return a false result}
if Length(DataObjects) = 0 then
Result := False
{otherwise, return a positive result}
else
Result := True;
end;
{define the 'Count' method used for counting the data objects}
function TRepository.Count: integer;
begin
Result := Length(DataObjects);
end;
end.
_______________________________________________
Delphi mailing list -> [email protected]
http://www.elists.org/mailman/listinfo/delphi
