dbf.pas

很管用的GIS控件

    //end;
  end;
  inherited;
end;

//====================================================================
// TDbf = TDataset Descendant.
//====================================================================
constructor TDbf.Create(AOwner: TComponent); {override;}
begin
  inherited create(aOwner);
  BookmarkSize:=sizeof(rBookmarkData);

  _RunTimePath:='.';
  _IsCursorOpen:=false;
  _Indexes:=TList.Create;
  _CurIndex:=nil;
  _IndexFiles:=TStringList.Create;
end;

destructor TDbf.Destroy; {override;}
var
  i:integer;
begin
  inherited;
  _CurIndex:=nil;
  for i:=0 to _Indexes.Count-1 do begin
    TIndex(_Indexes[i]).Free;
  end;
  _Indexes.Free;
  _IndexFiles.Free;
//  _MemIndex.Free;
end;


function TDbf._FilterRecord(Buffer: PChar): Boolean;
var
  SaveState: TDatasetState;
  s:string;
begin
  Result:=True;
  if Length(easyfilter)<>0 then begin
    SetString(s,buffer,RecordSize);
    s:=LowerCase(s);
    if Pos(easyfilter,s)=0 then begin
      Result:=False;
      Exit;
    end;
  end;
  if not Assigned(OnFilterRecord) then Exit;
  if not Filtered then Exit;
  _FilterBuffer:=buffer;
  SaveState:=SetTempState(dsFilter);
  OnFilterRecord(self,Result);
  RestoreState(SaveState);
end;

function TDbf._RecordDataSize:integer;
begin
  if _dbfFile=nil then result:=0
  else result:=_dbfFile.RecordSize;
end;

function TDbf._FullRecordSize:integer;
begin
  result:=sizeof(rBeforeRecord) + _RecordDataSize + CalcFieldsSize;
end;

function TDbf.AllocRecordBuffer: PChar; {override virtual abstract from TDataset}
begin
  result:=StrAlloc(_FullRecordSize);
  InternalInitRecord(result);
end;

procedure TDbf.FreeRecordBuffer(var Buffer: PChar); {override virtual abstract from TDataset}
begin
  StrDispose(Buffer);
end;

procedure TDbf.GetBookmarkData(Buffer: PChar; Data: Pointer); {override virtual abstract from TDataset}
var
  prec:pDbfRecord;
begin
  prec:=pDbfRecord(Buffer);
  pBookMarkData(Data)^:=prec.BookMarkData;
end;

function TDbf.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; {override virtual abstract from TDataset}
var
  prec:pDbfRecord;
begin
  prec:=pDbfRecord(Buffer);
  result:=prec.BookMarkFlag;
end;

function TDbf.GetFieldData(Field: TField; Buffer: Pointer): Boolean; {override virtual abstract from TDataset}
var
	ptr:pointer;
begin
	Result := False;
	if State=dsFilter then begin
		Ptr:=_FilterBuffer;
	end else   if State = dsCalcFields then  begin
		// ***** calc fields *****  set correct buffer
		ptr := @(pDbfRecord(CalcBuffer).deletedflag);
	end else begin
		if IsEmpty then exit;
		ptr:=@(pDbfRecord(ActiveBuffer).deletedflag);
	end;

	if Field.FieldNo>0 then begin
		Result:=_dbfFile.GetFieldData(Field.FieldNo - 1,Field.DataType,ptr,Buffer);
	end else begin { calculated fields.... }
		Inc(PChar(Ptr), Field.Offset + GetRecordSize);
		Result := Boolean(PChar(Ptr)[0]);
		if Result and (Buffer <> nil) then
			Move(PChar(Ptr)[1], Buffer^, Field.DataSize);
	end;
end;


function TDbf.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; {override virtual abstract from TDataset}
var
	Acceptable : Boolean;
	prec:pDBFRecord;
begin
	prec:=pDBFRecord(Buffer);
	if _dbfFile.RecordCount < 1 then
		Result := grEOF
	else repeat
		result := grOk;
		case GetMode of
			gmCurrent :
				begin
					if prec.BookmarkData.Recno=_PhysicalRecno then begin
						exit;		// try to fasten a bit...
					end;
				end;
			gmNext :
				begin
					if _curIndex<>nil then begin
						Acceptable:=_curIndex.Next;
					end else begin
						inc(_PhysicalRecno);
						Acceptable:=(_PhysicalRecno<_dbfFile.RecordCount);
					end;
					if Acceptable then begin
						result:= grOk;
					end else begin
						InternalLast;
						result:= grEOF
					end;
				end;
			gmPrior :
				begin
					if _curIndex<>nil then begin
						Acceptable:=_curIndex.Prev;
					end else begin
						dec(_PhysicalRecno);
						Acceptable:=(_PhysicalRecno>=0);
					end;
					if Acceptable then begin
						result:= grOk;
					end else begin
						InternalFirst;
						result:= grBOF
					end;
				end;
		end;
		if result=grOk then begin
			if _curIndex<>nil then _PhysicalRecno:=_CurIndex.GetRealRecNo;
			if (_PhysicalRecno>=_dbfFile.RecordCount)
				or (_PhysicalRecno<0) then begin
				result:=grError;
			end else begin
				_dbfFile.ReadRecord(_PhysicalRecno,@prec.DeletedFlag);
				result:=grOk;
			end;
			if Result = grOK then begin
				ClearCalcFields(Buffer);
				GetCalcFields(Buffer);
				prec.BookmarkFlag := bfCurrent;
				prec.BookmarkData.Recno:=PhysicalRecno;
			end else if (Result = grError) and DoCheck then
					raise eBinaryDataSetError.Create ('GetRecord: Invalid record');
		end;
		Acceptable := (_ShowDeleted or (prec.DeletedFlag = ' '))
			and _FilterRecord(Buffer);
		if (GetMode=gmCurrent) and Not Acceptable then Result := grError;
	until (Result <> grOK) or Acceptable;
