Idiot JoJo, Joost.
On Sun, 8 Jan 2006 [EMAIL PROTECTED] 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. > >
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:[EMAIL PROTECTED] + 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,@DTRBuffer); + end else - P:[EMAIL PROTECTED]; - 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}
_______________________________________________ fpc-devel maillist - fpc-devel@lists.freepascal.org http://lists.freepascal.org/mailman/listinfo/fpc-devel