Delphi JSON superobject saving multiple objects to file in alphabetical order - json

I'm using the JSON superobject library to save objects to a file. When my code worked, they were written with proper formatting.
procedure TDCell.Save(fileName: string);
var i,j : integer;
JsonObjCol1, JsonObjCol2, JsonObjCol3, JsonObjCol4: ISuperObject;
begin
JsonArray := SO();
JsonObjCol1 := SO();
JsonObjCol2 := SO();
JsonObjCol3 := SO();
JsonObjCol4 := SO();
for i := 0 to Table.ColCount - 1 do
begin
for j := 0 to Table.RowCount - 1 do
begin
if Table.Objects[i, j] is TEdit then
with Table.Objects[i, j] as TEdit do
case i of
0:JsonArray[Name] := SO(Table.Cells[i, j]);
1:JsonObjCol1[Name] := SO(Table.Cells[i, j]);
2:JsonObjCol2[Name] := SO(Table.Cells[i, j]);
3:JsonObjCol3[Name] := SO(Table.Cells[i, j]);
4:JsonObjCol4[Name] := SO(Table.Cells[i, j]);
end
else
if Table.Objects[i, j] is TLabel then
with Table.Objects[i, j] as TLabel do
case i of
0:JsonArray[Name] := SO(Caption);
1:JsonObjCol1[Name] := SO(Caption);
2:JsonObjCol2[Name] := SO(Caption);
3:JsonObjCol3[Name] := SO(Caption);
4:JsonObjCol4[Name] := SO(Caption);
end
end;
case i of
0:JsonObject['Col' + IntToStr(Table.ColCount - 1 - i)] := JsonArray;
1:JsonObject['Col' + IntToStr(Table.ColCount - 1 - i)] := JsonObjCol1;
2:JsonObject['Col' + IntToStr(Table.ColCount - 1 - i)] := JsonObjCol2;
3:JsonObject['Col' + IntToStr(Table.ColCount - 1 - i)] := JsonObjCol3;
4:JsonObject['Col' + IntToStr(Table.ColCount - 1 - i)] := JsonObjCol4;
end;
end;
JsonObject.SaveTo(fileName, true);
end;
JsonArray also has type ISuperObject
But it seems that there is some opposite order sorting feature running in this library. Not only objects but also key-value pairs in them are written in opposite alphabetical order.
{
"Col4": {
"Label03": "Hello03",
"Label01": "Hello01",
"Edit04": "Hello04",
"Edit02": "Hello02",
"Edit00": "Hello00"
},
"Col3": {
"Label13": "Hello13",
"Label11": "Hello11",
"Edit14": "Hello14",
"Edit12": "Hello12",
"Edit10": "Hello10"
},
"Col2": {
"Label23": "Hello23",
"Label21": "Hello21",
"Edit24": "Hello24",
"Edit22": "Hello22",
"Edit20": "Hello20"
},
"Col1": {
"Label33": "Hello33",
"Label31": "Hello31",
"Edit34": "Hello34",
"Edit32": "Hello32",
"Edit30": "Hello30"
},
"Col0": {
"Label43": "Hello43",
"Label41": "Hello41",
"Edit44": "Hello44",
"Edit42": "Hello42",
"Edit40": "Hello40"
}
}
What should I do to make superobject write the file in the proper order? I've tested that objects are added in the proper order in cycles. The file must look like this.
{
"Col0": {
"Edit00": "Hello00",
"Label01": "Hello01",
"Edit02": "Hello02",
"Label03": "Hello03",
"Edit04": "Hello04"
},
"Col1": {
"Edit10": "Hello10",
"Label11": "Hello11",
"Edit12": "Hello12",
"Label13": "Hello13",
"Edit14": "Hello14"
},
and so on

There is no proper order. The elements of a JSON object can be presented in any order, and the JSON standard makes it clear that the meaning of the file cannot depend on the order of the elements of a JSON object:
An object is an unordered set of name/value pairs.
If you require ordered data then you need to use a JSON array:
An array is an ordered collection of values.

Related

Why TFDBatchMove raises exception ELocalTimeInvalid for date field with value "03/11/2019"?

I'm using Delphi 10.3 Rio Update 1 on a Windows 7 SP1 machine.
My program's purpose is to convert a TFDMemtable into a JSON format. For a reason that I can't understand, when the date field of this TFDMemTable has the value '03/11/2019', using the DisplayFormat "day/month/year", it raises an exception:
Project ProjMemtabJSON.exe raised exception class ELocalTimeInvalid with message 'The given "03/11/2019" local time is invalid (situated within the missing period prior to DST).'.
Any other dates different than "Nov, 3rd 2019" work fine.
I have no clue what is going on here!
program ProjMemtabJSON;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
System.Classes,
System.JSON,
FireDAC.Comp.DataSet,
FireDAC.Comp.Client,
FireDAC.Comp.BatchMove,
FireDAC.Comp.BatchMove.DataSet,
FireDAC.Comp.BatchMove.JSON,
Data.DB;
Var
Fmemtable : TFDmemtable ;
FJSONArray : TJSONArray;
FDBatchMoveJSONWriter1 : TFDBatchMoveJSONWriter;
FDBatchMoveDataSetReader1 : TFDBatchMoveDataSetReader;
FDBatchMove1 : TFDBatchMove;
procedure CreateMemtable;
begin
Fmemtable := TFDmemtable.Create(nil);
FMemTable.FieldDefs.Add('ID', ftInteger, 0, False);
FMemTable.FieldDefs.Add('Name', ftString, 20, False);
FMemTable.FieldDefs.Add('Status', ftString, 20, False);
FMemTable.FieldDefs.Add('Duedate', ftdatetime,0, False);
FMemTable.CreateDataSet;
end;
procedure FillMemtable;
begin
FMemtable.Append;
FMemtable.Fields[0].Value := 10; // ID
FMemtable.Fields[1].Value := 'John'; // Name
FMemtable.Fields[2].Value := 'Active'; // Status
{ ==> HERE IS THE PROBLEM : change this date to 03/11/2019 i.e. 03/Nov/2019 and an error will raise }
FMemtable.Fields[3].Value := StrToDate('02/11/2019'); // Due date dd/mm/yyyy
end;
procedure PrintMemtable;
begin
writeln('ID : ' ,Fmemtable.Fields[0].AsString);
writeln('Name : ' ,Fmemtable.Fields[1].AsString);
writeln('Status : ' ,Fmemtable.Fields[2].AsString);
writeln('Due Date : ' ,Fmemtable.Fields[3].AsString);
end;
function TableToJson : TJSONArray;
begin
Result := TJSONArray.Create;
try
FDBatchMoveDataSetReader1 := TFDBatchMoveDataSetReader.Create(nil);
FDBatchMoveJSONWriter1 := TFDBatchMoveJSONWriter.Create(nil);
FDBatchMove1 := TFDBatchMove.Create(nil);
FDBatchMove1.Reader := FDBatchMoveDataSetReader1 ;
FDBatchMove1.Writer := FDBatchMoveJSONWriter1;
try
if not FMemtable.Active then
FMemtable.Active := True;
FDBatchMoveDataSetReader1.DataSet := FMemtable;
FDBatchMoveJSONWriter1.JsonArray := Result;
FDBatchMove1.Execute;
except
on E: Exception do
raise Exception.Create('Error Message: ' + E.Message);
end;
finally
FDBatchMoveDataSetReader1.Free;
FDBatchMoveJSONWriter1.Free;
FDBatchMove1.Free;
end;
end;
begin
try
{ TODO -oUser -cConsole Main : Insert code here }
Creatememtable;
FillMemtable;
PrintMemtable;
FJSONArray := TableToJSON;
readln;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
There is a System.DateUtils routine that can check for an invalid time:
TTimeZone.IsInvalidTime(const ADateTime : TDateTime) : Boolean;
If you add DateUtils to your Uses clause, then update your FillMemTable to something like:
procedure FillMemtable;
var MyDate : tDateTime;
begin
FMemtable.Append;
FMemtable.Fields[0].Value := 10; // ID
FMemtable.Fields[1].Value := 'John'; // Name
FMemtable.Fields[2].Value := 'Active'; // Status
{ ==> HERE IS THE PROBLEM : change this date to 03/11/2019 i.e. 03/Nov/2019 and an error will raise }
MyDate := StrToDate('03/11/2019');
if TTimeZone.local.IsInvalidTime(MyDate) then MyDate := MyDate + 0.5; //noon won't be invalid
FMemtable.Fields[3].Value := MyDate; // Due date dd/mm/yyyy
end;
Or, as mentioned in the comments, if you don't want the overhead of the IF statement, just force all dates to be noon.
I had never realized that there were time zones which switched to/from DST at midnight. Unfortunate, what with how Dates (without times) are defined.

PLSQL parse json list: JSON Scanner exception

I'm parsing a json feed but when I loop the json_list I get the following error:
ORA-20100: JSON Scanner exception # line: 1 column: 33086 - string ending not found
Looking at the feed I'm unable to find anything out of the ordinary. It started to make me wonder if there's a character limitation.
my code is pretty simple..here are the relevant parts:
DECLARE
a_list json_list;
v_list clob;
obj_ json;
.....
BEGIN
....
req := utl_http.begin_request (v_url,'GET');
res := utl_http.get_response (req);
utl_http.read_text(res, v_list);
a_list := json_list(v_list);
for i in 1 .. a_list.count loop
obj_ := json(a_list.get(i));
val_source := obj_.get('source');
val_date := obj_.get('date');
el_source := val_source.get_string;
el_date := val_date.get_string;
end loop;
...
END;
Is there anything that I'm doing wrong? Or any hints out there?
I figured it out....
I read the data into a buffer string and basically worked on the data by chunks and then appended it to a clob.
dbms_lob.createtemporary(p_res_clob, false);
req := utl_http.begin_request (v_url,'GET');
res := utl_http.get_response (req);
begin
-- process the request and get the response:
loop
utl_http.read_text(res,l_buffer,32000);
dbms_lob.writeappend(p_res_clob,length(l_buffer), l_buffer);
end loop;
end;
a_list := json_list(v_list);
for i in 1 .. a_list.count loop
obj_ := json(a_list.get(i));
val_source := obj_.get('source');
val_date := obj_.get('date');
el_source := val_source.get_string;
el_date := val_date.get_string;
end loop;
...
END;
Hope this helps someone who gets stumped :)

