首页 > 其他分享 >db.msgpack.pas

db.msgpack.pas

时间：2024-12-19 11:58:25浏览次数：7  
标签：function begin msgpack end pvStream db pas result TMsgPack

db.msgpack.pas

unit db.msgpack;

// cxg 2024-12-12 only for delphi
interface

uses
  classes, SysUtils
{$IFDEF UNICODE}, Generics.Collections{$ELSE}, Contnrs{$ENDIF}
{$IFDEF MSWINDOWS}, Windows{$ENDIF}
    , Variants;

type
{$IF RTLVersion<25}
  IntPtr = Integer;
{$IFEND IntPtr}
{$IF CompilerVersion < 18} // before delphi 2007
  TBytes = array of Byte;
{$IFEND}
  TMsgPackType = (mptUnknown, mptNull, mptMap, mptArray, mptString, mptInteger,
    mptBoolean, mptFloat, mptSingle, mptDateTime, mptBinary);

  // reserved
  IMsgPack = interface
    ['{37D3E479-7A46-435A-914D-08FBDA75B50E}']
  end;

  // copy from qmsgPack
  TMsgPackValue = packed record
    ValueType: Byte;
    case Integer of
      0:
        (U8Val: Byte);
      1:
        (I8Val: Shortint);
      2:
        (U16Val: Word);
      3:
        (I16Val: Smallint);
      4:
        (U32Val: Cardinal);
      5:
        (I32Val: Integer);
      6:
        (U64Val: UInt64);
      7:
        (I64Val: Int64);
      // 8:(F32Val:Single);
      // 9:(F64Val:Double);
      10:
        (BArray: array [0 .. 16] of Byte);
  end;

  TMsgPackSetting = class(TObject)
  private
    FCaseSensitive: Boolean;
  public
    property CaseSensitive: Boolean read FCaseSensitive write FCaseSensitive;
  end;

  TMsgPack = class(TObject)
  private
    FParent: TMsgPack;
    FLowerName: string;
    FName: string;
    FValue: TBytes;
    FDataType: TMsgPackType;
{$IFDEF UNICODE}
    FChildren: TObjectList<TMsgPack>;
{$ELSE}
    FChildren: TObjectList;
{$ENDIF}
    procedure InnerAddToChildren(pvDataType: TMsgPackType; obj: TMsgPack);
    function InnerAdd(pvDataType: TMsgPackType): TMsgPack; overload;
    function InnerAdd(): TMsgPack; overload;
    function GetCount: Integer;
    procedure InnerEncodeToStream(pvStream: TStream);
    procedure InnerParseFromStream(pvStream: TStream);
    procedure setName(pvName: string);
  private
    function getAsString: String;
    procedure setAsString(pvValue: string);

    function getAsInteger: Int64;
    procedure setAsInteger(pvValue: Int64);
    function GetAsBoolean: Boolean;
    procedure SetAsBoolean(const Value: Boolean);

    procedure SetAsFloat(const Value: Double);
    function GetAsFloat: Double;

    procedure SetAsDateTime(const Value: TDateTime);
    function GetAsDateTime: TDateTime;

    function GetAsVariant: Variant;
    procedure SetAsVariant(const Value: Variant);

    procedure SetAsSingle(const Value: Single);
    function GetAsSingle: Single;

    procedure SetAsBytes(const Value: TBytes);
    function GetAsBytes: TBytes;

    procedure CheckObjectDataType(ANewType: TMsgPackType);

    function FindObj(pvName: string): TMsgPack;
    function IndexOf(pvName: string): Integer;
    function IndexOfCaseSensitive(pvName: string): Integer;
    function IndexOfIgnoreSensitive(pvLowerCaseName: string): Integer;
  private
    /// <summary>
    /// find object index by a path
    /// </summary>
    function InnerFindPathObject(pvPath: string; var vParent: TMsgPack;
      var vIndex: Integer): TMsgPack;

    function GetO(pvPath: String): TMsgPack;
    procedure SetO(pvPath: String; const Value: TMsgPack);

    function GetS(pvPath: String): string;
    procedure SetS(pvPath: String; const Value: string);

    function GetI(pvPath: String): Int64;
    procedure SetI(pvPath: String; const Value: Int64);

    function GetB(pvPath: String): Boolean;
    procedure SetB(pvPath: String; const Value: Boolean);

    function GetD(pvPath: String): Double;
    procedure SetD(pvPath: String; const Value: Double);

    function GetItems(AIndex: Integer): TMsgPack;
    function GetV(pvPath: String): Variant;
    procedure SetV(pvPath: String; const Value: Variant);
  public
    constructor Create;
    destructor Destroy; override;

    procedure Clear;

    property Count: Integer read GetCount;

    procedure LoadStream(pvStream: TStream; pvLen: Cardinal = 0);
    procedure SaveStream(pvStream: TStream);

    procedure LoadBinaryFromFile(pvFileName: String);
    procedure SaveBinaryToFile(pvFileName: String);

    procedure ToStream(pvStream: TStream);
    procedure ToFile(pvFileName: string);
    function ToRaw: RawByteString;

    procedure FromStream(pvStream: TStream);
    procedure DecodeFromFile(pvFileName: string);
    procedure FromRaw(const raw: RawByteString);

    function ToBytes: TBytes;
    procedure FromBytes(pvBytes: TBytes);

    function Add(pvNameKey, pvValue: string): TMsgPack; overload;
    function Add(pvNameKey: string; pvValue: Int64): TMsgPack; overload;
    function Add(pvNameKey: string; pvValue: TBytes): TMsgPack; overload;
    function Add(pvNameKey: String): TMsgPack; overload;
    function Add: TMsgPack; overload;

    function AddArrayChild: TMsgPack;

    function path(pvPath: string): TMsgPack;

    /// <summary>
    /// remove and free object
    /// false : object is not found!
    /// </summary>
    function DeleteObject(pvPath: String): Boolean;

    property AsInteger: Int64 read getAsInteger write setAsInteger;
    property AsString: string read getAsString write setAsString;
    property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean;
    property AsFloat: Double read GetAsFloat write SetAsFloat;
    property AsSingle: Single read GetAsSingle write SetAsSingle;
    property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
    property AsVariant: Variant read GetAsVariant write SetAsVariant;

    property AsBytes: TBytes read GetAsBytes write SetAsBytes;

    property O[pvPath: String]: TMsgPack read GetO write SetO;
    property S[pvPath: String]: string read GetS write SetS;
    property I[pvPath: String]: Int64 read GetI write SetI;
    property B[pvPath: String]: Boolean read GetB write SetB;
    property D[pvPath: String]: Double read GetD write SetD;
    property V[pvPath: String]: Variant read GetV write SetV;

    property Items[AIndex: Integer]: TMsgPack read GetItems; default;
  end;

{$IFNDEF unicode}

