Connect database table to StringGrid with LiveBindings via code - database

I want to use LiveBindings to connect a database table to a StringGrid, but I don't want to use the LiveBindings Designer, I want to do it manually via code. The documentation is in my opinion nearly not existing, which makes it more complicated than it should be.
I created a FMX application with my Delphi 10.3 and this is the code I wrote to do all I need:
procedure TForm_LiveBindings.CornerButton_Click(Sender: TObject);
var
aLinkTableToDataSource: TLinkGridToDataSource;
aConnection: TADOConnection;
aQuery: TADOQuery;
aBindSource: TBindSourceDB;
begin
aConnection:= TADOConnection.Create(self);
aQuery:= TADOQuery.Create(self);
aBindSource:= TBindSourceDB.Create(self);
aLinkTableToDataSource:= TLinkGridToDataSource.Create(self);
// Connection is set up here
aQuery.Connection := aConnection;
aQuery.SQL.Text := 'SELECT * FROM TestTable';
aQuery.Active := True;
aBindSource.DataSource.DataSet := aQuery;
aBindSource.DataSource.AutoEdit := True;
aBindSource.DataSource.Enabled := True;
aLinkTableToDataSource.DataSource := aBindSource;
aLinkTableToDataSource.GridControl := StringGrid1;
end;
The result: my StringGrid shows the table headers, but the rows stay empty. Which means the connection between the table and the string grid is existing, the columns have the correct header, but the content is not shown. So where did I go wrong?
Another question: is the StringGrid a good choice for displaying my database table or are there better solutions?
Thank a lot for your answers!

The example below shows all the code necessary to set up and populate a TStringGrid and a TGrid
using Live Bindings. It uses a TClientDataSet as the dataset so that it is completely self-
contained.
A bit of experimenting should satisfy you that setting up Live Bindings in code is actually
quite simple, but sensitive to the order of steps. Far more so than using VCL and traditional db-aware controls, Live Bindings seems require connecting up exactly the right things in the right way for it to work correctly. Note that unlike your code, my code does not touch the BindSorce's Datasource property, because it just isn't necessary.
type
TForm2 = class(TForm)
ClientDataSet1: TClientDataSet;
Grid1: TGrid;
StringGrid1: TStringGrid;
procedure FormCreate(Sender: TObject);
private
public
end;
[...]
procedure TForm2.FormCreate(Sender: TObject);
var
AField : TField;
BindSourceDB1 : TBindSourceDB;
LinkGridToDataSourceBindSourceDB1 : TLinkGridToDataSource;
LinkGridToDataSourceBindSourceDB2 : TLinkGridToDataSource;
begin
AField := TIntegerField.Create(Self);
AField.FieldName := 'ID';
AField.FieldKind := fkData;
AField.DataSet := ClientDataSet1;
AField := TStringField.Create(Self);
AField.FieldName := 'Name';
AField.Size := 20;
AField.FieldKind := fkData;
AField.DataSet := ClientDataSet1;
BindSourceDB1 := TBindSourceDB.Create(Self);
BindSourceDB1.DataSet := ClientDataSet1;
LinkGridToDataSourceBindSourceDB1 := TLinkGridToDataSource.Create(Self);
LinkGridToDataSourceBindSourceDB1.DataSource := BindSourceDB1;
LinkGridToDataSourceBindSourceDB1.GridControl := Grid1;
LinkGridToDataSourceBindSourceDB2 := TLinkGridToDataSource.Create(Self);
LinkGridToDataSourceBindSourceDB2.DataSource := BindSourceDB1;
LinkGridToDataSourceBindSourceDB2.GridControl := StringGrid1;
ClientDataSet1.IndexFieldNames := 'ID';
ClientDataSet1.CreateDataSet;
ClientDataSet1.InsertRecord([1, 'AName']);
ClientDataSet1.InsertRecord([2, 'AnotherName']);
ClientDataSet1.InsertRecord([3, 'ThirdName']);
ClientDataSet1.InsertRecord([4, 'FourthName']);
ClientDataSet1.InsertRecord([5, 'FifthName']);
ClientDataSet1.First;
end;

