RTTI и другие трюки с информацией о классах, модулях и т.п.

Code:

unit uStreamableExample;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Contnrs;

type

TStreamableObject = class(TPersistent)

protected

   function ReadString(Stream: TStream): String;

   function ReadLongInt(Stream: TStream): LongInt;

   function ReadDateTime(Stream: TStream): TDateTime;

   function ReadCurrency(Stream: TStream): Currency;

   function ReadClassName(Stream: TStream): ShortString;

   procedure WriteString(Stream: TStream; const Value: String);

   procedure WriteLongInt(Stream: TStream; const Value: LongInt);

   procedure WriteDateTime(Stream: TStream; const Value: TDateTime);

   procedure WriteCurrency(Stream: TStream; const Value: Currency);

   procedure WriteClassName(Stream: TStream; const Value: ShortString);

public

   constructor CreateFromStream(Stream: TStream);

   procedure LoadFromStream(Stream: TStream); virtual; abstract;

   procedure SaveToStream(Stream: TStream); virtual; abstract;

end;

TStreamableObjectClass = classof TStreamableObject;

TPerson = class(TStreamableObject)

private

   FName: String;

   FBirthDate: TDateTime;

public

   constructor Create(const AName: string; ABirthDate: TDateTime);

   procedure LoadFromStream(Stream: TStream); override;

   procedure SaveToStream(Stream: TStream); override;

   propertyName: Stringread FName write FName;

   property BirthDate: TDateTime read FBirthDate write FBirthDate;

end;

TCompany = class(TStreamableObject)

private

   FName: String;

   FRevenues: Currency;

   FEmployeeCount: LongInt;

public

   constructor Create(const AName: string; ARevenues: Currency; AEmployeeCount: LongInt);

   procedure LoadFromStream(Stream: TStream); override;

   procedure SaveToStream(Stream: TStream); override;

   propertyName: Stringread FName write FName;

   property Revenues: Currency read FRevenues write FRevenues;

   property EmployeeCount: LongInt read FEmployeeCount write FEmployeeCount;

end;

TStreamableList = class(TStreamableObject)

private

   FItems: TObjectList;

   function Get_Count: LongInt;

   function Get_Objects(Index: LongInt): TStreamableObject;

public

   constructor Create;

   destructor Destroy; override;

   function FindClass(const AClassName: String): TStreamableObjectClass;

   procedure Add(Item: TStreamableObject);

   procedure Delete(Index: LongInt);

   procedure Clear;

   procedure LoadFromStream(Stream: TStream); override;

   procedure SaveToStream(Stream: TStream); override;

   property Objects[Index: LongInt]: TStreamableObject read Get_Objects; default;

   property Count: LongInt read Get_Count;

end;

TForm1 = class(TForm)

   SaveButton: TButton;

   LoadButton: TButton;

   procedure SaveButtonClick(Sender: TObject);

   procedure LoadButtonClick(Sender: TObject);

   procedure FormCreate(Sender: TObject);

private

   { Private declarations }

public

   Path: String;

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

resourcestring

DEFAULT_FILENAME = 'test.dat';

procedure TForm1.SaveButtonClick(Sender: TObject);

var

List: TStreamableList;

Stream: TStream;

begin

List := TStreamableList.Create;

try

   List.Add(TPerson.Create('Rick Rogers', StrToDate('05/20/68')));

   List.Add(TCompany.Create('Fenestra', 1000000, 7));

   Stream := TFileStream.Create(Path + DEFAULT_FILENAME, fmCreate);

   try

     List.SaveToStream(Stream);

   finally

     Stream.Free;

   end;

finally

   List.Free;

end;

end;

{ TPerson }

constructor TPerson.Create(const AName: string; ABirthDate: TDateTime);

begin

inherited Create;

FName := AName;

FBirthDate := ABirthDate;

end;

procedure TPerson.LoadFromStream(Stream: TStream);

begin

FName := ReadString(Stream);

FBirthDate := ReadDateTime(Stream);

end;

procedure TPerson.SaveToStream(Stream: TStream);

begin

WriteString(Stream, FName);

WriteDateTime(Stream, FBirthDate);

end;

{ TStreamableList }

procedure TStreamableList.Add(Item: TStreamableObject);

begin

FItems.Add(Item);

end;

procedure TStreamableList.Clear;

begin

FItems.Clear;

end;

constructor TStreamableList.Create;

begin

FItems := TObjectList.Create;

end;

procedure TStreamableList.Delete(Index: LongInt);

begin

FItems.Delete(Index);

