其他

开发平台：
Delphi

DBF.pas：源码内容
							unit DBF;
(* ===========================================================================
 * dbf.dcu - tDBF : A custom data set which uses a flat binary
 *             structured datafile for single client usage only.
 *
 * Author:  Horacio Jamilis
 * Copyright (C) 1998, Terabyte Computacion
 *
 * ===========================================================================
 * v 0.91
 * - Fixed error on deleting records
 * - Added filtering capabilities (work wrong when there are no records within
 *   the filter expresion - Only support expresion with one field like
 *   "NUMFIELD>10" or "TEXTFIELD<='TEST'" or "DATEFIELD=19980626"
 *   (in yyyymmdd format)).
 * ===========================================================================
 * FOR C++ Builder users:
 * Use the file named DBF_C instead of this one.
 * Especial thanks to Michael Beauregard (Michael_Beauregard@mck.com).
 * ===========================================================================
 *)
interface
uses
  SysUtils, Classes, Db, DsgnIntf;
type
  TFilenameProperty = class(TStringProperty)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
  end;
  EDBFError = class (Exception);
  pDateTime = ^TDateTime;
  pBoolean = ^Boolean;
  pInteger = ^Integer;
  PRecInfo = ^TRecInfo;
  TRecInfo = record
    Bookmark: Longint;
    BookmarkFlag: TBookmarkFlag;
  end;
  TdbfHeader = record  { Dbase III + header definition        }
     VersionNumber    :byte;  { version number (03h or 83h ) }
     LastUpdateYear   :byte;  { last update YY MM DD         }
     LastUpdateMonth  :byte;
     LastUpdateDay    :byte;
     NumberOfRecords  :longint; { number of record in database }
     BytesInHeader    :smallint;{ number of bytes in header }
     BytesInRecords   :smallint;{ number of bytes in records }
     ReservedInHeader :array[1..20] of char;   { reserved bytes in header }
  end;
  TdbfField = record
     FieldName   :array[1..11] of char; { Name of this record             }
     FieldType   :char;           { type of record - C,N,D,L,etc.         }
     fld_addr    :longint;        { not used }
     Width       :byte;           { total field width of this record      }
     Decimals    :byte;           { number of digits to right of decimal  }
     MultiUser   :smallint;       { reserved for multi user }
     WorkAreaID  :byte;           { Work area ID }
     MUser       :smallint;       { reserved for multi_user }
     SetFields   :byte;           { SET_FIELDS flag }
     Reserved    :array[1..4] of byte;      { 8 bytes reserved }
  end;                           { record starts                         }
Type
  pRecordHeader = ^tRecordHeader;
  tRecordHeader = record
    DeletedFlag : char;
  end;
type
  TDBF = class(TDataSet)
  protected
    FStream: TStream; // the physical table
    FTableName: string; // table path and file name
    fDBFHeader : TdbfHeader;
    // record data
    fRecordHeaderSize : Integer;   // The size of the record header
    FRecordCount,                  // current number of record
    FRecordSize,                   // the size of the actual data
    FRecordBufferSize,             // data + housekeeping (TRecInfo)
    FRecordInfoOffset,             // offset of RecInfo in record buffer
    FCurrentRecord,                // current record (0 to FRecordCount - 1)
    BofCrack,                      // before the first record (crack)
    EofCrack: Integer;             // after the last record (crack)
    FIsTableOpen: Boolean;         // status
    FFileWidth,                    // field widths in record
    FFileDecimals,                 // field decimals in record
    FFileOffset: TList;            // field offsets in record
    fReadOnly : Boolean;           // Enhancements
    fStartData : Integer;          // Position in file where data starts
    function FFieldType(F : char):TFieldType;
    function FFieldSize(FType:char;FWidth:integer):integer;
  protected
    // TDataSet virtual abstract method
    function AllocRecordBuffer: PChar; override;
    procedure FreeRecordBuffer(var Buffer: PChar); override;
    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
    function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
    function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
    function GetRecordSize: Word; override;
    procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
    procedure InternalClose; override;
    procedure InternalDelete; override;
    procedure InternalFirst; override;
    procedure InternalGotoBookmark(Bookmark: Pointer); override;
    procedure InternalHandleException; override;
    procedure InternalInitFieldDefs; override;
    procedure InternalInitRecord(Buffer: PChar); override;
    procedure InternalLast; override;
    procedure InternalOpen; override;
    procedure InternalPost; override;
    procedure InternalSetToRecord(Buffer: PChar); override;
    function IsCursorOpen: Boolean; override;
    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
    procedure SetFieldData(Field: TField; Buffer: Pointer); override;
    // TDataSet virtual method (optional)
    function GetRecordCount: Integer; override;
    procedure SetRecNo(Value: Integer); override;
    function GetRecNo: Integer; override;
    Procedure WriteHeader;
  private
    Procedure _ReadRecord(Buffer:PChar;IntRecNum:Integer);
    Procedure _WriteRecord(Buffer:PChar;IntRecNum:Integer);
    Procedure _AppendRecord(Buffer:PChar);
    Procedure _SwapRecords(Rec1,REc2:Integer);
    Function _CompareRecords(SortFields:Array of String;Rec1,Rec2:Integer):Integer;
    Function _ProcessFilter(Buffer:PChar):boolean;
  public
    constructor Create(AOwner:tComponent); override;
    procedure CreateTable;
    Procedure PackTable;
    Procedure SortTable(SortFields : Array of String);
    Procedure UnsortTable;
  published
    property TableName: string read FTableName write FTableName;
    property ReadOnly : Boolean read fReadOnly write fReadonly default False;
    property DBFHeader : tDBFHeader read fDBFHeader;
    // redeclared data set properties
    property Active;
    property Filter;
    property Filtered;
    property BeforeOpen;
    property AfterOpen;
    property BeforeClose;
    property AfterClose;
    property BeforeInsert;
    property AfterInsert;
    property BeforeEdit;
    property AfterEdit;
    property BeforePost;
    property AfterPost;
    property BeforeCancel;
    property AfterCancel;
    property BeforeDelete;
    property AfterDelete;
    property BeforeScroll;
    property AfterScroll;
    property OnCalcFields;
    property OnDeleteError;
    property OnEditError;
    property OnNewRecord;
    property OnPostError;
  end;
procedure Register;
implementation
uses
  TypInfo, Dialogs, Windows, Forms, Controls, IniFiles;
