Текущий архив: 2008.02.10;
Скачать: CL | DM;

Вниз

TClassList.Add(pointerToTheObject);   Найти похожие ветки 

← →
savyhinst ©   (2008-01-14 15:31) [0]

Здраствуйте.
Подскажите пожалуйста, как сохранить какой-либо объект в файл, например TClassList. Причём будет ли при этом орректно сохранено его содержимое и можно ли сохранить два и более объектов в один файл. Подскажите пожалуйста как.
Спасибо за внимание.

---

← →
Сергей М. ©   (2008-01-14 15:34) [1]

ты вообще разницу между "класс" и "объект" понимаешь ?

Сдается мне - нет.

---

← →
savyhinst ©   (2008-01-14 15:39) [2]

Понимаю. Могу объяснить своими словами.

---

← →
savyhinst ©   (2008-01-14 15:41) [3]

если type TsmoeObj=object то можно к его св-вам обращаться без Create, а класс он всегда потомок TObject, он без Create вызывает AV

---

← →
Плохиш ©   (2008-01-14 15:45) [4]

> savyhinst ©   (14.01.08 15:41) [3]
> если type TsmoeObj=object то можно к его св-вам обращаться
> без Create, а класс он всегда потомок TObject, он без Create
> вызывает AV

Рыдал...

Откройте орешник...

---

← →
Palladin ©   (2008-01-14 15:47) [5]

> [3] savyhinst ©   (14.01.08 15:41)

эээ... ну ладно... вопрос моего детства

http://www.delphimaster.ru/cgi-bin/faq.pl?look=1&id=988619105&n=19

---

← →
Ins ©   (2008-01-14 15:50) [6]

> если type TsmoeObj=object то можно к его св-вам обращаться
> без Create, а класс он всегда потомок TObject, он без Create
> вызывает AV


Нет. В данном случае, класс - это тип данных (TObject, TPersistent и т.д.), а объекты - это экземпляры данного класса.

---

← →
Сергей М. ©   (2008-01-14 16:00) [7]

> savyhinst ©   (14.01.08 15:39) [2]


Почитай уж хоть какой-ниь букварь что ли ..

---

← →
savyhinst ©   (2008-01-14 16:25) [8]

А что же с сохранением в файл?

---

← →
Сергей М. ©   (2008-01-14 16:28) [9]

> что же с сохранением в файл?


Сохранение объекта есть сохранение его свойств.

При этом контейнер для хранения не важен - это м.б. файл, мусорное ведро, Луна, карман, шкатулка...

---

← →
savyhinst ©   (2008-01-14 16:30) [10]

Спасибо. Это понятно. А как сохранить два объекта в один файл и потом их достать оттуда целыми?

---

← →
savyhinst ©   (2008-01-14 16:30) [11]

Можно сохранить объект в TIniFile без прописывания этого вручную?

---

← →
savyhinst ©   (2008-01-14 16:30) [12]

Можно сохранить объект в TIniFile без прописывания этого вручную?

---

← →
Ins ©   (2008-01-14 16:34) [13]

Я для сериализации простых объектов (не потомков TComponent) когда-то написал для себя такие классы. Для большинства моих задач - вполне подходит. Использование - просто объявить свой класс потомком TRttiObject, записать в секцию published свойства, которые должны быть сохранены, и вызвать для экземпляра SaveToFile:

unit ExLists;

interface

uses Windows, Classes, SysUtils, Contnrs, TypInfo, Graphics;

const
 strInvalidSignature = "Неверная сигнатура";

