I'm trying to use SQL to display fields which the user selects in a TCheckListBox onto a TDBGrid.
I thought arrays may help. Here's my code, it doesn't execute:
Var
arrFields : array [1..9] of string = ('UserId','Surname','Name','EMail',
'Gender','DOB','ContinentOfOririn','Passport','IDNumber');
implementation
{$R *.dfm}
procedure TfrmUsersMan.pnlDisplayClick(Sender: TObject);
Var
I: Integer;
arrTempArray: Array [1..10] of String;
begin
for i := 0 to chkDisplay.Items.Count - 1 do
begin
if chkDisplay.Checked[i] then
arrTempArray[i+1]:='Checked';
With dmTourists do
begin
qryUsers.Active:=False;
qryUsers.SQL.Clear;
qryUsers.SQL.Add('SELECT ''arrFileds[i]'' FROM tblUsers WHERE ''(arrTemp[i+1]=Checked)''');
qryUsers.Active:=True;
end;
end;
end;
End;
Related
Using Delphi 2010
Can anyone tell me what I am doing wrong here with my code. The comments show the errors that I receive with the particular methods that I tried to pass parameters to my ADOQuery
procedure CreateAdminLogin(const APasswd: string);
var
qry: TADOQuery;
//P1, P2: TParameter;
begin
qry := TADOQuery.Create(nil);
try
qry.Connection := frmDataModule.conMain;
qry.SQL.Text := 'INSERT INTO Users (User_Id, Password) VALUES (:u, :p)';
//Syntax error in INTO statement
qry.Parameters.ParamByName('u').Value:= 'Admin';
qry.Parameters.ParamByName('p').Value:= GetMd5(APasswd);
//invalid variant operation
{qry.Parameters.ParamByName('u').Value.AsString:= 'Admin';
qry.Parameters.ParamByName('p').Value.AsString:= GetMd5(APasswd);}
//invalid variant operation
{P1:= qry.Parameters.ParamByName('u');
P1.Value.asString:= 'Admin';
P2:= qry.Parameters.ParamByName('p');
P2.Value.asString:= GetMd5(APasswd);}
qry.Prepared := True;
qry.ExecSQL;
finally
qry.Free;
end;
end;
NOTE: GetMD5 is declared as follows
function GetMd5(const Value: String): string;
var
hash: MessageDigest_5.IMD5;
fingerprint: string;
begin
hash := MessageDigest_5.GetMd5();
hash.Update(Value);
fingerprint := hash.AsString();
Result := fingerprint;
end;
Thankx
This works fine for me, using the DBDemos.MDB file that shipped with Delphi (C:\Users\Public\Documents\RAD Studio\9.0\Samples\Data\dbdemos.mdb by the default installation)
ADOQuery1.SQL.Clear;
ADOQuery1.SQL.Add('INSERT INTO Country (Name, Capital, Continent, Area, Population)');
ADOQuery1.SQL.Add('VALUES (:Name, :Capital, :Continent, :Area, :Population)');
ADOQuery1.Parameters.ParamByName('Name').Value := 'SomePlace';
ADOQuery1.Parameters.ParamByName('Capital').Value := 'Pitsville';
ADOQuery1.Parameters.ParamByName('Continent').Value := 'Floating';
ADOQuery1.Parameters.ParamByName('Area').Value := 1234;
ADOQuery1.Parameters.ParamByName('Population').Value := 56;
ADOQuery1.ExecSQL;
ADOQuery1.Close;
// Open it to read the data back
ADOQuery1.SQL.Text := 'SELECT * FROM Country WHERE Name = :Name';
ADOQuery1.Parameters.ParamByName('Name').Value := 'SomePlace';
ADOQuery1.Open;
ShowMessage(ADOQuery1.FieldByName('Name').AsString);
For using like extra thing to know:
Datasource SQL like this
select * from Table where Phone like :param
DataModule.findQuery.Parameters.ParamByName('param').Value:= '%%'+yourEdit.Text + '%%';
You should create parameters first:
procedure CreateAdminLogin(const APasswd: string);
var
qry: TADOQuery;
begin
qry := TADOQuery.Create(nil);
try
// this part is missed in your code
with qry.Parameters.AddParameter do
begin
Name := 'u';
DataType := ftString;
end;
with qry.Parameters.AddParameter do
begin
Name := 'p';
DataType := ftString;
end;
qry.Connection := frmDataModule.conMain;
qry.SQL.Text := 'INSERT INTO Users (User_Id, Password) VALUES (:u, :p)';
// Now it will be ok!
qry.Parameters.ParamByName('u').Value:= 'Admin';
qry.Parameters.ParamByName('p').Value:= GetMd5(APasswd);
qry.Prepared := True;
qry.ExecSQL;
finally
qry.Free;
end;
end;
Sorry if this question is a duplicate but I couldn't find any solution to my problem anywhere...
The code below shows how I'm assigning values from a listview into an object that is a property of another object:
Main Unit:
procedure TForm1.SBCadClick(Sender: TObject);
var
Procedimento: TProcedimento;
Produto: TItemProcedimento;
item: TListViewItem;
begin
...
Procedimento := TProcedimento.Create;
for item in LVItensProcedimento.Items do
begin
Produto := TItemProcedimento.Create;
Produto.PRO_ID := item.Tag;
Produto.IPR_Uso := TListItemText(item.Objects.FindDrawable('IPR_Uso'))
.Text.ToDouble;
Procedimento.AddPRC_Produtos(Produto);
Produto.DisposeOf;
end;
DM.gravaProcedimento(Procedimento); // from here we go into another unit to use its function, passing an object as a parameter
Before the command DM.gravaProcedimento(Procedimento); the produto is correctly being added to the TObjectList of TProcedimento, I can get its contents correctly with Procedimento.GetPRC_Produtos. But when I debug the next unit shown below, its getting random IDs that means its not being persisted from one unit to the other:
unit DM:
procedure TDM.gravaProcedimento(Procedimento: TProcedimento);
var
produto: TItemProcedimento;
dura: string;
begin
...
produto := TItemProcedimento.Create;
for produto in Procedimento.GetPRC_Produtos do
begin
DM.FDQ.Append;
DM.FDQ.FieldByName('PRO_ID').AsInteger := produto.PRO_ID; // here the value gets a random ID like 45684 instead of the current item ID
DM.FDQ.FieldByName('PRC_ID').AsInteger := Procedimento.PRC_ID;
DM.FDQ.FieldByName('IPR_Uso').AsFloat := produto.IPR_Uso;
DM.FDQ.Post;
end;
produto.DisposeOf;
DM.FDQ.ApplyUpdates;
DM.FDQ.Close;
end;
This is the class definition of my objects:
unit uClasses;
interface
uses
System.SysUtils, System.Types, Generics.Collections;
type
TItemProcedimento = class
private
FPRO_Nome: string;
FPRO_Tipo: integer;
FPRO_Custo: double;
FPRO_ID: integer;
FPRO_Rendimento: integer;
FPRO_Potencia: double;
FIPR_Uso: double;
procedure SetPRO_Custo(const Value: double);
procedure SetPRO_ID(const Value: integer);
procedure SetPRO_Nome(const Value: string);
procedure SetPRO_Rendimento(const Value: integer);
procedure SetPRO_Tipo(const Value: integer);
procedure SetPRO_Potencia(const Value: double);
procedure SetIPR_Uso(const Value: double);
public
constructor Create;
published
property PRO_Rendimento: integer read FPRO_Rendimento
write SetPRO_Rendimento;
property PRO_ID: integer read FPRO_ID write SetPRO_ID;
property PRO_Nome: string read FPRO_Nome write SetPRO_Nome;
property PRO_Tipo: integer read FPRO_Tipo write SetPRO_Tipo;
property PRO_Custo: double read FPRO_Custo write SetPRO_Custo;
property PRO_Potencia: double read FPRO_Potencia write SetPRO_Potencia;
property IPR_Uso: double read FIPR_Uso write SetIPR_Uso;
end;
TProcedimento = class
private
FPRC_Nome: string;
FPRC_Duracao: TDateTime;
FPRC_Preco: double;
FPRC_ID: integer;
FPRC_Consumo: double;
FPRC_Produtos: TObjectList<TItemProcedimento>;
procedure SetPRC_Consumo(const Value: double);
procedure SetPRC_Duracao(const Value: TDateTime);
procedure SetPRC_ID(const Value: integer);
procedure SetPRC_Nome(const Value: string);
procedure SetPRC_Preco(const Value: double);
public
constructor Create;
function GetPRC_Produtos: TObjectList<TItemProcedimento>;
procedure AddPRC_Produtos(const Value: TItemProcedimento);
procedure DelPRC_Produtos(const Value: TItemProcedimento);
procedure CleanPRC_Produtos;
published
property PRC_Preco: double read FPRC_Preco write SetPRC_Preco;
property PRC_Consumo: double read FPRC_Consumo write SetPRC_Consumo;
property PRC_ID: integer read FPRC_ID write SetPRC_ID;
property PRC_Nome: string read FPRC_Nome write SetPRC_Nome;
property PRC_Duracao: TDateTime read FPRC_Duracao write SetPRC_Duracao;
end;
implementation
{ TProcedimento }
procedure TProcedimento.CleanPRC_Produtos;
begin
if not Assigned(FPRC_Produtos) then
FPRC_Produtos := TObjectList<TItemProcedimento>.Create
else
FPRC_Produtos.Clear;
end;
constructor TProcedimento.Create;
begin
SetPRC_Consumo(0);
SetPRC_Duracao(0);
SetPRC_ID(0);
SetPRC_Nome('');
SetPRC_Preco(0);
end;
procedure TProcedimento.DelPRC_Produtos(const Value: TItemProcedimento);
begin
FPRC_Produtos.Delete(FPRC_Produtos.IndexOf(Value));
end;
function TProcedimento.GetPRC_Produtos: TObjectList<TItemProcedimento>;
begin
if Assigned(FPRC_Produtos) then
result := FPRC_Produtos
else
begin
CleanPRC_Produtos;
result := FPRC_Produtos;
end;
end;
procedure TProcedimento.SetPRC_Consumo(const Value: double);
begin
FPRC_Consumo := Value;
end;
procedure TProcedimento.SetPRC_Duracao(const Value: TDateTime);
begin
FPRC_Duracao := Value;
end;
procedure TProcedimento.SetPRC_ID(const Value: integer);
begin
FPRC_ID := Value;
end;
procedure TProcedimento.SetPRC_Nome(const Value: string);
begin
FPRC_Nome := Value;
end;
procedure TProcedimento.SetPRC_Preco(const Value: double);
begin
FPRC_Preco := Value;
end;
procedure TProcedimento.AddPRC_Produtos(const Value: TItemProcedimento);
begin
FPRC_Produtos.Add(Value);
end;
{ TItemProcedimento }
constructor TItemProcedimento.Create;
begin
SetPRO_Custo(0);
SetPRO_ID(0);
SetPRO_Nome('');
SetPRO_Tipo(0);
SetPRO_Rendimento(0);
end;
procedure TItemProcedimento.SetIPR_Uso(const Value: double);
begin
FIPR_Uso := Value;
end;
procedure TItemProcedimento.SetPRO_Custo(const Value: double);
begin
FPRO_Custo := Value;
end;
procedure TItemProcedimento.SetPRO_ID(const Value: integer);
begin
FPRO_ID := Value;
end;
procedure TItemProcedimento.SetPRO_Nome(const Value: string);
begin
FPRO_Nome := Value;
end;
procedure TItemProcedimento.SetPRO_Potencia(const Value: double);
begin
FPRO_Potencia := Value;
end;
procedure TItemProcedimento.SetPRO_Rendimento(const Value: integer);
begin
FPRO_Rendimento := Value;
end;
procedure TItemProcedimento.SetPRO_Tipo(const Value: integer);
begin
FPRO_Tipo := Value;
end;
end.
Any particular reason why this is happening? What am I doing wrong here?
The problem is that you are destroying the TItemProcedimento objects before gravaProcedimento() has a chance to use them.
You are calling Produto.DisposeOf() immediately after Procedimento.AddPRC_Produtos(Produto) exits, and also in gravaProcedimento(), too. DO NOT DO THAT!
AddPRC_Produtos() saves the original Produto object into a TObjectList, which takes ownership of the object (as TObjectList is set to OwnsObjects=True by default). That means the object will be destroyed automatically when it is removed from the list, which includes when the list is cleared or destroyed.
So, you need to get rid of your DisposeOf() calls completely.
Also, you need to get rid of the call to TItemProcedimento.Create in gravaProcedimento(), too. It does not belong there. All you are doing by that is creating a memory leak on non-ARC systems.
It seems you do not have a firm grasp of how Delphi object lifetimes actually work. You DO NOT need to call Create on an object variable before assigning an object instance to it. And you DO NOT need to call DisposeOf() on an object variable when you are doing using the variable, only when you are done using the object itself (which TObjectList will handle for you).
Try this instead:
procedure TForm1.SBCadClick(Sender: TObject);
var
Procedimento: TProcedimento;
Produto: TItemProcedimento;
item: TListViewItem;
begin
...
Procedimento := TProcedimento.Create;
try
for item in LVItensProcedimento.Items do
begin
Produto := TItemProcedimento.Create;
try
Produto.PRO_ID := item.Tag;
Produto.IPR_Uso := TListItemText(item.Objects.FindDrawable('IPR_Uso')).Text.ToDouble;
Procedimento.AddPRC_Produtos(Produto);
// Produto.DisposeOf; // <-- DO NOT DO THIS HERE!!!
except
Produto.DisposeOf; // <-- DO THIS HERE INSTEAD, if AddPRC_Produtos fails!!!
raise;
end;
end;
DM.gravaProcedimento(Procedimento);
finally
Procedimento.DisposeOf; // <-- ADD THIS, if needed!!!
end;
end;
procedure TDM.gravaProcedimento(Procedimento: TProcedimento);
var
produto: TItemProcedimento;
dura: string;
begin
...
// produto := TItemProcedimento.Create; // <- DO NOT DO THIS!!!
for produto in Procedimento.GetPRC_Produtos do
begin
FDQ.Append;
try
FDQ.FieldByName('PRO_ID').AsInteger := produto.PRO_ID;
FDQ.FieldByName('PRC_ID').AsInteger := Procedimento.PRC_ID;
FDQ.FieldByName('IPR_Uso').AsFloat := produto.IPR_Uso;
FDQ.Post;
except
FDQ.Cancel; // <-- ADD THIS!!!
raise;
end;
end;
// produto.DisposeOf; // <-- DO NOT DO THIS!!!
FDQ.ApplyUpdates;
FDQ.Close;
end;
You should not call Produto.DisposeOf in procedure TForm1.SBCadClick.
You are destroying the object you have just added..
I am trying to create a structure:
MyTopic
TopicID : String;
HelpID : Integer;
I wanted to create an array of these structures so I could sort them.
I have tried using this type / record syntax but it is failing.
Update
I defined this type and procedure:
type
TMyTopicRecord = record
idTopic : String;
idContextHelp : integer;
End;
procedure GetSortedTopicIDs(aTopics : array of String; size : Integer);
var
aMyTopicRecords : array of TMyTopicRecord;
temp : TMyTopicRecord;
iTopic, i, j : Integer;
begin
// Init the array
SetLength(aMyTopicRecords, size);
// Fill the array with the existing topid ids.
// Get the context ids at the same time.
for iTopic := 0 to size - 1 do
aMyTopicRecords[iTopic].idTopic := aTopics[iTopic];
aMyTopicRecords[iTopic].idContextHelp := HndTopics.GetTopicHelpContext(aTopics[iTopic]);
// Sort the array on context id
for i := size-1 DownTo 1 do
for j := 2 to i do
if (aMyTopicRecords[j-1].idContextHelp > aMyTopicRecords[j].idContextHelp) Then
begin
temp := aMyTopicRecords[j-1];
aMyTopicRecords[j-1] := aMyTopicRecords[j];
aMyTopicRecords[j] := temp;
end;
// Rebuild the original array of topic ids
for iTopic := 0 to size - 1 do
aTopics[iTopic] := aMyTopicRecords[iTopic].idTopic;
end;
The procedure gets called in a loop of the parent function (code snipped):
function GetKeywordsAsHtml(): string;
var
aKeywordList: THndKeywordsInfoArray;
aAssociatedTopics: array of string;
nBlocLevel, nDif, nClose, nCurKeywordLevel, nCurKeywordChildrenCnt: Integer;
nCurKeyword, nCurKeywordTopic: Integer;
nCountAssociatedTopics: Integer;
sCurrentKeyword, sKeywordLink, sKeywordRelated: string;
sKeywordJsCaption: string;
begin
Result := '<ul>';
nBlocLevel := 0;
try
aKeywordList := HndKeywords.GetKeywordList(False);
for nCurKeyword := 0 to length(aKeywordList) - 1 do
begin
sCurrentKeyword := aKeywordList[nCurKeyword].id;
nCurKeywordLevel := HndKeywords.GetKeywordLevel(sCurrentKeyword);
nCurKeywordChildrenCnt := HndKeywords.GetKeywordDirectChildrenCount(sCurrentKeyword);
sKeywordLink := '#';
sKeywordRelated := '[]';
aAssociatedTopics := HndTopicsKeywords.GetTopicsAssociatedWithKeyword(sCurrentKeyword);
nCountAssociatedTopics := Length(aAssociatedTopics);
if nCountAssociatedTopics > 0 then
begin
GetSortedTopicIDs(aAssociatedTopics, nCountAssociatedTopics);
// Code snipped
end;
end;
finally
Result := Result + '</ul>';
end;
end;
The script compiled in the HelpNDoc internal editor with no issues. But when I go to actually build my HTML documentation I encounter a problem:
The HelpNDoc API is explained here.
Is there something wrong with my code?
I decided to go about it a different way and used a simpler technique:
procedure GetSortedTopicIDs(var aTopics : array of String; iNumTopics : Integer);
var
iTopic : Integer;
// List of output
aList: TStringList;
begin
// Init list
aList := TStringList.Create;
// Build a new array of "nnn x"
// - nnn is the help context id
// - x is the topid id
// Note: I know that the context ID values are within the range 0 - 200
for iTopic := 0 to iNumTopics - 1 do
// We pad the context id with 0. We could increase the padding width to
// make the script mre useful
aList.Add(Format('%0.3d %s', [
HndTopics.GetTopicHelpContext(aTopics[iTopic]),
aTopics[iTopic]
]));
// Now we sort the new array (which basically sorts it by context id)
aList.Sort;
// Update original array
for iTopic := 0 to iNumTopics - 1 do
// We ignore the "nnn " part of the string to get just the topic id
aTopics[iTopic] := copy(aList[iTopic],5, length(aList[iTopic])-4);
// Tidy up
aList.Free;
end;
This compiles and I get the sorted array of topic IDs at the end of it. So the pop-up help is now listed as I want.
I'm new to delphi and am trying to start OOP. However I get an access violation when using public property to set a private field.
type
User = class;
TData = class
private
CurrUser: User;
Connection: TFDConnection;
Query: TFDQuery;
procedure SetUser(newUser: User);
procedure SetConnection(newConn: TFDConnection);
procedure SetQuery(newQry: TFDQuery);
public
property CUser: User read CurrUser write SetUser;
property Conn: TFDConnection read Connection write SetConnection;
property Qry: TFDQuery read Query write SetQuery;
class procedure Login(uID: integer); static;
class procedure Logout(uID: integer); static;
class procedure ExitApp(); static;
end;
implementation
{$R *.fmx}
procedure TData.SetUser(newUser: User);
begin
CurrUser := newUser;
end;
procedure TData.SetConnection(newConn: TFDConnection);
begin
Connection := newConn;
end;
procedure TData.SetQuery(newQry: TFDQuery);
begin
Query := newQry;
end;
I expect to be able to set the Connection using that property however it gives me the access violation with any code that uses the property write:
TData.Conn.LoginPrompt := False;
TData.Conn.Connected := True;
var
TData: frmData.TData;
LoginForm: TLoginForm;
ErrorCount : integer;
implementation
{$R *.fmx}
procedure TLoginForm.ExitAppButtonClick(Sender: TObject);
begin
TData.ExitApp;
end;
procedure TLoginForm.LoginButtonClick(Sender: TObject);
var
companyPath : string;
nurseID : integer;
begin
if(UsernameInput.Text = '') or (PasswordInput.Text = '') or (PincodeInput.Text = '') then
begin
ShowMessage('Please enter your login details.');
Exit;
end;
try
TData.Conn := TFDConnection.Create(nil);
TData.Conn.Params.DriverID := 'MSAcc';
TData.Conn.Params.Database := 'D:\PulseDB\AlfaPersonnel\Pulse.mdb';
TData.Conn.LoginPrompt := False;
TData.Conn.Connected := True;
if(TData.Conn.Connected <> True) then
begin
ShowMessage('Could not connect, try again');
Exit;
end
else //When Connection
begin
TData.Qry := TFDQuery.Create(TData.Conn);
try
TData.Qry.Connection := TData.Conn;
TData.Qry.SQL.Text := 'SELECT * FROM NurseLogin WHERE Username=:uname AND Password=:pword AND PinCode=:pin;';
TData.Qry.Params.ParamByName('uname').AsString := UsernameInput.Text;
TData.Qry.Params.ParamByName('pword').AsString := PasswordInput.Text;
TData.Qry.Params.ParamByName('pin').AsString := PincodeInput.Text;
TData.Qry.Active := True;
if TData.Qry.RecordCount = 0 then ShowMessage('Details not recognised.')
else if TData.Qry.RecordCount = 1 then
begin
if TData.Qry.FieldByName('IsActive').AsBoolean then //If the user is active
begin
try
//Connect to the path
companyPath := TData.Qry.FieldByName('CompanyName').AsString;
TData.Conn.Params.Database := 'D\PulseDB\' + companyPath + '\Pulse.mdb';
TData.Conn.Connected := True;
ShowMessage('Connected to ' + companyPath);
finally
end;
end;
end;
finally
end;
end;
finally
end;
end;
You don't ever create an instance of your TData class. At some point you need to write:
TData := frmData.TData.Create;
Which is how you instantiate an instance. And you need to destroy it when you are finished also. Like this:
TData.Free;
That you did not instantiate an instance is the explanation for your access violation.
Some other issues:
Use the T prefix for types. Your variable should be named Data rather than TData.
Don't use global variables if at all possible.
I am using TMemIniFile to store configuration and I need to sort the sections in alpha order.
For that I have created a descendant of TMemIniFile
TRWStudioMemIniFile = class(TMemIniFile)
public
procedure UpdateFile; override;
procedure GetSortedStrings(List: TStrings);
end;
{ TRWStudioMemIniFile }
procedure TRWStudioMemIniFile.GetSortedStrings(List: TStrings);
var
I, J: Integer;
Strings: TStrings;
begin
List.BeginUpdate;
try
Sections.Sort;
for I := 0 to Sections.Count - 1 do
begin
List.Add('[' + Sections[I] + ']');
Strings := TStrings(Sections.Objects[I]);
for J := 0 to Strings.Count - 1 do List.Add(Strings[J]);
List.Add('');
end;
finally
List.EndUpdate;
end;
end;
procedure TRWStudioMemIniFile.UpdateFile;
var
List: TStringList;
begin
List := TStringList.Create;
try
GetSortedStrings(List);
List.SaveToFile(FileName, Encoding);
finally
List.Free;
end;
end;
but it needs to have access to the Sections (actually FSections: TStringList, that is a private member of TMemIniFile)
I have created a Helper class to expose that member thru a property. However this behavior is not supported anymore in Delphi 10.1
I started copy/paste the TMemIniFile to my unit and after and endless process I am ending up making a copy of the entire System.IniFile, just to access the FSections.
My question is how to access that FSections member without need to duplicate everything from that unit just to gain visibility
OR is there another way that I can Sort the Sections before saving? (I am just calling the TStringList.Sort from FSections)
Rather than relying on type-casting and "cracking open" the private member, you can instead get the sections into your own TStringList using the inherited ReadSections() method, sort that list as needed, and then use the inherited ReadSectionValues() method to read the strings for each section:
var
sections: TStringList;
values: TStringList;
begin
sections := TStringList.Create;
try
ReadSections(sections);
sections.Sort;
values := TStringList.Create;
try
List.BeginUpdate;
try
for I := 0 to sections.Count - 1 do
begin
List.Add('[' + sections[I] + ']');
values.Clear; // Just in case
ReadSectionValues(sections[i], values);
for J := 0 to values.Count - 1 do
List.Add(values[J]);
List.Add('');
end;
finally
List.EndUpdate;
end;
finally
values.Free;
end;
finally
sections.Free;
end;
end;