Const
  dfhVersionNumber = 13;
TYPE
  PBufArray = ^BufArray;
  BufArray = Array[0..0] of Char;
// ****************************************************************************
// Low Level Routines for accessing an internal record
// ____________________________________________________________________________
// TDBF._ReadRecord
Procedure TDBF._ReadRecord(Buffer:PChar;IntRecNum:Integer);
  {-Read a record based on the internal record number (absolute)}
BEGIN
  FStream.Position := FStartData + (FRecordSize * IntRecNum);
 try
  FStream.ReadBuffer(Buffer^, FRecordSize);
 except
 end;
END;
// ____________________________________________________________________________
// TDBF._WriteRecord
Procedure TDBF._WriteRecord(Buffer:PChar;IntRecNum:Integer);
  {-Write a record based on the internal record number (absolute)}
BEGIN
  FStream.Position := FStartData + (FRecordSize * IntRecNum);
  FStream.WriteBuffer (Buffer^, FRecordSize);
END;
// ____________________________________________________________________________
// TDBF._AppendRecord
Procedure TDBF._AppendRecord(Buffer:PChar);
BEGIN
  FStream.Position := FStartData + (FRecordSize * (FRecordCount{+FDeletedCount}));
  FStream.WriteBuffer (Buffer^, FRecordSize);
END;
/////////////////////////////////////////////////
////// Part I:
////// Initialization, opening, and closing
/////////////////////////////////////////////////
// ____________________________________________________________________________
// TDBF.InternalOpen
// I: open the table/file
procedure TDBF.InternalOpen;
var
  Field : TField;
  i,j : integer;
  d : string;
begin
  // check if the file exists
  if not FileExists (FTableName) then
    raise eDBFError.Create ('Open: Table file not found');
  // create a stream for the file
  if fReadOnly then
    fStream := tFileStream.Create( fTableName, fmOpenRead + fmShareDenyWrite)
  else
    FStream := TFileStream.Create (FTableName, fmOpenReadWrite + fmShareExclusive);
  fStream.ReadBuffer(fDBFHeader,SizeOf(TDBFHeader));
  // sets cracks and record position
  BofCrack := -1;
  EofCrack := fRecordCount{+fDeletedCount};
  FCurrentRecord := BofCrack;
  // set the bookmark size
  BookmarkSize := sizeOf (Integer);
  if not (assigned(FFileOffset)) then
    FFileOffset := TList.Create;
  if not (assigned(FFileWidth)) then
    FFileWidth := TList.Create;
  if not (assigned(FFileDecimals)) then
    FFileDecimals := TList.Create;
  // initialize the field definitions
  // (another virtual abstract method of TDataSet)
  InternalInitFieldDefs;
  FRecordInfoOffset := FRecordSize;
  FRecordBufferSize := FRecordSize + sizeof (TRecInfo);
  // if there are no persistent field objects,
  // create the fields dynamically
  if DefaultFields then
    CreateFields;
  // connect the TField objects with the actual fields
  BindFields (True);
  for i := 0 to FieldCount-1 do
    begin
      Field := Fields[i];
      if (Field.DataType = ftFloat) and (Integer(FFileDecimals[i])>0) then
        begin
          d := '0.';
          for j := 1 to Integer(FFileDecimals[i]) do
            d := d + '0';
          (Field as TFloatField).DisplayFormat := d;
        end;
    end;
  // get the number of records and check size
  fRecordCount := fDBFHeader.NumberOfRecords;
  // everything OK: table is now open
  FIsTableOpen := True;
  // ShowMessage ('InternalOpen: RecCount: ' + IntToStr (FRecordCount));
end;
// Returns the Type of the field
function TDBF.FFieldType(F : char):TFieldType;
begin
  if F = 'C' then
    FFieldType := ftString
  else if (F = 'N') or (F = 'F') then
    FFieldType := ftFloat
  else if F = 'L' then
    FFieldType := ftBoolean
  else if F = 'D' then
    FFieldType := ftDate
//    FFieldType := ftString
  else
    FFieldType := ftUnknown;
end;
function TDBF.FFieldSize(FType:char;FWidth:integer):integer;
begin
  if FType = 'C' then
    FFieldSize := FWidth
  else if (FType = 'N') or (FType = 'F') then
    FFieldSize := 0
  else if FType = 'L' then
    FFieldSize := 0
  else if FType = 'D' then
    FFieldSize := 0
//    FFieldSize := 8
  else
    FFieldSize := 0;
end;
// ____________________________________________________________________________
// TDBF.InternalInitFieldDefs
// I: define the fields
procedure TDBF.InternalInitFieldDefs;
var
  Il : Integer;
  TmpFileOffset : Integer;
  NumberOfFields : integer;
  Fld : TDBFField;
  FldName : PChar;
begin
  FieldDefs.Clear;
  FStream.Seek(SizeOf(TDbfHeader),soFromBeginning);
  NumberOfFields := ((fDbfHeader.BytesInHeader-sizeof(DbfHeader))div 32);
  if not (assigned(FFileOffset)) then
    FFileOffset := TList.Create;
  FFileOffset.Clear;
  if not (assigned(FFileWidth)) then
    FFileWidth := TList.Create;
  FFileWidth.Clear;
  if not (assigned(FFileDecimals)) then
    FFileDecimals := TList.Create;
  FFileDecimals.Clear;
  TmpFileOffset := 0;
  if (NumberOfFields>0) then
    begin
      for Il:=0 to NumberOfFields-1 do
        begin
          FStream.Read(Fld,SizeOf(Fld));
          GetMem(FldName,Length(Fld.FieldName)+1);
          CharToOem(PChar(@Fld.FieldName),FldName);
          TFieldDef.Create(FieldDefs, FldName,FFieldType(Fld.FieldType){DescribF.DataType},
                           FFieldSize(Fld.FieldType,Fld.Width){DescribF.Size},False,Il+1);
          FreeMem(FldName);
          FFileOffset.Add(Pointer(TmpFileOffset));
          FFileWidth.Add(Pointer(Fld.Width));
          FFileDecimals.Add(Pointer(Fld.Decimals));
          Inc(tmpFileOffset,Fld.Width);
        end;
      fRecordSize := tmpFileOffset+FrecordHeaderSize;
      FStartData := FStream.Position+1;
    end;
