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

* fcl-db/dbase: start splitting out FoxPro and Visual FoxPro support

Browse Source 
git-svn-id: trunk@24109 -
This commit is contained in:
reiniero 2013-04-01 16:47:22 +00:00
parent 7d3504ead5
commit db7b1aa940
5 changed files with 119 additions and 89 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
packages/fcl-db/src/dbase/dbf.pas
View File

@ -496,9 +496,10 @@ const
function TableLevelToDbfVersion(TableLevel: integer): TXBaseVersion;
begin
case TableLevel of
3: Result := xBaseIII;
7: Result := xBaseVII;
TDBF_TABLELEVEL_FOXPRO: Result := xFoxPro;
3: Result := xBaseIII;
7: Result := xBaseVII;
TDBF_TABLELEVEL_FOXPRO: Result := xFoxPro;
TDBF_TABLELEVEL_VISUALFOXPRO: Result := xVisualFoxPro;
else
{4:} Result := xBaseIV;
end;
@ -1071,7 +1072,7 @@ begin
if TempFieldDef.FieldType = ftFloat then
begin
FieldDefs[I].Size := 0; // Size is not defined for float-fields
FieldDefs[I].Size := 0; // Size is not defined for float fields
FieldDefs[I].Precision := TempFieldDef.Size;
end;
@ -1220,10 +1221,11 @@ begin
// determine dbf version
case FDbfFile.DbfVersion of
xBaseIII: FTableLevel := 3;
xBaseIV: FTableLevel := 4;
xBaseVII: FTableLevel := 7;
xFoxPro: FTableLevel := TDBF_TABLELEVEL_FOXPRO;
xBaseIII: FTableLevel := 3;
xBaseIV: FTableLevel := 4;
xBaseVII: FTableLevel := 7;
xFoxPro: FTableLevel := TDBF_TABLELEVEL_FOXPRO;
xVisualFoxPro: FTableLevel := TDBF_TABLELEVEL_VISUALFOXPRO;
end;
FLanguageID := FDbfFile.LanguageID;

3
packages/fcl-db/src/dbase/dbf_common.pas
View File

