TFDMemTable lost/clearing data after filtering - delphi

I have created a FDMemTable with following structure:
Cds_NaMenu := TFDMemTable.Create(nil);
Cds_NaMenu.FieldDefs.Add('ID', ftInteger);
Cds_NaMenu.FieldDefs.Add('MN_TELA_CODIGO', ftInteger);
Cds_NaMenu.FieldDefs.Add('MN_MENU_PESQUISA', ftString, 500);
Cds_NaMenu.FieldDefs.Add('DISPONIBILIDADE', ftInteger);
Cds_NaMenu.IndexDefs.Add('Ordem', 'MN_TELA_CODIGO', []);
Cds_NaMenu.CreateDataSet;
Cds_NaMenu.LogChanges := False;
Cds_NaMenu.IndexName := 'Ordem';
I put data in TFDMemTable like this:
Cds_NaMenu.Append;
Cds_NaMenu.FieldByName('DISPONIBILIDADE').AsInteger := 1;
Cds_NaMenu.Post;
Well... The problem ocurrs when a set filtered property to True and back to False. The RecordCount property goes to 0; None data has found in, even I use saveToFile procedure. Aparently the data was losted.
_recCount := Cds_NaMenu.RecordCount; // Result = 867;
Cds_NaMenu.Filter := 'DISPONIBILIDADE=1 AND MN_MENU_PESQUISA like ' + QuotedStr('%' + sTexto + '%');
Cds_NaMenu.Filtered := True;
_recCount := Cds_NaMenu.RecordCount; // Result = 0;
Cds_NaMenu.Filtered := False;
Cds_NaMenu.Filter := '';
_recCount := Cds_NaMenu.RecordCount; // Result = 0;
PS: With ClientDataSet, this code works perfectly

If you're working with a pure memory table, there should not be any problem to query record count by the RecordCount property. Maybe you expect having NULL and empty value records included in a filtered view when having filter Value LIKE '%%', but it's not so. When having dataset like this:
ID | Value
1 | NULL
2 | ''
3 | 'Some text'
And applying filter like this:
var
S: string;
begin
S := '';
FDMemTable.Filtered := False;
FDMemTable.Filter := 'Value LIKE ' + QuotedStr('%' + S + '%');
FDMemTable.Filtered := True;
{ ← FDMemTable.RecordCount should be 1 here for the above dataset }
end;
The empty and NULL value records should not be included in the view. Here is a short proof:
var
S: string;
MemTable: TFDMemTable;
begin
MemTable := TFDMemTable.Create(nil);
try
MemTable.FieldDefs.Add('ID', ftInteger);
MemTable.FieldDefs.Add('Value', ftString, 500);
MemTable.IndexDefs.Add('PK_ID', 'ID', [ixPrimary]);
MemTable.CreateDataSet;
MemTable.AppendRecord([1, NULL]);
MemTable.AppendRecord([2, '']);
MemTable.AppendRecord([3, 'Some text']);
S := '';
MemTable.Filtered := False;
MemTable.Filter := 'Value LIKE ' + QuotedStr('%' + S + '%');
ShowMessage(Format('Total count: %d', [MemTable.RecordCount])); { ← should be 3 }
MemTable.Filtered := True;
ShowMessage(Format('Filtered count: %d', [MemTable.RecordCount])); { ← should be 1 }
MemTable.Filtered := False;
ShowMessage(Format('Total count: %d', [MemTable.RecordCount])); { ← should be 3 }
finally
MemTable.Free;
end;
end;

