Сохранение/загрузка Persistent a в поток

← →
jack128 © (2004-08-15 15:40) [0]

Есть иерархия объетов. Нужно что бы все объкты иерархии могли сохронять себя поток. Так как иерархия весь обширная (порядка 50 классов) , то писать методы SaveToStream/LoadFromStream для каждого класса несколько лениво, решил использовать RTTI. Сейчас это выглядит так:

type TReaderCrack = class(TReader) public procedure DefineProperty(const Name: string; ReadData: TReaderProc; WriteData: TWriterProc; HasData: Boolean); override; procedure DefineBinaryProperty(const Name: string; ReadData, WriteData: TStreamProc; HasData: Boolean); override; end; TWriterCrack = class(TWriter); TPersistentCrack = class(TPersistent); procedure SavePersistent(Stream: TStream; Instance: TPersistent); var PropList: PPropList; PropCount: Integer; Writer: TWriterCrack; i: Integer; begin Assert(Assigned(Instance), "Object must be not nil"); PropCount := GetTypeData(Instance.ClassInfo).PropCount; GetMem(PropList, SizeOf(PPropInfo) * PropCount); try PropCount := GetPropList(Instance.ClassInfo, tkProperties - [tkClass], PropList); if PropCount = 0 then exit; Writer := TWriterCrack.Create(Stream, 1024); try Writer.WriteListBegin; for i := 0 to PropCount - 1 do if IsStoredProp(Instance, PropList[i]) then Writer.WriteProperty(Instance, PropList[i]); Writer.WriteListEnd; TPersistentCrack(Instance).DefineProperties(Writer); finally Writer.Free; end; finally FreeMem(PropList); end; end; procedure LoadPersistent(Stream: TStream; Instance: TPersistent); var Reader: TReaderCrack; begin Assert(Assigned(Instance), "Object must be not nil"); Reader := TReaderCrack.Create(Stream, 1024); try Reader.ReadListBegin; while not Reader.EndOfList do Reader.ReadProperty(Instance); Reader.ReadListEnd; TPersistentCrack(Instance).DefineProperties(Reader); finally Reader.Free; end; end; { TReaderCrack } procedure TReaderCrack.DefineBinaryProperty(const Name: string; ReadData, WriteData: TStreamProc; HasData: Boolean); var Count: LongInt; ms: TMemoryStream; begin if not (Assigned(ReadData) and HasData) then Exit; CheckValue(vaBinary); ms := TMemoryStream.Create; try Read(Count, SizeOf(Count)); ms.Size := Count; Read(ms.Memory^, Count); ReadData(ms); finally ms.Free; end; end; procedure TReaderCrack.DefineProperty(const Name: string; ReadData: TReaderProc; WriteData: TWriterProc; HasData: Boolean); var SavePos: Integer; begin if not (Assigned(ReadData) and HasData) then Exit; SavePos := Position; if not SameText(Name, ReadStr) then begin Position := SavePos; Exit; end; ReadData(Self); end; Но у меня сильное впечатление, чтоо туплю. Задача, думаю достаточно распростронённая и, наверника есть какое нить стандартное решение. По крайней мере без переписывания TReader"a ??

← →
GuAV © (2004-08-15 15:52) [1]

Юзай наследника TComponent.
Если считаешь, что TComponent - это VCL, то TPersistent - это тоже VCL.

← →
GuAV © (2004-08-15 15:59) [2]

> решил использовать RTTI

Я когда решил юзать RTTI напрямую TypInfo юзал
вот тут вылаживал идею, правда сейчас уже всё переделал, интересно - выложу.
http://delphimaster.net/view/1-1091963555/

← →
jack128 © (2004-08-15 15:59) [3]

э-э-э-э-э... Не хочется.. Объектов много, тысячи/десятки тысяч..А компонент оверхед неплохой накатывает..

← →
jack128 © (2004-08-15 16:02) [4]

> Я когда решил юзать RTTI напрямую TypInfo юзал
> вот тут вылаживал идею, правда сейчас уже всё переделал,
> интересно - выложу.
> http://delphimaster.net/view/1-1091963555/

глянь в исходники ридера и райтера и увидишь приметно тоже самое ;-)

