key.val.pas

unit key.val;
// cxg 2024-12-19 key-value list
// fit (fpc+delphi)
{$ifdef fpc}
{$mode delphi}{$H+}
{$endif}
{ example:
procedure TForm1.Button2Click(Sender: TObject);
var kv, kv2: Pkv;
  s: RawByteString;
begin
  New(kv);
  kv.S['s'] := 'test';
  s := kv.toRaw;
  kv.free;
  Dispose(kv);

  New(kv2);
  kv2.fromRaw(s);
  Caption := kv2.S['s'];
  kv2.free;
  Dispose(kv2);
end;
}

interface

uses Variants, SysUtils, Classes;

type
  Pkv = ^Tkv;

  Tkv = record // key-value
  private
    key: RawByteString; // key must only-one
    val: TBytes; // value
    list: TList;
  private
    function path(const key: RawByteString): Pkv;
  private
    function getI(const key: RawByteString): integer;
    procedure setI(const key: RawByteString; const Value: integer);
    function getI64(const key: RawByteString): Int64;
    procedure setI64(const key: RawByteString; const Value: Int64);
    function getB(const key: RawByteString): boolean;
    procedure setB(const key: RawByteString; const Value: boolean);
    function getD(const key: RawByteString): Double;
    procedure setD(const key: RawByteString; const Value: Double);
    function getDT(const key: RawByteString): TDateTime;
    procedure setDT(const key: RawByteString; const Value: TDateTime);
    function getS(const key: RawByteString): RawByteString;
    procedure setS(const key, Value: RawByteString);
    function getV(const key: RawByteString): OleVariant;
    procedure setV(const key: RawByteString; const Value: OleVariant);
    function getST(const key: RawByteString): TStream;
    procedure setST(const key: RawByteString; const Value: TStream);
  public
    property I[const key: RawByteString]: integer read getI write setI;
    property I64[const key: RawByteString]: Int64 read getI64 write setI64;
    property B[const key: RawByteString]: boolean read getB write setB;
    property D[const key: RawByteString]: Double read getD write setD;
    property DT[const key: RawByteString]: TDateTime read getDT write setDT;
    property S[const key: RawByteString]: RawByteString read getS write setS;
    property V[const key: RawByteString]: OleVariant read getV write setV;
    property ST[const key: RawByteString]: TStream read getST write setST;
  public // marshal
    procedure toStream(ms: TStream);
    function toRaw: RawByteString;
  public // unmarshal
    procedure fromStream(ms: TStream);
    procedure fromRaw(const raw: RawByteString);
  public
    procedure free;
    procedure clear;   //clear list;
  end;

implementation

procedure Tkv.clear;
begin
  while list.Count > 0 do
  begin
    Dispose(Pkv(list[0]));
    list.Delete(0);
  end;
end;

procedure Tkv.free;
begin
  clear;
  if Assigned(list) then
    FreeAndNil(list);
end;

function Tkv.path(const key: RawByteString): Pkv;
var
  I: integer;
  found: boolean;
begin
  Result := nil;
  if not Assigned(list) then
    list := TList.Create; // new list
  found := False;
  for I := 0 to list.Count - 1 do
  begin
    if key = Pkv(list[I])^.key then
    begin
      Result := Pkv(list[I]);
      exit;
    end;
  end;
  if not found then
  begin
    new(Result);
    Result^.key := key;
    list.Add(Result);
  end;
end;

procedure Tkv.fromRaw(const raw: RawByteString);
var
  ms: TStringStream;
begin
  ms := TStringStream.Create(raw);
  try
    fromStream(ms);
  finally
    ms.free;
  end;
end;

procedure Tkv.fromStream(ms: TStream);
var
  len: integer;
  key: RawByteString;
  kv: Pkv;
begin
  ms.Position := 0;
  while ms.Position < ms.Size do
  begin
    ms.Read(len, SizeOf(integer));
    SetLength(key, len);
    ms.Read(key[1], len);
    ms.Read(len, SizeOf(integer));
    new(kv);
    list := tlist.Create;
    SetLength(kv^.val, len);
    ms.Read(kv^.val[0], len);
    kv^.key := key;
    list.Add(kv);
  end;
end;

function Tkv.getB(const key: RawByteString): boolean;
var
  kv: Pkv;
begin
  kv := path(key);
  Result := PBoolean(kv^.val)^;
end;

function Tkv.getDT(const key: RawByteString): TDateTime;
var
  kv: Pkv;
begin
  kv := path(key);
  Result := PDateTime(kv^.val)^;
end;

function Tkv.getD(const key: RawByteString): Double;
var
  kv: Pkv;