@ -21,6 +21,7 @@ const
TDBF_SUB_MINOR_VERSION = 2;
TDBF_TABLELEVEL_FOXPRO = 25;
TDBF_TABLELEVEL_VISUALFOXPRO = 30; {Source: http://www.codebase.com/support/kb/?article=C01059}
JulianDateDelta = 1721425; { number of days between 1.1.4714 BC and "0" }
@ -30,7 +31,7 @@ type
TDbfFieldType = char;
TXBaseVersion = (xUnknown, xClipper, xBaseIII, xBaseIV, xBaseV, xFoxPro, xBaseVII);
TXBaseVersion = (xUnknown, xClipper, xBaseIII, xBaseIV, xBaseV, xFoxPro, xBaseVII, xVisualFoxPro);
TSearchKeyType = (stEqual, stGreaterEqual, stGreater);
TDateTimeHandling = (dtDateTime, dtBDETimeStamp);

128
packages/fcl-db/src/dbase/dbf_dbffile.pas
View File

@ -354,24 +354,35 @@ begin
// $03,$F5 FoxPro Level 25 Header Byte $1d=$09, Float -> N($14.$05) DateTime D($08)
version := PDbfHdr(Header)^.VerDBF;
case (version and $07) of
$03:
if LanguageID = 0 then
FDbfVersion := xBaseIII
else
FDbfVersion := xBaseIV;
$04:
FDbfVersion := xBaseVII;
$02, $05:
FDbfVersion := xFoxPro;
else
// check visual foxpro
if ((version and $FE) = $30) or (version = $F5) or (version = $FB) then
begin
FDbfVersion := xFoxPro;
end else begin
// not a valid DBF file
raise EDbfError.Create(STRING_INVALID_DBF_FILE);
FDbfVersion := xUnknown;
// Some hardcode versions for Visual FoxPro; see MS documentation
// (including the correction at the bottom):
// http://msdn.microsoft.com/en-US/library/st4a0s68%28v=vs.80%29.aspx
case version of
$30, $31, $32: FDbfVersion:=xVisualFoxPro;
$F5: FDbfVersion:=xFoxPro;
end;
if FDbfVersion = xUnknown then
begin
case (version and $07) of
$03:
if LanguageID = 0 then
FDbfVersion := xBaseIII
else
FDbfVersion := xBaseIV;
$04:
FDbfVersion := xBaseVII;
$02, $05:
FDbfVersion := xFoxPro;
else
// todo: check visual foxpro, modify
if ((version and $FE) = $30) or (version = $F5) or (version = $FB) then
begin
FDbfVersion := xFoxPro;
end else begin
// not a valid DBF file
raise EDbfError.Create(STRING_INVALID_DBF_FILE);
end;
end;
end;
FFieldDefs.DbfVersion := FDbfVersion;
@ -449,7 +460,7 @@ begin
// open blob file
if not FileExists(lMemoFileName) then
MemoFileClass := TNullMemoFile
else if FDbfVersion = xFoxPro then
else if FDbfVersion in [xFoxPro,xVisualFoxPro] then
MemoFileClass := TFoxProMemoFile
else
MemoFileClass := TDbaseMemoFile;
@ -461,19 +472,19 @@ begin
FMemoFile.DbfVersion := FDbfVersion;
FMemoFile.Open;
// set header blob flag corresponding to field list
if FDbfVersion <> xFoxPro then
if not(FDbfVersion in [xFoxPro,xVisualFoxPro]) then
begin
PDbfHdr(Header)^.VerDBF := PDbfHdr(Header)^.VerDBF or $80;
lModified := true;
end;
end else
if FDbfVersion <> xFoxPro then
if not(FDbfVersion in [xFoxPro,xVisualFoxPro]) then
begin
PDbfHdr(Header)^.VerDBF := PDbfHdr(Header)^.VerDBF and $7F;
lModified := true;
end;
// check if mdx flagged
if (FDbfVersion <> xFoxPro) and (PDbfHdr(Header)^.MDXFlag <> 0) then
if not(FDbfVersion in [xFoxPro,xVisualFoxPro]) and (PDbfHdr(Header)^.MDXFlag <> 0) then
begin
// open mdx file if present
lMdxFileName := ChangeFileExt(FileName, '.mdx');
@ -606,11 +617,10 @@ begin
HeaderSize := SizeOf(rDbfHdr) + SizeOf(rAfterHdrIII);
RecordSize := SizeOf(rFieldDescIII);
FillChar(Header^, HeaderSize, #0);
if FDbfVersion = xFoxPro then
begin
PDbfHdr(Header)^.VerDBF := $02
end else
PDbfHdr(Header)^.VerDBF := $03;
case FDbfVersion of
xFoxPro: PDbfHdr(Header)^.VerDBF := $02; {FoxBASE}
xVisualFoxPro: PDbfHdr(Header)^.VerDBF := $30; {Visual FoxPro no autoincrement,no varchar} //todo: check autoincrement, Varchar, Varbinary, or Blob-enabled
else PDbfHdr(Header)^.VerDBF := $03; {FoxBASE+/dBASE III PLUS, no memo!?}
// standard language WE, dBase III no language support
if FDbfVersion = xBaseIII then
PDbfHdr(Header)^.Language := 0
@ -646,7 +656,7 @@ begin
lPrec := lFieldDef.Precision;
if (lFieldDef.NativeFieldType = 'C')
{$ifndef USE_LONG_CHAR_FIELDS}
and (FDbfVersion = xFoxPro)
and (FDbfVersion in [xFoxPro,xVisualFoxPro])
{$endif}
then
begin
@ -670,12 +680,12 @@ begin
lFieldDescIII.FieldType := lFieldDef.NativeFieldType;
lFieldDescIII.FieldSize := lSize;
lFieldDescIII.FieldPrecision := lPrec;
if FDbfVersion = xFoxPro then
if FDbfVersion in [xFoxPro,xVisualFoxPro] then
lFieldDescIII.FieldOffset := SwapIntLE(lFieldOffset);
if (PDbfHdr(Header)^.VerDBF = $02) and (lFieldDef.NativeFieldType in ['0', 'Y', 'T', 'O', '+']) then
PDbfHdr(Header)^.VerDBF := $30;
PDbfHdr(Header)^.VerDBF := $30; {Visual FoxPro}
if (PDbfHdr(Header)^.VerDBF = $30) and (lFieldDef.NativeFieldType = '+') then
PDbfHdr(Header)^.VerDBF := $31;
PDbfHdr(Header)^.VerDBF := $31; {Visual FoxPro, autoincrement enabled}
end;
// update our field list
@ -696,26 +706,26 @@ begin
// write memo bit
if lHasBlob then
begin
if FDbfVersion = xBaseIII then
PDbfHdr(Header)^.VerDBF := PDbfHdr(Header)^.VerDBF or $80
else
if FDbfVersion = xFoxPro then
begin
if PDbfHdr(Header)^.VerDBF = $02 then
PDbfHdr(Header)^.VerDBF := $F5;
end else
PDbfHdr(Header)^.VerDBF := PDbfHdr(Header)^.VerDBF or $88;
case FDbfVersion of
xBaseIII: PDbfHdr(Header)^.VerDBF := PDbfHdr(Header)^.VerDBF or $80;
xFoxPro: if PDbfHdr(Header)^.VerDBF = $02 then {change from FoxBASE to...}
PDbfHdr(Header)^.VerDBF := $F5; {...FoxPro 2.x (or earlier) with memo}
xVisualFoxPro: //MSDN says field 28 or $02 to set memo flag
PDbfHdr(Header)^.MDXFlag := PDbfHdr(Header)^.MDXFlag or $02;
else PDbfHdr(Header)^.VerDBF := PDbfHdr(Header)^.VerDBF or $88;
end;
end;
// update header
PDbfHdr(Header)^.RecordSize := lFieldOffset;
PDbfHdr(Header)^.FullHdrSize := HeaderSize + RecordSize * AFieldDefs.Count + 1;
// add empty "back-link" info, whatever it is:
{ A 263-byte range that contains the backlink, which is the relative path of
{ For Visual FoxPro only, add empty "back-link" info:
A 263-byte range that contains the backlink, which is the relative path of
an associated database (.dbc) file, information. If the first byte is 0x00,
the file is not associated with a database. Therefore, database files always
contain 0x00. }
if FDbfVersion = xFoxPro then
end;
if FDbfVersion = xVisualFoxPro then
Inc(PDbfHdr(Header)^.FullHdrSize, 263);
// write dbf header to disk
@ -731,7 +741,7 @@ begin
if HasBlob and (FMemoFile=nil) then
begin
lMemoFileName := ChangeFileExt(FileName, GetMemoExt);
if FDbfVersion = xFoxPro then
if FDbfVersion in [xFoxPro,xVisualFoxPro] then
FMemoFile := TFoxProMemoFile.Create(Self)
else
FMemoFile := TDbaseMemoFile.Create(Self);
@ -756,10 +766,10 @@ end;
function TDbfFile.GetMemoExt: string;
begin
if FDbfVersion = xFoxPro then
Result := '.fpt'
else
Result := '.dbt';
case FDbfVersion of
xFoxPro, xVisualFoxPro: Result := '.fpt'
else Result := '.dbt';
end;
end;
procedure TDbfFile.Zap;
@ -854,7 +864,8 @@ begin
lSize := lFieldDescIII.FieldSize;
lPrec := lFieldDescIII.FieldPrecision;
lNativeFieldType := lFieldDescIII.FieldType;
lCanHoldNull := (FDbfVersion = xFoxPro) and
// todo: verify but AFAIU only Visual FoxPro supports null fields. Leave in FoxPro for now
lCanHoldNull := (FDbfVersion in [xFoxPro,xVisualFoxPro]) and
((lFieldDescIII.FoxProFlags and $2) <> 0) and
(lFieldName <> '_NULLFLAGS');
end;
@ -862,7 +873,7 @@ begin
// apply field transformation tricks
if (lNativeFieldType = 'C')
{$ifndef USE_LONG_CHAR_FIELDS}
and (FDbfVersion = xFoxPro)
and (FDbfVersion in [xFoxPro,xVisualFoxPro])
{$endif}
then
begin
@ -1486,9 +1497,9 @@ begin
Result := true;
// field types that are binary and of which the fieldsize should not be truncated
case AFieldDef.NativeFieldType of
'+', 'I':
'+', 'I': //Autoincrement, integer
begin
if FDbfVersion <> xFoxPro then
if not(FDbfVersion in [xFoxPro,xVisualFoxPro]) then
begin
Result := PDWord(Src)^ <> 0;
if Result and (Dst <> nil) then
@ -1558,9 +1569,9 @@ begin
end;
{$endif}
end;
'B': // foxpro double
'B': // Foxpro double
begin
if FDbfVersion = xFoxPro then
if FDbfVersion in [xFoxPro,xVisualFoxPro] then
begin
Result := true;
if Dst <> nil then
@ -1737,10 +1748,11 @@ begin
// copy field data to record buffer
Dst := PChar(Dst) + TempFieldDef.Offset;
asciiContents := false;
// todo: check/add xvisualfoxpro autoincrement capability, null values, DateTime, Currency, and Double data types
case TempFieldDef.NativeFieldType of
'+', 'I':
'+', 'I' {autoincrement, integer}:
begin
if FDbfVersion <> xFoxPro then
if not(FDbfVersion in [xFoxPro,xVisualFoxPro]) then
begin
if Src = nil then
IntValue := 0
@ -1821,9 +1833,9 @@ begin
end;
{$endif}
end;
'B':
'B' {(Visual) FoxPro Double}:
begin
if DbfVersion = xFoxPro then
if DbfVersion in [xFoxPro,xVisualFoxPro] then
begin
if Src = nil then
PDouble(Dst)^ := 0

55
packages/fcl-db/src/dbase/dbf_fields.pas
View File

@ -55,6 +55,7 @@ type
procedure Assign(Source: TPersistent); override;
procedure AssignDb(DbSource: TFieldDef);
// Checks and adjusts field size & precision
procedure CheckSizePrecision;
procedure SetDefaultSize;
procedure AllocBuffers;
@ -365,7 +366,7 @@ begin
'D' : FFieldType := ftDate;
'M' : FFieldType := ftMemo;
'B' :
if DbfVersion = xFoxPro then
if (DbfVersion = xFoxPro) or (DbfVersion=xVisualFoxPro) then
FFieldType := ftFloat
else
FFieldType := ftBlob;
@ -375,7 +376,15 @@ begin
FFieldType := ftBCD
else
FFieldType := ftCurrency;
'0' : FFieldType := ftBytes; { Visual FoxPro ``_NullFlags'' }
'0' : FFieldType := ftBytes; { Visual FoxPro ``_NullFlags'' }
{
To do: add support for Visual Foxpro types
http://msdn.microsoft.com/en-US/library/ww305zh2%28v=vs.80%29.aspx
P Picture (in at least Visual FoxPro)
V Varchar/varchar binary (in at least Visual FoxPro) 1 byte up to 255 bytes (or perhaps 254)
W Blob (in at least Visual FoxPro), 4 bytes in a table; stored in .fpt
Q Varbinary (in at least Visual Foxpro)
}
else
FNativeFieldType := #0;
FFieldType := ftUnknown;
@ -391,7 +400,7 @@ begin
if DbfVersion = xBaseVII then
FNativeFieldType := '@'
else
if DbfVersion = xFoxPro then
if (DbfVersion = xFoxPro) or (DbfVersion = xVisualFoxPro) then
FNativeFieldType := 'T'
else
FNativeFieldType := 'D';
@ -416,7 +425,7 @@ begin
else
FNativeFieldType := 'N';
ftBCD, ftCurrency:
if DbfVersion = xFoxPro then
if (DbfVersion = xFoxPro) or (DBFVersion = xVisualFoxPro) then
FNativeFieldType := 'Y';
end;
if FNativeFieldType = #0 then
@ -471,11 +480,11 @@ end;
procedure TDbfFieldDef.CheckSizePrecision;
begin
case FNativeFieldType of
'C':
'C': // Character
begin
if FSize < 0 then
FSize := 0;
if DbfVersion = xFoxPro then
if (DbfVersion = xFoxPro) or (DbfVersion = xVisualFoxPro) then
begin
if FSize >= $FFFF then
FSize := $FFFF;
@ -485,35 +494,34 @@ begin
end;
FPrecision := 0;
end;
'L':
'L': // Logical/boolean
begin
FSize := 1;
FPrecision := 0;
end;
'N','F':
'N','F': // Binary code decimal numeric, floating point binary numeric
begin
// floating point
if FSize < 1 then FSize := 1;
if FSize >= 20 then FSize := 20;
if FPrecision > FSize-2 then FPrecision := FSize-2;
if FPrecision < 0 then FPrecision := 0;
end;
'D':
'D': // Date
begin
FSize := 8;
FPrecision := 0;
end;
'B':
'B': // Double
begin
if DbfVersion <> xFoxPro then
if (DbfVersion <> xFoxPro) and (DbfVersion <> xVisualFoxPro) then
begin
FSize := 10;
FPrecision := 0;
end;
end;
'M','G':
'M','G': // Memo, general
begin
if DbfVersion = xFoxPro then
if (DbfVersion = xFoxPro) or (DbfVersion = xVisualFoxPro) then
begin
if (FSize <> 4) and (FSize <> 10) then
FSize := 4;
@ -521,31 +529,38 @@ begin
FSize := 10;
FPrecision := 0;
end;
'+','I':
'+','I': // Autoincrement, integer
begin
FSize := 4;
FPrecision := 0;
end;
'@', 'O':
'@', 'O': //Timestamp, double (both DBase 7)
begin
FSize := 8;
FPrecision := 0;
end;
'T':
'T': // DateTime
begin
if DbfVersion = xFoxPro then
if (DbfVersion = xFoxPro) or (DbfVersion = xVisualFoxPro) then
FSize := 8
else
FSize := 14;
FPrecision := 0;
end;
'Y':
'Y': // Currency
begin
FSize := 8;
FPrecision := 4;
end;
else
// Nothing
{
No check, includes:
http://msdn.microsoft.com/en-US/library/ww305zh2%28v=vs.80%29.aspx
P Picture (in at least Visual FoxPro)
V Varchar/varchar binary (in at least Visual FoxPro) 1 byte up to 255 bytes (or perhaps 254)
W Blob (in at least Visual FoxPro), 4 bytes in a table; stored in .fpt
Q Varbinary (in at least Visual Foxpro)
}
end; // case
end;

4
packages/fcl-db/src/dbase/dbf_memo.pas
View File

@ -184,7 +184,7 @@ begin
RecordSize := GetBlockLen;
// checking for right blocksize not needed for foxpro?
// mod 128 <> 0 <-> and 0x7F <> 0
if (RecordSize = 0) and ((FDbfVersion = xFoxPro) or ((RecordSize and $7F) <> 0)) then
if (RecordSize = 0) and ((FDbfVersion in [xFoxPro,xVisualFoxPro]) or ((RecordSize and $7F) <> 0)) then
begin
SetBlockLen(512);
RecordSize := 512;
@ -371,7 +371,7 @@ begin
if bytesBefore=8 then
begin
totsize := Src.Size + bytesBefore + bytesAfter;
if FDbfVersion <> xFoxPro then
if not(FDbfVersion in [xFoxPro,xVisualFoxPro]) then
begin
PBlockHdr(FBuffer)^.MemoType := SwapIntLE($0008FFFF);
PBlockHdr(FBuffer)^.MemoSize := SwapIntLE(totsize);