JSON returned by TIdHTTP cannot be decoded

I have the following code:
var
MemoryStream1: TMemoryStream;
IdHTTP1: TIdHTTP;
Bytes1: TBytes;
s1: string;
begin
IdHTTP1 := TIdHTTP.Create(nil);
MemoryStream1 := TMemoryStream.Create;
IdHTTP1.Get('https://restcountries.eu/rest/v2/all', MemoryStream1);
MemoryStream1.Position := 0;
MemoryStream1.SaveToFile('C:\Temp\MemoryStream1.txt');
MemoryStream1.Position := 0;
SetLength(Bytes1, MemoryStream1.Size);
MemoryStream1.Read(Bytes1[0], MemoryStream1.Size);
s1 := TEncoding.UTF8.GetString(Bytes1);
It fails at the last line with the message "no mapping for the unicode character in the target multi-byte code page exists"
However, I can see the returned JSON clearly in HttpAnalyzer.
The file 'C:\Temp\MemoryStream1.txt' starts with the hex '1F8B0800000000000003DC9BED6F1BB7' when I am expecting something corresponding to { - a left brace - as the first character
when I try
s1 := TEncoding.Unicode.GetString(Bytes1);
String s1 contains "Chinese" characters.
I worked it out. Apparently, the gzip is not decompressed. One must do it oneself. Here goes:
var
IdHTTP1: TIdHTTP;
a1: AnsiString;
s1: string;
MemoryStream1, MemoryStream2: TMemoryStream;
begin
Screen.Cursor := crHourGlass;
IdHTTP1 := TIdHTTP.Create(nil);
MemoryStream1 := TMemoryStream.Create;
MemoryStream2 := TMemoryStream.Create;
IdHTTP1.Get('https://restcountries.eu/rest/v2/all', MemoryStream1);
MemoryStream1.Position := 0;
IdCompressorZLib1.DecompressGZipStream(MemoryStream1, MemoryStream2);
FreeAndNil(MemoryStream1);
MemoryStream2.Position := 0;
SetLength(a1, MemoryStream2.Size);
MemoryStream2.Read(a1[1], MemoryStream2.Size);
// AnsiString a1 now contains the decompressed data

Can't deserialize valid JSON using system.json

I write some code (rest server) that produce for me data in JSON format. When I use it in PHP it works fine, JSON is valid, everything is ok. When I use it in Delphi nothing works.
When I search internet I found:
desearilizing JSON using SuperObject
but that method returns empty strings for me.
I want to use that JSON elements as array (eg. JSONValue.items[i]).
I'm using Delphi XE7 System.JSON and don't want to use superobject or any others libraries.
How use it as array?
I paste my code that generates JSON:
var
qry: TfdQuery;
FieldsObj: TJSONObject;
FieldNameArray: TJSONArray;
I: Integer;
DataObj: TJSONObject;
DataRows: TJSONArray;
RowFields: TJSONArray;
tablename:string;
begin
tablename:='produkt';
qry := TfdQuery.Create(Self);
qry.SQL.Text := 'select * from produkt where (id ='''+ProductID+''')';
qry.Connection := FDConnection1;
qry.Open;
FieldsObj := TJSONObject.Create;
FieldNameArray := TJSONArray.Create;
for I := 0 to qry.FieldCount - 1 do
FieldNameArray.Add(qry.Fields[I].FieldName);
FieldsObj.AddPair(TableName, FieldNameArray);
DataObj := TJSONObject.Create;
DataRows := TJSONArray.Create;
qry.First;
while not qry.Eof do
begin
RowFields := TJSONArray.Create;
for I := 0 to qry.FieldCount - 1 do
RowFields.Add(qry.Fields[I].AsString);
DataRows.Add(RowFields);
qry.Next;
end;
DataObj.AddPair('data', DataRows);
Result := TJSONArray.Create(FieldsObj, DataObj);
qry.Free;
And this is the result:
{
"ProductID": "1",
"result": [{
"produkt": ["id", "parent_id", "full_name", "opcja_1", "opcja_2", "opcja_3", "opcja_4", "opcja_5", "opcja_6", "opcja_7", "opcja_8", "opcja_9", "opcja_10", "opcja_11", "opcja_12", "field_address1", "field_address2", "quantity", "opis", "zdjecie1", "zdjecie2", "zdjecie3", "samples", "link_stable0", "link_stable1", "link_stable2", "price1", "price2", "price3"]
}, {
"data": [
["1", "1", "name", "1", "1", "1", "1", "0", "0", "0", "0", "0", "0", "0", "12", "10", "20", "1,2", "description of product", "http://www.vphosted.com/e6=0", "photo link2", "photo link 3", "sample project file link", "link option", "10", "link", "10", "link", "10"]
]
}]
}
This would produce JSON more in the format that I would expect:
var
qry: TfdQuery;
FieldsObj: TJSONObject;
//FieldNameArray: TJSONArray;
I: Integer;
DataObj: TJSONObject;
FieldObj: TJSONObject;
DataRows: TJSONArray;
RowFields: TJSONArray;
tablename:string;
begin
tablename:='produkt';
qry := TfdQuery.Create(Self);
qry.SQL.Text := 'select * from produkt where (id ='''+ProductID+''')';
qry.Connection := FDConnection1;
qry.Open;
FieldsObj := TJSONObject.Create;
//FieldNameArray := TJSONArray.Create;
//for I := 0 to qry.FieldCount - 1 do
// FieldNameArray.Add(qry.Fields[I].FieldName);
//FieldsObj.AddPair(TableName, FieldNameArray);
DataObj := TJSONObject.Create;
DataRows := TJSONArray.Create;
qry.First;
while not qry.Eof do
begin
RowFields := TJSONArray.Create;
for I := 0 to qry.FieldCount - 1 do
begin
FieldObj := TJSONObject.Create;
FieldObject.AddPair(qry.Fields[I].FieldName, qry.Fields[I].AsString));
RowFields.Add( FieldObj );
end;
DataRows.Add(RowFields);
qry.Next;
end;
DataObj.AddPair('data', DataRows);
Result := TJSONArray.Create(FieldsObj, DataObj);
qry.Free;
If you know the record structure, though, I would prefer to use REST.JSON, which I am pretty sure ships with XE7 and is much simpler to use. You just create your object structure, create an instance of that structure, populate it with your field values and use
TJSON.ObjectToJsonString( fObject )
to create your string and
iObject := TJSON.JsonToObject<TMyObject>( pTransferString );
to get your object back.
If you want a more complete example using this method, let me know and I will post.

Why does this operation break when turned into a function (AutoHotKey/AHK)

The following operation works correcting inside AHK. It replaces the word ted with the word tom inside an open word document.
Working Code
; Word Constants
vbTrue := -1
wdReplaceNone := 0
wdFindContinue := 1
return
#IfWinActive, ahk_exe WINWORD.EXE
^7::
try
oWord := ComObjActive("Word.Application")
catch
return
FindText := "ted"
ReplaceWith := "tom"
oFind := oWord.Selection.Find
oHyperlinks := oWord.ActiveDocument.Hyperlinks
oFind.ClearFormatting
oFind.Replacement.ClearFormatting
while oFind.Execute(FindText, vbTrue, false,,,,, wdFindContinue,,, wdReplaceNone)
oHyperlinks.Add(oWord.Selection.Range, "http://www.autohotkey.com",,, ReplaceWith)
return
However, when I turn this exact same code into a function it does not work. It does not work when written this way, and it also does not work even if the parameters are removed and the variables are put back into the script.
Broken Code (with parameters)
ReplaceAndLink(FindText, ReplaceWith)
{
; Word Constants
vbTrue := -1
wdReplaceNone := 0
wdFindContinue := 1
return
try
oWord := ComObjActive("Word.Application")
catch
return
oFind := oWord.Selection.Find
oHyperlinks := oWord.ActiveDocument.Hyperlinks
oFind.ClearFormatting
oFind.Replacement.ClearFormatting
while oFind.Execute(FindText, vbTrue, false,,,,, wdFindContinue,,, wdReplaceNone)
oHyperlinks.Add(oWord.Selection.Range, "http://www.autohotkey.com",,, ReplaceWith)
return
}
#IfWinActive, ahk_exe WINWORD.EXE
^7::
ReplaceAndLink("ted", "tom")
Broken Code (without parameters)
ReplaceAndLink(FindText, ReplaceWith)
{
; Word Constants
vbTrue := -1
wdReplaceNone := 0
wdFindContinue := 1
return
try
oWord := ComObjActive("Word.Application")
catch
return
FindText := "ted"
ReplaceWith := "tom"
oFind := oWord.Selection.Find
oHyperlinks := oWord.ActiveDocument.Hyperlinks
oFind.ClearFormatting
oFind.Replacement.ClearFormatting
while oFind.Execute(FindText, vbTrue, false,,,,, wdFindContinue,,, wdReplaceNone)
oHyperlinks.Add(oWord.Selection.Range, "http://www.autohotkey.com",,, ReplaceWith)
return
}
#IfWinActive, ahk_exe WINWORD.EXE
^7::
ReplaceAndLink()
Troubleshooting Notes:
Word is open during both operations
I am using the newest version of AHK
I have tried running the broken one on a clean restart
No special libraries or other AHK scripts are running
Also... I know that similar COM based AHK scripts can be placed into functions... see for example:
LinkCreator(FindText, ReplaceWith)
{
oWord := ComObjActive("Word.Application")
oWord.Selection.Find.ClearFormatting
oWord.Selection.Find.Replacement.ClearFormatting
oWord.Selection.Find.Execute(FindText, 0, 0, 0, 0, 0, 1, 1, 0, ReplaceWith, 2)
}
F2::
LinkCreator("store", "town")
You're calling return before the function can finish. This causes the script to stop processing that function and return to the caller.
ReplaceAndLink(FindText, ReplaceWith)
{
; Word Constants
vbTrue := -1
wdReplaceNone := 0
wdFindContinue := 1
return <---------- HERE
try
oWord := ComObjActive("Word.Application")
catch
return
Try removing that and it should execute as expected.
A simple troubleshooting tip for when something isn't executing is to place a Soundbeep or MsgBox somewhere in the code to see if you have some unreachable code and work backwards from there.