mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-24 04:21:53 +02:00
+ 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 -
This commit is contained in:
parent
b9a0e2ead2
commit
1f754a3905
@ -365,6 +365,12 @@ begin
|
|||||||
Result := grOK;
|
Result := grOK;
|
||||||
end;
|
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;
|
function TBufDataset.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
|
||||||
|
|
||||||
var
|
var
|
||||||
@ -413,6 +419,12 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TBufDataset.SetFieldData(Field: TField; Buffer: Pointer;
|
||||||
|
NativeFormat: Boolean);
|
||||||
|
begin
|
||||||
|
SetFieldData(Field,Buffer);
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TBufDataset.SetFieldData(Field: TField; Buffer: Pointer);
|
procedure TBufDataset.SetFieldData(Field: TField; Buffer: Pointer);
|
||||||
var
|
var
|
||||||
x : longint;
|
x : longint;
|
||||||
|
@ -298,6 +298,13 @@ begin
|
|||||||
FAfterScroll(Self);
|
FAfterScroll(Self);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
Procedure TDataset.DoAfterRefresh;
|
||||||
|
|
||||||
|
begin
|
||||||
|
If assigned(FAfterRefresh) then
|
||||||
|
FAfterRefresh(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
Procedure TDataset.DoBeforeCancel;
|
Procedure TDataset.DoBeforeCancel;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
@ -354,6 +361,13 @@ begin
|
|||||||
FBeforeScroll(Self);
|
FBeforeScroll(Self);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
Procedure TDataset.DoBeforeRefresh;
|
||||||
|
|
||||||
|
begin
|
||||||
|
If assigned(FBeforeRefresh) then
|
||||||
|
FBeforeRefresh(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
Procedure TDataset.DoInternalOpen;
|
Procedure TDataset.DoInternalOpen;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
@ -501,26 +515,23 @@ end;
|
|||||||
function TDataSet.GetFieldData(Field: TField; Buffer: Pointer;
|
function TDataSet.GetFieldData(Field: TField; Buffer: Pointer;
|
||||||
NativeFormat: Boolean): Boolean;
|
NativeFormat: Boolean): Boolean;
|
||||||
|
|
||||||
Const
|
|
||||||
TempBufSize = 1024; { Let's not exaggerate.}
|
|
||||||
|
|
||||||
Var
|
Var
|
||||||
Buf : Array[1..TempBufSize] of Char;
|
DT : TFieldType;
|
||||||
P : PChar;
|
DTRBuffer : TDateTimeRec;
|
||||||
begin
|
begin
|
||||||
If NativeFormat then
|
If NativeFormat then
|
||||||
Result:=GetFieldData(Field, Buffer)
|
Result:=GetFieldData(Field, Buffer)
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
If (Field.DataSize<=TempBufSize) then
|
DT := Field.DataType;
|
||||||
P:=@Buf
|
case DT of
|
||||||
|
ftDate, ftTime, ftDateTime: begin
|
||||||
|
Result := GetfieldData(Field, @DTRBuffer);
|
||||||
|
TDateTime(buffer^) := DateTimeRecToDateTime(DT, DTRBuffer);
|
||||||
|
end
|
||||||
else
|
else
|
||||||
P:=GetMem(Field.DataSize);
|
Result:=GetFieldData(Field, Buffer)
|
||||||
Result:=GetFieldData(Field,P);
|
end;
|
||||||
If Result then
|
|
||||||
DataConvert(Field,P,Buffer,False);
|
|
||||||
If (P<>@Buf) then
|
|
||||||
FreeMem(P);
|
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -566,26 +577,6 @@ begin
|
|||||||
end;
|
end;
|
||||||
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);
|
procedure TDataSet.SetFieldData(Field: TField; Buffer: Pointer);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
@ -595,26 +586,25 @@ end;
|
|||||||
procedure TDataSet.SetFieldData(Field: TField; Buffer: Pointer;
|
procedure TDataSet.SetFieldData(Field: TField; Buffer: Pointer;
|
||||||
NativeFormat: Boolean);
|
NativeFormat: Boolean);
|
||||||
|
|
||||||
Const
|
|
||||||
TempBufSize = 1024; { Let's not exaggerate.}
|
|
||||||
|
|
||||||
Var
|
Var
|
||||||
Buf : Array[1..TempBufSize] of Char;
|
DT : TFieldType;
|
||||||
P : PChar;
|
DTRBuffer : TDateTimeRec;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if NativeFormat then
|
if NativeFormat then
|
||||||
SetFieldData(Field, Buffer)
|
SetFieldData(Field, Buffer)
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
if Field.DataSize<=dsMaxStringSize then
|
DT := Field.DataType;
|
||||||
P:=GetMem(Field.DataSize)
|
case DT of
|
||||||
|
ftDate, ftTime, ftDateTime: begin
|
||||||
|
DTRBuffer := DateTimeToDateTimeRec(DT,TDateTime(buffer^));
|
||||||
|
SetFieldData(Field,@DTRBuffer);
|
||||||
|
end
|
||||||
else
|
else
|
||||||
P:=@Buf;
|
SetFieldData(Field, Buffer);
|
||||||
DataConvert(Field,Buffer,P,True);
|
end; {case};
|
||||||
SetFieldData(Field,P);
|
|
||||||
If (P<>@Buf) then
|
|
||||||
FreeMem(P);
|
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -1771,12 +1761,14 @@ Procedure TDataset.Refresh;
|
|||||||
|
|
||||||
begin
|
begin
|
||||||
CheckbrowseMode;
|
CheckbrowseMode;
|
||||||
|
DoBeforeRefresh;
|
||||||
UpdateCursorPos;
|
UpdateCursorPos;
|
||||||
InternalRefresh;
|
InternalRefresh;
|
||||||
{ SetCurrentRecord is called by UpdateCursorPos already, so as long as
|
{ SetCurrentRecord is called by UpdateCursorPos already, so as long as
|
||||||
InternalRefresh doesn't do strange things this should be ok. }
|
InternalRefresh doesn't do strange things this should be ok. }
|
||||||
// SetCurrentRecord(FActiverecord);
|
// SetCurrentRecord(FActiverecord);
|
||||||
Resync([]);
|
Resync([]);
|
||||||
|
DoAfterRefresh;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
Procedure TDataset.RegisterDataSource(ADatasource : TDataSource);
|
Procedure TDataset.RegisterDataSource(ADatasource : TDataSource);
|
||||||
|
18
fcl/db/db.pp
18
fcl/db/db.pp
@ -127,6 +127,7 @@ type
|
|||||||
procedure SetDataType(AValue: TFieldType);
|
procedure SetDataType(AValue: TFieldType);
|
||||||
procedure SetPrecision(const AValue: Longint);
|
procedure SetPrecision(const AValue: Longint);
|
||||||
procedure SetSize(const AValue: Word);
|
procedure SetSize(const AValue: Word);
|
||||||
|
procedure SetRequired(const AValue: Boolean);
|
||||||
protected
|
protected
|
||||||
function GetDisplayName: string; override;
|
function GetDisplayName: string; override;
|
||||||
procedure SetDisplayName(const AValue: string); override;
|
procedure SetDisplayName(const AValue: string); override;
|
||||||
@ -139,7 +140,7 @@ type
|
|||||||
property FieldClass: TFieldClass read GetFieldClass;
|
property FieldClass: TFieldClass read GetFieldClass;
|
||||||
property FieldNo: Longint read FFieldNo;
|
property FieldNo: Longint read FFieldNo;
|
||||||
property InternalCalcField: Boolean read FInternalCalcField write FInternalCalcField;
|
property InternalCalcField: Boolean read FInternalCalcField write FInternalCalcField;
|
||||||
property Required: Boolean read FRequired;
|
property Required: Boolean read FRequired write SetRequired;
|
||||||
Published
|
Published
|
||||||
property Attributes: TFieldAttributes read FAttributes write SetAttributes default [];
|
property Attributes: TFieldAttributes read FAttributes write SetAttributes default [];
|
||||||
property Name: string read FName write FName; // Must move to TNamedItem
|
property Name: string read FName write FName; // Must move to TNamedItem
|
||||||
@ -884,6 +885,8 @@ type
|
|||||||
|
|
||||||
TDataAction = (daFail, daAbort, daRetry);
|
TDataAction = (daFail, daAbort, daRetry);
|
||||||
|
|
||||||
|
TUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApplied);
|
||||||
|
|
||||||
TUpdateKind = (ukModify, ukInsert, ukDelete);
|
TUpdateKind = (ukModify, ukInsert, ukDelete);
|
||||||
|
|
||||||
|
|
||||||
@ -916,6 +919,7 @@ type
|
|||||||
FAfterInsert: TDataSetNotifyEvent;
|
FAfterInsert: TDataSetNotifyEvent;
|
||||||
FAfterOpen: TDataSetNotifyEvent;
|
FAfterOpen: TDataSetNotifyEvent;
|
||||||
FAfterPost: TDataSetNotifyEvent;
|
FAfterPost: TDataSetNotifyEvent;
|
||||||
|
FAfterRefresh: TDataSetNotifyEvent;
|
||||||
FAfterScroll: TDataSetNotifyEvent;
|
FAfterScroll: TDataSetNotifyEvent;
|
||||||
FAutoCalcFields: Boolean;
|
FAutoCalcFields: Boolean;
|
||||||
FBOF: Boolean;
|
FBOF: Boolean;
|
||||||
@ -926,6 +930,7 @@ type
|
|||||||
FBeforeInsert: TDataSetNotifyEvent;
|
FBeforeInsert: TDataSetNotifyEvent;
|
||||||
FBeforeOpen: TDataSetNotifyEvent;
|
FBeforeOpen: TDataSetNotifyEvent;
|
||||||
FBeforePost: TDataSetNotifyEvent;
|
FBeforePost: TDataSetNotifyEvent;
|
||||||
|
FBeforeRefresh: TDataSetNotifyEvent;
|
||||||
FBeforeScroll: TDataSetNotifyEvent;
|
FBeforeScroll: TDataSetNotifyEvent;
|
||||||
FBlobFieldCount: Longint;
|
FBlobFieldCount: Longint;
|
||||||
FBookmarkSize: Longint;
|
FBookmarkSize: Longint;
|
||||||
@ -997,6 +1002,7 @@ type
|
|||||||
procedure DoAfterOpen; virtual;
|
procedure DoAfterOpen; virtual;
|
||||||
procedure DoAfterPost; virtual;
|
procedure DoAfterPost; virtual;
|
||||||
procedure DoAfterScroll; virtual;
|
procedure DoAfterScroll; virtual;
|
||||||
|
procedure DoAfterRefresh; virtual;
|
||||||
procedure DoBeforeCancel; virtual;
|
procedure DoBeforeCancel; virtual;
|
||||||
procedure DoBeforeClose; virtual;
|
procedure DoBeforeClose; virtual;
|
||||||
procedure DoBeforeDelete; virtual;
|
procedure DoBeforeDelete; virtual;
|
||||||
@ -1005,6 +1011,7 @@ type
|
|||||||
procedure DoBeforeOpen; virtual;
|
procedure DoBeforeOpen; virtual;
|
||||||
procedure DoBeforePost; virtual;
|
procedure DoBeforePost; virtual;
|
||||||
procedure DoBeforeScroll; virtual;
|
procedure DoBeforeScroll; virtual;
|
||||||
|
procedure DoBeforeRefresh; virtual;
|
||||||
procedure DoOnCalcFields; virtual;
|
procedure DoOnCalcFields; virtual;
|
||||||
procedure DoOnNewRecord; virtual;
|
procedure DoOnNewRecord; virtual;
|
||||||
function FieldByNumber(FieldNo: Longint): TField;
|
function FieldByNumber(FieldNo: Longint): TField;
|
||||||
@ -1068,10 +1075,9 @@ type
|
|||||||
function GetDataSource: TDataSource; virtual;
|
function GetDataSource: TDataSource; virtual;
|
||||||
function GetFieldData(Field: TField; Buffer: Pointer): Boolean; overload; virtual;
|
function GetFieldData(Field: TField; Buffer: Pointer): Boolean; overload; virtual;
|
||||||
function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): 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 GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; virtual; abstract;
|
||||||
function GetRecordSize: Word; 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 InternalClose; virtual; abstract;
|
||||||
procedure InternalDelete; virtual; abstract;
|
procedure InternalDelete; virtual; abstract;
|
||||||
procedure InternalFirst; virtual; abstract;
|
procedure InternalFirst; virtual; abstract;
|
||||||
@ -1179,6 +1185,8 @@ type
|
|||||||
property AfterDelete: TDataSetNotifyEvent read FAfterDelete write FAfterDelete;
|
property AfterDelete: TDataSetNotifyEvent read FAfterDelete write FAfterDelete;
|
||||||
property BeforeScroll: TDataSetNotifyEvent read FBeforeScroll write FBeforeScroll;
|
property BeforeScroll: TDataSetNotifyEvent read FBeforeScroll write FBeforeScroll;
|
||||||
property AfterScroll: TDataSetNotifyEvent read FAfterScroll write FAfterScroll;
|
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 OnCalcFields: TDataSetNotifyEvent read FOnCalcFields write FOnCalcFields;
|
||||||
property OnDeleteError: TDataSetErrorEvent read FOnDeleteError write FOnDeleteError;
|
property OnDeleteError: TDataSetErrorEvent read FOnDeleteError write FOnDeleteError;
|
||||||
property OnEditError: TDataSetErrorEvent read FOnEditError write FOnEditError;
|
property OnEditError: TDataSetErrorEvent read FOnEditError write FOnEditError;
|
||||||
@ -1532,7 +1540,11 @@ type
|
|||||||
procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
|
procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
|
||||||
procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
|
procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
|
||||||
function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; 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;
|
function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
|
||||||
|
procedure SetFieldData(Field: TField; Buffer: Pointer;
|
||||||
|
NativeFormat: Boolean); override;
|
||||||
procedure SetFieldData(Field: TField; Buffer: Pointer); override;
|
procedure SetFieldData(Field: TField; Buffer: Pointer); override;
|
||||||
function IsCursorOpen: Boolean; override;
|
function IsCursorOpen: Boolean; override;
|
||||||
function GetRecordCount: Longint; override;
|
function GetRecordCount: Longint; override;
|
||||||
|
@ -195,6 +195,7 @@
|
|||||||
{$define SUPPORT_INT64}
|
{$define SUPPORT_INT64}
|
||||||
{$define SUPPORT_DEFAULT_PARAMS}
|
{$define SUPPORT_DEFAULT_PARAMS}
|
||||||
{$define SUPPORT_NEW_TRANSLATE}
|
{$define SUPPORT_NEW_TRANSLATE}
|
||||||
|
{$define SUPPORT_BACKWARD_FIELDDATA}
|
||||||
{$define SUPPORT_NEW_FIELDDATA}
|
{$define SUPPORT_NEW_FIELDDATA}
|
||||||
{$define SUPPORT_FIELDDEF_TPERSISTENT}
|
{$define SUPPORT_FIELDDEF_TPERSISTENT}
|
||||||
{$define SUPPORT_FIELDTYPES_V4}
|
{$define SUPPORT_FIELDTYPES_V4}
|
||||||
|
@ -132,6 +132,12 @@ begin
|
|||||||
Changed(False);
|
Changed(False);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TFieldDef.SetRequired(const AValue: Boolean);
|
||||||
|
begin
|
||||||
|
FRequired := AValue;
|
||||||
|
Changed(False);
|
||||||
|
end;
|
||||||
|
|
||||||
function TFieldDef.GetDisplayName: string;
|
function TFieldDef.GetDisplayName: string;
|
||||||
begin
|
begin
|
||||||
Result := FDisplayName;
|
Result := FDisplayName;
|
||||||
|
@ -88,6 +88,7 @@ type
|
|||||||
function Fetch(cursor : TSQLCursor) : boolean; virtual; abstract;
|
function Fetch(cursor : TSQLCursor) : boolean; virtual; abstract;
|
||||||
procedure AddFieldDefs(cursor: TSQLCursor; FieldDefs : TfieldDefs); virtual; abstract;
|
procedure AddFieldDefs(cursor: TSQLCursor; FieldDefs : TfieldDefs); virtual; abstract;
|
||||||
procedure UnPrepareStatement(cursor : TSQLCursor); virtual; abstract;
|
procedure UnPrepareStatement(cursor : TSQLCursor); virtual; abstract;
|
||||||
|
|
||||||
procedure FreeFldBuffers(cursor : TSQLCursor); virtual; abstract;
|
procedure FreeFldBuffers(cursor : TSQLCursor); virtual; abstract;
|
||||||
function LoadField(cursor : TSQLCursor;FieldDef : TfieldDef;buffer : pointer) : boolean; virtual; abstract;
|
function LoadField(cursor : TSQLCursor;FieldDef : TfieldDef;buffer : pointer) : boolean; virtual; abstract;
|
||||||
function GetTransactionHandle(trans : TSQLHandle): pointer; virtual; abstract;
|
function GetTransactionHandle(trans : TSQLHandle): pointer; virtual; abstract;
|
||||||
@ -195,7 +196,6 @@ type
|
|||||||
function Fetch : boolean; override;
|
function Fetch : boolean; override;
|
||||||
function LoadField(FieldDef : TFieldDef;buffer : pointer) : boolean; override;
|
function LoadField(FieldDef : TFieldDef;buffer : pointer) : boolean; override;
|
||||||
// abstract & virtual methods of TDataset
|
// abstract & virtual methods of TDataset
|
||||||
procedure DataConvert(Field: TField; Source, Dest: Pointer; ToNative: Boolean); override;
|
|
||||||
procedure UpdateIndexDefs; override;
|
procedure UpdateIndexDefs; override;
|
||||||
procedure SetDatabase(Value : TDatabase); override;
|
procedure SetDatabase(Value : TDatabase); override;
|
||||||
Procedure SetTransaction(Value : TDBTransaction); override;
|
Procedure SetTransaction(Value : TDBTransaction); override;
|
||||||
@ -679,16 +679,6 @@ begin
|
|||||||
result := (Database as tSQLConnection).LoadField(FCursor,FieldDef,buffer)
|
result := (Database as tSQLConnection).LoadField(FCursor,FieldDef,buffer)
|
||||||
end;
|
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);
|
procedure TSQLQuery.InternalAddRecord(Buffer: Pointer; AAppend: Boolean);
|
||||||
begin
|
begin
|
||||||
// not implemented - sql dataset
|
// not implemented - sql dataset
|
||||||
|
Loading…
Reference in New Issue
Block a user