Delphi语言怎样对自己定义类进行持久化保存及恢复 (性能远比json/xml高)

本文介绍: Del p hi的RTL自身就带有一套非常好的资源持久化保存（IDE设计窗口时，保存为DFM格式及编译到EXE里面的资源文件）及恢复机制（EXE启动时对窗口资源的载入），那么应不是必需再额外用xml/json 格式保存程序的參数了。我们大能够将參数集中在一个參数类里面，然后通过这套机制进行保存及恢复。

Delphi的RTL自身就带有一套非常好的资源持久化保存（IDE设计窗口时，保存为DFM格式及编译到EXE里面的资源文件）及恢复机制（EXE启动时对窗口资源的载入），那么应不是必需再额外用xml/json格式保存程序的參数了。我们大能够将參数集中在一个參数类里面，然后通过这套机制进行保存及恢复。

    因为我们的參数类型可能五花八门。除了传统的整数、小数、字符串、true/false、还有可能是数组、列表、枚举等，则须要override DefineProperties这个函数来自己定义属性的保存及恢复。

    废话少说，给出代码，此代码演示了怎样自己定义数据的保存及恢复、以及保存整个Form：

	unit Unit1;
 
	interface
 
	uses
	  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
	  Vcl.Graphics,
	  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
 
	type
	  TArrayOfInteger = array of integer;
 
	  TSetting = class(TComponent)
	  private
		fIntVal: integer;
		fIntArr: TArrayOfInteger;
		procedure ReadIntArr(Reader: TReader);
		procedure WriteIntArr(Writer: TWriter);
	  protected
		procedure DefineProperties(Filer: TFiler); override;
	  public
		property intArr: TArrayOfInteger read fIntArr write fIntArr;
 
	  published
		property intval: integer read fIntVal write fIntVal;
	  end;
 
	  TForm1 = class(TForm)
		btnCloneClass: TButton;
		mmo1: TMemo;
		btnCloneForm: TButton;
		procedure btnCloneClassClick(Sender: TObject);
		procedure btnCloneFormClick(Sender: TObject);
	  private
		{ Private declarations }
	  public
		{ Public declarations }
	  end;
 
	var
	  Form1: TForm1;
 
	implementation
 
	{$R *.dfm}
	{ TSetting }
 
	procedure TSetting.DefineProperties(Filer: TFiler);
	begin
	  inherited;
	  Filer.DefineProperty('intArr', ReadIntArr, WriteIntArr, true);
	end;
 
	procedure TSetting.ReadIntArr(Reader: TReader);
	var
	  lvIdx: integer;
	begin
	  fIntArr := nil;
	  Reader.ReadListBegin;
	  SetLength(fIntArr,Reader.ReadInteger);
	  lvIdx:=low(fIntArr);
	  while not Reader.EndOfList do
	  begin
		fIntArr[lvIdx] := Reader.ReadInteger;
		inc(lvIdx);
	  end;
	  Reader.ReadListEnd;
	end;
 
	procedure TSetting.WriteIntArr(Writer: TWriter);
	var
	  i: integer;
	begin
	  Writer.WriteListBegin;
	  Writer.WriteInteger(integer(Length(fIntArr)));
	  for i := Low(fIntArr) to High(fIntArr) do
	  begin
		Writer.WriteInteger(fIntArr[i]);
	  end;
	  Writer.WriteListEnd;
	end;
 
	function ClassToStr(pvClass: TComponent): ansiString;
	var
	  inStream, outStream: TMemoryStream;
 
	begin
	  inStream := TMemoryStream.Create;
	  outStream := TMemoryStream.Create;
	  try
		inStream.WriteComponentRes(pvClass.ClassName, pvClass);
		// inStream.WriteComponent(pvClass);
		inStream.Position := 0;
		ObjectResourceToText(inStream, outStream);
		// ObjectBinaryToText(inStream,outStream);
		outStream.Position := 0;
		SetLength(Result, outStream.Size + 1);
		FillChar(Result[1], outStream.Size + 1, 0);
		outStream.ReadBuffer(Result[1], outStream.Size);
	  finally
		FreeAndNil(inStream);
		FreeAndNil(outStream);
	  end;
	end;
 
	function StrToClass(pvStr: ansiString; pvCmpToSetProperties: TComponent=nil): TComponent;
	var
	  inStream, outStream: TMemoryStream;
	begin
	  inStream := TMemoryStream.Create;
	  outStream := TMemoryStream.Create;
	  try
		if (pvStr <> '') then
		  inStream.WriteBuffer(pvStr[1], length(pvStr));
		inStream.Position := 0;
		ObjectTextToResource(inStream, outStream);
		// ObjectTextToBinary(inStream,outStream);
		outStream.Position := 0;
		Result := outStream.ReadComponentRes(pvCmpToSetProperties);
	  finally
		FreeAndNil(inStream);
		FreeAndNil(outStream);
	  end;
 
	end;
 
	procedure TForm1.btnCloneClassClick(Sender: TObject);
	var
	  lvObj, lv1: TSetting;
	  lvStr: String;
	  lvArr: TArrayOfInteger;
	begin
	  lvObj := TSetting.Create(nil);
	  try
		lvObj.intval := 12345;
		SetLength(lvArr, 3);
		lvArr[0] := 222;
		lvArr[1] := 333;
		lvArr[2] := 444;
		lvObj.intArr := lvArr;
		lvStr := ClassToStr(lvObj);
		RegisterClass(TSetting);
		lvObj.intval := 1;
		lv1 := TSetting(StrToClass(lvStr, nil));
		if (lv1.intval > lvObj.intval) then
		  mmo1.Text := lvStr;
	  finally
		FreeAndNil(lvObj);
		FreeAndNil(lv1);
	  end;
	  // WriteComponentResFile(ExtractFilePath(ParamStr(0))+ 'd.res',self);
	end;
 
	procedure TForm1.btnCloneFormClick(Sender: TObject);
	var lvNewForm:TForm1;
	lvRes:string;
	begin
	  lvRes:=ClassToStr(self);
	  RegisterClass(TForm1);
	  lvNewForm:=TForm1.CreateNew(application);
	  StrToClass(lvRes,lvNewForm);
	  lvNewForm.Left:=self.Left+50;
	  lvNewForm.Top:=self.Top+50;
 
	end;
 
	end.