dbf.pas

很管用的GIS控件

			Inc(integer(dst), 1);
			Move(Buffer^, dst^, Field.DataSize);
		end;
	end;     { end of ***** fkCalculated, fkLookup ***** }
	if not (State in [dsCalcFields, dsFilter, dsNewValue]) then begin
		DataEvent(deFieldChange, Longint(Field));
	end;
end;


// this function is just for the grid scrollbars
// it doesn't have to be perfectly accurate, but fast.
function TDbf.GetRecordCount: Integer; {override virtual}
begin
  if _curIndex=nil then begin
    result:=_dbfFile.RecordCount;
  end else begin
    result:=_curIndex.GuessRecordCount;
	end;
end;

// this function is just for the grid scrollbars
// it doesn't have to be perfectly accurate, but fast.
function TDbf.GetRecNo: Integer; {override virtual}
begin
	UpdateCursorPos;
	if _curIndex=nil then begin
		result:=_PhysicalRecno+1;
	end else begin
		result:=_curIndex.GuessRecNo;
	end;
end;

procedure TDbf.SetRecNo(Value: Integer); {override virual}
begin
	if _curIndex=nil then begin
		_PhysicalRecno:=Value-1;
	end else begin
		//result:=_curIndex.GuessRecNo;
	end;
	Resync([rmExact]);
end;

procedure TDBf.DeleteIndex(const Name: string);
begin
	// I must admit that is seems a bit expeditive.
	// but I does implement this method because TTable does
	DeleteFile(_GetPath + Name);
end;

procedure TDbf.CloseIndexFile(const IndexFileName: string);
var
	lindex:tindex;
begin
	lindex:=_GetIndex(IndexFileName);
	if lindex<>nil then begin
    lindex.Free;
    _indexes.Delete(_indexes.IndexOf(lindex));
    if _curindex = lindex then begin
      _curindex:=nil;
      resync([]);
    end;
  end;
end;

procedure TDbf.OpenIndexFile(IndexName:string);
var
  lIndexFile:TIndexFile;
  lIndex:TIndex;
begin
  lindex:=_GetIndex(IndexName);
  if lindex=nil then begin
    IndexName:=lowercase(_GetPath + IndexName);
    lIndexFile:=TIndexFile(GetPagedFile(IndexName));
    if lIndexFile=nil then begin
      lIndexFile:=TIndexFile.Create(IndexName,fmOpenReadWrite + fmShareDenyWrite);
    end;
    lIndex:=TIndex.Create(lIndexFile,0,false);
    _Indexes.Add(lIndex);
    lIndex.InitFieldDef(_DbfFile,lIndex._NdxHdr.KeyDesc);
  end;
end;

(*
procedure TDbfFile.DbfFile_PackTable;
var
begin
end;
*)
{$ifdef DELPHI_3}
procedure TDbf.AddIndex(const IndexName, Fields: String; Options: TIndexOptions);
var
  DescFields:string;
{$else}
procedure TDbf.AddIndex(const IndexName, Fields: String; Options: TIndexOptions; const DescFields: String='');
var
{$endif}
  lfilename:string;
  lIndexFile:TIndexFile;
  lIndex:TIndex;
  cur,last:integer;
begin
  lfilename:=lowercase(_GetPath+IndexName);
  lIndexFile:=TIndexFile(GetPagedFile(lfilename));
  if lIndexFile<>nil then exit;
  lIndexFile:=TIndexFile.Create(lfilename,fmCreate);
  lIndex:=TIndex.Create(lIndexFile,0,true);
  lIndex.InitFieldDef(_DbfFile,Fields);
  with lIndex._NdxHdr do begin
    startpage:=1;
    nbPage:=1;
    keyformat:=#0;
    keytype:='C';
    dummy:=$5800;
    keylen:=lindex._FieldLen;
    nbkey:=(512-8) div (lindex._FieldLen+8);
    keyreclen:=lindex._FieldLen+8;
    Unique:=0;
    KeyDesc[0]:=' ';
    StrLCopy(KeyDesc,PChar(UpperCase(Fields)),255);
  end;
  lindex._IndexFile._Seek(lindex._RootPage);
  lindex._IndexFile.Stream.Write(lindex._NdxHdr,SizeOf(lindex._NdxHdr));

  cur:=0;
  last:=_DbfFile.CalcRecordCount;

  while cur<last do begin
    _DbfFile.ReadRecord(cur, _PrevBuffer);
    lIndex.Insert(cur,_PrevBuffer);
    inc(cur);
  end;
  _Indexes.Add(lIndex);
end;

function TDbf.Deleted: Boolean;
begin
  CheckActive;
  Result:= pRecordHdr(ActiveBuffer)^.DeletedFlag = '*';
end;

procedure TDbf.Recall;
begin
//  CheckActive;
  if not Deleted then exit;
  pRecordHdr(ActiveBuffer)^.DeletedFlag := ' ';
  _dbfFile.WriteRecord(_PhysicalRecNo,ActiveBuffer);
  Resync([]);
end;