type
  RawByteString = AnsiString;
{$ENDIF}

  TRawByteStringStream = class(TStream)
  protected
    fDataString: RawByteString;
    fPosition: Integer;
    procedure SetSize(NewSize: Longint); override;
  public
    constructor Create(const aString: RawByteString = ''); overload;
    function Read(var Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    property DataString: RawByteString read fDataString write fDataString;
  end;

implementation

resourcestring
  SVariantConvertNotSupport = 'type to convert not support!。';
  SCannotAddChild = 'Can''t add child in this node!';

function swap16(const V): Word;
begin
  // FF, EE : EE->1, FF->2
  PByte(@result)^ := PByte(IntPtr(@V) + 1)^;
  PByte(IntPtr(@result) + 1)^ := PByte(@V)^;
end;

function swap32(const V): Cardinal;
begin
  // FF, EE, DD, CC : CC->1, DD->2, EE->3, FF->4
  PByte(@result)^ := PByte(IntPtr(@V) + 3)^;
  PByte(IntPtr(@result) + 1)^ := PByte(IntPtr(@V) + 2)^;
  PByte(IntPtr(@result) + 2)^ := PByte(IntPtr(@V) + 1)^;
  PByte(IntPtr(@result) + 3)^ := PByte(@V)^;
end;

function swap64(const V): Int64;
begin
  // FF, EE, DD, CC, BB, AA, 99, 88 : 88->1 ,99->2 ....
  PByte(@result)^ := PByte(IntPtr(@V) + 7)^;
  PByte(IntPtr(@result) + 1)^ := PByte(IntPtr(@V) + 6)^;
  PByte(IntPtr(@result) + 2)^ := PByte(IntPtr(@V) + 5)^;
  PByte(IntPtr(@result) + 3)^ := PByte(IntPtr(@V) + 4)^;
  PByte(IntPtr(@result) + 4)^ := PByte(IntPtr(@V) + 3)^;
  PByte(IntPtr(@result) + 5)^ := PByte(IntPtr(@V) + 2)^;
  PByte(IntPtr(@result) + 6)^ := PByte(IntPtr(@V) + 1)^;
  PByte(IntPtr(@result) + 7)^ := PByte(@V)^;
end;

// v and outVal is can't the same value
procedure swap64Ex(const V; out outVal);
begin
  // FF, EE, DD, CC, BB, AA, 99, 88 : 88->1 ,99->2 ....
  PByte(@outVal)^ := PByte(IntPtr(@V) + 7)^;
  PByte(IntPtr(@outVal) + 1)^ := PByte(IntPtr(@V) + 6)^;
  PByte(IntPtr(@outVal) + 2)^ := PByte(IntPtr(@V) + 5)^;
  PByte(IntPtr(@outVal) + 3)^ := PByte(IntPtr(@V) + 4)^;
  PByte(IntPtr(@outVal) + 4)^ := PByte(IntPtr(@V) + 3)^;
  PByte(IntPtr(@outVal) + 5)^ := PByte(IntPtr(@V) + 2)^;
  PByte(IntPtr(@outVal) + 6)^ := PByte(IntPtr(@V) + 1)^;
  PByte(IntPtr(@outVal) + 7)^ := PByte(@V)^;
end;

// v and outVal is can't the same value
procedure swap32Ex(const V; out outVal);
begin
  // FF, EE, DD, CC : CC->1, DD->2, EE->3, FF->4
  PByte(@outVal)^ := PByte(IntPtr(@V) + 3)^;
  PByte(IntPtr(@outVal) + 1)^ := PByte(IntPtr(@V) + 2)^;
  PByte(IntPtr(@outVal) + 2)^ := PByte(IntPtr(@V) + 1)^;
  PByte(IntPtr(@outVal) + 3)^ := PByte(@V)^;
end;

// v and outVal is can't the same value
procedure swap16Ex(const V; out outVal);
begin
  // FF, EE : EE->1, FF->2
  PByte(@outVal)^ := PByte(IntPtr(@V) + 1)^;
  PByte(IntPtr(@outVal) + 1)^ := PByte(@V)^;
end;

// overload swap, result type is integer, because single maybe NaN
function swap(V: Single): Integer; overload;
begin
  swap32Ex(V, result);
end;

// overload swap
function swap(V: Word): Word; overload;
begin
  swap16Ex(V, result);
end;

// overload swap
function swap(V: Cardinal): Cardinal; overload;
begin
  swap32Ex(V, result);
end;

// swap , result type is Int64, because Double maybe NaN
function swap(V: Double): Int64; overload;
begin
  swap64Ex(V, result);
end;

// copy from qstring
function BinToHex(p: Pointer; l: Integer; ALowerCase: Boolean): string;
const
  B2HConvert: array [0 .. 15] of Char = ('0', '1', '2', '3', '4', '5', '6', '7',
    '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');
  B2HConvertL: array [0 .. 15] of Char = ('0', '1', '2', '3', '4', '5', '6',
    '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
var
  pd: PChar;
  pb: PByte;
begin
  if SizeOf(Char) = 2 then
  begin
    SetLength(result, l shl 1);
  end
  else
  begin
    SetLength(result, l);
  end;
  pd := PChar(result);
  pb := p;
  if ALowerCase then
  begin
    while l > 0 do
    begin
      pd^ := B2HConvertL[pb^ shr 4];
      Inc(pd);
      pd^ := B2HConvertL[pb^ and $0F];
      Inc(pd);
      Inc(pb);
      Dec(l);
    end;
  end
  else
  begin
    while l > 0 do
    begin
      pd^ := B2HConvert[pb^ shr 4];
      Inc(pd);
      pd^ := B2HConvert[pb^ and $0F];
      Inc(pd);
      Inc(pb);
      Dec(l);
    end;
  end;
end;

function getFirst(var strPtr: PChar; splitChars: TSysCharSet): string;
var
  oPtr: PChar;
  l: Cardinal;
begin
  oPtr := strPtr;
  result := '';
  while True do
  begin
    if (strPtr^ in splitChars) then
    begin
      l := strPtr - oPtr;
      if l > 0 then
      begin
{$IFDEF UNICODE}
        SetLength(result, l);
        Move(oPtr^, PChar(result)^, l shl 1);
{$ELSE}
        SetLength(result, l);
        Move(oPtr^, PChar(result)^, l);
{$ENDIF}
        break;
      end;
    end
    else if (strPtr^ = #0) then
    begin
      l := strPtr - oPtr;
      if l > 0 then
      begin
{$IFDEF UNICODE}
        SetLength(result, l);
        Move(oPtr^, PChar(result)^, l shl 1);
{$ELSE}
        SetLength(result, l);
        Move(oPtr^, PChar(result)^, l);
{$ENDIF}
      end;
      break;
    end;
    Inc(strPtr);
  end;
end;

function Utf8DecodeEx(pvValue:
{$IFDEF UNICODE}TBytes{$ELSE}AnsiString{$ENDIF}; len: Cardinal): string;
{$IFDEF UNICODE}
var
  lvBytes: TBytes;
{$ENDIF}
begin
{$IFDEF UNICODE}
  lvBytes := TEncoding.Convert(TEncoding.UTF8, TEncoding.Unicode, pvValue);
  SetLength(result, Length(lvBytes) shr 1);
  Move(lvBytes[0], PChar(result)^, Length(lvBytes));
{$ELSE}
  result := UTF8Decode(pvValue);
{$ENDIF}
end;

function Utf8EncodeEx(pvValue: string):
{$IFDEF UNICODE}TBytes{$ELSE}AnsiString{$ENDIF};
{$IFDEF UNICODE}
var
  lvBytes: TBytes;
  len: Cardinal;
{$ENDIF}
begin
{$IFDEF UNICODE}
  len := Length(pvValue) shl 1;
  SetLength(lvBytes, len);
  Move(PChar(pvValue)^, lvBytes[0], len);
  result := TEncoding.Convert(TEncoding.Unicode, TEncoding.UTF8, lvBytes);
{$ELSE}
  result := UTF8Encode(pvValue);
{$ENDIF}
end;

// copy from qmsgPack
procedure writeString(pvValue: string; pvStream: TStream);
var

  lvRawData: {$IFDEF UNICODE}TBytes{$ELSE}AnsiString{$ENDIF};
  l: Integer;
  lvValue: TMsgPackValue;
begin
  lvRawData := Utf8EncodeEx(pvValue);
  l := Length(lvRawData);

  //
  // fixstr stores a byte array whose length is upto 31 bytes:
  // +--------+========+
  // |101XXXXX|  data  |
  // +--------+========+
  //
  // str 8 stores a byte array whose length is upto (2^8)-1 bytes:
  // +--------+--------+========+
  // |  0xd9  |YYYYYYYY|  data  |
  // +--------+--------+========+
  //
  // str 16 stores a byte array whose length is upto (2^16)-1 bytes:
  // +--------+--------+--------+========+
  // |  0xda  |ZZZZZZZZ|ZZZZZZZZ|  data  |
  // +--------+--------+--------+========+
  //
  // str 32 stores a byte array whose length is upto (2^32)-1 bytes:
  // +--------+--------+--------+--------+--------+========+
  // |  0xdb  |AAAAAAAA|AAAAAAAA|AAAAAAAA|AAAAAAAA|  data  |
  // +--------+--------+--------+--------+--------+========+
  //
  // where
  // * XXXXX is a 5-bit unsigned integer which represents N
  // * YYYYYYYY is a 8-bit unsigned integer which represents N
  // * ZZZZZZZZ_ZZZZZZZZ is a 16-bit big-endian unsigned integer which represents N
  // * AAAAAAAA_AAAAAAAA_AAAAAAAA_AAAAAAAA is a 32-bit big-endian unsigned integer which represents N
  // * N is the length of data

  if l <= 31 then
  begin
    lvValue.ValueType := $A0 + Byte(l);
    pvStream.WriteBuffer(lvValue.ValueType, 1);
  end
  else if l <= 255 then
  begin
    lvValue.ValueType := $D9;
    lvValue.U8Val := Byte(l);
    pvStream.WriteBuffer(lvValue, 2);
  end
  else if l <= 65535 then
  begin
    lvValue.ValueType := $DA;
    lvValue.U16Val := ((l shr 8) and $FF) or ((l shl 8) and $FF00);
    pvStream.Write(lvValue, 3);
  end
  else
  begin
    lvValue.ValueType := $DB;
    lvValue.BArray[0] := (l shr 24) and $FF;
    lvValue.BArray[1] := (l shr 16) and $FF;
    lvValue.BArray[2] := (l shr 8) and $FF;
    lvValue.BArray[3] := l and $FF;
    pvStream.WriteBuffer(lvValue, 5);
  end;

  pvStream.Write(PByte(lvRawData)^, l);
end;

procedure WriteBinary(p: PByte; l: Integer; pvStream: TStream);
var
  lvValue: TMsgPackValue;
begin
  if l <= 255 then
  begin
    lvValue.ValueType := $C4;
    lvValue.U8Val := Byte(l);
    pvStream.WriteBuffer(lvValue, 2);
  end
  else if l <= 65535 then
  begin
    lvValue.ValueType := $C5;
    lvValue.BArray[0] := (l shr 8) and $FF;
    lvValue.BArray[1] := l and $FF;
    pvStream.WriteBuffer(lvValue, 3);
  end
  else
  begin
    lvValue.ValueType := $C6;
    lvValue.BArray[0] := (l shr 24) and $FF;
    lvValue.BArray[1] := (l shr 16) and $FF;
    lvValue.BArray[2] := (l shr 8) and $FF;
    lvValue.BArray[3] := l and $FF;
    pvStream.WriteBuffer(lvValue, 5);
  end;
  pvStream.WriteBuffer(p^, l);
end;

// copy from qmsgPack
procedure WriteInt(const iVal: Int64; AStream: TStream);
var
  lvValue: TMsgPackValue;
begin
  if iVal >= 0 then
  begin
    if iVal <= 127 then
    begin
      lvValue.U8Val := Byte(iVal);
      AStream.WriteBuffer(lvValue.U8Val, 1);
    end
    else if iVal <= 255 then // UInt8
    begin
      lvValue.ValueType := $CC;
      lvValue.U8Val := Byte(iVal);
      AStream.WriteBuffer(lvValue, 2);
    end
    else if iVal <= 65535 then
    begin
      lvValue.ValueType := $CD;
      lvValue.BArray[0] := (iVal shr 8);
      lvValue.BArray[1] := (iVal and $FF);
      AStream.WriteBuffer(lvValue, 3);
    end
    else if iVal <= Cardinal($FFFFFFFF) then
    begin
      lvValue.ValueType := $CE;
      lvValue.BArray[0] := (iVal shr 24) and $FF;
      lvValue.BArray[1] := (iVal shr 16) and $FF;
      lvValue.BArray[2] := (iVal shr 8) and $FF;
      lvValue.BArray[3] := iVal and $FF;
      AStream.WriteBuffer(lvValue, 5);
    end
    else
    begin
      lvValue.ValueType := $CF;
      lvValue.BArray[0] := (iVal shr 56) and $FF;
      lvValue.BArray[1] := (iVal shr 48) and $FF;
      lvValue.BArray[2] := (iVal shr 40) and $FF;
      lvValue.BArray[3] := (iVal shr 32) and $FF;
      lvValue.BArray[4] := (iVal shr 24) and $FF;
      lvValue.BArray[5] := (iVal shr 16) and $FF;
      lvValue.BArray[6] := (iVal shr 8) and $FF;
      lvValue.BArray[7] := iVal and $FF;
      AStream.WriteBuffer(lvValue, 9);
    end;
  end
  else // <0
  begin
    if iVal <= Low(Integer) then // -2147483648  // 64 bit
    begin
      lvValue.ValueType := $D3;
      lvValue.BArray[0] := (iVal shr 56) and $FF;
      lvValue.BArray[1] := (iVal shr 48) and $FF;
      lvValue.BArray[2] := (iVal shr 40) and $FF;
      lvValue.BArray[3] := (iVal shr 32) and $FF;
      lvValue.BArray[4] := (iVal shr 24) and $FF;
      lvValue.BArray[5] := (iVal shr 16) and $FF;
      lvValue.BArray[6] := (iVal shr 8) and $FF;
      lvValue.BArray[7] := iVal and $FF;
      AStream.WriteBuffer(lvValue, 9);
    end
    else if iVal <= Low(Smallint) then // -32768    // 32 bit
    begin
      lvValue.ValueType := $D2;
      lvValue.BArray[0] := (iVal shr 24) and $FF;
      lvValue.BArray[1] := (iVal shr 16) and $FF;
      lvValue.BArray[2] := (iVal shr 8) and $FF;
      lvValue.BArray[3] := iVal and $FF;
      AStream.WriteBuffer(lvValue, 5);
    end
    else if iVal <= -128 then
    begin
      lvValue.ValueType := $D1;
      lvValue.BArray[0] := (iVal shr 8);
      lvValue.BArray[1] := (iVal and $FF);
      AStream.WriteBuffer(lvValue, 3);
    end
    else if iVal < -32 then
    begin
      lvValue.ValueType := $D0;
      lvValue.I8Val := iVal;
      AStream.WriteBuffer(lvValue, 2);
    end
    else
    begin
      lvValue.I8Val := iVal;
      AStream.Write(lvValue.I8Val, 1);
    end;
  end; // End <0
end;

procedure WriteFloat(pvVal: Double; AStream: TStream);
var
  lvValue: TMsgPackValue;
begin
  lvValue.I64Val := swap(pvVal);
  lvValue.ValueType := $CB;
  AStream.WriteBuffer(lvValue, 9);
end;

procedure WriteSingle(pvVal: Single; AStream: TStream);
var
  lvValue: TMsgPackValue;
begin
  lvValue.I32Val := swap(pvVal);
  lvValue.ValueType := $CA;
  AStream.WriteBuffer(lvValue, 5);
end;

procedure WriteNull(pvStream: TStream);
var
  lvByte: Byte;
begin
  lvByte := $C0;
  pvStream.Write(lvByte, 1);
end;

procedure WriteBoolean(pvValue: Boolean; pvStream: TStream);
var
  lvByte: Byte;
begin
  if pvValue then
    lvByte := $C3
  else
    lvByte := $C2;
  pvStream.Write(lvByte, 1);
end;

/// <summary>
/// copy from qmsgpack
/// </summary>
procedure writeArray(obj: TMsgPack; pvStream: TStream);
var
  c, I: Integer;
  lvValue: TMsgPackValue;
  lvNode: TMsgPack;
begin
  c := obj.Count;

  if c <= 15 then
  begin
    lvValue.ValueType := $90 + c;
    pvStream.WriteBuffer(lvValue.ValueType, 1);
  end
  else if c <= 65535 then
  begin
    lvValue.ValueType := $DC;
    lvValue.BArray[0] := (c shr 8) and $FF;
    lvValue.BArray[1] := c and $FF;
    pvStream.WriteBuffer(lvValue, 3);
  end
  else
  begin
    lvValue.ValueType := $DD;
    lvValue.BArray[0] := (c shr 24) and $FF;
    lvValue.BArray[1] := (c shr 16) and $FF;
    lvValue.BArray[2] := (c shr 8) and $FF;
    lvValue.BArray[3] := c and $FF;
    pvStream.WriteBuffer(lvValue, 5);
  end;

  for I := 0 to c - 1 do
  begin
    lvNode := TMsgPack(obj.FChildren[I]);
    lvNode.InnerEncodeToStream(pvStream);
  end;
end;

procedure writeMap(obj: TMsgPack; pvStream: TStream);
var
  c, I: Integer;
  lvValue: TMsgPackValue;
  lvNode: TMsgPack;
begin
  c := obj.Count;
  if c <= 15 then
  begin
    lvValue.ValueType := $80 + c;
    pvStream.WriteBuffer(lvValue.ValueType, 1);
  end
  else if c <= 65535 then
  begin
    lvValue.ValueType := $DE;
    lvValue.BArray[0] := (c shr 8) and $FF;
    lvValue.BArray[1] := c and $FF;
    pvStream.WriteBuffer(lvValue, 3);
  end
  else
  begin
    lvValue.ValueType := $DF;
    lvValue.BArray[0] := (c shr 24) and $FF;
    lvValue.BArray[1] := (c shr 16) and $FF;
    lvValue.BArray[2] := (c shr 8) and $FF;
    lvValue.BArray[3] := c and $FF;
    pvStream.WriteBuffer(lvValue, 5);
  end;
  for I := 0 to c - 1 do
  begin
    lvNode := TMsgPack(obj.FChildren[I]);
    writeString(lvNode.FName, pvStream);
    lvNode.InnerEncodeToStream(pvStream);
  end;
end;

function EncodeDateTime(pvVal: TDateTime): string;
var
  AValue: TDateTime;
begin
  AValue := pvVal;
  if AValue - Trunc(AValue) = 0 then // Date
    result := FormatDateTime('yyyy-MM-dd', AValue)
  else
  begin
    if Trunc(AValue) = 0 then
      result := FormatDateTime('hh:nn:ss.zzz', AValue)
    else
      result := FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', AValue);
  end;
end;

constructor TMsgPack.Create;
begin
  inherited Create;
{$IFDEF UNICODE}
  FChildren := TObjectList<TMsgPack>.Create(True);
{$ELSE}
  FChildren := TObjectList.Create(True);
{$ENDIF}
end;

procedure TMsgPack.FromBytes(pvBytes: TBytes);
var ms: TBytesStream;
begin
  ms := TBytesStream.Create(pvBytes);
  try
    FromStream(ms);
  finally
    ms.Free;
  end;
end;

procedure TMsgPack.DecodeFromFile(pvFileName: string);
var
  lvFileStream: TFileStream;
begin
  if FileExists(pvFileName) then
  begin
    lvFileStream := TFileStream.Create(pvFileName, fmOpenRead);
    try
      FromStream(lvFileStream);
    finally
      lvFileStream.Free;
    end;
  end;
end;

procedure TMsgPack.FromRaw(const raw: RawByteString);
var
  rs: TRawByteStringStream;
begin
  rs := TRawByteStringStream.Create(raw);
  try
    self.FromStream(rs);
  finally
    rs.Free;
  end;
end;

procedure TMsgPack.FromStream(pvStream: TStream);
begin
  pvStream.Position := 0;
  InnerParseFromStream(pvStream);
end;

function TMsgPack.DeleteObject(pvPath: String): Boolean;
var
  lvParent, lvObj: TMsgPack;
  j: Integer;
begin
  lvObj := InnerFindPathObject(pvPath, lvParent, j);
  result := lvObj <> nil;
  if result then
  begin
    lvParent.FChildren.Delete(j);
  end;
end;

destructor TMsgPack.Destroy;
begin
  FChildren.Clear;
  FChildren.Free;
  FChildren := nil;
  inherited Destroy;
end;

function TMsgPack.Add(pvNameKey, pvValue: string): TMsgPack;
begin
  result := InnerAdd(mptMap);
  result.setName(pvNameKey);
  result.AsString := pvValue;
end;

function TMsgPack.Add(pvNameKey: string; pvValue: Int64): TMsgPack;
begin
  result := InnerAdd(mptMap);
  result.setName(pvNameKey);
  result.AsInteger := pvValue;
end;

function TMsgPack.Add: TMsgPack;
begin
  result := InnerAdd(mptMap);
end;

function TMsgPack.AddArrayChild: TMsgPack;
begin
  if FDataType <> mptArray then
  begin
    Clear;
    FDataType := mptArray;
  end;
  result := InnerAdd;
end;

function TMsgPack.Add(pvNameKey: string; pvValue: TBytes): TMsgPack;
begin
  result := InnerAdd(mptMap);
  result.setName(pvNameKey);
  result.FDataType := mptBinary;
  result.FValue := pvValue;
end;

function TMsgPack.Add(pvNameKey: String): TMsgPack;
begin
  result := InnerAdd(mptMap);
  result.setName(pvNameKey);
end;

procedure TMsgPack.CheckObjectDataType(ANewType: TMsgPackType);
begin
  if (FDataType <> ANewType) then
  begin
    FDataType := ANewType;
  end;
end;

procedure TMsgPack.Clear;
begin
  FChildren.Clear;
  FDataType := mptNull;
  SetLength(FValue, 0);
end;

function TMsgPack.ToBytes: TBytes;
var ms: TBytesStream;
begin
  ms := TBytesStream.Create;
  try
    ToStream(ms);
    Result := ms.Bytes;
  finally
    ms.Free;
  end;
end;

procedure TMsgPack.ToFile(pvFileName: string);
var
  lvFileStream: TFileStream;
begin
  if FileExists(pvFileName) then
    lvFileStream := TFileStream.Create(pvFileName, fmOpenWrite)
  else
    lvFileStream := TFileStream.Create(pvFileName, fmCreate);
  try
    lvFileStream.size := 0;
    ToStream(lvFileStream);
  finally
    lvFileStream.Free;
  end;
end;

function TMsgPack.ToRaw: RawByteString;
var
  rs: TRawByteStringStream;
begin
  rs := TRawByteStringStream.Create;
  try
    self.ToStream(rs);
    result := rs.DataString;
  finally
    rs.Free;
  end;
end;

procedure TMsgPack.ToStream(pvStream: TStream);
begin
  InnerEncodeToStream(pvStream);
end;

function TMsgPack.FindObj(pvName: string): TMsgPack;
var
  I: Integer;
begin
  I := IndexOfCaseSensitive(pvName);
  if I <> -1 then
  begin
    result := TMsgPack(FChildren[I]);
  end
  else
  begin
    result := nil;
  end;
end;

function TMsgPack.path(pvPath: string): TMsgPack;
var
  lvName: string;
  S: string;
  sPtr: PChar;
  lvTempObj, lvParent: TMsgPack;
  j: Integer;
begin
  result := nil;
  S := pvPath;

  lvParent := self;
  sPtr := PChar(S);
  while sPtr^ <> #0 do
  begin
    lvName := getFirst(sPtr, ['.', '/', '\']);
    if lvName = '' then
    begin
      break;
    end
    else
    begin
      if sPtr^ = #0 then
      begin // end
        j := lvParent.IndexOf(lvName);
        if j <> -1 then
        begin
          result := TMsgPack(lvParent.FChildren[j]);
        end
        else
        begin
          result := lvParent.Add(lvName);
        end;
      end
      else
      begin
        // find childrean
        lvTempObj := lvParent.FindObj(lvName);
        if lvTempObj = nil then
        begin
          lvParent := lvParent.Add(lvName);
        end
        else
        begin
          lvParent := lvTempObj;
        end;
      end;
    end;
    if sPtr^ = #0 then
      break;
    Inc(sPtr);
  end;
end;

function TMsgPack.GetAsBoolean: Boolean;
begin
  if FDataType = mptBoolean then
    result := PBoolean(FValue)^
  else if FDataType = mptString then
    result := StrToBoolDef(AsString, False)
  else if FDataType = mptInteger then
    result := (AsInteger <> 0)
  else if FDataType in [mptNull, mptUnknown] then
    result := False
  else
    result := False;
end;

function TMsgPack.GetAsBytes: TBytes;
begin
  result := FValue;
end;

function TMsgPack.GetAsDateTime: TDateTime;
begin
  if FDataType in [mptDateTime, mptFloat] then
    result := PDouble(FValue)^
  else if FDataType = mptSingle then
    result := PSingle(FValue)^
  else if FDataType = mptString then
  begin
    result := StrToDateTimeDef(getAsString, 0);
  end
  else if FDataType in [mptInteger] then
    result := AsInteger
  else
    result := 0;
end;

function TMsgPack.GetAsFloat: Double;
begin
  if FDataType in [mptFloat, mptDateTime] then
    result := PDouble(FValue)^
  else if FDataType = mptSingle then
    result := PSingle(FValue)^
  else if FDataType = mptBoolean then
    result := Integer(AsBoolean)
  else if FDataType = mptString then
    result := StrToFloatDef(AsString, 0)
  else if FDataType = mptInteger then
    result := AsInteger
  else
    result := 0;
end;

function TMsgPack.getAsInteger: Int64;
begin
  case FDataType of
    mptInteger:
      result := PInt64(FValue)^;
  else
    result := 0;
  end;
end;

function TMsgPack.GetAsSingle: Single;
begin
  if FDataType in [mptFloat, mptDateTime] then
    result := PDouble(FValue)^
  else if FDataType = mptSingle then
    result := PSingle(FValue)^
  else if FDataType = mptBoolean then
    result := Integer(AsBoolean)
  else if FDataType = mptString then
    result := StrToFloatDef(AsString, 0)
  else if FDataType = mptInteger then
    result := AsInteger
  else
    result := 0;
end;

function TMsgPack.getAsString: String;
var
  l: Cardinal;
begin
  result := '';
  if FDataType = mptString then
  begin
    l := Length(FValue);
    if l = 0 then
    begin
      result := '';
    end
    else if SizeOf(Char) = 2 then
    begin
      SetLength(result, l shr 1);
      Move(FValue[0], PChar(result)^, l);
    end
    else
    begin
      SetLength(result, l);
      Move(FValue[0], PChar(result)^, l);
    end;
  end
  else
  begin
    case FDataType of
      mptUnknown, mptNull:
        result := '';
      mptInteger:
        result := IntToStr(AsInteger);
      mptBoolean:
        result := BoolToStr(AsBoolean, True);
      mptFloat:
        result := FloatToStrF(AsFloat, ffGeneral, 15, 0);
      mptSingle:
        result := FloatToStrF(AsSingle, ffGeneral, 7, 0);
      mptBinary:
        result := BinToHex(@FValue[0], Length(FValue), False);
      mptDateTime:
        result := EncodeDateTime(AsDateTime);
      // mptArray:
      // Result := EncodeArray;
      // mptMap:
      // Result := EncodeMap;
      // mptExtended:
      // Result := EncodeExtended;
    else
      result := '';
    end;
  end;
  // showMessage(Result);
end;

/// <summary>
/// copy from qdac3
/// </summary>
function TMsgPack.GetAsVariant: Variant;
var
  I: Integer;
  procedure BytesAsVariant;
  var
    l: Integer;
    p: PByte;
  begin
    l := Length(FValue);
    result := VarArrayCreate([0, l - 1], varByte);
    p := VarArrayLock(result);
    Move(FValue[0], p^, l);
    VarArrayUnlock(result);
  end;

begin
  case FDataType of
    mptNull:
      result := null;
    mptString:
      result := AsString;
    mptInteger:
      result := AsInteger;
    mptFloat:
      result := AsFloat;
    mptSingle:
      result := AsSingle;
    mptDateTime:
      result := AsDateTime;
    mptBoolean:
      result := AsBoolean;
    mptArray, mptMap:
      begin
        result := VarArrayCreate([0, Count - 1], varVariant);
        for I := 0 to Count - 1 do
          result[I] := TMsgPack(FChildren[I]).AsVariant;
      end;
    mptBinary:
      BytesAsVariant;
  else
    raise Exception.Create(SVariantConvertNotSupport);
  end;
end;

function TMsgPack.GetB(pvPath: String): Boolean;
var
  lvObj: TMsgPack;
begin
  lvObj := GetO(pvPath);
  if lvObj = nil then
  begin
    result := False;
  end
  else
  begin
    result := lvObj.AsBoolean;
  end;
end;

function TMsgPack.GetCount: Integer;
begin
  result := FChildren.Count;
end;

function TMsgPack.GetD(pvPath: String): Double;
var
  lvObj: TMsgPack;
begin
  lvObj := GetO(pvPath);
  if lvObj = nil then
  begin
    result := 0;
  end
  else
  begin
    result := lvObj.AsFloat;
  end;
end;

function TMsgPack.GetI(pvPath: String): Int64;
var
  lvObj: TMsgPack;
begin
  lvObj := GetO(pvPath);
  if lvObj = nil then
  begin
    result := 0;
  end
  else
  begin
    result := lvObj.AsInteger;
  end;
end;

function TMsgPack.GetItems(AIndex: Integer): TMsgPack;
begin
  result := TMsgPack(FChildren[AIndex]);
end;

function TMsgPack.GetO(pvPath: String): TMsgPack;
var
  lvParent: TMsgPack;
  j: Integer;
begin
  result := InnerFindPathObject(pvPath, lvParent, j);
end;

function TMsgPack.GetS(pvPath: String): string;
var
  lvObj: TMsgPack;
begin
  lvObj := GetO(pvPath);
  if lvObj = nil then
  begin
    result := '';
  end
  else
  begin
    result := lvObj.AsString;
  end;
end;

function TMsgPack.GetV(pvPath: String): Variant;
var
  lvObj: TMsgPack;
begin
  lvObj := GetO(pvPath);
  if lvObj = nil then
  begin
    result := null;
  end
  else
  begin
    result := lvObj.AsVariant;
  end;
end;

function TMsgPack.IndexOf(pvName: string): Integer;
begin
  result := IndexOfIgnoreSensitive(LowerCase(pvName));
end;

function TMsgPack.IndexOfCaseSensitive(pvName: string): Integer;
var
  I, l: Integer;
  lvObj: TMsgPack;
begin
  result := -1;
  l := Length(pvName);
  if l = 0 then
    exit;
  for I := 0 to FChildren.Count - 1 do
  begin
    lvObj := TMsgPack(FChildren[I]);
    if Length(lvObj.FName) = l then
    begin
      if lvObj.FName = pvName then
      begin
        result := I;
        break;
      end;
    end;
  end;
end;

function TMsgPack.IndexOfIgnoreSensitive(pvLowerCaseName: string): Integer;
var
  I, l: Integer;
  lvObj: TMsgPack;
begin
  result := -1;
  l := Length(pvLowerCaseName);
  if l = 0 then
    exit;
  for I := 0 to FChildren.Count - 1 do
  begin
    lvObj := TMsgPack(FChildren[I]);
    if Length(lvObj.FLowerName) = l then
    begin
      if lvObj.FLowerName = pvLowerCaseName then
      begin
        result := I;
        break;
      end;
    end;
  end;
end;

function TMsgPack.InnerAdd(pvDataType: TMsgPackType): TMsgPack;
begin
  result := TMsgPack.Create;
  result.FDataType := mptUnknown;
  InnerAddToChildren(pvDataType, result);
end;

function TMsgPack.InnerAdd: TMsgPack;
begin
  if self.FDataType in [mptMap, mptArray] then
  begin
    result := TMsgPack.Create;
    result.FDataType := mptUnknown;
    result.FParent := self;
    FChildren.Add(result);
  end
  else
  begin
    raise Exception.Create(SCannotAddChild);
  end;
end;

procedure TMsgPack.InnerAddToChildren(pvDataType: TMsgPackType; obj: TMsgPack);
begin
  CheckObjectDataType(pvDataType);
  obj.FParent := self;
  FChildren.Add(obj);
end;

procedure TMsgPack.InnerEncodeToStream(pvStream: TStream);
begin
  case FDataType of
    mptUnknown, mptNull:
      WriteNull(pvStream);
    mptMap:
      writeMap(self, pvStream);
    mptArray:
      writeArray(self, pvStream);
    mptString:
      writeString(self.getAsString, pvStream);
    mptInteger:
      WriteInt(self.getAsInteger, pvStream);
    mptBoolean:
      WriteBoolean(self.GetAsBoolean, pvStream);
    mptDateTime, mptFloat:
      WriteFloat(GetAsFloat, pvStream);
    mptSingle:
      WriteSingle(GetAsSingle, pvStream);
    mptBinary:
      WriteBinary(PByte(@FValue[0]), Length(FValue), pvStream);
  end;
end;

function TMsgPack.InnerFindPathObject(pvPath: string; var vParent: TMsgPack;
  var vIndex: Integer): TMsgPack;
var
  lvName: string;
  S: string;
  sPtr: PChar;
  lvTempObj, lvParent: TMsgPack;
  j: Integer;
begin
  S := pvPath;

  result := nil;

  lvParent := self;
  sPtr := PChar(S);
  while sPtr^ <> #0 do
  begin
    lvName := getFirst(sPtr, ['.', '/', '\']);
    if lvName = '' then
    begin
      break;
    end
    else
    begin
      if sPtr^ = #0 then
      begin // end
        j := lvParent.IndexOf(lvName);
        if j <> -1 then
        begin
          result := TMsgPack(lvParent.FChildren[j]);
          vIndex := j;
          vParent := lvParent;
        end
        else
        begin
          break;
        end;
      end
      else
      begin
        // find childrean
        lvTempObj := lvParent.FindObj(lvName);
        if lvTempObj = nil then
        begin
          break;
        end
        else
        begin
          lvParent := lvTempObj;
        end;
      end;
    end;
    if sPtr^ = #0 then
      break;
    Inc(sPtr);
  end;
end;

procedure TMsgPack.InnerParseFromStream(pvStream: TStream);
var
  lvByte: Byte;
  lvBData: array [0 .. 15] of Byte;
  lvSwapData: array [0 .. 7] of Byte;
  lvAnsiStr: {$IFDEF UNICODE}TBytes{$ELSE}AnsiString{$ENDIF};
  l, I: Cardinal;
  i64: Int64;
  lvObj: TMsgPack;
begin
  pvStream.Read(lvByte, 1);
  if lvByte in [$00 .. $7F] then // positive fixint    0xxxxxxx    0x00 - 0x7f
  begin
    // +--------+
    // |0XXXXXXX|
    // +--------+
    setAsInteger(lvByte);
  end
  else if lvByte in [$80 .. $8F] then // fixmap    1000xxxx    0x80 - 0x8f
  begin
    FDataType := mptMap;
    SetLength(FValue, 0);
    FChildren.Clear;
    l := lvByte - $80;
    if l > 0 then // check is empty ele
    begin
      for I := 0 to l - 1 do
      begin
        lvObj := InnerAdd(mptMap);

        // map key
        lvObj.InnerParseFromStream(pvStream);
        lvObj.setName(lvObj.getAsString);

        // value
        lvObj.InnerParseFromStream(pvStream);
      end;
    end;
  end
  else if lvByte in [$90 .. $9F] then // fixarray    1001xxxx    0x90 - 0x9f
  begin
    FDataType := mptArray;
    SetLength(FValue, 0);
    FChildren.Clear;

    l := lvByte - $90;
    if l > 0 then // check is empty ele
    begin
      for I := 0 to l - 1 do
      begin
        lvObj := InnerAdd(mptArray);
        // value
        lvObj.InnerParseFromStream(pvStream);
      end;
    end;
  end
  else if lvByte in [$A0 .. $BF] then // fixstr    101xxxxx    0xa0 - 0xbf
  begin
    l := lvByte - $A0; // str len
    if l > 0 then
    begin

      SetLength(lvAnsiStr, l);
      pvStream.Read(PByte(lvAnsiStr)^, l);
      setAsString(Utf8DecodeEx(lvAnsiStr, l));

      // SetLength(lvBytes, l + 1);
      // lvBytes[l] := 0;
      // pvStream.Read(lvBytes[0], l);
      // setAsString(UTF8Decode(PAnsiChar(@lvBytes[0])));
    end
    else
    begin
      setAsString('');
    end;
  end
  else if lvByte in [$E0 .. $FF] then
  begin
    // negative fixnum stores 5-bit negative integer
    // +--------+
    // |111YYYYY|
    // +--------+
    setAsInteger(Shortint(lvByte));
  end
  else
  begin
    case lvByte of
      $C0: // null
        begin
          FDataType := mptNull;
          SetLength(FValue, 0);
        end;
      $C1: // (never used)
        raise Exception.Create('(never used) type $c1');
      $C2: // False
        begin
          SetAsBoolean(False);
        end;
      $C3: // True
        begin
          SetAsBoolean(True);
        end;
      $C4: // 短二进制，最长255字节
        begin
          FDataType := mptBinary;

          l := 0; // fill zero
          pvStream.Read(l, 1);

          SetLength(FValue, l);
          pvStream.Read(FValue[0], l);
        end;
      $C5: // 二进制，16位，最长65535B
        begin
          FDataType := mptBinary;

          l := 0; // fill zero
          pvStream.Read(l, 2);
          l := swap16(l);

          SetLength(FValue, l);
          pvStream.Read(FValue[0], l);
        end;
      $C6: // 二进制，32位，最长2^32-1
        begin
          FDataType := mptBinary;

          l := 0; // fill zero
          pvStream.Read(l, 4);
          l := swap32(l);

          SetLength(FValue, l);
          pvStream.Read(FValue[0], l);
        end;
      $C7, $C8, $C9:
        // ext 8    11000111    0xc7, ext 16    11001000    0xc8, ext 32    11001001    0xc9
        begin
          raise Exception.Create('(ext8,ext16,ex32) type $c7,$c8,$c9');
        end;
      $CA: // float 32
        begin
          pvStream.Read(lvBData[0], 4);

          swap32Ex(lvBData[0], lvSwapData[0]);

          AsSingle := PSingle(@lvSwapData[0])^;
        end;
      $CB: // Float 64
        begin

          pvStream.Read(lvBData[0], 8);

          // swap to int64, and lvBData is not valid double value (for IEEE)
          i64 := swap64(lvBData[0]);

          //
          AsFloat := PDouble(@i64)^;

          // AsFloat := swap(PDouble(@lvBData[0])^);
        end;
      $CC: // UInt8
        begin
          // uint 8 stores a 8-bit unsigned integer
          // +--------+--------+
          // |  0xcc  |ZZZZZZZZ|
          // +--------+--------+
          l := 0;
          pvStream.Read(l, 1);
          setAsInteger(l);
        end;
      $CD:
        begin
          // uint 16 stores a 16-bit big-endian unsigned integer
          // +--------+--------+--------+
          // |  0xcd  |ZZZZZZZZ|ZZZZZZZZ|
          // +--------+--------+--------+
          l := 0;
          pvStream.Read(l, 2);
          l := swap16(l);
          setAsInteger(Word(l));
        end;
      $CE:
        begin
          // uint 32 stores a 32-bit big-endian unsigned integer
          // +--------+--------+--------+--------+--------+
          // |  0xce  |ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ
          // +--------+--------+--------+--------+--------+
          l := 0;
          pvStream.Read(l, 4);
          l := swap32(l);
          setAsInteger(Cardinal(l));
        end;
      $CF:
        begin
          // uint 64 stores a 64-bit big-endian unsigned integer
          // +--------+--------+--------+--------+--------+--------+--------+--------+--------+
          // |  0xcf  |ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|
          // +--------+--------+--------+--------+--------+--------+--------+--------+--------+
          i64 := 0;
          pvStream.Read(i64, 8);
          i64 := swap64(i64);
          setAsInteger(i64);
        end;
      $DC: // array 16
        begin
          // +--------+--------+--------+~~~~~~~~~~~~~~~~~+
          // |  0xdc  |YYYYYYYY|YYYYYYYY|    N objects    |
          // +--------+--------+--------+~~~~~~~~~~~~~~~~~+
          FDataType := mptArray;
          SetLength(FValue, 0);
          FChildren.Clear;

          l := 0; // fill zero
          pvStream.Read(l, 2);

          l := swap16(l);
          if l > 0 then // check is empty ele
          begin
            for I := 0 to l - 1 do
            begin
              lvObj := InnerAdd(mptArray);
              // value
              lvObj.InnerParseFromStream(pvStream);
            end;
          end;
        end;
      $DD: // Array 32
        begin
          // +--------+--------+--------+--------+--------+~~~~~~~~~~~~~~~~~+
          // |  0xdd  |ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|    N objects    |
          // +--------+--------+--------+--------+--------+~~~~~~~~~~~~~~~~~+
          FDataType := mptArray;
          SetLength(FValue, 0);
          FChildren.Clear;

          l := 0; // fill zero
          pvStream.Read(l, 4);

          l := swap32(l);
          if l > 0 then // check is empty ele
          begin
            for I := 0 to l - 1 do
            begin
              lvObj := InnerAdd(mptArray);
              // value
              lvObj.InnerParseFromStream(pvStream);
            end;
          end;
        end;
      $D9: // str 8 , 255
        begin
          // str 8 stores a byte array whose length is upto (2^8)-1 bytes:
          // +--------+--------+========+
          // |  0xd9  |YYYYYYYY|  data  |
          // +--------+--------+========+
          l := 0;
          pvStream.Read(l, 1);
          if l > 0 then // check is empty ele
          begin
            SetLength(lvAnsiStr, l);
            pvStream.Read(PByte(lvAnsiStr)^, l);
            setAsString(Utf8DecodeEx(lvAnsiStr, l));
          end
          else
          begin
            setAsString('');
          end;
          // SetLength(lvBytes, l + 1);
          // lvBytes[l] := 0;
          // pvStream.Read(lvBytes[0], l);
          // setAsString(UTF8Decode(PAnsiChar(@lvBytes[0])));
        end;
      $DE: // Object map 16
        begin
          // +--------+--------+--------+~~~~~~~~~~~~~~~~~+
          // |  0xde  |YYYYYYYY|YYYYYYYY|   N*2 objects   |
          // +--------+--------+--------+~~~~~~~~~~~~~~~~~+
          FDataType := mptMap;
          SetLength(FValue, 0);
          FChildren.Clear;

          l := 0; // fill zero
          pvStream.Read(l, 2);
          l := swap16(l);
          if l > 0 then // check is empty ele
          begin
            for I := 0 to l - 1 do
            begin
              lvObj := InnerAdd(mptMap);
              // map key
              lvObj.InnerParseFromStream(pvStream);
              lvObj.setName(lvObj.getAsString);

              // value
              lvObj.InnerParseFromStream(pvStream);
            end;
          end;
        end;
      $DF: // Object map 32
        begin
          // +--------+--------+--------+--------+--------+~~~~~~~~~~~~~~~~~+
          // |  0xdf  |ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|   N*2 objects   |
          // +--------+--------+--------+--------+--------+~~~~~~~~~~~~~~~~~+
          FDataType := mptMap;
          SetLength(FValue, 0);
          FChildren.Clear;

          l := 0; // fill zero
          pvStream.Read(l, 4);

          l := swap32(l);
          if l > 0 then // check is empty ele
          begin
            for I := 0 to l - 1 do
            begin
              lvObj := InnerAdd(mptMap);

              // map key
              lvObj.InnerParseFromStream(pvStream);
              lvObj.setName(lvObj.getAsString);

              // value
              lvObj.InnerParseFromStream(pvStream);
            end;
          end;
        end;
      $DA: // str 16
        begin
          // str 16 stores a byte array whose length is upto (2^16)-1 bytes:
          // +--------+--------+--------+========+
          // |  0xda  |ZZZZZZZZ|ZZZZZZZZ|  data  |
          // +--------+--------+--------+========+

          l := 0; // fill zero
          pvStream.Read(l, 2);
          l := swap16(l);
          if l > 0 then // check is empty ele
          begin
            SetLength(lvAnsiStr, l);
            pvStream.Read(PByte(lvAnsiStr)^, l);
            setAsString(Utf8DecodeEx(lvAnsiStr, l));
          end
          else
          begin
            setAsString('');
          end;

          // SetLength(lvBytes, l + 1);
          // lvBytes[l] := 0;
          // pvStream.Read(lvBytes[0], l);
          // setAsString(UTF8Decode(PAnsiChar(@lvBytes[0])));
        end;
      $DB: // str 16
        begin
          // str 32 stores a byte array whose length is upto (2^32)-1 bytes:
          // +--------+--------+--------+--------+--------+========+
          // |  0xdb  |AAAAAAAA|AAAAAAAA|AAAAAAAA|AAAAAAAA|  data  |
          // +--------+--------+--------+--------+--------+========+

          l := 0; // fill zero
          pvStream.Read(l, 4);
          l := swap32(l);
          if l > 0 then // check is empty ele
          begin
            SetLength(lvAnsiStr, l);
            pvStream.Read(PByte(lvAnsiStr)^, l);
            setAsString(Utf8DecodeEx(lvAnsiStr, l));
          end
          else
          begin
            setAsString('');
          end;

          // SetLength(lvBytes, l + 1);
          // lvBytes[l] := 0;
          // pvStream.Read(lvBytes[0], l);
          // setAsString(UTF8Decode(PAnsiChar(@lvBytes[0])));
        end;
      $D0: // int 8
        begin
          // int 8 stores a 8-bit signed integer
          // +--------+--------+
          // |  0xd0  |ZZZZZZZZ|
          // +--------+--------+

          l := 0;
          pvStream.Read(l, 1);
          setAsInteger(Shortint(l));
        end;
      $D1:
        begin
          // int 16 stores a 16-bit big-endian signed integer
          // +--------+--------+--------+
          // |  0xd1  |ZZZZZZZZ|ZZZZZZZZ|
          // +--------+--------+--------+

          l := 0;
          pvStream.Read(l, 2);
          l := swap16(l);
          setAsInteger(Smallint(l));
        end;

      $D2:
        begin
          // int 32 stores a 32-bit big-endian signed integer
          // +--------+--------+--------+--------+--------+
          // |  0xd2  |ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|
          // +--------+--------+--------+--------+--------+
          l := 0;
          pvStream.Read(l, 4);
          l := swap32(l);
          setAsInteger(Integer(l));
        end;
      $D3:
        begin
          // int 64 stores a 64-bit big-endian signed integer
          // +--------+--------+--------+--------+--------+--------+--------+--------+--------+
          // |  0xd3  |ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|ZZZZZZZZ|
          // +--------+--------+--------+--------+--------+--------+--------+--------+--------+
          i64 := 0;
          pvStream.Read(i64, 8);
          i64 := swap64(i64);
          setAsInteger(Int64(i64));
        end;
    end;
  end;
end;

procedure TMsgPack.LoadBinaryFromFile(pvFileName: String);
var
  lvFileStream: TFileStream;
begin
  if FileExists(pvFileName) then
  begin
    lvFileStream := TFileStream.Create(pvFileName, fmOpenRead);
    try
      LoadStream(lvFileStream);
    finally
      lvFileStream.Free;
    end;
  end;
end;

procedure TMsgPack.LoadStream(pvStream: TStream; pvLen: Cardinal = 0);
begin
  FDataType := mptBinary;
  if pvLen = 0 then
  begin
    pvStream.Position := 0;
    SetLength(FValue, pvStream.size);
    pvStream.Read(FValue[0], pvStream.size);
  end
  else
  begin
    SetLength(FValue, pvLen);
    pvStream.ReadBuffer(FValue[0], pvLen);
  end;
end;

procedure TMsgPack.SaveBinaryToFile(pvFileName: String);
var
  lvFileStream: TFileStream;
begin
  if FileExists(pvFileName) then
  begin
    if not DeleteFile(PChar(pvFileName)) then
      RaiseLastOSError;
  end;
  lvFileStream := TFileStream.Create(pvFileName, fmCreate);
  try
    lvFileStream.WriteBuffer(FValue[0], Length(FValue));
  finally
    lvFileStream.Free;
  end;
end;

procedure TMsgPack.SaveStream(pvStream: TStream);
begin
  pvStream.WriteBuffer(FValue[0], Length(FValue));
  pvStream.Position := 0;
end;

procedure TMsgPack.SetAsBoolean(const Value: Boolean);
begin
  FDataType := mptBoolean;
  SetLength(FValue, 1);
  PBoolean(@FValue[0])^ := Value;
end;

procedure TMsgPack.SetAsBytes(const Value: TBytes);
begin
  FDataType := mptBinary;
  FValue := Value;
end;

procedure TMsgPack.SetAsDateTime(const Value: TDateTime);
begin
  FDataType := mptDateTime;
  SetLength(FValue, SizeOf(TDateTime));
  PDouble(@FValue[0])^ := Value;
end;

procedure TMsgPack.SetAsFloat(const Value: Double);
begin
  FDataType := mptFloat;
  SetLength(FValue, SizeOf(Double));
  PDouble(@FValue[0])^ := Value;
end;

procedure TMsgPack.setAsInteger(pvValue: Int64);
begin
  FDataType := mptInteger;
  SetLength(FValue, SizeOf(Int64));
  PInt64(@FValue[0])^ := pvValue;
end;

procedure TMsgPack.SetAsSingle(const Value: Single);
begin
  FDataType := mptSingle;
  SetLength(FValue, SizeOf(Single));
  PSingle(FValue)^ := Value;
end;

procedure TMsgPack.setAsString(pvValue: string);
begin
  FDataType := mptString;
  if SizeOf(Char) = 2 then
  begin
    SetLength(FValue, Length(pvValue) shl 1);
    Move(PChar(pvValue)^, FValue[0], Length(FValue));
  end
  else
  begin
    SetLength(FValue, Length(pvValue));
    Move(PChar(pvValue)^, FValue[0], Length(FValue));
  end;
end;

/// <summary>
/// copy from qdac3
/// </summary>
procedure TMsgPack.SetAsVariant(const Value: Variant);
var
  I: Integer;
  AType: TVarType;
  procedure VarAsBytes;
  var
    l: Integer;
    p: PByte;
  begin
    FDataType := mptBinary;
    l := VarArrayHighBound(Value, 1) + 1;
    SetLength(FValue, l);
    p := VarArrayLock(Value);
    Move(p^, FValue[0], l);
    VarArrayUnlock(Value);
  end;

begin
  if VarIsArray(Value) then
  begin
    AType := VarType(Value);
    if (AType and varTypeMask) = varByte then
      VarAsBytes
    else
    begin
      CheckObjectDataType(mptArray);
      FChildren.Clear;
      for I := VarArrayLowBound(Value, VarArrayDimCount(Value))
        to VarArrayHighBound(Value, VarArrayDimCount(Value)) do
        Add.AsVariant := Value[I];
    end;
  end
  else
  begin
    case VarType(Value) of
      varSmallInt, varInteger, varByte, varShortInt, varWord,
        varLongWord, varInt64:
        AsInteger := Value;
      varSingle, varDouble, varCurrency:
        AsFloat := Value;
      varDate:
        AsDateTime := Value;
      varOleStr, varString{$IFDEF UNICODE}, varUString{$ENDIF}:
        AsString := Value;
      varBoolean:
        AsBoolean := Value;
      varNull, varEmpty, varUnknown:
        begin
          FDataType := mptNull;
          SetLength(FValue, 0);
        end;
{$IF RtlVersion>=26}
      varUInt64:
        AsInteger := Value;
{$IFEND}
    else
      // null
      ; // raise Exception.Create(SVariantConvertNotSupport);
    end;
  end;
end;

procedure TMsgPack.SetB(pvPath: String; const Value: Boolean);
var
  lvObj: TMsgPack;
begin
  lvObj := path(pvPath);
  lvObj.AsBoolean := Value;
end;

procedure TMsgPack.SetD(pvPath: String; const Value: Double);
var
  lvObj: TMsgPack;
begin
  lvObj := path(pvPath);
  lvObj.AsFloat := Value;
end;

procedure TMsgPack.SetI(pvPath: String; const Value: Int64);
var
  lvObj: TMsgPack;
begin
  lvObj := path(pvPath);
  lvObj.AsInteger := Value;
end;

procedure TMsgPack.setName(pvName: string);
begin
  FName := pvName;
  FLowerName := LowerCase(FName);
end;

procedure TMsgPack.SetO(pvPath: String; const Value: TMsgPack);
var
  lvName: String;
  S: String;
  sPtr: PChar;
  lvTempObj, lvParent: TMsgPack;
  j: Integer;
begin
  S := pvPath;

  lvParent := self;
  sPtr := PChar(S);
  while sPtr^ <> #0 do
  begin
    lvName := getFirst(sPtr, ['.', '/', '\']);
    if lvName = '' then
    begin
      break;
    end
    else
    begin
      if sPtr^ = #0 then
      begin // end
        j := lvParent.IndexOf(lvName);
        if j <> -1 then
        begin
          lvTempObj := TMsgPack(lvParent.FChildren[j]);
          lvParent.FChildren[j] := Value;
          lvTempObj.Free; // free old
        end
        else
        begin
          Value.setName(lvName);
          lvParent.InnerAddToChildren(mptMap, Value);
        end;
      end
      else
      begin
        // find childrean
        lvTempObj := lvParent.FindObj(lvName);
        if lvTempObj = nil then
        begin
          lvParent := lvParent.Add(lvName);
        end
        else
        begin
          lvParent := lvTempObj;
        end;
      end;
    end;
    if sPtr^ = #0 then
      break;
    Inc(sPtr);
  end;
end;

procedure TMsgPack.SetS(pvPath: String; const Value: string);
var
  lvObj: TMsgPack;
begin
  lvObj := path(pvPath);
  lvObj.AsString := Value;
end;

procedure TMsgPack.SetV(pvPath: String; const Value: Variant);
var
  lvObj: TMsgPack;
begin
  lvObj := path(pvPath);
  lvObj.AsVariant := Value;
end;

{ TRawByteStringStream }

constructor TRawByteStringStream.Create(const aString: RawByteString);
begin
  fDataString := aString;
end;

function TRawByteStringStream.Read(var Buffer; Count: Integer): Longint;
begin
  if Count <= 0 then
    result := 0
  else
  begin
    result := Length(fDataString) - fPosition;
    if result > Count then
      result := Count;
    Move(PByteArray(fDataString)[fPosition], Buffer, result);
    Inc(fPosition, result);
  end;
end;

function TRawByteStringStream.Seek(Offset: Integer; Origin: Word): Longint;
begin
  case Origin of
    soFromBeginning:
      fPosition := Offset;
    soFromCurrent:
      fPosition := fPosition + Offset;
    soFromEnd:
      fPosition := Length(fDataString) - Offset;
  end;
  if fPosition > Length(fDataString) then
    fPosition := Length(fDataString)
  else if fPosition < 0 then
    fPosition := 0;
  result := fPosition;
end;

procedure TRawByteStringStream.SetSize(NewSize: Integer);
begin
  SetLength(fDataString, NewSize);
  if fPosition > NewSize then
    fPosition := NewSize;
end;

function TRawByteStringStream.Write(const Buffer; Count: Integer): Longint;
begin
  if Count <= 0 then
    result := 0
  else
  begin
    result := Count;
    SetLength(fDataString, fPosition + result);
    Move(Buffer, PByteArray(fDataString)[fPosition], result);
    Inc(fPosition, result);
  end;
end;

end.

 

标签：function,begin,msgpack,end,pvStream,db,pas,result,TMsgPack
From： https://www.cnblogs.com/hnxxcxg/p/18616886

相关文章

  • key.val.pas
    key.val.pasunitkey.val;//cxg2024-12-19key-valuelist//fit(fpc+delphi){$ifdeffpc}{$modedelphi}{$H+}{$endif}{example:procedureTForm1.Button2Click(Sender:TObject);varkv,kv2:Pkv;s:RawByteString;beginNew(kv);kv.S['s'......
  • 【MySQL】InnoDB存储引擎中的页
    目录1、背景2、页的组成3、各部分讲解【1】文件头部【2】页头部【3】最小记录和最大记录【4】行记录【5】空闲空间【6】页目录【7】文件尾部4、总结1、背景mysql中存储数据是存储引擎干的事，存储引擎存储数据的基本单位是页，我们往数据库插入表中的一条条记录就是存储......
  • Apache SeaTunnel如何实现MongoDB到Doris无缝数据同步？
    如果你需要使用ApacheSeaTunnel将MongoDB数据库的数据同步到Doris，你可以按照以下步骤进行操作。这些步骤基于ApacheSeaTunnel的官方文档和社区提供的最佳实践：一、环境准备下载并安装SeaTunnel：访问SeaTunnel的官方GitHub页面，下载最新稳定版本的SeaTunnel。解压下载的文件......
  • Oracle 数据库 dblink 使用全解析
    一、引言在企业级数据库应用场景中，常常需要在不同的Oracle数据库实例之间进行数据交互与共享。Oracle的数据库链接（dblink）功能为此提供了便捷的解决方案，它允许用户如同访问本地数据库对象一样操作远程数据库中的数据。二、dblink的创建语法格式创建dblink的基本语......
  • 【阿里matlab算法】matlab实现超启发驱动贝叶斯散斑去噪MDBSD研究——散斑去噪
    MATLAB实现超启发驱动贝叶斯散斑去噪MDBSD研究1、项目下载：本项目完整论文和全套实现源码见下面资源，有需要的朋友可以点击进行下载说明文档（点击下载）本算法文档matlab实现超启发驱动贝叶斯散斑去噪MDBSD-贝叶斯去噪-MDBSD-图像处理-散斑噪声更多阿里matlab精品项目可点击......
  • 从 spring-boot-starter-jdbc 到 DataSource
    JDBC是什么JDBC是JavaDataBaseConnectivity的缩写，是由一组用Java语言编写的类和接口，用于在Java应用程序中与数据库进行交互。JDBC只是一套标准规范，具体的实现由各个数据库厂商去实现。对开发者来说其屏蔽了不同数据库之间的区别，可以使用相同的方式（JavaAPI）去操作不同......
  • GaussDB——PageStore组件
    PageStore是一个分布式存储，对外提供SAL接口，SQL节点通过SAL接口进行日志和页面的持久化服务，PageStore对象间的映射关系如下图所示。PageClusterManagerControlServer（集群管理）：页面集群管理控制服务负责整个存储节点的管理，VFS和StoreSpace的管理，以及Slice的分配和调度。VFS：虚拟......
  • GaussDB DCS组件
    云原生数据库支持DCS一是为了DCS能够支持持久化能力，二是构建一站式的云数据库服务能力。DCS原来是一个sharenothing的分布式集群，有自己的通信管理，集群管理和客户端。在云原生数据库中，DCS是作为一个组件集成到整个服务中，主要提供字符串（String）、哈希（Hash）、列表（List）、集合结构（Set、S......
  • GaussDB高性能关键技术——查询重写RBO
    在数据库里RBO基于规则的优化一般指查询重写技术，按照一系列关系代数表达式的等价规则，对查询的关系代数表达式进行等价转换，从逻辑上减少执行的总量从而提高查询执行效率，例如，通过条件的推导得出非必要的表扫描、避免非必要的计算表示等。查询重写RBO优化是非常重要的一种逻辑优化......
  • GaussDB数据库技术解读——高性能关键技术
    GaussDB数据库技术解读——高性能关键技术内容概要：本章节介绍GaussDB中实现的高性能关键技术，内容涉及优化器、执行器、分布式数据库、存储引擎等多个方面。目的：通过对GaussDB数据库关键高性能技术的学习，能够让读者更加清晰的理解数据库内核哪些优化是性能关键点同时也为类似的应......

赞助商

阅读排行

网站主页关于我们联系我们网站地图

本网站内容转载自其他媒体，侵权联系[admin##ips99.com]。

Copyright © 2020-2023 IPS99 版权所有 IPS99