end;
// ____________________________________________________________________________
// TDBF.InternalClose
// I: close the table/file
procedure TDBF.InternalClose;
begin
  // if required, save updated header
  if (fDBFHeader.NumberOfRecords <> fRecordCount) or
    (fDBFHeader.BytesInRecords = 0) then
    BEGIN
      fDBFHeader.BytesInRecords := fRecordSize;
      fDBFHeader.NumberOfRecords := fRecordCount;
      WriteHeader;
    END;
  // disconnet field objects
  BindFields(False);
  // destroy field object (if not persistent)
  if DefaultFields then
    DestroyFields;
  // free the internal list field offsets
  if Assigned(FFileOffset) then
    FFileOffset.Free;
  FFileOffset := nil;
  if Assigned(FFileWidth) then
    FFileWidth.Free;
  FFileWidth := nil;
  if Assigned(FFileDecimals) then
    FFileDecimals.Free;
  FFileDecimals := nil;
  FCurrentRecord := -1;
  // close the file
  FIsTableOpen := False;
  FStream.Free;
  FStream := nil;
end;
// ____________________________________________________________________________
// TDBF.IsCursorOpen
// I: is table open
function TDBF.IsCursorOpen: Boolean;
begin
  Result := FIsTableOpen;
end;
// ____________________________________________________________________________
// TDBF.WriteHeader
procedure TDBF.WriteHeader;
begin
//  Assert(FStream<>nil,'fStream=Nil');
  if fStream <> nil then
    begin
      FSTream.Seek(0,soFromBeginning);
      FStream.WriteBuffer(fDBFHeader,SizeOf(TDbfHeader));
    end;
end;
// ____________________________________________________________________________
// TDBF.Create
constructor TDBF.Create(AOwner:tComponent);
BEGIN
  inherited create(aOwner);
  fRecordHeaderSize := SizeOf(tRecordHeader);
END;
// ____________________________________________________________________________
// TDBF.CreateTable
// I: Create a new table/file
procedure TDBF.CreateTable;
var
  Ix : Integer;
//  DescribF : TBDescribField;
  Offs : Integer;
  Fld : TDbfField;
  FldName : PChar;
  i : integer;
