惯性聚合 高效追踪和阅读你感兴趣的博客、新闻、科技资讯
阅读原文 在惯性聚合中打开

推荐订阅源

博客园 - Franky
奇客Solidot–传递最新科技情报
奇客Solidot–传递最新科技情报
美团技术团队
The Cloudflare Blog
量子位
酷 壳 – CoolShell
酷 壳 – CoolShell
博客园_首页
F
Fortinet All Blogs
J
Java Code Geeks
人人都是产品经理
人人都是产品经理
N
Netflix TechBlog - Medium
Cyber Security Advisories - MS-ISAC
Cyber Security Advisories - MS-ISAC
爱范儿
爱范儿
Apple Machine Learning Research
Apple Machine Learning Research
B
Blog RSS Feed
博客园 - 聂微东
Hugging Face - Blog
Hugging Face - Blog
WordPress大学
WordPress大学
小众软件
小众软件
Y
Y Combinator Blog
OSCHINA 社区最新新闻
OSCHINA 社区最新新闻
Vercel News
Vercel News
S
SegmentFault 最新的问题
有赞技术团队
有赞技术团队

博客园 - delphi中间件

delphi 面向模型编程 array of TVarRec 使用泛型序列结构体 DDD建模指导 rabbitMQ VS mqtt redis流的应用场景 redis消费者组 redis流的操作命令 领域服务与领域事件 业务规则和模型 限界上下文与统一语言 领域驱动 mqtt即时通讯 ActiveRecord ORM RAD(速成应用开发) unigui插件框架 工厂流水线式自动生产UNIGUI WEB软件 delphi cs\web一种统一的界面风格 - delphi中间件 - 博客园 动态生成unidbgrid 单据工厂 用json元数据填充模板 mormot2 ORM rest vs jsonrpc SSE技术详解:使用 HTTP 做服务端数据推送应用的技术 http持久连接 json-rpc 2.0 MCP服务器 RTTI对性能的影响 频繁地创建和销毁对象 TMultiPartFormData
core.recordModel.pas
delphi中间件 · 2026-09-08 · via 博客园 - delphi中间件
unit core.recordModel;
// cxg 2026
{$ifdef fpc}
{$mode delphi}{$H+}
{$endif}
interface

uses
  Classes,
  SysUtils
  {$ifndef fpc}
  , json.Serializers
  {$else}
  , fpjson, fpjsonrtti, jsonparser, fpjson.helper
  {$endif}
  ;

type
  ByteStr = RawByteString;
  PByteStr = PRawByteString;

  // record<-->json(binary)
type
  TRecordSerial<T> = record
  public
    // json-->record
    class procedure unjson(const AJson: string; var AResult: T); static;
    // record-->json
    class procedure json(const ARecord: T; var AResult: string); static;
    //record-->binary
    class procedure bytes(const ARecord: T; var AResult: TBytes); static;
    class procedure bytestr(const ARecord: T; var AResult: ByteStr); static;
    class procedure stream(const ARecord: T; var AResult: TStream); static;
    //binary-->record
    class procedure unbytes(const ABytes: TBytes; var AResult: T); static;
    class procedure unbytestr(const AByteStr: ByteStr; var AResult: T); static;
    class procedure unstream(const AStream: TStream; var AResult: T); static;
  end;

implementation

{ TRecordSerial<T> }

class procedure TRecordSerial<T>.json(const ARecord: T; var AResult: string);
{$ifdef fpc}
var js: TJSONStreamer;
{$endif}
begin
  if @ARecord = nil then Exit;
  {$ifndef fpc}
  var LJsonSerializer: TJsonSerializer := TJsonSerializer.Create;
  try
    AResult := LJsonSerializer.Serialize<T>(ARecord);
  finally
    LJsonSerializer.Free;
  end;
  {$else}
  js := TJSONStreamer.Create(nil);
  try
    AResult := js.RecordToJSONString(@ARecord, typeinfo(T));
  finally
    js.Free;
  end;
  {$endif}
end;

class procedure TRecordSerial<T>.stream(const ARecord: T; var AResult: TStream);
begin
  if @ARecord = nil then Exit;
  if AResult = nil then
    AResult := TMemoryStream.Create;
  AResult.Write(ARecord, SizeOf(ARecord));
  AResult.Position := 0;
end;

class procedure TRecordSerial<T>.bytes(const ARecord: T; var AResult: TBytes);
var len: Integer;
begin
  if @ARecord = nil then Exit;
  len := SizeOf(ARecord);
  SetLength(AResult, len);
  Move(ARecord,  PByte(AResult)^, len);
end;

class procedure TRecordSerial<T>.bytestr(const ARecord: T; var AResult: RawByteString);
var len: Integer;
begin
  if @ARecord = nil then Exit;
  len := SizeOf(ARecord);
  SetLength(AResult, len);
  Move(ARecord, PByteStr(AResult)^, len);
end;

class procedure TRecordSerial<T>.UnJson(const AJson: string; var AResult: T);
{$ifdef fpc}
var js: TJSONDeStreamer;
  LRecord: T;
{$endif}
begin
  if AJson = '' then
    Exit;
  {$ifndef fpc}
  var LJsonSerializer: TJsonSerializer := TJsonSerializer.Create;
  try
    AResult := LJsonSerializer.Deserialize<T>(AJson);
  finally
    LJsonSerializer.Free;
  end;
  {$else}
  js := TJSONDeStreamer.Create(nil);
  try
    js.JSONToRecord(AJson, @AResult, typeinfo(AResult));
  finally
    js.Free;
  end;
  {$endif}
end;

class procedure TRecordSerial<T>.unstream(const AStream: TStream; var AResult: T);
begin
  if AStream = nil then Exit;
  AStream.Read(AResult, AStream.Size);
end;

class procedure TRecordSerial<T>.unbytes(const ABytes: TBytes; var AResult: T);
var len: Integer;
begin
  len := Length(ABytes);
  if len = 0 then Exit;
  Move(PByte(ABytes)^, AResult, len);
end;

class procedure TRecordSerial<T>.unbytestr(const AByteStr: RawByteString; var AResult: T);
var len: Integer;
begin
  len := Length(AByteStr);
  if len = 0 then Exit;
  Move(PByteStr(AByteStr)^, AResult, len);
end;

end.