ulkjson.pas

json delphi component

function TlkJSONboolean.GetValue: Variant;
begin
  result := FValue;
end;

class function TlkJSONboolean.SelfType: TlkJSONtypes;
begin
  Result := jsBoolean;
end;

class function TlkJSONboolean.SelfTypeName: string;
begin
  Result := 'jsBoolean';
end;

procedure TlkJSONboolean.SetValue(const AValue: Variant);
begin
  FValue := boolean(AValue);
end;

{ TlkJSONnull }

function TlkJSONnull.Generate: TlkJSONnull;
begin
  result := TlkJSONnull.Create;
end;

function TlkJSONnull.GetValue: Variant;
begin
  result := variants.Null;
end;

class function TlkJSONnull.SelfType: TlkJSONtypes;
begin
  result := jsNull;
end;

class function TlkJSONnull.SelfTypeName: string;
begin
  result := 'jsNull';
end;

{ TlkJSONcustomlist }

function TlkJSONcustomlist._Add(obj: TlkJSONbase): Integer;
begin
  if not Assigned(obj) then
    begin
      result := -1;
      exit;
    end;
  result := fList.Add(obj);
end;

procedure TlkJSONcustomlist.AfterConstruction;
begin
  inherited;
  fList := TList.Create;
end;

procedure TlkJSONcustomlist.BeforeDestruction;
var
  i: Integer;
begin
  for i := (Count - 1) downto 0 do _Delete(i);
  fList.Free;
  inherited;
end;

procedure TlkJSONcustomlist._Delete(idx: Integer);
begin
  if not ((idx < 0) or (idx >= Count)) then
    begin
      if fList.Items[idx]<>nil then TlkJSONbase(fList.Items[idx]).Free;
      fList.Delete(idx);
    end;
end;

function TlkJSONcustomlist.GetChild(idx: Integer): TlkJSONbase;
begin
  if (idx < 0) or (idx >= Count) then
    begin
      result := nil;
    end
  else
    begin
      result := fList.Items[idx];
    end;
end;

function TlkJSONcustomlist.GetCount: Integer;
begin
  result := fList.Count;
end;

function TlkJSONcustomlist._IndexOf(obj: TlkJSONbase): Integer;
var
  i: Integer;
begin
  result := fList.IndexOf(obj);
end;

procedure TlkJSONcustomlist.SetChild(idx: Integer; const AValue:
  TlkJSONbase);
begin
  if not ((idx < 0) or (idx >= Count)) then
    begin
      if fList.Items[idx]<>nil then TlkJSONbase(fList.Items[idx]).Free;
      fList.Items[idx] := AValue;
    end;
end;

///---- renamed to here

procedure TlkJSONcustomlist.ForEach(cb: TlkJSONFuncEnum; data:
  pointer);
var
  i: Integer;
  doCont: Boolean;
  obj: TlkJSONbase;
  ws: string;
begin
  if not assigned(cb) then exit;
  doCont := true;
  for i := 0 to GetCount - 1 do
    begin
      obj := ForEachElement(i, ws);
      if assigned(obj) then cb(ws, obj, data, doCont);
      if not doCont then break;
    end;
end;

function TlkJSONcustomlist.ForEachElement(idx: Integer; var nm:
  string): TlkJSONbase;
begin
  nm := inttostr(idx);
  result := GetChild(idx);
end;

function TlkJSONcustomlist.getDouble(idx: Integer): Double;
var
  jn:TlkJSONnumber;
begin
  jn := Child[idx] as TlkJSONnumber;
  if not assigned(jn) then result := 0
  else result := jn.Value;
end;

function TlkJSONcustomlist.getInt(idx: Integer): Integer;
var
  jn:TlkJSONnumber;
begin
  jn := Child[idx] as TlkJSONnumber;
  if not assigned(jn) then result := 0
  else result := round(int(jn.Value));
end;

function TlkJSONcustomlist.getString(idx: Integer): String;
var
  js:TlkJSONstring;
begin
  js := Child[idx] as TlkJSONstring;
  if not assigned(js) then result := ''
  else result := VarToStr(js.Value);
end;

function TlkJSONcustomlist.getWideString(idx: Integer): WideString;
var
  js:TlkJSONstring;
begin
  js := Child[idx] as TlkJSONstring;
  if not assigned(js) then result := ''
  else result := VarToWideStr(js.Value);
