Problem with checking ADOTable field values - database

I'm having yet another problem with Delphi. I wrote a piece of code that should check if a field in a database table equals to 0, and if that is true, changes font color and caption of a certain button. It runs on creation of the main form. However, when I run the program, nothing happens - the program does not appear and I get no errors. I seriously don't know what's wrong, seems like some kind of an infinite loop.
Here's the code:
procedure TForm1.FormCreate(Sender: TObject);
begin
ADOTableStorage.First;
while not ADOTableStorage.Eof do
If ADOTableStorage.FieldByName('amount').AsInteger = 0 then
begin
btStorage.Font.Color := clRed;
btStorage.Caption := 'Some items are out of stock!';
Break;
end;
ADOTableStorage.Next;
end;
Note: The ADOTableStorage table is a on the detail table in a Master-Detail connection.
Thanks!

I guess you are missing a begin/end in the while loop. Try this.
procedure TForm1.FormCreate(Sender: TObject);
begin
ADOTableStorage.First;
while not ADOTableStorage.Eof do
begin
If ADOTableStorage.FieldByName('amount').AsInteger = 0 then
begin
btStorage.Font.Color := clRed;
btStorage.Caption := 'Some items are out of stock!';
Break;
end;
ADOTableStorage.Next;
end;
end;

Related

TStringList in an array in Lazarus

I have a problem with TStringLists in Lazarus. I have an array called 'trans' of records called 'TTrans' which contain, among other things, TStringList called 'meebetalers'. So when I need to know for example the amount of lines in that StringList I would have to write this right?
trans[i].meebetalers.Count;
Anyways, I first create a stringlist and put the selected strings from a checklistbox in it, and that works (i.e. the program returns 3 when I ask for the Count, which is correct).
In this piece of code I add values to the StringList:
slmeebetalers := TStringList.Create;
for i:= 0 to Form6.CLBox.Count-1 do begin
if Form6.CLBox.Checked[i] then begin
slmeebetalers.Add(Form6.CLBox.Items[i]);
end;
end;
Then I put the stringlist a procedure, and in that procedure I assign my first created StringList to the stringlist I mentionned before (trans[i].meebetalers), see my piece of code next.
Unit6.VoegTransToe(Form6.TransNaam.Text,
Form6.TrComboBox.Text,
bedrag,
slmeebetalers,
Form6.CalendarDialog1.Date);
But when I then ask for the count, it returns 0.
procedure VoegTransToe(naam, betaalpers: string; bedrag: currency;
meebetalers: TStringList; datum: TDateTime);
begin
aantaltrans:= aantaltrans+1;
trans[aantaltrans].naam:=naam;
trans[aantaltrans].pers.naam:=betaalpers;
trans[aantaltrans].bedrag:=bedrag;
trans[aantaltrans].datum:=datum;
meebetalers:= TStringList.Create;
trans[aantaltrans].meebetalers:= TStringList.Create;
trans[aantaltrans].meebetalers.Assign(meebetalers);
meebetalers.Free;
//trans[aantaltrans].meebetalers.Free;
end;
note The difference in name of the variable is because they are in different units
With this code I don't get an error, but it returns 0. When I say //meebetalers.Free; the same happens.
But when I add //trans[aantaltrans].meebetalers.Free; I don't get an error while compiling, but when I call the procedure. Then I get this error:
Project project1 raised exception class 'External: SIGSEGV'.
I think there is something wrong with the Create and Free function, but I don't know what. When I implement the try...finally...end it returns the same error. Can anybody help me?
The problem is that your VoegTransToe() procedure is ignoring the populated TStringList object that is passed in via its meebetalers parameter. You are resetting meebetalers to point at a newly created empty TStringList object just before assigning meebetalers to trans[aantaltrans].meebetalers.
procedure VoegTransToe(naam, betaalpers: string; bedrag: currency;
meebetalers: TStringList; datum: TDateTime);
begin
aantaltrans:= aantaltrans+1;
trans[aantaltrans].naam:=naam;
trans[aantaltrans].pers.naam:=betaalpers;
trans[aantaltrans].bedrag:=bedrag;
trans[aantaltrans].datum:=datum;
// meebetalers:= TStringList.Create; // <-- GET RID OF THIS!
trans[aantaltrans].meebetalers:= TStringList.Create;
trans[aantaltrans].meebetalers.Assign(meebetalers);
//meebetalers.Free; // <-- AND THIS!
end;
Don't forget to Free() the input TStringList object when you are done using it:
slmeebetalers := TStringList.Create;
try
for i := 0 to Form6.CLBox.Count-1 do begin
if Form6.CLBox.Checked[i] then begin
slmeebetalers.Add(Form6.CLBox.Items[i]);
end;
end;
Unit6.VoegTransToe(..., slmeebetalers, ...);
finally
slmeebetalers.Free;
end;

