delphi和fpc共用的TJSONObjectHelper

unit core.json;
{$mode delphi}{$H+}
//{$ifdef fpc}
//{$codepage UTF8}
//{$endif}
// cxg 2025-5-18 TJsonObject's helper. fit delphi and FPC

interface

uses
{$IFNDEF fpc}
  System.json,
{$ELSE}
  fpjson, jsonparser,
{$ENDIF}
  SysUtils, Classes;

type
  str = UTF8String;
  bool = Boolean;
  int = Integer;
  TJsonO = TJSONObject;
  TJsonA = TJSONArray;

  TJsonObjectCrud = record
    class function Insert(const AJsonO: TJsonO; const ATableName: string)
      : string; static;
    class function Delete(const AJsonO: TJsonO;
      const ATableName, AKeyFields: string): string; static;
    class function Update(const AJsonO: TJsonO;
      const ATableName, AKeyFields: string): string; static;
  end;

  TJSONObjectHelper = class Helper for TJSONObject
  private
    procedure SetB(const AKey: str; const AValue: bool);
    procedure SetD(const AKey: str; const AValue: Double);
    procedure SetI64(const AKey: str; const AValue: Int64);
    procedure SetO(const AKey: str; const AValue: TJSONObject);
    procedure SetS(const AKey, AValue: str);
    procedure SetA(const AKey: str; const AValue: TJSONArray);
    function GetI(const AKey: str): int;
    procedure SetI(const AKey: str; const AValue: int);
  public
    function Exists(const AKey: str): bool;
    procedure Del(const AKey: str); // delete a item
    function ToUtf8String: str;
    function ToStr: string;
  private
    function GetB(const AKey: str): bool;
    function GetD(const AKey: str): Double;
    function GetI64(const AKey: str): Int64;
    function GetS(const AKey: str): str;
    function GetA(const AKey: str): TJSONArray;
    function GetO(const AKey: str): TJSONObject;
  public
    property S[const key: str]: str read GetS write SetS;
    property I[const key: str]: int read GetI write SetI;
    property I64[const key: str]: Int64 read GetI64 write SetI64;
    property D[const key: str]: Double read GetD write SetD;
    property B[const key: str]: bool read GetB write SetB;
    property O[const key: str]: TJSONObject read GetO write SetO;
    property A[const key: str]: TJSONArray read GetA write SetA;
  end;

  // json string to TJSONObject
function SO(const AValue: str): TJSONObject; overload;
function SO(const AValue: TStream): TJSONObject; overload;
function SO(const AValue: TBytes): TJSONObject; overload;
// json string to TJSONArray
function SA(const AValue: TBytes): TJSONArray; overload;
function SA(const AValue: TStream): TJSONArray; overload;
function SA(const AValue: str): TJSONArray; overload;
// json file to TJSONObject
function FromFile(const AFileName: str): TJSONObject;
// json file to TJSONArray
function FromFile2(const AFileName: str): TJSONArray;

implementation

{ TJSONObjectHelper }

function FromFile2(const AFileName: str): TJSONArray;
var
  LList: TStringList;
begin
  LList := TStringList.Create;
  try
    LList.LoadFromFile(AFileName, TEncoding.UTF8);
    Result := SA(LList.Text);
  finally
    LList.Free;
  end;
end;

function FromFile(const AFileName: str): TJSONObject;
var
  LList: TStringList;
begin
  LList := TStringList.Create;
  try
    LList.LoadFromFile(AFileName, TEncoding.UTF8);
    Result := SO(LList.Text);
  finally
    LList.Free;
  end;
end;

function SO(const AValue: TBytes): TJSONObject; overload;
var
  LLen: Integer;
  LStr: RawByteString;
begin
  LLen := Length(AValue);
  if LLen = 0 then
    Exit;
  SetLength(LStr, LLen);
  Move(AValue[0], LStr[1], LLen);
  Result := SO(LStr);
end;

function SO(const AValue: TStream): TJSONObject; overload;
var
  LStr: RawByteString;
begin
  if AValue = nil then
    Exit;
  SetLength(LStr, AValue.Size);
  Move(TMemoryStream(AValue).Memory^, LStr[1], AValue.Size);
  Result := SO(LStr);
end;

function SO(const AValue: str): TJSONObject;
begin
{$IFNDEF fpc}
  Result := TJSONObject.ParseJSONValue(AValue) as TJSONObject;
{$ELSE}
  Result := TJSONObject(getjson(AValue));
{$ENDIF}
end;

function SA(const AValue: TBytes): TJSONArray;
var
  LStr: RawByteString;
  LLen: Integer;
begin
  LLen := Length(AValue);
  if LLen = 0 then
    Exit;
  Move(AValue[0], LStr[1], LLen);
  Result := SA(LStr);
end;

function SA(const AValue: TStream): TJSONArray;
var
  LStr: RawByteString;