end;

function TlkJSONcustomlist.getBoolean(idx: Integer): Boolean;
var
  jb:TlkJSONboolean;
begin
  jb := Child[idx] as TlkJSONboolean;
  if not assigned(jb) then result := false
  else result := jb.Value;
end;

{ TlkJSONobjectmethod }

procedure TlkJSONobjectmethod.AfterConstruction;
begin
  inherited;
  FValue := nil;
  FName := '';
end;

procedure TlkJSONobjectmethod.BeforeDestruction;
begin
  FName := '';
  if FValue <> nil then
    begin
      FValue.Free;
      FValue := nil;
    end;
  inherited;
end;

class function TlkJSONobjectmethod.Generate(const aname: WideString;
  aobj: TlkJSONbase): TlkJSONobjectmethod;
begin
  result := TlkJSONobjectmethod.Create;
  result.FName := aname;
  result.FValue := aobj;
end;

procedure TlkJSONobjectmethod.SetName(const AValue: WideString);
begin
  FName := AValue;
end;

{ TlkJSONlist }

function TlkJSONlist.Add(obj: TlkJSONbase): Integer;
begin
  result := _Add(obj);
end;

function TlkJSONlist.Add(nmb: double): Integer;
begin
  Result := self.Add(TlkJSONnumber.Generate(nmb));
end;

function TlkJSONlist.Add(bool: Boolean): Integer;
begin
  Result := self.Add(TlkJSONboolean.Generate(bool));
end;

function TlkJSONlist.Add(inmb: Integer): Integer;
begin
  Result := self.Add(TlkJSONnumber.Generate(inmb));
end;

function TlkJSONlist.Add(const ws: WideString): Integer;
begin
  Result := self.Add(TlkJSONstring.Generate(ws));
end;

function TlkJSONlist.Add(s: string): Integer;
begin
  Result := self.Add(TlkJSONstring.Generate(s));
end;

procedure TlkJSONlist.Delete(idx: Integer);
begin
  _Delete(idx);
end;

class function TlkJSONlist.Generate: TlkJSONlist;
begin
  result := TlkJSONlist.Create;
end;

function TlkJSONlist.IndexOf(obj: TlkJSONbase): Integer;
begin
  result := _IndexOf(obj);
end;

class function TlkJSONlist.SelfType: TlkJSONtypes;
begin
  result := jsList;
end;

class function TlkJSONlist.SelfTypeName: string;
begin
  result := 'jsList';
end;

{ TlkJSONobject }

function TlkJSONobject.Add(const aname: WideString; aobj: TlkJSONbase):
  Integer;
var
  mth: TlkJSONobjectmethod;
begin
  if not assigned(aobj) then
    begin
      result := -1;
      exit;
    end;
  mth := TlkJSONobjectmethod.Create;
  mth.FName := aname;
  mth.FValue := aobj;
  result := self._Add(mth);
  if FUseHash then ht.AddPair(aname, result);
end;

procedure TlkJSONobject.Delete(idx: Integer);
var
  mth: TlkJSONobjectmethod;
begin
  if (idx >= 0) and (idx < Count) then
    begin
//      mth := FValue[idx] as TlkJSONobjectmethod;
      mth := TlkJSONobjectmethod(fList.Items[idx]);
      if FUseHash then ht.Delete(mth.FName);
    end;
  _Delete(idx);
end;

class function TlkJSONobject.Generate(AUseHash: Boolean = true): TlkJSONobject;
begin
  result := TlkJSONobject.Create(AUseHash);
end;

function TlkJSONobject.GetField(nm: string): TlkJSONbase;
var
  mth: TlkJSONobjectmethod;
  i: Integer;
begin
  i := IndexOfName(nm);
  if i = -1 then
    begin
      result := nil;
    end
  else
    begin
//      mth := TlkJSONobjectmethod(FValue[i]);
      mth := TlkJSONobjectmethod(fList.Items[i]);
      result := mth.FValue;
    end;
end;

function TlkJSONobject.IndexOfName(const aname: WideString): Integer;
var
  mth: TlkJSONobjectmethod;
  i: Integer;
begin
  if not FUseHash then
    begin
      result := -1;
      for i := 0 to Count - 1 do
        begin
