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

fcl-db/dbase: DbaseIII memo fix: blocksize=fixed 512; no memo field size header

Browse Source 
git-svn-id: trunk@24256 -
This commit is contained in:
reiniero 2013-04-16 07:42:04 +00:00
parent 996b26b936
commit 0553754d05
1 changed files with 14 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -45,6 +45,8 @@ type
property MemoRecordSize: Integer read FMemoRecordSize write FMemoRecordSize;
end;
{ TFoxProMemoFile }
// (Visual) Foxpro memo file support
TFoxProMemoFile = class(TMemoFile)
protected
function GetBlockLen: Integer; override;
@ -54,6 +56,7 @@ type
procedure SetBlockLen(BlockLen: Integer); override;
end;
// DBaseIII+ memo file support:
TDbaseMemoFile = class(TMemoFile)
protected
function GetBlockLen: Integer; override;
@ -146,6 +149,7 @@ type
// memo data 8..N
end;
procedure TMemoFile.SetDBFVersion(AValue: TXBaseVersion);
begin
if FDbfVersion=AValue then Exit;
@ -301,10 +305,10 @@ begin
end;
end;
end else begin
// dbase III memo
// e.g. dbase III memo
done := false;
repeat
// scan for EOF marker
// scan for EOF marker/field terminator
endMemo := MemScan(FBuffer, $1A, RecordSize);
// EOF found?
if endMemo <> nil then
@ -313,10 +317,10 @@ begin
if (endMemo-FBuffer < RecordSize - 1) and
((endMemo[1] = #$1A) or (endMemo[1] = #0)) then
begin
done := true;
done := true; //found the end
numBytes := endMemo - FBuffer;
end else begin
// no, fake
// no, fake ending
numBytes := RecordSize;
end;
end else begin
@ -402,7 +406,7 @@ begin
Src.Position := 0;
FillChar(FBuffer[0], RecordSize, FEmptySpaceFiller);
if bytesBefore=8 then
if bytesBefore=8 then //Field header
begin
totsize := Src.Size + bytesBefore + bytesAfter;
if not(FDbfVersion in [xFoxPro,xVisualFoxPro]) then
@ -454,7 +458,7 @@ end;
function TDbaseMemoFile.GetBlockLen: Integer;
begin
// Can you tell me why the header of dbase3 memo contains 1024 and is 512 ?
// answer: it is not a valid field in memo db3 header
// answer: BlockLen is not a valid field in memo db3 header
if FDbfVersion = xBaseIII then
Result := 512
else
@ -464,7 +468,7 @@ end;
function TDbaseMemoFile.GetMemoSize: Integer;
begin
// dBase4 memofiles contain a small 'header'
if PInteger(@FBuffer[0])^ = Integer(SwapIntLE($0008FFFF)) then
if (FDbfVersion<>xBaseIII) and (PInteger(@FBuffer[0])^ = Integer(SwapIntLE($0008FFFF))) then
Result := SwapIntLE(PBlockHdr(FBuffer)^.MemoSize)-8
else
Result := -1;
@ -482,7 +486,9 @@ end;
procedure TDbaseMemoFile.SetBlockLen(BlockLen: Integer);
begin
PDbtHdr(Header)^.BlockLen := SwapWordLE(BlockLen);
// DBase III does not support block sizes<>512 bytes
if (FDbfVersion<>xBaseIII) then
PDbtHdr(Header)^.BlockLen := SwapWordLE(BlockLen);
end;
// ------------------------------------------------------------------