mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 04:29:29 +02:00
* Refactored report designer, so the report design file can be loaded using report data manager class without visual components. Default support for CSV, DBF, JSON, SQLDB
git-svn-id: trunk@38550 -
This commit is contained in:
michael
parent
8fdf4b2cc3
commit
62fe64dbb2
5
.gitattributes
vendored
5
.gitattributes
vendored
@ -2712,6 +2712,11 @@ packages/fcl-report/src/fpreportbarcode.pp svneol=native#text/plain
|
||||
packages/fcl-report/src/fpreportcanvashelper.pp svneol=native#text/plain
|
||||
packages/fcl-report/src/fpreportcheckbox.inc svneol=native#text/plain
|
||||
packages/fcl-report/src/fpreportcontnr.pp svneol=native#text/plain
|
||||
packages/fcl-report/src/fpreportdata.pp svneol=native#text/plain
|
||||
packages/fcl-report/src/fpreportdatacsv.pp svneol=native#text/plain
|
||||
packages/fcl-report/src/fpreportdatadbf.pp svneol=native#text/plain
|
||||
packages/fcl-report/src/fpreportdatajson.pp svneol=native#text/plain
|
||||
packages/fcl-report/src/fpreportdatasqldb.pp svneol=native#text/plain
|
||||
packages/fcl-report/src/fpreportdb.pp svneol=native#text/plain
|
||||
packages/fcl-report/src/fpreportdom.pp svneol=native#text/plain
|
||||
packages/fcl-report/src/fpreportfpimageexport.pp svneol=native#text/plain
|
||||
|
||||
@ -48,11 +48,52 @@ begin
|
||||
AddUnit('fpreportstreamer');
|
||||
AddUnit('fpreporthtmlparser');
|
||||
end;
|
||||
|
||||
T:=P.Targets.AddUnit('fpreportdata.pp');
|
||||
T.ResourceStrings := True;
|
||||
with T.Dependencies do
|
||||
AddUnit('fpreport');
|
||||
|
||||
T:=P.Targets.AddUnit('fpreportdatacsv.pp');
|
||||
T.ResourceStrings := True;
|
||||
with T.Dependencies do
|
||||
begin
|
||||
AddUnit('fpreport');
|
||||
AddUnit('fpreportdata');
|
||||
end;
|
||||
|
||||
T:=P.Targets.AddUnit('fpreportdatadbf.pp');
|
||||
T.ResourceStrings := True;
|
||||
with T.Dependencies do
|
||||
begin
|
||||
AddUnit('fpreport');
|
||||
AddUnit('fpreportdata');
|
||||
end;
|
||||
|
||||
T:=P.Targets.AddUnit('fpreportdatajson.pp');
|
||||
T.ResourceStrings := True;
|
||||
with T.Dependencies do
|
||||
begin
|
||||
AddUnit('fpreport');
|
||||
AddUnit('fpreportdata');
|
||||
end;
|
||||
|
||||
|
||||
T:=P.Targets.AddUnit('fpreportdatasqldb.pp');
|
||||
T.ResourceStrings := True;
|
||||
with T.Dependencies do
|
||||
begin
|
||||
AddUnit('fpreport');
|
||||
AddUnit('fpreportdata');
|
||||
end;
|
||||
|
||||
T:=P.Targets.AddUnit('fpjsonreport.pp');
|
||||
T.ResourceStrings := True;
|
||||
with T.Dependencies do
|
||||
begin
|
||||
AddUnit('fpreport');
|
||||
AddUnit('fpreportdata');
|
||||
end;
|
||||
|
||||
T:=P.Targets.AddUnit('fpreportjson.pp');
|
||||
T.ResourceStrings := True;
|
||||
|
||||
@ -20,19 +20,33 @@ unit fpjsonreport;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpreport, fpjson, fpreportstreamer;
|
||||
Classes, SysUtils, fpreport, fpjson, fpreportstreamer, fpreportdata;
|
||||
|
||||
Type
|
||||
|
||||
{ TFPJSONReport }
|
||||
TReadReportJSONEvent = Procedure(Sender : TObject; JSON : TJSONObject) of object;
|
||||
TWriteReportJSONEvent = Procedure(Sender : TObject; JSON : TJSONObject) of object;
|
||||
|
||||
TFPJSONReport = class(TFPReport)
|
||||
private
|
||||
FDataManager: TFPCustomReportDataManager;
|
||||
FDesignTimeJSON: TJSONObject;
|
||||
FLoadErrors: TStrings;
|
||||
FOnReadJSON: TReadReportJSONEvent;
|
||||
FOnWriteJSON: TWriteReportJSONEvent;
|
||||
FDesignDataName : String;
|
||||
function GetDesignDataName: String;
|
||||
procedure ReadReportJSON(Reader: TReader);
|
||||
procedure SetDataManager(AValue: TFPCustomReportDataManager);
|
||||
procedure SetDesignDataName(AValue: String);
|
||||
function StoreDesignDataName: Boolean;
|
||||
procedure WriteReportJSON(Writer: TWriter);
|
||||
Protected
|
||||
procedure DoReadJSON(aJSON: TJSONObject);virtual;
|
||||
procedure DoWriteJSON(aJSON: TJSONObject);virtual;
|
||||
Procedure DefineProperties(Filer: TFiler); override;
|
||||
Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
||||
Public
|
||||
Constructor Create(AOwner : TComponent); override;
|
||||
destructor Destroy; override;
|
||||
@ -42,11 +56,19 @@ Type
|
||||
Procedure SavetoJSON(aJSON : TJSONObject); virtual;
|
||||
Procedure LoadFromFile(const aFileName : String);
|
||||
Procedure SaveToFile(const aFileName : String);
|
||||
Property LoadErrors : TStrings Read FLoadErrors;
|
||||
Property DataManager : TFPCustomReportDataManager Read FDataManager Write SetDataManager;
|
||||
Property DesignDataName : String Read GetDesignDataName Write SetDesignDataName Stored StoreDesignDataName;
|
||||
Property DesignTimeJSON : TJSONObject Read FDesignTimeJSON;
|
||||
Property OnReadJSON : TReadReportJSONEvent Read FOnReadJSON Write FOnReadJSON;
|
||||
Property OnWriteJSON : TWriteReportJSONEvent Read FOnWriteJSON Write FOnWriteJSON;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
Const
|
||||
DefaultDesignData = 'DesignData';
|
||||
|
||||
Resourcestring
|
||||
SErrInvalidJSONData = 'Invalid JSON Data';
|
||||
SErrFailedToLoad = 'Failed to load report: %s';
|
||||
@ -79,6 +101,27 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPJSONReport.SetDataManager(AValue: TFPCustomReportDataManager);
|
||||
begin
|
||||
if FDataManager=AValue then Exit;
|
||||
If Assigned(FDataManager) then
|
||||
FDataManager.RemoveFreeNotification(Self);
|
||||
FDataManager:=AValue;
|
||||
If Assigned(FDataManager) then
|
||||
FDataManager.FreeNotification(Self);
|
||||
end;
|
||||
|
||||
procedure TFPJSONReport.SetDesignDataName(AValue: String);
|
||||
begin
|
||||
if AValue=GetDesignDataName then exit;
|
||||
FDesignDataName:=aValue;
|
||||
end;
|
||||
|
||||
function TFPJSONReport.StoreDesignDataName: Boolean;
|
||||
begin
|
||||
Result:=GetDesignDataName<>DefaultDesignData;
|
||||
end;
|
||||
|
||||
procedure TFPJSONReport.WriteReportJSON(Writer: TWriter);
|
||||
|
||||
Var
|
||||
@ -97,18 +140,55 @@ begin
|
||||
Filer.DefineProperty('ReportJSON',@ReadReportJSON,@WriteReportJSON,Assigned(FDesignTimeJSON) and (FDesignTimeJSON.Count>0));
|
||||
end;
|
||||
|
||||
procedure TFPJSONReport.Notification(AComponent: TComponent; Operation: TOperation);
|
||||
begin
|
||||
inherited Notification(AComponent, Operation);
|
||||
if (Operation=opRemove) and (AComponent=FDataManager) then
|
||||
FDataManager:=Nil;
|
||||
end;
|
||||
|
||||
constructor TFPJSONReport.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FDesignTimeJSON:=TJSONObject.Create;
|
||||
FLoadErrors:=TStringList.Create;
|
||||
end;
|
||||
|
||||
destructor TFPJSONReport.Destroy;
|
||||
begin
|
||||
FreeAndNil(FLoadErrors);
|
||||
FreeAndNil(FDesignTimeJSON);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
Function TFPJSONReport.GetDesignDataName : String;
|
||||
|
||||
begin
|
||||
Result:=FDesignDataName;
|
||||
if (FDesignDataName='') then
|
||||
Result:=DefaultDesignData;
|
||||
end;
|
||||
|
||||
procedure TFPJSONReport.DoReadJSON(aJSON: TJSONObject);
|
||||
|
||||
Var
|
||||
O : TJSONObject;
|
||||
|
||||
begin
|
||||
FloadErrors.Clear;
|
||||
if Assigned(FOnReadJSON) then
|
||||
FOnReadJSON(Self,aJSON);
|
||||
if Assigned(FDataManager) then
|
||||
begin
|
||||
O:=aJSON.get(GetDesignDataName,TJSONObject(Nil));
|
||||
if Assigned(O) then
|
||||
begin
|
||||
FDataManager.LoadFromJSON(O);
|
||||
FDataManager.ApplyToReport(Self,LoadErrors);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPJSONReport.LoadFromJSON(aJSON: TJSONObject);
|
||||
|
||||
Var
|
||||
@ -117,6 +197,7 @@ Var
|
||||
|
||||
begin
|
||||
N:=Name;
|
||||
DoReadJSON(aJSON);
|
||||
R:=TFPReportJSONStreamer.Create(Nil);
|
||||
try
|
||||
R.OwnsJSON:=False;
|
||||
@ -128,12 +209,29 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPJSONReport.DoWriteJSON(aJSON: TJSONObject);
|
||||
|
||||
Var
|
||||
O: TJSONObject;
|
||||
|
||||
begin
|
||||
if Assigned(FDataManager) then
|
||||
begin
|
||||
O:=TJSONObject.Create();
|
||||
aJSON.Add(GetDesignDataName,O);
|
||||
FDataManager.SaveToJSON(O);
|
||||
end;
|
||||
if Assigned(FOnWriteJSON) then
|
||||
FOnWriteJSON(Self,aJSON);
|
||||
end;
|
||||
|
||||
procedure TFPJSONReport.SavetoJSON(aJSON: TJSONObject);
|
||||
|
||||
Var
|
||||
R : TFPReportJSONStreamer;
|
||||
|
||||
begin
|
||||
DoWriteJSON(aJSON);
|
||||
R:=TFPReportJSONStreamer.Create(Nil);
|
||||
try
|
||||
R.OwnsJSON:=False;
|
||||
|
||||
@ -1615,6 +1615,14 @@ type
|
||||
property OnEndReport;
|
||||
end;
|
||||
|
||||
TFPReportCustomDataManager = Class(TComponent)
|
||||
Public
|
||||
procedure WriteElement(AWriter: TFPReportStreamer); virtual; abstract;
|
||||
procedure ReadElement(AReader: TFPReportStreamer); virtual; abstract;
|
||||
Procedure ApplyToReport(aReport : TFPCustomReport; AErrors: TStrings); virtual; abstract;
|
||||
Procedure RemoveFromReport(aReport : TFPCustomReport); virtual; abstract;
|
||||
end;
|
||||
|
||||
|
||||
{ TFPReportLayouter }
|
||||
TOverFlowAction = (oaNone,oaBandWithChilds,oaSingleBand);
|
||||
@ -2124,7 +2132,6 @@ type
|
||||
property Items[AIndex: Integer]: TFPReportCustomBand read GetItems write SetItems; default;
|
||||
end;
|
||||
|
||||
|
||||
{ TFPReportExportManager }
|
||||
|
||||
TFPReportExportManager = Class(TComponent)
|
||||
|
||||
723
packages/fcl-report/src/fpreportdata.pp
Normal file
723
packages/fcl-report/src/fpreportdata.pp
Normal file
@ -0,0 +1,723 @@
|
||||
unit fpreportdata;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, DB, fpjson, fpreport, fpreportdb;
|
||||
|
||||
Type
|
||||
EReportDataError = class(EReportError);
|
||||
|
||||
{ TFPReportDataHandler }
|
||||
|
||||
TFPReportDataHandler = Class(TObject)
|
||||
Public
|
||||
Class Procedure RegisterHandler;
|
||||
Class Procedure UnRegisterHandler;
|
||||
Class Procedure RegisterConfigClass(aClass : TComponentClass);
|
||||
// Override this to return a dataset which is owned by AOwner, and configured by AConfig.
|
||||
// The dataset must not be opened.
|
||||
Function CreateDataset(AOwner : TComponent; AConfig : TJSONObject) : TDataset; virtual; abstract;
|
||||
// Check if the configuration is valid. Return a string that describes the error(s)
|
||||
// If the return is an empty string, the data designer will not close.
|
||||
Class Function CheckConfig(AConfig : TJSONObject) : String; virtual;
|
||||
// Configuration component. This is normally a visual class.
|
||||
Class Function ConfigFrameClass : TComponentClass; virtual;
|
||||
Class Function DataType : String; virtual; abstract;
|
||||
Class Function DataTypeDescription : String; virtual;
|
||||
end;
|
||||
TFPReportDataHandlerClass = Class of TFPReportDataHandler;
|
||||
|
||||
{ TFPReportDataDefinitionItem }
|
||||
|
||||
TFPReportDataDefinitionItem = Class(TCollectionItem)
|
||||
private
|
||||
FConfig: TJSONObject;
|
||||
FDataType: String;
|
||||
FName: String;
|
||||
FReportData: TFPReportDatasetData;
|
||||
FRunReportDataItem: TFPReportDataItem;
|
||||
function GetJSONConfig: TJSONStringType;
|
||||
procedure SetConfig(AValue: TJSONObject);
|
||||
procedure SetJSONConfig(AValue: TJSONStringType);
|
||||
procedure SetName(AValue: String);
|
||||
Protected
|
||||
// To hold temporary references
|
||||
Property RunReportData : TFPReportDatasetData Read FReportData Write FReportData;
|
||||
Property RunReportDataItem : TFPReportDataItem Read FRunReportDataItem Write FRunReportDataItem;
|
||||
Public
|
||||
Constructor Create(ACollection: TCollection); override;
|
||||
Destructor Destroy; override;
|
||||
Procedure Assign(Source : TPersistent); override;
|
||||
Procedure SaveToJSON(O : TJSONObject); virtual;
|
||||
procedure LoadFromJSON(O: TJSONObject); virtual;
|
||||
// Clone this
|
||||
Function Clone(aNewName : String) : TFPReportDataDefinitionItem;
|
||||
// Create a dataset.
|
||||
Function CreateDataSet(AOwner : TComponent) : TDataset;
|
||||
// Check if the configuration is OK.
|
||||
Function Check : String;
|
||||
Property Config : TJSONObject Read FConfig Write SetConfig;
|
||||
Published
|
||||
property Name : String Read FName Write SetName;
|
||||
Property DataType : String Read FDataType Write FDataType;
|
||||
Property JSONConfig : TJSONStringType Read GetJSONConfig Write SetJSONConfig;
|
||||
end;
|
||||
|
||||
{ TFPReportDataDefinitions }
|
||||
|
||||
TFPReportDataDefinitions = Class(TCollection)
|
||||
private
|
||||
function GetD(Aindex : Integer): TFPReportDataDefinitionItem;
|
||||
procedure SetD(Aindex : Integer; AValue: TFPReportDataDefinitionItem);
|
||||
Public
|
||||
Function IndexOfRunData(aData : TFPReportDatasetData) : integer;
|
||||
Function IndexOfName(const aName : String): Integer;
|
||||
Function FindDataByName(const aName : String): TFPReportDataDefinitionItem;
|
||||
Function AddData(const aName : String) : TFPReportDataDefinitionItem;
|
||||
Procedure SaveToJSON(O : TJSONObject);
|
||||
Procedure LoadFromJSON(O : TJSONObject);
|
||||
Property Data [Aindex : Integer] : TFPReportDataDefinitionItem Read GetD Write SetD; default;
|
||||
end;
|
||||
|
||||
{ TFPCustomReportDataManager }
|
||||
|
||||
TFPCustomReportDataManager = class(TComponent)
|
||||
private
|
||||
Class Var
|
||||
FTypesList : TStrings;
|
||||
Type
|
||||
{ THDef }
|
||||
|
||||
THDef = Class(TObject)
|
||||
TheClass : TFPReportDataHandlerClass;
|
||||
TheConfigClass : TComponentClass;
|
||||
Constructor Create(aClass : TFPReportDataHandlerClass; aConfigClass : TComponentClass);
|
||||
end;
|
||||
procedure ClearReportDatasetReference(aDataset: TFPReportDatasetData);
|
||||
Class Function FindDef(aDataType: String) : THDef;
|
||||
Class Function GetDef(aDataType: String) : THDef;
|
||||
Private
|
||||
FDataParent: TComponent;
|
||||
FMyParent : TComponent;
|
||||
FDefinitions: TFPReportDataDefinitions;
|
||||
FReport: TFPReport;
|
||||
procedure SetDataParent(AValue: TComponent);
|
||||
procedure SetDefinitions(AValue: TFPReportDataDefinitions);
|
||||
procedure SetReport(AValue: TFPReport);
|
||||
Protected
|
||||
Class Function TypeList : TStrings;
|
||||
Class procedure RemoveHandler(aDataType: String);
|
||||
Class Procedure RegisterHandler(aClass: TFPReportDataHandlerClass); virtual;
|
||||
Class Procedure UnRegisterHandler(aClass: TFPReportDataHandlerClass); virtual;
|
||||
Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
||||
Function CreateDataDefinitions : TFPReportDataDefinitions; virtual;
|
||||
Function GetDatasetParent : TComponent;
|
||||
Property DataDefinitions : TFPReportDataDefinitions Read FDefinitions Write SetDefinitions;
|
||||
Public
|
||||
Class Function GetRegisteredTypes(AList : Tstrings) : Integer;
|
||||
Class Procedure RegisterConfigFrameClass(aTypeName : String; aClass : TComponentClass);
|
||||
Class Procedure UnRegisterConfigFrameClass(aTypeName : String);
|
||||
Class Function GetTypeHandlerClass(aTypeName : String) : TFPReportDataHandlerClass;
|
||||
Class Function GetTypeHandler(aTypeName : String) : TFPReportDataHandler;
|
||||
Class Function GetConfigFrameClass(aTypeName : String) : TComponentClass;
|
||||
Constructor Create(AOwner : TComponent); override;
|
||||
Destructor Destroy; override;
|
||||
Procedure SaveToJSON(O : TJSONObject);
|
||||
Procedure LoadFromJSON(O : TJSONObject);
|
||||
procedure RemoveFromReport(aReport: TFPReport);virtual;
|
||||
procedure RemoveFromReport;
|
||||
procedure ApplyToReport(aReport: TFPReport; Errors: TStrings); virtual;
|
||||
Procedure ApplyToReport(Errors : TStrings);
|
||||
Property Report : TFPReport Read FReport Write SetReport;
|
||||
Property DataParent : TComponent Read FDataParent Write SetDataParent;
|
||||
end;
|
||||
|
||||
TFPReportDataManager = Class(TFPCustomReportDataManager)
|
||||
Public
|
||||
Property DataDefinitions;
|
||||
end;
|
||||
|
||||
Resourcestring
|
||||
SErrDuplicateData = 'Duplicate data set name: "%s"';
|
||||
SErrInvalidDataName = 'Invalid data set name: "%s"';
|
||||
SErrNeedName = 'Data set needs a name';
|
||||
SErrNeedDataType = 'Data set needs a type';
|
||||
SErrInvalidDataType = 'Invalid data type: "%s"';
|
||||
SErrInvalidJSONConfig = '%s: Invalid JSON Configuration';
|
||||
SErrUnknownDataType = 'Unknown report data type: %s';
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
Const
|
||||
DatasetNamePrefix = '__DS__';
|
||||
|
||||
{ TFPCustomReportDataManager }
|
||||
|
||||
procedure TFPCustomReportDataManager.SetDefinitions(AValue: TFPReportDataDefinitions);
|
||||
begin
|
||||
if FDefinitions=AValue then Exit;
|
||||
FDefinitions.Assign(AValue);
|
||||
end;
|
||||
|
||||
procedure TFPCustomReportDataManager.SetDataParent(AValue: TComponent);
|
||||
begin
|
||||
if FDataParent=AValue then Exit;
|
||||
If Assigned(FDataParent) then
|
||||
FDataParent.RemoveFreeNotification(Self);
|
||||
FDataParent:=AValue;
|
||||
If Assigned(FDataParent) then
|
||||
FDataParent.FreeNotification(Self);
|
||||
FreeAndNil(FMyParent);
|
||||
end;
|
||||
|
||||
class function TFPCustomReportDataManager.FindDef(aDataType: String): THDef;
|
||||
|
||||
var
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
I:=TypeList.IndexOf(aDataType);
|
||||
if (I<>-1) then
|
||||
Result:=TypeList.Objects[i] as THDef
|
||||
else
|
||||
Result:=Nil;
|
||||
end;
|
||||
|
||||
class function TFPCustomReportDataManager.GetDef(aDataType: String): THDef;
|
||||
begin
|
||||
Result:=FindDef(aDataType);
|
||||
if Result=Nil then
|
||||
Raise EReportDataError.CreateFmt(SErrUnknownDataType,[aDataType]);
|
||||
end;
|
||||
|
||||
procedure TFPCustomReportDataManager.SetReport(AValue: TFPReport);
|
||||
begin
|
||||
if FReport=AValue then Exit;
|
||||
If Assigned(FReport) then
|
||||
FReport.RemoveFreeNotification(Self);
|
||||
FReport:=AValue;
|
||||
If Assigned(FReport) then
|
||||
FReport.FreeNotification(Self);
|
||||
end;
|
||||
|
||||
class procedure TFPCustomReportDataManager.RegisterHandler(aClass: TFPReportDataHandlerClass);
|
||||
|
||||
Var
|
||||
N : String;
|
||||
C : TComponentClass;
|
||||
|
||||
begin
|
||||
N:=aClass.DataType;
|
||||
RemoveHandler(N);
|
||||
C:=aClass.ConfigFrameClass;
|
||||
TypeList.AddObject(N, THDef.Create(aClass,C));
|
||||
end;
|
||||
|
||||
class procedure TFPCustomReportDataManager.RemoveHandler(aDataType : String);
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
O : TObject;
|
||||
|
||||
begin
|
||||
I:=TypeList.IndexOf(aDataType);
|
||||
if (I<>-1) then
|
||||
begin
|
||||
O:=TypeList.Objects[i];
|
||||
TypeList.Delete(I);
|
||||
O.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
class procedure TFPCustomReportDataManager.UnRegisterHandler(aClass: TFPReportDataHandlerClass);
|
||||
|
||||
begin
|
||||
RemoveHandler(aClass.DataType);
|
||||
end;
|
||||
|
||||
procedure TFPCustomReportDataManager.ClearReportDatasetReference(aDataset : TFPReportDatasetData);
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
if Assigned(FDefinitions) then
|
||||
begin
|
||||
I:=FDefinitions.IndexOfRunData(aDataset);
|
||||
if (I<>-1) then
|
||||
FDefinitions[i].RunReportData:=nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPCustomReportDataManager.Notification(AComponent: TComponent; Operation: TOperation);
|
||||
begin
|
||||
inherited Notification(AComponent, Operation);
|
||||
if Operation=opRemove then
|
||||
begin
|
||||
if AComponent=FDataParent then
|
||||
FDataParent:=Nil
|
||||
else if AComponent=FReport then
|
||||
FReport:=Nil
|
||||
else if (aComponent is TFPReportDatasetData) then
|
||||
ClearReportDatasetReference(aComponent as TFPReportDatasetData);
|
||||
end;
|
||||
end;
|
||||
|
||||
Class function TFPCustomReportDataManager.TypeList: TStrings;
|
||||
|
||||
Var
|
||||
SL : TStringList;
|
||||
|
||||
begin
|
||||
If (FTypesList=nil) then
|
||||
begin
|
||||
SL:=TStringList.Create;
|
||||
SL.Sorted:=True;
|
||||
SL.Duplicates:=dupError;
|
||||
SL.OwnsObjects:=True;
|
||||
FTypesList:=SL;
|
||||
end;
|
||||
Result:=FTypesList;
|
||||
end;
|
||||
|
||||
function TFPCustomReportDataManager.CreateDataDefinitions: TFPReportDataDefinitions;
|
||||
begin
|
||||
Result:=TFPReportDataDefinitions.Create(TFPReportDataDefinitionItem);
|
||||
end;
|
||||
|
||||
function TFPCustomReportDataManager.GetDatasetParent: TComponent;
|
||||
begin
|
||||
Result:=FDataParent;
|
||||
if Result=Nil then
|
||||
begin
|
||||
If (FMyParent=Nil) then
|
||||
FMyParent:=TComponent.Create(Nil);
|
||||
Result:=FMyParent;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TFPCustomReportDataManager.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FDefinitions:=CreateDataDefinitions;
|
||||
end;
|
||||
|
||||
destructor TFPCustomReportDataManager.Destroy;
|
||||
begin
|
||||
FreeAndNil(FDefinitions);
|
||||
FreeAndNil(FMyParent);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TFPCustomReportDataManager.SaveToJSON(O: TJSONObject);
|
||||
begin
|
||||
DataDefinitions.SaveToJSON(O);
|
||||
end;
|
||||
|
||||
procedure TFPCustomReportDataManager.LoadFromJSON(O: TJSONObject);
|
||||
begin
|
||||
DataDefinitions.LoadFromJSON(O);
|
||||
end;
|
||||
|
||||
|
||||
procedure TFPCustomReportDataManager.RemoveFromReport(aReport: TFPReport);
|
||||
|
||||
Var
|
||||
DD : TFPReportDataDefinitionItem;
|
||||
RD : TFPReportDatasetData;
|
||||
D : TDataset;
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
For I:=0 to DataDefinitions.Count-1 do
|
||||
begin
|
||||
DD:=DataDefinitions[i];
|
||||
RD:=DD.RunReportData;
|
||||
if (RD<>Nil) then
|
||||
if (aReport.ReportData.IndexOfReportData(RD)<>-1) then
|
||||
begin
|
||||
D:=RD.Dataset;
|
||||
FreeAndNil(D);
|
||||
FreeAndNil(RD); // Should nil due to freenotification...
|
||||
DD.RunReportData:=Nil;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPCustomReportDataManager.RemoveFromReport;
|
||||
begin
|
||||
RemoveFromReport(FReport);
|
||||
end;
|
||||
|
||||
procedure TFPCustomReportDataManager.ApplyToReport(Errors: TStrings);
|
||||
|
||||
begin
|
||||
ApplyToReport(FReport,Errors);
|
||||
end;
|
||||
|
||||
procedure TFPCustomReportDataManager.ApplyToReport(aReport : TFPReport; Errors: TStrings);
|
||||
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
DesignD : TFPReportDataDefinitionItem;
|
||||
DatasetD : TFPReportDatasetData;
|
||||
L : TFPList;
|
||||
P : TComponent;
|
||||
|
||||
begin
|
||||
RemoveFromReport(aReport);
|
||||
P:=GetDatasetParent;
|
||||
aReport.SaveDataToNames;
|
||||
aReport.ReportData.Clear;
|
||||
For I:=0 to DataDefinitions.Count-1 do
|
||||
begin
|
||||
DesignD:=DataDefinitions[i];
|
||||
DatasetD:=TFPReportDatasetData.Create(P);
|
||||
DesignD.RunReportData:=DatasetD;
|
||||
DatasetD.FreeNotification(Self);
|
||||
DatasetD.Dataset:=DesignD.CreateDataSet(P);
|
||||
Try
|
||||
DatasetD.InitFieldDefs;
|
||||
except
|
||||
On E : Exception do
|
||||
If Assigned(Errors) then
|
||||
Errors.Add(Format('Error opening data "%s" : Exception %s with message %s',[DesignD.Name,E.ClassName,E.Message]))
|
||||
else
|
||||
Raise;
|
||||
end;
|
||||
DatasetD.Name:=DesignD.Name;
|
||||
DatasetD.Dataset.Name:=DatasetNamePrefix+DesignD.Name;
|
||||
DatasetD.StartDesigning; // set designing flag, or OI will not show reference to it.
|
||||
DesignD.RunReportDataItem:=aReport.ReportData.AddReportData(DatasetD);
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TFPCustomReportDataManager.GetRegisteredTypes(AList: Tstrings): Integer;
|
||||
begin
|
||||
// Don't use assign or addstrings, it will copy the THRefs too, possibly leading to errors
|
||||
AList.Text:=TypeList.Text;
|
||||
Result:=AList.Count;
|
||||
end;
|
||||
|
||||
class procedure TFPCustomReportDataManager.RegisterConfigFrameClass(aTypeName: String; aClass: TComponentClass);
|
||||
|
||||
Var
|
||||
H : THDef;
|
||||
|
||||
begin
|
||||
H:=GetDef(aTypeName);
|
||||
H.TheConfigClass:=aClass;
|
||||
end;
|
||||
|
||||
class procedure TFPCustomReportDataManager.UnRegisterConfigFrameClass(aTypeName: String);
|
||||
|
||||
Var
|
||||
H : THDef;
|
||||
|
||||
begin
|
||||
H:=FindDef(aTypeName);
|
||||
if Assigned(H) then
|
||||
H.TheConfigClass:=Nil;
|
||||
end;
|
||||
|
||||
class function TFPCustomReportDataManager.GetTypeHandlerClass(aTypeName: String): TFPReportDataHandlerClass;
|
||||
|
||||
Var
|
||||
H : THDef;
|
||||
|
||||
begin
|
||||
H:=GetDef(aTypeName);
|
||||
Result:=H.TheClass;
|
||||
end;
|
||||
|
||||
class function TFPCustomReportDataManager.GetTypeHandler(aTypeName: String): TFPReportDataHandler;
|
||||
|
||||
begin
|
||||
Result:=GetTypeHandlerClass(aTypeName).Create;
|
||||
end;
|
||||
|
||||
class function TFPCustomReportDataManager.GetConfigFrameClass(aTypeName: String): TComponentClass;
|
||||
|
||||
Var
|
||||
H : THDef;
|
||||
|
||||
begin
|
||||
H:=GetDef(aTypeName);
|
||||
Result:=H.TheConfigClass;
|
||||
end;
|
||||
|
||||
{ THDef }
|
||||
|
||||
constructor TFPCustomReportDataManager.THDef.Create(aClass: TFPReportDataHandlerClass; aConfigClass : TComponentClass);
|
||||
|
||||
begin
|
||||
TheClass:=AClass;
|
||||
TheConfigClass:=aConfigClass;
|
||||
end;
|
||||
|
||||
{ TFPReportDataDefinitions }
|
||||
|
||||
function TFPReportDataDefinitions.GetD(Aindex : Integer): TFPReportDataDefinitionItem;
|
||||
begin
|
||||
Result:=Items[Aindex] as TFPReportDataDefinitionItem;
|
||||
end;
|
||||
|
||||
procedure TFPReportDataDefinitions.SetD(Aindex : Integer; AValue: TFPReportDataDefinitionItem);
|
||||
begin
|
||||
Items[Aindex]:=AValue;
|
||||
end;
|
||||
|
||||
function TFPReportDataDefinitions.IndexOfRunData(aData: TFPReportDatasetData): integer;
|
||||
begin
|
||||
Result:=Count-1;
|
||||
While (Result>=0) and (GetD(Result).RunReportData<>aData) do
|
||||
Dec(Result);
|
||||
end;
|
||||
|
||||
function TFPReportDataDefinitions.IndexOfName(const aName: String): Integer;
|
||||
begin
|
||||
Result:=Count-1;
|
||||
While (Result>=0) and (CompareText(AName,GetD(Result).Name)<>0) do
|
||||
Dec(Result);
|
||||
end;
|
||||
|
||||
function TFPReportDataDefinitions.FindDataByName(const aName: String): TFPReportDataDefinitionItem;
|
||||
|
||||
var
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
I:=indexOfname(aName);
|
||||
if I=-1 then
|
||||
Result:=Nil
|
||||
else
|
||||
Result:=GetD(I);
|
||||
end;
|
||||
|
||||
function TFPReportDataDefinitions.AddData(const aName: String): TFPReportDataDefinitionItem;
|
||||
|
||||
begin
|
||||
if (IndexOfName(aName)<>-1) then
|
||||
raise EReportError.CreateFmt(SErrDuplicateData, [aName]);
|
||||
Result:=add as TFPReportDataDefinitionItem;
|
||||
Result.Name:=aName;
|
||||
end;
|
||||
|
||||
procedure TFPReportDataDefinitions.SaveToJSON(O: TJSONObject);
|
||||
|
||||
Var
|
||||
A : TJSONArray;
|
||||
DS : TJSONObject;
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
A:=TJSONArray.Create;
|
||||
O.Add('datasets',a);
|
||||
For I:=0 to Count-1 do
|
||||
begin
|
||||
DS:=TJSONObject.Create;
|
||||
A.Add(DS);
|
||||
Data[i].SaveToJSON(DS);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPReportDataDefinitions.LoadFromJSON(O: TJSONObject);
|
||||
Var
|
||||
A : TJSONArray;
|
||||
DS : TFPReportDataDefinitionItem;
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
Clear;
|
||||
A:=O.Get('datasets',TJSONArray(Nil));
|
||||
if Assigned(A) then
|
||||
For I:=0 to A.Count-1 do
|
||||
if A.Types[i]=jtObject then
|
||||
begin
|
||||
DS:=Add as TFPReportDataDefinitionItem;
|
||||
DS.LoadFromJSON(A.Objects[i]);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
class procedure TFPReportDataHandler.RegisterHandler;
|
||||
begin
|
||||
TFPCustomReportDataManager.RegisterHandler(Self);
|
||||
end;
|
||||
|
||||
class procedure TFPReportDataHandler.UnRegisterHandler;
|
||||
|
||||
begin
|
||||
TFPCustomReportDataManager.UnRegisterHandler(Self);
|
||||
end;
|
||||
|
||||
class procedure TFPReportDataHandler.RegisterConfigClass(aClass: TComponentClass);
|
||||
begin
|
||||
TFPCustomReportDataManager.RegisterConfigFrameClass(DataType,aClass);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
class function TFPReportDataHandler.CheckConfig(AConfig: TJSONObject): String;
|
||||
begin
|
||||
Result:='';
|
||||
end;
|
||||
|
||||
class function TFPReportDataHandler.ConfigFrameClass: TComponentClass;
|
||||
begin
|
||||
Result:=Nil;
|
||||
end;
|
||||
|
||||
class function TFPReportDataHandler.DataTypeDescription: String;
|
||||
begin
|
||||
Result:=DataType
|
||||
end;
|
||||
|
||||
{ TFPReportDataDefinitionItem }
|
||||
|
||||
procedure TFPReportDataDefinitionItem.SetConfig(AValue: TJSONObject);
|
||||
begin
|
||||
if FConfig=AValue then Exit;
|
||||
FreeAndNil(FConfig);
|
||||
FConfig:=AValue.Clone as TJSONObject;
|
||||
end;
|
||||
|
||||
function TFPReportDataDefinitionItem.GetJSONConfig: TJSONStringType;
|
||||
begin
|
||||
Result:=FConfig.AsJSON;
|
||||
end;
|
||||
|
||||
procedure TFPReportDataDefinitionItem.SetJSONConfig(AValue: TJSONStringType);
|
||||
|
||||
Var
|
||||
D : TJSONData;
|
||||
|
||||
begin
|
||||
D:=GetJSON(aValue);
|
||||
if D is TJSONObject then
|
||||
begin
|
||||
FreeAndNil(FConfig);
|
||||
FConfig:=D as TJSONObject;
|
||||
end
|
||||
else
|
||||
begin
|
||||
FreeAndNil(D);
|
||||
Raise EReportDataError.CreateFmt(SErrInvalidJSONConfig,[Name]);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPReportDataDefinitionItem.SetName(AValue: String);
|
||||
begin
|
||||
if FName=AValue then Exit;
|
||||
{$IF FPC_FULLVERSION < 30002}
|
||||
if Not IsValidIdent(aValue) then
|
||||
{$ELSE}
|
||||
if Not IsValidIdent(aValue,True,true) then
|
||||
{$ENDIF}
|
||||
raise EReportDataError.CreateFmt(SErrInvalidDataName, [aValue]);
|
||||
if (Collection is TFPReportVariables) then
|
||||
If ((Collection as TFPReportVariables).FindVariable(AValue)<>Nil) then
|
||||
raise EReportDataError.CreateFmt(SErrDuplicateData, [aValue]);
|
||||
FName:=AValue;
|
||||
end;
|
||||
|
||||
procedure TFPReportDataDefinitionItem.Assign(Source: TPersistent);
|
||||
|
||||
Var
|
||||
D : TFPReportDataDefinitionItem;
|
||||
begin
|
||||
if (Source is TFPReportDataDefinitionItem) then
|
||||
begin
|
||||
D:=Source as TFPReportDataDefinitionItem;
|
||||
Config:=D.Config;
|
||||
Name:=D.Name;
|
||||
DataType:=D.DataType;
|
||||
end
|
||||
else
|
||||
inherited Assign(Source);
|
||||
end;
|
||||
|
||||
procedure TFPReportDataDefinitionItem.SaveToJSON(O: TJSONObject);
|
||||
begin
|
||||
O.Add('name',Name);
|
||||
O.Add('type',DataType);
|
||||
O.Add('config',Config.Clone);
|
||||
end;
|
||||
|
||||
procedure TFPReportDataDefinitionItem.LoadFromJSON(O: TJSONObject);
|
||||
|
||||
Var
|
||||
C : TJSONObject;
|
||||
|
||||
begin
|
||||
Name:=O.Get('name',Name);
|
||||
DataType:=O.Get('type',DataType);
|
||||
C:=O.Get('config',TJSONObject(Nil));
|
||||
if Assigned(C) then
|
||||
Config:=C;
|
||||
end;
|
||||
|
||||
function TFPReportDataDefinitionItem.Clone(aNewName: String): TFPReportDataDefinitionItem;
|
||||
begin
|
||||
Result:=Collection.Add as TFPReportDataDefinitionItem;
|
||||
Result.Assign(Self);
|
||||
Result.Name:=aNewName;
|
||||
end;
|
||||
|
||||
function TFPReportDataDefinitionItem.CreateDataSet(AOwner: TComponent): TDataset;
|
||||
|
||||
Var
|
||||
H : TFPReportDataHandler;
|
||||
|
||||
begin
|
||||
H:=TFPCustomReportDataManager.GetTypeHandler(DataType);
|
||||
try
|
||||
Result:=H.CreateDataset(AOwner,Config);
|
||||
finally
|
||||
H.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function TFPReportDataDefinitionItem.Check: String;
|
||||
|
||||
Var
|
||||
H : TFPReportDataHandler;
|
||||
|
||||
begin
|
||||
If (Name='') then
|
||||
Result:=SErrNeedName
|
||||
else if (DataType='') then
|
||||
Result:=SErrNeedDataType
|
||||
else
|
||||
begin
|
||||
H:=TFPCustomReportDataManager.GetTypeHandler(DataType);
|
||||
if H=Nil then
|
||||
Result:=Format(SErrInvalidDataType,[DataType])
|
||||
else
|
||||
Result:=H.CheckConfig(Config);
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TFPReportDataDefinitionItem.Create(ACollection: TCollection);
|
||||
begin
|
||||
inherited Create(ACollection);
|
||||
FConfig:=TJSONObject.Create;
|
||||
end;
|
||||
|
||||
destructor TFPReportDataDefinitionItem.Destroy;
|
||||
begin
|
||||
FreeAndNil(FConfig);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
Finalization
|
||||
FreeAndNil(TFPCustomReportDataManager.FTypesList);
|
||||
end.
|
||||
|
||||
122
packages/fcl-report/src/fpreportdatacsv.pp
Normal file
122
packages/fcl-report/src/fpreportdatacsv.pp
Normal file
@ -0,0 +1,122 @@
|
||||
unit fpreportdatacsv;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, db, bufdataset, csvdataset, fpjson, fpreportdata;
|
||||
|
||||
Const
|
||||
keyFileName = 'filename';
|
||||
keyFirstLineHasFieldNames = 'firstLineHasFieldNames';
|
||||
keyCustomFieldNames = 'customFieldNames';
|
||||
keyDelimiter = 'delimiter';
|
||||
keyQuoteChar = 'quoteChar';
|
||||
|
||||
DefFirstLineFieldNames = True;
|
||||
DefDelimiter = ',';
|
||||
DefQuoteChar = '"';
|
||||
|
||||
Type
|
||||
TCSVReportDataHandler = Class(TFPReportDataHandler)
|
||||
Function CreateDataset(AOwner : TComponent; AConfig : TJSONObject) : TDataset; override;
|
||||
Class Function CheckConfig(AConfig: TJSONObject): String; override;
|
||||
Class Function DataType : String; override;
|
||||
Class Function DataTypeDescription : String; override;
|
||||
end;
|
||||
|
||||
Resourcestring
|
||||
SFileNameDoesNotExist = 'Filename does not exist: "%s"';
|
||||
SErrNeedFileName = 'Need a CSV file name';
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
{ TCSVReportDataHandler }
|
||||
|
||||
Type
|
||||
|
||||
{ TMyCSVDataset }
|
||||
|
||||
TMyCSVDataset = Class(TCSVDataset)
|
||||
private
|
||||
FCSVFileName: String;
|
||||
Protected
|
||||
function GetPacketReader(const Format: TDataPacketFormat; const AStream: TStream): TDataPacketReader; override;
|
||||
Procedure InternalOpen; override;
|
||||
Public
|
||||
Property CSVFileName : String Read FCSVFileName Write FCSVFileName;
|
||||
end;
|
||||
|
||||
|
||||
{ TMyCSVDataset }
|
||||
|
||||
function TMyCSVDataset.GetPacketReader(const Format: TDataPacketFormat; const AStream: TStream): TDataPacketReader;
|
||||
begin
|
||||
Result:=inherited GetPacketReader(Format, AStream);
|
||||
if (Result is TCSVDataPacketReader) and (FieldDefs.Count>0) then
|
||||
TCSVDataPacketReader(Result).CreateFieldDefs:=FieldDefs;
|
||||
end;
|
||||
|
||||
procedure TMyCSVDataset.InternalOpen;
|
||||
|
||||
begin
|
||||
FileName:=CSVFileName;
|
||||
Inherited;
|
||||
FileName:='';
|
||||
end;
|
||||
|
||||
function TCSVReportDataHandler.CreateDataset(AOwner: TComponent; AConfig: TJSONObject): TDataset;
|
||||
|
||||
Var
|
||||
C : TMyCSVDataset;
|
||||
A : TJSONArray;
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
C:=TMyCSVDataset.Create(AOWner);
|
||||
C.CSVOptions.FirstLineAsFieldNames:=AConfig.Get(keyFirstLineHasFieldNames,DefFirstLineFieldNames);
|
||||
C.CSVOptions.Delimiter:=AConfig.Get(KeyDelimiter,defDelimiter)[1];
|
||||
C.CSVOptions.quoteChar:=AConfig.Get(KeyQuoteChar,defQuoteChar)[1];
|
||||
if not C.CSVOptions.FirstLineAsFieldNames then
|
||||
begin
|
||||
A:=AConfig.Get(keyCustomFieldNames,TJSONArray(Nil));
|
||||
If Assigned(A) then
|
||||
For I:=0 to A.Count-1 do
|
||||
C.FieldDefs.Add(A.Strings[i],ftString,255);
|
||||
end;
|
||||
C.ReadOnly:=True;
|
||||
C.CSVFileName:=AConfig.Get(KeyFileName,'');
|
||||
Result:=C;
|
||||
end;
|
||||
|
||||
class function TCSVReportDataHandler.CheckConfig(AConfig: TJSONObject): String;
|
||||
|
||||
Var
|
||||
FN : UTF8String;
|
||||
|
||||
begin
|
||||
Result:='';
|
||||
FN:=AConfig.Get(KeyFileName,'');
|
||||
if FN='' then
|
||||
Result:=SErrNeedFileName
|
||||
else if not FileExists(FN) then
|
||||
Result:=Format(SFileNameDoesNotExist,[FN]);
|
||||
end;
|
||||
|
||||
class function TCSVReportDataHandler.DataType: String;
|
||||
begin
|
||||
Result:='CSV'
|
||||
end;
|
||||
|
||||
class function TCSVReportDataHandler.DataTypeDescription: String;
|
||||
begin
|
||||
Result:='Comma-separated values text file';
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
TCSVReportDataHandler.RegisterHandler;
|
||||
end.
|
||||
|
||||
67
packages/fcl-report/src/fpreportdatadbf.pp
Normal file
67
packages/fcl-report/src/fpreportdatadbf.pp
Normal file
@ -0,0 +1,67 @@
|
||||
unit fpreportdatadbf;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, db, dbf, fpjson, fpreportdata;
|
||||
|
||||
|
||||
Const
|
||||
keyFileName = 'filename';
|
||||
|
||||
Type
|
||||
TDBFReportDataHandler = Class(TFPReportDataHandler)
|
||||
Function CreateDataset(AOwner : TComponent; AConfig : TJSONObject) : TDataset; override;
|
||||
Class Function CheckConfig(AConfig: TJSONObject): String; override;
|
||||
Class Function DataType : String; override;
|
||||
Class Function DataTypeDescription : String; override;
|
||||
end;
|
||||
|
||||
Resourcestring
|
||||
SErrNeedFileName = 'Need a DBF file name';
|
||||
SFileNameDoesNotExist = 'Filename does not exist: "%s"';
|
||||
|
||||
implementation
|
||||
|
||||
function TDBFReportDataHandler.CreateDataset(AOwner: TComponent; AConfig: TJSONObject): TDataset;
|
||||
|
||||
Var
|
||||
C : TDBF;
|
||||
|
||||
begin
|
||||
C:=TDBF.Create(AOWner);
|
||||
C.TableName:=AConfig.Get(KeyFileName,'');
|
||||
C.ReadOnly:=True;
|
||||
Result:=C;
|
||||
end;
|
||||
|
||||
class function TDBFReportDataHandler.CheckConfig(AConfig: TJSONObject): String;
|
||||
|
||||
Var
|
||||
FN : UTF8String;
|
||||
|
||||
begin
|
||||
Result:='';
|
||||
FN:=AConfig.Get(KeyFileName,'');
|
||||
if FN='' then
|
||||
Result:=SErrNeedFileName
|
||||
else if not FileExists(FN) then
|
||||
Result:=Format(SFileNameDoesNotExist,[FN]);
|
||||
end;
|
||||
|
||||
class function TDBFReportDataHandler.DataType: String;
|
||||
begin
|
||||
Result:='DBF'
|
||||
end;
|
||||
|
||||
class function TDBFReportDataHandler.DataTypeDescription: String;
|
||||
begin
|
||||
Result:='DBase data file';
|
||||
end;
|
||||
|
||||
initialization
|
||||
TDBFReportDataHandler.RegisterHandler;
|
||||
end.
|
||||
|
||||
457
packages/fcl-report/src/fpreportdatajson.pp
Normal file
457
packages/fcl-report/src/fpreportdatajson.pp
Normal file
@ -0,0 +1,457 @@
|
||||
unit fpreportdatajson;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, db, fpjsondataset, fpjson, fpreportdata;
|
||||
|
||||
{ TDBFReportDataFrame }
|
||||
|
||||
Const
|
||||
keyFileName = 'filename';
|
||||
keyMetaData = 'meta';
|
||||
keyURL = 'url';
|
||||
keyDataForm = 'dataform';
|
||||
keyDataPath = 'path';
|
||||
keyFields = 'fields';
|
||||
keyFieldType = 'type';
|
||||
keyFieldName = 'name';
|
||||
|
||||
|
||||
Type
|
||||
TJSONReportDataHandler = Class(TFPReportDataHandler)
|
||||
Function CreateDataset(AOwner : TComponent; AConfig : TJSONObject) : TDataset; override;
|
||||
Class Function CheckConfig(AConfig: TJSONObject): String; override;
|
||||
Class Function DataType : String; override;
|
||||
Class Function DataTypeDescription : String; override;
|
||||
Class Function GetDataFromFile(aFileName : String) : TJSONData;
|
||||
Class Function GetDataFromURL(aURL : String) : TJSONData;
|
||||
end;
|
||||
|
||||
Type
|
||||
TDataForm = (dfObject,dfArray);
|
||||
|
||||
{ TMyJSONDataset }
|
||||
|
||||
TMyJSONDataset = class(TBaseJSONDataSet)
|
||||
private
|
||||
FDataForm: TDataForm;
|
||||
FDataPath: String;
|
||||
FFileNAme: String;
|
||||
FMaxStringFieldSize: Integer;
|
||||
FURL: String;
|
||||
FJSON : TJSONData;
|
||||
Public
|
||||
Constructor Create(AOwner : TComponent); override;
|
||||
Destructor Destroy; override;
|
||||
procedure InternalClose; override;
|
||||
Procedure InternalOpen; override;
|
||||
Procedure MetaDataToFieldDefs; override;
|
||||
Function CreateFieldMapper : TJSONFieldMapper; override;
|
||||
property DataForm : TDataForm Read FDataForm Write FDataForm;
|
||||
Property MetaData;
|
||||
Property FileName : String Read FFileNAme Write FFileName;
|
||||
Property URL : String Read FURL Write FURL;
|
||||
Property DataPath : String Read FDataPath Write FDataPath;
|
||||
Property MaxStringFieldSize : Integer Read FMaxStringFieldSize Write FMaxStringFieldSize;
|
||||
end;
|
||||
|
||||
TMyJSONObjectFieldMapper = Class(TJSONFieldMapper)
|
||||
procedure SetJSONDataForField(Const FieldName : String; FieldIndex : Integer; Row,Data : TJSONData); override;
|
||||
Function GetJSONDataForField(Const FieldName : String; FieldIndex : Integer; Row : TJSONData) : TJSONData; override;
|
||||
Function CreateRow : TJSONData; override;
|
||||
end;
|
||||
|
||||
Type
|
||||
TRecordDesc = Record
|
||||
name : string;
|
||||
fieldtype : TFieldType;
|
||||
end;
|
||||
TRecordDescArray = Array of TRecordDesc;
|
||||
|
||||
Function DetectJSONStruct(J : TJSONData; StartPath : String; Out APath : String; Out Records : TRecordDescArray; Out ArrayBased : Boolean) : Boolean;
|
||||
Function FieldTypeToString(Ft : TFieldType; Strict : Boolean) : String;
|
||||
Function TryStringToFieldType(S : String; out Ft : TFieldType; Strict : Boolean) : Boolean;
|
||||
|
||||
Resourcestring
|
||||
SErrNeedFileNameOrURL = 'Need a file name or URL';
|
||||
SErrNeedFileName = 'Need a file name';
|
||||
SErrNeedURL = 'Need a URL';
|
||||
SErrNeedFields = 'No fields have been defined';
|
||||
SErrFileNameDoesNotExist = 'Filename does not exist: "%s"';
|
||||
SErrInvalidProtocol = 'URL has invalid protocol: "%s". Only http and https are supported';
|
||||
SErrNotArrayData = 'Data at "%s" does not exist or is not an array.';
|
||||
SErrNoDataFound = 'JSON data was found, but no valid data structure was detected.';
|
||||
SErrUnsupportedJSONFieldType = 'Unsupported JSON field type: "%s"';
|
||||
SErrEmptyFieldsNotAllowed = 'Empty fields are not allowed (field: %d)';
|
||||
|
||||
implementation
|
||||
|
||||
uses typinfo,jsonparser,uriparser, fphttpclient;
|
||||
|
||||
Function FieldTypeToString(Ft : TFieldType; Strict : Boolean) : String;
|
||||
|
||||
begin
|
||||
Case FT of
|
||||
ftstring : Result:='string';
|
||||
ftBoolean : Result:='boolean';
|
||||
ftInteger : Result:='integer';
|
||||
ftLargeint : Result:='largeint';
|
||||
ftFloat : Result:='float';
|
||||
else
|
||||
if Strict then
|
||||
Raise EDatabaseError.CreateFmt(SErrUnsupportedJSONFieldType,[GetEnumName(TypeInfo(TFieldType),Ord(FT))]);
|
||||
result:='string';
|
||||
end;
|
||||
end;
|
||||
|
||||
Function TryStringToFieldType(S : String; out Ft : TFieldType; Strict : Boolean) : Boolean;
|
||||
|
||||
begin
|
||||
Result:=True;
|
||||
Case lowercase(s) of
|
||||
'string' : ft:=ftstring;
|
||||
'boolean': ft:=ftBoolean;
|
||||
'integer': ft:=ftInteger;
|
||||
'bigint' : ft:=ftLargeint;
|
||||
'largeint' : ft:=ftLargeint ;
|
||||
'float' : ft:=ftFloat;
|
||||
else
|
||||
if Strict then
|
||||
Result:=False
|
||||
else
|
||||
ft:=ftString;
|
||||
end;
|
||||
end;
|
||||
|
||||
Function DetectJSONStruct(J : TJSONData; StartPath : String; Out APath : String; Out Records : TRecordDescArray; Out ArrayBased : Boolean) : Boolean;
|
||||
|
||||
Var
|
||||
A : TJSONArray;
|
||||
D : TJSONData;
|
||||
O : TJSONObject;
|
||||
I,C : Integer;
|
||||
|
||||
begin
|
||||
J:=J.FindPath(StartPath);
|
||||
A:=Nil;
|
||||
if J is TJSONArray then
|
||||
begin
|
||||
APath:=StartPath;
|
||||
A:=J as TJSONArray;
|
||||
end
|
||||
else
|
||||
begin
|
||||
If J is TJSONObject then
|
||||
begin
|
||||
O:=J as TJSONObject;
|
||||
I:=0;
|
||||
While (A=Nil) and (I<J.Count) do
|
||||
begin
|
||||
If J.Items[i].JSONType=jtArray then
|
||||
begin
|
||||
A:= J.Items[i] as TJSONArray;
|
||||
APath:=O.Names[I];
|
||||
If StartPath<>'' then
|
||||
APath:=StartPath+'.'+APath;
|
||||
end;;
|
||||
Inc(I);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
Result:=Assigned(A) and (A.Count>0) and (A.Items[0].JSONType in [jtArray,jtObject]);
|
||||
if Result then
|
||||
begin
|
||||
D:=A.items[0];
|
||||
if D is TJSONObject then
|
||||
O:=D as TJSONObject
|
||||
else
|
||||
O:=Nil;
|
||||
ArrayBased:=O=Nil;
|
||||
SetLength(Records,D.Count);
|
||||
C:=0;
|
||||
for I:=0 to D.Count-1 do
|
||||
begin
|
||||
Records[C].FieldType:=ftUnknown;
|
||||
Case D.Items[C].JSONType of
|
||||
jtString : Records[C].FieldType:=ftString;
|
||||
jtNumber :
|
||||
Case TJSONNumber(D.Items[C]).NumberType of
|
||||
ntFloat: Records[C].fieldtype:=ftFloat;
|
||||
ntInteger: Records[C].fieldtype:=ftInteger;
|
||||
else
|
||||
Records[C].fieldtype:=ftLargeInt;
|
||||
end;
|
||||
jtBoolean : Records[C].fieldtype:=ftBoolean;
|
||||
jtNull : Records[C].fieldtype:=ftString;
|
||||
end;
|
||||
if (Records[C].FieldType<>ftUnknown) then
|
||||
begin
|
||||
if Assigned(O) then
|
||||
Records[C].Name:=O.Names[i]
|
||||
else
|
||||
Records[C].Name:='Column'+IntToStr(I);
|
||||
Inc(C);
|
||||
end;
|
||||
end;
|
||||
SetLength(Records,C);
|
||||
end
|
||||
else If J is TJSONObject then
|
||||
begin
|
||||
// Check members one by one
|
||||
O:=J as TJSONObject;
|
||||
I:=0;
|
||||
While Not result and (I<J.Count) do
|
||||
begin
|
||||
If J.Items[i].JSONType=jtObject then
|
||||
begin
|
||||
Result:=DetectJSONStruct(J,O.Names[I],APath,Records,ArrayBased);
|
||||
end;
|
||||
Inc(I);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TMyJSONObjectFieldMapper.SetJSONDataForField(const FieldName: String;
|
||||
FieldIndex: Integer; Row, Data: TJSONData);
|
||||
|
||||
begin
|
||||
Raise Exception.Create('Read-only data!');
|
||||
end;
|
||||
|
||||
function TMyJSONObjectFieldMapper.GetJSONDataForField(const FieldName: String;
|
||||
FieldIndex: Integer; Row: TJSONData): TJSONData;
|
||||
|
||||
Var
|
||||
I : integer;
|
||||
|
||||
begin
|
||||
I:=(Row as TJSONObject).IndexOfName(FieldName);
|
||||
if I=-1 then
|
||||
Result:=Nil
|
||||
else
|
||||
Result:=Row.Items[i];
|
||||
end;
|
||||
|
||||
function TMyJSONObjectFieldMapper.CreateRow: TJSONData;
|
||||
begin
|
||||
Result:=TJSONObject.Create;
|
||||
end;
|
||||
{ TMyJSONDataset }
|
||||
|
||||
constructor TMyJSONDataset.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
MaxStringFieldSize:=1024;
|
||||
OwnsData:=False;
|
||||
end;
|
||||
|
||||
destructor TMyJSONDataset.Destroy;
|
||||
begin
|
||||
FreeAndNil(FJSON);
|
||||
// We own metadata
|
||||
Metadata.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TMyJSONDataset.InternalClose;
|
||||
|
||||
begin
|
||||
Inherited;
|
||||
FreeAndNil(FJSON);
|
||||
end;
|
||||
|
||||
procedure TMyJSONDataset.InternalOpen;
|
||||
|
||||
Var
|
||||
R : TJSONData;
|
||||
|
||||
begin
|
||||
FreeAndNil(FJSON);
|
||||
if (URL<>'') then
|
||||
FJSON:=TJSONReportDataHandler.GetDataFromURL(URL)
|
||||
else
|
||||
FJSON:=TJSONReportDataHandler.GetDataFromFile(FileName);
|
||||
R:=FJSON.FindPath(DataPath);
|
||||
if not (R is TJSONArray) then
|
||||
Raise EDatabaseError.CreateFmt(SErrNotArrayData,[DataPath]);
|
||||
Rows:=R as TJSONArray;
|
||||
inherited InternalOpen;
|
||||
end;
|
||||
|
||||
|
||||
procedure TMyJSONDataset.MetaDataToFieldDefs;
|
||||
|
||||
Var
|
||||
F : TJSONarray;
|
||||
I : Integer;
|
||||
O : TJSONObject;
|
||||
Ft : TFieldType;
|
||||
|
||||
begin
|
||||
FieldDefs.Clear;
|
||||
F:=Metadata.get(keyFields,TJSONArray(Nil));
|
||||
if not Assigned(F) then
|
||||
exit;
|
||||
For I:=0 to F.Count-1 do
|
||||
begin
|
||||
O:=F.Objects[i];
|
||||
if TryStringToFieldType(O.strings[keyFieldType],ft,false) then
|
||||
if ft=ftString then
|
||||
FieldDefs.Add(O.strings[keyFieldName],FT,MaxStringFieldSize,False)
|
||||
else
|
||||
FieldDefs.Add(O.strings[keyFieldName],FT);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMyJSONDataset.CreateFieldMapper: TJSONFieldMapper;
|
||||
begin
|
||||
if DataForm = dfObject then
|
||||
begin
|
||||
Result:=TMyJSONObjectFieldMapper.Create;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Result:=TJSONArrayFieldMapper.Create;
|
||||
end
|
||||
end;
|
||||
|
||||
function TJSONReportDataHandler.CreateDataset(AOwner: TComponent; AConfig: TJSONObject): TDataset;
|
||||
|
||||
Var
|
||||
C : TMyJSONDataset;
|
||||
O : TJSONObject;
|
||||
|
||||
begin
|
||||
// Writeln('Starting dataset',aConfig.FormatJSON());
|
||||
C:=TMyJSONDataset.Create(AOWner);
|
||||
C.FileName:=AConfig.get(keyFileName,'');
|
||||
C.URL:=AConfig.get(keyURL,'');
|
||||
O:=AConfig.get(keyMetaData,TJSONObject(Nil));
|
||||
if Assigned(O) then
|
||||
C.MetaData:=O.Clone as TJSONObject
|
||||
else
|
||||
Raise EDatabaseError.Create('No metadata');
|
||||
if AConfig.get(keyDataForm,'object')='object' then
|
||||
C.DataForm:=dfObject
|
||||
else
|
||||
C.DataForm:=dfArray;
|
||||
C.DataPath:=AConfig.get(keyDataPath,'');;
|
||||
Result:=C;
|
||||
end;
|
||||
|
||||
class function TJSONReportDataHandler.CheckConfig(AConfig: TJSONObject): String;
|
||||
|
||||
Var
|
||||
FN,URL : UTF8String;
|
||||
URI : TURI;
|
||||
O : TJSONObject;
|
||||
A : TJSONArray;
|
||||
I : Integer;
|
||||
Ft : TFieldType;
|
||||
V : String;
|
||||
|
||||
begin
|
||||
Result:='';
|
||||
FN:=AConfig.Get(KeyFileName,'');
|
||||
if (FN='') then
|
||||
begin
|
||||
URL:=AConfig.Get(KeyURL,'');
|
||||
URI:=parseuri(URL,'http',80,True);
|
||||
case lowercase(uri.Protocol) of
|
||||
'https' : ;
|
||||
'http' : ;
|
||||
'' : ;
|
||||
else
|
||||
Result:=Format(SErrInvalidProtocol,[URI.Protocol]);
|
||||
end
|
||||
end
|
||||
else if FN='' then
|
||||
Result:=SErrNeedFileNameOrURL
|
||||
else if not FileExists(FN) then
|
||||
Result:=Format(SErrFileNameDoesNotExist,[FN])
|
||||
else
|
||||
begin
|
||||
O:=aConfig.get(keyMetaData,TJSONObject(Nil));
|
||||
if not Assigned(O) then
|
||||
Result:=SErrNeedFields
|
||||
else
|
||||
begin
|
||||
A:=O.get(keyFields,TJSONArray(Nil));
|
||||
if (A=Nil) or (A.Count=0) then
|
||||
Result:=SErrNeedFields
|
||||
else
|
||||
begin
|
||||
I:=0;
|
||||
While (Result='') and (I<A.Count) do
|
||||
begin
|
||||
if A.Types[i]=jtObject then
|
||||
begin
|
||||
O:=A.Objects[i];
|
||||
if (O.Get(KeyfieldName,'')='') then
|
||||
Result:=Format(SErrEmptyFieldsNotAllowed,[I+1])
|
||||
else
|
||||
begin
|
||||
V:=O.Get(KeyFieldType,'');
|
||||
if not TryStringToFieldType(V,ft,True) then
|
||||
Result:=Format(SErrUnsupportedJSONFieldType,[V]);
|
||||
end;
|
||||
end;
|
||||
Inc(I);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TJSONReportDataHandler.DataType: String;
|
||||
begin
|
||||
Result:='JSON'
|
||||
end;
|
||||
|
||||
class function TJSONReportDataHandler.DataTypeDescription: String;
|
||||
begin
|
||||
Result:='JSON data';
|
||||
end;
|
||||
|
||||
class function TJSONReportDataHandler.GetDataFromFile(aFileName: String): TJSONData;
|
||||
|
||||
Var
|
||||
F : TFileStream;
|
||||
begin
|
||||
F:=TFileStream.Create(aFileName,fmOpenRead or fmShareDenyWrite);
|
||||
try
|
||||
Result:=GetJSON(F);
|
||||
finally
|
||||
F.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TJSONReportDataHandler.GetDataFromURL(aURL: String): TJSONData;
|
||||
|
||||
Var
|
||||
S : TStringStream;
|
||||
URI : TURI;
|
||||
|
||||
begin
|
||||
S:=TStringStream.Create('');
|
||||
try
|
||||
URI:=ParseURI(aURL,False);
|
||||
if (URI.protocol='') then
|
||||
URI.protocol:='http';
|
||||
TFPHTTPClient.SimpleGet(EncodeURI(URI),S);
|
||||
S.Position:=0;
|
||||
Result:=getJSON(S);
|
||||
finally
|
||||
S.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
TJSONReportDataHandler.RegisterHandler;
|
||||
|
||||
end.
|
||||
|
||||
271
packages/fcl-report/src/fpreportdatasqldb.pp
Normal file
271
packages/fcl-report/src/fpreportdatasqldb.pp
Normal file
@ -0,0 +1,271 @@
|
||||
{
|
||||
This file is part of the Free Component Library.
|
||||
Copyright (c) 2017 Michael Van Canneyt, member of the Free Pascal development team
|
||||
|
||||
Report Designer Data connector for SQLDB based data.
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
unit fpreportdatasqldb;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, strutils, sqldb, db, fpjson, fpreportdata;
|
||||
|
||||
Const
|
||||
keyConnection = 'connection';
|
||||
keySQL = 'sql';
|
||||
keyType = 'dbtype';
|
||||
keyHostName = 'host';
|
||||
keyDatabaseName = 'database';
|
||||
keyUserName = 'user';
|
||||
keyPassword = 'pwd';
|
||||
keyRole = 'role';
|
||||
keyParams = 'params';
|
||||
KeyCharSet = 'charset';
|
||||
keyHash = 'FPCRulez';
|
||||
|
||||
Resourcestring
|
||||
SErrNoConnectionData = 'No connection data available';
|
||||
SErrNoSQL = 'No SQL statement set';
|
||||
|
||||
Type
|
||||
|
||||
{ TFPReportConnector }
|
||||
|
||||
TFPReportConnector = Class(TSQLConnector)
|
||||
Private
|
||||
FRefCount: Integer;
|
||||
Class procedure init;
|
||||
class procedure done;
|
||||
Class var
|
||||
FPool : TStringList;
|
||||
Public
|
||||
Procedure LoadFromConfig(aConfig : TJSONObject);
|
||||
class function CreateConnection(aConfig: TJSONObject): TFPReportConnector;
|
||||
Class Function TestConnection (aConfig : TJSONObject) : string;
|
||||
class function CreateDataset(aOwner: TComponent; aConfig: TJSONObject): TSQLQuery;
|
||||
class function CreateConfigHash(aConfig: TJSONObject): String;
|
||||
Class procedure CheckDBRelease;
|
||||
Property RefCount : Integer Read FRefCount;
|
||||
end;
|
||||
|
||||
{ TFPReportQuery }
|
||||
|
||||
TFPReportQuery = class(TSQLQuery)
|
||||
Public
|
||||
Constructor Create(AOwner : TComponent); override;
|
||||
Destructor Destroy; override;
|
||||
end;
|
||||
|
||||
|
||||
TSQLDBReportDataHandler = Class(TFPReportDataHandler)
|
||||
Function CreateDataset(AOwner : TComponent; AConfig : TJSONObject) : TDataset; override;
|
||||
Class Function CheckConfig(AConfig: TJSONObject): String; override;
|
||||
Class Function DataType : String; override;
|
||||
Class Function DataTypeDescription : String; override;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{ TFPReportQuery }
|
||||
|
||||
constructor TFPReportQuery.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
ReadOnly:=True;
|
||||
end;
|
||||
|
||||
destructor TFPReportQuery.Destroy;
|
||||
|
||||
begin
|
||||
If Database is TFPReportConnector then
|
||||
Dec(TFPReportConnector(Database).FRefCount);
|
||||
inherited Destroy;
|
||||
TFPReportConnector.CheckDBRelease;
|
||||
end;
|
||||
|
||||
{ TFPReportConnector }
|
||||
|
||||
class procedure TFPReportConnector.init;
|
||||
begin
|
||||
FPool:=TStringList.Create;
|
||||
FPool.OwnsObjects:=True;
|
||||
FPool.Sorted:=True;
|
||||
FPool.Duplicates:=dupError;
|
||||
end;
|
||||
|
||||
class procedure TFPReportConnector.done;
|
||||
begin
|
||||
FreeAndNil(FPool);
|
||||
end;
|
||||
|
||||
Class Function TFPReportConnector.CreateConfigHash(aConfig : TJSONObject) : String;
|
||||
|
||||
Procedure AH(N,V : String);
|
||||
|
||||
begin
|
||||
if (V<>'') then
|
||||
Result:=Result+';'+N+'='+V;
|
||||
end;
|
||||
|
||||
Procedure AH(N : String);
|
||||
|
||||
|
||||
begin
|
||||
AH(N,aConfig.get(N,''));
|
||||
end;
|
||||
|
||||
Var
|
||||
A : TJSONArray;
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
AH(keyType);
|
||||
AH(keyHostName);
|
||||
AH(keyDatabaseName);
|
||||
AH(keyUserName);
|
||||
AH(keyPassword);
|
||||
AH(keyRole);
|
||||
A:=aConfig.get(keyParams,TJSONArray(Nil));
|
||||
If Assigned(A) then
|
||||
For I:=0 to A.Count-1 do
|
||||
AH(IntToStr(I),A.Strings[i]);
|
||||
end;
|
||||
|
||||
class procedure TFPReportConnector.CheckDBRelease;
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
For I:=FPool.Count-1 downto 0 do
|
||||
begin
|
||||
// Writeln('Connection count for ',FPool[i], ' : ',TFPReportConnector(FPool.Objects[i]).FRefCount);
|
||||
if TFPReportConnector(FPool.Objects[i]).FRefCount=0 then
|
||||
FPool.Delete(I);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPReportConnector.LoadFromConfig(aConfig: TJSONObject);
|
||||
|
||||
Var
|
||||
S : String;
|
||||
A : TJSONArray;
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
ConnectorType:=aConfig.get(keyType,'');
|
||||
HostName:=aConfig.get(keyHostName,'');
|
||||
DatabaseName:=aConfig.get(keyDatabaseName,'');
|
||||
UserName:=aConfig.get(keyUserName,'');
|
||||
S:=aConfig.get(keyPassword,'');
|
||||
if (S<>'') then
|
||||
Password:=XORDecode(keyHash,S);
|
||||
Role:=aConfig.get(keyRole,'');
|
||||
Params.Clear;
|
||||
A:=aConfig.get(keyParams,TJSONArray(Nil));
|
||||
If Assigned(A) then
|
||||
For I:=0 to A.Count-1 do
|
||||
Params.Add(A.Strings[i]);
|
||||
end;
|
||||
|
||||
class function TFPReportConnector.CreateConnection(aConfig: TJSONObject): TFPReportConnector;
|
||||
|
||||
begin
|
||||
Result:=Self.Create(Nil);
|
||||
Result.LoadFromConfig(aConfig);
|
||||
Result.Transaction:=TSQLtransaction.Create(Result);
|
||||
end;
|
||||
|
||||
class function TFPReportConnector.TestConnection(aConfig: TJSONObject): string;
|
||||
|
||||
Var
|
||||
C : TFPReportConnector;
|
||||
|
||||
begin
|
||||
Result:='';
|
||||
C:=CreateConnection(aConfig);
|
||||
try
|
||||
C.Connected:=True;
|
||||
except
|
||||
On E : Exception do
|
||||
Result:=E.Message;
|
||||
end;
|
||||
C.free;
|
||||
end;
|
||||
|
||||
class function TFPReportConnector.CreateDataset(aOwner: TComponent; aConfig: TJSONObject): TSQLQuery;
|
||||
|
||||
Var
|
||||
S : String;
|
||||
C : TFPReportConnector;
|
||||
I : integer;
|
||||
O : TJSONObject;
|
||||
|
||||
begin
|
||||
O:=aConfig.Get(keyConnection,TJSONObject(Nil));
|
||||
if O=Nil then
|
||||
Raise EDatabaseError.Create(SErrNoConnectionData);
|
||||
S:=CreateConfigHash(o);
|
||||
i:=FPool.IndexOf(S);
|
||||
if (I<>-1) then
|
||||
C:=FPool.Objects[i] as TFPReportConnector
|
||||
else
|
||||
begin
|
||||
C:=CreateConnection(o);
|
||||
FPool.AddObject(S,C);
|
||||
end;
|
||||
Result:=TFPReportQuery.Create(aOwner);
|
||||
Result.Database:=C;
|
||||
Result.SQL.Text:=aConfig.get(keySQL,'');
|
||||
Inc(C.FRefCount);
|
||||
end;
|
||||
|
||||
{ TSQLDBReportDataHandler }
|
||||
|
||||
function TSQLDBReportDataHandler.CreateDataset(AOwner: TComponent; AConfig: TJSONObject): TDataset;
|
||||
begin
|
||||
Result:=TFPReportConnector.CreateDataset(aOwner,aConfig);
|
||||
end;
|
||||
|
||||
class function TSQLDBReportDataHandler.CheckConfig(AConfig: TJSONObject): String;
|
||||
|
||||
Var
|
||||
O : TJSONObject;
|
||||
|
||||
begin
|
||||
O:=aConfig.Get(keyConnection,TJSONObject(Nil));
|
||||
if (O=Nil) or (O.Count=0) then
|
||||
Result:=SErrNoConnectionData
|
||||
else if Trim(aConfig.Get(keySQL,''))='' then
|
||||
Result:=SErrNoSQL
|
||||
end;
|
||||
|
||||
class function TSQLDBReportDataHandler.DataType: String;
|
||||
begin
|
||||
Result:='SQLDB';
|
||||
end;
|
||||
|
||||
class function TSQLDBReportDataHandler.DataTypeDescription: String;
|
||||
begin
|
||||
Result:='SQL Database server';
|
||||
end;
|
||||
|
||||
initialization
|
||||
TSQLDBReportDataHandler.RegisterHandler;
|
||||
TFPReportConnector.Init;
|
||||
Finalization
|
||||
TFPReportConnector.Done;
|
||||
end.
|
||||
|
||||
@ -28,7 +28,9 @@ Type
|
||||
TFPReportDatasetData = class(TFPReportData)
|
||||
private
|
||||
FDataSet: TDataSet;
|
||||
procedure SetDataSet(AValue: TDataSet);
|
||||
protected
|
||||
Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
||||
procedure DoGetValue(const AFieldName: string; var AValue: variant); override;
|
||||
procedure DoInitDataFields; override;
|
||||
procedure DoOpen; override;
|
||||
@ -41,7 +43,7 @@ Type
|
||||
Procedure StartDesigning; override;
|
||||
Procedure EndDesigning; override;
|
||||
published
|
||||
property DataSet: TDataSet read FDataSet write FDataSet;
|
||||
property DataSet: TDataSet read FDataSet write SetDataSet;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -53,6 +55,23 @@ resourcestring
|
||||
|
||||
{ TFPReportDatasetData }
|
||||
|
||||
procedure TFPReportDatasetData.SetDataSet(AValue: TDataSet);
|
||||
begin
|
||||
if FDataSet=AValue then Exit;
|
||||
if Assigned(FDataset) then
|
||||
FDataset.RemoveFreeNotification(Self);
|
||||
FDataSet:=AValue;
|
||||
if Assigned(FDataset) then
|
||||
FDataset.FreeNotification(Self);
|
||||
end;
|
||||
|
||||
procedure TFPReportDatasetData.Notification(AComponent: TComponent; Operation: TOperation);
|
||||
begin
|
||||
inherited Notification(AComponent, Operation);
|
||||
if (Operation=opRemove) and (AComponent=FDataset) then
|
||||
FDataset:=Nil;
|
||||
end;
|
||||
|
||||
procedure TFPReportDatasetData.DoGetValue(const AFieldName: string; var AValue: variant);
|
||||
var
|
||||
ms: TMemoryStream;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user