Procházet zdrojové kódy

--- Merging r17247 into '.':
U packages/fcl-db/src/memds/memds.pp
--- Merging r17321 into '.':
U packages/fcl-db/src/base/dsparams.inc
--- Merging r17354 into '.':
U packages/fcl-db/src/base/dataset.inc
U packages/fcl-db/src/base/db.pas
--- Merging r17377 into '.':
U packages/fcl-db/src/base/bufdataset.pas
--- Merging r17378 into '.':
U packages/fcl-db/src/sqldb/sqldb.pp
G packages/fcl-db/src/base/bufdataset.pas
--- Merging r17381 into '.':
G packages/fcl-db/src/base/db.pas

# revisions: 17247,17321,17354,17377,17378,17381
------------------------------------------------------------------------
r17247 | michael | 2011-04-04 22:57:11 +0200 (Mon, 04 Apr 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/memds/memds.pp

* Applied patch from 19097, compilable with Delphi
------------------------------------------------------------------------
------------------------------------------------------------------------
r17321 | michael | 2011-04-14 23:40:23 +0200 (Thu, 14 Apr 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/base/dsparams.inc

* TParam.AsXXX now also sets Bound
------------------------------------------------------------------------
------------------------------------------------------------------------
r17354 | michael | 2011-04-20 18:05:41 +0200 (Wed, 20 Apr 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/base/dataset.inc
M /trunk/packages/fcl-db/src/base/db.pas

* Patch from Stephano to implement IProviderSupport
------------------------------------------------------------------------
------------------------------------------------------------------------
r17377 | joost | 2011-04-27 22:14:32 +0200 (Wed, 27 Apr 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/base/bufdataset.pas

* Publish TBufDataset properties, part of bug #17813
------------------------------------------------------------------------
------------------------------------------------------------------------
r17378 | joost | 2011-04-27 22:18:15 +0200 (Wed, 27 Apr 2011) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/base/bufdataset.pas
M /trunk/packages/fcl-db/src/sqldb/sqldb.pp

* Published TSQLQuery.MaxIndexesCount and FieldDefs
* Set default values for MaxIndexesCount and Readonly
------------------------------------------------------------------------
------------------------------------------------------------------------
r17381 | michael | 2011-04-28 20:12:07 +0200 (Thu, 28 Apr 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/base/db.pas

* Made TIntegerField a descendant of TLongintField
------------------------------------------------------------------------

git-svn-id: branches/fixes_2_4@17593 -

marco před 14 roky
rodič
revize
1b499b4ba5

+ 29 - 1
packages/fcl-db/src/base/bufdataset.pas

@@ -528,7 +528,7 @@ type
     function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; override;
 
     property ChangeCount : Integer read GetChangeCount;
-    property MaxIndexesCount : Integer read FMaxIndexesCount write SetMaxIndexesCount;
+    property MaxIndexesCount : Integer read FMaxIndexesCount write SetMaxIndexesCount default 2;
   published
     property FileName : string read FFileName write FFileName;
     property PacketRecords : Integer read FPacketRecords write SetPacketRecords default 10;
@@ -541,7 +541,35 @@ type
 
   TBufDataset = class(TCustomBufDataset)
   published
+    property MaxIndexesCount;
+    // TDataset stuff
     property FieldDefs;
+    Property Active;
+    Property AutoCalcFields;
+    Property Filter;
+    Property Filtered;
+    Property AfterCancel;
+    Property AfterClose;
+    Property AfterDelete;
+    Property AfterEdit;
+    Property AfterInsert;
+    Property AfterOpen;
+    Property AfterPost;
+    Property AfterScroll;
+    Property BeforeCancel;
+    Property BeforeClose;
+    Property BeforeDelete;
+    Property BeforeEdit;
+    Property BeforeInsert;
+    Property BeforeOpen;
+    Property BeforePost;
+    Property BeforeScroll;
+    Property OnCalcFields;
+    Property OnDeleteError;
+    Property OnEditError;
+    Property OnFilterRecord;
+    Property OnNewRecord;
+    Property OnPostError;
   end;
 
 

+ 129 - 0
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;
+
+{------------------------------------------------------------------------------}
+

+ 207 - 139
packages/fcl-db/src/base/db.pas

@@ -553,7 +553,7 @@ type
     property MaxValue: Longint read FMaxValue write SetMaxValue default 0;
     property MinValue: Longint read FMinValue write SetMinValue default 0;
   end;
-  TIntegerField = TLongintField;
+  TIntegerField = Class(TLongintField);
 
 { TLargeintField }
 
@@ -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;

+ 14 - 14
packages/fcl-db/src/base/dsparams.inc

@@ -595,75 +595,75 @@ end;
 
 Procedure TParam.SetAsBlob(const AValue: TBlobData);
 begin
-  FValue:=AValue;
+  Value:=AValue;
   FDataType:=ftBlob;
 end;
 
 Procedure TParam.SetAsBoolean(AValue: Boolean);
 begin
-  FValue:=AValue;
+  Value:=AValue;
   FDataType:=ftBoolean;
 end;
 
 Procedure TParam.SetAsCurrency(const AValue: Currency);
 begin
-  FValue:=Avalue;
+  Value:=Avalue;
   FDataType:=ftCurrency;
 end;
 
 Procedure TParam.SetAsDate(const AValue: TDateTime);
 begin
-  FValue:=Avalue;
+  Value:=Avalue;
   FDataType:=ftDate;
 end;
 
 Procedure TParam.SetAsDateTime(const AValue: TDateTime);
 begin
-  FValue:=AValue;
+  Value:=AValue;
   FDataType:=ftDateTime;
 end;
 
 Procedure TParam.SetAsFloat(const AValue: Double);
 begin
-  FValue:=AValue;
+  Value:=AValue;
   FDataType:=ftFloat;
 end;
 
 Procedure TParam.SetAsInteger(AValue: Longint);
 begin
-  FValue:=AValue;
+  Value:=AValue;
   FDataType:=ftInteger;
 end;
 
 Procedure TParam.SetAsLargeInt(AValue: LargeInt);
 begin
-  FValue:=AValue;
+  Value:=AValue;
   FDataType:=ftLargeint;
 end;
 
 Procedure TParam.SetAsMemo(const AValue: string);
 begin
-  FValue:=AValue;
+  Value:=AValue;
   FDataType:=ftMemo;
 end;
 
 
 Procedure TParam.SetAsSmallInt(AValue: LongInt);
 begin
-  FValue:=AValue;
+  Value:=AValue;
   FDataType:=ftSmallInt;
 end;
 
 Procedure TParam.SetAsString(const AValue: string);
 begin
-  FValue:=AValue;
+  Value:=AValue;
   if FDataType <> ftFixedChar then
     FDataType := ftString;
 end;
 
 procedure TParam.SetAsWideString(const aValue: WideString);
 begin
-  FValue := aValue;
+  Value := aValue;
   if FDataType <> ftFixedWideChar then
     FDataType := ftWideString;
 end;
@@ -671,7 +671,7 @@ end;
 
 Procedure TParam.SetAsTime(const AValue: TDateTime);
 begin
-  FValue:=AValue;
+  Value:=AValue;
   FDataType:=ftTime;
 end;
 
@@ -703,7 +703,7 @@ end;
 
 Procedure TParam.SetAsWord(AValue: LongInt);
 begin
-  FValue:=AValue;
+  Value:=AValue;
   FDataType:=ftWord;
 end;
 

+ 41 - 16
packages/fcl-db/src/memds/memds.pp

@@ -11,8 +11,10 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+{$IFDEF FPC}
 {$mode objfpc}
 {$H+}
+{$ENDIF}
 {
   TMemDataset : In-memory dataset.
   - Has possibility to copy Structure/Data from other dataset.
@@ -37,6 +39,10 @@ const
   smData      = 2;
 
 type
+  {$IFNDEF FPC}
+  ptrint = Integer;
+  {$ENDIF}
+
   MDSError=class(Exception);
 
   PRecInfo=^TMTRecInfo;
@@ -63,6 +69,9 @@ type
     FFilterBuffer: PChar;
     ffieldoffsets: PInteger;
     ffieldsizes: PInteger;
+    function GetCharPointer(p:PChar; Pos:Integer):PChar;
+    function GetIntegerPointer(p:PInteger; Pos:Integer):PInteger;
+
     procedure calcrecordlayout;
     function  MDSGetRecordOffset(ARecNo: integer): longint;
     function  MDSGetFieldOffset(FieldNo: integer): integer;
@@ -123,16 +132,16 @@ type
 
     Function  DataSize : Integer;
 
-    procedure Clear(ClearDefs : Boolean);
-    procedure Clear;
-    Procedure SaveToFile(AFileName : String);
-    Procedure SaveToFile(AFileName : String; SaveData : Boolean);
-    Procedure SaveToStream(F : TStream);
-    Procedure SaveToStream(F : TStream; SaveData : Boolean);
+    procedure Clear(ClearDefs : Boolean);{$IFNDEF FPC} overload; {$ENDIF}
+    procedure Clear;{$IFNDEF FPC} overload; {$ENDIF}
+    Procedure SaveToFile(AFileName : String);{$IFNDEF FPC} overload; {$ENDIF}
+    Procedure SaveToFile(AFileName : String; SaveData : Boolean);{$IFNDEF FPC} overload; {$ENDIF}
+    Procedure SaveToStream(F : TStream); {$IFNDEF FPC} overload; {$ENDIF}
+    Procedure SaveToStream(F : TStream; SaveData : Boolean);{$IFNDEF FPC} overload; {$ENDIF}
     Procedure LoadFromStream(F : TStream);
     Procedure LoadFromFile(AFileName : String);
-    Procedure CopyFromDataset(DataSet : TDataSet);
-    Procedure CopyFromDataset(DataSet : TDataSet; CopyData : Boolean);
+    Procedure CopyFromDataset(DataSet : TDataSet); {$IFNDEF FPC} overload; {$ENDIF}
+    Procedure CopyFromDataset(DataSet : TDataSet; CopyData : Boolean); {$IFNDEF FPC} overload; {$ENDIF}
 
     Property FileModified : Boolean Read FFileModified;
 
@@ -284,7 +293,7 @@ end;
 
 function TMemDataset.MDSGetFieldOffset(FieldNo: integer): integer;
 begin
- result:= ffieldoffsets[fieldno-1];
+ result:= getIntegerpointer(ffieldoffsets, fieldno-1)^;
 end;
 
 Procedure TMemDataset.RaiseError(Fmt : String; Args : Array of const);
@@ -706,7 +715,7 @@ begin
           not getfieldisnull(pointer(srcbuffer),I);
  if result and (buffer <> nil) then 
    begin
-   Move((SrcBuffer+ffieldoffsets[I])^, Buffer^,FFieldSizes[I]);
+   Move(getcharpointer(SrcBuffer,getintegerpointer(ffieldoffsets,I)^)^, Buffer^,GetIntegerPointer(FFieldSizes, I)^);
    end;
 end;
 
@@ -724,10 +733,10 @@ begin
    else 
      begin 
      unsetfieldisnull(pointer(destbuffer),I);
-     J:=FFieldSizes[I];
+     J:=GetIntegerPointer(FFieldSizes, I)^;
      if Field.DataType=ftString then
        Dec(J); // Do not move terminating 0, which is in the size.
-     Move(Buffer^,(DestBuffer+FFieldOffsets[I])^,J);
+     Move(Buffer^,GetCharPointer(DestBuffer, getIntegerPointer(FFieldOffsets, I)^)^,J);
      dataevent(defieldchange,ptrint(field));
      end;
    end;
@@ -843,18 +852,22 @@ begin
  // Avoid mem-leak if CreateTable is called twice
  FreeMem(ffieldoffsets);
  Freemem(ffieldsizes);
-
+ {$IFDEF FPC}
  FFieldOffsets:=getmem(Count*sizeof(integer));
  FFieldSizes:=getmem(Count*sizeof(integer));
+ {$ELSE}
+ getmem(FFieldOffsets, Count*sizeof(integer));
+ getmem(FFieldSizes, Count*sizeof(integer));
+ {$ENDIF}
  FRecSize:= (Count+7) div 8; //null mask
 {$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT}
  FRecSize:=Align(FRecSize,4);
 {$ENDIF}
  for i:= 0 to Count-1 do
    begin
-   ffieldoffsets[i] := frecsize;
-   ffieldsizes[i] := MDSGetbufferSize(i+1);
-   FRecSize:= FRecSize+FFieldSizes[i];
+   GetIntegerPointer(ffieldoffsets, i)^ := frecsize;
+   GetIntegerPointer(ffieldsizes,   i)^ := MDSGetbufferSize(i+1);
+   FRecSize:= FRecSize+GetIntegerPointeR(FFieldSizes, i)^;
    end;
 end;
 
@@ -988,4 +1001,16 @@ begin
     end;
 end;
 
+function TMemDataset.GetCharPointer(p:PChar; Pos:Integer):PChar;
+begin
+  Result:=p;
+  inc(Result, Pos);
+end;
+
+function TMemDataset.GetIntegerPointer(p:PInteger; Pos:Integer):PInteger;
+begin
+  Result:=p;
+  inc(Result, Pos);
+end;
+
 end.

+ 3 - 1
packages/fcl-db/src/sqldb/sqldb.pp

@@ -321,7 +321,7 @@ type
   // protected
     property SchemaType : TSchemaType read FSchemaType default stNoSchema;
     property Transaction;
-    property ReadOnly : Boolean read FReadOnly write SetReadOnly;
+    property ReadOnly : Boolean read FReadOnly write SetReadOnly default false;
     property SQL : TStringlist read FSQL write SetSQL;
     property UpdateSQL : TStringlist read FUpdateSQL write SetUpdateSQL;
     property InsertSQL : TStringlist read FInsertSQL write SetInsertSQL;
@@ -342,7 +342,9 @@ type
   public
     property SchemaType;
   Published
+    property MaxIndexesCount;
    // TDataset stuff
+    property FieldDefs;
     Property Active;
     Property AutoCalcFields;
     Property Filter;