← →
GuAV © (2004-08-15 16:05) [5]

Сейчас, когда сделал классом, ещё больше сходство ;-)
Да я понимаю то же самое, но
> компонент оверхед неплохой накатывает..
, а тут ничего лишнего только то что мне нужно.

← →
jack128 © (2004-08-15 16:25) [6]

> а тут ничего лишнего только то что мне нужно.
ну я процедуру загрузки не собираюсь оптимизировать. Все таки эти объекты весятв памяти постоянно, сохраняет все это пользователь от силы раз в полчаса..
Но что мне не нравиться, так это то что я переписал TReader! Это меня несколько беспокоит..И вообще велосипед избретает - все это было уже..

← →
GuAV © (2004-08-15 16:33) [7]

> это то что я переписал TReader

А зачем это понадобилось?
Особо с этими не разбирался, но
constructor Create(Stream: TStream; BufSize: Integer);

← →
jack128 © (2004-08-15 16:39) [8]

> А зачем это понадобилось?
конкретно вот из-за этого

procedure TReader.DefineProperty(const Name: string; ReadData: TReaderProc; WriteData: TWriterProc; HasData: Boolean); begin if SameText(Name, FPropName) and Assigned(ReadData) then begin ReadData(Self); FPropName := ""; end; end;
когда в своей процедуре я вызываю Instance.DefineProperties(Reader), FPropName у нас равно "", со всеми втекающими и вытекающими последствиями..

← →
GuAV © (2004-08-15 17:16) [9]

FPropName читается в
procedure TReader.ReadProperty(AInstance: TPersistent);

← →
jack128 © (2004-08-15 17:38) [10]

это понятно, но TRaeder.ReadProperty читает Published свойства, а а мне то нужно прочитать те свойства, которые были определены в TPersistent.DefineProperties!!!

← →
GuAV © (2004-08-15 20:22) [11]

TComponent.DefineProperties
пишет Left и Top - этот способ тоже не устраивает?

← →
jack128 © (2004-08-15 20:31) [12]

и что? Ты не умничай, ты пальцем покажи ;-) Как конкретно мне записать/прочитать Persistent в поток. Ну переопределил я DefineProperties и что дальше?

← →
GuAV © (2004-08-15 20:38) [13]

> Ты не умничай, ты пальцем покажи ;-)

Я не умничаю - я не умнее тебя.
Я показал:
procedure TComponent.DefineProperties(Filer: TFiler); var Ancestor: TComponent; Info: Longint; begin Info := 0; Ancestor := TComponent(Filer.Ancestor); if Ancestor <> nil then Info := Ancestor.FDesignInfo; Filer.DefineProperty("Left", ReadLeft, WriteLeft, LongRec(FDesignInfo).Lo <> LongRec(Info).Lo); Filer.DefineProperty("Top", ReadTop, WriteTop, LongRec(FDesignInfo).Hi <> LongRec(Info).Hi); end;
и так не работает? Или не устраивает?
зы я там сделал свои IniReader/IniWriter, потому что считаю, что проще самому сделать, чем разбираться.

← →
jack128 © (2004-08-15 21:04) [14]

ты не понял. что я от тебя хотел.
Короче выяснил в чем у мя затык был. Моя ошибка была в том, что я считал

> TRaeder.ReadProperty читает Published свойства,
нет, этот метод так же читает и свойства определенные через TPersistint.DefineProperies. Почему то сразу я до этого не дошёл.. Соответственно код упрочается безобразия:

