How add one object and one pair for a existent .json file? - json

I have a code that changes a value of a determinated pair in a existent JSON file and works perfectly. Now i need add one object and one pair to this file, using great part this same code. So how do this?
Thank you.
uses
System.Json, ShFolder, System.IOUtils;
...
function GetSpecialFolderPath(folder : integer) : string;
const
SHGFP_TYPE_CURRENT = 0;
var
path: array [0..MAX_PATH] of char;
begin
if SUCCEEDED(SHGetFolderPath(0,folder,0,SHGFP_TYPE_CURRENT,#path[0])) then
Result := path
else
Result := '';
end;
procedure ChangeChromeSetting(const ATarget, Avalue: string);
var
specialfolder: integer;
caminhochrome: String;
JSONObj, Obj: TJSONObject;
JSONPair: TJSONPair;
OldValue: string;
begin
specialFolder := CSIDL_LOCAL_APPDATA;
caminhochrome := GetSpecialFolderPath(specialFolder);
caminhochrome := caminhochrome + '\Google\Chrome\User Data\Local State';
if fileexists(caminhochrome) then
begin
Obj := TJSONObject.Create;
JSONObj := TJSONObject.ParseJSONValue(TFile.ReadAllText(caminhochrome)) as TJSONObject;
if not Assigned(JSONObj) then raise Exception.Create('Cannot read file: ' + caminhochrome);
try
OldValue := JSONObj.GetValue<string>(ATarget);
if not SameText(OldValue, Avalue) then
begin
JSONPair := JSONObj.Get(ATarget);
JSONPair.JsonValue.Free;
JSONPair.JsonValue := TJSONString.Create(Avalue);
///////////////////////////////////////////////////
Obj.AddPair('enabled', TJSONBool.Create(false)); // Trying add pair
JSONObj.AddPair('hardware_acceleration_mode', Obj); // Trying add object
//////////////////////////////////////////////////
TFile.WriteAllText(caminhochrome, JSONObj.ToJSON); // Don't add object and pair
end;
finally
JSONObj.Free;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ChangeChromeSetting('hardware_acceleration_mode_previous', 'false');
end;
This is result that i'm waiting
"hardware_acceleration_mode":{"enabled":false}

Your code is somewhat confusing since you pass in some of the names as arguments, but then hard code others inside the function. Abstracting functionality is good practise but before you can abstract you really need to ensure the code works correctly. I'm going to show code that does not attempt to be abstract. Once you are satisfied it behaves as you need, then feel free to abstract away.
This code does what I believe is your intent:
var
root: TJSONObject;
value: TJSONObject;
prev: string;
begin
root := TJSONObject.ParseJSONValue(TFile.ReadAllText(FileName)) as TJSONObject;
try
prev := root.GetValue<string>('hardware_acceleration_mode_previous');
if not SameText(prev, 'false') then
begin
// remove existing value, if it exists
root.RemovePair('hardware_acceleration_mode').Free;
// create a new object, and initialise it
value := TJSONObject.Create;
value.AddPair('enabled', 'false');
// add the object at the root level
root.AddPair('hardware_acceleration_mode', value);
// save to file
TFile.WriteAllText(FileName, root.ToJSON);
end;
finally
root.Free;
end;
end;
Note that I have ensured that there are no memory leaks. I've used RemovePair to make sure that if there is an existing value named hardware_acceleration_mode it is first removed.

Related

Simple JSON deserialization of records incorrect (Delphi Sydney [10.4.1])

What happened to the JSON deserializer of Delphi Sydney (10.4.1)?
After the migration from Delphi Seattle to Sydney, the standard marshal has problems with the deserialization of simple records.
Here is an example and simplified representation of my problem:
Data structure - Interation 1:
TAnalysisAdditionalData=record {order important for marshaling}
ExampleData0:Real; {00}
ExampleData1:Real; {01}
ExampleData2:String; {02}
end;
JSON representation:
"AnalysisAdditionalData":[0,1,"ExampleString"]
Data structure - Interation x, 5 years later:
TAnalysisAdditionalData=record {order important for marshaling}
ExampleData0:Real; {00}
ExampleData1:Real; {01}
ExampleData2:String; {02}
ExampleData3:String; {03} {since version 2016-01-01}
ExampleData4:String; {04} {since version 2018-01-01}
ExampleData5:String; {05}
end;
JSON representation:
"AnalysisAdditionalData":[0,1,"ExampleString0","ExampleString1","ExampleString2","ExampleString3"]
After interation 1, three string fields have been added.
If I now confront the standard marshal of Delphi Sydney (no custom converter, reverter, etc.) with an old dataset, so concretely with the data "AnalysisAdditionalData":[0,1, "ExampleString"], Sydney throws an EArgumentOutOfBoundsException because the 3 strings are expected - the deserialization fails.
Exit point is in Data.DBXJSONReflect in method TJSONUnMarshal.JSONToTValue - location marked below:
function TJSONUnMarshal.JSONToTValue(JsonValue: TJSONValue;
rttiType: TRttiType): TValue;
var
tvArray: array of TValue;
Value: string;
I: Integer;
elementType: TRttiType;
Data: TValue;
recField: TRTTIField;
attrRev: TJSONInterceptor;
jsonFieldVal: TJSONValue;
ClassType: TClass;
Instance: Pointer;
begin
// null or nil returns empty
if (JsonValue = nil) or (JsonValue is TJSONNull) then
Exit(TValue.Empty);
// for each JSON value type
if JsonValue is TJSONNumber then
// get data "as is"
Value := TJSONNumber(JsonValue).ToString
else if JsonValue is TJSONString then
Value := TJSONString(JsonValue).Value
else if JsonValue is TJSONTrue then
Exit(True)
else if JsonValue is TJSONFalse then
Exit(False)
else if JsonValue is TJSONObject then
// object...
Exit(CreateObject(TJSONObject(JsonValue)))
else
begin
case rttiType.TypeKind of
TTypeKind.tkDynArray, TTypeKind.tkArray:
begin
// array
SetLength(tvArray, TJSONArray(JsonValue).Count);
if rttiType is TRttiArrayType then
elementType := TRttiArrayType(rttiType).elementType
else
elementType := TRttiDynamicArrayType(rttiType).elementType;
for I := 0 to Length(tvArray) - 1 do
tvArray[I] := JSONToTValue(TJSONArray(JsonValue).Items[I],
elementType);
Exit(TValue.FromArray(rttiType.Handle, tvArray));
end;
TTypeKind.tkRecord, TTypeKind.tkMRecord:
begin
TValue.Make(nil, rttiType.Handle, Data);
// match the fields with the array elements
I := 0;
for recField in rttiType.GetFields do
begin
Instance := Data.GetReferenceToRawData;
jsonFieldVal := TJSONArray(JsonValue).Items[I]; <<<--- Exception here (EArgumentOutOfBoundsException)
// check for type reverter
ClassType := nil;
if recField.FieldType.IsInstance then
ClassType := recField.FieldType.AsInstance.MetaclassType;
if (ClassType <> nil) then
begin
if HasReverter(ClassType, FIELD_ANY) then
RevertType(recField, Instance,
Reverter(ClassType, FIELD_ANY),
jsonFieldVal)
else
begin
attrRev := FieldTypeReverter(recField.FieldType);
if attrRev = nil then
attrRev := FieldReverter(recField);
if attrRev <> nil then
try
RevertType(recField, Instance, attrRev, jsonFieldVal)
finally
attrRev.Free
end
else
recField.SetValue(Instance, JSONToTValue(jsonFieldVal,
recField.FieldType));
end
end
else
recField.SetValue(Instance, JSONToTValue(jsonFieldVal,
recField.FieldType));
Inc(I);
end;
Exit(Data);
end;
end;
end;
// transform value string into TValue based on type info
Exit(StringToTValue(Value, rttiType.Handle));
end;
Of course, this may make sense for people who, for example, only work with Sydney, or at least with Delphi versions above Seattle, or have started with these versions. I, on the other hand, have only recently been able to make the transition from Seattle to Sydney (Update 1).
Delphi Seattle has no problems with the missing record fields. Why should it, when they can be left untouched as default? Absurdly, however, Sydney has no problems with excess data.
Is this a known Delphi Sydney bug? Can we expect a fix? Or can the problem be worked around in some other way, i.e. compiler directive, Data.DBXJSONReflect.TCustomAttribute, etc.? Or, is it possible to write a converter/reverter for records? If so, is there a useful guide or resource that explains how to do this?
I, for my part, have unfortunately not found any useful information in this regard, only many very poorly documented class descriptions.
Addendum: Yes, it looks like it is a Delphi bug, and in my opinion a very dangerous one. Luckily, and I'm just about to deploy a major release, I discovered the bug while testing after porting to Sydney. But that was only by chance, because I had to deal with old datasets. I could have easily overlooked the flaw.
You should check if your projects are also affected. For me, the problem is a neckbreaker right now.
I have just written a very simple test program for the Embarcadero support team. If you want, you can have a look at it and test if your code is also affected.
Below are the instructions and the code:
Create a new project.
Creates two buttons and a memo on the main form.
Assign the two OnClick events for the buttons for load and save accordingly
Runs the program and clicks the save button.
Opens the .TXT in the application directory and delete e.g. the last entry of the record.
Click the load button and an EArgumentOutOfBoundsException is thrown.
unit main;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
FMX.Memo.Types, FMX.StdCtrls, FMX.Controls.Presentation, FMX.ScrollBox,
FMX.Memo;
type
TAnalysisAdditionalData=record {order important for marshaling}
ExampleData0:Real; {00}
ExampleData1:Real; {01}
ExampleData2:String; {02}
ExampleData3:String; {03} {since version 2016-01-01}
ExampleData4:String; {04} {since version 2018-01-01}
ExampleData5:String; {05}
end;
TSHCustomEntity=class(TPersistent)
private
protected
public
GUID:String;
end;
TSHAnalysis=class(TSHCustomEntity)
private
protected
public
AnalysisResult:String;
AnalysisAdditionalData:TAnalysisAdditionalData;
end;
TMainform = class(TForm)
Memo_Output: TMemo;
Button_Save: TButton;
Button_Load: TButton;
procedure Button_SaveClick(Sender: TObject);
procedure Button_LoadClick(Sender: TObject);
private
Analysis:TSHAnalysis;
procedure Marshal(Filename:String);
procedure Unmarshal(Filename:String);
function GetApplicationPath: String;
function GetFilename: String;
protected
procedure AfterConstruction;override;
public
Destructor Destroy;override;
property ApplicationPath:String read GetApplicationPath;
property Filename:String read GetFilename;
end;
var
Mainform: TMainform;
implementation
{$R *.fmx}
uses
DBXJSON,
DBXJSONReflect,
System.JSON;
{ TMainform }
procedure TMainform.AfterConstruction;
begin
inherited;
self.Analysis:=TSHAnalysis.Create;
self.Analysis.GUID:='6ed61388-cdd4-28dd-6efe-24461c4df3cd';
self.Analysis.AnalysisAdditionalData.ExampleData0:=0.5;
self.Analysis.AnalysisAdditionalData.ExampleData1:=0.9;
self.Analysis.AnalysisAdditionalData.ExampleData2:='ExampleString0';
self.Analysis.AnalysisAdditionalData.ExampleData3:='ExampleString1';
self.Analysis.AnalysisAdditionalData.ExampleData4:='ExampleString2';
self.Analysis.AnalysisAdditionalData.ExampleData5:='ExampleString3';
end;
destructor TMainform.Destroy;
begin
self.Analysis.free;
inherited;
end;
function TMainform.GetApplicationPath: String;
begin
RESULT:=IncludeTrailingPathDelimiter(ExtractFilePath(paramStr(0)));
end;
function TMainform.GetFilename: String;
begin
RESULT:=self.ApplicationPath+'6ed61388-cdd4-28dd-6efe-24461c4df3cd.txt';
end;
procedure TMainform.Button_SaveClick(Sender: TObject);
begin
self.Marshal(self.Filename);
end;
procedure TMainform.Button_LoadClick(Sender: TObject);
begin
if Analysis<>NIL then
FreeAndNil(Analysis);
self.Unmarshal(self.Filename);
self.Memo_Output.Text:=
self.Analysis.GUID+#13#10+
FloatToStr(self.Analysis.AnalysisAdditionalData.ExampleData0)+#13#10+
FloatToStr(self.Analysis.AnalysisAdditionalData.ExampleData1)+#13#10+
self.Analysis.AnalysisAdditionalData.ExampleData2+#13#10+
self.Analysis.AnalysisAdditionalData.ExampleData3+#13#10+
self.Analysis.AnalysisAdditionalData.ExampleData4+#13#10+
self.Analysis.AnalysisAdditionalData.ExampleData5;
end;
procedure TMainform.Marshal(Filename:String);
var
_Marshal:TJSONMarshal;
_Strings:TStringlist;
_Value:TJSONValue;
begin
_Strings:=TStringlist.Create;
try
_Marshal:=TJSONMarshal.Create;
try
_Value:=_Marshal.Marshal(Analysis);
_Strings.text:=_Value.ToString;
finally
if _Value<>NIL then
_Value.free;
_Marshal.free;
end;
_Strings.SaveToFile(Filename);
finally
_Strings.free;
end;
end;
procedure TMainform.Unmarshal(Filename:String);
var
_Strings:TStrings;
_UnMarshal:TJSONUnMarshal;
_Value:TJSONValue;
begin
if FileExists(Filename) then begin
_Strings:=TStringlist.create;
try
_Strings.LoadFromFile(Filename);
try
_Value:=TJSONObject.ParseJSONValue(_Strings.Text);
_UnMarshal:=TJSONUnMarshal.Create;
try
try
self.Analysis:=_UnMarshal.Unmarshal(_Value) as TSHAnalysis;
except
on e:Exception do
self.Memo_Output.text:=e.Message;
end;
finally
_UnMarshal.free;
end;
finally
if _Value<>NIL then
_Value.free;
end;
finally
_Strings.free;
end;
end;
end;
end.
To solve the problem temporarily, I have the following quick solution for you:
Make a copy of the standard library Data.DBXJSONReflect and name it e.g. Data.TempFix.DBXJSONReflect.
Change all includes/uses in your project accordingly.
After that navigate in Data.TempFix.DBXJSONReflect to line 2993:
jsonFieldVal := TJSONArray(JsonValue).Items[I];
And replace it with the following code:
try
jsonFieldVal := TJSONArray(JsonValue).Items[I];
except
on e:Exception do
if e is EArgumentOutOfRangeException then
continue
else
raise;
end;
After that the whole method should look like this:
function TJSONUnMarshal.JSONToTValue(JsonValue: TJSONValue; rttiType: TRttiType): TValue;
var
tvArray: array of TValue;
Value: string;
I: Integer;
elementType: TRttiType;
Data: TValue;
recField: TRTTIField;
attrRev: TJSONInterceptor;
jsonFieldVal: TJSONValue;
ClassType: TClass;
Instance: Pointer;
begin
// null or nil returns empty
if (JsonValue = nil) or (JsonValue is TJSONNull) then
Exit(TValue.Empty);
// for each JSON value type
if JsonValue is TJSONNumber then
// get data "as is"
Value := TJSONNumber(JsonValue).ToString
else if JsonValue is TJSONString then
Value := TJSONString(JsonValue).Value
else if JsonValue is TJSONTrue then
Exit(True)
else if JsonValue is TJSONFalse then
Exit(False)
else if JsonValue is TJSONObject then
// object...
Exit(CreateObject(TJSONObject(JsonValue)))
else
begin
case rttiType.TypeKind of
TTypeKind.tkDynArray, TTypeKind.tkArray:
begin
// array
SetLength(tvArray, TJSONArray(JsonValue).Count);
if rttiType is TRttiArrayType then
elementType := TRttiArrayType(rttiType).elementType
else
elementType := TRttiDynamicArrayType(rttiType).elementType;
for I := 0 to Length(tvArray) - 1 do
tvArray[I] := JSONToTValue(TJSONArray(JsonValue).Items[I],
elementType);
Exit(TValue.FromArray(rttiType.Handle, tvArray));
end;
TTypeKind.tkRecord, TTypeKind.tkMRecord:
begin
TValue.Make(nil, rttiType.Handle, Data);
// match the fields with the array elements
I := 0;
for recField in rttiType.GetFields do
begin
Instance := Data.GetReferenceToRawData;
try
jsonFieldVal := TJSONArray(JsonValue).Items[I];
except
on e:Exception do
if e is EArgumentOutOfRangeException then
continue
else
raise;
end;
// check for type reverter
ClassType := nil;
if recField.FieldType.IsInstance then
ClassType := recField.FieldType.AsInstance.MetaclassType;
if (ClassType <> nil) then
begin
if HasReverter(ClassType, FIELD_ANY) then
RevertType(recField, Instance,
Reverter(ClassType, FIELD_ANY),
jsonFieldVal)
else
begin
attrRev := FieldTypeReverter(recField.FieldType);
if attrRev = nil then
attrRev := FieldReverter(recField);
if attrRev <> nil then
try
RevertType(recField, Instance, attrRev, jsonFieldVal)
finally
attrRev.Free
end
else
recField.SetValue(Instance, JSONToTValue(jsonFieldVal,
recField.FieldType));
end
end
else
recField.SetValue(Instance, JSONToTValue(jsonFieldVal,
recField.FieldType));
Inc(I);
end;
Exit(Data);
end;
end;
end;
// transform value string into TValue based on type info
Exit(StringToTValue(Value, rttiType.Handle));
end;

Importing JSON into TFDMemTable

I'm attempting to import JSON from a TMemo to a TFDMemTable. Upon execution I get a "Exception EAccessViolation..." error. The line of code that appears to be causing the problem is FDMemTable1.FieldByName('userId').AsString := oProd.GetValue('PutRequest.Item.userId').Value; which is where I'm appending my first entry to the FDMemTable. I checked the JSON and it appears to be formatted correctly.
Here's my JSON array:
{"Jobs":[{"PutRequest":{"Item":{"userId":{"S":"1"},"WorkOrder":{"S":"29236"},"ServiceDate":{"S":"4/12/2019"}}}},{"PutRequest":{"Item":{"userId":{"S":"1"},"WorkOrder":{"S":"29237"},"ServiceDate":{"S":"4/12/2019"}}}}]}
Here's a snippet from my code:
uses
System.JSON;
procedure TForm1.FormCreate(Sender: TObject);
var
oJson: TJSONObject;
oArr: TJsonArray;
oPair: TJSONPair;
i: Integer;
oProd: TJSONObject;
begin
FDMemTable1.FieldDefs.Add('userId', ftString, 5);
FDMemTable1.FieldDefs.Add('WorkOrder', ftString, 5);
FDMemTable1.FieldDefs.Add('ServiceDate', ftString, 10);
FDMemTable1.Active := True;
oJson := TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(Memo1.Lines.Text), 0) as TJSONObject;
try
oArr := oJson.Get('Jobs').JsonValue as TJSONArray;
for i := 0 to oArr.Count - 1 do begin
oProd := oArr.Items[i] as TJSONObject;
FDMemTable1.Append;
FDMemTable1.FieldByName('userId').AsString := oProd.GetValue('PutRequest.Item.userId').Value;
FDMemTable1.FieldByName('WorkOrder').AsString := oProd.GetValue('PutRequest.Item.WorkOrder').Value;
FDMemTable1.FieldByName('ServiceDate').AsString := oProd.GetValue('PutRequest.Item.ServiceDate').Value;
FDMemTable1.Post;
end;
finally
oJson.Free;
end;
end;
I have checked the assignments and values of "oArr" and "oProd" and they appear correct. I'm guessing that I'm not addressing the JSON properly when I'm trying to assign the value to the FDMemTable. How do I resolve this?
You forgot to add
`FDMemTable1.CreateDataSet;`
under
FDMemTable1.FieldDefs.Add('ServiceDate', ftString, 10);
which means your dataSet Fields are not created yet and thus the call to
FDMemTable1.FieldByName('userId').AsString
will return nil and throw an EV when assigning to it
add that line and you are good to go
see this guide by Jim McKeeth (the code under the video) for proper way to use TMemTable and what it can do.

Delphi FDQuery to Json

I'm trying to convert the result of my Sqlite query into a Json,
to use the same procedures I use with remote binding to Sql Server by php.
The code works, but do you think it's a better solution?
Anyone there do that?
function TLogin.RetornaRegistros(query:String): String;
var
FDQuery : TFDQuery;
field_name,nomeDaColuna,valorDaColuna : String;
I: Integer;
begin
FDQuery := TFDQuery.Create(nil);
try
FDQuery.Connection := FDConnection1;
FDQuery.SQL.Text := query;
FDQuery.Active := True;
FDQuery.First;
result := '[';
while (not FDQuery.EOF) do
begin
result := result+'{';
for I := 0 to FDQuery.FieldDefs.Count-1 do
begin
nomeDaColuna := FDQuery.FieldDefs[I].Name;
valorDaColuna := FDQuery.FieldByName(nomeDaColuna).AsString;
result := result+'"'+nomeDaColuna+'":"'+valorDaColuna+'",';
end;
Delete(result, Length(Result), 1);
result := result+'},';
FDQuery.Next;
end;
FDQuery.Refresh;
Delete(result, Length(Result), 1);
result := result+']';
finally
FDQuery.Free;
end;
end;
That is not a good approach. I really suggest consider at least three options:
Use the power of System.JSON unit.
Uses {...} System.JSON;
Var
FDQuery : TFDQuery;
field_name,Columnname,ColumnValue : String;
I: Integer;
LJSONObject:TJsonObject;
begin
FDQuery := TFDQuery.Create(nil);
try
FDQuery.Connection := FDConnection1;
FDQuery.SQL.Text := query;
FDQuery.Active := True;
FdQuery.BeginBatch;//Don't update external references until EndBatch;
FDQuery.First;
LJSONObject:= TJSONObject.Create;
while (not FDQuery.EOF) do
begin
for I := 0 to FDQuery.FieldDefs.Count-1 do
begin
ColumnName := FDQuery.FieldDefs[I].Name;
ColumnValue := FDQuery.FieldByName(ColumnName).AsString;
LJSONObject.AddPair(TJSONPair.Create(TJSONString.Create( ColumnName),TJSONString.Create(ColumnValue)));
FDQuery.Next;
end;
//FDQuery.Refresh; that's wrong
FdQuery.EndBatch;
finally
FDQuery.Free;
Showmessage(LJSonObject.ToString);
end;
end;
https://www.youtube.com/watch?v=MLoeLpII9IE&t=715s
Second approach, use FDMemTable.SaveToStream;
The same works for FDMemTable.SaveToFile;
Put a TFDMemTable on Datamodule (Or form, as well).
fMStream:TMemoryStream;
Begin
FDQuery := TFDQuery.Create(nil);
try
FDQuery.Connection := FDConnection1;
FDQuery.SQL.Text := query;
FDQuery.Active := True;
//fdMemTable1.Data:=fdQuery.Data; {note *2}
fdMemTable1.CloneCursor(FdQuery,true,true);{note *3}
fMStream:=TMemoryStream.Create;
FdMemTable1.SaveToStream(fMStream,sfJson);
finally
FDQuery.Free;
FdMemTable.Close;
end;
Now you can Read the JSON content
For example, following answer Converting TMemoryStream to 'String' in Delphi 2009
function MemoryStreamToString(M: TMemoryStream): string;
begin
SetString(Result, PChar(M.Memory), M.Size div SizeOf(Char));
end;
and you have the json as String
The BatchMove suggeted by #VictoriaMarotoSilva
You can use BatchMove components, which provides an interface to move data between datasets, but it works better for backup and importation when you want to save data in drive, XML or json format. I didn't find examples yet, using data moving in memory; if somebody else has an example, please comment.
Notes
Using FdMemTable, don't forget drag TFDStanStorageJSONLink component for datamodule
method .Data just works for FiredacDatasets (Datasets with prefix FD).
To assign data for memTable in old Datasets use method .Copydata instead.
Sorry guys, I change .Data to .CloneCursor to share the same Memory Space with both datasets.
I just modified my first answer below to comport different type of field to convert number, date and boolean in appropriate json format.
I comment the Types I didn't test.
Look
Uses {...} System.JSON;
Var
FDQuery : TFDQuery;
field_name, Columnname, ColumnValue : String;
I: Integer;
LJSONObject:TJsonObject;
begin
FDQuery := TFDQuery.Create(nil);
try
FDQuery.Connection := FDConnection1;
FDQuery.SQL.Text := query;
FDQuery.Active := True;
FdQuery.BeginBatch;//Don't update external references until EndBatch;
FDQuery.First;
LJSONObject:= TJSONObject.Create;
while (not FDQuery.EOF) do
begin
for I := 0 to FDQuery.FieldDefs.Count-1 do
begin
ColumnName := FDQuery.FieldDefs[I].Name;
Case FDQuery.FieldDefs[I].Datatype of
ftBoolean:
IF FDQuery.FieldDefs[I].Value=True then LJSONObject.AddPair(TJSONPair.Create(TJSONString.Create( ColumnName),TJSONTrue.Create)) else
LJSONObject.AddPair(TJSONPair.Create(TJSONString.Create( ColumnName),TJSONFalse.Create));
ftInteger,ftFloat{,ftSmallint,ftWord,ftCurrency} :
LJSONObject.AddPair(TJSONPair.Create(TJSONString.Create( ColumnName),TJSONNumber.Create(FDQuery.FieldDefs[I].value)));
ftDate,ftDatetime,ftTime:
LJSONObject.AddPair(TJSONPair.Create(TJSONString.Create( ColumnName),TJSONString.Create(FDQuery.FieldDefs[I].AsString)));
//or TJSONString.Create(formatDateTime('dd/mm/yyyy',FDQuery.FieldDefs[I].Value));
else LJSONObject.AddPair(TJSONPair.Create(TJSONString.Create( ColumnName),TJSONString.Create(FDQuery.FieldDefs[I].AsString)));
End;
FDQuery.Next;
end;
FdQuery.EndBatch;
finally
FDQuery.Free;
Showmessage(LJSonObject.ToString);
end;
end;
More about dataset.DataType http://docs.embarcadero.com/products/rad_studio/delphiAndcpp2009/HelpUpdate2/EN/html/delphivclwin32/DB_TFieldType.html
More about JSONTypes https://community.embarcadero.com/blogs/entry/json-types-for-server-methods-in-datasnap-2010-4
Consider using TFDBatchMove component. It's for direct transferring of data between two databases with additional mappings support. As a source and target can be a text, dataset or an SQL query to any of the FireDAC's supported database engines.
The Delphi MVC Framework contains a powerful mapper to map json to objects and datasets to objects. The Mapper is a sub project. It's independent code that can also be used in other kind of projects. It is open-source!
Advantage is that boolean values for example, are converted to TJSONBool type and not a string. I suggest take a look at the samples.
https://github.com/danieleteti/delphimvcframework/tree/master/samples/objectsmapperssamples
Probably not the best solution, and you can modify this to how you would like the JSON to be formatted... here is a quick sample solution:
function GetDataSetAsJSON(DataSet: TDataSet): TJSONObject;
var
f: TField;
o: TJSOnObject;
a: TJSONArray;
begin
a := TJSONArray.Create;
DataSet.Active := True;
DataSet.First;
while not DataSet.EOF do begin
o := TJSOnObject.Create;
for f in DataSet.Fields do
o.AddPair(f.FieldName, VarToStr(f.Value));
a.AddElement(o);
DataSet.Next;
end;
DataSet.Active := False;
Result := TJSONObject.Create;
Result.AddPair(DataSet.Name, a);
end;

Json Array into ListBox/Memo in Delphi xe7

I'm trying to catch the following JSON array :
[{"name":"Bryan","email":"Bryan#hotmail.com"},
{"name":"Louis","email":"Louis#hotmail.com"},
{"name":"Maria","email":"Maria#hotmail.com"},
{"name":"Test","email":"test#hotmail.com"},
{"name":"Anthony","email":"anthony#hotmail.com"}]
and put it in Memo or ListBox in Delphi :
the code is the following :
procedure TForm1.Button1Click(Sender: TObject);
var jv: TJSONValue;
jo: TJSONObject;
jp: TJSONPair;
ja: TJSONArray;
i: integer;
j: integer;
begin
RESTRequest1.Execute;
jv:=RESTResponse1.JSONValue;
jo:= TJSONObject.ParseJSONValue(jv.ToString) as TJSONObject;
try
for i := 0 to jo.Size - 1 do
begin
jp := jo.Get(i);
if jp.JsonValue is TJSONArray then
begin
ja := jp.JsonValue as TJSONArray;
for j := 0 to ja.Size -1 do
Memo1.Lines.Add(ja.Get(i).ClassName + ': ' + ja.Get(j).ToString);
end
else
Memo1.Lines.Add(jp.ClassName + ': '+ jp.ToString);
end;
finally
jo.Free;
end;
end;
When I click in Button I got the following error message :
Invalid class typecast
during debugging the following line has a problem :
jo:= TJSONObject.ParseJSONValue(jv.ToString) as TJSONObject;
I don't know how to resolve this problem or this mistake ,
Could you please help me ?
Thanks.
This could perfectly well be worked out by reading the code and looking at the JSON. However, I'd like to show you how to go about debugging such a problem in case you cannot work it out by static analysis. When an as cast fails that is always because the object on the left hand side of the as does not derive from the type on the right hand side. The next step then is always to inquire as to what the type of the object on the left hand side is. I've included a short MCVE above as a means to demonstrate.
The output of this program:
{$APPTYPE CONSOLE}
uses
System.JSON;
const
JSON = '[{"name":"Bryan","email":"Bryan#hotmail.com"},' +
' {"name":"Louis","email":"Louis#hotmail.com"},' +
' {"name":"Maria","email":"Maria#hotmail.com"},' +
' {"name":"Test","email":"test#hotmail.com"},' +
' {"name":"Anthony","email":"anthony#hotmail.com"}]';
begin
Writeln(TJSONObject.ParseJSONValue(JSON).ClassName);
end.
is
TJSONArray
Now, TJSONArray does not derive from TJSONObject. Hence your as cast raise a runtime error. If you cast the value returned by ParseJSONValue to TJSONArray that will succeed.
This is to be expected since the root of your JSON is an array and is not an object.
You need to modify your code so that it does not assume that the root level is always an object. You need different behaviour for arrays and objects.
I'm not sure what the problem of TJSONObject is with the string you posted.
For some reason it will parse it if you changed it.
{"Persons":[{"name":"Bryan","email":"Bryan#hotmail.com"},{"name":"Louis","email":"Louis#hotmail.com"},{"name":"Maria","email":"Maria#hotmail.com"},{"name":"Test","email":"test#hotmail.com"},{"name":"Anthony","email":"anthony#hotmail.com"}]}
If I run the code as it is I get the following result
If you don't mind using something different than default Delphi units I would suggest superobject (Link here)
superobject will parse your JSON edited and as posted.
Your code would look like this:
Const
MyJSON = '[{"name":"Bryan","email":"Bryan#hotmail.com"},{"name":"Louis","email":"Louis#hotmail.com"},{"name":"Maria","email":"Maria#hotmail.com"},{"name":"Test","email":"test#hotmail.com"},{"name":"Anthony","email":"anthony#hotmail.com"}]';
procedure ParseJSON;
var
obj: ISuperObject;
Ar: TSuperArray;
I: integer;
begin
obj := SO(MyJSON);
if obj.IsType(stArray) then
begin
Ar := obj.AsArray;
try
for I := 0 to Ar.Length-1 do
L.Add(Ar.O[I].AsString);
finally
Ar.Free;
end;
end
else
L.Add(Obj.AsString);
end;
Result:
For Koul, to get the element names and values.
Like I said not very pretty code but ok.
Ar.O[0].AsObject.GetNames.AsArray.S[0]
To cut it up in pieces a bit.
Ar.O[0] //Get the first element in the array as ISuperObject
.AsObject //Get it as TSuperTableString
.GetNames //Gets all names in the array, in this case "name" and "email"
.AsArray[0]//Get the first name in the names array.
It will result in email (Names are sorted A-Z)
You can do the same for the values by calling GetValues instead of GetNames.
I think the prettiest way to get it will be defining 2x more TSuperArray
procedure PrintNamesAndValues;
Var
Ar, ArNames, ArValues:TSuperArray;
I: Integer;
begin
Ar := SO(<JSON string>).asArray;
ArNames := Ar.O[0].AsObject.GetNames.AsArray;
ArValues := Ar.O[0].AsObject.GetValues.AsArray;
For I := 0 to ArNames.Length-1 do
WriteLn(Format('%s: %s',[ArNames.S[I], ArValues.S[I]]));
end;
Hope it's all clear enough :)

How do I obtain a reference to the object or its data from my external viewer debugger visualizer?

I am trying to write a debugger visualizer for a TJSONObject or a TJSONValue. I have most of the visualizer working nicely. The problem I am having is getting a reference to the TJSONObject, or at least to the tostring() value of the TJSONObject.
According to the samples I've seen, as well as the nice post by Jeremy North at http://edn.embarcadero.com/article/40268, I should get what I need from the Show method of my IOTADebuggerVisualizerExternalViewer implementation. Specifically, from the Expression, TypeName, and EvalResult string parameters.
From what I understand, Expression is the name of variable being inspected (visualized), TypeName is the classname of the variable, and EvalResult is the default string representation of the variable.
For a simple test I placed a TMemo on my TFrame descendant. From the IOTADebuggerVisualizerExternalViewer.Show method I call the ShowJSONObject method of my TFrame, to which I pass Expression, TypeName, and EvalResult. The relevant code appears here:
function TDebuggerJSONVisualizer.Show(const Expression, TypeName, EvalResult: string;
SuggestedLeft, SuggestedTop: Integer):
IOTADebuggerVisualizerExternalViewerUpdater;
var
AForm: TCustomForm;
AFrame: TJSONViewerFrame;
VisDockForm: INTACustomDockableForm;
begin
VisDockForm := TJSONVisualizerForm.Create(Expression) as INTACustomDockableForm;
AForm := (BorlandIDEServices as INTAServices).CreateDockableForm(VisDockForm);
AForm.Left := SuggestedLeft;
AForm.Top := SuggestedTop;
(VisDockForm as IFrameFormHelper).SetForm(AForm);
AFrame := (VisDockForm as IFrameFormHelper).GetFrame as TJSONViewerFrame;
AFrame.ShowJSONObject(Expression, TypeName, EvalResult);
Result := AFrame as IOTADebuggerVisualizerExternalViewerUpdater;
end;
{ TStringListViewerFrame }
procedure TJSONViewerFrame.ShowJSONObject(const Expression, TypeName,
EvalResult: string);
begin
Memo1.Lines.Add(Expression);
Memo1.Lines.Add(TypeName);
Memo1.Lines.Add(EvalResult);
end;
As you can see, I at this point I am only trying to display the values of these three parameters from my ShowJSONObject method.
Here is a simple TJSONObject that I tried to display using the visualizer:
var
jo: TJSONObject;
begin
jo := TJSONObject.Create;
jo.AddPair('one', 'one');
jo.AddPair('two', TJSONNumber.Create(1)); //a breakpoint here
The result looks like this:
I was hoping that EvalResult would return the tostring representation of the TJSONObject, but it only returned the uninformative (), which is the same thing you see by default in the local variables window.
How do I get either the tostring representation of the TJSONObject for which the visualizer was invoked or a handle to the actual object, so I can deconstruct and display its value?
You need to evaluate your expression (including ToString call) using this procedure (just copied from my own visualizer source so it could use some local variables that are not declared here):
function TJSONViewerFrame.Evaluate(Expression: string): string;
var
CurProcess: IOTAProcess;
CurThread: IOTAThread;
ResultStr: array[0..4095] of Char;
CanModify: Boolean;
ResultAddr, ResultSize, ResultVal: LongWord;
EvalRes: TOTAEvaluateResult;
DebugSvcs: IOTADebuggerServices;
begin
begin
Result := '';
if Supports(BorlandIDEServices, IOTADebuggerServices, DebugSvcs) then
CurProcess := DebugSvcs.CurrentProcess;
if CurProcess <> nil then
begin
CurThread := CurProcess.CurrentThread;
if CurThread <> nil then
begin
EvalRes := CurThread.Evaluate(Expression, #ResultStr, Length(ResultStr),
CanModify, eseAll, '', ResultAddr, ResultSize, ResultVal, '', 0);
case EvalRes of
erOK: Result := ResultStr;
erDeferred:
begin
FCompleted := False;
FDeferredResult := '';
FDeferredError := False;
FNotifierIndex := CurThread.AddNotifier(Self);
while not FCompleted do
DebugSvcs.ProcessDebugEvents;
CurThread.RemoveNotifier(FNotifierIndex);
FNotifierIndex := -1;
if not FDeferredError then
begin
if FDeferredResult <> '' then
Result := FDeferredResult
else
Result := ResultStr;
end;
end;
erBusy:
begin
DebugSvcs.ProcessDebugEvents;
Result := Evaluate(Expression);
end;
end;
end;
end;
end;
end;
So now you can replace your Show function with something like this:
AFrame.ShowJSONObject(Expression, TypeName, Evaluate(Expression + '.ToString'));