end;

function TDbf.GetRecordSize: Word; {override virtual abstract from TDataset}
begin
	Result := _RecordDataSize; // data only
end;

procedure TDbf.InternalAddRecord(Buffer: Pointer; Append: Boolean); {override virtual abstract from TDataset}
begin
end;

procedure TDbf.InternalClose; {override virtual abstract from TDataset}
begin
  _CloseFiles;

  // disconnect field objects
  BindFields(False);
  // destroy field object (if not persistent)
  if DefaultFields then
    DestroyFields;
end;

procedure TDbf.InternalDelete; {override virtual abstract from TDataset}
begin
//  CheckActive;
  pRecordHdr(ActiveBuffer)^.DeletedFlag := '*'; //_DataHdr.LastDeleted;
  _dbfFile.WriteRecord(_PhysicalRecNo,ActiveBuffer);
  Resync([]);
end;

procedure TDbf.InternalFirst; {override virtual abstract from TDataset}
begin
  if _dbfFile.RecordCount=0 then InternalLast
  else if _curindex=nil then _PhysicalRecno:=-1
  else _curIndex.First;
end;

procedure TDbf.InternalGotoBookmark(Bookmark: Pointer); {override virtual abstract from TDataset}
var
	RecInfo: TRecInfo;
begin
	RecInfo := TRecInfo(Bookmark^);
	if (RecInfo.Bookmark >= 0) and (RecInfo.Bookmark < _dbfFile.RecordCount) then begin
		_PhysicalRecno:=RecInfo.Bookmark;
	end else
		raise eBinaryDataSetError.Create ('Bookmark ' +
			IntToStr (RecInfo.Bookmark) + ' not found');
end;

procedure TDbf.InternalHandleException; {override virtual abstract from TDataset}
begin
	Application.HandleException(Self);
end;

procedure TDbf.InternalInitFieldDefs; {override virtual abstract from TDataset}
begin
	FieldDefs.Clear;
	with FieldDefs do
	begin
		if IsCursorOpen  then begin
			_dbfFile.CreateFieldDefs(FieldDefs);
    end else begin
      _OpenFiles(false);
      _dbfFile.CreateFieldDefs(FieldDefs);
      Close();
    end;
  end;
end;

procedure TDbf.InternalInitRecord(Buffer: PChar); {override virtual abstract from TDataset}
var
  prec:pDbfRecord;
begin
  prec:=pDbfRecord(Buffer);
	prec.BookmarkData.RecNo:=-1;
  prec.BookmarkFlag:=TBookmarkFlag(0);
  fillchar(prec.DeletedFlag,_RecordDataSize,' ');
end;

procedure TDbf.InternalLast; {override virtual abstract from TDataset}
begin
  if _curindex=nil then _PhysicalRecno:=_dbfFile.RecordCount
  else _curIndex.Last;
end;

procedure TDbf.InternalOpen; {override virtual abstract from TDataset}
begin
  _OpenFiles(false);
  // if there are no persistent field objects,
  InternalInitFieldDefs;
  // create the fields dynamically
  if DefaultFields then begin
    CreateFields;
  end;
  BindFields (True);
  // connect the TField objects with the actual fields

  InternalFirst;
end;

procedure TDbf.InternalPost; {override virtual abstract from TDataset}
var
  prec:pDbfRecord;
  lIndex:TIndex;
  i:integer;
begin
	CheckActive;
	prec:=pDbfRecord(ActiveBuffer);
	prec.DeletedFlag:=' ';

	if State = dsEdit then
	begin
		// replace data with new data
		if _indexes.Count>0 then begin
			_dbfFile.ReadRecord(_PhysicalRecno,_PrevBuffer);
			for i:=0 to _indexes.Count-1 do begin
				lindex:=TIndex(_indexes.Items[i]);
				lindex.Update(_PhysicalRecno,_PrevBuffer,@prec.DeletedFlag);
			end;
		end;
	end else begin
		// append
		_PhysicalRecno:=_dbfFile._DataHdr.RecordCount;
		inc(_dbfFile._DataHdr.RecordCount);
		if _indexes.Count>0 then begin
			_dbfFile.ReadRecord(_PhysicalRecno,_PrevBuffer);
			for i:=0 to _indexes.Count-1 do begin
				lindex:=TIndex(_indexes.Items[i]);
				lindex.Insert(_PhysicalRecno,@prec.DeletedFlag);
			end;
		end;
	end;
	_dbfFile.WriteRecord(_PhysicalRecno,@prec.DeletedFlag);