begin
  kv := path(key);
  Result := PDouble(kv^.val)^;
end;

function Tkv.getI(const key: RawByteString): integer;
var
  kv: Pkv;
begin
  kv := path(key);
  Result := PInteger(kv^.val)^;
end;

function Tkv.getI64(const key: RawByteString): Int64;
var
  kv: Pkv;
begin
  kv := path(key);
  Result := PInt64(kv^.val)^;
end;

function Tkv.getS(const key: RawByteString): RawByteString;
var
  kv: Pkv;
  len: Integer;
begin
  kv := path(key);
  len := Length(kv^.val);
  if len = 0 then
    Result := ''
  else
  begin
    SetLength(Result, len);
    Move(kv^.val[0], Result[1], len);
  end;
end;

function Tkv.getST(const key: RawByteString): TStream;
var
  kv: Pkv;
  len: integer;
begin
  kv := path(key);
  len := Length(kv^.val);
  Result := TMemoryStream.Create;
  Result.Size := len;
  Result.Write(kv^.val[0], len);
  Result.Position := 0;
end;

function Tkv.getV(const key: RawByteString): OleVariant;
var
  p: pbyte;
  len: integer;
  kv: Pkv;
begin
  kv := path(key);
  len := Length(kv^.val);
  Result := VarArrayCreate([0, len - 1], varByte);
  p := VarArrayLock(Result);
  try
    Move(kv^.val[0], p^, len);
  finally
    VarArrayUnlock(Result);
  end;
end;

procedure Tkv.setB(const key: RawByteString; const Value: boolean);
var
  kv: Pkv;
begin
  kv := path(key);
  SetLength(kv^.val, SizeOf(boolean));
  PBoolean(kv^.val)^ := Value;
end;

procedure Tkv.setDT(const key: RawByteString; const Value: TDateTime);
var
  kv: Pkv;
begin
  kv := path(key);
  SetLength(kv^.val, SizeOf(TDateTime));
  PDateTime(kv^.val)^ := Value;
end;

procedure Tkv.setD(const key: RawByteString; const Value: Double);
var
  kv: Pkv;
begin
  kv := path(key);
  SetLength(kv^.val, SizeOf(Double));
  PDouble(kv^.val)^ := Value;
end;

procedure Tkv.setI(const key: RawByteString; const Value: integer);
var
  kv: Pkv;
begin
  kv := path(key);
  SetLength(kv^.val, SizeOf(integer));
  PInteger(kv^.val)^ := Value;
end;

procedure Tkv.setI64(const key: RawByteString; const Value: Int64);
var
  kv: Pkv;
begin
  kv := path(key);
  SetLength(kv^.val, SizeOf(Int64));
  PInt64(kv^.val)^ := Value;
end;

procedure Tkv.setS(const key, Value: RawByteString);
var
  len: integer;
  kv: Pkv;
begin
  kv := path(key);
  len := Length(Value);
  SetLength(kv^.val, len);
  if len > 0 then
    Move(Value[1], kv^.val[0], len);
end;

procedure Tkv.setST(const key: RawByteString; const Value: TStream);
var
  kv: Pkv;
begin
  kv := path(key);
  SetLength(kv^.val, Value.Size);
  Value.Position := 0;
  Value.Read(kv^.val[0], Value.Size);
end;

procedure Tkv.setV(const key: RawByteString; const Value: OleVariant);
var
  p: pbyte;
  len: integer;
  kv: Pkv;
begin
  kv := path(key);
  len := VarArrayHighBound(Value, 1) - VarArrayLowBound(Value, 1) + 1;
  p := VarArrayLock(Value);
  try
    SetLength(kv^.val, len);
    Move(p^, kv^.val[0], len);
  finally
    VarArrayUnlock(Value);
  end;
end;

function Tkv.toRaw: RawByteString;
var
  ms: TMemoryStream;
begin
  ms := TMemoryStream.Create;
  try
    toStream(ms);
    SetLength(Result, ms.Size);
    ms.Read(Result[1], ms.Size);
  finally
    ms.free;
  end;
end;

procedure Tkv.toStream(ms: TStream);
var
  I: integer;
  kv: Pkv;
  len: integer;
begin
  ms.Position := 0;
  for I := 0 to list.Count - 1 do
  begin
    kv := list[I];
    len := Length(kv^.key);
    ms.Write(len, SizeOf(integer));
    ms.Write(kv^.key[1], len);
    len := Length(kv^.val);
    ms.Write(len, SizeOf(integer));
    ms.Write(kv^.val[0], len);
  end;
  ms.Position := 0;
end;

end.