← Back to branch summary

~ubuntu-branches/ubuntu/feisty/fpc/feisty

« back to all changes in this revision

Viewing changes to fcl/db/dbase/dbf_memo.pas

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2007-01-27 20:08:50 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070127200850-9mrptaqqjsx9nwa7
Tags: 2.0.4-5
* Fixed Build-Depends.
* Add myself to Uploaders in debian/control.
* Make sure that the sources are really patched before building them.
* Build unit 'libc' on powerpc too.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fcl/db/dbase/dbf_memo.pas
2
2
 
3
3
interface
4
4
 
5
 
{$I Dbf_Common.inc}
 
5
{$I dbf_common.inc}
6
6
 
7
7
uses
8
8
  Classes,
9
 
  Dbf_PgFile,
10
 
  Dbf_Common;
 
9
  dbf_pgfile,
 
10
  dbf_common;
11
11
 
12
12
type
13
13
 
95
95
implementation
96
96
 
97
97
uses
98
 
  SysUtils, Dbf_DbfFile;
 
98
  SysUtils, dbf_dbffile;
99
99
 
100
100
//====================================================================
101
101
//=== Memo and binary fields support
104
104
 
105
105
  PDbtHdr = ^rDbtHdr;
106
106
  rDbtHdr = record
107
 
    NextBlock : Longint;
 
107
    NextBlock : dword;
108
108
    Dummy     : array [4..7] of Byte;
109
109
    DbfFile   : array [0..7] of Byte;   // 8..15
110
110
    bVer      : Byte;                   // 16
115
115
 
116
116
  PFptHdr = ^rFptHdr;
117
117
  rFptHdr = record
118
 
    NextBlock : Longint;
 
118
    NextBlock : dword;
119
119
    Dummy     : array [4..5] of Byte;
120
120
    BlockLen  : Word;                   // 20..21
121
121
    Dummy3    : array [8..511] of Byte;
168
168
 
169
169
    // determine version
170
170
    if FDbfVersion = xBaseIII then
171
 
      PDbtHdr(Header).bVer := 3;
 
171
      PDbtHdr(Header)^.bVer := 3;
172
172
    VirtualLocks := false;
173
173
 
174
174
    if FileCreated or (HeaderSize = 0) then
183
183
 
184
184
    RecordSize := GetBlockLen;
185
185
    // checking for right blocksize not needed for foxpro?
186
 
    if FDbfVersion <> xFoxPro then
 
186
    // mod 128 <> 0 <-> and 0x7F <> 0
 
187
    if (RecordSize = 0) and ((FDbfVersion = xFoxPro) or ((RecordSize and $7F) <> 0)) then
187
188
    begin
188
 
      // mod 128 <> 0 <-> and 0x7F <> 0
189
 
      if (RecordSize = 0) or ((RecordSize and $7F) <> 0) then
190
 
      begin
191
 
        SetBlockLen(512);
192
 
        RecordSize := 512;
193
 
        WriteHeader;
194
 
      end;
 
189
      SetBlockLen(512);
 
190
      RecordSize := 512;
 
191
      WriteHeader;
195
192
    end;
196
193
 
197
194
    // get memory for temporary buffer
234
231
  if (BlockNo<=0) or (RecordSize=0) then
235
232
    exit;
236
233
  // read first block
237
 
  if ReadRecord(BlockNo, @FBuffer[0]) = 0 then
 
234
  numBytes := ReadRecord(BlockNo, @FBuffer[0]);
 
235
  if numBytes = 0 then
238
236
  begin
239
237
    // EOF reached?
240
238
    exit;
241
 
  end;
 
239
  end else
 
240
  if numBytes < RecordSize then
 
