* Patch from Alexandrov Alexandru:

  - TFieldDefs rewrited as TOwnedCollection and TFieldDef as
    TCollectionItem, so it can be edited now with Collection editor;
  - TFieldDef.Assign implemented;
  - corrections to Index property of TField;
  - made writeable Fields property of TFields;
  - DefaultFieldClasses uncommented and moved to implementation part;
    and some more.

git-svn-id: trunk@175 -

fcl/db/dataset.inc

@@ -445,71 +445,90 @@ begin
   Result:=nil;
 end;
 
-Function TDataset.GetField (Index : Longint) : TField;
+function TDataSet.GetFieldData(Field: TField; Buffer: Pointer;
+  NativeFormat: Boolean): Boolean;
+  
+  function ConvertData(Field: TField; Source: TDateTimeRec): TDateTime;
+  var
+    TimeStamp: TTimeStamp;
+  begin
+    case Field.DataType of
+      ftDate:
+        begin
+          TimeStamp.Time := 0;
+          TimeStamp.Date := Source.Date;
+        end;
+      ftTime:
+        begin
+          TimeStamp.Time := Source.Time;
+          TimeStamp.Date := DateDelta;
+        end;
+    else
+      try
+        TimeStamp := MSecsToTimeStamp(Source.DateTime);
+      except
+        TimeStamp.Time := 0;
+        TimeStamp.Date := 0;
+      end;
+    end;
+//    Result := TimeStampToDateTime(TimeStamp);
+    Result := (TimeStamp.Date - DateDelta) + (TimeStamp.Time / MSecsPerDay);
+  end;
 
+var
+  d: TDateTimeRec;
 begin
-  Result:=FFIeldList[index];
+  if NativeFormat then
+    Result := GetFieldData(Field, Buffer) else
+  if Field.DataType in  [ ftDate, ftDateTime, ftTime ] then begin
+    Result := GetFieldData(Field, @d);
+    if Result then
+      TDateTime(Buffer^) := ConvertData(Field, d);
+  end else
+    Result := GetFieldData(Field, Buffer);
 end;
 
-{
-  This is not yet allowed, FPC doesn't allow typed consts of Classes...
+procedure TDataSet.SetFieldData(Field: TField; Buffer: Pointer;
+  NativeFormat: Boolean);
 
-Const
-  DefFieldClasses : Array [TFieldType] of TFieldClass =
-    ( { ftUnknown} Tfield,
-      { ftString} TStringField,
-      { ftSmallint} TLongIntField,
-      { ftInteger} TLongintField,
-      { ftWord} TLongintField,
-      { ftBoolean} TBooleanField,
-      { ftFloat} TFloatField,
-      { ftDate} TDateField,
-      { ftTime} TTimeField,
-      { ftDateTime} TDateTimeField,
-      { ftBytes} TBytesField,
-      { ftVarBytes} TVarBytesField,
-      { ftAutoInc} TAutoIncField,
-      { ftBlob} TBlobField,
-      { ftMemo} TMemoField,
-      { ftGraphic} TGraphicField,
-      { ftFmtMemo} TMemoField,
-      { ftParadoxOle} Nil,
-      { ftDBaseOle} Nil,
-      { ftTypedBinary} Nil,
-      { ftCursor} Nil
-    );
-}
+  function ConvertData(Field: TField; Data: TDateTime): TDateTimeRec;
+  var
+    TimeStamp: TTimeStamp;
+  begin
+    TimeStamp.Time := Trunc(Frac(Data) * MSecsPerDay);
+    TimeStamp.Date := DateDelta + Trunc(System.Int(Data));
+//    TimeStamp := DateTimeToTimeStamp(Data);
+    case Field.DataType of
+      ftDate: Result.Date := TimeStamp.Date;
+      ftTime: Result.Time := TimeStamp.Time;
+    else
+      Result.DateTime := TimeStampToMSecs(TimeStamp);
+    end;
+  end;
+
+var
+  d: TDateTimeRec;
+begin
+  if NativeFormat then
+    SetFieldData(Field, Buffer)
+  else
+  if Field.DataType in  [ ftDate, ftDateTime, ftTime ] then begin
+    d := ConvertData(Field, TDateTime(Buffer^));
+    SetFieldData(Field, @d);
+  end else
+    SetFieldData(Field, Buffer);
+end;
+
+Function TDataset.GetField (Index : Longint) : TField;
+
+begin
+  Result:=FFIeldList[index];
+end;
 
 Function TDataset.GetFieldClass(FieldType: TFieldType): TFieldClass;
 
 begin