begin
  if AValue = nil then
    Exit;
  SetLength(LStr, AValue.Size);
  Move(TMemoryStream(AValue).Memory^, LStr[1], AValue.Size);
  Result := SA(LStr);
end;

function SA(const AValue: str): TJSONArray;
begin
{$IFNDEF fpc}
  Result := TJSONArray.ParseJSONValue(AValue) as TJSONArray;
{$ELSE}
  Result := TJSONArray(getjson(AValue));
{$ENDIF}
end;

function TJSONObjectHelper.Exists(const AKey: str): bool;
begin
{$IFNDEF fpc}
  Result := Assigned(GetValue(AKey));
{$ELSE}
  Result := self.IndexOfName(AKey) >= 0;
{$ENDIF}
end;

function TJSONObjectHelper.GetB(const AKey: str): bool;
begin
{$IFNDEF fpc}
  Result := TJSONBool(GetValue(AKey)).AsBoolean;
{$ELSE}
  Result := self.Booleans[AKey];
{$ENDIF}
end;

function TJSONObjectHelper.GetD(const AKey: str): Double;
begin
{$IFNDEF fpc}
  Result := TJSONNumber(GetValue(AKey)).AsDouble;
{$ELSE}
  Result := self.Floats[AKey];
{$ENDIF}
end;

function TJSONObjectHelper.GetI(const AKey: str): int;
begin
{$IFNDEF fpc}
  Result := TJSONNumber(GetValue(AKey)).AsInt;
{$ELSE}
  Result := self.Integers[AKey];
{$ENDIF}
end;

function TJSONObjectHelper.GetI64(const AKey: str): Int64;
begin
{$IFNDEF fpc}
  Result := TJSONNumber(GetValue(AKey)).AsInt64;
{$ELSE}
  Result := self.Int64s[AKey];
{$ENDIF}
end;

function TJSONObjectHelper.GetA(const AKey: str): TJSONArray;
begin
{$IFNDEF fpc}
  Result := TJSONArray(GetValue(AKey));
{$ELSE}
  Result := Arrays[AKey];
{$ENDIF}
end;

function TJSONObjectHelper.GetO(const AKey: str): TJSONObject;
begin
{$IFNDEF fpc}
  Result := TJSONObject(GetValue(AKey));
{$ELSE}
  Result := Objects[AKey];
{$ENDIF}
end;

function TJSONObjectHelper.GetS(const AKey: str): str;
begin
{$IFNDEF fpc}
  Result := TJSONString(GetValue(AKey)).AsType<str>;
{$ELSE}
  Result := Strings[AKey];
{$ENDIF}
end;

procedure TJSONObjectHelper.Del(const AKey: str);
begin
{$IFNDEF fpc}
  RemovePair(AKey);
{$ELSE}
  Delete(AKey);
{$ENDIF}
end;

procedure TJSONObjectHelper.SetB(const AKey: str; const AValue: bool);
begin
  Del(AKey);
{$IFNDEF fpc}
  AddPair(AKey, TJSONBool.Create(AValue));
{$ELSE}
  add(AKey, AValue);
{$ENDIF}
end;

procedure TJSONObjectHelper.SetD(const AKey: str; const AValue: Double);
begin
  Del(AKey);
{$IFNDEF fpc}
  AddPair(AKey, TJSONNumber.Create(AValue));
{$ELSE}
  add(AKey, AValue);
{$ENDIF}
end;

procedure TJSONObjectHelper.SetI(const AKey: str; const AValue: int);
begin
  Del(AKey);
{$IFNDEF fpc}
  AddPair(AKey, TJSONNumber.Create(AValue));
{$ELSE}
  add(AKey, AValue);
{$ENDIF}
end;

procedure TJSONObjectHelper.SetI64(const AKey: str; const AValue: Int64);
begin
  Del(AKey);
{$IFNDEF fpc}
  AddPair(AKey, TJSONNumber.Create(AValue));
{$ELSE}
  add(AKey, AValue);
{$ENDIF}
end;

procedure TJSONObjectHelper.SetA(const AKey: str; const AValue: TJSONArray);
begin
  Del(AKey);
{$IFNDEF fpc}
  AddPair(AKey, AValue);
{$ELSE}
  add(AKey, AValue);
{$ENDIF}
end;

procedure TJSONObjectHelper.SetO(const AKey: str; const AValue: TJSONObject);
begin
  Del(AKey);
{$IFNDEF fpc}
  AddPair(AKey, AValue);
{$ELSE}
  add(AKey, AValue);
{$ENDIF}
end;

procedure TJSONObjectHelper.SetS(const AKey, AValue: str);
begin
  Del(AKey);
{$IFNDEF fpc}
  AddPair(AKey, TJSONString.Create(AValue));
{$ELSE}
  add(AKey, AValue);
{$ENDIF}
end;

function TJSONObjectHelper.ToStr: string;
begin
{$IFNDEF fpc}
  Result := ToString;
{$ELSE}
  Result := asjson;
{$ENDIF}
end;

