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.
	
相关推荐
憧憬成为原神糕手2 小时前
Playwright、Selenium、DrissionPage 与 JSON 接口怎么选?
数据库·selenium·json
SelectDB技术团队2 小时前
Apache Doris 4.1:面向 AI & Search 的统一数据底座怎么选?向量检索 + 全文搜索 + 100MB JSON 完整能力拆解
人工智能·json·apache doris
进击切图仔4 小时前
VS Code 调试 launch.json 解析
json
码智社18 小时前
JSON 零基础到资深全体系教程
java·json
五阿哥永琪2 天前
MySQL中操作json的函数!
数据库·mysql·json
用户7783366132112 天前
SERP API JSON Schema 演进版本管理实战
json·api
x17388062733 天前
XXE外部实体注入
xml·笔记
IT小盘3 天前
14-让大模型稳定输出JSON-Prompt约束与结构化输出
windows·json·prompt
赵庆明老师4 天前
Vben精讲:21-详解web-antd:tsconfig.json
前端·json·vim
云水一下4 天前
零基础玩转bWAPP靶场(三十):XML/XPath 注入(登录表单)
xml·web安全·bwapp