当前位置： 首页 > news >正文

core.binary.pas

news 2026/5/11 9:00:01 
unit core.binary;
// binary key-value pairs serialization
// Need support delphi6/7, The latest grammar cannot be used.
// cxg 2026
{$ifdef fpc}
{$mode delphi}{$H+}
{$endif}interfaceuses Variants, SysUtils, Classes, SyncObjs;{$IFNDEF fpc}
{$IF CompilerVersion < 18}// before delphi 2007
typeTBytes = array of byte;
{$IFEND}
{$IFNDEF UNICODE}typeRawByteString = AnsiString;PRawByteString = ^RawByteString;
{$ENDIF}
{$ENDIF}typestr = RawByteString;Pstr = PRawByteString;int = integer;Pint = PInteger;bool = Boolean;Pbool = PBoolean;TMemPool = classprivateFList: TList;CS: TCriticalSection;FPoolSize: Integer;privateprocedure Init;function NewObject: TMemoryStream;publicconstructor Create(APoolSize: Integer);destructor Destroy; override;public//get a object from poolfunction Lock: TMemoryStream; virtual;//return a object to the poolprocedure Unlock(AValue: TMemoryStream); virtual;end;TData = classprivateFKey: str; // The key must be uniqueFValue: TBytes; // valueprivateFList: TList;privatefunction Path(const AKey: str): TData;function GetByteCount: int;privatefunction GetByte(const AKey: str): byte;procedure SetByte(const AKey: str; const AValue: byte);function GetWord(const AKey: str): Word;procedure SetWord(const AKey: str; const AValue: Word);function GetCardinal(const AKey: str): Cardinal;procedure SetCardinal(const AKey: str; const AValue: Cardinal);function GetI(const AKey: str): int;procedure SetI(const AKey: str; const AValue: int);function GetI64(const AKey: str): Int64;procedure SetI64(const AKey: str; const AValue: Int64);function GetB(const AKey: str): bool;procedure SetB(const AKey: str; const AValue: bool);function GetD(const AKey: str): Double;procedure SetD(const AKey: str; const AValue: Double);function GetDT(const AKey: str): TDateTime;procedure SetDT(const AKey: str; const AValue: TDateTime);function GetC(const AKey: str): Currency;procedure SetC(const AKey: str; const AValue: Currency);function GetS(const AKey: str): str;procedure SetS(const AKey, AValue: str);function GetV(const AKey: str): Variant;procedure SetV(const AKey: str; const AValue: Variant);function GetST(const AKey: str): TStream;procedure SetST(const AKey: str; const AValue: TStream);function GetBT(const AKey: str): TBytes;procedure SetBT(const AKey: str; const AValue: TBytes);publicproperty byte[const key: str]: byte read GetByte write SetByte;property Word[const key: str]: Word read GetWord write SetWord;property Cardinal[const key: str]: Cardinal read GetCardinalwrite SetCardinal;property I[const key: str]: int read GetI write SetI;property I64[const key: str]: Int64 read GetI64 write SetI64;property B[const key: str]: bool read GetB write SetB;property C[const key: str]: Currency read GetC write SetC;property D[const key: str]: Double read GetD write SetD;property DateTime[const key: str]: TDateTime read GetDT write SetDT;property S[const key: str]: str read GetS write SetS;property V[const key: str]: Variant read GetV write SetV;// TClientDataset's data and deltaproperty Stream[const key: str]: TStream read GetST write SetST;property Bytes[const key: str]: TBytes read GetBT write SetBT;public // marshal
    procedure ToStream(AStream: TStream);function ToRaw: str;function ToBytes: TBytes;public // unmarshal
    procedure FromStream(AStream: TStream);procedure FromRaw(const AValue: str);procedure FromBytes(const AValue: TBytes);publicconstructor Create;destructor Destroy; override;procedure Clear; // clear list;
  end;var MemPool: TMemPool;implementationprocedure TData.Clear;
