I have the same query only the connections change :
if DataModule1.1_CONNECTION.Connected = true
then begin
DataModule1.ZAM_GESLO.SQL.Text:='select user,pwd from users where user = :a';
DataModule1.ZAM_GESLO.Params.ParamByName('a').AsString := DataModule1.LOGIN_QUERY.FieldByName('user').AsString;
DataModule1.ZAM_GESLO.Open;
cxGrid1.ActiveLevel.GridView := MYGRIDVIEW1;
end else
if DataModule1.2_CONNECTION.Connected = true
then begin
DataModule1.ZAM_GESLO.SQL.Text:='select user,pwd from users where user = :a';
DataModule1.ZAM_GESLO.Params.ParamByName('a').AsString := DataModule1.LOGIN_QUERY.FieldByName('user').AsString;
DataModule1.ZAM_GESLO.Open;
cxGrid1.ActiveLevel.GridView := MYGRIDVIEW2;
end;
.......
This is a long way arround,so I was wondering if this can be done in any other optimized way so I dont have to write the same query all over again?
To save duplicated code, you could add a procedure to your form
procedure TxForm.UseDataSet(ADataSet : TxDataSet; AUserName : String);
begin
if ADataSet.Active then
ADataSet.Close;
ADataSet.SQL.Text:='select user, pwd from users where user = :a';
ADataSet.Params.ParamByName('a').AsString := AUser;
ADataSet.Open;
cxGrid1.ActiveLevel.GridView := AGridView;
end;
Note: I've used "x" in the ADataset parameter's type because I didn't know which type of dataset you're using, likewise your Form's type.
Then, you could re-write your code as
if DataModule1.1_CONNECTION.Connected then
begin
UseDataSet(DataModule1.ZAM_GESLO,
DataModule1.LOGIN_QUERY.FieldByName('user').AsString);
end
else
if DataModule1.2_CONNECTION.Connected then
begin
UseDataSet(DataModule1.ZAM_GESLO,
DataModule1.LOGIN_QUERY.FieldByName('user').AsString);
end;
Btw, it's good that you obviously wondered about duplicated code when you asked your q. Whenever you find yourself writing essentially the same code using different objects, consider writing a procedure (or function) which contains the repetitive code and which operates on the objects as parameters.
Related
I'm trying to create a simple example of using IFileOperation to delete the files in a
given directory, to include in the answer to another q for comparison with other methods.
Below is the code of my MRE. It
successfully creates 1000 files in a subdirectory off C:\Temp and then attempts to delete
them in the DeleteFiles method. This supposedly "easy" task fails but I'm not sure
exactly where it comes off the rails. The comments in the code show what I'm expecting
and the actual results. On one occasion, instead of the exception noted, I got a pop-up
asking for confirmation to delete an item with an odd name which was evidently an array of
numbers referring to a shell item, but my attempt to capture it using Ctrl-C failed;
I'm fairly sure I'm either missing a step or two, misusing the interfaces involved
or both. My q is, could anybody please show the necessary corrections to the code to get IFileOperation.DeleteItems() to delete the files in question, as I am completely out of my depth with this stuff? I am not interested in alternative methods of deleting these files, using the shell interfaces or otherwise.
procedure TForm2.DeleteFiles;
var
iFileOp: IFileOperation;
iIDList : ItemIDList;
iItemArray : IShellItemArray;
iArray : Array[0..1] of ItemIDList;
Count : DWord;
begin
iFileOp := CreateComObject(CLSID_FileOperation) as IFileOperation;
iIDList := ILCreateFromPath(sPath)^;
// IFileOperation.DeleteItems seems to require am IShellItemArray, so the following attempts
// to create one
// The definition of SHCreateShellItemArrayFromIDLists
// seems to require a a zero-terminated array of ItemIDLists so the next steps
// attempt to create one
ZeroMemory(#iArray, SizeOf(iArray));
iArray[0] := iIDList;
OleCheck(SHCreateShellItemArrayFromIDLists(1, #iArray, iItemArray));
// Next test the number of items in iItemArray, which I'm expecting to be 1000
// seeing as the CreateFiles routine creats that many
OleCheck(iItemArray.GetCount(Count));
Caption := IntToStr(Count); // Duh, this shows Count to be 1, not the expected 1000
OleCheck(iFileOp.DeleteItems(iItemArray));
OleCheck( iFileOp.PerformOperations );
// Returns Exception 'No object for moniker'
end;
procedure TForm2.Button1Click(Sender: TObject);
begin
DeleteFiles;
end;
procedure CreateFiles;
var
i : Integer;
SL : TStringList;
FileName,
FileContent : String;
begin
SL := TStringList.Create;
try
if not (DirectoryExists(sPath)) then
MkDir(sPath);
SL.BeginUpdate;
for i := 0 to 999 do begin
FileName := Format('File%d.Txt', [i]);
FileContent := Format('content of file %s', [FileName]);
SL.Text := FileContent;
SL.SaveToFile(sPath + '\' + FileName);
end;
SL.EndUpdate;
finally
SL.Free;
end;
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
CreateFiles;
end;
You are leaking the memory returned by ILCreateFromPath(), you need to call ILFree() when you are done using the returned PItemIDList.
Also, you should not be dereferencing the PItemIDList. SHCreateShellItemArrayFromIDLists() expects an array of PItemIDList pointers, but you are giving it an array of ItemIDList instances.
Try this instead:
procedure TForm2.DeleteFiles;
var
iFileOp: IFileOperation;
iIDList : PItemIDList;
iItemArray : IShellItemArray;
Count : DWord;
begin
iFileOp := CreateComObject(CLSID_FileOperation) as IFileOperation;
iIDList := ILCreateFromPath(sPath);
try
OleCheck(SHCreateShellItemArrayFromIDLists(1, #iIDList, iItemArray));
finally
ILFree(iIDList);
end;
// Next test the number of items in iItemArray, which I'm expecting to be 1000
// seeing as the CreateFiles routine creates that many
OleCheck(iItemArray.GetCount(Count));
Caption := IntToStr(Count); // Duh, this shows Count to be 1, not the expected 1000
OleCheck(iFileOp.DeleteItems(iItemArray));
OleCheck( iFileOp.PerformOperations );
// Returns Exception 'No object for moniker'
end;
That being said, even if this were working correctly, you are not creating an IShellItemArray containing 1000 IShellItems for the individual files. You are creating an IShellItemArray containing 1 IShellItem for the C:\Temp subdirectory itself.
Which is fine if your goal is to delete the whole folder. But in that case, I would suggest using SHCreateItemFromIDList() or SHCreateItemFromParsingName() instead, and then pass that IShellItem to IFileOperation.DeleteItem().
But, if your goal is to delete the individual files without deleting the subdirectory as well, then you will have to either:
get the IShellFolder interface for the subdirectory, then enumerate the relative PIDLs of its files using IShellFolder.EnumObjects(), and then pass the PIDLs in an array to SHCreateShellItemArray().
get the IShellFolder interface of the subdirectory, then query it for an IDataObject interface using IShellFolder.GetUIObjectOf(), and then use SHCreateShellItemArrayFromDataObject(), or just give the IDataObject directly to IFileOperation.DeleteItems().
get an IShellItem interface for the subdirectory, then query its IEnumShellItems interface using IShellItem.BindToHandler(), and then pass that directly to IFileOperation.DeleteItems().
I'm trying to get the price of medication from the table but i just get:
procedure TForm1.BuyButtonClick(Sender: TObject);
var
iAmount : integer;
rRate : real;
sMedication : string;
sRate : string;
begin
iAmount := 0;
sMedication := BuyCombobox.Items[BuyCombobox.ItemIndex];
dmHospital.qryPrices.SQL.Clear;
dmHospital.qryPrices.SQL.Add('SELECT Price(R) FROM MedicationPrices WHERE Medication = quaotedstr(sMedication)');
sRate := dmHospital.qryPrices.SQL;
ShowMessage(sRate);
end;
You're not using the query properly. qryPrices.SQL is the SQL statement itself. It's just text. You need to do something to actually run the statement. (See below.)
You've also embedded the variable inside the quotes, which means it's not being evaluated, and neither is the function call to the (misspelled) QuotedStr. There is no function quaotedStr(). If you insist on the poor idea of concatenating SQL, you need to do it properly. If you're going to clear and then add, you can just assign to SQL.Text instead to do it in one step:
dmHospital.qryPrices.SQL.Text := 'SELECT Price(R) FROM MedicationPrices WHERE Medication = ' + Quotedstr(sMedication);
Also, the query won't do anything until you actually execute it. You need to use qryPrices.Open to run a SELECT statement, or qryPrices.ExecSQL to run an INSERT, UPDATE or DELETE statement.
You should get out of the thought of concatenating SQL immediately (before you get the habit) and learn to use parameterized queries. It allows the database driver to handle the formatting and conversion and quoting for you, and it also prevents SQL injection that can give others access to your data. Here's a corrected version that should get you started.
procedure TForm1.BuyButtonClick(Sender: TObject);
var
sMedication : string;
sRate : string;
begin
iAmount := 0;
sMedication := BuyCombobox.Items[BuyCombobox.ItemIndex];
dmHospital.qryPrices.SQL.Text := 'SELECT Price(R) FROM MedicationPrices WHERE Medication = :Medication';
dmHospital.qryPrices.Parameters.ParamByName('Medication').Value := sMedication;
dmHospital.qryPrices.Open;
sRate := dmHospital.qryPrices.FieldByName('Price(R)').AsString;
dmHospital.qryPrices.Close;
ShowMessage(sRate);
end;
You should modify Your code to actually work:
My advise is to use parameters instead of QuotedStr:
dmHospital.qryPrices.SQL.Clear;
dmHospital.qryPrices.SQL.Add('SELECT Price(R) AS Rate FROM MedicationPrices WHERE Medication = :pMedication');
dmHospital.qryPrices.Params.ParamByName('pMedication').AsString=sMedication;
(Note that in ADOQuery You'd use .Parameters instead of .Params)
dmHospital.qryPrices.Open;
sRate=dmHospital.qryPrices.FieldByName('Rate').AsString;
ShowMessage(sRate);
Regards
Not tested it (dont have Delphi at hand here) but it should be something like this :
iAmount := 0;
sMedication := BuyCombobox.Items[BuyCombobox.ItemIndex];
dmHospital.qryPrices.SQL.Clear;
dmHospital.qryPrices.SQL.Add('SELECT Price(R) as price FROM MedicationPrices WHERE Medication = ' + QuotedStr(sMedication));
dmHospital.qryPrices.Open;
if (dmHospital.qryPrices.RecordCount = 1)
sRate := dmHospital.qryPrices.FieldByName('price').AsString;
ShowMessage(sRate);
Can you close all database tables except some? Can you then reopen them? I use an absolute database that is similar to BDE. If this is possible, how can I do so many?
Yes, of course you can. You could iterate the Components property of your form/datamodule, use the is operator to check whether each is an instance of your table type and use a cast to call Open or Close on it.
The following closes all TABSDataSet tables on your form except one called Table1.
procedure TForm1.ProcessTables;
var
ATable : TABSDataSet; // used to access a particular TABSDataSet found on the form
i : Integer;
begin
for i := 0 to ComponentCount - 1 do begin
if Components[i] is TABSDataSet then begin
ATable := TABSDataSet(Components[i]);
// Now that you have a reference to a dataset in ATable, you can
// do whatever you like with it. For example
if ATable.Active and (ATable <> Table1) then
ATable.Close;
end;
end;
end;
I've seen from the code you've posted in comments and your answer that you
are obviously having trouble applying my code example to your situation. You
may find the following code easier to use:
procedure ProcessTables(AContainer : TComponent);
var
ATable : TABSTable;
i : Integer;
begin
for i := 0 to AContainer.ComponentCount - 1 do begin
if AContainer.Components[i] is TABSTable then begin
ATable := TABSTable(AContainer.Components[i]);
// Now that you have a reference to a dataset in ACDS, you can
// do whatever you like with it. For example
if ATable.Active then
ATable.Close;
end;
end;
end;
Note that this is a stand-alone procedure, not a procedure of a particular
form or datamodule. Instead, when you use this procedure, you call it passing
whatever form or datamodule contains the TABSTables you want to work with as the
AContainer parameter, like so
if Assigned(DataModule1) then
ProcessTables(DataModule1);
or
if Assigned(Form1) then
ProcessTables(Form1);
However, the downside of doing it this was is that it is trickier to specify which tables, if any, to leave open, because AContainer, being a TComponent, will not have any member tables.
Btw, your task would probably be easier if you could iterate through the tables in a TABSDatabase. However I've looked at its online documentation but can't see an obvious way to do this; I've asked the publishers, ComponentAce, about this but haven't had a reply yet.
Using Delphi 10 I have two values work_start and work_finish of type TTime that I need to read and write from database table so I though to create a property for each one like that
private
fWorkStart: TTime;
function GetWS: TTime;
procedure SetWS(const Value: TTime);
Public
property WorkStart: TTime read GetWS write SetWS;
....
procedure MyClass.SetWS(const Value: TTime);
begin
fWorkStart := value;
mydataset.Edit;
mydataset.FieldByName('work_start').AsDateTime := fWorkStart;
mydataset.Post;
end;
function MyClass.GetWS: TTime;
begin
if mydataset.FieldByName('work_start').IsNull then
fWorkStart := encodetime(6,0,0,0)
else
fWorkStart := mydataset.FieldByName('work_start').AsDateTime;
result := fWorkStart;
end;
WorkFinish property is the same. So is there a way to create one property for both times or my code is fine ?
Craig's answer demonstrates record properties, which means you have a single property that gets set as a unit; you can't set the start and finish times independently. Dawood's answer demonstrates an array property, which allows independent accesses, but imposes cumbersome bracket notation on the consumer. Kobik's comment improves the semantics, but we can do even better using index specifiers.
First, define an enum to represent the two kinds of times:
type
TWorkTime = (wtStart, wtFinish);
Use those values in your property declarations, and provide an extra parameter to your property accessors to represent the index:
private
FWorkTime: :array[TWorkTime] of TTime;
function GetWT(Index: TWorkTime): TTime;
procedure SetWT(Index: TWorkTime; const Value: TTime);
public
property WorkStart: TTime index wsStart read GetWT write SetWT;
property WorkFinish: TTime index wsFinish read GetWT write SetWT;
To reduce the bloat Craig warns about in your accessors, you can define another array with the corresponding fields names, which lets you avoid duplicating code for your different fields:
const
FieldNames: array[TWorkTime] of string = (
'work_start',
'work_finish'
);
function MyClass.GetWT(Index: TWorkTime): TTime;
begin
if mydataset.FieldByName(FieldName[Index]).IsNull then
FWorkTime[Index] := EncodeTime(6, 0, 0, 0)
else
FWorkTime[Index] := mydataset.FieldByName(FieldNames[Index]).AsDateTime;
Result := FWorkTime[Index];
end;
It is possible:
//Define a record to hold both
type
TTimeRange = record
StartTime: TTime;
EndTime: TTime;
end;
//And have your property use the record
property WorkHours: TTimeRange read GetWorkHours write SetWorkHours;
However, this would force clients of your class to interact using the record structure. Basically the complications you'd encounter outweigh the small benefit you'd gain.
So I don't recommend it.
(Although it's worth remembering the technique because in other scenarios it may prove more useful.)
As for your code:
Handling of properties is fine. Although in the code you've presented fWorkStart is redundant.
I'd caution against Edit and Post within your property writer. Apart from the fact that updating 1 field at a time in the Db would be highly inefficient, your method has unexpected side-effects. (And can you always assume edit is the right choice and not insert?)
In your property reader, assuming NULL == 6:00 is not a good idea. NULL has very specific meaning that the value is unknown/unassigned. Defaulting it in the wrong place leads to being unable to tell the difference between 6:00 and NULL. (I'm not saying never default a null; just understand the implications.)
yes you can use indexed properties
property WorkTime[IsStart: Boolean]: TDataTime read GetWorkTime write SetWorkTime;
procedure MyClass.SetWorkTime(IsStart: Boolean;const value: TDataTime);
begin
mydataset.Edit;
if IsStart then
mydataset.FieldByName('work_start').AsDateTime := value else
mydataset.FieldByName('work_Finish').AsDateTime := value;
mydataset.Post;
end;
function MyClass.GetWorkTime(IsStart: Boolean): TTime;
begin
if IsStart then
Begin
if mydataset.FieldByName('work_start').IsNull then
fWorkStart := encodetime(6,0,0,0)
else
fWorkStart := mydataset.FieldByName('work_start').AsDateTime;
result := fWorkStart;
end else
begin
if mydataset.FieldByName('work_finish').IsNull then
fWorkfinish := encodetime(6,0,0,0)
else
fWorkfinish := mydataset.FieldByName('work_finish').AsDateTime;
result := fWorkfinish;
end
end;
I got a problem with saving all values from 3 datasources into a SMDBGrid with another datasouce.
I got AdressID, ContactpersonID and RelationID.
Those all dont match each others.
The problem is that my SMDBGrid has another datasource then those 3.
I wanna save them with one button.
Tried many ways but can't find a good result.
this is the code i use right now for my Insert button:
procedure TFRelatiebeheer.ToolButton1Click(Sender: TObject);
begin
DRelatiebeheer.ContactpersonID.Insert;
DRelatiebeheer.RelationID.Insert;
DRelatiebeheer.AdressID.Insert;
end;
This is the code i use for my save button right now
if (DRelatiebeheer.ContactpersonID.State in dsEditModes) then
if not (DRelatiebeheer.ContactpersonID.State in [dsInsert]) then
begin
KJSMDBGrid1.RefreshData;
KJPanel4.Visible := True;
end
else
begin
if (DRelatiebeheer.ContactpersonID.State IN dsEditModes) then
DRelatiebeheer.ContactpersonID.Post;
if (DRelatiebeheer.AdressID.State IN dsEditModes) then
DRelatiebeheer.AdressID.Post;
end;
Hope you have a good sight for what I am doing right now, if not please notify.
I got the problem with the datasources that need to be saved on 1 click and then be refreshed in the database and in the Grid.
That means that when I insert a Contactperson there needs to be a AdressID and a RelationID coupled with it.
After that the grid needs to reload all of the data.
Focusing on the given problem
Depending on the intended behavior (should it be possible posting only one or two table(s) or is it necessary to post all tables) the first thing to do would be to ensure that the tables can be posted. You coulds create a function for each table e.g. CanAdressIDBePosted:Boolean to check if required fields are already entered. The condition of the table ContactpersonID would contain additional conditions: needed fields are entered AND CanAdressIDBePosted AND CanRelationIDBePosted. You could create an Action which would be bound on your button with an OnUpdate event which could look like this:
procedure TForm1.PostActionUpdate(Sender: TObject);
begin
TAction(Sender).Enabled := CanAdressIDBePosted and CanContactpersonIDBePosted and CanRelationIDBePosted;
// depending on your requirements (e.g. no need to post RelationID if not entered) it also could be
TAction(Sender).Enabled := CanAdressIDBePosted or CanContactpersonIDBePosted ;
end;
procedure TForm1.PostActionExecute(Sender: TObject);
begin
if CanAdressIDBePosted then AdressID.Post; // ensure ID fields will be generated
if CanRelationIDBePosted then RelationID.Post; // ensure ID fields will be generated
if CanContactpersonIDBePosted then
begin
ContactpersonID.FieldByName('AdressID').value := AdressID.FieldByName('ID').Value;
ContactpersonID.FieldByName('RelationID').value := RelationID.FieldByName('ID').Value;
end;
DateSetBoundToTheGrid.Requery;
// furthor actions you need
end;
Function TForm1.CanAdressIDBePosted:Boolean;
begin
// example implementation
Result := (AdressID.State in [dsEdit,dsInsert]) and (not AdressID.FieldByName('NeededField').IsNull);
end;
Function TForm1.CanContactpersonIDBePosted:Boolean;
begin
// example implementation
Result := (ContactpersonID.State in [dsEdit,dsInsert]) and (not ContactpersonID.FieldByName('NeededField').IsNull)
and CanAdressIDBePosted and CanRelationIDBePosted;
end;
An addidtional Action should be created to cancel if needed:
procedure TForm1.CancelActionExecute(Sender: TObject);
begin
AdressID.Cancel;
RelationID.Cancel;
ContactpersonID.Cancel;
end;
procedure TForm1.CancelActionUpdate(Sender: TObject);
begin
TAction(Sender).Enabled := (AdressID.State in [dsEdit,dsInsert])
or (RelationID.State in [dsEdit,dsInsert])
or (ContactpersonID.State in [dsEdit,dsInsert]);
end;
In general I am not sure if the approach you took ist the best which can be taken, since from the structure given IMHO it should be possible to assign already existing relations and adresses to new generated contactpersons, but that would be another question.
This code just looks somewhat random to me. What SHOULD happen there ?
if (DRelatiebeheer.ContactpersonID.State in dsEditModes) then
// remember this check (1)
if not (DRelatiebeheer.ContactpersonID.State in [dsInsert]) then
// this check better written as "...State = dsInsert"
begin
// why don't you call DRelatiebeheer.ContactpersonID.Post to save chanegs ?
KJSMDBGrid1.RefreshData;
KJPanel4.Visible := True;
end
else
begin
if (DRelatiebeheer.ContactpersonID.State IN dsEditModes) then
// you already checked this above (1), why check again ?
DRelatiebeheer.ContactpersonID.Post;
if (DRelatiebeheer.AdressID.State IN dsEditModes) then
DRelatiebeheer.AdressID.Post;
end;
// so what about DRelatiebeheer.RelationID ?
For what i may deduce, you don't have to make any complex if-ladders, you just have to literally translate your words to Delphi. You want to save three tables and then refresh the grid. Then just do it.
procedure TFRelatiebeheer.SaveButtonClick(Sender: TObject);
begin
DRelatiebeheer.ContactpersonID.Post;
DRelatiebeheer.RelationID.Post;
DRelatiebeheer.AdressID.Post;
DatabaseConnection.CommitTrans;
KJSMDBGrid1.RefreshData;
KJPanel4.Visible := True;
end;
Just like you was told in your other questions.
Delphi save all values from different datasources with 1 save button
Delphi set Panel visible after post
PS. ToolButton1Click - plase, DO rename the buttons. Believe me when you have 10 buttons named Button1, Button2, ...Button10 you would never be sure what each button should do and would mix everything and make all possible program logic errors.