//          mth := TlkJSONobjectmethod(FValue[i]);
          mth := TlkJSONobjectmethod(fList.Items[i]);
          if mth.Name = aname then
            begin
              result := i;
              break;
            end;
        end;
    end
  else
    begin
      result := ht.IndexOf(aname);
    end;
end;

function TlkJSONobject.IndexOfObject(aobj: TlkJSONbase): Integer;
var
  mth: TlkJSONobjectmethod;
  i: Integer;
begin
  result := -1;
  for i := 0 to Count - 1 do
    begin
//      mth := TlkJSONobjectmethod(FValue[i]);
      mth := TlkJSONobjectmethod(fList.Items[i]);
      if mth.FValue = aobj then
        begin
          result := i;
          break;
        end;
    end;
end;

procedure TlkJSONobject.SetField(nm: string; const AValue:
  TlkJSONbase);
var
  mth: TlkJSONobjectmethod;
  i: Integer;
begin
  i := IndexOfName(nm);
  if i <> -1 then
    begin
//      mth := TlkJSONobjectmethod(FValue[i]);
      mth := TlkJSONobjectmethod(fList.Items[i]);
      mth.FValue := AValue;
    end;
end;

function TlkJSONobject.Add(const aname: WideString; nmb: double): Integer;
begin
  Result := self.Add(aname, TlkJSONnumber.Generate(nmb));
end;

function TlkJSONobject.Add(const aname: WideString; bool: Boolean):
  Integer;
begin
  Result := self.Add(aname, TlkJSONboolean.Generate(bool));
end;

function TlkJSONobject.Add(const aname: WideString; s: string): Integer;
begin
  Result := self.Add(aname, TlkJSONstring.Generate(s));
end;

function TlkJSONobject.Add(const aname: WideString; inmb: Integer):
  Integer;
begin
  Result := self.Add(aname, TlkJSONnumber.Generate(inmb));
end;

function TlkJSONobject.Add(const aname, ws: WideString): Integer;
begin
  Result := self.Add(aname, TlkJSONstring.Generate(ws));
end;

class function TlkJSONobject.SelfType: TlkJSONtypes;
begin
  Result := jsObject;
end;

class function TlkJSONobject.SelfTypeName: string;
begin
  Result := 'jsObject';
end;

function TlkJSONobject.GetFieldByIndex(idx: Integer): TlkJSONbase;
var
  nm: WideString;
begin
  nm := GetNameOf(idx);
  if nm <> '' then
    begin
      result := Field[nm];
    end
  else
    begin
      result := nil;
    end;
end;

function TlkJSONobject.GetNameOf(idx: Integer): WideString;
var
  mth: TlkJSONobjectmethod;
begin
  if (idx < 0) or (idx >= Count) then
    begin
      result := '';
    end
  else
    begin
      mth := Child[idx] as TlkJSONobjectmethod;
      result := mth.Name;
    end;
end;

procedure TlkJSONobject.SetFieldByIndex(idx: Integer;
  const AValue: TlkJSONbase);
var
  nm: WideString;
begin
  nm := GetNameOf(idx);
  if nm <> '' then
    begin
      Field[nm] := AValue;
    end;
end;

function TlkJSONobject.ForEachElement(idx: Integer;
  var nm: string): TlkJSONbase;
begin
  nm := GetNameOf(idx);
  result := GetFieldByIndex(idx);
end;

function TlkJSONobject.GetHashTable: TlkHashTable;
begin
  result := ht;
end;

constructor TlkJSONobject.Create(bUseHash: Boolean);
begin
  inherited Create;
  FUseHash := bUseHash;
  ht := TlkHashTable.Create;
end;

destructor TlkJSONobject.Destroy;
begin
  if assigned(ht) then FreeAndNil(ht);
  inherited;
end;

function TlkJSONobject.getDouble(idx: Integer): Double;
var
  jn:TlkJSONnumber;
begin
  jn := FieldByIndex[idx] as TlkJSONnumber;
  if not assigned(jn) then result := 0
  else result := jn.Value;
end;

function TlkJSONobject.getInt(idx: Integer): Integer;
var
  jn:TlkJSONnumber;
begin
  jn := FieldByIndex[idx] as TlkJSONnumber;
  if not assigned(jn) then result := 0
  else result := round(int(jn.Value));
end;

function TlkJSONobject.getString(idx: Integer): String;
var
  js:TlkJSONstring;