type
 TNotifyType = (ntLoadComplete, ntSaveComplete);

 EInvalidSignature = class(Exception);
 
 // Элемент списка. Среда генерирует для него RTTI информацию
 // Сохраняет и читает из потока все Published свойства
 TRttiObject = class(TInterfacedPersistent, IStreamPersist)
 protected
   class function ClassSignature: String; virtual;
 public
   procedure SaveToStream(Stream: TStream);
   procedure LoadFromStream(Stream: TStream);
   procedure LoadFromFile(FileName: TFileName);
   procedure SaveToFile(FileName: TFileName);
   constructor Create; virtual;
 end;

 // Список классов-потомков TRttiObject. Классы элементов списка необходимо
 // регистрировать с помощью RegisterClass до первого обращения к методам
 // загрузки из потока
 TRttiList = class(TObjectList, IStreamPersist)
 protected
   function GetRttiObject(Index: Integer): TRttiObject;
   procedure SetRttiObject(Index: Integer; AItem: TRttiObject);
   function _AddRef: Integer; stdcall;
   function _Release: Integer; stdcall;
 public
   function QueryInterface(const IID: TGUID; out Obj):
     HResult; virtual; stdcall;
   function Add(AItem: TRttiObject): Integer;
   function Extract(AItem: TRttiObject): TRttiObject;
   function Remove(AItem: TRttiObject): Integer;
   function IndexOf(AItem: TRttiObject): Integer;
   function First: TRttiObject;
   function Last: TRttiObject;
   procedure Insert(Index: Integer; AItem: TRttiObject);
   procedure SaveToStream(Stream: TStream); dynamic;
   procedure LoadFromStream(Stream: TStream); dynamic;
   procedure SaveToFile(const FileName: TFileName); virtual;
   procedure LoadFromFile(const FileName: TFileName); virtual;
   property Items[Index: Integer]: TRttiObject read GetRttiObject write
     SetRttiObject; default;
 end;

 // Класс для асинхронной работы
 // Любые изменения в списке необходимо оформлять так:
 // MyList.BeginUpdate;
 // try
 //   DoSomething;
 // finally
 //   MyList.EndUpdate;
 // end;
 TAsyncRttiList = class(TRttiList)
 private
   FCriticalSection: TRTLCriticalSection;
   procedure WaitReleaseCriticalSection;
 protected
   // Оповещение об окончании сохранения/загрузки. Рекомендуется через
   // PostMessage
   procedure NotifyMainThread(NotifyType: TNotifyType); virtual; abstract;
 public
   constructor Create; virtual;
   destructor Destroy; override;
   procedure BeginUpdate;
   procedure EndUpdate;
   procedure AsyncLoadFromFile(const FileName: TFileName);
   procedure AsyncSaveToFile(const FileName: TFileName);
 end;

 TSaveLoadThread = class(TThread)
 private
   FListObj: TAsyncRttiList;
   FFileName: TFileName;
 public
   property ListObj: TAsyncRttiList read FListObj write FListObj;
   property FileName: TFileName read FFileName write FFileName;
 end;

 TSaveThread = class(TSaveLoadThread)
 protected
   procedure Execute; override;
 end;

 TLoadThread = class(TSaveLoadThread)
 protected
   procedure Execute; override;
 end;

 TRTTIObjectClass = class of TRTTIObject;



---

← →
Ins ©   (2008-01-14 16:34) [14]

implementation

{ TRttiList }

function TRttiList.Add(AItem: TRttiObject): Integer;
begin
 Result := inherited Add(AItem);
end;

function TRttiList.Extract(AItem: TRttiObject): TRttiObject;
begin
 Result := TRttiObject(inherited Extract(AItem));
end;

function TRttiList.First: TRttiObject;
begin
 Result := TRttiObject(inherited First);
end;

function TRttiList.GeTRttiObject(Index: Integer): TRttiObject;
begin
 Result := TRttiObject(inherited Items[Index]);
end;

function TRttiList.IndexOf(AItem: TRttiObject): Integer;
begin
 Result := inherited IndexOf(AItem);
end;

procedure TRttiList.Insert(Index: Integer; AItem: TRttiObject);
begin
 inherited Insert(Index, AItem);
end;

function TRttiList.Last: TRttiObject;
begin
 Result := TRttiObject(inherited Last);
end;

procedure TRttiList.LoadFromFile(const FileName: TFileName);
var
 Stream: TFileStream;
begin
 Stream:=TFileStream.Create(FileName,fmOpenRead);
 try
   LoadFromStream(Stream);
 finally
   Stream.Free;
 end;
end;

procedure TRttiList.LoadFromStream(Stream: TStream);
var
 Cnt,Size,i: Integer;
 AClassName: String;
begin
 Clear;
 Stream.Read(Cnt,SizeOf(Integer));
 Capacity:=Cnt;
 for i:=0 to Cnt - 1 do begin
   Stream.Read(Size,SizeOf(Integer));
   SetLength(AClassName,Size);
   Stream.Read(PChar(AClassName)^,Size);
   Add(TRTTIObjectClass(FindClass(AClassName)).Create);
   Items[i].LoadFromStream(Stream);
 end;