-  Case FieldType of
-     ftUnknown : Result:=Tfield;
-     ftString: Result := TStringField;
-     ftLargeint: Result := TLargeintField;
-     ftSmallint: Result := TSmallIntField;
-     ftInteger: Result := TLongintField;
-     ftWord: Result := TWordField;
-     ftBoolean: Result := TBooleanField;
-     ftFloat: Result := TFloatField;
-     ftBCD: Result := TBCDField;
-     ftDate: Result := TDateField;
-     ftTime: Result := TTimeField;
-     ftDateTime: Result := TDateTimeField;
-     ftBytes: Result := TBytesField;
-     ftVarBytes: Result := TVarBytesField;
-     ftAutoInc: Result := TAutoIncField;
-     ftBlob: Result := TBlobField;
-     ftMemo: Result := TMemoField;
-     ftGraphic: Result := TGraphicField;
-     ftFmtMemo: Result := TMemoField;
-     ftParadoxOle: Result := Nil;
-     ftDBaseOle: Result := Nil;
-     ftTypedBinary: Result := Nil;
-     ftCursor: Result := Nil
-  else
-     Result := nil;
-  end;
+  Result := DefaultFieldClasses[FieldType];
 end;
 
 Function TDataset.GetIsIndexField(Field: TField): Boolean;
@@ -620,7 +639,13 @@ end;
 Procedure TDataset.InitFieldDefs;
 
 begin
-  //!! To be implemented
+  if IsCursorOpen then InternalInitFieldDefs
+  else
+  try
+    OpenCursor(True);
+  finally
+    CloseCursor;
+  end;
 end;
 
 Procedure TDataset.InitRecord(Buffer: PChar);

fcl/db/db.pp

@@ -111,7 +111,9 @@ type
   TFieldAttribute = (faHiddenCol, faReadonly, faRequired, faLink, faUnNamed, faFixed);
   TFieldAttributes = set of TFieldAttribute;
 
-  TFieldDef = class(TComponent)
+  { TFieldDef }
+
+  TFieldDef = class(TCollectionItem)
   Private
     FDataType : TFieldType;
     FFieldNo : Longint;
@@ -123,50 +125,59 @@ type
     FDisplayName : String;
     FAttributes : TFieldAttributes;
     Function GetFieldClass : TFieldClass;
+    procedure SetAttributes(AValue: TFieldAttributes);
+    procedure SetDataType(AValue: TFieldType);
+    procedure SetPrecision(const AValue: Longint);
+    procedure SetSize(const AValue: Word);
+  protected
+    function GetDisplayName: string;
+    procedure SetDisplayName(const AValue: string);
   public
     constructor Create(AOwner: TFieldDefs; const AName: string;
       ADataType: TFieldType; ASize: Word; ARequired: Boolean; AFieldNo: Longint);
     destructor Destroy; override;
+    procedure Assign(APersistent: TPersistent); override;
     function CreateField(AOwner: TComponent): TField;
     property FieldClass: TFieldClass read GetFieldClass;
     property FieldNo: Longint read FFieldNo;
     property InternalCalcField: Boolean read FInternalCalcField write FInternalCalcField;
     property Required: Boolean read FRequired;
   Published
-    property Attributes: TFieldAttributes read FAttributes write FAttributes default [];
+    property Attributes: TFieldAttributes read FAttributes write SetAttributes default [];
     property Name: string read FName write FName; // Must move to TNamedItem
     property DisplayName : string read FDisplayName write FDisplayName; // Must move to TNamedItem
