From db7b1aa9404b4d8a30e6dcc759f1813975a5faee Mon Sep 17 00:00:00 2001 From: reiniero Date: Mon, 1 Apr 2013 16:47:22 +0000 Subject: [PATCH] * fcl-db/dbase: start splitting out FoxPro and Visual FoxPro support git-svn-id: trunk@24109 - --- packages/fcl-db/src/dbase/dbf.pas | 18 +-- packages/fcl-db/src/dbase/dbf_common.pas | 3 +- packages/fcl-db/src/dbase/dbf_dbffile.pas | 128 ++++++++++++---------- packages/fcl-db/src/dbase/dbf_fields.pas | 55 ++++++---- packages/fcl-db/src/dbase/dbf_memo.pas | 4 +- 5 files changed, 119 insertions(+), 89 deletions(-) diff --git a/packages/fcl-db/src/dbase/dbf.pas b/packages/fcl-db/src/dbase/dbf.pas index 41ed0062f0..e1d0c0c6d1 100644 --- a/packages/fcl-db/src/dbase/dbf.pas +++ b/packages/fcl-db/src/dbase/dbf.pas @@ -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; diff --git a/packages/fcl-db/src/dbase/dbf_common.pas b/packages/fcl-db/src/dbase/dbf_common.pas index 975233aee2..b7f88b1d1f 100644 --- a/packages/fcl-db/src/dbase/dbf_common.pas +++ b/packages/fcl-db/src/dbase/dbf_common.pas @@ -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); diff --git a/packages/fcl-db/src/dbase/dbf_dbffile.pas b/packages/fcl-db/src/dbase/dbf_dbffile.pas index b481954618..a0e03d2aa5 100644 --- a/packages/fcl-db/src/dbase/dbf_dbffile.pas +++ b/packages/fcl-db/src/dbase/dbf_dbffile.pas @@ -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 diff --git a/packages/fcl-db/src/dbase/dbf_fields.pas b/packages/fcl-db/src/dbase/dbf_fields.pas index 2ed4b7752c..a8244f1f8b 100644 --- a/packages/fcl-db/src/dbase/dbf_fields.pas +++ b/packages/fcl-db/src/dbase/dbf_fields.pas @@ -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; diff --git a/packages/fcl-db/src/dbase/dbf_memo.pas b/packages/fcl-db/src/dbase/dbf_memo.pas index 585559cda0..24637f06d7 100644 --- a/packages/fcl-db/src/dbase/dbf_memo.pas +++ b/packages/fcl-db/src/dbase/dbf_memo.pas @@ -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);