Форум: "Основная";
Текущий архив: 2006.07.02;
Скачать: [xml.tar.bz2];

Вниз

Сохранение коллекции в потоке.   Найти похожие ветки 

← →
learner ©   (2006-05-21 00:44) [0]

Здравствуйте !
Пытаюсь сохранять коллекцию в потоке.
Все работает. Св-ва записываються и считываються правильно.
Беда в том, что при записи св-в коллекции из потока, новый Item
все время записываеться в Items[0] (см. ***)
Как это можно исправить ?

procedure Obj_ToStream(Obj:TObject; Strm:TStream);
var
i,j:integer;
PropNum:DWord;
TypeInf:PTypeInfo;
PropInfo:PPropInfo;
TypeData:PTypeData;
PropList:PPropList;
PropObject:TObject;
PropName,PropValue:string;
begin
TypeInf:=Obj.ClassInfo;
if (TypeInf=nil) or (TypeInf^.Kind<>tkClass) then Exit;
TypeData:=GetTypeData(TypeInf);
PropNum:=TypeData^.PropCount;
if PropNum=0 then
 if (Obj is TCollection) then
  begin
   Strm_AddDWord(TCollection(Obj).Count,Strm);
   for i:=0 to TCollection(Obj).Count-1 do
    begin
     Obj_ToStream(TCollection(Obj).Items[i],Strm);
    end;
   Exit;
  end
 else Exit;
GetMem(PropList,PropNum*SizeOf(PPropInfo));
try
 GetPropInfos(TypeInf,PropList);
 for i := 0 to PropNum - 1 do
  begin
   PropName:=PropList^[i]^.Name;
   TypeInf:=PropList^[i]^.PropType^;
   case TypeInf^.Kind of
    tkInteger,tkChar,tkEnumeration,tkFloat,tkString,tkSet,tkWChar,tkLString,tkWStrin g,tkVariant:
     begin
      PropValue:=GetPropValue(Obj,PropName,True);
      Strm_AddPropValue(PropName,PropValue,Strm);
     end;
    tkClass:
     begin
      Strm_WriteString(PropName,Strm);
      PropInfo:=PropList^[i];
      PropObject:=GetObjectProp(Obj,PropInfo);
      if Assigned(PropObject) then
       ...
        if (PropObject is TCollection) then
         begin
          Obj_ToStream(PropObject,Strm);
          Strm_AddDWord(TCollection(PropObject).Count,Strm);
          for j:=0 to TCollection(PropObject).Count-1 do
           begin
            Obj_ToStream(TCollection(PropObject).Items[j],Strm);
           end;
         end
        else
         if (PropObject is TPersistent) then Obj_ToStream(PropObject,Strm);
       end;
     end;
  end;
finally
 FreeMem(PropList,PropNum*SizeOf(PPropInfo));
end;
end;

procedure Obj_FromStream(Obj:TObject; Strm:TStream);
var
i,j,Ind,PropNum:integer;
TypeInf:PTypeInfo;
PropInfo:PPropInfo;
TypeData:PTypeData;
PropList:PPropList;
PropObject:TObject;
PropName,PropValue:string;

function FindProperty(Name:string):integer;
var
 i:integer;
begin
 Result := -1;
 for i:=0 to PropNum-1 do
  if CompareText(PropList^[i]^.Name,Name)=0 then
   begin
    Result:=i;
    Break;
   end;
 end;

begin
TypeInf:=Obj.ClassInfo;
if (TypeInf=nil) or (TypeInf^.Kind<>tkClass) then Exit;
TypeData:=GetTypeData(TypeInf);
PropNum:=TypeData^.PropCount;
if PropNum=0 then
 if (Obj is TCollection) then
  begin
   Strm.Read(Ind,SizeOf(DWord));
   for i:=0 to Ind-1 do
    begin
     Obj_FromStream(TCollection(Obj).Add,Strm);<<-- Вот здесь пишеться не в Items[i],  а в Items[0] ***
    end;
   Exit;
  end
 else Exit;
GetMem(PropList,PropNum*SizeOf(PPropInfo));
try
 GetPropInfos(TypeInf,PropList);
 PropName:=Strm_ReadString(Strm);
 Ind:=FindProperty(PropName);
 if Ind=-1 then Exit;
 TypeInf:=PropList^[Ind]^.PropType^;
 case TypeInf^.Kind of
  tkInteger,tkChar,tkEnumeration,tkFloat,tkString,tkSet,tkWChar,tkLString,tkWStrin g,tkVariant:
   begin
    PropValue:=Strm_ReadString(Strm);
    SetPropValue(Obj,PropName,PropValue);
   end;
    tkClass:
     begin
      PropInfo:=PropList^[Ind];
      PropObject:=GetObjectProp(Obj,PropInfo);
      if Assigned(PropObject) then
       ...
        if (PropObject is TCollection) then
         begin
          Obj_FromStream(PropObject,Strm);
          Strm.Read(Ind,SizeOf(DWord));
          for i:=0 to Ind-1 do
           begin
            for j:=0 to TCollection(PropObject).Count-1 do Obj_FromStream(TCollection(PropObject).Add,Strm);
           end;
         end
        else
         if (PropObject is TPersistent) then Obj_FromStream(PropObject,Strm);
     end;
 end;
finally
 FreeMem(PropList,PropNum*SizeOf(PPropInfo));
end;
if Strm.Position<Strm.Size then Obj_FromStream(Obj,Strm);
end;

---

← →
Мефисто   (2006-05-21 09:24) [1]

>> Obj _FromStream(TCollection(Obj).Add,Strm);

Как я понимаю производится рекурсивный вызов.

Только почему?

TCollection(Obj).Add

а не

TCollection(Obj).Items[I]

P.S.
Особо в реализацию кода не всматривался :)

---

← →
pargo ©   (2006-05-21 09:51) [2]

Мефисто   (21.05.06 9:24) [1]
Если, вместо TCollection(Obj).Add
использовать TCollection(Obj).Items[I] то происходит то же самое.

---

← →
jack128 ©   (2006-05-21 13:40) [3]


type
 TDBGridColumns = class(TCollection);

type
 TColumnsWrapper = class(TComponent)
 private
   FColumns: TDBGridColumns;
 published
   property Columns: TDBGridColumns read FColumns write FColumns;
 end;

procedure TDBGridColumns.SaveToStream(S: TStream);
var
 Wrapper: TColumnsWrapper;
begin
 Wrapper := TColumnsWrapper.Create(nil);
 try
   Wrapper.Columns := Self;
   S.WriteComponent(Wrapper);
 finally
   Wrapper.Free;
 end;
end;

procedure TDBGridColumns.LoadFromStream(S: TStream);
var
 Wrapper: TColumnsWrapper;
begin
 Wrapper := TColumnsWrapper.Create(nil);
 try
   Wrapper.Columns := FGrid.CreateColumns;
   S.ReadComponent(Wrapper);
   Assign(Wrapper.Columns);
 finally
   Wrapper.Columns.Free;
   Wrapper.Free;
 end;
end;

---

← →
learner ©   (2006-05-21 15:16) [4]

jack128 ©   (21.05.06 13:40) [3]
Спасибо, работает.

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2006.07.02;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.009 c