* Implemented OnParamValue event

git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@15571 3ad0048d-3df7-0310-abae-a5850022a9f2

1 files changed, 30 insertions, 11 deletions

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}