end;

function TRttiList.QueryInterface(const IID: TGUID; out Obj): HResult;
const
 E_NOINTERFACE = HResult($80004002);
begin
 if GetInterface(IID, Obj) then Result := 0 else Result := E_NOINTERFACE;
end;

function TRttiList.Remove(AItem: TRttiObject): Integer;
begin
 Result := inherited Remove(AItem);
end;

procedure TRttiList.SaveToFile(const FileName: TFileName);
var
 Stream: TFileStream;
begin
 Stream:=TFileStream.Create(FileName,fmCreate);
 try
   SaveToStream(Stream);
 finally
   Stream.Free;
 end;
end;

procedure TRttiList.SaveToStream(Stream: TStream);
var
 Len,i: Integer;
 AClassName: String;
begin
 Stream.Write(Count,SizeOf(Integer));
 for i:=0 to Count - 1 do begin
   AClassName:=Items[i].ClassName;
   Len:=Length(AClassName);
   Stream.Write(Len,SizeOf(Integer));
   Stream.Write(PChar(AClassName)^,Len);
   Items[i].SaveToStream(Stream);
 end;
end;

procedure TRttiList.SeTRttiObject(Index: Integer; AItem: TRttiObject);
begin
 inherited Items[Index] := AItem;
end;

function TRttiList._AddRef: Integer;
begin
 Result := -1;
end;

function TRttiList._Release: Integer;
begin
 Result := -1;
end;

{ TRttiObject }

class function TRttiObject.ClassSignature: String;
begin
 Result:="";
end;

constructor TRttiObject.Create;
begin
 inherited Create;
end;

procedure TRttiObject.LoadFromFile(FileName: TFileName);
var
 Stream: TFileStream;
begin
 Stream:=TFileStream.Create(FileName,fmOpenRead);
 try
   LoadFromStream(Stream);
 finally
   Stream.Free;
 end;
end;



---

← →
Ins ©   (2008-01-14 16:34) [15]

procedure TRttiObject.LoadFromStream(Stream: TStream);
var
 TypeData: PTypeData;
 PropList: PPropList;
 Count,i: Integer;

 function ReadSignature: Boolean;
 var
   Signature: String;
   L: Integer;
 begin
   L:=Length(ClassSignature);
   SetLength(Signature,L);
   Stream.Read(PChar(Signature)^,L);
   Result:=Signature = ClassSignature;
 end;

 procedure ReadOrdProp;
 var
   Value: Integer;
 begin
   Stream.Read(Value,SizeOf(Value));
   SetOrdProp(self,PropList[i],Value);
 end;

 procedure ReadFloatProp;
 var
   Value: Extended;
 begin
   Stream.Read(Value,SizeOf(Value));
   SetFloatProp(self,PropList[i],Value);
 end;

 procedure ReadStringProp;
 var
   Value: String;
   L: Integer;
 begin
   Stream.Read(L,SizeOf(L));
   SetLength(Value,L);
   Stream.Read(PChar(Value)^,L);
   SetStrProp(self,PropList[i],Value);
 end;

 procedure ReadClassProp;
 var
   Obj: TObject;
   SaveLoader: IStreamPersist;
   IsEmpty: Boolean;
 begin
   IsEmpty:=false;
   Obj:=GetObjectProp(self,PropList[i]);
   if (Obj is TGraphic) then begin
     Stream.Read(IsEmpty,SizeOf(Boolean));
   end;
   if (not IsEmpty) then begin
     if Supports(Obj,IStreamPersist,SaveLoader) then begin
       SaveLoader.LoadFromStream(Stream);
     end;
   end;
 end;
 
begin
 if ReadSignature then begin
   TypeData:=GetTypeData(ClassInfo);
   Count:=TypeData.PropCount;
   if Count>0 then begin
     GetMem(PropList,SizeOf(PPropInfo)*Count);
     try
       GetPropInfos(ClassInfo,PropList);
       for i:=0 to Count - 1 do begin
         case PropList[i].PropType^.Kind of
           tkEnumeration, tkInteger, tkChar, tkWChar: ReadOrdProp;
           tkFloat: ReadFloatProp;
           tkString, tkLString: ReadStringProp;
           tkClass: ReadClassProp;
         end;
       end;
     finally
       FreeMem(PropList,SizeOf(PPropInfo)*Count);
     end;
   end;
 end
 else begin
   // Неверная сигнатура
   raise EInvalidSignature.Create(ClassName+": "+strInvalidSignature);
 end;