//==========================================================
//============ dbtfile
//==========================================================
constructor TDbtFile.Create(const FileName: string; Mode: Word; Ver:xBaseVersion);
begin
  inherited Create(FileName,Mode);
  _DbtVersion:=Ver;
  if mode = fmCreate then begin
    FillChar(_MemoHdr,sizeof(_MemoHdr),0);
  end else begin
    Stream.Position:=0;
    Stream.read(_MemoHdr,SizeOf(_MemoHdr));
  end;
  HeaderSize:=0;
  RecordSize:=_MemoHdr.BlockLen;

  if (RecordSize=0) or ((RecordSize mod 128)<>0) then begin
    _MemoHdr.BlockLen := $200;
    RecordSize := $200;
  end;
  // Can you tell me why the header of dbase3 memo contains 1024 and it 512 ?
  if _DbtVersion=xBaseIII then RecordSize:=512;
end;

procedure TDbtFile.ReadMemo(recno:Integer;Dst:TStream);
var
  Buff:array[0..511] of char;
  i,lsize:integer;
  finish:boolean;
  lastc:char;
begin
  if recno=0 then Exit;
  Stream.Position:= RecordSize * recno;
  if _DbtVersion >= xBaseIV then begin // dBase4 memofiles
    Stream.read(Buff[0],8);
    if (Buff[0]=#$ff) and  (Buff[1]=#$ff) and
      (Buff[2]=#$08) and (Buff[3]=#$00) then begin
          // dbase IV memo
      lsize:=(PInteger(@Buff[4])^)-8;
    end else begin
      lsize:=0;
    end;
    repeat
      if lsize>SizeOf(Buff) then begin
        Stream.read(Buff,SizeOf(Buff));
        Dst.Write(buff,SizeOf(Buff));
        Dec(lsize,SizeOf(Buff));
      end else if lsize>0 then begin
        Stream.read(Buff,lsize);
        Dst.Write(buff,lsize);
        lsize:=0;
      end;
    until lsize=0;
  end else begin
    finish:=False;
    Stream.read(Buff,SizeOf(Buff));
    lastc:=#0;
    repeat
      for i:=0 to SizeOf(Buff)-2 do begin
        if ((Buff[i]=#$1A) and
          ((Buff[i+1]=#$1A) or ((i=0) and (lastc=#$1A))))
          or (Buff[i]=#$0)
          then begin
          if i>0 then Dst.Write(buff,i);
          finish:=True;
          break;
        end;
      end;
      if finish then Break;
      Dst.Write(buff,512);
      lastc:=Buff[511];
      Stream.read(Buff,SizeOf(Buff));
    until finish;
  end;
  Dst.Seek(0,0);
end;

procedure TDbtFile.WriteMemo(var MemoRecno:Integer;ReadSize:Integer;Src:TStream);
var
  ByteBefore:Integer;
  ByteAfter:Integer;
  Buff:array[0..511] of char;
  i:Integer;
  c:Byte;
  Append:Boolean;
begin
  if _DbtVersion >= xBaseIV then begin // dBase4 memofiles
    ByteBefore:=8;
    ByteAfter:=0;
  end else begin // stupid files
    ByteBefore:=0;
    ByteAfter:=2;
  end;
  if Src.Size = 0 then begin
    MemoRecno:=0;
  end else begin
    if ((ByteBefore+Src.Size+ByteAfter+_MemoHdr.BlockLen-1) div _MemoHdr.BlockLen)
      <= ((ReadSize+_MemoHdr.BlockLen-1) div _MemoHdr.BlockLen)
      then begin
      Append:=false;
      //MemoRecno:=MemoRecno;
    end else begin
      Append:=True;
      MemoRecno:=_MemoHdr.NextBlock;
      if MemoRecno=0 then begin
        _MemoHdr.NextBlock:=1;
        MemoRecno:=1;
      end;
    end;
    Stream.Seek(_MemoHdr.BlockLen * MemoRecno,0);
    i:=Src.Position;
    Src.Seek(0,0);
    if ByteBefore=8 then begin
      i:=$0008ffff;
      Stream.Write(i,4);
      i:=Src.Size+ByteBefore+ByteAfter;
      Stream.Write(i,4);
    end;
    repeat
      i:=Src.Read(buff,512);
      if i=0 then break;
      Inc(_MemoHdr.NextBlock);
      Stream.Write(Buff,i);
    until i<512;
    if ByteAfter=2 then begin
      c:=$1A;
      Stream.Write(c,1);
      Stream.Write(c,1);
    end;
    if Append then begin
      Stream.Seek(0,0);
      Stream.Write(_MemoHdr,SizeOf(_MemoHdr))
    end;
  end;
end;

//==========================================================
//============ TIndexFile
//==========================================================
constructor TIndexFile.Create(const FileName: string; Mode: Word);
var
  ext:string;
  i:Integer;
begin
  inherited Create(FileName,Mode);
  HeaderSize:=0;
  RecordSize:=512;

  ext:=ExtractFileExt(FileName);
  if (ext='.mdx') then begin
    _IndexVersion:=xBaseIV;
    if Mode = fmCreate then begin
      FillChar(_MdxHdr,sizeof(_MdxHdr),0);
    end else begin
      Stream.read(_MdxHdr,SizeOf(_MdxHdr));
    end;
    for i:= 0 to _MdxHdr.TagUsed-1 do begin
//      Stream.Position :=544 + i * _MdxHdr.TagSize;
//      Stream.read(lMdxTag,SizeOf(rMdxTag));
//      lIndex:=TIndex.Create(Self,lMdxTag.pageno);
//      _Indexes.Add(lIndex);
//      if i=0 then lIndex.ReadPage(lIndex._NdxHdr.startpage);
    end;
  end else begin
    _IndexVersion:=xBaseIII;
(*
      _IndexFile._Seek(Pos);
      _IndexFile.Stream.Read(_NdxHdr,SizeOf(_NdxHdr));
      _Root:=TIndexPage.Create(Self);
      _Root.SetPageNo(_NdxHdr.startpage);
      lPos:=_Root;
      _nblevel:=1;
      repeat
        lPos.LocalFirst;
        if lPos.Entry._LowerPage=0 then break;
        inc(_nblevel);
    lChild:=TIndexPage.Create(Self);
    lChild._UpperLevel:=lPos;
    lPos._LowerLevel:=lChild;
    lChild.SetPageNo(lPos.Entry._LowerPage);
    lPos:=lChild;
  until false;

  _Spare:=TIndexPage.Create(Self);
//  _Field:=_IndexFile._Dbf.FindField(_NdxHdr.KeyDesc);
  First;
*)
  end;
end;

destructor TIndexFile.Destroy;
begin
  inherited;
end;

//==========================================================
//============ TIndexPage
//==========================================================
constructor TIndexPage.Create(Parent:TIndex);
begin
  _LowerLevel:=nil;
  _UpperLevel:=nil;
  _Index:=Parent;
  _PageNo:=-1;
  _EntryNo:=-1;
end;

destructor TIndexPage.Destroy;
begin
  if _LowerLevel<>nil then _LowerLevel.Free;
end;

function  TIndexPage.GetPEntry(EntryNo:integer):PNdxEntry;
begin
  Result:=PNdxentry(@_PageBuff.Entries[_Index._NdxHdr.keyreclen*entryno]);
end;

function  TIndexPage.LocalInsert(Recno:integer; Buffer:Pchar;LowerPage:integer):boolean;
var
  src,dst:pointer;
  siz:integer;
begin
  if _PageBuff.NbEntries < _Index._NdxHdr.nbkey then begin
    src:=Entry;
    dst:=GetPEntry(_EntryNo+1);
    siz:=(_PageBuff.NbEntries - _EntryNo)
      * _Index._NdxHdr.keyreclen + 8;
    Move(Src^, Dst^, Siz);
    inc(_PageBuff.NbEntries);
    SetEntry(Recno,Buffer,LowerPage);
    Write;
    Result:=true;
  end else begin
    Result:=false;
  end;
end;


function  TIndexPage.LocalDelete:boolean;
var
  src,dst:pointer;
  siz:integer;
begin
  if _PageBuff.NbEntries >=0 then begin
    if _EntryNo<_PageBuff.NbEntries then begin
      src:=GetPEntry(_EntryNo+1);
      dst:=Entry;
      siz:=(_PageBuff.NbEntries - _EntryNo - 1)
        * _Index._NdxHdr.keyreclen + 8;
      Move(Src^, Dst^, Siz);
    end;
    dec(_PageBuff.NbEntries);
    Write;
    if ((_PageBuff.NbEntries=0) and (_lowerlevel=nil))
      or (_PageBuff.NbEntries<0) then begin
      if _UpperLevel<>nil then begin
        _UpperLevel.LocalDelete;
      end;
    end else if (_EntryNo>LastEntryNo) then begin
      SetEntryNo(LastEntryNo); // We just removed the last on this page.
      if (_UpperLevel<>nil)  then begin
        _UpperLevel.SetEntry(0,Entry.CKey,_PageNo);
      end;
    end;
    Result:=true;
  end else begin
    Result:=false;
  end;
end;

function  TIndexPage.LastEntryNo:integer;
begin
  if (_LowerLevel=nil) then begin
    result := _PageBuff.NbEntries - 1;
  end else begin
    result := _PageBuff.NbEntries;
  end;
end;

procedure TIndexPage.LocalFirst;
begin
  SetEntryNo(0);
end;

procedure TIndexPage.LocalLast;
begin
  SetEntryNo(LastEntryNo);
end;

function TIndexPage.LocalPrev:boolean;
begin
  if _EntryNo>0 then begin
    SetEntryNo(_EntryNo-1);
    Result:=true;
  end else begin
    Result:=false;
  end;
end;

function TIndexPage.LocalNext:boolean;
begin
  if (_EntryNo<LastEntryNo) then begin
    SetEntryNo(_EntryNo+1);
    Result:=true;
  end else begi