Browse Source

+ date/time fields handling compatibility fix
+ implemented BeforeRefresh and AfterRefresh
+ made TFieldDef.Required writeable (delphi compatible)
+ implemented TUpdateAction
+ Fixed web bug #4644

git-svn-id: trunk@2281 -

joost 19 years ago
parent
commit
1f754a3905
6 changed files with 71 additions and 58 deletions
  1. 12 0
      fcl/db/bufdataset.inc
  2. 36 44
      fcl/db/dataset.inc
  3. 15 3
      fcl/db/db.pp
  4. 1 0
      fcl/db/dbase/dbf_common.inc
  5. 6 0
      fcl/db/fields.inc
  6. 1 11
      fcl/db/sqldb/sqldb.pp

+ 12 - 0
fcl/db/bufdataset.inc

@@ -365,6 +365,12 @@ begin
   Result := grOK;
 end;
 
+function TBufDataset.GetFieldData(Field: TField; Buffer: Pointer;
+  NativeFormat: Boolean): Boolean;
+begin
+  Result := GetFieldData(Field, Buffer);
+end;
+
 function TBufDataset.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
 
 var
@@ -413,6 +419,12 @@ begin
     end;
 end;
 
+procedure TBufDataset.SetFieldData(Field: TField; Buffer: Pointer;
+  NativeFormat: Boolean);
+begin
+  SetFieldData(Field,Buffer);
+end;
+
 procedure TBufDataset.SetFieldData(Field: TField; Buffer: Pointer);
 var
   x        : longint;

+ 36 - 44
fcl/db/dataset.inc

@@ -298,6 +298,13 @@ begin
    FAfterScroll(Self);
 end;
 
+Procedure TDataset.DoAfterRefresh;
+
+begin
+ If assigned(FAfterRefresh) then
+   FAfterRefresh(Self);
+end;
+
 Procedure TDataset.DoBeforeCancel;
 
 begin
@@ -354,6 +361,13 @@ begin
    FBeforeScroll(Self);
 end;
 
+Procedure TDataset.DoBeforeRefresh;
+
+begin
+ If assigned(FBeforeRefresh) then
+   FBeforeRefresh(Self);
+end;
+
 Procedure TDataset.DoInternalOpen;
 
 begin
@@ -501,26 +515,23 @@ end;
 function TDataSet.GetFieldData(Field: TField; Buffer: Pointer;
   NativeFormat: Boolean): Boolean;
 
