From 64c0fede255e2a5b500495f9be23f06a1e64078c Mon Sep 17 00:00:00 2001 From: michael Date: Wed, 20 Apr 2011 16:05:41 +0000 Subject: [PATCH] * Patch from Stephano to implement IProviderSupport git-svn-id: trunk@17354 - --- packages/fcl-db/src/base/dataset.inc | 129 ++++++++++ packages/fcl-db/src/base/db.pas | 344 ++++++++++++++++----------- 2 files changed, 335 insertions(+), 138 deletions(-) diff --git a/packages/fcl-db/src/base/dataset.inc b/packages/fcl-db/src/base/dataset.inc index 34443e4a40..bc8b98556e 100644 --- a/packages/fcl-db/src/base/dataset.inc +++ b/packages/fcl-db/src/base/dataset.inc @@ -2305,3 +2305,132 @@ begin FDataSources.Remove(ADataSource); end; +{------------------------------------------------------------------------------} +{ IProviderSupport methods} + +procedure TDataset.PSEndTransaction(Commit: Boolean); +begin + DatabaseError('Provider support not available', Self); +end; + +procedure TDataset.PSExecute; +begin + DatabaseError('Provider support not available', Self); +end; + +function TDataset.PSExecuteStatement(const ASQL: string; AParams: TParams; + ResultSet: Pointer): Integer; +begin + Result := 0; + DatabaseError('Provider support not available', Self); +end; + +procedure TDataset.PSGetAttributes(List: TList); +begin + DatabaseError('Provider support not available', Self); +end; + +function TDataset.PSGetCommandText: string; +begin + Result := ''; + DatabaseError('Provider support not available', Self); +end; + +function TDataset.PSGetCommandType: TPSCommandType; +begin + Result := ctUnknown; + DatabaseError('Provider support not available', Self); +end; + +function TDataset.PSGetDefaultOrder: TIndexDef; +begin + Result := nil; + //DatabaseError('Provider support not available', Self); +end; + +function TDataset.PSGetIndexDefs(IndexTypes: TIndexOptions): TIndexDefs; +begin + Result := nil; + DatabaseError('Provider support not available', Self); +end; + +function TDataset.PSGetKeyFields: string; +begin + Result := ''; + DatabaseError('Provider support not available', Self); +end; + +function TDataset.PSGetParams: TParams; +begin + Result := nil; + DatabaseError('Provider support not available', Self); +end; + +function TDataset.PSGetQuoteChar: string; +begin + Result := ''; + DatabaseError('Provider support not available', Self); +end; + +function TDataset.PSGetTableName: string; +begin + Result := ''; + DatabaseError('Provider support not available', Self); +end; + +function TDataset.PSGetUpdateException(E: Exception; Prev: EUpdateError + ): EUpdateError; +begin + if Prev <> nil then + Result := EUpdateError.Create(E.Message, '', 0, Prev.ErrorCode, E) + else + Result := EUpdateError.Create(E.Message, '', 0, 0, E) +end; + +function TDataset.PSInTransaction: Boolean; +begin + Result := False; + DatabaseError('Provider support not available', Self); +end; + +function TDataset.PSIsSQLBased: Boolean; +begin + Result := False; + DatabaseError('Provider support not available', Self); +end; + +function TDataset.PSIsSQLSupported: Boolean; +begin + Result := False; + DatabaseError('Provider support not available', Self); +end; + +procedure TDataset.PSReset; +begin + //DatabaseError('Provider support not available', Self); +end; + +procedure TDataset.PSSetCommandText(const CommandText: string); +begin + DatabaseError('Provider support not available', Self); +end; + +procedure TDataset.PSSetParams(AParams: TParams); +begin + DatabaseError('Provider support not available', Self); +end; + +procedure TDataset.PSStartTransaction; +begin + DatabaseError('Provider support not available', Self); +end; + +function TDataset.PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet + ): Boolean; +begin + Result := False; + DatabaseError('Provider support not available', Self); +end; + +{------------------------------------------------------------------------------} + diff --git a/packages/fcl-db/src/base/db.pas b/packages/fcl-db/src/base/db.pas index 4b58514ae2..2806646eb3 100644 --- a/packages/fcl-db/src/base/db.pas +++ b/packages/fcl-db/src/base/db.pas @@ -1092,6 +1092,144 @@ type end; + { TParam } + + TBlobData = string; + + TParamBinding = array of integer; + + TParamType = (ptUnknown, ptInput, ptOutput, ptInputOutput, ptResult); + TParamTypes = set of TParamType; + + TParamStyle = (psInterbase,psPostgreSQL,psSimulated); + + TParams = class; + + TParam = class(TCollectionItem) + private + FNativeStr: string; + FValue: Variant; + FPrecision: Integer; + FNumericScale: Integer; + FName: string; + FDataType: TFieldType; + FBound: Boolean; + FParamType: TParamType; + FSize: Integer; + Function GetDataSet: TDataSet; + Function IsParamStored: Boolean; + protected + Procedure AssignParam(Param: TParam); + Procedure AssignTo(Dest: TPersistent); override; + Function GetAsBoolean: Boolean; + Function GetAsCurrency: Currency; + Function GetAsDateTime: TDateTime; + Function GetAsFloat: Double; + Function GetAsInteger: Longint; + Function GetAsLargeInt: LargeInt; + Function GetAsMemo: string; + Function GetAsString: string; + Function GetAsVariant: Variant; + Function GetDisplayName: string; override; + Function GetIsNull: Boolean; + Function IsEqual(AValue: TParam): Boolean; + Procedure SetAsBlob(const AValue: TBlobData); + Procedure SetAsBoolean(AValue: Boolean); + Procedure SetAsCurrency(const AValue: Currency); + Procedure SetAsDate(const AValue: TDateTime); + Procedure SetAsDateTime(const AValue: TDateTime); + Procedure SetAsFloat(const AValue: Double); + Procedure SetAsInteger(AValue: Longint); + Procedure SetAsLargeInt(AValue: LargeInt); + Procedure SetAsMemo(const AValue: string); + Procedure SetAsSmallInt(AValue: LongInt); + Procedure SetAsString(const AValue: string); + Procedure SetAsTime(const AValue: TDateTime); + Procedure SetAsVariant(const AValue: Variant); + Procedure SetAsWord(AValue: LongInt); + Procedure SetDataType(AValue: TFieldType); + Procedure SetText(const AValue: string); + function GetAsWideString: WideString; + procedure SetAsWideString(const aValue: WideString); + public + constructor Create(ACollection: TCollection); overload; override; + constructor Create(AParams: TParams; AParamType: TParamType); reintroduce; overload; + Procedure Assign(Source: TPersistent); override; + Procedure AssignField(Field: TField); + Procedure AssignToField(Field: TField); + Procedure AssignFieldValue(Field: TField; const AValue: Variant); + procedure AssignFromField(Field : TField); + Procedure Clear; + Procedure GetData(Buffer: Pointer); + Function GetDataSize: Integer; + Procedure LoadFromFile(const FileName: string; BlobType: TBlobType); + Procedure LoadFromStream(Stream: TStream; BlobType: TBlobType); + Procedure SetBlobData(Buffer: Pointer; ASize: Integer); + Procedure SetData(Buffer: Pointer); + Property AsBlob : TBlobData read GetAsString write SetAsBlob; + Property AsBoolean : Boolean read GetAsBoolean write SetAsBoolean; + Property AsCurrency : Currency read GetAsCurrency write SetAsCurrency; + Property AsDate : TDateTime read GetAsDateTime write SetAsDate; + Property AsDateTime : TDateTime read GetAsDateTime write SetAsDateTime; + Property AsFloat : Double read GetAsFloat write SetAsFloat; + Property AsInteger : LongInt read GetAsInteger write SetAsInteger; + Property AsLargeInt : LargeInt read GetAsLargeInt write SetAsLargeInt; + Property AsMemo : string read GetAsMemo write SetAsMemo; + Property AsSmallInt : LongInt read GetAsInteger write SetAsSmallInt; + Property AsString : string read GetAsString write SetAsString; + Property AsTime : TDateTime read GetAsDateTime write SetAsTime; + Property AsWord : LongInt read GetAsInteger write SetAsWord; + Property Bound : Boolean read FBound write FBound; + Property Dataset : TDataset Read GetDataset; + Property IsNull : Boolean read GetIsNull; + Property NativeStr : string read FNativeStr write FNativeStr; + Property Text : string read GetAsString write SetText; + Property Value : Variant read GetAsVariant write SetAsVariant stored IsParamStored; + property AsWideString: WideString read GetAsWideString write SetAsWideString; + published + Property DataType : TFieldType read FDataType write SetDataType; + Property Name : string read FName write FName; + Property NumericScale : Integer read FNumericScale write FNumericScale default 0; + Property ParamType : TParamType read FParamType write FParamType; + Property Precision : Integer read FPrecision write FPrecision default 0; + Property Size : Integer read FSize write FSize default 0; + end; + + + { TParams } + + TParams = class(TCollection) + private + FOwner: TPersistent; + Function GetItem(Index: Integer): TParam; + Function GetParamValue(const ParamName: string): Variant; + Procedure SetItem(Index: Integer; Value: TParam); + Procedure SetParamValue(const ParamName: string; const Value: Variant); + protected + Procedure AssignTo(Dest: TPersistent); override; + Function GetDataSet: TDataSet; + Function GetOwner: TPersistent; override; + public + Constructor Create(AOwner: TPersistent); overload; + Constructor Create; overload; + Procedure AddParam(Value: TParam); + Procedure AssignValues(Value: TParams); + Function CreateParam(FldType: TFieldType; const ParamName: string; ParamType: TParamType): TParam; + Function FindParam(const Value: string): TParam; + Procedure GetParamList(List: TList; const ParamNames: string); + Function IsEqual(Value: TParams): Boolean; + Function ParamByName(const Value: string): TParam; + Function ParseSQL(SQL: String; DoCreate: Boolean): String; overload; + Function ParseSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle): String; overload; + Function ParseSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle; var ParamBinding: TParambinding): String; overload; + Function ParseSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle; var ParamBinding: TParambinding; var ReplaceString : string): String; overload; + Procedure RemoveParam(Value: TParam); + Procedure CopyParamValuesFromDataset(ADataset : TDataset; CopyBound : Boolean); + Property Dataset : TDataset Read GetDataset; + Property Items[Index: Integer] : TParam read GetItem write SetItem; default; + Property ParamValues[const ParamName: string] : Variant read GetParamValue write SetParamValue; + end; + { TDataSet } TBookmark = Pointer; @@ -1134,6 +1272,48 @@ type TDatasetClass = Class of TDataset; TBufferArray = ^pchar; +{------------------------------------------------------------------------------} +{IProviderSupport interface} + + TPSCommandType = ( + ctUnknown, + ctQuery, + ctTable, + ctStoredProc, + ctSelect, + ctInsert, + ctUpdate, + ctDelete, + ctDDL + ); + + IProviderSupport = interface + procedure PSEndTransaction(ACommit: Boolean); + procedure PSExecute; + function PSExecuteStatement(const ASQL: string; AParams: TParams; + ResultSet: Pointer = nil): Integer; + procedure PSGetAttributes(List: TList); + function PSGetCommandText: string; + function PSGetCommandType: TPSCommandType; + function PSGetDefaultOrder: TIndexDef; + function PSGetIndexDefs(IndexTypes: TIndexOptions = [ixPrimary..ixNonMaintained]) + : TIndexDefs; + function PSGetKeyFields: string; + function PSGetParams: TParams; + function PSGetQuoteChar: string; + function PSGetTableName: string; + function PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError; + function PSInTransaction: Boolean; + function PSIsSQLBased: Boolean; + function PSIsSQLSupported: Boolean; + procedure PSReset; + procedure PSSetCommandText(const CommandText: string); + procedure PSSetParams(AParams: TParams); + procedure PSStartTransaction; + function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; + end; +{------------------------------------------------------------------------------} + TDataSet = class(TComponent) Private FOpenAfterRead : boolean; @@ -1324,6 +1504,32 @@ type procedure InternalOpen; virtual; abstract; procedure InternalInitFieldDefs; virtual; abstract; function IsCursorOpen: Boolean; virtual; abstract; + protected { IProviderSupport methods } + procedure PSEndTransaction(Commit: Boolean); virtual; + procedure PSExecute; virtual; + function PSExecuteStatement(const ASQL: string; AParams: TParams; + ResultSet: Pointer = nil): Integer; virtual; + procedure PSGetAttributes(List: TList); virtual; + function PSGetCommandText: string; virtual; + function PSGetCommandType: TPSCommandType; virtual; + function PSGetDefaultOrder: TIndexDef; virtual; + function PSGetIndexDefs(IndexTypes: TIndexOptions = [ixPrimary..ixNonMaintained]) + : TIndexDefs; virtual; + function PSGetKeyFields: string; virtual; + function PSGetParams: TParams; virtual; + function PSGetQuoteChar: string; virtual; + function PSGetTableName: string; virtual; + function PSGetUpdateException(E: Exception; Prev: EUpdateError) + : EUpdateError; virtual; + function PSInTransaction: Boolean; virtual; + function PSIsSQLBased: Boolean; virtual; + function PSIsSQLSupported: Boolean; virtual; + procedure PSReset; virtual; + procedure PSSetCommandText(const CommandText: string); virtual; + procedure PSSetParams(AParams: TParams); virtual; + procedure PSStartTransaction; virtual; + function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet) + : Boolean; virtual; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; @@ -1716,144 +1922,6 @@ type end; - { TParam } - - TBlobData = string; - - TParamBinding = array of integer; - - TParamType = (ptUnknown, ptInput, ptOutput, ptInputOutput, ptResult); - TParamTypes = set of TParamType; - - TParamStyle = (psInterbase,psPostgreSQL,psSimulated); - - TParams = class; - - TParam = class(TCollectionItem) - private - FNativeStr: string; - FValue: Variant; - FPrecision: Integer; - FNumericScale: Integer; - FName: string; - FDataType: TFieldType; - FBound: Boolean; - FParamType: TParamType; - FSize: Integer; - Function GetDataSet: TDataSet; - Function IsParamStored: Boolean; - protected - Procedure AssignParam(Param: TParam); - Procedure AssignTo(Dest: TPersistent); override; - Function GetAsBoolean: Boolean; - Function GetAsCurrency: Currency; - Function GetAsDateTime: TDateTime; - Function GetAsFloat: Double; - Function GetAsInteger: Longint; - Function GetAsLargeInt: LargeInt; - Function GetAsMemo: string; - Function GetAsString: string; - Function GetAsVariant: Variant; - Function GetDisplayName: string; override; - Function GetIsNull: Boolean; - Function IsEqual(AValue: TParam): Boolean; - Procedure SetAsBlob(const AValue: TBlobData); - Procedure SetAsBoolean(AValue: Boolean); - Procedure SetAsCurrency(const AValue: Currency); - Procedure SetAsDate(const AValue: TDateTime); - Procedure SetAsDateTime(const AValue: TDateTime); - Procedure SetAsFloat(const AValue: Double); - Procedure SetAsInteger(AValue: Longint); - Procedure SetAsLargeInt(AValue: LargeInt); - Procedure SetAsMemo(const AValue: string); - Procedure SetAsSmallInt(AValue: LongInt); - Procedure SetAsString(const AValue: string); - Procedure SetAsTime(const AValue: TDateTime); - Procedure SetAsVariant(const AValue: Variant); - Procedure SetAsWord(AValue: LongInt); - Procedure SetDataType(AValue: TFieldType); - Procedure SetText(const AValue: string); - function GetAsWideString: WideString; - procedure SetAsWideString(const aValue: WideString); - public - constructor Create(ACollection: TCollection); overload; override; - constructor Create(AParams: TParams; AParamType: TParamType); reintroduce; overload; - Procedure Assign(Source: TPersistent); override; - Procedure AssignField(Field: TField); - Procedure AssignToField(Field: TField); - Procedure AssignFieldValue(Field: TField; const AValue: Variant); - procedure AssignFromField(Field : TField); - Procedure Clear; - Procedure GetData(Buffer: Pointer); - Function GetDataSize: Integer; - Procedure LoadFromFile(const FileName: string; BlobType: TBlobType); - Procedure LoadFromStream(Stream: TStream; BlobType: TBlobType); - Procedure SetBlobData(Buffer: Pointer; ASize: Integer); - Procedure SetData(Buffer: Pointer); - Property AsBlob : TBlobData read GetAsString write SetAsBlob; - Property AsBoolean : Boolean read GetAsBoolean write SetAsBoolean; - Property AsCurrency : Currency read GetAsCurrency write SetAsCurrency; - Property AsDate : TDateTime read GetAsDateTime write SetAsDate; - Property AsDateTime : TDateTime read GetAsDateTime write SetAsDateTime; - Property AsFloat : Double read GetAsFloat write SetAsFloat; - Property AsInteger : LongInt read GetAsInteger write SetAsInteger; - Property AsLargeInt : LargeInt read GetAsLargeInt write SetAsLargeInt; - Property AsMemo : string read GetAsMemo write SetAsMemo; - Property AsSmallInt : LongInt read GetAsInteger write SetAsSmallInt; - Property AsString : string read GetAsString write SetAsString; - Property AsTime : TDateTime read GetAsDateTime write SetAsTime; - Property AsWord : LongInt read GetAsInteger write SetAsWord; - Property Bound : Boolean read FBound write FBound; - Property Dataset : TDataset Read GetDataset; - Property IsNull : Boolean read GetIsNull; - Property NativeStr : string read FNativeStr write FNativeStr; - Property Text : string read GetAsString write SetText; - Property Value : Variant read GetAsVariant write SetAsVariant stored IsParamStored; - property AsWideString: WideString read GetAsWideString write SetAsWideString; - published - Property DataType : TFieldType read FDataType write SetDataType; - Property Name : string read FName write FName; - Property NumericScale : Integer read FNumericScale write FNumericScale default 0; - Property ParamType : TParamType read FParamType write FParamType; - Property Precision : Integer read FPrecision write FPrecision default 0; - Property Size : Integer read FSize write FSize default 0; - end; - - - { TParams } - - TParams = class(TCollection) - private - FOwner: TPersistent; - Function GetItem(Index: Integer): TParam; - Function GetParamValue(const ParamName: string): Variant; - Procedure SetItem(Index: Integer; Value: TParam); - Procedure SetParamValue(const ParamName: string; const Value: Variant); - protected - Procedure AssignTo(Dest: TPersistent); override; - Function GetDataSet: TDataSet; - Function GetOwner: TPersistent; override; - public - Constructor Create(AOwner: TPersistent); overload; - Constructor Create; overload; - Procedure AddParam(Value: TParam); - Procedure AssignValues(Value: TParams); - Function CreateParam(FldType: TFieldType; const ParamName: string; ParamType: TParamType): TParam; - Function FindParam(const Value: string): TParam; - Procedure GetParamList(List: TList; const ParamNames: string); - Function IsEqual(Value: TParams): Boolean; - Function ParamByName(const Value: string): TParam; - Function ParseSQL(SQL: String; DoCreate: Boolean): String; overload; - Function ParseSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle): String; overload; - Function ParseSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle; var ParamBinding: TParambinding): String; overload; - Function ParseSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle; var ParamBinding: TParambinding; var ReplaceString : string): String; overload; - Procedure RemoveParam(Value: TParam); - Procedure CopyParamValuesFromDataset(ADataset : TDataset; CopyBound : Boolean); - Property Dataset : TDataset Read GetDataset; - Property Items[Index: Integer] : TParam read GetItem write SetItem; default; - Property ParamValues[const ParamName: string] : Variant read GetParamValue write SetParamValue; - end; - TMasterParamsDataLink = Class(TMasterDataLink) Private FParams : TParams;