function TJSONObjectHelper.ToUtf8String: str;
begin
{$IFNDEF fpc}
  Result := UTF8Encode(ToString);
{$ELSE}
  Result := asjson;
{$ENDIF}
end;

{ TJsonObjectCrud }

class function TJsonObjectCrud.Delete(const AJsonO: TJsonO; const ATableName,
  AKeyFields: string): string;
var
  {$ifndef fpc}
  LPair: TJSONPair;
  {$else}
  i: Integer;
  {$endif}
  LKey, LValue, LWhere: string;
begin
  if (AJsonO = nil) or (ATableName = '') or (AKeyFields = '') then
    Exit;
  LWhere := '';
  LKey := '';
  LValue := '';

  {$ifndef fpc}
  for LPair in AJsonO do
  begin
    LKey := LPair.JsonString.Value;
    LValue := LPair.JsonValue.Value;
    if LPair.JsonValue is TJSONString then
      LValue := QuotedStr(LValue);
    if Pos(LKey, AKeyFields) = 0 then
      Continue; // 非主键不做where条件
    LWhere := LWhere + ' and ' + LKey + '=' + LValue; // 拼where条件
  end;
  {$else}
  for i := 0 to AJsonO.Count - 1 do
  begin
    LKey := AJsonO.Names[i];
    LValue := AJsonO.Items[i].Value;
    if AJsonO.Items[i].JSONType = jtString then
      LValue := QuotedStr(LValue);
    if Pos(LKey, AKeyFields) = 0 then
      Continue; // 非主键不做where条件
    LWhere := LWhere + ' and ' + LKey + '=' + LValue; // 拼where条件
  end;
  {$endif}
  system.Delete(LWhere, 1, 5);
  Result := 'delete from ' + ATableName + ' where ' + LWhere;
end;

class function TJsonObjectCrud.Insert(const AJsonO: TJsonO;
  const ATableName: string): string;
var
  {$ifndef fpc}
  LPair: TJSONPair;
  {$else}
  i: Integer;
  {$endif}
  LKey, LValue, LFields, LValues: string;
begin
  if (AJsonO = nil) or (ATableName = '') then
    Exit;
  LKey := '';
  LValue := '';
  LFields := '';
  LValues := '';
  {$ifndef fpc}
  for LPair in AJsonO do
  begin
    LKey := LPair.JsonString.Value;
    LValue := LPair.JsonValue.Value;
    if LPair.JsonValue is TJSONString then
      LValue := QuotedStr(LValue);
    LFields := LFields + ',' + LKey;//拼字段
    LValues := LValues + ',' + LValue;//拼值
  end;
  {$else}
  for i := 0 to AJsonO.Count - 1 do
  begin
    LKey := AJsonO.Names[i];
    LValue := AJsonO.Items[i].Value;
    if AJsonO.Items[i].JSONType = jtString then
      LValue := QuotedStr(LValue);
    LFields := LFields + ',' + LKey;//拼字段
    LValues := LValues + ',' + LValue;//拼值
  end;
  {$endif}
  system.Delete(LFields,1,1);
  system.Delete(LValues,1,1);
  Result := 'insert into ' + ATableName + '('+LFields+') values (' + LValues + ')';
end;

class function TJsonObjectCrud.Update(const AJsonO: TJsonO; const ATableName,
  AKeyFields: string): string;
var
  {$ifndef fpc}
  LPair: TJSONPair;
  {$else}
  i: Integer;
  {$endif}
  LKey, LValue, LSet, LWhere: string;
begin
  if (AJsonO = nil) or (ATableName = '') or (AKeyFields = '') then
    Exit;
  LWhere := '';
  LKey := '';
  LValue := '';
  LSet := '';
  {$ifndef fpc}
  for LPair in AJsonO do
  begin
    LKey := LPair.JsonString.Value;
    LValue := LPair.JsonValue.Value;
    if LPair.JsonValue is TJSONString then
      LValue := QuotedStr(LValue);
    LSet := LSet + ',' + LKey + '=' + LValue;
    if Pos(LKey, AKeyFields) = 0 then Continue; //非主键不做where条件
    LWhere := LWhere + ' and ' + LKey + '=' + LValue; // 拼where条件
  end;
  {$else}
    for i := 0 to AJsonO.Count - 1 do
  begin
    LKey := AJsonO.Names[i];
    LValue := AJsonO.Items[i].Value;
    if AJsonO.Items[i].JSONType = jtString then
      LValue := QuotedStr(LValue);
    LSet := LSet + ',' + LKey + '=' + LValue;
    if Pos(LKey, AKeyFields) = 0 then Continue; //非主键不做where条件
    LWhere := LWhere + ' and ' + LKey + '=' + LValue; // 拼where条件
  end;
  {$endif}
  system.Delete(LSet,1,1);
  system.Delete(LWhere,1,5);
  Result := 'update ' + ATableName + ' set ' + LSet + ' where ' + LWhere;
end;

end.