end;

procedure TRttiObject.SaveToFile(FileName: TFileName);
var
 Stream: TFileStream;
begin
 Stream:=TFileStream.Create(FileName,fmCreate);
 try
   SaveToStream(Stream);
 finally
   Stream.Free;
 end;
end;

procedure TRttiObject.SaveToStream(Stream: TStream);
var
 TypeData: PTypeData;
 PropList: PPropList;
 Count,i: Integer;

 procedure WriteSignature;
 var
   Signature: String;
   L: Integer;
 begin
   Signature:=ClassSignature;
   L:=Length(Signature);
   Stream.Write(PChar(Signature)^,L);
 end;

 procedure WriteOrdProp;
 var
   Value: Integer;
 begin
   Value:=GetOrdProp(self,PropList[i]);
   Stream.Write(Value,SizeOf(Value));
 end;

 procedure WriteFloatProp;
 var
   Value: Extended;
 begin
   Value:=GetFloatProp(self,PropList[i]);
   Stream.Write(Value,SizeOf(Value));
 end;

 procedure WriteStringProp;
 var
   Value: String;
   L: Integer;
 begin
   Value:=GetStrProp(self,PropList[i]);
   L:=Length(Value);
   Stream.Write(L,SizeOf(L));
   Stream.Write(PChar(Value)^,Length(Value));
 end;

 procedure WriteClassProp;
 var
   Obj: TObject;
   SaveLoader: IStreamPersist;
   IsEmpty: Boolean;
 begin
   Obj:=GetObjectProp(self,PropList[i]);
   if (Obj is TGraphic) then begin
     IsEmpty:=TGraphic(Obj).Empty;
     Stream.Write(IsEmpty,SizeOf(Boolean));
   end;
   if Supports(Obj,IStreamPersist,SaveLoader) then begin
     SaveLoader.SaveToStream(Stream);
   end;
 end;

begin
 WriteSignature;
 TypeData:=GetTypeData(ClassInfo);
 Count:=TypeData.PropCount;
 if Count>0 then begin
   GetMem(PropList,SizeOf(PPropInfo)*Count);
   try
     GetPropInfos(ClassInfo,PropList);
     for i:=0 to Count - 1 do begin
       case PropList[i].PropType^.Kind of
         tkEnumeration, tkInteger, tkChar, tkWChar: WriteOrdProp;
         tkFloat: WriteFloatProp;
         tkString, tkLString: WriteStringProp;
         tkClass: WriteClassProp;
       end;
     end;
   finally
     FreeMem(PropList,SizeOf(PPropInfo)*Count);
   end;
 end;
end;

{ TAsyncRttiList }

procedure TAsyncRttiList.AsyncLoadFromFile(const FileName: TFileName);
var
 Thread: TLoadThread;
begin
 try
   Thread:=TLoadThread.Create(true);
   Thread.FreeOnTerminate:=true;
   Thread.ListObj:=self;
   Thread.FileName:=FileName;
   Thread.Resume;
 except
   // Ошибка потока
 end;
end;

procedure TAsyncRttiList.AsyncSaveToFile(const FileName: TFileName);
var
 Thread: TSaveThread;
begin
 try
   Thread:=TSaveThread.Create(true);
   Thread.FreeOnTerminate:=true;
   Thread.ListObj:=self;
   Thread.FileName:=FileName;
   Thread.Resume;
 except
   // Ошибка потока
 end;
end;

procedure TAsyncRttiList.BeginUpdate;
begin
 EnterCriticalSection(FCriticalSection);
end;

constructor TAsyncRttiList.Create;
begin
 inherited Create;
 InitializeCriticalSection(FCriticalSection);
end;

destructor TAsyncRttiList.Destroy;
begin
 WaitReleaseCriticalSection;
 DeleteCriticalSection(FCriticalSection);
 inherited Destroy;
end;

procedure TAsyncRttiList.EndUpdate;
begin
 LeaveCriticalSection(FCriticalSection);
end;

procedure TAsyncRttiList.WaitReleaseCriticalSection;
begin
 EnterCriticalSection(FCriticalSection);
 LeaveCriticalSection(FCriticalSection);