end;


procedure TDbf.CreateTable; //(FieldDefs:TFieldDefs);
var
	ix:integer;
begin
	CheckInactive;
	//  InternalInitFieldDefs;
	if FieldDefs.Count = 0 then
	begin
		for Ix := 0 to FieldCount - 1 do
		begin
      with Fields[Ix] do
      begin
        if FieldKind = fkData then
          FieldDefs.Add(FieldName,DataType,Size,Required);
      end;
    end;
  end;
  _OpenFiles(true);
  try
    _dbfFile.DbfFile_CreateTable(FieldDefs);
  finally
    // close the file
    _CloseFiles;
  end;
end;

procedure TDbf.PackTable;
begin
	_dbfFile.dbfFile_PackTable;
	Resync([]);
end;


function TDbf.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; {override virtual}
var
  Memoi:array[1..32] of char;
  lBlob:TMyBlobFile;
begin
  lBlob:=TMyBlobFile.Create(Mode,Field);
  if _dbfFile.GetFieldData(Field.FieldNo-1, ftString,@pDbfRecord(ActiveBuffer).deletedflag,@Memoi[1]) then begin
    lBlob.MemoRecno:=StrToIntDef(Memoi,0);
    _dbtFile.ReadMemo(lBlob.MemoRecno,lBlob);
    lBlob.ReadSize:=lBlob.Size;
  end else lBlob.MemoRecno:=0;
  Result:=lBlob;
end;

{$ifdef DELPHI_3}
procedure TDbf.Translate(Src, Dest: PChar; ToOem: Boolean); {override virtual}
begin
  if (Src <> nil) and (Dest<>nil) then begin
    if ToOem then CharToOem(Src,Dest)
    else OemToChar(Src,Dest);
  end;
end;
{$else}
function TDbf.Translate(Src, Dest: PChar; ToOem: Boolean): Integer; {override virtual}
begin
  if (Src <> nil) and (Dest<>nil) then begin
    if ToOem then CharToOem(Src,Dest)
    else OemToChar(Src,Dest);
    result:= StrLen(Dest);
  end else result:=0;
end;
{$endif}

procedure TDbf.ClearCalcFields(Buffer: PChar);
begin
  FillChar(Buffer[_dbfFile.RecordSize], CalcFieldsSize, 0);
end;

procedure TDbf.InternalSetToRecord(Buffer: PChar); {override virtual abstract from TDataset}
var
	prec:pDbfRecord;
begin
	if Buffer=nil then exit;
	prec:=pDbfRecord(Buffer);
	_PhysicalRecno:=prec.BookmarkData.RecNo;
  _ResyncIndexes(Buffer);
end;

procedure TDbf._ResyncIndexes(Buffer: PChar);
var
  i:integer;
  lindex:TIndex;
begin
  if _indexes.Count>0 then begin
    _dbfFile.ReadRecord(_PhysicalRecno,_PrevBuffer);
    for i:=0 to _indexes.Count-1 do begin
      lindex:=TIndex(_indexes.Items[i]);
      lindex.GotoKey(_physicalRecno,nil);
    end;
  end;
end;

function TDbf.IsCursorOpen: Boolean; {override virtual abstract from TDataset}
begin
  result:=_IsCursorOpen;
end;

procedure TDbf.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); {override virtual abstract from TDataset}
var
  prec:pDbfRecord;
begin
  prec:=pDbfRecord(Buffer);
  prec.BookMarkFlag:=Value;
end;

procedure TDbf.SetBookmarkData(Buffer: PChar; Data: Pointer); {override virtual abstract from TDataset}
var
  prec:pDbfRecord;
begin
  prec:=pDbfRecord(Buffer);
  prec.BookMarkData:=pBookMarkData(Data)^;
end;

procedure TDbf.SetFieldData(Field: TField; Buffer: Pointer); {override virtual abstract from TDataset}
var
  prec:pDbfRecord;
	dst:pointer;
begin
	if (Field.FieldNo >= 0) then begin
		prec:=pDbfRecord(ActiveBuffer);
		dst:=@prec.DeletedFlag;
		_dbfFile.SetFieldData(Field.FieldNo - 1,Field.DataType,Buffer,Dst);
	end else begin    { ***** fkCalculated, fkLookup ***** }
		prec:=pDbfRecord(CalcBuffer);
		dst:=@prec.DeletedFlag;
		Inc(integer(dst), GetRecordSize + Field.Offset);
		Boolean(dst^) := LongBool(Buffer);
		if Boolean(dst^) then begin