-    property DataType: TFieldType read FDataType write FDataType;
-    property Precision: Longint read FPrecision write FPrecision;
-    property Size: Word read FSize write FSize;
+    property DataType: TFieldType read FDataType write SetDataType;
+    property Precision: Longint read FPrecision write SetPrecision;
+    property Size: Word read FSize write SetSize;
   end;
 
 { TFieldDefs }
 
-  TFieldDefs = class(TComponent)
+  TFieldDefs = class(TOwnedCollection)
   private
-    FDataSet: TDataSet;
-    FItems: TList;
     FUpdated: Boolean;
     FHiddenFields : Boolean;
-    function GetCount: Longint;
     function GetItem(Index: Longint): TFieldDef;
+    function GetDataset: TDataset;
+    procedure SetItem(Index: Longint; const AValue: TFieldDef);
+  protected
+    procedure SetItemName(AItem: TCollectionItem); override;
   public
     constructor Create(ADataSet: TDataSet);
-    destructor Destroy; override;
+//    destructor Destroy; override;
     procedure Add(const AName: string; ADataType: TFieldType; ASize: Word; ARequired: Boolean);
     procedure Add(const AName: string; ADataType: TFieldType; ASize: Word);
     procedure Add(const AName: string; ADataType: TFieldType);
     Function AddFieldDef : TFieldDef;
     procedure Assign(FieldDefs: TFieldDefs);
-    procedure Clear;
-    procedure Delete(Index: Longint);
+//    procedure Clear;
+//    procedure Delete(Index: Longint);
     function Find(const AName: string): TFieldDef;
     function IndexOf(const AName: string): Longint;
     procedure Update;
-    property Count: Longint read GetCount;
     Property HiddenFields : Boolean Read FHiddenFields Write FHiddenFields;
-    property Items[Index: Longint]: TFieldDef read GetItem; default;
+    property Items[Index: Longint]: TFieldDef read GetItem write SetItem; default;
+    property Dataset: TDataset read GetDataset;
     property Updated: Boolean read FUpdated write FUpdated;
   end;
 
@@ -227,6 +238,7 @@ type
     FProviderFlags : TProviderFlags;
     Function GetIndex : longint;
     procedure SetAlignment(const AValue: TAlignMent);
+    procedure SetIndex(AValue: Integer);
     Procedure SetDataset(Value : TDataset);
     function GetDisplayText: String;
     procedure SetDisplayLabel(const AValue: string);
@@ -329,7 +341,7 @@ type
     property FieldKind: TFieldKind read FFieldKind write FFieldKind;
     property FieldName: string read FFieldName write FFieldName;
     property HasConstraints: Boolean read FHasConstraints;
-    property Index: Longint read GetIndex;
+    property Index: Longint read GetIndex write SetIndex;
     property ImportedConstraint: string read FImportedConstraint write FImportedConstraint;
     property LookupDataSet: TDataSet read FLookupDataSet write FLookupDataSet;
     property LookupKeyFields: string read FLookupKeyFields write FLookupKeyFields;
@@ -806,6 +818,7 @@ type
       Procedure CheckfieldKind(Fieldkind : TFieldKind; Field : TField);
       Function GetCount : Longint;
       Function GetField (Index : longint) : TField;
+      Procedure SetField(Index: Integer; Value: TField);
       Procedure SetFieldIndex (Field : TField;Value : Integer);
       Property OnChange : TNotifyEvent Read FOnChange Write FOnChange;
       Property ValidFieldKinds : TFieldKinds Read FValidFieldKinds;
@@ -824,7 +837,7 @@ type
       procedure Remove(Value : TField);
       Property Count : Integer Read GetCount;
       Property Dataset : TDataset Read FDataset;
-      Property Fields [Index : Integer] : TField Read GetField; default;
+      Property Fields [Index : Integer] : TField Read GetField Write SetField; default;
     end;
 
 