end;

{ TSaveThread }

procedure TSaveThread.Execute;
begin
 ListObj.BeginUpdate;
 try
   ListObj.SaveToFile(FFileName);
   ListObj.NotifyMainThread(ntSaveComplete);
 finally
   ListObj.EndUpdate;
 end;
end;

{ TLoadThread }

procedure TLoadThread.Execute;
begin
 ListObj.BeginUpdate;
 try
   ListObj.LoadFromFile(FFileName);
   ListObj.NotifyMainThread(ntLoadComplete);
 finally
   ListObj.EndUpdate;
 end;
end;

end.

---

← →
savyhinst ©   (2008-01-14 16:47) [16]

> Ins

Крууто. Вот только в том и проблема что я не могу просто взять и объявить TGLFreeForm потомком чего-то. А мне именно его надобно сохранить.

---

← →
Apollon ©   (2008-01-14 16:49) [17]

>Ins ©   (14.01.08 16:34) [13], [14], [15]

Сильно, но "Все уже украдено(написано) до нас" (с)

http://www.rsdn.ru/article/delphi/serialization.xml

---

← →
Apollon ©   (2008-01-14 16:55) [18]

> Вот только в том и проблема что я не могу просто взять и
> объявить TGLFreeForm потомком чего-то. А мне именно его
> надобно сохранить.

Если твой класс не является наследником TPersistent или для него явно не указана директива о включении для него RTTI, то в автоматическом режиме ты его никак не сохранишь

---

← →
Ins ©   (2008-01-14 16:57) [19]

TGLFreeForm - если это форма, то стандартная сериализация (TSteram.WriteComponent/ReadComponent) чем не подходит?

---

← →
Сергей М. ©   (2008-01-14 17:01) [20]

> savyhinst ©   (14.01.08 16:47) [16]


Ты придурок или куда ?

Тебе же сказано - сохранение объекта есть ничто иное как сохранение свойств этого объекта.

---

← →
Apollon ©   (2008-01-14 17:03) [21]

> TGLFreeForm - если это форма, то стандартная сериализация
> (TSteram.WriteComponent/ReadComponent) чем не подходит?


Если мне память не изменяет, это класс из библиотек GLScene, и он не является наследником TComponent.

---

← →
Ins ©   (2008-01-14 17:07) [22]

> Если мне память не изменяет, это класс из библиотек GLScene,
>  и он не является наследником TComponent.


Ну тогда звиняйте, мне показалось (по названию), что это класс-потомок TForm. GLScene в глаза не видел :)

---

← →
icWasya ©   (2008-01-14 17:07) [23]

Если класс скомпилировать с директивой {$M+}, то его свойства(published) будут доступны в рун-тиме

---

← →
savyhinst ©   (2008-01-14 17:08) [24]

> Если мне память не изменяет, это класс из библиотек GLScene,
>  и он не является наследником TComponent.

Я щас посмотрел - он является наследникои TComponent. Только не прямо, а то что он наследует в свою очередь наследует ещё всякую дрянь, а она уже TComponent. Значит, можно сохранять WriteComponent?

---

← →
Apollon ©   (2008-01-14 17:09) [25]

> savyhinst ©  


а вообще, друх, перед тем как пытаться создавать 3D приложения, неплохо было бы разобраться с азами...

---

← →
Ins ©   (2008-01-14 17:10) [26]

> Apollon ©   (14.01.08 17:09) [25]


Не царское это дело :)

---

← →
Apollon ©   (2008-01-14 17:10) [27]

> savyhinst ©   (14.01.08 17:08) [24]


значит, изменяет...
тогда смело используй WriteComponent

---

← →
savyhinst ©   (2008-01-14 17:12) [28]

> тогда смело используй WriteComponent

Спасибо огромное. Буду пытаться реализовать.

---

← →
Apollon ©   (2008-01-14 17:12) [29]

> Если класс скомпилировать с директивой {$M+}, то его свойства(published)
> будут доступны в рун-тиме

я это и имел в виду в [18] :)

---

← →
Amoeba ©   (2008-01-14 17:14) [30]

http://rsdn.ru/article/delphi/serialization.xml

---

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

Текущий архив: 2008.02.10;
Скачать: CL | DM;

Наверх

Память: 0.56 MB
Время: 0.021 c