I think this is just a minor FD quirk. The code below works as expected, with Cds_NaMenu declared as a TFDMemTable (though it would have been nice if you could have dropped the Cds_ to avoid confusion).
The key difference, I think, is the call to .Locate after the filter is cleared. The reason I put it there is because it causes the dataset to scroll and, I imagine, to recalculate its RecordCount as a result. Probably any other operation which causes a scroll would have the same effect, even MoveBy(0) - try it.
procedure TForm1.FormCreate(Sender: TObject);
var
_recCount : Integer;
ID : Integer;
sTexto : String;
begin
sTexto := 'xxx'; // added
Cds_NaMenu.FieldDefs.Add('ID', ftInteger);
Cds_NaMenu.FieldDefs.Add('MN_TELA_CODIGO', ftInteger);
Cds_NaMenu.FieldDefs.Add('MN_MENU_PESQUISA', ftString, 500);
Cds_NaMenu.FieldDefs.Add('DISPONIBILIDADE', ftInteger);
Cds_NaMenu.IndexDefs.Add('Ordem', 'MN_TELA_CODIGO', []);
Cds_NaMenu.CreateDataSet;
Cds_NaMenu.LogChanges := False;
Cds_NaMenu.IndexName := 'Ordem';
Cds_NaMenu.Append;
Cds_NaMenu.FieldByName('ID').AsInteger := 666; // added
Cds_NaMenu.FieldByName('DISPONIBILIDADE').AsInteger := 1;
Cds_NaMenu.Post;
_recCount := Cds_NaMenu.RecordCount; // Result = 1
ID := Cds_NaMenu.FieldByName('ID').AsInteger; // added
Cds_NaMenu.Filter := 'DISPONIBILIDADE=1 AND MN_MENU_PESQUISA like ' + QuotedStr('%' + sTexto + '%');
Cds_NaMenu.Filtered := True;
_recCount := Cds_NaMenu.RecordCount; // Result = 0;
Cds_NaMenu.Filtered := False;
Cds_NaMenu.Filter := '';
// Now force the dataset to scroll
if Cds_NaMenu.Locate('ID', ID, []) then; // added
_recCount := Cds_NaMenu.RecordCount; // Result = 1;
Caption := IntToStr(_recCount); // added
end;

Related

How to fill TListView with TJSONIterator.Next?

I have an app with a TListView and I want to populate data from JSON inside its Items by using TJSONIterator.Next(). The code I use displays the results I want, except for the first one.
How can I parse these JSON objects correctly, what am I doing wrong?
Data: Data.json
{
"event":"subscribe-status",
"status":"ok",
"success":[
{
"symbol":"EUR/USD",
"exchange":"PHYSICAL CURRENCY",
"mic_code":"PHYSICAL CURRENCY",
"country":"",
"type":"Physical Currency"
},
{
"symbol":"USD/JPY",
"exchange":"PHYSICAL CURRENCY",
"mic_code":"PHYSICAL CURRENCY",
"country":"",
"type":"Physical Currency"
},
{
"symbol":"BTC/USD",
"exchange":"Coinbase Pro",
"mic_code":"Coinbase Pro",
"country":"",
"type":"Digital Currency"
},
{
"symbol":"ETH/BTC",
"exchange":"Huobi",
"mic_code":"Huobi",
"country":"",
"type":"Digital Currency"
}
],
"fails":null
}
Code app:
LStringReader := TStreamReader.Create('../../Data.json', TEncoding.UTF8, True);
LJsonTextReader := TJsonTextReader.Create(LStringReader);
LIterator := TJSONIterator.Create(LJsonTextReader);
NObjJSON := LIterator.AsInteger;
ListView1.Items.Clear;
ListView1.BeginUpdate;
try
while True do
begin
while LIterator.Next do
begin
if LIterator.&Type in [TJsonToken.StartObject, TJsonToken.StartArray] then
begin
LIterator.Recurse;
LIterator.Next;
oItem := ListView1.Items.Add;
for NObjJSON := 0 to ListView1.ItemCount -1 do
begin
oItem.Text := 'Object #' + NObjJSON.ToString + ' ' + LIterator.AsValue.ToString;
oItem.Detail := 'Key:' +LIterator.Key;
end
end;
end;
if LIterator.InRecurse then
LIterator.Return
else
Break;
end;
finally
ListView1.EndUpdate;
LIterator.Free;
LJsonTextReader.Free;
lStringReader.Free;
Memo1.Lines.Text := NObjJSON.ToString;
end;
Add this recurse / next at beginning of your loop to prepare to enter array :
while LIterator.Next do
begin
if LIterator.&Type = TJsonToken.StartArray then
begin
LIterator.Recurse;
LIterator.Next;
end;
You can check this exemple in the doc : https://docwiki.embarcadero.com/CodeExamples/Sydney/en/RTL.JSONIterator
The code below is easier to read :
procedure TFormX.LoadJSON;
const
cValue = 'symbol';
var
LValue: TJSONValue;
LArray: TJSONArray;
i: integer;
oItem: TListViewItem;
begin
LValue := TJSONObject.ParseJSONValue('{json}');
LArray := LValue.FindValue('success') as TJSONArray;
if Assigned(LArray) then
begin
for i := 0 to LArray.Count - 1 do
begin
oItem := ListView1.Items.Add;
oItem.Text := 'Object #' + i.ToString + ' ' + LArray.Items[i].GetValue<string>(cValue);
oItem.Detail := 'Key:' + cValue;
end;
end;
end;
After all, i found the correct solution:*
var
LIterator: TJSONIterator;
LJsonTextReader: TJsonTextReader;
LStringReader: TStreamReader;
NObjJSON: Integer;
begin
LStringReader := TStreamReader.Create('../../Data.json', TEncoding.UTF8, True);
LJsonTextReader := TJsonTextReader.Create(LStringReader);
LIterator := TJSONIterator.Create(LJsonTextReader);
NObjJSON := LIterator.AsInteger;
ListView1.Items.Clear;
ListView1.BeginUpdate;
try
while True do
begin
while LIterator.Next do
begin
if LIterator.&Type in [TJsonToken.StartObject, TJsonToken.StartArray] then
begin
Memo1.Lines.Add(LIterator.Key);
LIterator.Recurse;
end
else if LIterator.Path = 'success['+NObjJSON.ToString+'].symbol' then
begin
Memo1.Lines.Add(LIterator.AsValue.ToString);
oItem := ListView1.Items.Add;
for NObjJSON := 0 to ListView1.ItemCount -1 do
oItem.Text := 'Object #' + NObjJSON.ToString + ' ' + LIterator.AsValue.ToString;
end
end;
if LIterator.InRecurse then
LIterator.Return
else
Break;
end;
finally
ListView1.EndUpdate;
LIterator.Free;
LJsonTextReader.Free;
LStringReader.Free;
end;
end;
NObjJSON is used to count the number of objects inside array and it returns 4.
You can use a simple integer (I) and replace "for NObjJSON := 0 to ListView1.ItemCount -1 do" by for I := 0 to ListView1.ItemCount -1 do but the number of objects will return 0.

