Delphi XE6 FireDAC - Export TFDQuery recordset to JSON - json

I'm using FireDAC in Delphi XE6 to query a database (Pervasive) through ODBC. I have a TFDQuery component which runs my SELECT query and returns the records. Once the query is complete I want to export the data in the recordset as JSON. I've tried using the following code :
fdacQuery.SaveToStream(myStream, sfJSON);
This creates JSON, but only for the table definition i.e. field names, data types, constraints etc. - there is no representation of the data. Is there another method I should be using to export just the recordset data as JSON? Is there another solution?

Try this on for size then. I did it for a utility I needed yesterday. It uses SuperObject. I left all field types in the code in case you want to add other special treatments or tweak any of those I put in. It's working for me on many random datasets right now.
class procedure TTool.ExportDataSetToJson(DataSet: TDataSet; FileName: string; Append: boolean = false);
const
SData = 'data';
var
json : ISuperObject;
item : ISuperObject;
wasActive: boolean;
fld : TField;
begin
json := SO;
json.O[SData] := SA([]);
wasActive := DataSet.Active;
try
DataSet.Active := true;
DataSet.First;
while not DataSet.Eof do
begin
item := SO;
for fld in DataSet.Fields do
begin
case fld.DataType of
// ftUnknown: ;
ftString,
ftBlob,
ftMemo,
ftFmtMemo,
ftBytes,
ftVarBytes,
ftFixedChar,
ftFixedWideChar,
ftWideMemo,
ftByte,
ftWideString: item.S[fld.FieldName] := fld.AsString;
ftBoolean: item.B[fld.FieldName] := fld.AsBoolean;
ftFloat,
ftSingle,
ftExtended,
ftCurrency,
ftFMTBcd,
ftBCD: item.D[fld.FieldName] := fld.AsFloat;
ftTime : item.S[fld.FieldName] := TimeToJson(fld.AsDateTime);
ftDate,
ftTimeStamp,
ftOraTimeStamp,
ftDateTime: item.S[fld.FieldName] := DateTimeToJson(fld.AsDateTime);
ftSmallint,
ftInteger,
ftWord,
ftAutoInc,
ftLongWord,
ftShortint,
ftLargeInt: item.I[fld.FieldName] := fld.AsLargeInt;
// ftGraphic: ;
// ftParadoxOle: ;
// ftDBaseOle: ;
// ftTypedBinary: ;
// ftCursor: ;
// ftADT: ;
// ftArray: ;
// ftReference: ;
// ftDataSet: ;
// ftOraBlob: ;
// ftOraClob: ;
// ftVariant: ;
// ftInterface: ;
// ftIDispatch: ;
ftGuid: item.S[fld.FieldName] := fld.AsString;
// ftOraInterval: ;
// ftConnection: ;
// ftParams: ;
// ftStream: ;
// ftTimeStampOffset: ;
// ftObject: ;
else
item.S[fld.FieldName] := fld.AsString;
end;
end;
DataSet.Next;
json.A[SData].Add(item);
end;
if Append then
TFile.AppendAllText(FileName, json.AsJSon(true, true))
else
json.SaveTo(FileName, true, true);
finally
DataSet.Active := wasActive;
end;
end;

Have you looked at the code in the tutorial at http://docwiki.embarcadero.com/RADStudio/XE8/en/Tutorial:_Using_a_REST_DataSnap_Server_with_an_Application_and_FireDAC yet?
// Create dataset list
Result := TFDJSONDataSets.Create;
// Add departments dataset
TFDJSONDataSetsWriter.ListAdd(Result, sDepartment, FDQueryDepartment);
// Add employees dataset
TFDJSONDataSetsWriter.ListAdd(Result, sEmployees, FDQueryDepartmentEmployees);

Related

How to solve: incompatible types "TJSONIterator" and "string"