-Const
-  TempBufSize = 1024; { Let's not exaggerate.}
-
 Var
-  Buf : Array[1..TempBufSize] of Char;
-  P : PChar;
+  DT : TFieldType;
+  DTRBuffer : TDateTimeRec;
 begin
   If NativeFormat then
     Result:=GetFieldData(Field, Buffer)
   else
     begin
-    If (Field.DataSize<=TempBufSize) then
-      P:=@Buf
+    DT := Field.DataType;
+    case DT of
+      ftDate, ftTime, ftDateTime: begin
+                                  Result := GetfieldData(Field, @DTRBuffer);
+                                  TDateTime(buffer^) := DateTimeRecToDateTime(DT, DTRBuffer);
+                                  end
     else
-      P:=GetMem(Field.DataSize);
-    Result:=GetFieldData(Field,P);
-    If Result then
-      DataConvert(Field,P,Buffer,False);
-    If (P<>@Buf) then
-      FreeMem(P);
+      Result:=GetFieldData(Field, Buffer)
+    end;
     end;
 end;
 
@@ -566,26 +577,6 @@ begin
     end;
 end;
 
-procedure TDataSet.DataConvert(Field: TField; Source, Dest: Pointer; ToNative: Boolean);
-
-Type
-  PDateTime = ^TDateTime;
-  PDateTimeRec = ^TDateTimeRec;
-
-Var
-  DT : TFieldType;
-
-begin
-  DT:=Field.DataType;
-  case DT of
-    ftDate, ftTime, ftDateTime:
-      if ToNative then
-         PDateTimeRec(Dest)^:=DateTimeToDateTimeRec(DT,PDateTime(Source)^)
-       else
-         PDateTime(Dest)^:=DateTimeRecToDateTime(DT,PDateTimeRec(Source)^);
-  end;
-end;
-
 procedure TDataSet.SetFieldData(Field: TField; Buffer: Pointer);
 
 begin
@@ -595,26 +586,25 @@ end;
 procedure TDataSet.SetFieldData(Field: TField; Buffer: Pointer;
   NativeFormat: Boolean);
 
-Const
-  TempBufSize = 1024; { Let's not exaggerate.}
 
 Var
-  Buf : Array[1..TempBufSize] of Char;
-  P : PChar;
+  DT : TFieldType;
+  DTRBuffer : TDateTimeRec;
 
 begin
   if NativeFormat then
     SetFieldData(Field, Buffer)
   else
     begin
-    if Field.DataSize<=dsMaxStringSize then
-      P:=GetMem(Field.DataSize)
+    DT := Field.DataType;
+    case DT of
+      ftDate, ftTime, ftDateTime: begin
+                                  DTRBuffer := DateTimeToDateTimeRec(DT,TDateTime(buffer^));
+                                  SetFieldData(Field,@DTRBuffer);
+                                  end
     else
-      P:=@Buf;
-    DataConvert(Field,Buffer,P,True);
-    SetFieldData(Field,P);
-    If (P<>@Buf) then
-      FreeMem(P);
+      SetFieldData(Field, Buffer);
+    end; {case};
     end;
 end;
 
@@ -1771,12 +1761,14 @@ Procedure TDataset.Refresh;
 
 begin
   CheckbrowseMode;
+  DoBeforeRefresh;
   UpdateCursorPos;
   InternalRefresh;
 { SetCurrentRecord is called by UpdateCursorPos already, so as long as
   InternalRefresh doesn't do strange things this should be ok. }
 //  SetCurrentRecord(FActiverecord);
   Resync([]);
+  DoAfterRefresh;
 end;
 
 Procedure TDataset.RegisterDataSource(ADatasource : TDataSource);

+ 15 - 3
fcl/db/db.pp

@@ -127,6 +127,7 @@ type
     procedure SetDataType(AValue: TFieldType);
     procedure SetPrecision(const AValue: Longint);
     procedure SetSize(const AValue: Word);
+    procedure SetRequired(const AValue: Boolean);
   protected
     function GetDisplayName: string; override;
     procedure SetDisplayName(const AValue: string); override;
@@ -139,7 +140,7 @@ type
     property FieldClass: TFieldClass read GetFieldClass;
     property FieldNo: Longint read FFieldNo;
     property InternalCalcField: Boolean read FInternalCalcField write FInternalCalcField;
-    property Required: Boolean read FRequired;
+    property Required: Boolean read FRequired write SetRequired;
   Published
     property Attributes: TFieldAttributes read FAttributes write SetAttributes default [];
     property Name: string read FName write FName; // Must move to TNamedItem
@@ -884,6 +885,8 @@ type
 
   TDataAction = (daFail, daAbort, daRetry);
 
+  TUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApplied);
+
   TUpdateKind = (ukModify, ukInsert, ukDelete);
 
 
@@ -916,6 +919,7 @@ type
     FAfterInsert: TDataSetNotifyEvent;
     FAfterOpen: TDataSetNotifyEvent;
     FAfterPost: TDataSetNotifyEvent;
+    FAfterRefresh: TDataSetNotifyEvent;
     FAfterScroll: TDataSetNotifyEvent;
     FAutoCalcFields: Boolean;
     FBOF: Boolean;
@@ -926,6 +930,7 @@ type
     FBeforeInsert: TDataSetNotifyEvent;
     FBeforeOpen: TDataSetNotifyEvent;
     FBeforePost: TDataSetNotifyEvent;
+    FBeforeRefresh: TDataSetNotifyEvent;
     FBeforeScroll: TDataSetNotifyEvent;
     FBlobFieldCount: Longint;
     FBookmarkSize: Longint;
@@ -997,6 +1002,7 @@ type
     procedure DoAfterOpen; virtual;
     procedure DoAfterPost; virtual;
     procedure DoAfterScroll; virtual;
+    procedure DoAfterRefresh; virtual;
     procedure DoBeforeCancel; virtual;
     procedure DoBeforeClose; virtual;
     procedure DoBeforeDelete; virtual;
@@ -1005,6 +1011,7 @@ type
     procedure DoBeforeOpen; virtual;
     procedure DoBeforePost; virtual;
     procedure DoBeforeScroll; virtual;
+    procedure DoBeforeRefresh; virtual;
     procedure DoOnCalcFields; virtual;
     procedure DoOnNewRecord; virtual;
     function  FieldByNumber(FieldNo: Longint): TField;
@@ -1068,10 +1075,9 @@ type
     function GetDataSource: TDataSource; virtual;
     function GetFieldData(Field: TField; Buffer: Pointer): Boolean; overload; virtual;
     function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; overload; virtual;
-    procedure DataConvert(Field: TField; Source, Dest: Pointer; ToNative: Boolean);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;
+    procedure InternalAddRecord(Buffer: Pointer; AAppend: Boolean); virtual; abstract;
     procedure InternalClose; virtual; abstract;
     procedure InternalDelete; virtual; abstract;
     procedure InternalFirst; virtual; abstract;
@@ -1179,6 +1185,8 @@ type
     property AfterDelete: TDataSetNotifyEvent read FAfterDelete write FAfterDelete;
     property BeforeScroll: TDataSetNotifyEvent read FBeforeScroll write FBeforeScroll;
     property AfterScroll: TDataSetNotifyEvent read FAfterScroll write FAfterScroll;
+    property BeforeRefresh: TDataSetNotifyEvent read FBeforeRefresh write FBeforeRefresh;
+    property AfterRefresh: TDataSetNotifyEvent read FAfterRefresh write FAfterRefresh;
     property OnCalcFields: TDataSetNotifyEvent read FOnCalcFields write FOnCalcFields;
     property OnDeleteError: TDataSetErrorEvent read FOnDeleteError write FOnDeleteError;
     property OnEditError: TDataSetErrorEvent read FOnEditError write FOnEditError;
@@ -1532,7 +1540,11 @@ type
     procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
     procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
     function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
+    function GetFieldData(Field: TField; Buffer: Pointer;
+      NativeFormat: Boolean): Boolean; override;
     function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
+    procedure SetFieldData(Field: TField; Buffer: Pointer;
+      NativeFormat: Boolean); override;
     procedure SetFieldData(Field: TField; Buffer: Pointer); override;
     function IsCursorOpen: Boolean; override;
     function  GetRecordCount: Longint; override;

+ 1 - 0
fcl/db/dbase/dbf_common.inc

@@ -195,6 +195,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}

+ 6 - 0
fcl/db/fields.inc

@@ -132,6 +132,12 @@ begin
   Changed(False);
 end;
 
+procedure TFieldDef.SetRequired(const AValue: Boolean);
+begin
+  FRequired := AValue;
+  Changed(False);
+end;
+
 function TFieldDef.GetDisplayName: string;
 begin
   Result := FDisplayName;

+ 1 - 11
fcl/db/sqldb/sqldb.pp

@@ -88,6 +88,7 @@ type
     function Fetch(cursor : TSQLCursor) : boolean; virtual; abstract;
     procedure AddFieldDefs(cursor: TSQLCursor; FieldDefs : TfieldDefs); virtual; abstract;
     procedure UnPrepareStatement(cursor : TSQLCursor); virtual; abstract;
+
     procedure FreeFldBuffers(cursor : TSQLCursor); virtual; abstract;
     function LoadField(cursor : TSQLCursor;FieldDef : TfieldDef;buffer : pointer) : boolean; virtual; abstract;
     function GetTransactionHandle(trans : TSQLHandle): pointer; virtual; abstract;
@@ -195,7 +196,6 @@ type
     function Fetch : boolean; override;
     function LoadField(FieldDef : TFieldDef;buffer : pointer) : boolean; override;
     // abstract & virtual methods of TDataset
-    procedure DataConvert(Field: TField; Source, Dest: Pointer; ToNative: Boolean); override;
     procedure UpdateIndexDefs; override;
     procedure SetDatabase(Value : TDatabase); override;
     Procedure SetTransaction(Value : TDBTransaction); override;
@@ -679,16 +679,6 @@ begin
   result := (Database as tSQLConnection).LoadField(FCursor,FieldDef,buffer)
 end;
 
-procedure TSQLQuery.DataConvert(Field: TField; Source, Dest: Pointer; ToNative: Boolean);
-
-begin
-  {
-    all data is in native format for these types, so no conversion is needed.
-  }
-  If not (Field.DataType in [ftDate,ftTime,ftDateTime]) then
-    Inherited DataConvert(Field,Source,Dest,ToNative);
-end;
-
 procedure TSQLQuery.InternalAddRecord(Buffer: Pointer; AAppend: Boolean);
 begin
   // not implemented - sql dataset