How to add all fields without opening dataset?

I'm using TFIBDataSet (Firebird dataset component) and I'm trying to automatically create all fields at runtime, without loading any record into the dataset.
Here is the code of my test:
uses
FIBDatabase, FIBDataSet, Dialogs;
...
var
Db : TFIBDataBase;
Tr : TFIBTransaction;
Dst : TFIBDataSet;
begin
//connection
Db := TFIBDatabase.Create(Self);
Db.ConnectParams.UserName := 'SYSDBA';
Db.ConnectParams.Password := 'masterkey';
Db.DatabaseName := 'localhost:mydatabase.fdb';
Db.SQLDialect := 3;
Db.Connected := True;
//transaction
Tr := TFIBTransaction.Create(Self);
Tr.DefaultDatabase := Db;
Tr.Active := True;
//dataset
Dst := TFIBDataSet.Create(Self);
Dst.Database := Db;
Dst.Transaction := Tr;
Dst.SelectSQL.Text := 'SELECT * FROM rdb$database';
//...
ShowMessage(IntToStr(Dst.FieldCount));
end;
The previous code produces '0' as output..
I've tried using Dst.Open() and it produces '5', but it also executes the SQL query.
I did it by calling FieldDefs.Update and creating the fields from the FieldDefs list.
uses
FIBDatabase, FIBDataSet, Dialogs;
...
var
Db : TFIBDataBase;
Tr : TFIBTransaction;
Dst : TFIBDataSet;
I : integer;
begin
//connection
Db := TFIBDatabase.Create(Self);
Db.ConnectParams.UserName := 'SYSDBA';
Db.ConnectParams.Password := 'masterkey';
Db.DatabaseName := 'localhost:mydatabase.fdb';
Db.SQLDialect := 3;
Db.Connected := True;
//transaction
Tr := TFIBTransaction.Create(Self);
Tr.DefaultDatabase := Db;
Tr.Active := True;
//dataset
Dst := TFIBDataSet.Create(Self);
Dst.Database := Db;
Dst.Transaction := Tr;
Dst.SelectSQL.Text := 'SELECT * FROM rdb$database';
//create fields
Dst.FieldDefs.Update();
for I := 0 to Dst.FieldDefs.Count - 1 do
Dst.FieldDefs[I].CreateField(Dst);
ShowMessage(IntToStr(Dst.FieldCount));
end;

