Hello,
I would like to inquire about the possibility of implementing a service in a data module-like class. This would allow for the inclusion of visual components in the implementation, similar to the server methods form in DataSnap.
I would appreciate your advice on this matter.
Thank you for your time.
Currently you can't inherit a service directly from a data module, but nothing prevents you from creating a separated data module and just instantiating it in your Create service method.
I did something like this to incorporate Digital Metaphors' ReportBuilder. A separate datamodule is loaded when needed to run a report.
Hi @AndrewSimard ,
have you a code example on using Reporbuilder inside Xdata?
Thanks in advance!
It's been some time since I looked at this, but here's a substantial amount of code. As the saying goes, if I had more time I'd write a shorter letter. This is the entire endpoint for a particular set of data. The endpoint looks to see what is being requested in terms of the format, and if it is a PDF, it loads up another module that has the ReportBuilder components and then does its thing from there.
Fair warning, this was written when I first started to learn about TMS WEB Core and XData, so this isn't really a teaching example, just an example from a project.
function TWorkerMgrService.GetWorkerAvailability(Worker: Integer; Filter, StreamFormat: String): TStream;
var
controlDB: TFDConnection;
clientDB: TFDConnection;
qry: TFDQuery;
User: IUserIdentity;
Username: String;
EMailAddress: String;
DatabaseName: String;
DatabaseConn: String;
DatabaseType: Integer;
Project: String;
Version: String;
Timezone: String;
CurrentJWT: String;
bm: TFDBatchMove;
bw: TFDBatchMoveJSONWriter;
br: TFDBatchMoveDataSetReader;
L: TStringList;
S: String;
I: Integer;
dm: TDMConfigMgr;
pd: TppPDFDevice;
fn: String;
ms: TMemoryStream;
ClientTimeZone: TBundledTimeZone;
ServerTime:TDateTime;
ClientTime:TDateTime;
GlobalTime:TDateTime;
ElapsedTime: TDateTime;
begin
ElapsedTime := Now;
Result := TMemoryStream.Create;
// We've got an authenticated request, so let's be sure that the request contains all
// that we need to issue a new JWT in its place.
User := TXDataOperationContext.Current.Request.User;
if (User = nil) then raise EXDataHttpUnauthorized.Create('Missing authentication');
if not(User.Claims.Exists('prj')) then raise EXDataHttpUnauthorized.Create('Missing project');
if not(User.Claims.Exists('dbn')) then raise EXDataHttpUnauthorized.Create('Missing database name');
if not(User.Claims.Exists('dbc')) then raise EXDataHttpUnauthorized.Create('Missing database connection');
if not(User.Claims.Exists('dbt')) then raise EXDataHttpUnauthorized.Create('Missing database type');
if not(User.Claims.Exists('usr')) then raise EXDataHttpUnauthorized.Create('Missing username');
Username := User.Claims.Find('usr').AsString;
EMailAddress := User.Claims.Find('eml').AsString;
DatabaseName := User.Claims.Find('dbn').AsString;
DatabaseConn := User.Claims.Find('dbc').AsString;
DatabaseType := User.Claims.Find('dbt').AsInteger;
Project := User.Claims.Find('prj').AsString;
Version := User.Claims.Find('ver').AsString;
Timezone := User.Claims.Find('tzn').AsString;
CurrentJWT := TXDataOperationContext.Current.Request.Headers.Get('Authorization');
Delete(CurrentJWT,1,7); // Remove 'Bearer ' from beginning of JWT
// Confirm JWT in Control Database
controlDB := TFDConnection.Create(nil);
controlDB.ConnectionDefName := 'ControlPool';
controlDB.Connected := True;
qry := TFDQuery.Create(nil);
qry.Connection := controlDB;
// If the current JWT doesn't exist then this is an invalid request.
qry.SQL.Text := 'select JWT from CONTROL.AUTHORIZATIONS where (JWT='+QuotedStr(CurrentJWT)+') and (EXPIRES > current timestamp)';
qry.Open;
if qry.RecordCount <> 1 then
begin
qry.Close;
qry.Free;
controlDB.Connected := False;
controlDB.Free;
raise EXDataHttpUnauthorized.Create('Invalid JWT Token');
end;
qry.Close;
controlDB.Connected := False;
controlDB.Free;
// Alright, we're good to go. Got a valid JWT and we know the Project/Database/Username
// Get Menu from Client Database
clientDB := TFDConnection.Create(nil);
clientDB.ConnectionDefName := DatabaseConn;
clientDB.Connected := True;
qry.Connection := clientDB;
if ((Trim(Filter) = '') or (Uppercase(Trim(Filter)) = 'CURRENT')) then
begin
if (DatabaseType = 1) then qry.SQL.Assign(DMWorkerMgr.qryWorkerAvailability_db2.SQL)
else if (DatabaseType = 2) then qry.SQL.Assign(DMWorkerMgr.qryWorkerAvailability_mysql.SQL);
qry.ParamByName('SERVERTZ').AsString := MainForm.AppTimezone;
qry.ParamByName('LOCALTZ').AsString := Timezone;
qry.ParamByName('USERNAME').AsString := Username;
qry.ParamByName('EMPLOYEE').AsInteger := Worker;
end
else
begin
if (DatabaseType = 1) then qry.SQL.Assign(DMWorkerMgr.qryWorkerAvailability_db2.SQL)
else if (DatabaseType = 2) then qry.SQL.Assign(DMWorkerMgr.qryWorkerAvailability_mysql.SQL);
qry.ParamByName('SERVERTZ').AsString := MainForm.AppTimezone;
qry.ParamByName('LOCALTZ').AsString := Timezone;
qry.ParamByName('USERNAME').AsString := Username;
qry.ParamByName('EMPLOYEE').AsInteger := Worker;
end;
qry.Open;
if (Uppercase(StreamFormat) = 'FIREDAC') then
begin
qry.SaveToStream(Result, sfJSON);
end
else if (Uppercase(StreamFormat) = 'XML') then
begin
CoInitialize(nil);
try
qry.SaveToStream(Result, sfXML);
finally
CoUninitialize;
end;
end
else if (Uppercase(StreamFormat) = 'BINARY') then
begin
ms := TMemoryStream.Create;
try
qry.SaveToStream(ms,sfBinary);
ms.Position := 0;
TNetEncoding.Base64.Encode(ms, Result);
finally
ms.Free;
end;
end
else if (Uppercase(StreamFormat) = 'CSV') then
begin
L := TStringList.Create;
S := '';
for I := 0 to qry.FieldCount - 1 do
begin
if (S > '') then S := S + ',';
S := S + '"' + qry.FieldDefs.Items[I].Name + '"';
end;
L.Add(S);
try
qry.First;
while not qry.Eof do
begin
S := '';
for I := 0 to qry.FieldCount - 1 do
begin
if (S > '') then S := S + ',';
S := S + '"' + qry.Fields[I].AsString + '"';
end;
L.Add(S);
qry.Next;
end;
finally
L.SaveToStream(Result);
L.Free;
end;
end
else if (Uppercase(StreamFormat) = 'PDF') then
begin
dm := TDMConfigMgr.Create(nil);
pd := TppPDFDevice.Create(nil);
ms := TMemoryStream.Create;
ClientTimeZone :=TBundledTimeZone.GetTimeZone(TimeZone);
ServerTime := Now;
GlobalTime := TTimeZone.Local.ToUniversalTime(ServerTime);
ClientTime := ClientTimeZone.ToLocalTime(GlobalTime);
dm.ppReport1_TimeStamp.Caption := FormatDateTime('yyyy-mmm-dd (ddd) hh:nn:ss', ClientTime)+' / '+TimeZone+' / '+Username+' / '+EMailAddress;
dm.ppReport1_Project.Caption := Project;
dm.ppReport1_Database.Caption := DatabaseName;
dm.DataSource1.DataSet := qry;
dm.ppReport1.AllowPrintToFile := True;
dm.ppReport1.DeviceType := dtPDF;
pd.PDFSettings := dm.ppReport1.PDFSettings;
pd.OutputStream := ms;
pd.Publisher := dm.ppReport1.Publisher;
dm.ppReport1.PrintToDevices;
try
ms.Position := 0;
TNetEncoding.Base64.Encode(ms, Result);
finally
ms.Free;
pd.Free;
dm.Free;
end;
end
else if (Uppercase(StreamFormat) = 'EXCEL') then
begin
dm := TDMConfigMgr.Create(nil);
ms := TMemoryStream.Create;
fn := TPath.GetTempFileName;
dm.DataSource1.DataSet := qry;
dm.ppReport1.DeviceType := dtXLSData;
dm.ppReport1.TextFileName := fn;
dm.ppReport1.ShowPrintDialog := False;
dm.ppReport1.ShowCancelDialog := False;
dm.ppReport1.XLSSettings.MergeAdjacentCells:=False;
dm.ppReport1.XLSSettings.ScaleToPageWidth:=True;
dm.ppReport1.XLSSettings.ExportComponents:=[ecText,ecImage,ecRichText,ecBarCode,ecOther];
dm.ppReport1.Print;
try
ms.LoadFromFile(fn);
ms.Position := 0;
TNetEncoding.Base64.Encode(ms, Result);
finally
ms.Free;
dm.Free;
DeleteFile(fn);
end;
end
else // if (Uppercase(StreamFormat) = 'JSON') then
begin
bm := TFDBatchMove.Create(nil);
bw := TFDBatchMoveJSONWriter.Create(nil);
br := TFDBatchMoveDataSetReader.Create(nil);
try
br.Dataset := qry;
bw.Stream := Result;
bm.Reader := br;
bm.Writer := bw;
bm.Execute;
finally
br.Free;
bw.Free;
bm.Free;
end;
end;
qry.Close;
// Log Event in Client Database
MainForm.LogEvent('WorkerMgr/GetWorkerAvailability', qry, DatabaseType, Project, TXDataOperationContext.Current.Request.RemoteIP,
Username,
-181,
'Get Availability for Worker #'+IntToStr(Worker),
MillisecondsBetween(Now, ElapsedTime),
Version
);
// Cleanup afterwards
qry.Free;
clientDB.Connected := False;
clientDB.Free;
MainForm.LogThis('WorkerMgr/GetWorkerAvailability',TXDataOperationContext.Current.Request.RemoteIP, Project, DatabaseName, Username, 'GetWorkerAvailability');
MainForm.RecordEvent(Username+' / '+DatabaseName);
end;
The DataModule is instantiated just for this service call, and this is the standard TDataModule where you can add in VCL components and that kind of thing. In this case, it is an assortment of ReportBuilder objects which are then manipulated after the module is loaded. I've deleted most of the objects here for brevity but left in enough to show what it looks like.
unit ConfigMgrData;
interface
uses
System.SysUtils, System.Classes, FireDAC.Stan.Intf, FireDAC.Stan.Option,
FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def,
FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys, FireDAC.Phys.DB2,
FireDAC.Phys.DB2Def, FireDAC.VCLUI.Wait, FireDAC.Stan.Param,
FireDAC.DatS, FireDAC.DApt.Intf, FireDAC.DApt, Data.DB,
FireDAC.Comp.DataSet, FireDAC.Comp.Client, FireDAC.Phys.ODBCBase,
FireDAC.Comp.BatchMove, FireDAC.Comp.BatchMove.JSON,
FireDAC.Comp.BatchMove.DataSet, ppPrnabl, ppClass, ppCtrls, ppBands,
ppCache, ppDesignLayer, ppParameter, ppDB, ppDBPipe, ppComm, ppRelatv,
ppProd, ppReport, ppVar;
type
TDMConfigMgr = class(TDataModule)
conAuthControl_db2: TFDConnection;
qryParamList_db2: TFDQuery;
qryParamListFiltered_db2: TFDQuery;
qryParamList_mysql: TFDQuery;
qryParamListFiltered_mysql: TFDQuery;
ppReport1: TppReport;
ppDBPipeline1: TppDBPipeline;
DataSource1: TDataSource;
ppParameterList1: TppParameterList;
qryParamList_db2PARAMNUM: TIntegerField;
qryParamList_db2PARAMNAME: TStringField;
qryParameter_db2: TFDQuery;
DataSource2: TDataSource;
ppDBPipeline2: TppDBPipeline;
qryParameter_mysql: TFDQuery;
qryParameter_db2LOOKUP: TIntegerField;
qryParameter_db2SORTORDER: TIntegerField;
qryParameter_db2MODIFIER: TStringField;
qryParameter_db2MODIFIED: TSQLTimeStampField;
qryParameter_db2DESCRIPTION: TStringField;
qryParamListFiltered_db2PARAMNUM: TIntegerField;
qryParamListFiltered_db2PARAMNAME: TStringField;
qryParameter_mysqlPARAMNUM: TIntegerField;
qryParameter_mysqlPARAMNAME: TStringField;
qryParameter_mysqlLOOKUP: TIntegerField;
qryParameter_mysqlSORTORDER: TIntegerField;
qryParameter_mysqlMODIFIER: TStringField;
qryParameter_mysqlMODIFIED: TSQLTimeStampField;
qryParameter_mysqlDESCRIPTION: TStringField;
qryParamListFiltered_mysqlPARAMNUM: TIntegerField;
qryParamListFiltered_mysqlPARAMNAME: TStringField;
qryParamList_mysqlPARAMNUM: TIntegerField;
qryParamList_mysqlPARAMNAME: TStringField;
ppReport2: TppReport;
ppHeaderBand2: TppHeaderBand;
ppDetailBand2: TppDetailBand;
ppDBText3: TppDBText;
ppFooterBand2: TppFooterBand;
ppLine4: TppLine;
ppSystemVariable4: TppSystemVariable;
ppDesignLayers2: TppDesignLayers;
ppDesignLayer2: TppDesignLayer;
ppParameterList2: TppParameterList;
qryParameter_db2ID: TLargeintField;
qryParameter_db2RESPONSE: TStringField;
qryParameter_db2GROUPTYPE: TIntegerField;
ppDBText4: TppDBText;
ppDBText5: TppDBText;
ppTitleBand1: TppTitleBand;
ppLine3: TppLine;
ppReport2_Title1: TppLabel;
ppReport2_Title2: TppLabel;
ppShape2: TppShape;
ppReport2_Project: TppLabel;
ppReport2_Database: TppLabel;
ppLine5: TppLine;
ppLabel9: TppLabel;
ppLabel10: TppLabel;
ppLabel11: TppLabel;
ppReport2_Timestamp: TppLabel;
qryNewParameter_db2: TFDQuery;
LargeintField1: TLargeintField;
IntegerField1: TIntegerField;
IntegerField2: TIntegerField;
IntegerField3: TIntegerField;
StringField1: TStringField;
StringField2: TStringField;
StringField3: TStringField;
SQLTimeStampField1: TSQLTimeStampField;
qryNewParameter_mysql: TFDQuery;
LargeintField2: TLargeintField;
IntegerField4: TIntegerField;
IntegerField5: TIntegerField;
IntegerField6: TIntegerField;
StringField4: TStringField;
StringField5: TStringField;
StringField6: TStringField;
SQLTimeStampField2: TSQLTimeStampField;
qryDelParameter_DB2: TFDQuery;
LargeintField3: TLargeintField;
IntegerField7: TIntegerField;
IntegerField8: TIntegerField;
IntegerField9: TIntegerField;
StringField7: TStringField;
StringField8: TStringField;
StringField9: TStringField;
SQLTimeStampField3: TSQLTimeStampField;
qryDelParameter_mysql: TFDQuery;
LargeintField4: TLargeintField;
IntegerField10: TIntegerField;
IntegerField11: TIntegerField;
IntegerField12: TIntegerField;
StringField10: TStringField;
StringField11: TStringField;
StringField12: TStringField;
SQLTimeStampField4: TSQLTimeStampField;
qryUpdParameter_DB2: TFDQuery;
LargeintField5: TLargeintField;
IntegerField13: TIntegerField;
IntegerField14: TIntegerField;
IntegerField15: TIntegerField;
StringField13: TStringField;
StringField14: TStringField;
StringField15: TStringField;
SQLTimeStampField5: TSQLTimeStampField;
qryUpdParameter_mysql: TFDQuery;
LargeintField6: TLargeintField;
IntegerField16: TIntegerField;
IntegerField17: TIntegerField;
IntegerField18: TIntegerField;
StringField16: TStringField;
StringField17: TStringField;
StringField18: TStringField;
SQLTimeStampField6: TSQLTimeStampField;
qryParamList_db2ID: TLargeintField;
qryParamList_db2PARAMDESC: TStringField;
qryParamList_db2MODIFIER: TStringField;
qryParamList_db2MODIFIED: TSQLTimeStampField;
qryParamListFiltered_db2ID: TLargeintField;
qryParamListFiltered_db2PARAMDESC: TStringField;
qryParamListFiltered_db2MODIFIER: TStringField;
qryParamListFiltered_db2MODIFIED: TSQLTimeStampField;
ppLabel5: TppLabel;
ppDBText8: TppDBText;
ppLabel6: TppLabel;
ppDBText9: TppDBText;
qryGetHTMLBlock_db2: TFDQuery;
LargeintField7: TLargeintField;
IntegerField19: TIntegerField;
IntegerField20: TIntegerField;
IntegerField21: TIntegerField;
StringField19: TStringField;
StringField20: TStringField;
StringField21: TStringField;
SQLTimeStampField7: TSQLTimeStampField;
qryGetHTMLBlock_mysql: TFDQuery;
LargeintField8: TLargeintField;
IntegerField22: TIntegerField;
IntegerField23: TIntegerField;
IntegerField24: TIntegerField;
StringField22: TStringField;
StringField23: TStringField;
StringField24: TStringField;
SQLTimeStampField8: TSQLTimeStampField;
qryUpdHTMLBlock_db2: TFDQuery;
LargeintField9: TLargeintField;
IntegerField25: TIntegerField;
IntegerField26: TIntegerField;
IntegerField27: TIntegerField;
StringField25: TStringField;
StringField26: TStringField;
StringField27: TStringField;
SQLTimeStampField9: TSQLTimeStampField;
qryUpdHTMLBlock_mysql: TFDQuery;
LargeintField10: TLargeintField;
IntegerField28: TIntegerField;
IntegerField29: TIntegerField;
IntegerField30: TIntegerField;
StringField28: TStringField;
StringField29: TStringField;
StringField30: TStringField;
SQLTimeStampField10: TSQLTimeStampField;
ppTitleBand2: TppTitleBand;
ppLine2: TppLine;
ppReport1_Title1: TppLabel;
ppReport1_Title2: TppLabel;
...
etc.
...
IntegerField74: TIntegerField;
IntegerField75: TIntegerField;
IntegerField76: TIntegerField;
StringField78: TStringField;
StringField79: TStringField;
StringField80: TStringField;
SQLTimeStampField26: TSQLTimeStampField;
procedure DataModuleCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
DMConfigMgr: TDMConfigMgr;
implementation
{%CLASSGROUP 'Vcl.Controls.TControl'}
{$R *.dfm}
procedure TDMConfigMgr.DataModuleCreate(Sender: TObject);
begin
conAuthControl_db2.Connected := False;
conAuthControl_db2.Free;
end;
end.
Thanks a lot Andrew!!
This topic was automatically closed 24 hours after the last reply. New replies are no longer allowed.