beginwhile FList.Count > 0 dobeginTData(FList[0]).free;FList.Delete(0);end;
end;constructor TData.Create;
beginFList := TList.Create;
end;destructor TData.Destroy;
beginClear;FreeAndNil(FList);
end;function TData.Path(const AKey: str): TData;
varI: int;LFound: bool;
beginResult := nil;LFound := False;for I := 0 to FList.Count - 1 dobeginif AKey = TData(FList[I]).FKey thenbeginResult := TData(FList[I]);exit;end;end;if not LFound thenbeginResult := TData.Create;Result.FKey := AKey;FList.Add(Result);end;
end;procedure TData.FromBytes(const AValue: TBytes);
varLData: TData;LPos, LLen: int;LKey: str;
beginLPos := 0;while LPos < length(AValue) dobeginMove(AValue[LPos], LLen, SizeOf(int));LPos := LPos + SizeOf(int);SetLength(LKey, LLen);Move(AValue[LPos], Pstr(LKey)^, LLen);LPos := LPos + LLen;Move(AValue[LPos], LLen, SizeOf(int));LPos := LPos + SizeOf(int);LData := TData.Create;SetLength(LData.FValue, LLen);Move(AValue[LPos], pbyte(LData.FValue)^, LLen);LPos := LPos + LLen;LData.FKey := LKey;FList.Add(LData);end;
end;procedure TData.FromRaw(const AValue: str);
varLData: TData;LPos, LLen: int;LKey: str;
beginLPos := 1;while LPos < length(AValue) dobeginMove(AValue[LPos], LLen, SizeOf(int));LPos := LPos + SizeOf(int);SetLength(LKey, LLen);Move(AValue[LPos], Pstr(LKey)^, LLen);LPos := LPos + LLen;Move(AValue[LPos], LLen, SizeOf(int));LPos := LPos + SizeOf(int);LData := TData.Create;SetLength(LData.FValue, LLen);Move(AValue[LPos], pbyte(LData.FValue)^, LLen);LPos := LPos + LLen;LData.FKey := LKey;FList.Add(LData);end;
end;procedure TData.FromStream(AStream: TStream);
varLLen: int;LKey: str;LData: TData;
beginAStream.Position := 0;while AStream.Position < AStream.size dobeginAStream.Read(LLen, SizeOf(int));SetLength(LKey, LLen);AStream.Read(Pstr(LKey)^, LLen);AStream.Read(LLen, SizeOf(int));LData := TData.Create;SetLength(LData.FValue, LLen);AStream.Read(pbyte(LData.FValue)^, LLen);LData.FKey := LKey;FList.Add(LData);end;
end;function TData.GetB(const AKey: str): bool;
varLData: TData;
beginLData := Path(AKey);Result := Pbool(LData.FValue)^;
end;function TData.GetBT(const AKey: str): TBytes;
varLData: TData;LLen: int;
beginLData := Path(AKey);LLen := length(LData.FValue);SetLength(Result, LLen);Move(pbyte(LData.FValue)^, pbyte(Result)^, LLen);
end;function TData.GetD(const AKey: str): Double;
varLData: TData;
beginLData := Path(AKey);Result := PDouble(LData.FValue)^;
end;function TData.GetDT(const AKey: str): TDateTime;
varLData: TData;
beginLData := Path(AKey);Result := PDateTime(LData.FValue)^;
end;function TData.GetI(const AKey: str): int;
varLData: TData;
beginLData := Path(AKey);Result := Pint(LData.FValue)^;
end;function TData.GetI64(const AKey: str): Int64;
varLData: TData;
beginLData := Path(AKey);Result := PInt64(LData.FValue)^;
end;function TData.GetS(const AKey: str): str;
varLData: TData;LLen: int;
beginLData := Path(AKey);LLen := length(LData.FValue);if LLen = 0 thenResult := ''elsebeginSetLength(Result, LLen);Move(pbyte(LData.FValue)^, Pstr(Result)^, LLen);end;
end;function TData.GetByte(const AKey: str): byte;
varLData: TData;
beginLData := Path(AKey);Result := pbyte(LData.FValue)^;
end;function TData.GetByteCount: int;
varI: int;
beginResult := 0;for I := 0 to FList.Count - 1 doResult := Result + SizeOf(int) * 2 + length(TData(FList[I]).FKey) +length(TData(FList[I]).FValue);
end;function TData.GetC(const AKey: str): Currency;
varLData: TData;
beginLData := Path(AKey);Result := PCurrency(LData.FValue)^;
end;function TData.GetCardinal(const AKey: str): Cardinal;
varLData: TData;
beginLData := Path(AKey);Result := PCardinal(LData.FValue)^;
end;function TData.GetST(const AKey: str): TStream;
varLData: TData;LLen: int;
beginLData := Path(AKey);LLen := length(LData.FValue);Result := MemPool.Lock;Result.size := LLen;Result.Write(pbyte(LData.FValue)^, LLen);Result.Position := 0;
end;function TData.GetV(const AKey: str): Variant;
varLPByte: pbyte;LLen: int;LData: TData;
beginLData := Path(AKey);LLen := length(LData.FValue);Result := VarArrayCreate([0, LLen - 1], varByte);LPByte := VarArrayLock(Result);tryMove(pbyte(LData.FValue)^, LPByte^, LLen);finallyVarArrayUnlock(Result);end;
end;function TData.GetWord(const AKey: str): Word;
varLData: TData;
beginLData := Path(AKey);Result := pbyte(LData.FValue)^;
end;procedure TData.SetB(const AKey: str; const AValue: bool);
varLData: TData;
beginLData := Path(AKey);SetLength(LData.FValue, SizeOf(bool));Pbool(LData.FValue)^ := AValue;
end;procedure TData.SetBT(const AKey: str; const AValue: TBytes);
varLData: TData;LLen: int;
beginLLen := length(AValue);LData := Path(AKey);SetLength(LData.FValue, LLen);Move(pbyte(AValue)^, pbyte(LData.FValue)^, LLen);
end;procedure TData.SetByte(const AKey: str; const AValue: byte);
varLData: TData;
beginLData := Path(AKey);SetLength(LData.FValue, 1);pbyte(LData.FValue)^ := AValue;
end;procedure TData.SetC(const AKey: str; const AValue: Currency);
varLData: TData;
beginLData := Path(AKey);SetLength(LData.FValue, SizeOf(Currency));PCurrency(LData.FValue)^ := AValue;
end;procedure TData.SetCardinal(const AKey: str; const AValue: Cardinal);
varLData: TData;
beginLData := Path(AKey);SetLength(LData.FValue, 4);PCardinal(LData.FValue)^ := AValue;
end;procedure TData.SetD(const AKey: str; const AValue: Double);
varLData: TData;
beginLData := Path(AKey);SetLength(LData.FValue, SizeOf(Double));PDouble(LData.FValue)^ := AValue;
end;procedure TData.SetDT(const AKey: str; const AValue: TDateTime);
varLData: TData;
beginLData := Path(AKey);SetLength(LData.FValue, SizeOf(TDateTime));PDateTime(LData.FValue)^ := AValue;
end;procedure TData.SetI(const AKey: str; const AValue: integer);
varLData: TData;
beginLData := Path(AKey);SetLength(LData.FValue, SizeOf(int));PInteger(LData.FValue)^ := AValue;
end;procedure TData.SetI64(const AKey: str; const AValue: Int64);
varLData: TData;
beginLData := Path(AKey);SetLength(LData.FValue, SizeOf(Int64));PInt64(LData.FValue)^ := AValue;
end;procedure TData.SetS(const AKey, AValue: str);
varLLen: int;LData: TData;
beginLData := Path(AKey);LLen := length(AValue);SetLength(LData.FValue, LLen);if LLen > 0 thenMove(Pstr(AValue)^, pbyte(LData.FValue)^, LLen);
end;procedure TData.SetST(const AKey: str; const AValue: TStream);
varLData: TData;
beginLData := Path(AKey);SetLength(LData.FValue, AValue.size);AValue.Position := 0;AValue.Read(pbyte(LData.FValue)^, AValue.size);AValue.Position := 0;
end;procedure TData.SetV(const AKey: str; const AValue: Variant);
varLPByte: pbyte;LLen: int;LData: TData;
beginLData := Path(AKey);LLen := VarArrayHighBound(AValue, 1) - VarArrayLowBound(AValue, 1) + 1;LPByte := VarArrayLock(AValue);trySetLength(LData.FValue, LLen);Move(LPByte^, pbyte(LData.FValue)^, LLen);finallyVarArrayUnlock(AValue);end;
end;procedure TData.SetWord(const AKey: str; const AValue: Word);
varLData: TData;
beginLData := Path(AKey);SetLength(LData.FValue, 2);PWord(LData.FValue)^ := AValue;
end;function TData.ToBytes: TBytes;
varI, LLen, LPos: int;
beginSetLength(Result, GetByteCount);LPos := 0;for I := 0 to FList.Count - 1 dobeginLLen := length(TData(FList[I]).FKey);Move(LLen, Result[LPos], SizeOf(int));LPos := LPos + SizeOf(int);Move(Pstr(TData(FList[I]).FKey)^, Result[LPos], LLen);LPos := LPos + LLen;LLen := length(TData(FList[I]).FValue);Move(LLen, Result[LPos], SizeOf(int));LPos := LPos + SizeOf(int);Move(pbyte(TData(FList[I]).FValue)^, Result[LPos], LLen);LPos := LPos + LLen;end;
end;function TData.ToRaw: str;
varI, LLen, LPos: int;
beginSetLength(Result, GetByteCount);LPos := 1;for I := 0 to FList.Count - 1 dobeginLLen := length(TData(FList[I]).FKey);Move(LLen, Result[LPos], SizeOf(int));LPos := LPos + SizeOf(int);Move(Pstr(TData(FList[I]).FKey)^, Result[LPos], LLen);LPos := LPos + LLen;LLen := length(TData(FList[I]).FValue);Move(LLen, Result[LPos], SizeOf(int));LPos := LPos + SizeOf(int);Move(pbyte(TData(FList[I]).FValue)^, Result[LPos], LLen);LPos := LPos + LLen;end;
end;procedure TData.ToStream(AStream: TStream);
varI, LLen: int;
beginAStream.Position := 0;for I := 0 to FList.Count - 1 dobeginLLen := length(TData(FList[I]).FKey);AStream.Write(LLen, SizeOf(int));AStream.Write(Pstr(TData(FList[I]).FKey)^, LLen);LLen := length(TData(FList[I]).FValue);AStream.Write(LLen, SizeOf(int));AStream.Write(pbyte(TData(FList[I]).FValue)^, LLen);end;AStream.Position := 0;
end;{ TMemPool }constructor TMemPool.Create(APoolSize: Integer);
beginFList := TList.Create;CS := TCriticalSection.Create;Self.FPoolSize := APoolSize;Self.Init;
end;destructor TMemPool.Destroy;
beginFList.Clear;FreeAndNil(FList);FreeAndNil(CS);inherited Destroy;
end;procedure TMemPool.Init;
beginwhile FList.Count < Self.FPoolSize doFList.Add(NewObject);
end;function TMemPool.Lock: TMemoryStream;
beginCS.Enter;tryif FList.Count > 0 thenbeginResult := TMemoryStream(FList.First);FList.Remove(Result);endelsebeginFList.Add(NewObject);Result := TMemoryStream(FList.First);FList.Remove(Result);end;finallycs.Leave;end;
end;function TMemPool.NewObject: TMemoryStream;
beginResult := TMemoryStream.Create;
end;procedure TMemPool.Unlock(AValue: TMemoryStream);
beginAValue.Clear;   //free memory
  FList.Add(AValue);
