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.
	
相关推荐
耍酷的魔镜9 小时前
核心设计理念:5W2H、JSON-LD 与通用知识图谱
人工智能·json·知识图谱
自信的未来9 小时前
JSON 工具|Web Worker 工程化打包 + 语法自动修复 + 多语言代码生成实战
java·前端·json
墨神谕12 小时前
JSON-RPC 2.0
网络协议·rpc·json
PixelBai15 小时前
什么是 JSON 验证工具?
json
码农学院20 小时前
电商零售品牌的6个技术信号——从JSON-LD结构化数据到llms.txt,让AI搜索主动推荐你的产品
人工智能·json·零售
月走乂山21 小时前
DeepSeek 对话记录一键导出:零依赖 Tampermonkey 脚本(支持 JSON/Markdown/ZIP)
json·油猴脚本·tampermonkey·数据导出·deepseek·对话记录·用户脚本
前网易架构师-高司机1 天前
带标注的打电话识别数据集,识别率98.9%,9723张图,支持yolo,coco json,voc xml,文末有模型训练代码
yolo·json·手机·数据集·打电话
sjg200104142 天前
JSON对象参数转URL参数
json
techdashen2 天前
Uber 如何用原生 gRPC 加速 OpenSearch:从 REST/JSON 瓶颈到搜索与写入性能优化
性能优化·json
我命由我123452 天前
Android 构建项目问题:XML 片段出错,com.ctc.wstx.exc.WstxUnexpectedCharException
android·xml·android studio·android jetpack·android-studio·android runtime