Adding Values to an Array in Pascal - iIllegal Qualifier"

I am trying to create a program that prints 11 buttons so I wanted to use an array. The only change with these buttons is the name.
When I try to compile, I get the error "illegal qualifier" at my first array assignment.
type
buttonName = array[0..11] of String;
procedure PopulateButton(const buttonName);
begin
buttonName[0] := 'Sequence';
buttonName[1] := 'Repetition';
buttonName[2]:= 'Modularisation';
buttonName[3]:= 'Function';
buttonName[4]:= 'Variable';
buttonName[5]:= 'Type';
buttonName[6]:= 'Program';
buttonName[7]:= 'If and case';
buttonName[8]:= 'Procedure';
buttonName[9]:= 'Constant';
buttonName[10]:= 'Array';
buttonName[11]:= 'For, while, repeat';
end;
and in main I am trying to use this for loop
for i:=0 to High(buttonName) do
begin
DrawButton(x, y, buttonName[i]);
y:= y+70;
end;
Please know, I am very new to this and am not too confident of my knowledge in arrays, parameters/calling by constant and such.
Thank you
The parameter definition of PopulateButton() is wrong.
Try this:
type
TButtonNames = array[0..11] of String;
procedure PopulateButtons(var AButtonNames: TButtonNames);
begin
AButtonNames[0] := 'Sequence';
...
end;
...
var lButtonNames: TButtonNames;
PopulateButtons(lButtonNames);
for i := Low(lButtonNames) to High(lButtonNames) do
begin
DrawButton(x, y, lButtonNames[i]);
y:= y+70;
end;
Also pay attention to the naming conventions. Types normally begin with a T and function parameters start with an A.

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;

How get an SQL output cursor into a Delphi Data Component?

I have a stored procedure with this signature:
CREATE PROCEDURE SI_Inteligence(#dt datetime, #actions varchar(6), #FullData cursor varying out)
This procedure returns an open cursor.
What kind of component do I need to trap it and iterate over it record by record? It's only a parameter from stored procedure!
procedure DoIt;
var sp: TADOStoredProc;
x: TADODataSet; //?
begin
sp := TADOStoredProc.Create(Self);
sp.Connection := myConnection; //TADOConnection Component
sp.ProcedureName := 'SI_Inteligence';
sp.Parameters.ParamByName('#dt').Value := date;
sp.Parameters.ParamByName('#actions').Value := 'something';
sp.ExecProc;//? Open doesn't return anything
x := TADODataSet.Create(Self);
//How load the cursor??
x.Assign(sp.Parameters.ParamByName('#FullData') as TADODataSet); //crash
end;
Now I need loop that cursor. How can I do that?
The CURSOR params are returned as recordsets, So you can iterate over the data using the TADOStoredProc methods related to the TDataSet class like Eof, Next, FieldByName and so on.
Try this code .
ADOStoredProc1.ExecProc;
while not ADOStoredProc1.Eof do
begin
//do something
//ADOStoredProc1.FieldByName('Foo').Value;
ADOStoredProc1.Next;
end;
if the stored procedure return more than a cursor, you can iterate over the recordsets using the NextRecordset method as is described on this post.

Delete and refresh a record in DBgrid where u maintain the same position

I have a small database I'm using dbgo, I have a DBgrid displaying my records, I need to know how to delete a record and refresh the database where the index arrow stays in the same position or at least go to the next? but currently my index arrow jump to start form the beginning each time I refresh !
Just keep and reset Recno
var
I:Integer;
.......
I := Ads.Recno;
Ads.Delete;
Ads.Recno := I;
an example implementation for usage with DBNavigator could be
Procedure DeleteAndKeepRecno(Ads: TCustomAdoDataset);
var
rn: Integer;
begin
rn := Ads.RecNo;
Ads.Delete;
Ads.RecNo := rn;
end;
procedure TForm4.DBNavigator1Click(Sender: TObject; Button: TNavigateBtn);
begin
if Button = nbDelete then
begin
DeleteAndKeepRecno (TCustomAdoDataset(TDBNavigator(Sender).DataSource.DataSet));
Abort;
end;
end;

Resources