@@ -1029,7 +1042,8 @@ type
     procedure GetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
     function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; virtual; abstract;
     function GetDataSource: TDataSource; virtual;
-    function GetFieldData(Field: TField; Buffer: Pointer): Boolean; virtual; abstract;
+    function GetFieldData(Field: TField; Buffer: Pointer): Boolean; overload; virtual; abstract;
+    function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; overload; virtual;
     function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; virtual; abstract;
     function GetRecordSize: Word; virtual; abstract;
     procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); virtual; abstract;
@@ -1047,7 +1061,8 @@ type
     function IsCursorOpen: Boolean; virtual; abstract;
     procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); virtual; abstract;
     procedure SetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
-    procedure SetFieldData(Field: TField; Buffer: Pointer); virtual; abstract;
+    procedure SetFieldData(Field: TField; Buffer: Pointer); overload; virtual; abstract;
+    procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); overload; virtual;
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -1703,6 +1718,48 @@ Const
       'Cursor'
     );}
 
+const
+  DefaultFieldClasses : Array [TFieldType] of TFieldClass =
+    ( { ftUnknown} Tfield,
+      { ftString} TStringField,
+      { ftSmallint} TLongIntField,
+      { ftInteger} TLongintField,
+      { ftWord} TLongintField,
+      { ftBoolean} TBooleanField,
+      { ftFloat} TFloatField,
+      { ftCurrency} Nil,
+      { ftBCD} TBCDField,
+      { ftDate} TDateField,
+      { ftTime} TTimeField,
+      { ftDateTime} TDateTimeField,
+      { ftBytes} TBytesField,
+      { ftVarBytes} TVarBytesField,
+      { ftAutoInc} TAutoIncField,
+      { ftBlob} TBlobField,
+      { ftMemo} TMemoField,
+      { ftGraphic} TGraphicField,
+      { ftFmtMemo} TMemoField,
+      { ftParadoxOle} Nil,
+      { ftDBaseOle} Nil,
+      { ftTypedBinary} Nil,
+      { ftCursor} Nil,
+      { ftFixedChar} TStringField,
+      { ftWideString} Nil,
+      { ftLargeint} TLargeIntField,
+      { ftADT} Nil,
+      { ftArray} Nil,
+      { ftReference} Nil,
+      { ftDataSet} Nil,
+      { ftOraBlob} TBlobField,
+      { ftOraClob} TMemoField,
+      { ftVariant} Nil,
+      { ftInterface} Nil,
+      { ftIDispatch} Nil,
+      { ftGuid} Nil,
+      { ftTimeStamp} Nil,
+      { ftFMTBcd} Nil
+    );
+
   dsEditModes = [dsEdit, dsInsert, dsSetKey];
   dsWriteModes = [dsEdit, dsInsert, dsSetKey, dsCalcFields, dsFilter,
     dsNewValue, dsInternalCalc];

fcl/db/dbase/dbf_common.inc

@@ -170,6 +170,7 @@
   {$define SUPPORT_INT64}
   {$define SUPPORT_DEFAULT_PARAMS}
   {$define SUPPORT_NEW_TRANSLATE}
+  {$define SUPPORT_BACKWARD_FIELDDATA}
   {$define SUPPORT_NEW_FIELDDATA}
   {$define SUPPORT_FIELDDEF_TPERSISTENT}
   {$define SUPPORT_FIELDTYPES_V4}

fcl/db/dbconst.pp

@@ -70,7 +70,7 @@ Const
   SParameterCountIncorrect = 'The number of parameters is incorrect.';
   SFieldValueError         = 'Invalid value for field ''%s''';
   SInvalidCalcType         = 'Field ''%s'' cannot be a calculated or lookup field';
-
+  SDuplicateName           = 'Duplicate name ''%s'' in %s';
 
 Implementation
 

fcl/db/fields.inc

@@ -51,7 +51,6 @@ begin
     If Not (FSize in [1,2,4]) then FSize:=4;
 
   FFieldNo:=AFieldNo;
