I was pondering on what I could do to simplify doing ad-hoc queries and minimize the scaffolding code required, so I came up with this.
Note that this code was yanked from one of our units, and hence is not directly runnable as it is missing some functions, and the code that sets up the connection, etc. - but it should give you the general gist of it works.
It is not pretty nor perfect, but it works, and if there are glaring mistakes or potential problems, I expect you will tell me all about them 🙂
unit SomeUnit;
type
RUser = record
id: Integer;
name: string;
displayname: string;
end;
implementation
procedure TSomeClass.ListThoseUsers(const aDB: TDatabase);
var
Users: TArray<RUser>;
begin
Users := DB.SelectArray<RUser>('select id, name, displayname from v_users');
// Do whatever you need to do with the user list here
end;
I am pretty sure that you can create records with fields of types that will cause the TValue conversion to fail horribly, but this deals fine with the basic types as well as enumerated types.
Note that the record type needs to be declared in the unit's interface section to get the proper RTTI.
Doing a test run from at home to a database server in Trondheim, 700km away - the logs showed
SelectArray<SomeUnit.RUser>("select Id, Name, DisplayName from v_users") returned 161 rows in 0:00,024
24 ms is not blisteringly fast, but acceptable.
function TDatabase.SelectArray<T>(const sSQL: String): TArray<T>;
var
Info: String;
StopWatch: TStopWatch;
Query: TFDQuery;
Retry: Boolean;
FieldName, RetryMsg: string;
rType: TRTTIType;
RecField: TArray<TRTTIField>;
DBField: TArray<TField>;
fx, rx, rc: Integer;
begin
Retry := False;
repeat
if Connect
then try
if Retry
then RetryMsg := '#RETRY '
else RetryMsg := '';
StopWatch := TStopWatch.StartNew;
rtype := TRTTIContext.Create.GetType(TypeInfo(T));
Info := RetryMsg + 'SelectArray<'+rtype.QualifiedName+'>("' + sSQL+ '") ';
Query := TFDQuery.Create(nil);
Query.Connection := Connection;
Query.ResourceOptions.ParamCreate := False;
Query.FetchOptions.Mode := fmAll;
Query.FetchOptions.Unidirectional := Unidirectional;
Query.SQL.Text := sSQL;
try
Query.Open;
rc := Query.RecordCount;
if (Query.FieldCount >= 1) and (rc > 1)
then begin
RecField := rtype.GetFields; // Fetch field list from record type
SetLength(DBField, Length(RecField));
try // Lookup record fields in database result set. Will raise exception if field not found
for fx := Low(RecField) to High(RecField)
do begin
FieldName := RecField[fx].Name;
DBField[fx] := Query.FieldByName(FieldName);
end;
except
on E: Exception
do begin
Info := Info + ' - Field ' + rType.QualifiedName + '.' + FieldName + ' was not found in result set.';
raise;
end;
end;
// for each row in the result set
SetLength(Result, rc);
for rx := 0 to rc - 1
do begin
for fx := Low(RecField) to High(RecField) // for each field in the record, transfer row field to record field
do begin
if RecField[fx].FieldType.TypeKind = tkEnumeration
then RecField[fx].SetValue(@Result[rx], TValue.FromOrdinal(RecField[fx].FieldType.Handle, DBField[fx].AsInteger))
else RecField[fx].SetValue(@Result[rx], TValue.FromVariant(DBField[fx].Value));
end;
Query.Next;
end;
if DebugLogging
then DebugOut(Info + ' returned ' + rc.ToString + ' rows in ' + TimeSpanToStr(StopWatch.Elapsed));
end
else begin
SetLength(Result, 0);
end;
finally
Query.Free;
end;
Retry := False;
except
on DBE:EFDDBEngineException
do begin
LogDBException(DBE, Info, Retry);
if not Retry
then RAISE;
end;
on E:Exception
do begin
LogException(E, Info);
RAISE;
end;
end
else
raise EDbConnectionFailure.Create(Info + ' DB Error: Could not connect.');
until not Retry;
end;