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

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.