-  AOwner.FItems.Add(Self);
 end;
 
 Destructor TFieldDef.Destroy;
@@ -60,6 +59,27 @@ begin
   Inherited destroy;
 end;
 
+procedure TFieldDef.Assign(APersistent: TPersistent);
+var fd: TFieldDef;
+begin
+  fd := nil;
+  if APersistent is TFieldDef then
+    fd := APersistent as TFieldDef;
+  if Assigned(fd) then begin
+    Collection.BeginUpdate;
+    try
+      Name := fd.Name;
+      DataType := fd.DataType;
+      Size := fd.Size;
+      Precision := fd.Precision;
+      FRequired := fd.Required;
+    finally
+      Collection.EndUpdate;
+    end;
+  end else
+  inherited Assign(APersistent);
+end;
+
 Function TFieldDef.CreateField(AOwner: TComponent): TField;
 
 Var TheField : TFieldClass;
@@ -86,7 +106,7 @@ begin
 {$ifdef dsdebug}
     Writeln ('TFieldDef.CReateField : Result Fieldno : ',Result.FieldNo,' Self : ',FieldNo);
 {$endif dsdebug}
-    Result.Dataset:=TFieldDefs(Owner).FDataset;
+    Result.Dataset:=TFieldDefs(Collection).Dataset;
     If Result is TFloatField then
       TFloatField(Result).Precision:=FPrecision;
   except
@@ -96,13 +116,55 @@ begin
 
 end;
 
+procedure TFieldDef.SetAttributes(AValue: TFieldAttributes);
+begin
+  FAttributes := AValue;
+  Changed(False);
+end;
+
+procedure TFieldDef.SetDataType(AValue: TFieldType);
+begin
+  FDataType := AValue;
+  Changed(False);
+end;
+
+procedure TFieldDef.SetPrecision(const AValue: Longint);
+begin
+  FPrecision := AValue;
+  Changed(False);
+end;
+
+procedure TFieldDef.SetSize(const AValue: Word);
+begin
+  FSize := AValue;
+  Changed(False);
+end;
+
+function TFieldDef.GetDisplayName: string;
+begin
+  Result := FDisplayName;
+  if Result = '' then
+    Result := Fname;
+end;
+
+procedure TFieldDef.SetDisplayName(const AValue: string);
+begin
+  if (AValue <> '') and (AnsiCompareText(AValue, DisplayName) <> 0) and
+    (Collection is TOwnedCollection) and
+    (TFieldDefs(Collection).IndexOf(AValue) >= 0) then
+    DatabaseErrorFmt(SDuplicateName, [AValue, Collection.ClassName]);
+  FName := AValue;
+end;
+
 Function TFieldDef.GetFieldClass : TFieldClass;
 
 begin
   //!! Should be owner as tdataset but that doesn't work ??
 
-  If Assigned(Owner) then
-    Result:=TFieldDefs(Owner).FDataSet.GetFieldClass(FDataType)
+  If Assigned(Collection) And
+     (Collection is TFieldDefs) And
+     Assigned(TFieldDefs(Collection).Dataset) then
+    Result:=TFieldDefs(Collection).Dataset.GetFieldClass(FDataType)
   else
     Result:=Nil;
 end;
@@ -111,6 +173,7 @@ end;
     TFieldDefs
   ---------------------------------------------------------------------}
 
+{
 destructor TFieldDefs.Destroy;
 
 begin
@@ -118,6 +181,7 @@ begin
   // This will destroy all fielddefs since we own them...
   Inherited Destroy;
 end;
+}
 
 procedure TFieldDefs.Add(const AName: string; ADataType: TFieldType);
 
@@ -139,37 +203,42 @@ begin
     DatabaseError(SNeedFieldName);
   // the fielddef will register itself here as a owned component.
   // fieldno is 1 based !