241
    FillChar(FBuffer[RecordSize-numBytes], numBytes, #0);
 
242
 
242
243
  bytesLeft := GetMemoSize;
243
244
  // bytesLeft <> -1 -> memo size is known (FoxPro, dBase4)
244
245
  // bytesLeft =  -1 -> memo size unknown (dBase3)
330
331
  bytesBefore: Integer;
331
332
  bytesAfter: Integer;
332
333
  totsize: Integer;
333
 
  read: Integer;
 
334
  readBytes: Integer;
334
335
  append: Boolean;
335
336
  tmpRecNo: Integer;
336
337
begin
372
373
      totsize := Src.Size + bytesBefore + bytesAfter;
373
374
      if FDbfVersion <> xFoxPro then
374
375
      begin
375
 
        PBlockHdr(FBuffer).MemoType := $0008FFFF;
376
 
        PBlockHdr(FBuffer).MemoSize := totsize;
 
376
        PBlockHdr(FBuffer)^.MemoType := $0008FFFF;
 
377
        PBlockHdr(FBuffer)^.MemoSize := totsize;
377
378
      end else begin
378
 
        PBlockHdr(FBuffer).MemoType := $01000000;
379
 
        PBlockHdr(FBuffer).MemoSize := SwapInt(Src.Size);
 
379
        PBlockHdr(FBuffer)^.MemoType := $01000000;
 
380
        PBlockHdr(FBuffer)^.MemoSize := SwapInt(Src.Size);
380
381
      end;
381
382
    end;
382
383
    repeat
383
384
      // read bytes, don't overwrite header
384
 
      read := Src.Read(FBuffer[bytesBefore], RecordSize{PDbtHdr(Header).BlockLen}-bytesBefore);
 
385
      readBytes := Src.Read(FBuffer[bytesBefore], RecordSize{PDbtHdr(Header).BlockLen}-bytesBefore);
385
386
      // end of input data reached ? check if need to write block terminators
386
 
      while (read < RecordSize - bytesBefore) and (bytesAfter > 0) do
 
387
      while (readBytes < RecordSize - bytesBefore) and (bytesAfter > 0) do
387
388
      begin
388
 
        FBuffer[read] := #$1A;
389
 
        Inc(read);
 
389
        FBuffer[readBytes] := #$1A;
 
390
        Inc(readBytes);
390
391
        Dec(bytesAfter);
391
392
      end;
392
393
      // have we read anything that is to be written?
393
 
      if read > 0 then
 
394
      if readBytes > 0 then
394
395
      begin
395
396
        // clear any unused space
396
 
        FillChar(FBuffer[bytesBefore+read], RecordSize-read-bytesBefore, ' ');
 
397
        FillChar(FBuffer[bytesBefore+readBytes], RecordSize-readBytes-bytesBefore, ' ');
397
398
        // write to disk
398
399
        WriteRecord(tmpRecNo, @FBuffer[0]);
399
400
        Inc(tmpRecNo);
422
423
  if FDbfVersion = xBaseIII then
423
424
    Result := 512
424
425
  else
425
 
    Result := PDbtHdr(Header).BlockLen;
 
426
    Result := PDbtHdr(Header)^.BlockLen;
426
427
end;
427
428
 
428
429
function  TDbaseMemoFile.GetMemoSize: Integer;
429
430
begin
430
431
  // dBase4 memofiles contain small 'header'
431
432
  if PInteger(@FBuffer[0])^ = $0008FFFF then
432
 
    Result := PBlockHdr(FBuffer).MemoSize-8
 
433
    Result := PBlockHdr(FBuffer)^.MemoSize-8
433
434
  else
434
435
    Result := -1;
435
436
end;
436
437
 
437
438
function  TDbaseMemoFile.GetNextFreeBlock: Integer;
438
439
begin
439
 
  Result := PDbtHdr(Header).NextBlock;
 
440
  Result := PDbtHdr(Header)^.NextBlock;
440
441
end;
441
442
 
442
443
procedure TDbaseMemoFile.SetNextFreeBlock(BlockNo: Integer);
443
444
begin
444
 
  PDbtHdr(Header).NextBlock := BlockNo;
 
445
  PDbtHdr(Header)^.NextBlock := BlockNo;
445
446
end;
446
447
 
447
448
procedure TDbaseMemoFile.SetBlockLen(BlockLen: Integer);
448
449
begin
449
 
  PDbtHdr(Header).BlockLen := BlockLen;
 
450
  PDbtHdr(Header)^.BlockLen := BlockLen;
450
451
end;
451
452
 
452
453
// ------------------------------------------------------------------
455
456
 
456
457
function  TFoxProMemoFile.GetBlockLen: Integer;
457
458
begin
458
 
  Result := Swap(PFptHdr(Header).BlockLen);
 
459
  Result := SwapWord(PFptHdr(Header)^.BlockLen);
459
460
end;
460
461
 
461
462
function  TFoxProMemoFile.GetMemoSize: Integer;
462
463
begin
463
 
  Result := SwapInt(PBlockHdr(FBuffer).MemoSize);
 
464
  Result := SwapInt(PBlockHdr(FBuffer)^.MemoSize);
464
465
end;
465
466
 
466
467
function  TFoxProMemoFile.GetNextFreeBlock: Integer;
467
468
begin
468
 
  Result := SwapInt(PFptHdr(Header).NextBlock);
 
469
  Result := SwapInt(PFptHdr(Header)^.NextBlock);
469
470
end;
470
471
 
471
472
procedure TFoxProMemoFile.SetNextFreeBlock(BlockNo: Integer);
472
473
begin
473
 
  PFptHdr(Header).NextBlock := SwapInt(BlockNo);
 
474
  PFptHdr(Header)^.NextBlock := SwapInt(dword(BlockNo));
474
475
end;
475
476
 
476
477
procedure TFoxProMemoFile.SetBlockLen(BlockLen: Integer);
477
478
begin
478
 
  PFptHdr(Header).BlockLen := Swap(BlockLen);
 
479
  PFptHdr(Header)^.BlockLen := SwapWord(dword(BlockLen));
479
480
end;
480
481
 
481
482
// ------------------------------------------------------------------