paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 21:09:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ date/time fields handling compatibility fix

Browse Source 
+ 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:
joost 2006-01-13 21:27:00 +00:00
parent b9a0e2ead2
commit 1f754a3905
6 changed files with 71 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
fcl/db/bufdataset.inc
View File

@ -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;

80
fcl/db/dataset.inc
View File

@ -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);

18
fcl/db/db.pp
View File

@ -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
fcl/db/dbase/dbf_common.inc
View File

@ -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
fcl/db/fields.inc
View File

@ -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;

12
fcl/db/sqldb/sqldb.pp
View File

@ -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