type TReaderCrack = class(TReader); TWriterCrack = class(TWriter); TPersistentCrack = class(TPersistent); procedure SavePersistent(Stream: TStream; Instance: TPersistent); var PropList: PPropList; PropCount: Integer; Writer: TWriterCrack; i: Integer; begin Assert(Assigned(Instance), "Object must be not nil"); PropCount := GetTypeData(Instance.ClassInfo).PropCount; GetMem(PropList, SizeOf(PPropInfo) * PropCount); try PropCount := GetPropList(Instance.ClassInfo, tkProperties - [tkClass], PropList); Writer := TWriterCrack.Create(Stream, 1024); try Writer.WriteListBegin; for i := 0 to PropCount - 1 do if IsStoredProp(Instance, PropList[i]) then Writer.WriteProperty(Instance, PropList[i]); TPersistentCrack(Instance).DefineProperties(Writer); Writer.WriteListEnd; finally Writer.Free; end; finally FreeMem(PropList); end; end; procedure LoadPersistent(Stream: TStream; Instance: TPersistent); var Reader: TReaderCrack; begin Assert(Assigned(Instance), "Object must be not nil"); Reader := TReaderCrack.Create(Stream, 1024); try Reader.ReadListBegin; while not Reader.EndOfList do Reader.ReadProperty(Instance); Reader.ReadListEnd; finally Reader.Free; end; end;

← →
jack128 © (2004-08-15 21:07) [15]

> потому что считаю, что проще самому сделать, чем разбираться
гм.. Возможно ты и прав, но как там у тя в анкете написано?
Ctrl+Click - ещё интереснее, вот мне и интересно ;-)

← →
GuAV © (2004-08-15 21:28) [16]

> Ctrl+Click - ещё интереснее, вот мне и интересно ;-)

Я думал те всегда грустно и неитересно ;-)
с твоего (надеюсь) разрешение - самое интересное - Ctrl+C + Ctrl+V :-)

← →
GuAV © (2004-08-15 21:40) [17]

Кажется, БАГ!

GetMem(PropList, SizeOf(PPropInfo) * PropCount); - убрать из твоего кода

Ctrl+Click ;-)

function GetPropList(TypeInfo: PTypeInfo; out PropList: PPropList): Integer; begin Result := GetTypeData(TypeInfo)^.PropCount; if Result > 0 then begin GetMem(PropList, Result * SizeOf(Pointer)); GetPropInfos(TypeInfo, PropList); end; end;

Это из Д7, если в Д5 аналогично, то имхо так:

Assert(Assigned(Instance), "Object must be not nil");
PropCount := GetPropList(Instance.ClassInfo, tkProperties - [tkClass], PropList);
try
Writer := TWriterCrack.Create(Stream, 1024);

не-а, не баг
function GetPropList(TypeInfo: PTypeInfo; TypeKinds: TTypeKinds;
PropList: PPropList): Integer;

В Д7 не так... может лучше GetPropInfos, чтоб было портируемо в Д7 ?

> function GetPropList(TypeInfo: PTypeInfo; TypeKinds: TTypeKinds;
> PropList: PPropList): Integer;

Такой в Д7 нет. Так что мы на разных языках говорим :-(
(Такая есть.
function GetPropList(TypeInfo: PTypeInfo; TypeKinds: TTypeKinds;
PropList: PPropList; SortList: Boolean): Integer;)

Да ну.. Если б эта функция, только здесь использовалась бы, то можно было бы.. А так.. Учитывая, что на семёрку я переходить не собираюсь.. Если когда нить это произойдёт, компилятор сам подскажет об ошибке..

Ну вобщем ты понял - мне ЛЕНЬ!!! ;-) :-))

ЗЫ Вообще говоря если используешь модуль TypInfo - то всегда будь готов к несовместимости версий. Хотя конкретно в данном случаи я вообще не понимаю логику борланда - нафиг так делоть было..

<off>
если таки соберешся писать в Borland по поводу конструкторов и если/когда получишь ответ - свистнешь, ОКи?
</off>

> Так что мы на разных языках говорим
именно. Ты на Delphi7, а я на Delphi5

> Ну вобщем ты понял - мне ЛЕНЬ!!! ;-) :-))

Ладно, себе я сам переведу под свой вкус.

> модуль TypInfo

Ты на нём ещё F1 нажми, смотри как "много" в справке про него - три ф-ции, самые ненужные.

> если таки соберешся писать в Borland по поводу конструкторов
> и если/когда получишь ответ - свистнешь, ОКи?

Мне лень повторяить твои эксперименты, давай всё что есть с тогдашних на мыло, а я уже спрошу.

А веточку - то в потрепаться пора...

Получил письмо, спасибо.

Сохранение/загрузка Persistent a в поток Найти похожие ветки