end;

destructor TStreamableList.Destroy;

begin

FItems.Free;

inherited;

end;

function TStreamableList.FindClass(const AClassName: String): TStreamableObjectClass;

begin

Result :=  TStreamableObjectClass(Classes.FindClass(AClassName));

end;

function TStreamableList.Get_Count: LongInt;

begin

Result := FItems.Count;

end;

function TStreamableList.Get_Objects(Index: LongInt): TStreamableObject;

begin

Result := FItems[Index] as TStreamableObject;

end;

procedure TStreamableList.LoadFromStream(Stream: TStream);

var

StreamCount: LongInt;

I: Integer;

S: String;

ClassRef: TStreamableObjectClass;

begin

StreamCount := ReadLongInt(Stream);

for I := 0to StreamCount - 1do

begin

   S := ReadClassName(Stream);

   ClassRef := FindClass(S);

   Add(ClassRef.CreateFromStream(Stream));

end;

end;

procedure TStreamableList.SaveToStream(Stream: TStream);

var

I: Integer;

begin

WriteLongInt(Stream, Count);

for I := 0to Count - 1do

begin

   WriteClassName(Stream, Objects[I].ClassName);

   Objects[I].SaveToStream(Stream);

end;

end;

{ TStreamableObject }

constructor TStreamableObject.CreateFromStream(Stream: TStream);

begin

inherited Create;

LoadFromStream(Stream);

end;

function TStreamableObject.ReadClassName(Stream: TStream): ShortString;

begin

Result := ReadString(Stream);

end;

function TStreamableObject.ReadCurrency(Stream: TStream): Currency;

begin

Stream.Read(Result, SizeOf(Currency));

end;

function TStreamableObject.ReadDateTime(Stream: TStream): TDateTime;

begin

Stream.Read(Result, SizeOf(TDateTime));

end;

function TStreamableObject.ReadLongInt(Stream: TStream): LongInt;

begin

Stream.Read(Result, SizeOf(LongInt));

end;

function TStreamableObject.ReadString(Stream: TStream): String;

var

L: LongInt;

begin

L := ReadLongInt(Stream);

SetLength(Result, L);

Stream.Read(Result[1], L);

end;

procedure TStreamableObject.WriteClassName(Stream: TStream; const Value: ShortString);

begin

WriteString(Stream, Value);

end;

procedure TStreamableObject.WriteCurrency(Stream: TStream; const Value: Currency);

begin

Stream.Write(Value, SizeOf(Currency));

end;

procedure TStreamableObject.WriteDateTime(Stream: TStream; const Value: TDateTime);

begin

Stream.Write(Value, SizeOf(TDateTime));

end;

procedure TStreamableObject.WriteLongInt(Stream: TStream; const Value: LongInt);

begin

Stream.Write(Value, SizeOf(LongInt));

end;

procedure TStreamableObject.WriteString(Stream: TStream; const Value: String);

var

L: LongInt;

begin

L := Length(Value);

WriteLongInt(Stream, L);

Stream.Write(Value[1], L);

end;

{ TCompany }

constructor TCompany.Create(const AName: string; ARevenues: Currency;

AEmployeeCount: Integer);

begin

FName := AName;

FRevenues := ARevenues;

FEmployeeCount := AEmployeeCount;

end;

procedure TCompany.LoadFromStream(Stream: TStream);

begin

FName := ReadString(Stream);

FRevenues := ReadCurrency(Stream);

FEmployeeCount := ReadLongInt(Stream);

end;

procedure TCompany.SaveToStream(Stream: TStream);

begin

WriteString(Stream, FName);

WriteCurrency(Stream, FRevenues);

WriteLongInt(Stream, FEmployeeCount);

end;

procedure TForm1.LoadButtonClick(Sender: TObject);

var

List: TStreamableList;

Stream: TStream;

Instance: TStreamableObject;

I: Integer;

begin

Stream := TFileStream.Create(Path + DEFAULT_FILENAME, fmOpenRead);

try

   List := TStreamableList.Create;

   try

     List.LoadFromStream(Stream);

     for I := 0to List.Count - 1do

     begin

       Instance := List[I];

       if Instance is TPerson then

         ShowMessage(TPerson(Instance).Name);

       if Instance is TCompany then

         ShowMessage(TCompany(Instance).Name);

     end;

   finally

     List.Free;

   end;

finally

   Stream.Free;

end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

Path := ExtractFilePath(Application.ExeName);

end;

initialization

RegisterClasses([TPerson, TCompany]);

end.