Following the Readers and Writers JSON Framework (which reduces memory consumption), I tried to use a RESTful service to get data via HTTP.
But I get an error :
E2010 Incompatible types: 'TJSONIterator' and 'string'
on the line:
LJRates := LJIter.AsDouble.ToString;
Async.Run<TStringList>(function: TStringList
var
LHTTP: THTTPClient;
LResp: IHTTPResponse;
LJIter: TJSONIterator;
LJRates: TJSONIterator;
LJTextR: TJsonTextReader;
LStrR: TStringReader;
// LResult: Boolean;
I: Integer;
begin
LHTTP := THTTPClient.Create;
try
LResp := LHTTP.Get('http://api.fixer.io/latest');
{$REGION 'check for errors'}
if LResp.StatusCode = 200 then
begin
// LResult := not LResp.ContentAsString(TEncoding.UTF8).IsEmpty
// or
// LStrR := TJSONObject.ParseJSONValue(LResp.ContentAsString(TEncoding.UTF8)) as TJSONObject;
// or
// LStrR := LResp.ContentAsString(TEncoding.UTF8);
// or
LStrR := TStringReader.Create(LResp.ContentAsString(TEncoding.UTF8));
end else
begin
raise Exception.CreateFmt('Cannot get rates. HTTP %d - %s', [LResp.StatusCode, LResp.StatusText]);
end;
{$ENDREGION}
LJTextR := TJsonTextReader.Create(LStrR);
LJIter := TJSONIterator.Create(LJTextR);
try
// gets the json object 'rates' and
LJIter.Recurse; // prepare to enter object
while LJIter.Next do;
begin
LJIter.Recurse; // enter object
LJIter.Next('rates');
LJRates := LJIter.AsDouble.ToString;
Result := TStringList.Create;
// loop through the property names
for I := 0 to LJRates.Depth - 1 do
begin
//add each names in the resulting TStringList
Result.Add(LJRates.Path[I]);
end;
Result.Sort;
end;
finally
LJIter.Free;
end;
finally
LHTTP.Free;
end;
end,
What is the correct way to iterates through the JSON, reading the content, and displaying the rate values?

Delphi JsonTextReader fails to read values

I have a very weird situation.
This is the JSON I am trying to parse:
[
{
"username":"xxx",
"email":"xxx#gmail.com",
"custom_title":"xxx title",
"timezone":"Africa\/Cairo",
"message_count":"218",
"alerts_unread":"0",
"like_count":"385",
"friend_count":"0"
}
]
This is my parsing code:
type
TUserData = record
email, timezone: string;
msg, alerts, likes: integer;
end;
procedure TDMRest.parseData(var b: TUserData);
var
jtr: TJsonTextReader;
sr: TStringReader;
begin
//RESTResponseLogin.Content has the above json text
sr := TStringReader.Create(RESTResponseLogin.Content);
try
jtr := TJsonTextReader.Create(sr);
try
while jtr.Read do
begin
if jtr.TokenType = TJsonToken.StartObject then
process(b, jtr);
end;
finally
jtr.Free;
end;
finally
sr.Free;
end;
end;
//here there is a problem
procedure TDMRest.process(var c: TUserData; jtr: TJsonTextReader);
begin
while jtr.Read do
begin
if (jtr.TokenType = TJsonToken.PropertyName) then
begin
if jtr.Value.ToString = 'email' then
begin
jtr.Read;
c.email := jtr.Value.AsString;
end;
if jtr.Value.ToString = 'timezone' then
begin
jtr.Read;
c.timezone := jtr.Value.AsString;
end;
if jtr.Value.ToString = 'message_count' then
begin
jtr.Read;
c.msg := jtr.Value.AsInteger;
end;
if jtr.TokenType = TJsonToken.EndObject then
begin
c.alerts := 0;
c.likes := 0;
exit;
end;
end;
end;
end;
MY PROBLEM: In the process() code, the first 2 if blocks (email and timezone) can read values into my record. But when I add other if blocks (like if jtr.Value.ToString = 'message_count' then), I cannot see the values of my record anymore.
Am I parsing the data properly?
Basically, I need to grab the info from a JSON string and put the data inside a TUserData record.
I have found the above pattern in a book titled "Expert Delphi", and I am pretty sure that the parseData() function is correct. Probably I am missing something in the process.
The TDMRrst is a DataModule; I am giving the function a record, and I'd like the data to be properly parsed.
What is wrong here?
In the JSON you have shown, all of the values are strings, there are no integers. So, when you call jtr.Value.AsInteger for the message_count value, it raises a conversion exception that you are not catching. TValue.AsInteger DOES NOT perform an implicit conversion from string to integer for you.
You will have to use jtr.Value.AsString instead and convert the string to an integer using StrToInt():
if jtr.Value.ToString = 'message_count' then
begin
jtr.Read;
//c.msg := jtr.Value.AsInteger;
c.msg := StrToInt(jtr.Value.AsString);
end;
Do the same for the other "integer" values in the JSON (alerts_unread, like_count, and friend_count).

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;

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

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.

How to convert bitmap images stored in a MySQL table to JPEG format?

I have a MySQL table that stores bitmap images and I want to convert them to JPEG format to the same table. Can anyone help me to find a solution ?
I need this to reduce the size of the table...
When you'd use ADO to access your MySQL database, it might look like this (it's untested). This code assumes you have the table you want to work with named as YourTable and the BLOB field you want to convert the images from as ImageField. Note you have to specify the connection string to your DB in the ConnectionString property of the ADOConnection object:
uses
DB, ADODB, JPEG;
procedure ConvertImage(BlobField: TBlobField);
var
BMPImage: TBitmap;
JPEGImage: TJPEGImage;
MemoryStream: TMemoryStream;
begin
MemoryStream := TMemoryStream.Create;
try
BlobField.SaveToStream(MemoryStream);
BMPImage := TBitmap.Create;
try
MemoryStream.Position := 0;
BMPImage.LoadFromStream(MemoryStream);
JPEGImage := TJPEGImage.Create;
try
JPEGImage.Assign(BMPImage);
MemoryStream.Position := 0;
JPEGImage.SaveToStream(MemoryStream);
finally
JPEGImage.Free;
end;
finally
BMPImage.Free;
end;
MemoryStream.Position := 0;
BlobField.LoadFromStream(MemoryStream);
finally
MemoryStream.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
ADOTable: TADOTable;
ADOConnection: TADOConnection;
begin
ADOConnection := TADOConnection.Create(nil);
try
ADOConnection.LoginPrompt := False;
// here you have to specify the connection string to your database
// according to your connection parameters
ADOConnection.ConnectionString := '<enter your connection string here>';
ADOConnection.Open;
if ADOConnection.Connected then
begin
ADOTable := TADOTable.Create(nil);
try
ADOTable.Connection := ADOConnection;
ADOTable.TableName := 'YourTable';
ADOTable.Filter := 'ImageField IS NOT NULL';
ADOTable.Filtered := True;
ADOTable.CursorType := ctOpenForwardOnly;
ADOTable.Open;
ADOTable.First;
while not ADOTable.Eof do
begin
ADOTable.Edit;
ConvertImage(TBlobField(ADOTable.FieldByName('ImageField')));
ADOTable.Post;
ADOTable.Next;
end;
finally
ADOTable.Free;
end;
end;
finally
ADOConnection.Free;
end;
end;