diff --git a/packages/fcl-web/src/webdata/sqldbwebdata.pp b/packages/fcl-web/src/webdata/sqldbwebdata.pp index 87af19233e..7fe04543a6 100644 --- a/packages/fcl-web/src/webdata/sqldbwebdata.pp +++ b/packages/fcl-web/src/webdata/sqldbwebdata.pp @@ -12,21 +12,23 @@ Type { TCustomSQLDBWebDataProvider } TNewIDEvent = Procedure(Sender : TObject; Out AID : String) of object; TGetParamTypeEvent = Procedure (Sender : TObject; Const ParamName,AValue : String; Var AType : TFieldtype) of object; + TGetParamValueEvent = Procedure (Sender : TObject; P : TParam; Var Handled : Boolean) of object; TCustomSQLDBWebDataProvider = Class(TFPCustomWebDataProvider) private FIDFieldName: String; FOnGetNewID: TNewIDEvent; + FOnGetParamValue: TGetParamValueEvent; FSQLS : Array[0..3] of TStringList; FConnection: TSQLConnection; FQuery : TSQLQuery; FLastNewID : String; FOnGetParamType : TGetParamTypeEvent; - procedure CheckDataset; function GetS(AIndex: integer): TStrings; procedure SetConnection(const AValue: TSQLConnection); procedure SetS(AIndex: integer; const AValue: TStrings); Protected + function CheckDataset : Boolean; virtual; function CreateQuery(AOwner: TComponent; ATransaction: TSQLTransaction; ASQL: Tstrings): TSQLQuery; function GetParamType(P: TParam; const AValue: String): TFieldType; virtual; procedure SetTypedParam(P: TParam; Const AValue: String); virtual; @@ -37,6 +39,7 @@ Type Procedure DoDelete; override; Procedure DoInsert; override; Procedure DoApplyParams; override; + Function SQLQuery : TSQLQuery; Function GetDataset : TDataset; override; Function GetNewID : String; Function IDFieldValue : String; override; @@ -48,6 +51,7 @@ Type Property Connection : TSQLConnection Read FConnection Write SetConnection; Property OnGetNewID : TNewIDEvent Read FOnGetNewID Write FOnGetNewID; property OnGetParameterType : TGetParamTypeEvent Read FOnGetParamType Write FOnGetParamType; + property OnGetParameterValue : TGetParamValueEvent Read FOnGetParamValue Write FOnGetParamValue; Public Constructor Create(AOwner : TComponent); override; Destructor Destroy; override; @@ -63,6 +67,7 @@ Type Property IDFieldName; Property OnGetNewID; property OnGetParameterType; + property OnGetParameterValue; Property Options; end; @@ -206,13 +211,14 @@ begin Result.SQL.Assign(ASQL); end; -procedure TCustomSQLDBWebDataProvider.CheckDataset; +Function TCustomSQLDBWebDataProvider.CheckDataset : boolean; begin {$ifdef wmdebug}SendDebug('Entering CheckDataset');{$endif} If (Trim(SelectSQL.Text)='') then Raise EFPHTTPError.CreateFmt(SErrNoSelectSQL,[Self.Name]); - If (FQuery=Nil) then + Result:=FQuery=Nil; + If (Result) then FQuery:=CreateQuery(Nil,Nil,SelectSQL) else if not FQuery.Active then FQuery.SQL.Assign(SelectSQL); @@ -311,20 +317,28 @@ var I: Integer; P : TParam; S : String; + B : Boolean; + begin {$ifdef wmdebug}SendDebug('Entering ApplySQLPArams');{$endif} For I:=0 to AQuery.Params.Count-1 do begin P:=AQuery.Params[i]; - If (P.Name=IDFieldName) and DoNewID then - SetTypedParam(P,GetNewID) - else If Adaptor.TryFieldValue(P.Name,S) then - SetTypedParam(P,S) - else If Adaptor.TryParamValue(P.Name,S) then - SetTypedParam(P,S) - else - P.Clear; + B:=Assigned(FOnGetParamValue); + if B then + FOnGetParamValue(Self,P,B); + if not B then + begin + If (P.Name=IDFieldName) and DoNewID then + SetTypedParam(P,GetNewID) + else If Adaptor.TryFieldValue(P.Name,S) then + SetTypedParam(P,S) + else If Adaptor.TryParamValue(P.Name,S) then + SetTypedParam(P,S) + else + P.Clear; + end; end; {$ifdef wmdebug}SendDebug('Exiting ApplySQLPArams');{$endif} end; @@ -336,6 +350,11 @@ begin ApplySQLParams(FQuery); end; +function TCustomSQLDBWebDataProvider.SQLQuery: TSQLQuery; +begin + Result:=FQuery; +end; + function TCustomSQLDBWebDataProvider.GetDataset: TDataset; begin {$ifdef wmdebug}SendDebug('Get dataset: checking dataset');{$endif}