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.
	
相关推荐
AI 编程助手GPT9 小时前
用 jq 清洗订单 JSON:先隔离异常,再统计已支付金额
json·jq
qq_3400408811 小时前
idea2021版,vue项目的package.json不展示scripts的绿色箭头
javascript·vue.js·json
骑着蜗牛撵大象32712 小时前
大模型 SDK 编译就崩?用 CMakeLists 把 httplib、JSON 与 OpenSSL 装配成可复用的 ChatServer
android·java·c++·http·json·cmake·大模型sdk
可爱系程序猿1 天前
XML 导入失败并指向 msxml6.dll:用最小样本区分解析错误与组件加载
xml·程序人生·电脑
rich_Chan.2 天前
阿里云百炼联网搜索教程:web_search 工具开启方法、web_extractor 网页抓取与 json 检索轨迹
前端·阿里云·json
SEO_juper2 天前
Node.js 重定向链检测工具:301 跳了几跳、有没有成环,一次看清
xml·开发语言·python·node.js·json·bash
代码丰2 天前
跨系统传输大 JSON:直接压缩,还是把数据放进 Redis?
redis·后端·json
步行cgn2 天前
Spring MVC 核心配置文件详解:springmvc.xml 每一行配置的意义
xml·spring·mvc
司曜珩2 天前
构建AI友好型网站:用JSON-LD给企业官网上“户口”的实战指南
人工智能·json