Answering late, but maybe it helps someone. LinkGrid must be Activate by
aLinkTableToDataSource.Active:= True;

Related

Multiple parameterized Delphi SQL updates within a transaction

I am trying to update two different SQL tables in the same loop using parameterized queries in Delphi XE8. I also want to wrap the whole thing in a transaction, so that if anything in the loop fails, neither table gets updated.
I don't really know what I'm doing, would appreciate some help.
The code below is a simplified version of what I'm trying to achieve, and my best guess as to how to go about it. But I'm not really sure of it at all, particularly the use of two datasets connected to the 'SQL connection' component.
SQL_transaction.TransactionID :=1;
SQL_transaction.IsolationLevel:=xilREADCOMMITTED;
SQL_connection.BeginTransaction;
Try
{ Create connections }
SQL_dataset1 :=TSQLDataSet.Create(nil);
SQL_dataset1.SQLConnection:=SQL_connection;
SQL_dataset2 :=TSQLDataSet.Create(nil);
SQL_dataset2.SQLConnection:=SQL_connection;
{ Create queries }
SQL_dataset1.CommandType:=ctQuery;
SQL_dataset1.CommandText:={ some parameterized query updating table A }
SQL_dataset2.CommandType:=ctQuery;
SQL_dataset2.CommandText:={ some parameterized query updating table B }
{ Populate parameters and execute }
For I:=0 to whatever do
begin
SQL_dataset1.ParamByName('Table A Field 1').AsString:='Value';
SQL_dataset1.ExecSQL;
SQL_dataset2.ParamByName('Table B Field 1').AsString:='Value';
SQL_dataset2.ExecSQL;
end;
SQL_connection.Commit(SQL_transaction);
except
SQL_connection.Rollback(SQL_transaction);
end;
I am using Delphi XE8, and the database can be either SQL server or SQLite.
The logic of your transaction handling is correct (except the missing exception re-raise mentioned by #whosrdaddy). What is wrong are missing try..finally blocks for your dataset instances. Except that you should stop using TSQLConnection deprecated methods that are using the TTransactinDesc record (always check the compiler warnings when you're building your app.). And you can also switch to TSQLQuery component. Try something like this instead:
var
I: Integer;
Query1: TSQLQuery;
Query2: TSQLQuery;
Connection: TSQLConnection;
Transaction: TDBXTransaction;
begin
...
Query1 := TSQLQuery.Create(nil);
try
Query1.SQLConnection := Connection;
Query1.SQL.Text := '...';
Query2 := TSQLQuery.Create(nil);
try
Query2.SQLConnection := Connection;
Query2.SQL.Text := '...';
Transaction := Connection.BeginTransaction;
try
// fill params here and execute the commands
for I := 0 to 42 to
begin
Query1.ExecSQL;
Query2.ExecSQL;
end;
// commit if everything went right
Connection.CommitFreeAndNil(Transaction);
except
// rollback at failure, and re-raise the exception
Connection.RollbackFreeAndNil(Transaction);
raise;
end;
finally
Query2.Free;
end;
finally
Query1.Free;
end;
end;
I prefer try finally over try except
here's how to make it work in a try finally block
var
a_Error: boolean;
begin
a_Error := True;//set in error state...
SQL_dataset1 := nil;
SQL_dataset2 := nil;
SQL_transaction.TransactionID :=1;
SQL_transaction.IsolationLevel:=xilREADCOMMITTED;
SQL_connection.BeginTransaction;
Try
{ Create connections }
SQL_dataset1 :=TSQLDataSet.Create(nil);
SQL_dataset1.SQLConnection:=SQL_connection;
SQL_dataset2 :=TSQLDataSet.Create(nil);
SQL_dataset2.SQLConnection:=SQL_connection;
{ Create queries }
SQL_dataset1.CommandType:=ctQuery;
SQL_dataset1.CommandText:={ some parameterized query updating table A }
SQL_dataset2.CommandType:=ctQuery;
SQL_dataset2.CommandText:={ some parameterized query updating table B }
{ Populate parameters and execute }
For I:=0 to whatever do
begin
SQL_dataset1.ParamByName('Table A Field 1').AsString:='Value';
SQL_dataset1.ExecSQL;
SQL_dataset2.ParamByName('Table B Field 1').AsString:='Value';
SQL_dataset2.ExecSQL;
end;
a_Error := False;//if you don't get here you had a problem
finally
if a_Error then
SQL_connection.Rollback(SQL_transaction)
else
SQL_connection.Commit(SQL_transaction);
SQL_dataset1.Free;
SQL_dataset2.Free;
end;
end;
I added some code on how Try Finally works with init objects to nil
TMyObject = class(TObject)
Name: string;
end;
procedure TForm11.Button1Click(Sender: TObject);
var
a_MyObject1, a_MyObject2: TMyObject;
begin
a_MyObject1 := nil;
a_MyObject2 := nil;
try
a_MyObject1 := TMyObject.Create;
a_MyObject1.Name := 'Object1';
if Sender = Button1 then
raise exception.Create('Object 2 not created');
ShowMessage('We will not see this');
a_MyObject2 := TMyObject.Create;
a_MyObject2.Name := 'Object2';
finally
a_MyObject2.Free;
ShowMessage('We will see this even though we called a_MyObject2.free on a nil object');
a_MyObject1.Free;
end;
end;

Login display error message

I need my program to log a user in from a database. This entails a diver number (like a username) and a password which is already in the database. Unfortunately, I don't know SQL right now and would rather use a technique similar to the one I've done here. I get an error message in run time that says: adotblDiversInfo: Cannot perform this operation on a closed dataset. Thank you so much for your help in advance (:
This is my code:
procedure TfrmHomeScreen.btnLogInClick(Sender: TObject);
var
iDiverNumber : Integer;
sPassword, sKnownPassword : String;
bFlagDiverNumber, bFlagPassword, Result : Boolean;
begin
iDiverNumber := StrToInt(ledDiverNumber.Text);
sPassword := ledPassword.Text;
with frmDM do
adotblDiversInfo.Filtered := False;
frmDM.adotblDiversInfo.Filter := 'Diver Number' + IntToStr(iDiverNumber);
frmDM.adotblDiversInfo.Filtered := True;
if frmDM.adotblDiversInfo.RecordCount = 0 then
ShowMessage(IntToStr(iDiverNumber) + ' cannot be found')
else
begin
sKnownPassword := frmDM.adotblDiversInfo['Password'];
if sKnownPassword = sPassword then
ShowMessage('Login successful')
else
ShowMessage('Incorrect password. Please try again');
end;
end;
The error you're getting is because you've forgotten to open the dataset before attempting to access it. Use frmDM.adoTblDiversInfo.Open; or frmDM.adoTblDiversInfo.Active := True; to do so before trying to use the table.
Your code could be much simpler (and faster) if you change it somewhat. Instead of filtering the entire dataset, simply see if you can Locate the proper record.
procedure TfrmHomeScreen.btnLogInClick(Sender: TObject);
var
iDiverNumber : Integer;
begin
if not frmDM.adoTblDiversInfo.Active then
frmDM.adoTblDiversInfo.Open;
iDiverNumber := StrToInt(ledDiverNumber.Text);
sPassword := ledPassword.Text;
if frmDM.adoTblDiversInfo.Locate('Diver Number', iDiverNumber, []) the
begin
if frmDM.adoTblDiversInfo['Password'] = ledPassword.Text then
ShowMessage('Login successful')
else
ShowMessage('Invalid password. Please try again.');
end
else
ShowMessage(ledDiverNumber.Text);
end;

What is the proper way to dynamically create and call a stored procedure in Delphi using FireDac?

I am relatively new to FireDAC. I want to be able to call a stored procedure "on the fly", dynamically. So far I have the following:
function TForm21.ExecuteStoredProc(aSPName: string; aParams: TADParams): Boolean;
var
LSP: TADStoredProc;
i: Integer;
begin
LSP := TADStoredProc.Create(nil);
try
LSP.Connection := ADConnection1;
LSP.StoredProcName := aSPName;
LSP.Prepare;
for i := 0 to aParams.Count - 1 do
begin
LSP.Params[i].Value := aParams[i].Value;
end;
LSP.ExecProc;
finally
LSP.Free;
end;
Result := True;
end;
I call it with
procedure TForm21.Button1Click(Sender: TObject);
var
LParams: TADParams;
begin
LParams := TADParams.Create;
LParams.Add.Value := 612;
LParams.Add.Value := '2008';
ExecuteStoredProc('HDMTEST.dbo.spARCHIVE_HISTORY_DATA', LParams);
end;
However, the stored procedure fails to execute. That is, the code runs fine, no error message is shown, but the stored procedure doesn't run.
Further info -- it runs fine if I drop a component and set up the params in code.
Anyone have any idea what I am missing?
Seeing as this q has been left unanswered for a while, I thought I'd try to get the code working without using the clues from the comments and found it not quite as easy as I'd imagined.
I immediately got stuck with the SP params. I found this
http://docwiki.embarcadero.com/RADStudio/XE5/en/TFDQuery,_TFDStoredProc_and_TFDUpdateSQL_Questions
which says
"If you have difficulties with manual definition of parameters,
populate the Params collection automatically and check how the
parameters are defined. Then compare that to your code. "
but I couldn't find a way of "automatically" populating the Params. I asked on the EMBA
FireDac newsgroup and the FD author, Dimitry Arefiev, kindly explained that
you can do that by checking that the FetchOptions include fiMeta, and then clearing and setting the FDStoredProc's StoredProcName.
Using a StoredProc in the pubs demo database on my SqlServer defined as follows:
create procedure test(#ANumber int, #AName varchar(20))
as
begin
select
#ANumber * 2 as "Number",
#AName + #AName as "Name"
end
I changed a couple of sections of the OP's code like this
[...]
LSP.Params.Clear;
LSP.StoredProcName := '';
LSP.FetchOptions.Items := LSP.FetchOptions.Items + [fiMeta];
LSP.StoredProcName := aSPName;
LSP.Prepare;
Assert(LSP.ParamCount > 0);
for i := 0 to aParams.Count - 1 do
begin
LSP.Params.ParamByName(aParams[i].Name).Value := aParams[i].Value;
end;
[...]
procedure TForm21.Button1Click(Sender: TObject);
var
LParams: TFDParams;
Param : TFDParam;
begin
LParams := TFDParams.Create;
Param := LParams.Add;
Param.Name := '#ANumber';
Param.Value := 612;
Param := LParams.Add;
Param.Name := '#AName';
Param.Value := '2008';
ExecuteStoredProc('test', LParams);
end;
and it worked fine.
The OP mentions in the q he'd first had the problem that the SP failed to execute
but that he'd found that it worked if he "[dropped] a component and set up the params in code" so I thought I'd include here a console application where of course necessarily everything is done in code. This wasn't difficult, but the time it took me to get the Uses clause right is my main reason for posting this as an answer, for future reference. W/o the correct uses, you get errors complaining about various class factories being missing.
Console app (created and tested in XE6):
program ConsoleStoredProcProject3;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils, FireDac.DApt, FireDAC.Stan.Def, FireDAC.Stan.ASync,
FireDAC.Stan.Param, FireDAC.Stan.Option, FireDAC.Comp.Client,
FireDAC.Phys.MSSQL, VCL.ClipBrd;
procedure TestSP;
var
Connection : TFDConnection;
StoredProc : TFDStoredProc;
Param : TFDParam;
begin
Connection := TFDConnection.Create(Nil);
Connection.DriverName := 'MSSQL';
Connection.Params.Values['Server'] := // your server name'';
Connection.Params.Values['Database'] := 'pubs';
Connection.Params.Values['user_name'] := 'user'; // adjust to suit
Connection.Params.Values['password'] := 'password'; // ditto
Connection.LoginPrompt := False;
Connection.Connected := True;
StoredProc := TFDStoredProc.Create(Nil);
StoredProc.Connection := Connection;
StoredProc.FetchOptions.Items := StoredProc.FetchOptions.Items + [fiMeta];
StoredProc.StoredProcName := 'test';
StoredProc.Prepare;
Param := StoredProc.Params.ParamByName('#ANumber');
Param.Value := 333;
Param := StoredProc.Params.ParamByName('#AName');
Param.Value := 'A';
StoredProc.Active := True;
WriteLn(StoredProc.FieldByName('Number').AsInteger);
WriteLn(StoredProc.FieldByName('Name').AsString);
ReadLn;
end;
begin
try
TestSP;
except
on E: Exception do
Clipboard.AsText := E.Message;
end;
end.

Unable to insert Unicode into SQL Server 2008 using Delphi ZeosLib and Delphi 7

I'm having trouble inserting Unicode into a SQL Server database using Delphi ZeosLib and Delphi 7, and then reading the inserted value. I've created a simple test program that first inserts and then queries the inserted value.
The test table schema:
CREATE TABLE [dbo].[incominglog](
[message] [nvarchar](500) NULL
) ON [PRIMARY]
I've upload the simple test program source (ZeosLib source included) - click here to download. I've also included ntwdblib.dll but you can use your own.
The test program also requires TNT component which can be downloaded from here
Using the test program, the Unicode characters that I have inserted appear as question marks on retrieval - I'm not certain whether the problem lies with the insert code or the query code.
I've also tried encoding the data into utf-8 before inserting and then decoding the data after retrieving from utf-8 - please search "//inserted as utf8" in the test program source. I'm able to view the Unicode after it has been decoded, so this method works. However, for my actual application, I can't encode as UTF-8 as SQL Server doesn't support UTF-8 completely - some characters can't be stored. See my previous question here.
Will appreciate any pointers. :)
Meanwhile, here's the source for the Test program:
unit Unit1;
interface
uses
ZConnection, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ZAbstractRODataset, ZAbstractDataset, ZAbstractTable, ZDataset,
StdCtrls, TntStdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
TntMemo1: TTntMemo;
Button2: TButton;
TntEdit1: TTntEdit;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
FZConnection: TZConnection;
FZQuery: TZQuery;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
tntmemo1.Lines.Clear;
FZConnection := TZConnection.Create(Owner);
FZConnection.LoginPrompt := False;
FZQuery := TZQuery.Create(Owner);
FZQuery.Connection := FZConnection;
FZConnection.Protocol := 'mssql';
FZConnection.Database := 'replace-with-your-db';
FZConnection.HostName := 'localhost';
FZConnection.User := 'sa';
FZConnection.Password := 'replace-with-your-password';
FZConnection.Connect;
FZQuery.SQL.Text := 'SELECT * from incominglog';
FZQuery.ExecSQL;
FZQuery.Open;
FZQuery.First;
while not FZQuery.EOF do
begin
tntmemo1.Lines.add(FZQuery.FieldByName('message').AsString);
// tntmemo1.Lines.add(utf8decode(FZQuery.FieldByName('message').AsString)); //inserted as utf8
FZQuery.Next;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
sqlstring, data:widestring;
begin
FZConnection := TZConnection.Create(Owner);
FZConnection.LoginPrompt := False;
FZQuery := TZQuery.Create(Owner);
FZQuery.Connection := FZConnection;
FZConnection.Protocol := 'mssql';
FZConnection.Database := 'replace-with-your-db';
FZConnection.HostName := 'localhost';
FZConnection.User := 'sa';
FZConnection.Password := 'replace-with-your-password';
FZConnection.Connect;
data:= tntedit1.Text;
// data:= utf8encode(tntedit1.Text); //inserted as utf8
sqlstring:= 'INSERT INTO INCOMINGLOG ([MESSAGE]) VALUES(N''' + data + ''')';
FZQuery.SQL.Text := sqlstring;
FZQuery.ExecSQL;
end;
end.
I have not tested your example, but I'm able to save and retrieve from database Unicode characters without problem on SQL Server with Delphi 7 VCL/CLX and zeoslib.
I think in your case it will be enough changing your save procedure like this :
procedure TForm1.Button2Click(Sender: TObject);
var
sqlstring : widestring;
data : UTF8String;
begin
FZConnection := TZConnection.Create(Owner);
FZConnection.LoginPrompt := False;
FZQuery := TZQuery.Create(Owner);
FZQuery.Connection := FZConnection;
FZConnection.Protocol := 'mssql';
FZConnection.Database := 'replace-with-your-db';
FZConnection.HostName := 'localhost';
FZConnection.User := 'sa';
FZConnection.Password := 'replace-with-your-password';
FZConnection.Connect;
data:= UTF8String( utf8encode(tntedit1.Text) );
sqlstring:= 'INSERT INTO INCOMINGLOG ([MESSAGE]) VALUES(:DATA)';
FZQuery.SQL.Text := sqlstring;
FZQuery.ParamByName('DATA').AsString := data;
FZQuery.ExecSQL;
end;
The point is changing your data string variable in UTF8String type, and use parameters pass the data string to the query ...
To be honest I use it with a ZTable and Post command, but it should be the same with a ZQuery like yours ...

Delphi TeeChart only showing one record from dataset

Using Delphi Steema TeeChart component, if I link a BarSeries to a dataset using the user interface, it shows up fine, but if I do it using code (which I need to), it's only showing one bar, even when I have several records in the database. What am I doing wrong?
Code:
var
i:Integer;
Bar:TBarSeries;
begin
ADataSet.Close;
ADataSet.LoadFromDataSet(mtbl);
ADataSet.Active := true;
ADataSet.First;
ASource.DataSet := ADataSet;
Bar := TBarSeries.Create(AChart);
Bar.Assign(Series2);
Bar.ParentChart := AChart;
Bar.DataSource := ASource;
Bar.XLabelsSource := 'Date';
Bar.YValues.ValueSource := 'Load';
for i := 0 to AChart.SeriesCount - 1 do
begin
AChart.Series[i].CheckDataSource;
end;
ADataSet is a DevExpress MemData (TdxMemData). When I run the program, the X axis is only showing one bar, the first record in the dataset, even though I have 4 records in the dataset.
This code works for me (using an Access database with fields ID and Height, I dropped a TDBChart, TADODataSet, and a TButton on a form):
procedure TForm1.Button1Click(Sender: TObject);
var
Bar : TBarSeries;
begin
ADODataSet1.Close;
ADODataSet1.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;...';
Bar := TBarSeries.Create(DBChart1);
DBChart1.AddSeries(Bar);
Bar.ParentChart := DBChart1;
Bar.DataSource := ADODataSet1;
Bar.XLabelsSource := 'ID';
Bar.YValues.ValueSource := 'Height';
ADODataSet1.Active := true;
end;
Note that the Datasource should be a TTable, TQuery, or TDataSet (not a TDataSource - go figure!).
Hope this helps.
TChart refreshes the query each time you set
ADataSet.Active := true;
so, move this command to the end of your block (e.g. after you've set up the series properties).

Resources