[fpc-devel] Re: Patch for datetime-stuff

joost at cnoc.nl joost at cnoc.nl
Sun Jan 8 21:13:23 CET 2006


Idiot

JoJo,
  Joost.

On Sun, 8 Jan 2006 joost at cnoc.nl wrote:

> Hi all,
> 
> If I'm right this patch makes the date/time handling of fpc compatible
> with Delphi 5+.
> 
> I haven't comitted it yet, because of all the discussion about the
> subject.
> 
> I've tested with sqldb, ZEOS and tDbf.
> 
> tDbf also has to be patched, so that the date/time handling is the same as
> in Delphi now.
> 
> When ising ZEOS, setting Date/Time values doesn't work, unless ZEOS is
> patched. (An 'ifdef fpc' has to be removed, i'll post that on the
> ZEOS-forum)
> 
> I hope all problems are solved now. . .
> 
> JoJo,
>   Joost.
> 
> 
-------------- next part --------------
Index: bufdataset.inc
===================================================================
--- bufdataset.inc	(revision 2210)
+++ bufdataset.inc	(working copy)
@@ -365,6 +365,12 @@
   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 @@
     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;
Index: dataset.inc
===================================================================
--- dataset.inc	(revision 2210)
+++ dataset.inc	(working copy)
@@ -501,27 +501,24 @@
 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;
 
 Function DateTimeRecToDateTime(DT: TFieldType; Data: TDateTimeRec): TDateTime;
@@ -566,26 +563,6 @@
     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 +572,25 @@
 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, at 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;
 
Index: db.pp
===================================================================
--- db.pp	(revision 2210)
+++ db.pp	(working copy)
@@ -1068,7 +1068,6 @@
     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;
@@ -1532,7 +1531,11 @@
     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;
Index: sqldb/sqldb.pp
===================================================================
--- sqldb/sqldb.pp	(revision 2210)
+++ sqldb/sqldb.pp	(working copy)
@@ -195,7 +196,6 @@
     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 @@
   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
Index: dbase/dbf_common.inc
===================================================================
--- dbase/dbf_common.inc	(revision 2210)
+++ dbase/dbf_common.inc	(working copy)
@@ -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}


More information about the fpc-devel mailing list