mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-16 03:09:36 +02:00
* fcl-db: clarified Dataset.txt
* fcl-db/dbase tests: fix for failing memo, string test improvement in naming saved dbf files (if enabled) git-svn-id: trunk@24525 -
This commit is contained in:
parent
2fe7dbfc6c
commit
773ee3d21c
@ -4,7 +4,7 @@ Contents
|
|||||||
+ Fields system
|
+ Fields system
|
||||||
+ The buffers
|
+ The buffers
|
||||||
+ Dataset implementation
|
+ Dataset implementation
|
||||||
+ Scalable Datasets
|
+ Switchable datasets
|
||||||
|
|
||||||
===============
|
===============
|
||||||
General remarks
|
General remarks
|
||||||
@ -231,10 +231,10 @@ procedure SetFieldData(Field: TField; Buffer: Pointer); virtual; abstract;
|
|||||||
--------------------------------------------------------------------------
|
--------------------------------------------------------------------------
|
||||||
Move the data in associated with Field from Buffer to the active buffer.
|
Move the data in associated with Field from Buffer to the active buffer.
|
||||||
|
|
||||||
=================
|
===================
|
||||||
Scalable datasets
|
Switchable datasets
|
||||||
=================
|
===================
|
||||||
In order to have Scalable database access, the concept of TDatabase and
|
In order to have flexible database access, the concept of TDatabase and
|
||||||
TDBDataset is introduced. The idea is that, in a visual IDE, the change
|
TDBDataset is introduced. The idea is that, in a visual IDE, the change
|
||||||
from one database to another is achieved by simply removing one TDatabase
|
from one database to another is achieved by simply removing one TDatabase
|
||||||
descendent (Say, TMySqlDatabase) with another (Say, TPostGreSQLDatabase)
|
descendent (Say, TMySqlDatabase) with another (Say, TPostGreSQLDatabase)
|
||||||
|
@ -2,14 +2,13 @@ unit DBFToolsUnit;
|
|||||||
|
|
||||||
{ Sets up dbf datasets for testing
|
{ Sets up dbf datasets for testing
|
||||||
Tests expect Get*Dataset to return a dataset with structure and test data, but closed.
|
Tests expect Get*Dataset to return a dataset with structure and test data, but closed.
|
||||||
Because of this, we use file-backed dbfs instead of memory backed dbfs
|
|
||||||
}
|
}
|
||||||
|
|
||||||
{$IFDEF FPC}
|
{$IFDEF FPC}
|
||||||
{$mode objfpc}{$H+}
|
{$mode objfpc}{$H+}
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
|
||||||
// If defined, do not delete the dbf files when done but print out location to stdout:
|
// If defined, save the dbf files when done and print out location to stdout:
|
||||||
{.$DEFINE KEEPDBFFILES}
|
{.$DEFINE KEEPDBFFILES}
|
||||||
|
|
||||||
interface
|
interface
|
||||||
@ -42,6 +41,8 @@ type
|
|||||||
TDBFAutoClean = class(TDBF)
|
TDBFAutoClean = class(TDBF)
|
||||||
private
|
private
|
||||||
FBackingStream: TMemoryStream;
|
FBackingStream: TMemoryStream;
|
||||||
|
FIndexBackingStream: TMemoryStream;
|
||||||
|
FMemoBackingStream: TMemoryStream;
|
||||||
FCreatedBy: string;
|
FCreatedBy: string;
|
||||||
public
|
public
|
||||||
// Keeps track of which function created the dataset, useful for troubleshooting
|
// Keeps track of which function created the dataset, useful for troubleshooting
|
||||||
@ -68,6 +69,41 @@ implementation
|
|||||||
uses
|
uses
|
||||||
FmtBCD;
|
FmtBCD;
|
||||||
|
|
||||||
|
function GetNewTempDBFName: string;
|
||||||
|
// Scans temp directory for dbf names and adds
|
||||||
|
var
|
||||||
|
Res: TSearchRec;
|
||||||
|
Path, Name: string;
|
||||||
|
FileAttr: LongInt;
|
||||||
|
Attr,NextFileNo: Integer;
|
||||||
|
begin
|
||||||
|
NextFileNo:=0;
|
||||||
|
Attr := faAnyFile;
|
||||||
|
if FindFirst(IncludeTrailingPathDelimiter(GetTempDir)+'*.dbf', Attr, Res) = 0 then
|
||||||
|
begin
|
||||||
|
Path := GetTempDir;
|
||||||
|
repeat
|
||||||
|
Name := ConcatPaths([Path, Res.Name]);
|
||||||
|
FileAttr := FileGetAttr(Name);
|
||||||
|
if FileAttr and faDirectory = 0 then
|
||||||
|
begin
|
||||||
|
// Capture alphabetically latest name
|
||||||
|
try
|
||||||
|
//... only if it is numeric
|
||||||
|
if strtoint(ChangeFileExt(Res.Name,''))>NextFileNo then
|
||||||
|
NextFileNo:=strtoint(ChangeFileExt(Res.Name,''));
|
||||||
|
except
|
||||||
|
// apparently not numeric
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
until FindNext(Res) <> 0;
|
||||||
|
end;
|
||||||
|
FindClose(Res);
|
||||||
|
// now we now the latest file, add 1, and paste the temp directory in front of it
|
||||||
|
NextFileNo:=NextFileNo+1;
|
||||||
|
Result:=IncludeTrailingPathDelimiter(GetTempDir)+IntToStr(NextFileNo)+'.DBF';
|
||||||
|
end;
|
||||||
|
|
||||||
{ TDBFAutoClean }
|
{ TDBFAutoClean }
|
||||||
|
|
||||||
function TDBFAutoClean.UserRequestedTableLevel: integer;
|
function TDBFAutoClean.UserRequestedTableLevel: integer;
|
||||||
@ -90,13 +126,18 @@ end;
|
|||||||
|
|
||||||
constructor TDBFAutoClean.Create;
|
constructor TDBFAutoClean.Create;
|
||||||
begin
|
begin
|
||||||
|
// Create storage for data:
|
||||||
FBackingStream:=TMemoryStream.Create;
|
FBackingStream:=TMemoryStream.Create;
|
||||||
// Create a unique name:
|
FIndexBackingStream:=TMemoryStream.Create;
|
||||||
TableName := FormatDateTime('hhnnssz',Now())+'/'+inttostr(random(32767));
|
FMemoBackingStream:=TMemoryStream.Create;
|
||||||
|
// Create a unique name (within the 10 character DBIII limit):
|
||||||
|
TableName := FormatDateTime('hhnnssz',Now())+'_'+inttostr(random(99));
|
||||||
TableLevel := UserRequestedTableLevel;
|
TableLevel := UserRequestedTableLevel;
|
||||||
Storage:=stoMemory;
|
Storage:=stoMemory;
|
||||||
UserStream:=FBackingStream;
|
UserStream:=FBackingStream;
|
||||||
CreateTable; //write out header to disk
|
UserIndexStream:=FIndexBackingStream;
|
||||||
|
UserMemoStream:=FMemoBackingStream;
|
||||||
|
CreateTable; //this will also write out the dbf header to disk/stream
|
||||||
end;
|
end;
|
||||||
|
|
||||||
constructor TDBFAutoClean.Create(AOwner: TComponent);
|
constructor TDBFAutoClean.Create(AOwner: TComponent);
|
||||||
@ -113,12 +154,18 @@ var
|
|||||||
begin
|
begin
|
||||||
{$IFDEF KEEPDBFFILES}
|
{$IFDEF KEEPDBFFILES}
|
||||||
Close;
|
Close;
|
||||||
FileName := GetTempFileName;
|
FileName := GetNewTempDBFName;
|
||||||
FBackingStream.SaveToFile(FileName);
|
FBackingStream.SaveToFile(FileName);
|
||||||
|
FIndexBackingStream.SaveToFile(ChangeFileExt(FileName, '.mdx'));
|
||||||
|
if Self.TableLevel in [TDBF_TABLELEVEL_FOXPRO, TDBF_TABLELEVEL_VISUALFOXPRO] then
|
||||||
|
FMemoBackingStream.SaveToFile(ChangeFileExt(FileName, '.fpt'))
|
||||||
|
else
|
||||||
|
FMemoBackingStream.SaveToFile(ChangeFileExt(FileName, '.dbt'));
|
||||||
writeln('TDBFAutoClean: file created by ',CreatedBy,' left file: ',FileName);
|
writeln('TDBFAutoClean: file created by ',CreatedBy,' left file: ',FileName);
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
inherited Destroy;
|
inherited Destroy;
|
||||||
FBackingStream.Free;
|
FBackingStream.Free;
|
||||||
|
FIndexBackingStream.Free;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -162,10 +209,10 @@ begin
|
|||||||
FieldDefs.Add('FWORD', ftWord);
|
FieldDefs.Add('FWORD', ftWord);
|
||||||
FieldDefs.Add('FBOOLEAN', ftBoolean);
|
FieldDefs.Add('FBOOLEAN', ftBoolean);
|
||||||
FieldDefs.Add('FFLOAT', ftFloat);
|
FieldDefs.Add('FFLOAT', ftFloat);
|
||||||
// Field types only available in newer versions
|
// Field types only available in (Visual) FoxPro
|
||||||
if (Result as TDBF).TableLevel >= 25 then
|
if (Result as TDBF).TableLevel >= TDBF_TABLELEVEL_FOXPRO then
|
||||||
FieldDefs.Add('FCURRENCY', ftCurrency);
|
FieldDefs.Add('FCURRENCY', ftCurrency);
|
||||||
if (Result as TDBF).TableLevel >= 25 then
|
if (Result as TDBF).TableLevel >= TDBF_TABLELEVEL_FOXPRO then
|
||||||
FieldDefs.Add('FBCD', ftBCD);
|
FieldDefs.Add('FBCD', ftBCD);
|
||||||
FieldDefs.Add('FDATE', ftDate);
|
FieldDefs.Add('FDATE', ftDate);
|
||||||
FieldDefs.Add('FDATETIME', ftDateTime);
|
FieldDefs.Add('FDATETIME', ftDateTime);
|
||||||
@ -182,13 +229,15 @@ begin
|
|||||||
FieldByName('FINTEGER').AsInteger := testIntValues[i];
|
FieldByName('FINTEGER').AsInteger := testIntValues[i];
|
||||||
FieldByName('FBOOLEAN').AsBoolean := testBooleanValues[i];
|
FieldByName('FBOOLEAN').AsBoolean := testBooleanValues[i];
|
||||||
FieldByName('FFLOAT').AsFloat := testFloatValues[i];
|
FieldByName('FFLOAT').AsFloat := testFloatValues[i];
|
||||||
if (Result as TDBF).TableLevel >= 25 then
|
if (Result as TDBF).TableLevel >= TDBF_TABLELEVEL_FOXPRO then
|
||||||
FieldByName('FCURRENCY').AsCurrency := testCurrencyValues[i];
|
FieldByName('FCURRENCY').AsCurrency := testCurrencyValues[i];
|
||||||
// work around missing TBCDField.AsBCD:
|
// work around missing TBCDField.AsBCD:
|
||||||
if (Result as TDBF).TableLevel >= 25 then
|
if (Result as TDBF).TableLevel >= TDBF_TABLELEVEL_FOXPRO then
|
||||||
FieldByName('FBCD').AsBCD := StrToBCD(testFmtBCDValues[i],Self.FormatSettings);
|
FieldByName('FBCD').AsBCD := StrToBCD(testFmtBCDValues[i],Self.FormatSettings);
|
||||||
FieldByName('FDATE').AsDateTime := StrToDate(testDateValues[i], 'yyyy/mm/dd', '-');
|
FieldByName('FDATE').AsDateTime := StrToDate(testDateValues[i], 'yyyy/mm/dd', '-');
|
||||||
|
FieldByName('FDATETIME').AsDateTime := StrToDateTime(testValues[ftDateTime,i], Self.FormatSettings);
|
||||||
FieldByName('FLARGEINT').AsLargeInt := testLargeIntValues[i];
|
FieldByName('FLARGEINT').AsLargeInt := testLargeIntValues[i];
|
||||||
|
FieldByName('FMEMO').AsString := testStringValues[i];
|
||||||
Post;
|
Post;
|
||||||
end;
|
end;
|
||||||
Close;
|
Close;
|
||||||
|
@ -2316,6 +2316,8 @@ var i : byte;
|
|||||||
Fld : TField;
|
Fld : TField;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
if (uppercase(dbconnectorname)='DBF') then
|
||||||
|
Ignore('TDBF Smallint support only from -999 to 9999');
|
||||||
TestfieldDefinition(ftSmallint,2,ds,Fld);
|
TestfieldDefinition(ftSmallint,2,ds,Fld);
|
||||||
|
|
||||||
for i := 0 to testValuesCount-1 do
|
for i := 0 to testValuesCount-1 do
|
||||||
@ -2338,7 +2340,10 @@ begin
|
|||||||
|
|
||||||
for i := 0 to testValuesCount-1 do
|
for i := 0 to testValuesCount-1 do
|
||||||
begin
|
begin
|
||||||
CheckEquals(testStringValues[i],Fld.AsString);
|
if (uppercase(dbconnectorname)<>'DBF') then
|
||||||
|
CheckEquals(testStringValues[i],Fld.AsString)
|
||||||
|
else {DBF right-trims spaces in string fields }
|
||||||
|
CheckEquals(TrimRight(testStringValues[i]),Fld.AsString);
|
||||||
ds.Next;
|
ds.Next;
|
||||||
end;
|
end;
|
||||||
ds.close;
|
ds.close;
|
||||||
|
Loading…
Reference in New Issue
Block a user