Firstly, I am new to these and the question could be stupid. Anyway, I have a procedure like this:
procedure Tform1.QueryChange(sqltext : String; query : Integer);
begin
if query = 1 then begin
ADOQuery1.Close;
ADOQuery1.SQL.Clear;
ADOQuery1.SQL.Add(sqltext);
ADOQuery1.Open;
end;
if query = 2 then begin
ADOQuery2.Close;
ADOQuery2.SQL.Clear;
ADOQuery2.SQL.Add(sqltext);
ADOQuery2.Open;
end;
I would like to remove the if blocks and make one united code:
ADOQuery+query.Close; (know that looks very silly)
ADOQuery+query.SQL.Clear;
ADOQuery+query.SQL.Add(sqltext);
ADOQuery+query.Open;
My goal is when query=1 code will use ADOQuery1.Close; etc.
when query=2 code will use ADOQuery2.Close;
You could create a local variable that referred to the TADOQuery object that you wish to operate on. Like this:
var
ADOQuery: TADOQuery;
begin
if query=1 then
ADOQuery := ADOQuery1
else if query=2 then
ADOQuery := ADOQuery2;
ADOQuery.Close;
ADOQuery.SQL.Clear;
ADOQuery.SQL.Add(sqltext);
ADOQuery.Open;
end;
Instead of creating variables ADOQuery1, ADOQuery2, ADOQuery3 etc of type TADOQuery, create an array:
ADOQueries: array of TADOQuery;
Then set the number of elements in it, when you know how many they will be:
SetLength(ADOQueries, NumberOfQueries);
Alternatively, if you know from the beginning how many elements there will be, you can define ADOQueries to be a static array instead:
ADOQueries: array[0..7] of TADOQuery;
Now you can do
procedure TForm1.QueryChange(sqltext: String; query: Integer);
begin
ADOQueries[Query].Close;
ADOQueries[Query].SQL.Clear;
ADOQueries[Query].SQL.Add(sqltext);
ADOQueries[Query].Open;
end;
Another way you can do this is with the FindComponent method, ie assuming the form owns the query components
procedure Tform1.QueryChange(sqltext : String; query : Integer);
var cmp: TComponent;
Query: TADOQuery;
begin
cmp := FindComponent('ADOQuery' + IntToStr(query));
if cmp <> nil then begin
Query := cmp as TADOQuery;
Query.Close;
...
end;
end;
Related
I have two procedures that almost identical the only difference is the data type of one of the parameters.
procedure InsertNewStringAnswer(AidQuestion: Integer; AAnswer: String);
and
procedure InsertNewBoolAnswer(AidQuestion: Integer; AAnswer: Boolean);
I need to change the answer type based on the question. Do I have to write two procedures and call them with a third or is there a way I can change the data type of the parameter AAnswer at runtime?
I am editing this to show How I build the solution. In this case I used Variant type. I cannot verify if this is best practice but it works:).
procedure InsertNewAnswer(AidQuestion: Integer; AAnswer: Variant);
var
idNextRecord: string;
isBoolean: Boolean;
StrAAnswer: String;
BoolAAnswer: Boolean;
begin
With Connection.queryMain Do
begin
SQL.Clear;
SQL.Text := 'select count(*) as summe from dbo.Answer';
Open;
end;
idNextRecord := Connection.queryMain.FieldByName('summe').Asstring;
With Connection.queryMain Do
begin
SQL.Clear;
//Here I check if the question has a boolean or string answer.
SQL.Text :=('select isBool from dbo.Questions AS ISBOOL WHERE idQuestion= :SQLAidQuestion;');
ParamByName('SQLAidQuestion').AsInteger := AidQuestion;
Prepare;
Open;
end;
//and write it to a Variable.
isBoolean := Connection.queryMain.FieldByName('isBool').AsBoolean;
Connection.queryMain.SQL.Clear;
//I then use a if statement to change the Variant Type accordingly
if isBoolean = True then
begin
//Note that System.Variants does not have VarToBool so I use a workaround
BoolAAnswer := StrToBool(VarToStr(AAnswer));
AAnswer := BoolAAnswer;
Connection.queryMain.SQL.Text :=
('INSERT INTO Frueherkennung.dbo.Answer' +
'(idAnswer, idQuestion, Answer)VALUES(' + idNextRecord +
', :sqlQuestion, :sqlAAnswer);');
Connection.queryMain.ParamByName('sqlQuestion').AsInteger := AidQuestion;
Connection.queryMain.ParamByName('sqlAAnswer').AsBoolean := AAnswer;
end
else
begin
StrAAnswer := VarToStr(AAnswer);
MessageDlg('iSBool:= False', mtError, [mbok], 0);
AAnswer := StrAAnswer;
Connection.queryMain.SQL.Text :=('INSERT INTO Frueherkennung.dbo.Answer' +
'(idAnswer, idQuestion, Answer)VALUES(' + idNextRecord +
', :sqlQuestion, :sqlAAnswer);');
Connection.queryMain.ParamByName('sqlQuestion').AsInteger := AidQuestion;
Connection.queryMain.ParamByName('sqlAAnswer').Asstring := AAnswer
end;
With Connection.queryMain Do
begin
Prepare;
Execute;
SQL.Clear;
end;
end;
Thank you everyone for your awesome answers.
You can write a single function if the AAnswer argument is of type variant which allows almost anything in it.
You can also keep two procedures but with same name using the overload keyword.
And you can also have a single procedure taking AAnswer as untyped pointer to the storage the caller want to use. Of course at that moment, the question must contain the necessary information to decide if the point point to a boolean or to a string.
This last option is really not recommended. For me the cleanest solution is using overloaded procedures.
Forgot another possibility: use AAnswer of type array of const.
Sounds like a job for Generics.
In XE7 and later, you can do this:
type
TQuestion = class
public
class procedure InsertNewAnswer<T>(AidQuestion: Integer; AAnswer: T);
end;
class procedure TQuestion.InsertNewAnswer<T>(AidQuestion: Integer; AAnswer: T);
begin
case GetTypeKind(T) of
tkString, tkLString, tkUString, tkWString:
InsertNewStringAnswer(AidQuestion, AAnswer);
tkEnumeration:
if GetTypeData(TypeInfo(T))^.BaseType^ = TypeInfo(Boolean) then
InsertNewBoolAnswer(AidQuestion, PBoolean(#AAnswer)^);
...
end;
end;
Prior to XE7, you can do this instead:
type
TQuestion = class
public
class procedure InsertNewAnswer<T>(AidQuestion: Integer; AAnswer: T);
end;
...
uses
..., TypInfo;
class procedure TQuestion.InsertNewAnswer<T>(AidQuestion: Integer; AAnswer: T);
begin
case PTypeInfo(TypeInfo(T)).Kind of
tkString:
InsertNewStringAnswer(AidQuestion, PShortString(#AAnswer)^);
tkLString:
InsertNewStringAnswer(AidQuestion, PAnsiString(#AAnswer)^);
tkUString:
InsertNewStringAnswer(AidQuestion, PUnicodeString(#AAnswer)^);
tkWString:
InsertNewStringAnswer(AidQuestion, PWideString(#AAnswer)^);
tkEnumeration:
if GetTypeData(TypeInfo(T))^.BaseType^ = TypeInfo(Boolean) then
InsertNewBoolAnswer(AidQuestion, PBoolean(#AAnswer)^);
...
end;
end;
Either way, you can then call it like this:
TQuestion.InsertNewAnswer<String>(id, '...');
TQuestion.InsertNewAnswer<Boolean>(id, true);
...
I am using an in-memory TClientDataSet with a TStringField column which contains folders path (Delphi 7).
When I create an index on this column the order is not what I am looking for.
As an example I get :
c:\foo
c:\fôo\a
c:\foo\b
when I would like this order :
c:\foo
c:\foo\b
c:\fôo\a
So I searched a way to use my own compare field function.
Based on this RRUZ answer How to change the implementation (detour) of an externally declared function I tried the following :
type
TClientDataSetHelper = class(DBClient.TClientDataSet);
...
MyCDS : TClientDataSet;
...
// My custom compare field function
function FldCmpHack
(
iFldType : LongWord;
pFld1 : Pointer;
pFld2 : Pointer;
iUnits1 : LongWord;
iUnits2 : LongWord
): Integer; stdcall;
begin
// Just to test
Result := -1;
end;
...
---RRUZ code here---
...
procedure HookDataCompare;
begin
HookProc
(
(MyCDs as TClientDataSetHelper).DSBase.FldCmp, <== do not compile !!!
#FldCmpHack,
FldCmpBackup
);
end;
When I try to compile I get an error (MyCDs as TClientDataSetHelper).DSBase.FldCmp : not enough actual parameters
I do not understand why this does not compile. Could you please help me ?
Is it even possible to "detour" IDSBase.FldCmp in DSIntf.pas ? Am i totally wrong ?
Thank you
EDIT
Finally, thanks to Dsm answer, I transformed the TStringFieldcolumn into a TVarBytesField in order to avoid doubling the buffer. Plus, when a TVarBytesField is indexed the order is based on the bytes value so I get the order I want. For having all child folders after a parent folder and before the next parent folder (c:\foo.new after c:\foo\b), I patched TVarBytesFieldlike this :
TVarBytesField = class(DB.TVarBytesField)
protected
function GetAsString: string; override;
procedure GetText(var Text: string; DisplayText: Boolean); override;
procedure SetAsString(const Value: string); override;
end;
function TVarBytesField.GetAsString: string;
var
vBuffer : PAnsiChar;
vTaille : WORD;
vTexte : PAnsiChar;
vI : WORD;
begin
Result := '';
GetMem(vBuffer, DataSize);
try
if GetData(vBuffer) then
begin
vTaille := PWORD(vBuffer)^;
vTexte := vBuffer + 2;
SetLength(Result, vTaille);
for vI := 1 to vTaille do
begin
if vTexte^ = #2 then
begin
Result[vI] := '\';
end
else
begin
Result[vI] := vTexte^;
end;
Inc(vTexte);
end;
end;
finally
FreeMem(vBuffer);
end;
end;
procedure TVarBytesField.GetText(var Text: string; DisplayText: Boolean);
begin
Text := GetAsString;
end;
procedure TVarBytesField.SetAsString(const Value: string);
var
vBuffer : PAnsiChar;
vTaille : WORD;
vTexte : PAnsiChar;
vI : WORD;
begin
vBuffer := AllocMem(DataSize);
try
vTaille := WORD(Length(Value));
PWORD(vBuffer)^ := vTaille;
vTexte := vBuffer + 2;
for vI := 1 to vTaille do
begin
if Value[vI] = '\' then
begin
vTexte^ := #2
end
else
begin
vTexte^ := Value[vI];
end;
Inc(vTexte);
end;
SetData(vBuffer);
finally
FreeMem(vBuffer);
end;
end;
The message is telling you that FldCmp is a function, and it is expecting you to execute it, but it has not got enough parameters. I am sure that you already realised that and probably already tried to get the address of the function with the # (like you do for FldCmpHack) and found that that does not work.
The reason for that is, I am afraid, that FldCmp is not a normal function. DSBase is actually an interface, which will have been assigned (looking at the source code) by a class factory. What you actually need is the real function itself and for that you need the real object that the class factory creates. And I am sorry, but I can't see any realistic way of doing that.
However, the DSBase field is only created if it has not been assigned, so you could, in theory, create your own IDSBase interface object, which is the way this type of problem is meant to be handled. That is a lot of work, though, unless you know class that the class factory produces and can descend from that.
A sneakier alternative is to override the Translate property and create some sort of hash (perhaps by translating the ASCII codes to their HEX values) so that the database keeps them in the right order
TClientDataSetHelper = class(TClientDataSet)
public
function Translate(Src, Dest: PAnsiChar; ToOem: Boolean): Integer; override;
end;
Am learning how to use insert into statements and, with my access database, am trying to insert a single record. The table I'm inserting a new record into has three fields: StockID (AutoN), Description (Text), Cost (Number). I've looked at previous posts but the posted solutions seem to go beyond my basic level of Insert Into...which is what I'm interested in. Anyway, here is my code...
adoQuery1.Active := true;
adoQuery1.SQL.Clear;
adoQuery1.SQL.Add('INSERT INTO Stock (StockID,Description,Cost) VALUES (4,Cheese,5)');
adoQuery1.open;
adoQuery1.Close;
It compiles fine, but when press a command button to invoke the above, I get the following message:
'ADOQuery1: "Missing SQL property".'
what am I doing wrong?
Thanks, Abelisto. Your last post looks complex indeed...but I did my own little version since your last solution got me up and running. It works so I'm very chuffed. Am now going to focus on DELETE FROM using combobox (for field selection) and user value. Here was my solution I got working... ;)
x:=strtoint(txtStockID.Text);
y:=txtDescription.Text;
z:=strtoCurr(txtCost.Text);
adoQuery1.SQL.Clear;
adoQuery1.SQL.Add('INSERT INTO tblStock (StockID,Description,Cost)');
adoQuery1.SQL.Add('VALUES (:StockID,:Description,:Cost)'); // ':StockID' denotes a parameter
adoQuery1.Parameters.ParamByName('StockID').Value:= x;
adoQuery1.Parameters.ParamByName('Description').Value:= y;
adoQuery1.Parameters.ParamByName('Cost').Value:= z;
adoQuery1.ExecSQL;
adoQuery1.Close;
Using parameters is more efficient then constant SQL statements.
Additional to my comments here is some useful functions which I using frequently to call SQL statements with parameters (Maybe it will be useful for you too):
function TCore.ExecQuery(const ASQL: String; const AParamNames: array of string;
const AParamValues: array of Variant): Integer;
var
q: TADOQuery;
i: Integer;
begin
if Length(AParamNames) <> Length(AParamValues) then
raise Exception.Create('There are different number of parameter names and values.');
q := GetQuery(ASQL) as TADOQuery;
try
for i := Low(AParamNames) to High(AParamNames) do
SetParamValue(q, AParamNames[i], AParamValues[i]);
q.ExecSQL;
Result := q.RowsAffected;
finally
q.Free;
end;
end;
function TCore.GetQuery(const ASQL: String): TDataSet;
begin
Result := TADOQuery.Create(Self);
(Result as TADOQuery).CommandTimeout := 0;
(Result as TADOQuery).Connection := Connection;
(Result as TADOQuery).SQL.Text := ASQL;
end;
procedure TCore.SetParamValue(AQuery: TDataSet; const AName: string; const AValue: Variant);
var
i: Integer;
q: TADOQuery;
begin
q := AQuery as TADOQuery;
for i := 0 to q.Parameters.Count - 1 do
if AnsiSameText(AName, q.Parameters[i].Name) then
begin
case VarType(AValue) of
varString, varUString:
q.Parameters[i].DataType := ftString;
varInteger:
q.Parameters[i].DataType := ftInteger;
varInt64:
q.Parameters[i].DataType := ftLargeint;
end;
q.Parameters[i].Value := AValue;
end;
end;
And usage example in your case:
Core.ExecQuery(
'INSERT INTO Stock (StockID, Description, Cost) VALUES (:PStockID, :PDescription, :PCost)',
['PStockID', 'PDescription', 'PCost'],
[4, 'Cheese', 5]);
I have an record type for each Table in SQL Server. So when I want to insert (or update) a record on table I define a function to do so. Each field in delphi record has equivalent field in SQL table (with exact same name an type).
It is too interesting to me to write a function to do this ( for example Inserting) for all record types using Retti. I mean a function that have a parameter for receive any record and creates insert query.
I searched a lot and asked this question but finally not find the solution. Can anyone guide me to solution. I mean how to pass any record (any type) into a function as parameter?
Try something like this:
type
TSqlHlpr<T: record> = class
public
class procedure Insert(const Rec: T);
end;
class procedure TSqlHlpr<T>.Insert(const Rec: T);
var
Ctx: TRttiContext;
RecType: TRttiType;
TableName: String;
Field: TRttiField;
Value: TValue;
FieldValues: TDictionary<String, TValue>;
FieldPair: TPair<String, TValue>;
begin
FieldValues := TDictionary<String, TValue>.Create;
try
Ctx := TRttiContext.Create;
try
RecType := Ctx.GetType(TypeInfo(T));
TableName := RecType.Name;
// massage TableName as needed to match the DB...
for Field in RecType.GetFields do
begin
Value := Field.GetValue(#Rec);
FieldValues.Add(Field.Name, Value);
end;
finally
Ctx.Free;
end;
for FieldPair in FieldValues do
begin
// insert FieldPair.Value into FieldPair.Key column of TableName as needed...
end;
finally
FieldValues.Free;
end;
end;
type
TMyTable = record
// table fields here...
end;
var
rec: TMyTable;
begin
// fill rec as needed...
TSqlHlpr<TMyTable>.Insert(rec);
end;
OK I found my answer. Yes it is possible and so simple using untyped parameters like this :
procedure CreateSQLInsert(var Data)
begin
// and do whatever with your any type record using Retti
end;
Delphi XE6 - I have a Unit (EMAIL1.pas) which does related processing. This is meant to be a standalone unit I can incorporate into multiple programs. My initial procedure is called GetDetailsFromEmailAddress. It has two parameters, an email address which I lookup and a "group of data" which will get updated, currently defined as a var. This can be a record or a class, I don't really care. It is just a group of related strings (firstname, last name, city, etc). Let's call this EmpRec.
My challenge is that this procedure creates an instance of a class (JEDI VCL HTMLParser) which uses a method pointer to call a method (TableKeyFound). This routine needs to update EmpRec. I do not want to change this code (HTMLPArser routine) to add additional parameters. There are several other procedures that my UNIT creates. All of them need to read/update EmpRec. How do I do this?
I need a way to "promote" the variable EmpRec which is passed in this one routine (GetDetailsFromEmailAddress) to be GLOBAL within this UNIT so that all the routines can access or change the various elements. How do I go about this? I do NOT really want to have to define this as a GLOBAL / Application wide variable.
Code sample below. So.. How does the routine TableKeyFoundEx get access to the EmpRec variable?
procedure GetDetailsFromEmailAddress(Email: string; var EmpRec: TEmpRec);
begin
...
// Now create the HTML Parser...
JvHtmlParser1 := TJvHTMLParser.Create(nil);
// On event KeyFoundEx, call Parsehandlers.TableKeyFoundEx;
JvHtmlParser1.OnKeyFoundEx := ParseHandlers.TableKeyFoundEx;
...
end.
procedure TParseHandlers.TableKeyFoundEx(Sender: TObject; Key, Results, OriginalLine: String; TagInfo: TTagInfo;
Attributes: TStrings);
begin
..
// NEED ACCESS to EmpRec here, but can't change procedure definition
end;
There are two different ways I would approach this:
use the parser's Tag property:
procedure GetDetailsFromEmailAddress(Email: string; var EmpRec: TEmpRec);
begin
...
JvHtmlParser1 := TJvHTMLParser.Create(nil);
JvHtmlParser1.OnKeyFoundEx := ParseHandlers.TableKeyFoundEx;
JvHtmlParser1.Tag := NativeInt(#EmpRec);
...
end;
procedure TParseHandlers.TableKeyFoundEx(Sender: TObject; Key, Results, OriginalLine: String; TagInfo: TTagInfo; Attributes: TStrings);
var
EmpRec: PEmpRec; // assuming PEmpRec = ^TEmpRec
begin
EmpRec := PEmpRec(TJvHTMLParser(Sender).Tag);
...
end;
use a little TMethod hack to pass the record DIRECTLY to the event handler:
// Note: this is declared as a STANDALONE procedure instead of a class method.
// The extra DATA parameter is where a method would normally pass its 'Self' pointer...
procedure TableKeyFoundEx(Data: Pointer: Sender: TObject; Key, Results, OriginalLine: String; TagInfo: TTagInfo; Attributes: TStrings);
var
EmpRec: PEmpRec; // assuming PEmpRec = ^TEmpRec
begin
EmpRec := PEmpRec(Data);
...
end;
procedure GetDetailsFromEmailAddress(Email: string; var EmpRec: TEmpRec);
var
M: TMethod;
begin
...
JvHtmlParser1 := TJvHTMLParser.Create(nil);
M.Code := #TableKeyFoundEx;
M.Data := #EmpRec;
JvHtmlParser1.OnKeyFoundEx := TJvKeyFoundExEvent(M);
...
end;
In addition to the two options that Remy offers, you could derive a sub-class of TJvHTMLParser.
type
PEmpRec = ^TEmpRec;
TMyJvHTMLParser = class(TJvHTMLParser)
private
FEmpRec: PEmpRec;
public
constructor Create(EmpRec: PEmpRec);
end;
....
constructor TMyJvHTMLParser.Create(EmpRec: PEmpRec);
begin
inherited Create(nil);
FEmpRec := EmpRec;
end;
When you create the parser, do so like this:
procedure GetDetailsFromEmailAddress(Email: string; var EmpRec: TEmpRec);
var
Parser: TMyJvHTMLParser;
begin
Parser := TMyJvHTMLParser.Create(#EmpRec);
try
Parser.OnKeyFoundEx := ParseHandlers.TableKeyFoundEx;
....
finally
Parser.Free;
end;
end.
And in your OnKeyFoundEx you cast Sender back to the parser type to gain access to the record:
procedure TParseHandlers.TableKeyFoundEx(Sender: TObject; ...);
var
EmpRec: PEmpRec;
begin
EmpRec := (Sender as TMyJvHTMLParser).FEmpRec;
....
end;