-  TFieldDef.Create(Self,AName,ADataType,ASize,Arequired,FItems.Count+1);
+  BeginUpdate;
+  try
+    TFieldDef.Create(Self,AName,ADataType,ASize,Arequired,Count+1);
+  finally
+    EndUpdate;
+  end;
 end;
 
-function TFieldDefs.GetCount: Longint;
+function TFieldDefs.GetItem(Index: Longint): TFieldDef;
 
 begin
-  Result:=FItems.Count;
+  Result := TFieldDef(inherited Items[Index]);;
 end;
 
-function TFieldDefs.GetItem(Index: Longint): TFieldDef;
-
+function TFieldDefs.GetDataset: TDataset;
 begin
-  Result:=TFieldDef(FItems[Index]);
+  Result := TDataset(GetOwner);
 end;
 
-procedure TFieldDefs.Delete(Index: Longint);
-
-var
-  c: TComponent;
+procedure TFieldDefs.SetItem(Index: Longint; const AValue: TFieldDef);
 begin
-  c := GetItem(Index);
-  RemoveComponent(c);
-  //c.Free; maybe not needed?
+  inherited Items[Index] := AValue;
 end;
 
-constructor TFieldDefs.Create(ADataSet: TDataSet);
+procedure TFieldDefs.SetItemName(AItem: TCollectionItem);
+begin
+  if AItem is TFieldDef then
+    with AItem as TFieldDef do
+      if Name = '' then
+        Name := Dataset.Name + Copy(ClassName, 2, 5) + IntToStr(ID+1)
+  else inherited SetItemName(AItem);
+end;
 
+constructor TFieldDefs.Create(ADataset: TDataset);
 begin
-  Inherited Create(ADataSet);
-  FItems:=TList.Create;
-  FDataset:=ADataset;
+  Inherited Create(TPersistent(ADataset), TFieldDef);
 end;
 
 procedure TFieldDefs.Assign(FieldDefs: TFieldDefs);
@@ -183,6 +252,7 @@ begin
       Add(Name,DataType,Size,Required);
 end;
 
+{
 procedure TFieldDefs.Clear;
 
 Var I : longint;
@@ -192,6 +262,7 @@ begin
     TFieldDef(Fitems[i]).Free;
   FItems.Clear;
 end;
+}
 
 function TFieldDefs.Find(const AName: string): TFieldDef;
 
@@ -200,8 +271,8 @@ Var I : longint;
 begin
   I:=IndexOf(AName);
   If I=-1 Then
-    DataBaseErrorFmt(SUnknownField,[AName,FDataSet.Name]);
-  Result:=TFieldDef(Fitems[i]);
+    DataBaseErrorFmt(SUnknownField,[AName,DataSet.Name]);
+  Result:=Items[i];
 end;
 
 function TFieldDefs.IndexOf(const AName: string): Longint;
@@ -209,8 +280,8 @@ function TFieldDefs.IndexOf(const AName: string): Longint;
 Var I : longint;
 
 begin
-  For I:=0 to Fitems.Count-1 do
-    If AnsiCompareText(TFieldDef(FItems[I]).Name,AName)=0 then
+  For I:=0 to Count-1 do
+    If AnsiCompareText(Items[I].Name,AName)=0 then
       begin
       Result:=I;
       Exit;
@@ -221,13 +292,13 @@ end;
 procedure TFieldDefs.Update;
 
 begin
-  FDataSet.UpdateFieldDefs;
+  DataSet.InitFieldDefs;
 end;
 
 Function TFieldDefs.AddFieldDef : TFieldDef;
 
 begin