Why is my TListBox getting blank when its last TListBoxItem is checked?

Problem
My TListBox is getting blank when its last TListBoxItem is programatically checked. To illustrate it better, hereby what I mean by getting blank:
Context
I'm generating a list from a TJSONArray. Each item looks like {"event_code","event_name"}.
Then, I compare if the event_code is written on a second TJSONArray : json_response_available_events. If it does, the ListBoxItem will be checked.
Code
procedure TFormHome.TimerGetEventsTimer(Sender: TObject);
var
K : Integer;
Z : Integer;
ListCount : Integer;
AvailableList_Count: Integer;
lb_item: TListBoxItem;
event_code_first_array: string;
event_code : string;
event_name : string;
begin
// Disable this timer for now
TimerGetEvents.Enabled := false;
// Get List of Notifications
json_response_events := DM_Auth0.ServerMethods1Client.GetEventsCodeAndDescription(communication_token);
json_response_available_events := DM_Auth0.ServerMethods1Client.GetAllowedNotificationsList(communication_token, genset_id);
ListCount := json_response_events.Count -1;
AvailableList_Count := json_response_available_events.Count - 1;
for K := 0 to (ListCount) do
begin
// Get complete Event Code and Name
event_name := json_response_events.Items[K].toString;
// Get Event Code
event_code_first_array := StringReplace(event_name.Split([':'])[0], '"', '', [rfReplaceAll]);
// Get Event Name
event_name := StringReplace(event_name.Split([':'])[1], '"', '', [rfReplaceAll]);
// Create ListBoxItem
lb_item := TListBoxItem.Create(self);
lb_item.Parent := lb_notifications;
lb_item.Text := event_name;
lb_item.StyleLookup := 'listboxitemleftdetail';
// Check if this Item code is available
for Z := 0 to (AvailableList_Count) do
begin
if json_response_available_events.Items[Z] <> nil then
begin
// Get Event Code
event_code := json_response_available_events.Items[Z].toString;
// Format
event_code := StringReplace(event_code, '"', '', [rfReplaceAll]);
if event_code_first_array.Contains(event_code) then
begin
if K <= ListCount then
begin
lb_item.IsChecked := true;
lb_item.IsSelected := false;
end;
end;
end;
end;
end;
end;
Analysis
If we set to < only, it displays the list correctly but the last item will remain unchecked.
if K < ListCount then
begin
lb_item.IsChecked := true;
lb_item.IsSelected := false;
end;
I can even change it's properties when its = like
if K = ListCount then
begin
lb_item.Text := 'Deadpool for President';
end;
and lb_item.isChecked := false works fine, but when setting lb_item.isChecked := true it gets all weirdly blank.
Why is it happening? And if there's a better way to do what I'm doing, the help will be appreciated.

Exporting DBgrid to CSV?