begin
  CheckInactive;
  //  InternalInitFieldDefs;
  // create the new file
  if FileExists (FTableName) and
    (MessageDlg ('File ' + FTableName +
      ' already exists. OK to override?',
      mtConfirmation, [mbYes, mbNo], 0) = mrNo) then
    Exit;
  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;
  FStream := TFileStream.Create (FTableName,
    fmCreate or fmShareExclusive);
  try
    FillChar(fDBFHeader,SizeOf(TDbfHeader),0);
    fDBFHeader.BytesInRecords := 0; // filled later
    fDBFHeader.NumberOfRecords := 0; // empty
    WriteHeader;
    Offs:=0;
    for Ix:=0 to FieldDefs.Count-1 do
      begin
        with FieldDefs.Items[Ix] do
        begin
          FillChar(Fld,SizeOf(TDbfField),#0);
          Fld.FieldType := 'C';
          Fld.Width := Size;
          GetMem(FldName,SizeOf(FieldDefs.Items[Ix].Name));
          OemToChar(PChar(FieldDefs.Items[Ix].Name),FldName);
          for i := 1 to Length(FldName) do
            Fld.FieldName[i] := FldName[i];
          Fld.FieldName[Length(FldName)+1] := #0;
          FreeMem(FldName);
          Inc(Offs,Fld.Width);
          FStream.Write(Fld,SizeOf(TDbfField));
        end;
      end;
    fStartData := FStream.Position;
    fDBFHeader.BytesInRecords := Offs;
    FRecordSize := Offs+FRecordHeaderSize;
    WriteHeader;
  finally
    // close the file
    fStream.Free;
    fStream := nil;
  end;
end;
// ____________________________________________________________________________
// TDBF.PackTable
//Enhancement: Remove all deleted items from the table.
Procedure TDBF.PackTable;
var
  NewStream, OldStream : tStream;
  PC : PChar;
  Ix : Integer;
//  DescribF : TBDescribField;
  NewDataFileHeader : tDBFHeader;
  DataBuffer : Pointer;
  NumberOfFields : integer;
  Fld : TDBFField;
BEGIN
  OldStream := Nil;
  NewStream := Nil;
  CheckInactive;
//  if Active then
//    raise eBinaryDataSetError.Create ('Dataset must be closed before packing.');
  if fTableName = '' then
    raise EDBFError.Create('Table name not specified.');
  if not FileExists (FTableName) then
    raise EDBFError.Create('Table '+fTableName+' does not exist.');
  PC := @fTablename[1];
  CopyFile(PChar(PC),PChar(PC+',old'+#0),False);
  // create the new file
  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;
  TRY
    NewStream := TFileStream.Create (FTableName+',new',
      fmCreate or fmShareExclusive);
    OldStream := tFileStream.Create (fTableName+',old',
      fmOpenRead or fmShareExclusive);
    OldStream.ReadBuffer(NewDataFileHeader,SizeOf(TDbfHeader));
    NewStream.WriteBuffer(NewDataFileHeader,SizeOf(TDbfHeader));
    NumberOfFields := ((NewDataFileHeader.BytesInHeader-sizeof(TDbfHeader))div 32);
    for IX := 0 to NumberOfFields do
      BEGIN
        OldStream.Read(Fld,SizeOf(TDbfField));
        NewStream.Write(Fld,SizeOf(TDbfField));
      END;
    GetMem(DataBuffer,NewDataFileHeader.BytesInRecords);
    REPEAT
      IX := OldStream.Read(DataBuffer^,NewDataFileHeader.BytesInRecords);
      if (IX = NewDataFileHeader.BytesInRecords) and (pRecordHeader(DataBuffer)^.DeletedFlag <> '*') then
        NewStream.WRite(DataBuffer^,NewDataFileHeader.BytesInRecords);
    Until IX <> NewDataFileHeader.BytesInRecords;
    FreeMem(DataBuffer,NewDataFileHeader.BytesInRecords);
  finally
    // close the file
    NewStream.Free;
    OldStream.Free;
  end;
  CopyFile(PChar(PC+',new'+#0),PChar(PC),False);
  DeleteFile(Pchar(PC+',new'+#0));
  DeleteFile(Pchar(PC+',old'+#0));
END;
// ____________________________________________________________________________
// TDBF._SwapRecords
// Enhancement: Quick swap of two records.  Used primarily for sorting.
Procedure TDBF._SwapRecords(Rec1,REc2:Integer);
VAR
  Buffer1, Buffer2 : PChar;
  Bookmark1, BOokmark2 : TBookmarkFlag;
BEGIN
  Rec1 := Rec1 - 1;
  Rec2 := Rec2 - 1;
  if Rec1 < 0 then Exit;
  if Rec2 < 0 then Exit;
  Buffer1 := AllocRecordBuffer;
  Buffer2 := AllocRecordBuffer;
  _ReadRecord(Buffer1,Rec1);
  _ReadRecord(Buffer2,Rec2);
  Bookmark1 := GetBookmarkFlag(Buffer1);
  Bookmark2 := GetBookmarkFlag(Buffer2);
  SetBookmarkFlag(Buffer1,Bookmark2);
  SetBookmarkFlag(Buffer2,Bookmark1);
  _WriteRecord(Buffer1,Rec2);
  _WriteRecord(Buffer2,Rec1);
  StrDispose(Buffer1);
  StrDispose(Buffer2);
END;
// ____________________________________________________________________________
// TDBF._CompareRecords
// Compare two records.  Returns -1 if REC1 < REC2, 0 if REC1 = REC2, or
// 1 if REC1 > REC2.
Function TDBF._CompareRecords(SortFields:Array of String;Rec1,Rec2:Integer):Integer; FAR;
{-Compare the records Rec1, Rec2 and return -1 if Rec1 < Rec2, 0 if Rec1 = Rec2,
  1 if Rec1 > Rec2 }
VAR
  IX : Integer;
  Function CompareHelper(KeyId:String;Rec1,Rec2:Integer):Integer;
  VAR
    SKey1, SKey2 : String;
    IKey1, IKey2 : Integer;
    fKey1, fKey2 : Double;
    dKey1, dKey2 : tDateTime;
    CompareType : tFieldType;
    KeyField : tField;
  BEGIN
    KeyField := FieldByName(KeyID);
    CompareType := KeyField.DataType;
    Case CompareType of
      ftFloat,
      ftCurrency,
      ftBCD :
        BEGIN
          _ReadRecord(ActiveBuffer,Rec1-1);
          fKey1 := KeyField.AsFloat;
          _ReadRecord(ActiveBuffer,Rec2-1);
          fKey2 := KeyField.AsFloat;
          if fKey1 < fKey2 then
            Result := -1
          else
            if fKey1 > fKey2 then
              Result := 1
            else
              Result := 0;
        END;
      ftSmallInt,
      ftInteger,
      ftWord :
        BEGIN
          _ReadRecord(ActiveBuffer,Rec1-1);
          IKey1 := KeyField.AsInteger;
          _ReadRecord(ActiveBuffer,Rec2-1);
          IKey2 := KeyField.AsInteger;
          if IKey1 < IKey2 then
            Result := -1
          else
            if IKey1 > IKey2 then
              Result := 1
            else
              Result := 0;
        END;
      ftDate,
      ftTime,
      ftDateTime :
        BEGIN
          _ReadRecord(ActiveBuffer,Rec1-1);
          dKey1 := KeyField.AsDateTime;
          _ReadRecord(ActiveBuffer,Rec2-1);
          dKey2 := KeyField.AsDateTime;
          if dKey1 < dKey2 then
            Result := -1
          else
            if dKey1 > dKey2 then
              Result := 1
            else
              Result := 0;
        END;
      else
        BEGIN
          _ReadRecord(ActiveBuffer,Rec1-1);
          SKey1 := KeyField.AsString;
          _ReadRecord(ActiveBuffer,Rec2-1);
          SKey2 := KeyField.AsString;
          if SKey1 < SKey2 then
            Result := -1
          else
            if SKey1 > SKey2 then
              Result := 1
            else
              Result := 0;
        END;
    END;
  END;
BEGIN
  IX := 0;
  REPEAT // Loop through all available sortfields until not equal or no more sort fiels.
    Result := CompareHelper(SortFields[IX],Rec1,Rec2);
    Inc(IX);
  UNTIL (Result <> 0) or (IX > High(SortFields));
END;
// ____________________________________________________________________________
// TDBF.SortTable
// Enhancement: Sort the table by the fields passed.
Procedure TDBF.SortTable(SortFields : Array of String);
  { This is the main sorting routine. It is passed the number of elements and the
    two callback routines. The first routine is the function that will perform
    the comparison between two elements. The second routine is the procedure that
    will swap two elements if necessary } // Source: UNDU #8
  procedure QSort(uNElem: Integer);
  { uNElem - number of elements to sort }
    procedure qSortHelp(pivotP: Integer; nElem: word);
    label
      TailRecursion,
      qBreak;
    var
      leftP, rightP, pivotEnd, pivotTemp, leftTemp: word;
      lNum: Integer;
      retval: integer;
    begin
      TailRecursion:
        if (nElem <= 2) then
          begin
            if (nElem = 2) then
              begin
                rightP := pivotP +1;
                if (_CompareRecords(SortFields,pivotP, rightP) > 0) then
                  _SwapRecords(pivotP, rightP);
              end;
            exit;
          end;
        rightP := (nElem -1) + pivotP;
        leftP :=  (nElem shr 1) + pivotP;
        { sort pivot, left, and right elements for "median of 3" }
        if (_CompareRecords(SortFields,leftP, rightP) > 0) then _SwapRecords(leftP, rightP);
        if (_CompareRecords(SortFields,leftP, pivotP) > 0) then _SwapRecords(leftP, pivotP)
        else if (_CompareRecords(SortFields,pivotP, rightP) > 0) then _SwapRecords(pivotP, rightP);
        if (nElem = 3) then
          begin
            _SwapRecords(pivotP, leftP);
            exit;
          end;
        { now for the classic Horae algorithm }
        pivotEnd := pivotP + 1;
        leftP := pivotEnd;
        repeat
          retval := _CompareRecords(SortFields,leftP, pivotP);
          while (retval <= 0) do
            begin
              if (retval = 0) then
                begin
                  _SwapRecords(LeftP, PivotEnd);
                  Inc(PivotEnd);
                end;
              if (leftP < rightP) then
                Inc(leftP)
              else
                goto qBreak;
              retval := _CompareRecords(SortFields,leftP, pivotP);
            end; {while}
          while (leftP < rightP) do
            begin
              retval := _CompareRecords(SortFields,pivotP, rightP);
              if (retval < 0) then
                Dec(rightP)
              else
                begin
                  _SwapRecords(leftP, rightP);
                  if (retval <> 0) then
                    begin
                      Inc(leftP);
                      Dec(rightP);
                    end;
                  break;
                end;
            end; {while}
        until (leftP >= rightP);
      qBreak:
        if (_CompareRecords(SortFields,leftP, pivotP) <= 0) then Inc(leftP);
        leftTemp := leftP -1;
        pivotTemp := pivotP;
        while ((pivotTemp < pivotEnd) and (leftTemp >= pivotEnd)) do
          begin
            _SwapRecords(pivotTemp, leftTemp);
            Inc(pivotTemp);
            Dec(leftTemp);
          end; {while}
        lNum := (leftP - pivotEnd);
        nElem := ((nElem + pivotP) -leftP);
        if (nElem < lNum) then
          begin
            qSortHelp(leftP, nElem);
            nElem := lNum;
          end
        else
          begin
            qSortHelp(pivotP, lNum);
            pivotP := leftP;
          end;
        goto TailRecursion;
      end; {qSortHelp }
  begin
    if (uNElem < 2) then  exit; { nothing to sort }
    qSortHelp(1, uNElem);
  end; { QSort }
BEGIN
  CheckActive;
  if fReadOnly then
    raise eDBFError.Create ('Dataset must be opened for read/write to perform sort.');
//  if fDataFileHeader.DeletedCount > 0 then
//    BEGIN
//      Close;
//      PackTable;
//      Open;
//    END;
  QSort(FRecordCount {+ fDeletedCount});
  First;
END;
// ____________________________________________________________________________
// TDBF.UnsortTable
// Used to help test the sort routine.  Attempts to generate a random
// dispersment of the records in the dataset.
Procedure TDBF.UnsortTable;
Var
  IX : Integer;
BEGIN
  First;
  Randomize;
  for IX := 0 to RecordCOunt do
    BEGIN
      _SwapRecords(IX,Random(RecordCount+1));
    END;
  First;
END;
////////////////////////////////////////
////// Part II:
////// Bookmarks management and movement
////////////////////////////////////////
// ____________________________________________________________________________
// TDBF.InternalGotoBookmark
// II: set the requested bookmark as current record
procedure TDBF.InternalGotoBookmark (Bookmark: Pointer);
var
  ReqBookmark: Integer;
begin
  ReqBookmark := PInteger (Bookmark)^;
//  ShowMessage ('InternalGotoBookmark: ' +
//    IntToStr (ReqBookmark));
  if (ReqBookmark >= 0) and (ReqBookmark < FRecordCount {+ fDeletedCount}) then
    FCurrentRecord := ReqBookmark
  else
    raise eDBFError.Create ('Bookmark ' +
      IntToStr (ReqBookmark) + ' not found');
end;
// ____________________________________________________________________________
// TDBF.InternalSetToRecord
// II: same as above (but passes a buffer)
procedure TDBF.InternalSetToRecord (Buffer: PChar);
var
  ReqBookmark: Integer;
begin
//  ShowMessage ('InternalSetToRecord');
  ReqBookmark := PRecInfo(Buffer + FRecordInfoOffset).Bookmark;
  InternalGotoBookmark (@ReqBookmark);
end;
// ____________________________________________________________________________
// TDBF.GetBookmarkFlag
// II: retrieve bookmarks flags from buffer
function TDBF.GetBookmarkFlag (
  Buffer: PChar): TBookmarkFlag;
begin
//  ShowMessage ('GetBookmarkFlag');
  Result := PRecInfo(Buffer + FRecordInfoOffset).BookmarkFlag;
end;
// ____________________________________________________________________________
// TDBF.SetBookmarkFlag
// II: change the bookmark flags in the buffer
procedure TDBF.SetBookmarkFlag (Buffer: PChar;
  Value: TBookmarkFlag);
begin
//  ShowMessage ('SetBookmarkFlag');
  PRecInfo(Buffer + FRecordInfoOffset).BookmarkFlag := Value;
end;
// ____________________________________________________________________________
// TDBF.GetBookmarkData
// II: read the bookmark data from record buffer
procedure TDBF.GetBookmarkData (
  Buffer: PChar; Data: Pointer);
begin
//  ShowMessage ('GetBookmarkData: ' + IntToStr (PRecInfo(Buffer + FRecordInfoOffset).Bookmark));
  PInteger(Data)^ :=
    PRecInfo(Buffer + FRecordInfoOffset).Bookmark;
end;
// ____________________________________________________________________________
// TDBF.SetBookmarkData
// II: set the bookmark data in the buffer
procedure TDBF.SetBookmarkData (
  Buffer: PChar; Data: Pointer);
begin
//  ShowMessage ('SetBookmarkData: ' + IntToStr (PInteger(Data)^));
  PRecInfo(Buffer + FRecordInfoOffset).Bookmark :=
    PInteger(Data)^;
end;
// ____________________________________________________________________________
// TDBF.InternalFirst
// II: Go to a special position before the first record
procedure TDBF.InternalFirst;
begin
  FCurrentRecord := BofCrack;
end;
// ____________________________________________________________________________
// TDBF.InternalLast
// II: Go to a special position after the last record
procedure TDBF.InternalLast;
begin
  EofCrack := FRecordCount {+ fDeletedCount};
  FCurrentRecord := EofCrack;
end;
// ____________________________________________________________________________
// TDBF.GetRecordCount
// II (optional): Record count
function TDBF.GetRecordCount: Longint;
begin
  CheckActive;
  Result := FRecordCount;
end;
// ____________________________________________________________________________
// TDBF.GetRecNo
// II (optional): Get the number of the current record
function TDBF.GetRecNo: Longint;
begin
  UpdateCursorPos;
  if FCurrentRecord < 0 then
    Result := 1
  else
    Result := FCurrentRecord + 1;
end;
// ____________________________________________________________________________
// TDBF.SetRecNo
// II (optional): Move to the given record number
procedure TDBF.SetRecNo(Value: Integer);
begin
  CheckBrowseMode;
  if (Value > 1) and (Value <= (FRecordCount{+FDeletedCount})) then
  begin
    FCurrentRecord := Value - 1;
    Resync([]);
  end;
end;
//////////////////////////////////////////
////// Part III:
////// Record buffers and field management
//////////////////////////////////////////
// ____________________________________________________________________________
// TDBF.GetRecordSize
/// III: Determine the size of each record buffer in memory
function TDBF.GetRecordSize: Word;
begin
  Result := FRecordSize; // data only
end;
// ____________________________________________________________________________
// TDBF.AllocRecordBuffer
/// III: Allocate a buffer for the record
function TDBF.AllocRecordBuffer: PChar;
begin
  Result := StrAlloc(FRecordBufferSize+1);
end;
// ____________________________________________________________________________
// TDBF.InternalInitRecord
// III: Initialize the record (set to zero)
procedure TDBF.InternalInitRecord(Buffer: PChar);
(*var
  Field : TField;
  i : integer;
  FieldOffset : integer;
  S : string; *)
begin
  FillChar(Buffer^, FRecordBufferSize, 32);
(*  for i := 0 to FieldCount-1 do
    begin
      Field := Fields[i];
      FieldOffset := Integer(FFileOffset[Field.FieldNo-1])+FRecordHeaderSize;
      if Field.DataType = ftString then
        begin
          pChar(Buffer+FieldOffset)^ := #0;
        end
      else if Field.DataType = ftFloat then
        begin
          pChar(Buffer+FieldOffset)^ := '0';
          pChar(Buffer+FieldOffset+1)^ := #0;
        end
      else if Field.DataType = ftDate then
        begin
          S := '19900101';
          CopyMemory(PChar(Buffer+FieldOffset),PChar(S),8);
        end
      else if Field.DataType = ftBoolean then
        begin
          pChar(Buffer+FieldOffset)^ := 'F';
        end;
    end; *)
end;
// ____________________________________________________________________________
// TDBF.FreeRecordBuffer
// III: Free the buffer
procedure TDBF.FreeRecordBuffer (var Buffer: PChar);
begin
  StrDispose(Buffer);
end;
// ____________________________________________________________________________
// TDBF.GetRecord
// III: Retrieve data for current, previous, or next record
// (eventually moving to it) and return the status
function TDBF.GetRecord(Buffer: PChar;
  GetMode: TGetMode; DoCheck: Boolean): TGetResult;
var
  Acceptable : Boolean;
begin
  result := grOk;
  if FRecordCount < 1 then
    Result := grEOF
  else
    repeat
      case GetMode of
        gmCurrent :
          begin
            // ShowMessage ('GetRecord Current');
            if (FCurrentRecord >= FRecordCount{+fDeletedCount}) or
                (FCurrentRecord < 0) then
              Result := grError;
          end;
        gmNext :
          begin
            if (fCurrentRecord < (fRecordCount{+fDeletedCount})-1) then
              Inc (FCurrentRecord)
            else
              Result := grEOF;
          end;
        gmPrior :
          begin
           if (fCurrentRecord > 0) then
              Dec(fCurrentRecord)
           else
              Result := grBOF;
          end;
      end;
      // fill record data area of buffer
      if Result = grOK then
        begin
          _ReadRecord(Buffer, fCurrentRecord );
          {FStream.Position := FDataFileHeader.StartData +
          FRecordSize * FCurrentRecord;
          FStream.ReadBuffer (Buffer^, FRecordSize);}
          ClearCalcFields(Buffer);
          GetCalcFields(Buffer);
          with PRecInfo(Buffer + FRecordInfoOffset)^ do
            begin
              BookmarkFlag := bfCurrent;
              Bookmark := FCurrentRecord;
            end;
        end
      else
        if (Result = grError) and DoCheck then
          raise eDBFError.Create('GetRecord: Invalid record');
      Acceptable := pRecordHeader(Buffer)^.DeletedFlag <> '*';
      if Filtered then
        Acceptable := Acceptable and (_ProcessFilter(Buffer));
      if (GetMode=gmCurrent) and Not Acceptable then
        Result := grError;
    until (Result <> grOK) or Acceptable;
  if ((Result=grEOF)or(Result=grBOF)) and Filtered and not (_ProcessFilter(Buffer)) then
    Result := grError;
end;
// ____________________________________________________________________________
// TDBF.InternalPost
// III: Write the current data to the file
procedure TDBF.InternalPost;
begin
  CheckActive;
  if State = dsEdit then
    begin
      // replace data with new data
      {FStream.Position := FDataFileHeader.StartData + (FRecordSize * FCurrentRecord);
      FStream.WriteBuffer (ActiveBuffer^, FRecordSize);}
      _WriteRecord (ActiveBuffer, fCurrentRecord);
    end
  else
    begin
      // always append
      InternalLast;
      {FStream.Seek (0, soFromEnd);
      FStream.WriteBuffer (ActiveBuffer^, FRecordSize);}
      pRecordHeader(ActiveBuffer)^.DeletedFlag := ' ';
      _AppendRecord(ActiveBuffer);
      Inc (FRecordCount);
    end;
end;
// ____________________________________________________________________________
// TDBF.InternalAddRecord
// III: Add the current data to the file
procedure TDBF.InternalAddRecord(Buffer:Pointer; Append:Boolean);
begin
  // always append
  InternalLast;
  // add record at the end of the file
  {FStream.Seek (0, soFromEnd);}
  pRecordHeader(ActiveBuffer)^.DeletedFlag := ' ';
  _AppendRecord(ActiveBuffer);
  {FStream.WriteBuffer (ActiveBuffer^, FRecordSize);}
  Inc (FRecordCount);
end;
// ____________________________________________________________________________
// TDBF.InternalDelete
// III: Delete the current record
procedure TDBF.InternalDelete;
begin
  CheckActive;
  // not supported in this version
{  raise eBinaryDataSetError.Create (
    'Delete: Operation not supported');}
//  pRecordHeader(ActiveBuffer)^.DeletedFlag := fDataFileHeader.LastDeleted;
  PChar(ActiveBuffer)^ := '*';
  _WriteRecord(ActiveBuffer,fCurrentRecord);
  {FStream.Position := FDataFileHeader.StartData + (FRecordSize * FCurrentRecord);
  FStream.WriteBuffer (ActiveBuffer^, FRecordSize);}
//  fDBFHeader.LastDeleted := GetRecNo;
//  Inc(fDeletedCount);
//  Dec(fRecordCount);
//  fDBFHeader.NumberOfRecords := fRecordCount;
//  WriteHeader;
  Resync([]);
end;
// ____________________________________________________________________________
// TDBF.GetFieldData
// III: Move data from record buffer to field
function TDBF.GetFieldData(Field:TField; Buffer:Pointer):Boolean;
var
  FieldOffset: Integer;
  S : string;
  Buf2 : PChar;
  i,l : integer;
  D : Double;
  n : integer;
  T : TDateTime;
  j : integer;
  OldDateFormat : string;
begin
  Result := False;
  Buf2 := ActiveBuffer;
  if (FRecordCount>0) and (Field.FieldNo > 0) and (Assigned(Buffer)) and (Assigned(Buf2))  then
    begin
      FieldOffset := Integer(FFileOffset[Field.FieldNo-1])+FRecordHeaderSize;
      if Field.DataType = ftString then
        begin
          l := Integer(FFileWidth[Field.FieldNo-1]);
          S := '';
          i := 0;
          While (Buf2[FieldOffset+i] <> #0) and (i<l) do
            begin
              S := S+pChar(Buf2+FieldOffset+i)^;
              inc(i);
            end;
          SetLength(S,l);
          S := Trim(S);
          CharToOemBuff(PChar(S), Buffer,l);
          Result := True;
        end
      else if Field.DataType = ftFloat then
        begin
          n := Integer(FFileWidth[Field.FieldNo-1]);
          S := '';
          for i := FieldOffset to FieldOffset+n-1 do
            S := S+pChar(Buf2+i)^;
          S := Trim(S);
          if S='' then
            Result := False
          else
            begin
              if (Pos('.',S) > 0) and (DecimalSeparator <> '.') then
                S[Pos('.',S)] := DecimalSeparator;
              Result := True;
             try
              D := StrToFloat(S);
             except
              D := 0;
              Result := False;
             end;
              PDouble(Buffer)^ := D;
            end;
        end
      else if Field.DataType = ftDate then
        begin
          S := '';
          for j := 0 to 7 do
            S := S + pChar(Buf2+FieldOffset+j);
          SetLength(S,8);
          if (trim(S) = '') or (S='00000000') then
            Result := false
          else
            begin
              S := Copy(S,7,2)+DateSeparator+Copy(S,5,2)+DateSeparator+Copy(S,1,4);
              OldDateFormat := ShortDateFormat;
              ShortDateFormat := 'dd/mm/yyyy';
              t := StrToDate(S);
              ShortDateFormat := OldDateFormat;
              j := Trunc(pDouble(@t)^)+693594;
              pInteger(Buffer)^ := j;
              result := True;
            end;
        end
      else if Field.DataType = ftBoolean then
        begin
          Result := True;
          if PChar(Buf2+FieldOffset)^ in ['S','T','Y'] then
            pBoolean(Buffer)^ := True
          else if PChar(Buf2+FieldOffset)^ in ['N','F'] then
            pBoolean(Buffer)^ := False
          else
            Result := False;
        end
      else
        begin
          ShowMessage ('very bad error in get field data');
          Result := False;
        end;
    end;
end;
// ____________________________________________________________________________
// TDBF.SetFieldData
// III: Move data from field to record buffer
procedure TDBF.SetFieldData(Field: TField; Buffer: Pointer);
var
  FieldOffset: Integer;
  Buf2 : PChar;
  l,i,n:integer;
  S : string;
  D : TDateTime;
  j : integer;
begin
  Buf2 := ActiveBuffer;
  if (Field.FieldNo >= 0) and (Assigned(Buffer)) and (Assigned(Buf2)) then
    begin
      FieldOffset := Integer(FFileOffset[Field.FieldNo-1])+FRecordHeaderSize;
      if Field.DataType = ftString then
        begin
          l := Integer(FFileWidth[Field.FieldNo-1]);
          S := '';
          i := 0;
          While (PChar(Buffer)[i] <> #0) and (i<l) do
            begin
              S := S+PChar(Buffer)[i];
              inc(i);
            end;
          SetLength(S,l);
          OemToCharBuff(PChar(S),PChar(Buf2+FieldOffset),l);
        end
      else if Field.DataType = ftFloat then
        begin
          n := Integer(FFileWidth[Field.FieldNo-1]);
          Str(pDouble(Buffer)^:n:Integer(FFileDecimals[Field.FieldNo-1]),S);
          while Length(S)<n do
            S :=  ' '+S;
          if (Pos(DecimalSeparator,S) > 0) and (DecimalSeparator <> '.') then
            S[Pos(DecimalSeparator,S)] := '.';
          CopyMemory(Pchar(Buf2+FieldOffset),PChar(S),n);
        end
      else if Field.DataType = ftDate then
        begin
          j := pInteger(Buffer)^-693594;
          pDouble(@d)^ := j;
          S := FormatDateTime('yyyymmdd',d);
          StrLCopy(pChar(Buf2+FieldOffset),pChar(S),8);
        end
      else if Field.DataType = ftBoolean then
        begin
          if pBoolean(Buffer)^ then
            PChar(Buf2+FieldOffset)^ := 'T'
          else
            PChar(Buf2+FieldOffset)^ := 'F';
        end
      else
        ShowMessage ('very bad error in setfield data');
      DataEvent (deFieldChange, Longint(Field));
    end;
end;
// ____________________________________________________________________________
// TDBF.InternalHandleException
// default exception handling
procedure TDBF.InternalHandleException;
begin
  // standard exception handling
  Application.HandleException(Self);
end;
Function TDBF._ProcessFilter(Buffer:PChar):boolean;
var
  FilterExpresion : string;
  PosComp : integer;
  FName : string;
  FieldPos : integer;
  FieldOffset : integer;
  FieldValue : Variant;
  TestValue : Variant;
  FieldText : string;
  OldShortDateFormat : string;
begin
  FilterExpresion := Filter;
  PosComp := Pos('>',FilterExpresion);
  if PosComp=0 then
    PosComp := Pos('<',FilterExpresion);
  if PosComp=0 then
    PosComp := Pos('=',FilterExpresion);
  if PosComp=0 then
    begin
      _ProcessFilter := True;
      Exit;
    end;
  FName := Trim(Copy(FilterExpresion,1,PosComp-1));
  FieldPos := FieldDefs.IndexOf(FName);
  FieldOffset := integer(FFileOffset[FieldPos]);
  if FieldPos < 0 then
    _ProcessFilter := True
  else if FieldDefs.Items[FieldPos].DataType = ftString then
    begin // STRING
     try
      FieldValue := '';
      FieldOffset := FieldOffset+1;
      While (Buffer[FieldOffset]<>#0) and (Length(FieldValue)<integer(FFileWidth[FieldPos])) do
        begin
          FieldValue := FieldValue + Buffer[FieldOffset];
          FieldOffset := FieldOffset+1;
        end;
      FieldValue := Trim(FieldValue);
      TestValue := Trim(Copy(FilterExpresion,PosComp+2,Length(FilterExpresion)-PosComp-2));
      if FilterExpresion[PosComp]='=' then
        _ProcessFilter := (FieldValue=TestValue)
      else if FilterExpresion[PosComp]='>' then
        begin
          if FilterExpresion[PosComp+1]='=' then
            _ProcessFilter := (FieldValue>=Copy(TestValue,2,(Length(TestValue)-1)))
          else
            _ProcessFilter := (FieldValue>TestValue);
        end
      else if FilterExpresion[PosComp]='<' then
        begin
          if FilterExpresion[PosComp+1]='=' then
            _ProcessFilter := (FieldValue<=Copy(TestValue,2,(Length(TestValue)-1)))
          else
            _ProcessFilter := (FieldValue<TestValue);
        end
      else
        _ProcessFilter := False;
     except
       _ProcessFilter := False;
     end;
    end
  else if FieldDefs.Items[FieldPos].DataType = ftFloat then
    begin // FLOAT
     try
      FieldText := '';
      FieldOffset := FieldOffset+1;
      While (Buffer[FieldOffset]<>#0) and (Length(FieldText)<integer(FFileWidth[FieldPos])) do
        begin
          FieldText := FieldText + Buffer[FieldOffset];
          FieldOffset := FieldOffset+1;
        end;
      FieldText := Trim(FieldText);
      if Pos('.',FieldText)>0 then
        FieldText[Pos('.',FieldText)] := DecimalSeparator;
      FieldValue := StrToFloat(FieldText);
      if FilterExpresion[PosComp+1]='='then
        FieldText := Trim(Copy(FilterExpresion,PosComp+2,Length(FilterExpresion)-PosComp-1))
      else
        FieldText := Trim(Copy(FilterExpresion,PosComp+1,Length(FilterExpresion)-PosComp));
      if Pos('.',FieldText)>0 then
        FieldText[Pos('.',FieldText)] := DecimalSeparator;
      TestValue := StrToFloat(FieldText);
      if FilterExpresion[PosComp]='=' then
        _ProcessFilter := (FieldValue=TestValue)
      else if FilterExpresion[PosComp]='>'then
        begin
          if FilterExpresion[PosComp+1]='='then
            _ProcessFilter := (FieldValue>=TestValue)
          else
            _ProcessFilter := (FieldValue>TestValue);
        end
      else if FilterExpresion[PosComp]='<'then
        begin
          if FilterExpresion[PosComp+1]='='then
            _ProcessFilter := (FieldValue<=TestValue)
          else
            _ProcessFilter := (FieldValue<TestValue);
        end
      else
        _ProcessFilter := False;
     except
      _ProcessFilter := False;
     end;
    end
  else if FieldDefs.Items[FieldPos].DataType = ftDate then
    begin // DATE
      OldShortDateFormat := ShortDateFormat;
     try
      FieldText := '';
      FieldOffset := FieldOffset+1;
      While (Buffer[FieldOffset]<>#0) and (Length(FieldText)<integer(FFileWidth[FieldPos])) do
        begin
          FieldText := FieldText + Buffer[FieldOffset];
          FieldOffset := FieldOffset+1;
        end;
      FieldText := Trim(FieldText);
      FieldText := Copy(FieldText,1,4)+DateSeparator+Copy(FieldText,5,2)+DateSeparator+Copy(FieldText,7,2);
      ShortDateFormat := 'yyyy/mm/dd';
      FieldValue := StrToDate(FieldText);
      if FilterExpresion[PosComp+1]='=' then
        FieldText := Trim(Copy(FilterExpresion,PosComp+2,Length(FilterExpresion)-PosComp-1))
      else
        FieldText := Trim(Copy(FilterExpresion,PosComp+1,Length(FilterExpresion)-PosComp));
      FieldText := Copy(FieldText,1,4)+DateSeparator+Copy(FieldText,5,2)+DateSeparator+Copy(FieldText,7,2);
      TestValue := StrToDate(FieldText);
      if FilterExpresion[PosComp]='=' then
        begin
          _ProcessFilter := (FieldValue=TestValue);
        end
      else if FilterExpresion[PosComp]='>' then
        begin
          if FilterExpresion[PosComp+1]='='then
            _ProcessFilter := (FieldValue>=TestValue)
          else
            _ProcessFilter := (FieldValue>TestValue);
        end
      else if FilterExpresion[PosComp]='<' then
        begin
          if FilterExpresion[PosComp+1]='='then
            _ProcessFilter := (FieldValue<=TestValue)
          else
            _ProcessFilter := (FieldValue<TestValue);
        end
      else
        _ProcessFilter := False;
     except
      _ProcessFilter := False;
     end;
      ShortDateFormat := OldShortDateFormat;
    end
  else
    _ProcessFilter := False;
end;
{******************************************************************************}
{* Property Editors Code                                                       *}
{******************************************************************************}
procedure TFilenameProperty.Edit;
var
  FileOpen: TOpenDialog;
begin
  FileOpen := TOpenDialog.Create(Nil);
  FileOpen.Filename := GetValue;
  FileOpen.Filter := 'dBase Files (*.DBF)|*.DBF|All Files (*.*)|*.*';
  FileOpen.Options := FileOpen.Options + [ofPathMustExist, ofFileMustExist];
  try
    if FileOpen.Execute then SetValue(FileOpen.Filename);
  finally
    FileOpen.Free;
  end;
end;
function TFilenameProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog, paRevertable];
end;
procedure Register;
begin
  RegisterComponents('Terabyte', [TDBF]);
  RegisterPropertyEditor(TypeInfo(String), TDBF, 'TableName', TFileNameProperty);
end;
end.

						