paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 07:09:09 +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; property MemoRecordSize: Integer read FMemoRecordSize write FMemoRecordSize;
end; end;
{ TFoxProMemoFile }
// (Visual) Foxpro memo file support
TFoxProMemoFile = class(TMemoFile) TFoxProMemoFile = class(TMemoFile)
protected protected
function GetBlockLen: Integer; override; function GetBlockLen: Integer; override;
@ -54,6 +56,7 @@ type
procedure SetBlockLen(BlockLen: Integer); override; procedure SetBlockLen(BlockLen: Integer); override;
end; end;
// DBaseIII+ memo file support:
TDbaseMemoFile = class(TMemoFile) TDbaseMemoFile = class(TMemoFile)
protected protected
function GetBlockLen: Integer; override; function GetBlockLen: Integer; override;
@ -146,6 +149,7 @@ type
// memo data 8..N // memo data 8..N
end; end;
procedure TMemoFile.SetDBFVersion(AValue: TXBaseVersion); procedure TMemoFile.SetDBFVersion(AValue: TXBaseVersion);
begin begin
if FDbfVersion=AValue then Exit; if FDbfVersion=AValue then Exit;
@ -301,10 +305,10 @@ begin
end; end;
end; end;
end else begin end else begin
// dbase III memo // e.g. dbase III memo
done := false; done := false;
repeat repeat
// scan for EOF marker // scan for EOF marker/field terminator
endMemo := MemScan(FBuffer, $1A, RecordSize); endMemo := MemScan(FBuffer, $1A, RecordSize);
// EOF found? // EOF found?
if endMemo <> nil then if endMemo <> nil then
@ -313,10 +317,10 @@ begin
if (endMemo-FBuffer < RecordSize - 1) and if (endMemo-FBuffer < RecordSize - 1) and
((endMemo[1] = #$1A) or (endMemo[1] = #0)) then ((endMemo[1] = #$1A) or (endMemo[1] = #0)) then
begin begin
done := true; done := true; //found the end
numBytes := endMemo - FBuffer; numBytes := endMemo - FBuffer;
end else begin end else begin
// no, fake // no, fake ending
numBytes := RecordSize; numBytes := RecordSize;
end; end;
end else begin end else begin
@ -402,7 +406,7 @@ begin
Src.Position := 0; Src.Position := 0;
FillChar(FBuffer[0], RecordSize, FEmptySpaceFiller); FillChar(FBuffer[0], RecordSize, FEmptySpaceFiller);
if bytesBefore=8 then if bytesBefore=8 then //Field header
begin begin
totsize := Src.Size + bytesBefore + bytesAfter; totsize := Src.Size + bytesBefore + bytesAfter;
if not(FDbfVersion in [xFoxPro,xVisualFoxPro]) then if not(FDbfVersion in [xFoxPro,xVisualFoxPro]) then
@ -454,7 +458,7 @@ end;
function TDbaseMemoFile.GetBlockLen: Integer; function TDbaseMemoFile.GetBlockLen: Integer;
begin begin
// Can you tell me why the header of dbase3 memo contains 1024 and is 512 ? // 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 if FDbfVersion = xBaseIII then
Result := 512 Result := 512
else else
@ -464,7 +468,7 @@ end;
function TDbaseMemoFile.GetMemoSize: Integer; function TDbaseMemoFile.GetMemoSize: Integer;
begin begin
// dBase4 memofiles contain a small 'header' // 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 Result := SwapIntLE(PBlockHdr(FBuffer)^.MemoSize)-8
else else
Result := -1; Result := -1;
@ -482,7 +486,9 @@ end;
procedure TDbaseMemoFile.SetBlockLen(BlockLen: Integer); procedure TDbaseMemoFile.SetBlockLen(BlockLen: Integer);
begin 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; end;
// ------------------------------------------------------------------ // ------------------------------------------------------------------