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

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

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

    废话少说,给出代码,此代码演示了怎样自己定义数据的保存及恢复、以及保存整个Form:
go 复制代码
	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.
	
相关推荐
冰水°4 小时前
2.5_XXE(XML外部实体注入)
xml·安全·网络安全·xml外部实体注入·外部实体注入·xml漏洞
爱吃土豆的程序员4 小时前
java XMLStreamConstants.CDATA 无法识别 <![CDATA[]]>
xml·java·cdata
Mephisto.java6 小时前
【大数据学习 | HBASE高级】storeFile文件的合并
大数据·sql·oracle·json·hbase·database
Json_181790144809 小时前
京东商品详情(item getAPI接口)json数据格式参考
大数据·json
颖火虫-IT赵云11 小时前
json转excel,读取json文件写入到excel中【rust语言】
rust·json·excel·jsontoexcel
航月12 小时前
yum下载时出现报错 Couldn‘t read a file:// file for file:///mnt/repodata/repomd.xml
xml·linux·运维
2的n次方_18 小时前
MyBatis——增删查改(XML 方式)
xml·数据库·mybatis
沟通反思总结18 小时前
【已解决】Postman:Get请求传JSON数据
json·postman
茅坑的小石头1 天前
json即json5新特性,idea使用json5,fastjson、gson、jackson对json5支持
java·json·json5
萧鼎1 天前
【Python】轻松解析JSON与XML:Python标准库的json与xml模块
xml·python·json