Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

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


Страницы:   1 2

jack128 ©   (2004-08-15 15:40:00) 

Есть иерархия объетов. Нужно что бы все объкты иерархии могли сохронять себя поток. Так как иерархия весь обширная (порядка 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-16 01:15:00) [1]

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

GuAV   (2004-08-15 22:52:00) [2]


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

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

> модуль TypInfo

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


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

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

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

jack128   (2004-08-15 22:38:00) [3]


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

jack128   (2004-08-15 22:32:00) [4]

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

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

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

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

GuAV   (2004-08-15 22:25:00) [5]


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

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

GuAV   (2004-08-15 22:15:00) [6]

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

jack128   (2004-08-15 22:03:00) [7]

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

GuAV   (2004-08-15 21:47:00) [8]

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

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

GuAV   (2004-08-15 21:40:00) [9]

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

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;

GuAV   (2004-08-15 21:28:00) [10]


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

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

jack128   (2004-08-15 21:07:00) [11]


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

jack128   (2004-08-15 21:04:00) [12]

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

> 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;

GuAV   (2004-08-15 20:38:00) [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 20:31:00) [14]

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

GuAV   (2004-08-15 20:22:00) [15]

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

jack128   (2004-08-15 17:38:00) [16]

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

GuAV   (2004-08-15 17:16:00) [17]

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

jack128   (2004-08-15 16:39:00) [18]


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

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 16:33:00) [19]


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

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

jack128   (2004-08-15 16:25:00) [20]


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

Страницы:   1 2

Наверх

Титульная страница Поиск, карта сайта Написать письмо