-  Result:=TFieldDef.Create(Self,'',ftUnknown,0,False,FItems.Count+1);
+  Result:=TFieldDef.Create(Self,'',ftUnknown,0,False,Count+1);
 end;
 
 { ---------------------------------------------------------------------
@@ -258,7 +329,8 @@ begin
   IF Assigned(FDataSet) then
     begin
     FDataSet.Active:=False;
-    FDataSet.RemoveField(Self);
+    if Assigned(FFields) then
+      FFields.Remove(Self);
     end;
   Inherited Destroy;
 end;
@@ -485,7 +557,7 @@ begin
       Move (FValueBuffer^,Buffer^ ,DataSize);
     end
   else
-    Result:=FDataset.GetFieldData(Self,Buffer);
+    Result:=FDataset.GetFieldData(Self,Buffer,False);
 end;
 
 function TField.GetDataSize: Word;
@@ -538,6 +610,11 @@ begin
     end;
 end;
 
+procedure TField.SetIndex(AValue: Integer);
+begin
+  if FFields <> nil then FFields.SetFieldIndex(Self, AValue)
+end;
+
 procedure TField.SetAsCurrency(AValue: Currency);
 begin
   SetAsFloat(AValue);
@@ -651,7 +728,7 @@ procedure TField.SetData(Buffer: Pointer);
 begin
   If Not Assigned(FDataset) then
     EDatabaseError.CreateFmt(SNoDataset,[FieldName]);
-  FDataSet.SetFieldData(Self,Buffer);
+  FDataSet.SetFieldData(Self,Buffer, False);
 end;
 
 Procedure TField.SetDataset (Value : TDataset);
@@ -2236,12 +2313,16 @@ end;
 Destructor TFields.Destroy;
 
 begin
+  if FFieldList <> nil then Clear;
   FFieldList.Free;
+  inherited Destroy;
 end;
 
 Procedure Tfields.Changed;
 
 begin
+  if (FDataSet <> nil) and not (csDestroying in FDataSet.ComponentState) then
+    FDataSet.DataEvent(deFieldListChange, 0);
   If Assigned(FOnChange) then
     FOnChange(Self);
 end;
@@ -2266,6 +2347,11 @@ begin
   Result:=Tfield(FFieldList[Index]);
 end;
 
+procedure Tfields.SetField(Index: Integer; Value: TField);
+begin
+  Fields[Index].Assign(Value);
+end;
+
 Procedure TFields.SetFieldIndex (Field : TField;Value : Integer);
 
 Var Old : Longint;
@@ -2322,7 +2408,13 @@ end;
 Procedure TFields.Clear;
 
 begin
-  FFieldList.Clear;
+  with FFieldList do
+    while Count > 0 do begin
+      TField(Last).FDataSet := Nil;
+      TField(Last).Free;
+      FFieldList.Delete(Count - 1);
+    end;
+  Changed;
 end;
 
 Function TFields.FindField (Const Value : String) : TField;
@@ -2378,23 +2470,16 @@ end;
 
 Function TFields.IndexOf(Field : TField) : Longint;
 
-Var i : longint;
-
 begin
-  Result:=-1;
-  For I:=0 To FFieldList.Count-1 do
-    If Pointer(Field)=FFieldList[i] Then
-      Exit(I);
+  Result:=FFieldList.IndexOf(Field);
 end;
 
 procedure TFields.Remove(Value : TField);
 
-Var I : longint;
-
 begin
-  I:=IndexOf(Value);
-  If I<>0 then
-    FFieldList.Delete(I);
+  FFieldList.Remove(Value);
+  Value.FFields := nil;
+  Changed;
 end;
 
 {

fcl/db/interbase/interbase.pp

@@ -251,6 +251,7 @@ type
     procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
     function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
     function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
+    function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; overload; override;
     function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
     function GetRecordCount: integer; override;
     function GetRecordSize: Word; override;
@@ -270,6 +271,7 @@ type
     procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
     procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
     procedure SetFieldData(Field: TField; Buffer: Pointer); override;
+    procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); overload; override;
   public
     { This method is used for executing sql statements, which
       doesn't return any rows. (insert,delete,update, and DDL commands) }
@@ -1033,6 +1035,12 @@ begin
   end;
 end;
 
+function TIBQuery.GetFieldData(Field: TField; Buffer: Pointer;
+  NativeFormat: Boolean): Boolean;
+begin
+  Result := GetFieldData(Field, Buffer);
+end;
+
 function TIBQuery.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
 begin
   if FStatementType <> stSelect then
@@ -1221,6 +1229,12 @@ procedure TIBQuery.SetFieldData(Field: TField; Buffer: Pointer);
 begin
 end;
 
+procedure TIBQuery.SetFieldData(Field: TField; Buffer: Pointer;
+  NativeFormat: Boolean);
+begin
+  SetFieldData(Field, Buffer);
+end;
+
 // public part
 
 procedure TIBQuery.ExecSQL;

fcl/db/mysql/mysqldb3.pp

@@ -124,6 +124,8 @@ type
 
     // TDataset method
     function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
+    function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; overload; override;
+    procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); overload; override;
 
     property AffectedRows: QWord read FAffectedRows;
     property LastInsertID: Integer read FLastInsertID;
@@ -256,6 +258,18 @@ begin
     end;
 end;
 
+function TMySQLDataset.GetFieldData(Field: TField; Buffer: Pointer;
+  NativeFormat: Boolean): Boolean;
+begin
+  Result:=GetFieldData(Field, Buffer);
+end;
+
+procedure TMySQLDataset.SetFieldData(Field: TField; Buffer: Pointer;
+  NativeFormat: Boolean);
+begin
+  SetFieldData(Field, Buffer);
+end;
+
 function TMySQLDataset.GetRecNo: Integer;
 begin
   UpdateCursorPos;

fcl/db/mysql/mysqldb4.pp

@@ -124,6 +124,8 @@ type
 
     // TDataset method
     function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
+    function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; overload; override;
+    procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); overload; override;
 
     property AffectedRows: QWord read FAffectedRows;
     property LastInsertID: Integer read FLastInsertID;
