paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-29 23:20:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Implemented OnParamValue event

Browse Source 
git-svn-id: trunk@15571 -
This commit is contained in:
michael 2010-07-14 14:35:36 +00:00
parent 1a50f3ed26
commit 463faef0b6
1 changed files with 30 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
packages/fcl-web/src/webdata/sqldbwebdata.pp
View File

@ -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}