I have a DB grid which is sorted (the user clicked a few radio buttons and checkboxes to influence the display).
I would like to export all of the data (not just what is visible in the grid), sorted identically, to CSV - how do I do so? The data - not the user settings, just to clarify.
Thanks in advance for any help
[Update] I build sqlQuery bit by bit, depending on the user's settings of checkboxes & radio groups, then, when one of them changes, I
ActivityADQuery.SQL.Clear();
ActivityADQuery.SQL.Add(sqlQuery);
ActivityADQuery.Open(sqlQuery);
That is to say that there isn't a hard coded query, it varies and I want to export the current settings.
I don't know enough if I want to export from the grid or the dataset (I am just not a db guy, this is my first DBgrid), but I suspect that I want the grid, because it has a subset of fields of he dataset.
I guess that TJvDBGridCSVExport is a Jedi component(?) I have tried to avoid them so far, great as they sound, because I prefer discreet, stand-alone, components to installing a huge collection. That may not be the cleverest thing to do, but it's how I feel - ymmv (and prolly does)
Another solution, works also with (multi)selected rows:
procedure TReportsForm.ExportToCSV(const aGrid : TDBGrid; const FileName : String);
Var
I, J : Integer;
SavePlace : TBookmark;
Table : TStrings;
HeadTable : String;
LineTable : String;
First : Boolean;
Begin
HeadTable := '';
LineTable := '';
Table := TStringList.Create;
First := True;
Try
For I := 0 To Pred(aGrid.Columns.Count) Do
If aGrid.Columns[I].Visible Then
If First Then
Begin
// Use the text from the grid, in case it has been set programatically
// E.g., we prefer to show "Date/time" than "from_unixtime(activity.time_stamp, "%D %b %Y %l:%i:%S")"
// HeadTable := HeadTable + aGrid.Columns[I].FieldName;
HeadTable := HeadTable + ActivityReportStringGrid.Columns[i].Title.Caption + ','; // Previous separated wth semi-colon, not comma! (global)
First := False;
End
Else
begin
// HeadTable := HeadTable + ';' + aGrid.Columns[I].FieldName;
HeadTable := HeadTable + ActivityReportStringGrid.Columns[i].Title.Caption + ',';
end;
Delete(HeadTable, Length(HeadTable), 1); // Remove the superfluous trailing comma
Table.Add(HeadTable);
First := True;
// with selection of rows
If aGrid.SelectedRows.Count > 0 Then
Begin
For i := 0 To aGrid.SelectedRows.Count - 1 Do
Begin
aGrid.DataSource.Dataset.GotoBookmark(pointer(aGrid.SelectedRows.Items[i]));
For j := 0 To aGrid.Columns.Count - 1 Do
If aGrid.Columns[J].Visible Then
If First Then
Begin
lineTable := lineTable + aGrid.Fields[J].AsString;
First := False;
End
Else
lineTable := lineTable + ',' + aGrid.Fields[J].AsString;
Delete(LineTable, Length(LineTable), 1); // Remove the superfluous trailing comma
Table.Add(LineTable);
LineTable := '';
First := True;
End;
End
Else
//no selection
Begin
SavePlace := aGrid.DataSource.Dataset.GetBookmark;
aGrid.DataSource.Dataset.First;
Try
While Not aGrid.DataSource.Dataset.Eof Do
Begin
For I := 0 To aGrid.Columns.Count - 1 Do
If aGrid.Columns[I].Visible Then
If First Then
Begin
lineTable := lineTable + aGrid.Fields[I].AsString;
First := False;
End
Else
lineTable := lineTable + ',' + aGrid.Fields[I].AsString;
Delete(LineTable, Length(LineTable), 1); // Remove the superfluous trailing comma
Table.Add(LineTable);
LineTable := '';
aGrid.DataSource.Dataset.Next;
First := True;
End;
aGrid.DataSource.Dataset.GotoBookmark(SavePlace);
Finally
aGrid.DataSource.Dataset.FreeBookmark(SavePlace);
End;
End;
Table.SaveToFile(FileName);
Finally
Table.Free;
End;
End; // ExportToCSV()
You could use a own tiny procedure wich could be adapted to your needs
Procedure Dataset2SeparatedFile(ads: TDataset; const fn: String; const Separator: String = ';');
var
sl: TStringList;
s: String;
i: Integer;
bm: TBookmark;
Procedure ClipIt;
begin
s := Copy(s, 1, Length(s) - Length(Separator));
sl.Add(s);
s := '';
end;
Function FixIt(const s: String): String;
begin
// maybe changed
Result := StringReplace(StringReplace(StringReplace(s, Separator, '', [rfReplaceAll]), #13, '', [rfReplaceAll]), #10, '', [rfReplaceAll]);
// additional changes could be Quoting Strings
end;
begin
sl := TStringList.Create;
try
s := '';
For i := 0 to ads.FieldCount - 1 do
begin
if ads.Fields[i].Visible then
s := s + FixIt(ads.Fields[i].DisplayLabel) + Separator;
end;
ClipIt;
bm := ads.GetBookmark;
ads.DisableControls;
try
ads.First;
while not ads.Eof do
begin
For i := 0 to ads.FieldCount - 1 do
begin
if ads.Fields[i].Visible then
s := s + FixIt(ads.Fields[i].DisplayText) + Separator;
end;
ClipIt;
ads.Next;
end;
ads.GotoBookmark(bm);
finally
ads.EnableControls;
ads.FreeBookmark(bm);
end;
sl.SaveToFile(fn);
finally
sl.Free;
end;
end;

'Malformed string' exception when inserting into Firebird (Delphi, UniDAC, UniSQL, INSERT, parameters)

Using Delphi 2010, UniDAC components, Firebird 2.5 SuperServer.
Database character set is ISO_8559_1 (my Windows default).
I am writing a data transfer application to transfer data from an Access database to a Firebird database that has identical table structure. I am using a ADOQuery component to select all rows from source table, and then looping through that recordset, and using UniSQL component with an INSERT statement with parameters, assigning parameter values from the corresponding source dataset field values.
When running the insert command, it throws a 'Malformed string' exception.
I am stuck and need help to resolve the issue.
Code follows:
function TDataTransfer.BeginTransfer(AProgressCallback: TProgressCallback): Boolean;
var
slSQLSelect, slSQLInsert: TStringList;
i, f, z: Integer;
cmdS, cmdI: String;
adods: TADODataSet;
fbcmd: TUniSQL;
fbscript: TUniscript;
q: String;
s : WideString;
begin
FProgressCallback := AProgressCallback;
fbscript := TUniscript.Create(nil);
try
fbscript.Connection := FirebirdConnection;
FirebirdConnection.StartTransaction;
try
fbscript.Delimiter := ';';
fbscript.ExecuteFile(ExtractFilePath(ParamStr(0)) + 'Firebird_Script_0.txt');
FirebirdConnection.CommitRetaining;
slSQLSelect := TStringList.Create;
slSQLInsert := TStringList.Create;
adods := TADODataSet.Create(nil);
fbcmd := TUniSQL.Create(nil);
try
adods.Connection := AccessConnection;
fbcmd.Connection := FirebirdConnection;
slSQLSelect.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'Access_Select.txt');
slSQLInsert.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'Firebird_Insert.txt');
z := slSQLSelect.Count - 1;
for i := 0 to z do begin
cmdS := slSQLSelect[i];
cmdI := slSQLInsert[i];
adods.CommandText := cmdS;
fbcmd.SQL.Text := cmdI;
adods.Open;
while not adods.Eof do begin
for f := 0 to adods.FieldCount - 1 do
try
if adods.FieldDefs[f].DataType = ftWideString then begin
s := adods.Fields[f].AsAnsiString ;
q := '"';
// if AnsiStrPos(PAnsiChar(#s), PAnsiChar(q)) <> nil then
// s := StringReplace(s, '"', '""', [rfReplaceAll]);
fbcmd.Params[f].Value := s;
end
else
if adods.FieldDefs[f].DataType = ftWideMemo then
fbcmd.Params[f].SetBlobData(adods.CreateBlobStream(adods.Fields[f], bmRead))
else
fbcmd.Params[f].Value := adods.Fields[f].Value;
except
raise;
end;
try
fbcmd.Execute;
// FirebirdConnection.CommitRetaining;
except
raise;
end;
adods.Next;
end;
adods.Close;
FProgressCallback((i + 1) * 100 div (z + 1), 10);
end;
finally
slSQLSelect.Free;
slSQLInsert.Free;
adods.Free;
fbcmd.Free;
end;
fbscript.ExecuteFile(ExtractFilePath(ParamStr(0)) + 'Firebird_Script_1.txt');
FirebirdConnection.Commit;
Result := True;
except
FirebirdConnection.Rollback;
Result := False;
end;
finally
fbscript.Free;
end;
end;
TIA,
SteveL
If you try to replace s := StringReplace(s, '"', '""', [rfReplaceAll]); with s := StringReplace(s, '''''', '''', [rfReplaceAll]); and uncomment the line;

Resources