end;initializationMemPool := TMemPool.Create(1000);end.

 

http://www.jsqmd.com/news/321505/

相关文章：

  • 想要高性价比毛绒布？蠡县比尤特纺织产品实力强劲，获客户广泛认可
  • 2026电线电缆厂家推广哪个平台效果好，电线电缆哪个平台订单多？
  • 反应釜用导热油炉哪个品牌好用，瑞源加热设备值得选吗？
  • OpenSSH远程代码执行高危漏洞(CVE-2024–6387)深度解析
  • 【电热耦合——锂电池集总参数热模型参数辨识】 Rs Cs Rc Cc GA算法辨识热参数
  • 官方网站搭建平台怎么选？聚焦实力、稳定及高性价比之选
  • 中文需求生成英文测试用例的技术路径与实践挑战
  • 前端
  • 算法竞赛中cin常用的成员函数
  • 气体检测仪2026年市场格局深度盘点：从国际巨头到本土专精企业的全景扫描
  • 盒马鲜生礼品卡回收实操五步指南
  • AI测试用例生成的数据驱动革命：从真实行为到精准覆盖
  • 深入解析：【Linux 网络】理解并应用应用层协议：HTTP（附简单HTTP服务器C++代码）
  • 详解Veo 3.1视频AI模型与Flow编辑新特性
  • 我让AI模拟“用户操作路径”，自动生成端到端用例
  • 2026国内最新木纹板材品牌top10推荐！优质木纹板材权源头厂家威榜单发布，环保与美学兼具助力高品质家居生活
  • 2026年江西性价比高的中医学校排名，想提升技能学习中医的优选
  • 救命神器2026最新！9款AI论文写作软件测评：本科生毕业论文必备
  • 看看靠谱的中医师承报考学校，江西中医药大学实践机会多价格怎样
  • 组态王6.X工程密码恢复工具（支持6.51/6.52/6.53/6.55/6.6SP3SP4）2025最新版｜所见即所得，一键清除遗忘密码
  • 分析超市零售批发，北京口碑好的服务推荐哪家
  • 2026必备！10个AI论文工具，MBA轻松搞定毕业论文！
  • 聊聊视唱练耳培训服务怎么收费，东城区有推荐的吗
  • 商业照明指南：从筒灯选型看光品质与能效平衡
  • 讲讲十大进口瓷砖品牌，依诺岩板性价比如何？
  • 2026年广州性价比高的送菜品牌企业排名，有实力的送菜企业推荐
  • 2026国内最新环保板材品牌top10推荐！优质环保板材源头厂家权威榜单发布，技术创新与环保性能双优助力健康家居生活
  • 2025年12月成都火锅大赏！春熙路网红火锅盘点，特色美食/火锅店/社区火锅，成都火锅回头客多的怎么选择
  • 聊聊便捷式紫外烟气测试仪哪家好，宇华智环性价比高值得选
  • 重德针织袜业作为袜子定制厂家品牌如何，产品选购有啥技巧？