@@ -256,6 +258,18 @@ begin
     end;
 end;
 
+function TMySQLDataset.GetFieldData(Field: TField; Buffer: Pointer;
+  NativeFormat: Boolean): Boolean;
+begin
+  Result:=GetFieldData(Field, Buffer);
+end;
+
+procedure TMySQLDataset.SetFieldData(Field: TField; Buffer: Pointer;
+  NativeFormat: Boolean);
+begin
+  SetFieldData(Field, Buffer);
+end;
+
 function TMySQLDataset.GetRecNo: Integer;
 begin
   UpdateCursorPos;
@@ -696,9 +710,9 @@ begin
   EY := StrToInt(Copy(S, 1, 4));
   EM := StrToInt(Copy(S, 6, 2));
   ED := StrToInt(Copy(S, 9, 2));
-  EH := StrToInt(Copy(S, 11, 2));
-  EN := StrToInt(Copy(S, 14, 2));
-  ES := StrToInt(Copy(S, 17, 2));
+  EH := StrToInt(Copy(S, 12, 2));
+  EN := StrToInt(Copy(S, 15, 2));
+  ES := StrToInt(Copy(S, 18, 2));
   if (EY = 0) or (EM = 0) or (ED = 0) then
     Result := 0
   else

fcl/db/sqldb/sqldb.pp

@@ -189,6 +189,8 @@ type
     function  GetCanModify: Boolean; override;
     function ApplyRecUpdate(UpdateKind : TUpdateKind) : boolean; override;
     Function IsPrepared : Boolean; virtual;
+    function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; overload; override;
+    procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); overload; override;
   public
     procedure Prepare; virtual;
     procedure UnPrepare; virtual;
@@ -517,6 +519,18 @@ begin
   Result := Assigned(FCursor) and FCursor.FPrepared;
 end;
 
+function TSQLQuery.GetFieldData(Field: TField; Buffer: Pointer;
+  NativeFormat: Boolean): Boolean;
+begin
+  Result:=GetFieldData(Field, Buffer);
+end;
+
+procedure TSQLQuery.SetFieldData(Field: TField; Buffer: Pointer;
+  NativeFormat: Boolean);
+begin
+  SetFieldData(Field, Buffer);
+end;
+
 procedure TSQLQuery.Prepare;
 var
   Buf   : string;