how to read .dbf file from delphi 7 ?

hello every body,
i want simply to connect and retrive data from .dbf fie. i could by your help make a connection to that folder but when ever i couldent retrive data can you help me ?
here is my code for connection
 var
  strDBFolder: String;
  tmpStringList, tmpStringList2: TStringList;
  intX: Integer;
begin
  tmpStringList := TStringList.Create;
  tmpStringList2 := TStringList.Create;
  strDBFolder := 'C:\Program Files\FingerTec\TCMSv2';
  ADOConnection1.Close;
  ADOConnection1.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' +
                                      strDBFolder +
                                      ';Extended Properties=dBASE IV;User ID=Admin;Password=;';
  ADOConnection1.Open;
  ADOConnection1.Connected := true ;
  ADOConnection1.GetTableNames( tmpStringList );
   showmessage(tmpStringList.Text) ;
aldahanAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Ferruccio AccalaiSenior developer, analyst and customer assistance Commented:
Into the list you got the table names,
Now you can add a TAdoTable, link the TADoConnection, set the tablename (from one of the list) and open.
0
aldahanAuthor Commented:
i have added this code :

for intX:=0 to 3 do
  begin
    ADOTable1.TableName := tmpStringList[ intX ];
   ADOTable1.Active := true;
   ADOTable1.Open ;
    showmessage( 'Fields for table : ' + UpperCase( ADOTable1.TableName ) + #13#10 + ADOTable1.GetFieldnames(tmpStringList2)  );
but an error message keep appearing : external table is not in the expected format

end;
0
peteratsaabCommented:

Hi here is a simple way to use DB component and table to read a dbf file on you local HDD without creating a database.

//loadDbTable -------------------------------------------------------------
Procedure loadDbTable(DBPath, DBTableName : String);
var i, j : Integer;
Begin
try
 if SysUtils.DirectoryExists(DBPath) then begin
   if FileExists(DBTableName) then begin
     Database.Connected := False;
      Table.Active := False;
      Database.Params.Clear;
      Database.Params.Add('TYPE=STANDARD');
      Database.Params.Add('DEFAULT DRIVER=PARADOX');
      Database.Params.Add('ENABLE BCD=FALSE');
      Database.Params.Add('PATH='+DBPath);
      Database.Connected := True;
      Table.DatabaseName := ShpDatabase.DatabaseName;
      Table.TableName := ExtractFileName(DBTableName);
      Table.Active := True;
      //Add all the fields to the title combo or grid or something...
      For i := 0 to Table.FieldCount - 1 do begin
        dbfCheckListBox.Items.Add(Table.FieldDefs.Items[i].Name);
      end;
      // Read the data like normally
      While not EOF(Table) do....
   end;
 end;
 except
 end;
end;


0
Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

aldahanAuthor Commented:
hello,
i could not understand database , table of what type are they ?
0
peteratsaabCommented:
Sorry you need to add these if you can go this route...

var
Database : TDataBase; //Std delphi component  
Table : TTable; //Std delphi component  
0
Ferruccio AccalaiSenior developer, analyst and customer assistance Commented:
peter, those are BDE components, not ADO components.

aldahan, wich kind of dbf files are you using?
0
aldahanAuthor Commented:
this is my code

var
  strDBFolder: String;
  tmpStringList, tmpStringList2: TStringList;
  intX : integer ;
begin
  strDBFolder := 'C:\Program Files\FingerTec\TCMSv2';
  tmpStringList := TStringList.Create;

  ADOConnection1.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' +
                                      strDBFolder +
                                      ';Extended Properties=dBASE II;User ID=Admin;Password=;';
  ADOConnection1.Open;
  ADOConnection1.GetTableNames( tmpStringList );
  showmessage( tmpStringList.Text );
  //FreeAndNil( tmpStringList );
  showmessage('the connection is ok') ;
 //DOConnection1.
  for intX:=1 to 3 do
  begin
    ADOTable1.TableName := tmpStringList[ intX ];
    ADOTable1.GetFieldNames( tmpStringList2 );
    showmessage( 'Fields for table : ' + UpperCase( tmpStringList[ intX ] )  + tmpStringList2.Text );
  end;
    FreeAndNil( tmpStringList );
    FreeAndNil( tmpStringList2 );
    ADOConnection1.Close;

here i could see the message that contained all tables names but when ever my loop started an error message saying missing connection or connection string , if i tried to but a connection string to my ADOTable another error message said external tables is not the expected format
what do you think the reason ?
how do i know my .dbf file type ?
0
peteratsaabCommented:
Sorry I'm not familliar ADO. We only use BDE for simple stuf and some other very expensive component suite(Unidac),  and As far as reading a ‘dBASE IV’ Table on your local HDD? this should work. You might need to change the language driver. I have "PARADOX" in the example but you may need to change to"DBASE".

 
 
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
aldahanAuthor Commented:
your example dose not  work with me because i could not define table as TTable or database as Tdatabase , although i added BDE to my uses
0
Ferruccio AccalaiSenior developer, analyst and customer assistance Commented:
aldahan, first of all to have the peter's sample working just add ttable and tdatabase to your form (from BDE palette in D7)

Anyway can you open these dbf from ms access? If so you should be able to do it using ado too, but you have to set the proper connection string depending on wich Dbase kind are them (dBase III, IV or 5)

Note that them could also be some FoxPro dbf tables. In this case you should use the MS ODBC driver to access them. Take a look here http://www.connectionstrings.com/dbf-foxpro
0
peteratsaabCommented:
Hi all a few mods this should be a bit clearer. hope this helps

//BitBtn1Click -----------------------------------------------------------------
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
 With OpenDialog1 do Begin
   filter := 'DB Files|*.dbf';
   if Execute Then begin
     loadDbTable(ExtractFilePath(FileName), ExtractFileName(FileName));
   end;
 end;
end;

// NOTE : Add "DB, DBTables" to your uses;
//LoadDbTable ------------------------------------------------------------------
Procedure TForm1.LoadDbTable(DBPath, DBTableName : String);
var i, j : Integer;
    Database : TDatabase;
    Table : TTable;
Begin
  Try
     Database := TDatabase.Create(Self);
     Table := TTable.Create(Self);
     try
       if SysUtils.DirectoryExists(DBPath) then begin
        if FileExists(DBTableName) then begin
          Database.Connected := False;
          Table.Active := False;
          Database.Params.Clear;
          Database.Params.Add('TYPE=STANDARD');
          Database.Params.Add('DEFAULT DRIVER=DBASE');
          Database.Params.Add('ENABLE BCD=FALSE');
          Database.Params.Add('PATH='+DBPath);
          Table.DatabaseName := Database.Name;
          Table.TableName := ExtractFileName(DBTableName);
          Table.Active := True;
          //Add all the fields to the title combo or grid or something...
          //Make sure you add some cols to the grid, before adding the fields
          For i := 0 to Table.FieldCount - 1 do begin
             StringGrid1.Cells[i, 0] :=  Table.FieldDefs.Items[i].Name;
          end;
          // Read the data
       end;
     end;
     except
     
     end;
  finally
    Database.Free;
    Table.Free;  
  end;
end;

0
peteratsaabCommented:
Ok,  here is a working example, works in D6 and D2010. Just add a TStringGrid and a TBitBtn to a from.



//----------------------------------------------------
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, Grids, DB, DBTables;

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    BitBtn1: TBitBtn;
    OpenDialog1: TOpenDialog;
    procedure BitBtn1Click(Sender: TObject);
  private
    Procedure LoadDbTable(DBPath, DBTableName : String);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation


{$R *.dfm}




//BitBtn1Click -----------------------------------------------------------------
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
 With OpenDialog1 do Begin
   filter := 'DB Files|*.dbf';
   if Execute Then begin
     loadDbTable(ExtractFilePath(FileName), ExtractFileName(FileName));
   end;
 end;
end;

// ADD "DB, DBTables" to your uses;
//LoadDbTable ------------------------------------------------------------------
Procedure TForm1.LoadDbTable(DBPath, DBTableName : String);
var i, j : Integer;
    Database : TDatabase;
    Table : TTable;
Begin
  Try
     Screen.Cursor := crHourGlass;
     Database := TDatabase.Create(Self);
     Table := TTable.Create(Self);
     try
       if SysUtils.DirectoryExists(DBPath) then begin
        if FileExists(DBTableName) then begin
          Database.Connected := False;
          Table.Active := False;
          Database.Params.Clear;
          Database.Params.Add('TYPE=STANDARD');
          Database.Params.Add('DEFAULT DRIVER=DBASE');
          Database.Params.Add('ENABLE BCD=FALSE');
          Database.Params.Add('PATH='+DBPath);
          Table.DatabaseName := Database.Name;
          Table.TableName := ExtractFileName(DBTableName);
          Table.Active := True;
          For i := 0 to Table.FieldCount - 1 do begin
             If StringGrid1.ColCount < i then StringGrid1.ColCount := StringGrid1.ColCount + 1;
             StringGrid1.Cells[i, 0] :=  Table.FieldDefs.Items[i].Name;
             j := 1;
             while not (Table.Eof) do begin
              If StringGrid1.RowCount < j then StringGrid1.RowCount := StringGrid1.RowCount + 1;
              StringGrid1.Cells[i, j] := Table.Fields[i].AsString;
              inc(j);
              Table.Next; //Goto next record
             end;
             Table.First; //goto first record
          end;
       end;
     end;
     except
       MessageDlg('Unable to load '+DBTableName, mtError, [mbOk], 0);
     end;
  finally
    Database.Free;
    Table.Free;
    Screen.Cursor := crDefault;  
  end;
end;


end.
0
senadCommented:
You don't use jet 4 to connect to dbase table.Jet 4 is for Access 2000-2003.
Use BDE from the components palette.
0
aldahanAuthor Commented:
thank you peter, i am so thankfull to your example here, i tried to use it but an error message said that an error occured while attempting to intialize the Borland Database Engine ( Error $2108)
0
aldahanAuthor Commented:
hi there every body,
thank you for being helpful. i install bde again on my computer but know i got this error : could not find language driver
0
Ferruccio AccalaiSenior developer, analyst and customer assistance Commented:
aldahan, first note that BDE is obsolete and no longer updated, then consider that if you use it you should distribute BDE with your application.

Also, wich delphi 7 are you using? Usually BDE is already installed with Delphi7, so why did you need to reinstall it?

Last, you didn't answer about the dbf type. Can you open it with MS Access? If so, you should open it using ADO too otherwise it could be, as said above, a FoxPro dbf file, so the approach should be different...
0
peteratsaabCommented:
an answer to the "Cannot intialize the Borland Database Engine ( Error $2108)"  problem exists on this site or check out http://support.embarcadero.com/article/35865

Alternatively here is the source for a component tat can read a dbf file without any DB engine support.
It reads an parses the file without   the need for any additional recourses.
This code is quite old so it might need some fiddling if your are not using D6, D7

I’ve attached an demo exe so first check if you can view your file if ok give the component a try
//--------------------------------------------------------------------------------------------------------------------------
unit MDBFTable;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, DsgnIntf;

const
   dBase_MaxRecCount   = 1000000000;
   dBase_MaxRecSize    = 4000;
   dBase_MaxFieldCount = 128;
   dBase_MaxFieldWidth = 255;
   dBase_MaxNumPrec    = 16;
   dBase_MaxMemoBytes  = 16384;
   dBase_MaxMemoRec    = 512;

   flgDeleted   = #$2A;
   flgUndeleted = #$20;
   flgEOF       = #$1A;
   flgBOF       = #$0D;

   err_ErrorCode = 'Error code: ';
   err_Warning='Warning';
   err_Stop='Error';
   err_BookMark='Cannot find bookmark';
   err_NoRecords='No records';
   err_InValidValue='Invalid value';
   err_ChangeFileName='Cannot change Filename if table is active';
   err_IncorrectDBF='Incorrect DBF file';
   err_AccessOutRange='Access out of range';
   err_WrongFieldDef='Wrong field definition';
   err_FileNotOpen='File not open';

   dBaseIIIPlus     = $03;
   dBaseIIIPlusMemo = $83;

type
  PBoolean = ^Boolean;

  TFilenameProperty = class(TStringProperty)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
  end;

  TDBFError = procedure(Sender: TObject;ErrorMsg:String) of object;

  TFieldName = string[10];

  TDBFBuffer = array[1..dBase_MaxRecSize] of Byte;

  TdBaseIIIPlus_Header = record
    Version,   //$03 without memo, $83 with memo
    Year,
    Month,
    Day :Byte;
    Recordcount :Longint;
    HeaderSize,
    RecordSize :Word;
    Reserved1 :array[1..3] of Byte;
    LANRsvd :array[1..13] of Byte;
    Reserved2 :array[1..4] of Byte;
  end;

  TdBaseIVPlus_Header = record
    Version,  { 01234567
                vvvmsssa
                |  ||  |
                |  ||  - presence of any memo file
                |  |- presence of an SQL table
                |  - presence of a dBASE IV memo
                - indicate version number}
    Year,
    Month,
    Day :Byte;
    Recordcount :Longint;
    HeaderSize,
    RecordSize :Word;
    Reserved1 :array[1..2] of Byte;   //filled with 0
    IncompleteTranstactionFlag,  //$01 transaction protected
    EncryptionFlag :byte;  //$01 encrypted
    MultiuserRsvd :array[1..12] of Byte;
    MDXFlag,   //$01 presence
    LangDrvID :byte;
    { 001 - cp 437
      002 - cp 850
      100 - cp 852
      102 - cp 865
      101 - cp 866
      104 - cp 895
      200 - cp 1250
      201 - cp 1251
      003 - cp 1252                      }
  end;

  TdBaseIIIPlus_Field = record
    Name :array[1..10] of Char;
    ClosingZero :byte;
    FieldType :Char;
    MemAddress :array[1..4] of Byte;
    Width,
    Decimals :Byte;
    LAN1 :array[1..2] of Byte;
    WorkAreaID :byte;
    LAN2 :array[1..2] of Byte;
    SetFields :byte;
    Rsvd :byte;
  end;

  TdBaseIVPlus_Field = record
    Name :array[1..10] of Char;
    ClosingZero :byte;
    FieldType :Char;
    Rsvd1 :array[1..4] of Byte;
    Width,
    Decimals :Byte;
    Rsvd2 :array[1..2] of Byte;
    WorkAreaID :byte;
    Rsvd3 :array[1..10] of Byte;
    Indexed: byte;
  end;

  TDBTHeader = record
    NextBlock :DWORD;
    BlockSize :DWORD;
    Reserved :array[1..504] of Char;
  end;

  PDBFField = ^TDBFField;
  TDBFField = record
    FieldName :TFieldname;
    FieldType :TFieldType;
    Size :word;
    Decimals :Byte;
    Offset :Word;
    Indexed :boolean;
  end;

  TDBFStructure = record
    FileName :string;
    Year, Month, Day :Byte;
    Version :byte;
    RecordCount, DeletedCount :LongInt;
    HeaderSize :Word;
    RecordSize :Word;
    MDXPresent :boolean;
    Encrypted,
    TransProt,
    Memo, AnyMemo :boolean;
    CodePage :word;
    FieldCount :Word;
    Data :TStringList;
    Fields :TList;
  end;

  PRecInfo = ^TRecInfo;
  TRecInfo = packed record
    BookMark: integer;
    UpdateStatus: TUpdateStatus;
    BookmarkFlag: TBookmarkFlag;
  end;

  TDBFAccess = class(TPersistent)
  private
    FFile :TFileStream;
    Fdb3Header :TdBaseIIIPlus_Header;
    Fdb4Header :TdBaseIVPlus_Header;
    Fdb3Field :TdBaseIIIPlus_Field;
    Fdb4Field :TdBaseIVPlus_Field;
    FDBF :TDBFStructure;
    FResult :integer;
    FOnDBFError:TDBFError;
    FPackOnSave: Boolean;
    FDB3 :boolean;
    function CheckRange(FileSize :longint) :integer;
    function CheckField(Field :TDBFField) :integer;
    procedure OpenFile(const Filename :string);
    procedure CreateFile(const Filename :string);
    procedure CloseFile;
    function ReadDBFHeader :integer;
    function ReadDBFFieldDefs :integer;
    function ReadDBFData :integer;
    function WriteDB3Header(HB :TdBaseIIIPlus_Header) :integer;
    function WriteDB4Header(HB :TdBaseIVPlus_Header) :integer;
    function WriteDBFFieldDefs(AFields :TList) :integer;
    function WriteDBFData(AFields :TList; AData :TStringList) :integer;
  protected
    procedure RaiseDBFError;
  public
    constructor Create;
    destructor Destroy; override;
    procedure LoadFromFile(const Filename :string);
    procedure SaveToFile(const Filename :string);
    property Structure :TDBFStructure read FDBF write FDBF;
    property LastError :integer read FResult write FResult;
    property OnDBFError:TDBFError read FOnDBFError write FOnDBFError;
    property PackOnSave :Boolean read FPackOnSave write FPackOnSave;
    property Dbase3 :boolean read FDB3 write FDB3;
  end;

  //PdBaseMemoRecord = ^TdBaseMemoRecord;
  //TdBaseMemoRecord = array [0..dBase_MaxMemoBytes] of byte;

  TMDBFTable = class(TDataset)
  private
    FAccess: TDBFAccess;
    FStructure :TDBFStructure;
    FData :tstringlist;
    FRecSize, FRecBufSize: Integer;
    FRecInfoOfs: Integer;
    FCurRec: Integer;
    FAbout, FFileName: string;
    FLastBookmark: Integer;
    FLastUpdate :string;
    FOnDBFError:TDBFError;
    FMakeBackup :Boolean;
    FShowDeleted: Boolean;
    FModified: Boolean;
    FVersion: string;
    FActiveFilter :boolean;
    FMemoFile :TFileStream;
    DBTHeader: TDBTHeader;
    FMemoFilename :string;
    function GetField(Index :integer) :TDBFField;
    procedure DBFError(Sender: TObject; ErrorMsg :string);
    function GetDeleted: Boolean;
    procedure SetShowDeleted(const Value: Boolean);
    procedure SetFilterActive(const Value: Boolean);
    function GetFilterActive: Boolean;
    function GetCodePage: word;
    function GetDeletedCount: integer;
    function GetEncrypted: boolean;
    function GetPackOnSave: Boolean;
    function GetTransactionProtected: boolean;
    function GetWithMemo: Boolean;
    procedure SetPackOnSave(const Value: Boolean);
  protected
    procedure SetNone(value :string);
    procedure SetFilename(value :string);
    function AllocRecordBuffer: PChar; override;
    procedure FreeRecordBuffer(var Buffer: PChar); override;
    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
    function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
    function GetRecordSize: Word; override;
    function GetFieldPointer(Buffer :PChar; Fields :TField) :PChar;
    function GetActiveRecordBuffer :PChar;
    procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
//    procedure InternalRefresh; 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 InternalInsert; 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;
    function GetRecordCount: Integer; override;
    function GetRecNo: Integer; override;
    procedure SetRecNo(Value: Integer); override;
    function GetData(Field :TField; var Value :pchar; Buffer :PChar) :boolean;
    function FindRecord(Restart, GoForward: Boolean): Boolean; override;
    procedure Zap;
    function HasMemo :boolean;
    function ProcessFilter(Buffer:PChar):boolean;
  public
    constructor Create(AOwner :TComponent); override;
    procedure CreateTable(const FileName :string; Fields :TList; Dbase3 :boolean);
    procedure Save;
    function FindKey(const KeyValues: array of const): Boolean;
    procedure GetFields(var Fields :TList);
    function Locate(const KeyFields: string; const KeyValues: Variant;
      Options: TLocateOptions): Boolean; override;
    function GetMemoData(Field :TField): string;
    procedure SetMemoData(Field :TField; Text :string);
    function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
    {function GetBLOBData(Field :TField): TMemoryStream;
    procedure SetBLOBData(Field :TField; BLOB :TMemoryStream);}
    procedure Undelete;
    property OriginalFields[Index :integer] :TDBFField read GetField;
    property LastUpdate :string read FLastUpdate;
    property Deleted :Boolean read GetDeleted;
    property WithMemo :Boolean read GetWithMemo;
    property DeletedCount :integer read GetDeletedCount;
    property Modified :Boolean read FModified write FModified;
    property Version :string read FVersion;
    property CodePage :word read GetCodePage;
    property TransactionProtected :boolean read GetTransactionProtected;
    property Encrypted :boolean read GetEncrypted;
  published
    property About :string read fabout write SetNone;
    property FileName: string read FFileName write SetFileName;
    property MakeBackup :Boolean read FMakeBackup write FMakeBackup;
    property ShowDeleted :Boolean read FShowDeleted write SetShowDeleted;
    property PackOnSave :Boolean read GetPackOnSave write SetPackOnSave;
    property Filter;
    property Filtered :Boolean read GetFilterActive write SetFilterActive;
    property Active;
    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 OnDBFError:TDBFError read FOnDBFError write FOnDBFError;
    property OnDeleteError;
    property OnEditError;
    property OnNewRecord;
    property OnPostError;
    property OnCalcFields;
  end;

const
   AboutInfo = 'MiTeC DBF Table 1.5 - © 1997,2002, MichaL MutL';

   DBFOK           = 0;
   DBFIncorectFile =-1;
   DBFOutOfRange   =-2;
   DBFWrongFieldDef=-3;
   DBFInvalidValue =-4;
   DBFNotOpened    =-5;

   DBFErrorMessages :array[0..5] of string = ('OK',Err_IncorrectDBF,
                                                   Err_AccessOutRange,
                                                   Err_WrongFieldDef,
                                                   Err_InValidValue,
                                                   Err_FileNotOpen);


procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Data', [TMDBFTable]);
  RegisterPropertyEditor(TypeInfo(String), TMDBFTable, 'FileName', TFileNameProperty);
end;

{TDBFAccess}

constructor TDBFAccess.Create;
begin
  inherited create;
  with fdbf do begin
    data:=tstringlist.create;
    fields:=tlist.create;
    filename:='';
  end;
end;

destructor TDBFAccess.Destroy;
begin
  with fdbf do begin
    data.free;
    fields.free;
  end;
  inherited destroy;
end;

procedure TDBFAccess.OpenFile;
begin
  if (filename<>'') and not assigned(ffile) then
    ffile:=tfilestream.create(filename,fmopenread or fmsharedenywrite);
end;

procedure TDBFAccess.CreateFile;
begin
  if (filename<>'') then begin
    if assigned(ffile) then begin
      ffile.free;
      ffile:=nil;
    end;
    if fileexists(filename) then
      deletefile(filename);
    ffile:=tfilestream.create(filename,fmcreate or fmshareexclusive);
  end;
end;

procedure TDBFAccess.CloseFile;
begin
  if assigned(ffile) then begin
    ffile.free;
    ffile:=nil;
  end;
end;

function TDBFAccess.CheckRange;
begin
  result:=dbfok;
  if FileSize<(fdbf.recordcount*fdbf.recordsize+fdbf.HeaderSize) then
    result:=DBFIncorectFile
  else
    if fdbf.recordcount>dBase_MaxReccount then
      result:=DBFOutOfRange
    else
      if fdbf.RecordSize>dBase_MaxRecSize then
        result:=DBFOutOfRange
      else
        if fdbf.FieldCount>dBase_MaxFieldCount then
          result:=DBFOutOfRange;
end;

function TDBFAccess.CheckField;
begin
  result:=dbfok;
  with field do begin
    if Size>dBase_MaxFieldWidth then
      result:=DBFOutOfRange
    else
      case fieldType of
        ftstring :if Decimals<>0 then
           result:=DBFOutOfRange;
        ftinteger :if (Size>30) or (Decimals<>0) then
           result:=DBFOutOfRange;
        ftfloat :if (Size>30) or (Decimals>size-2) then
           result:=DBFOutOfRange
        else
          if Size+2<Decimals then
            result:=DBFOutOfRange;
        ftdate: if (Size<>8) or (Decimals<>0) then
           result:=DBFOutOfRange;
        ftboolean :if (Size<>1) or (Decimals<>0) then
          result:=DBFOutOfRange;
        ftmemo :if (Size<>10) or (Decimals<>0) then
           result:=DBFOutOfRange;
        ftblob :if (Size<>10) or (Decimals<>0) then
           result:=DBFOutOfRange;
        ftdbaseole :if (Size<>10) or (Decimals<>0) then
           result:=DBFOutOfRange;
        else
          result:=DBFWrongFieldDef;
      end;
    end;
end;

function TDBFAccess.ReadDBFHeader;
var
  buffer :byte;
begin
  if assigned(ffile) then begin
    try
      setlasterror(0);
      ffile.Seek(0,sofrombeginning);
      ffile.Read(Buffer,1);
      ffile.Seek(0,sofrombeginning);
      if not(buffer in [$03..$F5]) then
        result:=DBFIncorectFile
      else
        if buffer in [dBaseIIIPlus,dBaseIIIPlusMemo] then begin
          fdb3:=true;
          ffile.Read(Fdb3Header,32);
          with fdbf do begin
            Year:=Fdb3Header.Year;
            Month:=Fdb3Header.Month;
            Day:=Fdb3Header.Day;
            version:=3;
            Recordcount:=Fdb3Header.Recordcount;
            HeaderSize:=Fdb3Header.HeaderSize;
            RecordSize:=Fdb3Header.RecordSize;
            FieldCount:=Pred(Pred(HeaderSize) div 32);
            mdxpresent:=false;
            memo:=Fdb3Header.Version=dBaseIIIPlusMemo;
            anymemo:=memo;
            codepage:=0;
            encrypted:=false;
            transprot:=false;
            result:=CheckRange(ffile.Size);
          end;
        end else begin
          ffile.Read(Fdb4Header,32);
          fdb3:=false;
          with fdbf do begin
            Year:=Fdb4Header.Year;
            Month:=Fdb4Header.Month;
            Day:=Fdb4Header.Day;
            case Fdb4Header.Version and 7 of
              3 :version:=4;
              else version:=5;
            end;
            Recordcount:=Fdb4Header.Recordcount;
            HeaderSize:=Fdb4Header.HeaderSize;
            RecordSize:=Fdb4Header.RecordSize;
            FieldCount:=Pred(Pred(HeaderSize) div 32);
            mdxpresent:=Fdb4Header.MDXFlag=$01;
            memo:=(Fdb4Header.Version and 128)=128;
            anymemo:=(Fdb4Header.Version and 8)=8;
            transprot:=Fdb4Header.IncompleteTranstactionFlag=$01;
            encrypted:=Fdb4Header.EncryptionFlag=$01;
            case Fdb4Header.LangDrvID of
              001 :codepage:=437;
              002 :codepage:=850;
              100 :codepage:=852;
              102 :codepage:=865;
              101 :codepage:=866;
              104 :codepage:=895;
              200 :codepage:=1250;
              201 :codepage:=1251;
              003 :codepage:=1252;
              else
                 codepage:=0;
            end;
            result:=CheckRange(ffile.Size);
          end;
        end;
    except
      result:=getlasterror;
    end;
  end else
    result:=dbfnotopened;
end;

function TDBFAccess.ReadDBFFieldDefs;
var
  i,o :word;
  b :byte;
  Field :PDBFField;
begin
  o:=1;
  result:=dbfok;
  if assigned(ffile) then begin
    setlasterror(0);
    try
      ffile.Seek(32,sofrombeginning);
      if fdb3 then begin
        for i:=1 to fdbf.FieldCount do
          with fdbf do begin
            new(field);
            ffile.Read(Fdb3Field,32);
            b:=1;
            while (b<=10) and (Fdb3Field.Name[b]<>#0) do
              Inc(b);
            system.Move(Fdb3Field.Name[1],Field^.fieldName[1],Pred(b));
            Field^.fieldName[0]:=Chr(Pred(b));
            if b>0 then
              Field^.fieldName[0]:=Char(Pred(b));
            case Fdb3Field.fieldType of
              'C':Field^.FieldType:=ftstring;
              'N': if Fdb3Field.Decimals>0 then
                     Field^.FieldType:=ftfloat
                   else
                     Field^.FieldType:=ftinteger;
              'F':Field^.FieldType:=ftfloat;
              'D':Field^.FieldType:=ftdate;
              'L':Field^.FieldType:=ftboolean;
              'M':Field^.FieldType:=ftmemo;
              'B':Field^.FieldType:=ftblob;
              'O':Field^.FieldType:=ftdbaseole;
            end;
            Field^.Size:=Fdb3Field.Width;
            Field^.Decimals:=Fdb3Field.Decimals;
            Field^.Offset:=o;
            Field^.indexed:=Fdb3Field.SetFields=1;
            Inc(o,Fdb3Field.Width);
            result:=CheckField(Field^);
            if result=dbfok then
              fields.add(field)
            else
              exit;
          end;
      end else begin
        for i:=1 to fdbf.FieldCount do
          with fdbf do begin
            new(field);
            ffile.Read(Fdb4Field,32);
            b:=1;
            while (b<=10) and (Fdb4Field.Name[b]<>#0) do
              Inc(b);
            system.Move(Fdb4Field.Name[1],Field^.fieldName[1],Pred(b));
            Field^.fieldName[0]:=Chr(Pred(b));
            if b>0 then
              Field^.fieldName[0]:=Char(Pred(b));
            case Fdb4Field.fieldType of
              'C':Field^.FieldType:=ftstring;
              'N': if Fdb4Field.Decimals>0 then
                     Field^.FieldType:=ftfloat
                   else
                     Field^.FieldType:=ftinteger;
              'F':Field^.FieldType:=ftfloat;
              'D':Field^.FieldType:=ftdate;
              'L':Field^.FieldType:=ftboolean;
              'M':Field^.FieldType:=ftmemo;
              'B':Field^.FieldType:=ftblob;
              'O':Field^.FieldType:=ftdbaseole;
            end;
            Field^.Size:=Fdb4Field.Width;
            Field^.Decimals:=Fdb4Field.Decimals;
            Field^.Offset:=o;
            Field^.indexed:=Fdb4Field.Indexed=1;
            Inc(o,Fdb4Field.Width);
            result:=CheckField(Field^);
            if result=dbfok then
              fields.add(field)
            else
              exit;
          end;
      end;
    except
      result:=getlasterror;
    end;
  end else
    result:=dbfnotopened;
end;

function TDBFAccess.ReadDBFData;
var
  r :integer;
  fbuffer :^TDBFBuffer;
begin
  if assigned(ffile) then begin
    ffile.seek(fDBF.HeaderSize,sofrombeginning);
    r:=fDBF.RecordSize;
    while (ffile.position+fDBF.RecordSize<ffile.Size) and (r=fDBF.RecordSize) do begin
      new(fbuffer);
      r:=ffile.Read(fbuffer^,fDBF.RecordSize);
      fdbf.data.add(strpas(pchar(fbuffer)));
    end;
    result:=dbfok;
  end else
    result:=dbfnotopened;
end;

function TDBFAccess.WriteDB3Header;
var
  y,m,d :word;
begin
  if assigned(ffile) then begin
    result:=dbfok;
    decodedate(date,y,m,d);
    if y>2000 then
      y:=y-2000
    else
      y:=y-1900;
    hb.Year:=Y;
    hb.Month:=M;
    hb.Day:=D;
    setlasterror(0);
    try
      ffile.Seek(0,sofrombeginning);
      ffile.Write(hb,32);
    except
      result:=getlasterror;
    end;
  end else
    result:=dbfnotopened;
end;

function TDBFAccess.WriteDB4Header(HB: TdBaseIVPlus_Header): integer;
var
  y,m,d :word;
begin
  if assigned(ffile) then begin
    result:=dbfok;
    decodedate(date,y,m,d);
    if y>2000 then
      y:=y-2000
    else
      y:=y-1900;
    hb.Year:=Y;
    hb.Month:=M;
    hb.Day:=D;
    setlasterror(0);
    try
      ffile.Seek(0,sofrombeginning);
      ffile.Write(hb,32);
    except
      result:=getlasterror;
    end;
  end else
    result:=dbfnotopened;
end;

function TDBFAccess.WriteDBFFieldDefs;
var
  i :word;
begin
  result:=dbfok;
  if assigned(ffile) then begin
    setlasterror(0);
    try
      if fdb3 then
        for i:=0 to aFields.Count-1 do begin
          FillChar(Fdb3Field,SizeOf(Fdb3Field),0);
          Move(tdbffield(aFields.items[i]^).fieldName[1],Fdb3Field.Name,Length(tdbffield(aFields.items[i]^).fieldName));
          case tdbffield(aFields.items[i]^).FieldType of
            ftstring: Fdb3Field.FieldType:='C';
            ftinteger: Fdb3Field.FieldType:='N';
            ftdate: Fdb3Field.FieldType:='D';
            ftboolean: Fdb3Field.FieldType:='L';
            ftmemo: Fdb3Field.FieldType:='M';
          end;
          Fdb3Field.Width:=tdbffield(aFields.items[i]^).size;
          Fdb3Field.Decimals:=tdbffield(aFields.items[i]^).Decimals;
          Fdb3Field.SetFields:=byte(tdbffield(aFields.items[i]^).indexed);
          ffile.Write(Fdb3Field,32);
        end
      else
        for i:=0 to aFields.Count-1 do begin
          FillChar(Fdb4Field,SizeOf(Fdb4Field),0);
          Move(tdbffield(aFields.items[i]^).fieldName[1],Fdb4Field.Name,Length(tdbffield(aFields.items[i]^).fieldName));
          case tdbffield(aFields.items[i]^).FieldType of
            ftstring: Fdb4Field.FieldType:='C';
            ftinteger: Fdb4Field.FieldType:='N';
            ftfloat: Fdb4Field.FieldType:='F';
            ftdate: Fdb4Field.FieldType:='D';
            ftboolean: Fdb4Field.FieldType:='L';
            ftmemo: Fdb4Field.FieldType:='M';
            ftblob: Fdb4Field.FieldType:='B';
            ftdbaseole: Fdb4Field.FieldType:='O';
          end;
          Fdb4Field.Width:=tdbffield(aFields.items[i]^).size;
          Fdb4Field.Decimals:=tdbffield(aFields.items[i]^).Decimals;
          Fdb4Field.Indexed:=byte(tdbffield(aFields.items[i]^).indexed);
          ffile.Write(Fdb4Field,32);
        end
    except
      result:=getlasterror;
    end;
  end else
    result:=dbfnotopened;
end;


function TDBFAccess.WriteDBFData;
var
  fbuffer :pchar;
  recsize,i :integer;
  S:char;
begin
  if assigned(ffile) then begin
    result:=dbfok;
    setlasterror(0);
    recsize:=1;
    for i:=0 to afields.count-1 do
      recsize:=recsize+tdbffield(afields.items[i]^).size;
    fbuffer:=stralloc(recsize+1);
    try
      S:=flgBOF;
      ffile.write(S,1);
      if assigned(adata) then begin
        for i:=0 to adata.count-1 do
          if not packonsave or (packonsave and (PChar(adata[i])[0]<>flgDeleted)) then begin
            StrCopy(FBuffer,PChar(adata[i]));
            ffile.write(fBuffer^,recsize);
          end;
       S:=flgEOF;
      end;
      ffile.write(S,1);
    finally
      strdispose(fbuffer);
    end;
  end else
    result:=dbfnotopened;
end;

procedure TDBFAccess.RaiseDBFError;
var
  s :string;
begin
  if (fresult<0) then
    s:=DBFErrorMessages[abs(fresult)]
  else
    s:=Err_ErrorCode+inttostr(fresult);
  if Assigned(FOnDBFError) then
    FOnDBFError(Self,s);
  Abort;
end;

procedure TDBFAccess.LoadFromFile;
begin
  fdbf.filename:=filename;
  fdbf.fields.clear;
  fdbf.data.clear;
  openfile(fdbf.filename);
  fresult:=readdbfheader;
  if fresult=dbfok then begin
    fresult:=readdbffielddefs;
    if fresult=dbfok then
begin
      fresult:=readdbFData;
end;
  end;
  closefile;
  if fresult<>dbfok then
    raisedbferror;
end;

procedure TDBFAccess.SaveToFile;
begin
  createfile(filename);
  if fdbf.version=3 then begin
    {if fdbf.Memo then
      Fdb3Header.Version:=dbaseiiiplusmemo
    else
      Fdb3Header.Version:=dbaseiiiplus;}
    if PackOnSave then
      Fdb3Header.Recordcount:=fDBF.data.Count-FDBF.DeletedCount
    else
      Fdb3Header.Recordcount:=fDBF.data.count;
    Fdb3Header.HeaderSize:=fDBF.HeaderSize;
    Fdb3Header.RecordSize:=fDBF.RecordSize;
    fresult:=writedb3header(Fdb3Header);
  end else begin
    {Fdb4Header.Version:=0;
    Fdb4Header.Version:=Fdb4Header.Version or 3;
    if fdbf.AnyMemo then
      Fdb4Header.Version:=Fdb4Header.Version or 128;
    if fdbf.Memo then
      Fdb4Header.Version:=Fdb4Header.Version or 8;
    Fdb4Header.MDXFlag:=byte(fdbf.MDXPresent);
    Fdb4Header.EncryptionFlag:=byte(fdbf.Encrypted);
    Fdb4Header.IncompleteTranstactionFlag:=byte(fdbf.TransProt);}
    if PackOnSave then
      Fdb4Header.Recordcount:=fDBF.data.Count-FDBF.DeletedCount
    else
      Fdb4Header.Recordcount:=fDBF.data.Count;
    Fdb4Header.HeaderSize:=fDBF.HeaderSize;
    Fdb4Header.RecordSize:=fDBF.RecordSize;
    fresult:=writedb4header(Fdb4Header);
  end;
  if fresult=dbfok then begin
    fresult:=writedbffielddefs(fdbf.fields);
    if fresult=dbfok then
       fresult:=writedbFData(fdbf.fields,fdbf.data);
  end;
  closefile;
  if fresult<>dbfok then
    raisedbferror;
end;

{TMDBFTable}

constructor TMDBFTable.Create;
begin
  inherited create(aowner);
  faccess:=tdbfaccess.create;
  faccess.OnDbfError:=DBFError;
  fabout:=aboutinfo;
  fversion:='Unknown';
end;

function TMDBFTable.GetField;
begin
  result:=tdbffield(FStructure.fields[index]^);
end;

procedure TMDBFTable.DBFError(Sender: TObject;ErrorMsg:String);
begin
  if Assigned(FOnDBFError) then
     FOnDBFError(Self,ErrorMsg) else
     MessageBox(0,PChar(ErrorMsg),Err_Stop,mb_Ok or mb_IconStop or mb_DefButton1);
end;

procedure TMDBFTable.SetFilename;
begin
  if active then begin
    if Assigned(FOnDBFError) then
      FOnDBFError(Self,Err_ChangeFileName)
    else
      MessageBox(0,Err_ChangeFileName,Err_Warning,mb_Ok or mb_IconExclamation or mb_DefButton1);
  end else
    ffilename:=value;
end;

procedure TMDBFTable.SetNone;
begin
end;

procedure TMDBFTable.InternalOpen;
var
  I: Integer;
  y :word;
begin
  faccess.loadfromfile(ffilename);
  FStructure:=FAccess.Structure;
  FData:=FStructure.data;
  FStructure.DeletedCount:=0;
  for I:=1 to FData.Count do begin
    FData.Objects[I-1]:=Pointer(I);
    if PChar(FData[i-1])[0]=flgDeleted then
      Inc(FStructure.Deletedcount);
  end;
  if WithMemo then begin
    try
      FMemoFilename:=changefileext(FFileName,'.dbt');
      FMemoFile:=TFileStream.Create(FMemoFilename,fmOpenReadWrite);
      FMemoFile.Seek(0,soFromBeginning);
      FMemoFile.ReadBuffer(DBTHeader,Sizeof(DBTHeader));
    except
      on e:exception do
        showmessage(e.message);
    end;
  end;
  fversion:='dBase ?';
  case FStructure.version of
    3: fversion:='dBase III+';
    4: fversion:='dBase IV';
    5: fversion:='dBase/Win';
  end;
  if FStructure.Year>50 then
    y:=FStructure.Year+1900
  else
    y:=FStructure.Year+2000;
  FLastUpdate:=datetostr(encodedate(y,FStructure.month,FStructure.day));
  FLastBookmark:=FData.Count;
  FCurRec:=-1;
  frecsize:=1;
  for i:=0 to FStructure.fields.count-1 do
    frecsize:=frecsize+tdbffield(FStructure.fields.items[i]^).size;
  FRecInfoOfs:=frecsize;
  FRecBufSize:=FRecInfoOfs+SizeOf(TRecInfo);
  BookmarkSize:=SizeOf(Integer);
  InternalInitFieldDefs;
  if DefaultFields then
    CreateFields;
  BindFields(True);
end;


procedure TMDBFTable.InternalClose;
begin
  if Assigned(FMemoFile) then begin
    FMemoFile.Free;
    FMemoFile:=nil;
  end;  
  if DefaultFields then
    DestroyFields;
  FLastBookmark:=0;
  FCurRec:=-1;
end;

function TMDBFTable.IsCursorOpen: Boolean;
begin
  result:=Assigned(FData);
end;

procedure TMDBFTable.InternalInitFieldDefs;
var
  i,s :integer;
begin
  FieldDefs.Clear;
  with FStructure.fields do
    for i:=0 to FStructure.fieldcount-1 do begin
      if tdbffield(items[i]^).fieldtype in [ftstring,ftmemo] then
        s:=tdbffield(items[i]^).size
      else
        s:=0;
      TFieldDef.Create(FieldDefs,tdbffield(items[i]^).fieldname,
        tdbffield(items[i]^).fieldtype,s,False,i+1)
    end;
end;

procedure TMDBFTable.InternalHandleException;
begin
  Application.HandleException(Self);
end;

procedure TMDBFTable.InternalGotoBookmark(Bookmark: Pointer);
var
  Index: Integer;
begin
  Index:=FData.IndexOfObject(TObject(PInteger(Bookmark)^));
  if Index<>-1 then
    FCurRec:=Index
  else
    DatabaseError(Err_BookMark);
end;

procedure TMDBFTable.InternalSetToRecord(Buffer: PChar);
begin
  InternalGotoBookmark(@PRecInfo(Buffer + FRecInfoOfs).Bookmark);
end;

function TMDBFTable.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
begin
  Result:=PRecInfo(Buffer+FRecInfoOfs).BookmarkFlag;
end;

procedure TMDBFTable.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
begin
  PRecInfo(Buffer+FRecInfoOfs).BookmarkFlag := Value;
end;

procedure TMDBFTable.GetBookmarkData(Buffer: PChar; Data: Pointer);
begin
  PInteger(Data)^:=PRecInfo(Buffer+FRecInfoOfs).Bookmark;
end;

procedure TMDBFTable.SetBookmarkData(Buffer: PChar; Data: Pointer);
begin
  PRecInfo(Buffer+FRecInfoOfs).Bookmark:=PInteger(Data)^;
end;

function TMDBFTable.GetRecordSize: Word;
begin
  Result:=frecsize;
end;

function TMDBFTable.AllocRecordBuffer: PChar;
begin
  GetMem(Result, FRecBufSize);
end;

procedure TMDBFTable.FreeRecordBuffer(var Buffer: PChar);
begin
  FreeMem(Buffer, FRecBufSize);
end;

function TMDBFTable.GetRecord(Buffer: PChar; GetMode: TGetMode;
  DoCheck: Boolean): TGetResult;
var
  accept :Boolean;
begin
  Result:=grOk;
  if FData.count < 1 then
    Result:=grEOF
  else
    repeat
      case GetMode of
        gmNext:
          if FCurRec >= RecordCount - 1  then
            result:=grEOF
          else
            Inc(FCurRec);
        gmPrior:
          if FCurRec <= 0 then
            result:=grBOF
          else
            Dec(FCurRec);
        gmCurrent:
          if (FCurRec < 0) or (FCurRec >= RecordCount) then
            result:=grError;
      end;
      if result=grOK then begin
        StrLCopy(Buffer, PChar(FData[FCurRec]),frecsize);
        ClearCalcFields(Buffer);
        GetCalcFields(Buffer);
        with PRecInfo(Buffer+FRecInfoOfs)^ do begin
          BookmarkFlag:=bfCurrent;
          Bookmark:=Integer(FData.Objects[FCurRec]);
        end;
      end else
        if (result=grError) and DoCheck then
          DatabaseError(Err_NoRecords);
      accept:=(fshowdeleted or (not fshowdeleted and (buffer[0]<>flgDeleted)));
      if Filtered or FActiveFilter then
        accept:=accept and ProcessFilter(Buffer);
      if (GetMode=gmCurrent) and not Accept then
        Result:=grError;
    until (Result<>grOK) or Accept;
  if ((Result=grEOF) or (Result=grBOF)) and (Filtered or FActiveFilter) and not (ProcessFilter(Buffer)) then
    Result := grError;
end;

procedure TMDBFTable.InternalInitRecord(Buffer: PChar);
begin
  FillChar(Buffer^,RecordSize,0);
end;

function TMDBFTable.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
begin
  if (FData.count=0) and (fcurrec=-1) and (state=dsbrowse) then
    fillchar(activeBuffer^,RecordSize,0);
  if not (Field.datatype in [ftmemo,ftgraphic,ftblob,ftdbaseole]) then
    Result:=getdata(field,pchar(buffer),activebuffer)
  else
    Result:=True;
end;

procedure TMDBFTable.SetFieldData(Field: TField; Buffer: Pointer);
var
  Offs,fs :integer;
  i,j,p :integer;
  s :string;
  dt :TDateTime;
  eof :boolean;
begin
  if (Field.FieldNo>=0) and (Assigned(Buffer)) then begin
    if activebuffer[0]=#0 then
      FillChar(activeBuffer^,RecordSize,32);
    offs:=tdbffield(FStructure.fields.Items[Field.fieldno-1]^).Offset;
    fs:=tdbffield(FStructure.fields.Items[Field.fieldno-1]^).Size;
    case Field.DataType of
      ftString: ;
      ftFloat :begin
        Str(pdouble(Buffer)^:fs:tdbffield(FStructure.fields.Items[Field.fieldno-1]^).Decimals,s);
        while Length(s)<fs do
          s:=' '+s;
        p:=Pos(DecimalSeparator,s);
        if (p>0) and (DecimalSeparator<>'.') then
          s[p]:='.';
        strlcopy(buffer,PChar(s),fs);
      end;
      ftInteger, ftMemo :begin
        s:=inttostr(pinteger(Buffer)^);
        while Length(s)<fs do
          s:=' '+s;
        strlcopy(buffer,PChar(s),fs);
      end;
      ftDate :begin
        j:=pinteger(Buffer)^-693594;
        pdouble(@dt)^:=j;
        s:=FormatDateTime('yyyymmdd',dt);
        StrLCopy(Buffer,PChar(s),fs);
      end;
      ftBoolean :if pboolean(Buffer)^ then
                   pchar(Buffer)^:='T'
                 else
                   pchar(Buffer)^:='F';
      ftgraphic,ftblob :;
      else
        raise Exception.Create('Unexpected field type.');
    end;
    eof:=false;
    if activebuffer[frecsize]<>#0 then
      activebuffer[frecsize]:=#0;
    for i:=offs to offs+fs-1 do begin
      if not eof then
        eof:=(pchar(buffer)[i-offs]=#0) and (i>0);
      if not eof then
        activebuffer[i]:=pchar(buffer)[i-offs]
      else
        activebuffer[i]:=#32;
    end;
    {if Field.DataType=ftMemo then
      strcopy(pchar(FData[FCurRec]),activebuffer);}
    DataEvent(deFieldChange,Longint(Field));
  end;
end;

procedure TMDBFTable.InternalFirst;
begin
  FCurRec:=-1;
end;

procedure TMDBFTable.InternalLast;
begin
  FCurRec:=FData.Count;
end;

procedure TMDBFTable.InternalPost;
begin
  FModified:=True;
  if (State=dsEdit) then begin
    FData[FCurRec]:=ActiveBuffer;
  end else begin
    Inc(FLastBookmark);
    if (State=dsInsert) and (FCurRec<0) then
      FCurRec:=0;
    FData.InsertObject(FCurRec, ActiveBuffer, Pointer(FLastBookmark));
  end;
end;

procedure TMDBFTable.InternalAddRecord(Buffer: Pointer; Append: Boolean);
begin
  FModified:=True;
  Inc(FLastBookmark);
  if Append then
    InternalLast;
  FData.InsertObject(FCurRec, PChar(Buffer), Pointer(FLastBookmark));
end;

procedure TMDBFTable.InternalDelete;
begin
{  FData.Delete(FCurRec);
  if FCurRec >= FData.Count then
    Dec(FCurRec);
  if fcurrec=-1 then
    FillChar(activeBuffer^,RecordSize,0);}
  PChar(FData[FCurRec])[0]:=flgDeleted;
  PChar(activebuffer)[0]:=flgDeleted;
  Inc(FStructure.DeletedCount);
  FModified:=True;
  //refresh;
end;

function TMDBFTable.GetRecordCount: Longint;
begin
  result:=FData.Count;
end;

function TMDBFTable.GetRecNo: Longint;
begin
  UpdateCursorPos;
  if (FCurRec = -1) and (RecordCount > 0) then
    result:=1 else
    result:=FCurRec + 1;
end;

procedure TMDBFTable.SetRecNo(Value: Integer);
begin
  if (Value >= 0) and (Value < FData.Count) then
  begin
    FCurRec := Value - 1;
    Resync([]);
  end;
end;

procedure TMDBFTable.CreateTable;
var
  hb :TdBaseIIIPlus_Header;
  i :integer;
begin
  with FAccess do begin
    createfile(filename);
    HB.Recordcount:=0;
    HB.HeaderSize:=succ(succ(Fields.Count)*32);
    hb.recordsize:=1;
    hb.version:=$03;
    FillChar(hb.Reserved1,3,0);
    FillChar(hb.LANRsvd,13,0);
    FillChar(hb.Reserved2,4,0);
    for i:=0 to fields.count-1 do
      hb.recordsize:=hb.recordsize+tdbffield(fields.items[i]^).size;
    fresult:=writedb3header(hb);
    if fresult=dbfok then begin
      fresult:=writedbffielddefs(fields);
      if fresult=dbfok then
        fresult:=writedbFData(fields,nil);
    end;
    closefile;
    if fresult<>dbfok then
      raisedbferror;
  end;
end;

function TMDBFTable.FindKey(const KeyValues: array of const): Boolean;
var
  i : integer;
begin
  result:=false;
  for i:=0 to FData.Count-1 do
    if pos(KeyValues[0].VPChar,FData[i])>0 then begin
      result:=true;
      FCurRec := i;
      resync([]);
      break;
    end;
end;

procedure TMDBFTable.Save;
var
  bakfile :string;
begin
  if fmakebackup then begin
    bakfile:=changefileext(ffilename,'.~'+Copy(extractfileext(ffilename),2,255));
    if fileexists(bakfile) then
      deletefile(bakfile);
    renamefile(ffilename,bakfile);
  end;
  with FAccess do begin
    Structure:=FStructure;
    PackOnSave:=FPackOnSave;
    SaveToFile(ffilename);
  end;
  FModified:=false;
end;

procedure TMDBFTable.Zap;
var
  i :integer;
begin
  FModified:=True;
  for i:=0 to FData.count-1 do
    delete;
  FillChar(activeBuffer^,RecordSize,0);
end;

procedure TMDBFTable.GetFields;
begin
  fields:=FStructure.fields;
end;

function TMDBFTable.Locate(const KeyFields: string;
  const KeyValues: Variant; Options: TLocateOptions): Boolean;
var
  i,j,a,n : integer;
  fn,s,k,v :string;
  kv :variant;
  p :pchar;
  found :boolean;
begin
  kv:=keyvalues;
  if not varisarray(kv) then
    kv:=vararrayof([keyvalues]);
  n:=vararrayhighbound(kv,1)+1;
  if length(trim(keyfields))>0 then begin
    p:=stralloc(dBase_MaxFieldWidth);
    result:=false;
    for a:=0 to FData.count-1 do begin
      j:=1;
      for i:=0 to n-1 do begin
        fn:=extractfieldname(keyfields,j);
        getdata(fieldbyname(fn),p,pchar(FData[a]));
        v:=strpas(p);
        if fieldbyname(fn).datatype=ftstring then begin
          if locaseinsensitive in options then begin
            s:=uppercase(v);
            k:=uppercase(kv[i]);
          end else begin
            s:=v;
            k:=kv[i];
          end;
          if lopartialkey in options then
            found:=(pos(k,s)=1)
          else
            found:=(k=s);
        end else
          found:=(v=kv[i]);
        result:=found;
        if not found then
          break;
      end;
      if result then begin
        fcurrec:=a;
        resync([]);
        break;
      end;
    end;
    strdispose(p);
  end else
    result:=false;
end;

function TMDBFTable.GetData(Field :TField; var Value :pchar; Buffer :pchar) :boolean;
var
  Offs :integer;
  s :string;
  Buf :PChar;
  i,j,l,p :integer;
  d :Double;
  n :integer;
  dt :TDateTime;
  OldDateFormat :string;
begin
  Result:=false;
  Buf:=Buffer;//ActiveBuffer;
  if (not IsEmpty) and (RecordCount>0) and (Field.FieldNo>0) and (Assigned(Buffer)) and (Assigned(Buf)) then begin
    offs:=tdbffield(FStructure.fields.Items[Field.fieldno-1]^).Offset;
    case Field.DataType of
      ftString: begin
        l:=tdbffield(FStructure.fields.Items[Field.fieldno-1]^).Size;
        s:='';
        i:=0;
        while (Buf[offs+i]<>#0) and (i<l) do begin
          s:=s+Buf[offs+i];
          inc(i);
        end;
        s:=Trim(s);
        s:=s+#0;
        CharToOemBuff(PChar(s),value,l+1);
        Result:=true;
      end;
      ftFloat,ftInteger :begin
        n:=tdbffield(FStructure.fields.Items[Field.fieldno-1]^).Size;
        s:='';
        for i:=offs to offs+n-1 do
          s:=s+Buf[i];
        s:=Trim(s);
        if s='' then
          Result:=false
        else begin
          if Field.DataType=ftfloat then begin
            p:=pos('.',s);
            if (p>0) and (DecimalSeparator<>'.') then
              s[p]:=DecimalSeparator;
            result:=true;
            try
              d:=StrToFloat(s);
            except
              d:=0;
              result:=false;
            end;
            PDouble(value)^:=d;
          end else begin
            Result:=True;
            try
              i:=StrToint(s);
            except
              i:=0;
              result:=false;
            end;
            Pinteger(value)^:=i;
          end;
        end;
      end;
      ftDate :begin
        s:='';
        for j:=0 to 7 do
          s:=s+Buf[offs+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';
          dt:=StrToDate(s);
          ShortDateFormat:=OldDateFormat;
          j:=Trunc(PDouble(@dt)^)+693594;
          pinteger(value)^:=j;
          result:=true;
        end;
      end;
      ftBoolean :begin
        result:=true;
        if Buf[offs] in ['S','T','Y'] then
          pboolean(value)^:=True
        else
          if Buf[Offs] in ['N','F'] then
            pboolean(value)^:=false
          else
            result:=false;
      end;
      ftMemo,ftgraphic,ftblob,ftdbaseole :begin
        n:=tdbffield(FStructure.fields.Items[Field.fieldno-1]^).Size;
        s:='';
        for i:=offs to offs+n-1 do
          s:=s+Buf[i];
        s:=Trim(s);
        if s='' then
          Result:=false
        else begin
          Result:=True;
          try
            i:=StrToint(s);
          except
            i:=0;
            result:=false;
          end;
          Pinteger(value)^:=i;
        end;
      end;
      else begin
        ShowMessage('Unexpected field type.');
        result:=false;
      end;
    end;
  end;
end;

procedure TMDBFTable.UnDelete;
begin
  PChar(activebuffer)[0]:=flgUndeleted;
  PChar(FData[FCurRec])[0]:=flgUndeleted;
  Dec(FStructure.DeletedCount);
  FModified:=True;
  //refresh;
end;

function TMDBFTable.GetDeleted: Boolean;
begin
  Result:=PChar(activebuffer)[0]=flgDeleted;
end;

procedure TMDBFTable.SetShowDeleted(const Value: Boolean);
begin
  if FShowDeleted<>Value then begin;
    FShowDeleted := Value;
    if Active then
      refresh;
  end;
end;

function TMDBFTable.GetFieldPointer(Buffer: PChar; Fields: TField): PChar;
begin
  Result:=Buffer;
  if Buffer=nil then
    exit;
  inc(Result,tdbffield(FStructure.fields.items[fields.fieldno-1]^).offset);
end;

function TMDBFTable.GetActiveRecordBuffer: PChar;
begin
  if State=dsBrowse then begin
    if IsEmpty then
      Result:=nil
    else
      Result:=ActiveBuffer;
  end else
    Result:=ActiveBuffer;
end;

function TMDBFTable.HasMemo: boolean;
var
  i :integer;
begin
  result:=false;
  for i:=0 to fieldcount-1 do
    if originalfields[i].FieldType=ftmemo then begin
      result:=true;
      break;
    end;
end;

function TMDBFTable.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
    result:=True;
    Exit;
  end;
  FName := Trim(Copy(FilterExpresion,1,PosComp-1));
  FieldPos := FieldDefs.IndexOf(FName);
  FieldOffset := tdbffield(FStructure.fields.Items[fieldpos]^).offset;
  if FieldPos < 0 then
    Result:=True
  else
    if tdbffield(FStructure.fields.Items[fieldpos]^).FieldType = ftString then begin // STRING
      try
        FieldValue := '';
        //FieldOffset := FieldOffset+1;
        While (Buffer[FieldOffset]<>#0) and (Length(FieldValue)<tdbffield(FStructure.fields.Items[fieldpos]^).Size) 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
          Result := (FieldValue=TestValue)
        else
          if FilterExpresion[PosComp]='>' then begin
            if FilterExpresion[PosComp+1]='=' then
              Result := (FieldValue>=Copy(TestValue,2,(Length(TestValue)-1)))
            else
              Result := (FieldValue>TestValue);
          end
        else
          if FilterExpresion[PosComp]='<' then begin
            if FilterExpresion[PosComp+1]='=' then
              Result := (FieldValue<=Copy(TestValue,2,(Length(TestValue)-1)))
            else
              if FilterExpresion[PosComp+1]='>' then
                Result := (FieldValue<>Copy(TestValue,2,(Length(TestValue)-1)))
              else
                Result := (FieldValue<TestValue);
          end else
            Result := False;
      except
        Result := False;
      end;
    end
  else
    if tdbffield(FStructure.fields.Items[fieldpos]^).FieldType in [ftFloat,ftinteger] then begin // FLOAT
      try
        FieldText := '';
        //FieldOffset := FieldOffset+1;
        while (Buffer[FieldOffset]<>#0) and (Length(FieldText)<tdbffield(FStructure.fields.Items[fieldpos]^).Size) 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
          Result := (FieldValue=TestValue)
        else
          if FilterExpresion[PosComp]='>'then begin
            if FilterExpresion[PosComp+1]='='then
              Result := (FieldValue>=TestValue)
            else
              Result := (FieldValue>TestValue);
          end
        else
          if FilterExpresion[PosComp]='<'then begin
            if FilterExpresion[PosComp+1]='='then
              Result := (FieldValue<=TestValue)
            else
              if FilterExpresion[PosComp+1]='>'then
                Result := (FieldValue<>TestValue)
              else
                Result := (FieldValue<TestValue);
          end
        else
          Result := False;
      except
        Result := False;
      end;
    end
  else
    if tdbffield(FStructure.fields.Items[fieldpos]^).FieldType = ftDate then begin // DATE
      OldShortDateFormat := ShortDateFormat;
      try
        FieldText := '';
        //FieldOffset := FieldOffset+1;
        while (Buffer[FieldOffset]<>#0) and (Length(FieldText)<tdbffield(FStructure.fields.Items[fieldpos]^).Size) 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
          Result := (FieldValue=TestValue);
        end else
          if FilterExpresion[PosComp]='>' then begin
            if FilterExpresion[PosComp+1]='='then
              Result := (FieldValue>=TestValue)
            else
              Result := (FieldValue>TestValue);
          end
        else
          if FilterExpresion[PosComp]='<' then begin
            if FilterExpresion[PosComp+1]='='then
              Result := (FieldValue<=TestValue)
            else
              if FilterExpresion[PosComp+1]='>'then
                Result := (FieldValue<>TestValue)
              else
                Result := (FieldValue<TestValue);
          end
        else
          Result := False;
      except
        Result := False;
      end;
      ShortDateFormat := OldShortDateFormat;
    end else
      if tdbffield(FStructure.fields.Items[fieldpos]^).FieldType = ftBoolean then begin
        try
          if (Buffer[FieldOffset+1]='T') or (Buffer[FieldOffset+1]='t') or
             (Buffer[FieldOffset+1]='Y') or (Buffer[FieldOffset+1]='y') or
             (Buffer[FieldOffset+1]='S') or (Buffer[FieldOffset+1]='s') then
            FieldValue := True
          else
            FieldValue := False;
        FieldText := Trim(Copy(FilterExpresion,PosComp+1,Length(FilterExpresion)-PosComp));
        if FilterExpresion[PosComp]='=' then  begin
          if (FieldText='T') or (FieldText='t') or
             (FieldText='Y') or (FieldText='y') or
             (FieldText='S') or (FieldText='s') then
            TestValue := True
          else
            TestValue := False;
          Result := (FieldValue=TestValue)
        end
      else
        if FilterExpresion[PosComp]='>' then begin
          if FilterExpresion[PosComp+1]='=' then  begin
              if (FieldText[2]='T') or (FieldText[2]='t') or
                 (FieldText[2]='Y') or (FieldText[2]='y') or
                 (FieldText[2]='S') or (FieldText[2]='s') then
                TestValue := True
              else
                TestValue := False;
              Result := (FieldValue>=TestValue);
            end else begin
              if (FieldText[1]='T') or (FieldText[1]='t') or
                 (FieldText[1]='Y') or (FieldText[1]='y') or
                 (FieldText[1]='S') or (FieldText[1]='s') then
                TestValue := True
              else
                TestValue := False;
              Result := (FieldValue>TestValue);
            end;
        end
      else
        if FilterExpresion[PosComp]='<' then begin
          if FilterExpresion[PosComp+1]='=' then begin
              if (FieldText[2]='T') or (FieldText[2]='t') or
                 (FieldText[2]='Y') or (FieldText[2]='y') or
                 (FieldText[2]='S') or (FieldText[2]='s') then
                TestValue := True
              else
                TestValue := False;
              Result := (FieldValue<=TestValue);
            end
          else
            if FilterExpresion[PosComp+1]='>' then begin
              if (FieldText[2]='T') or (FieldText[2]='t') or
                 (FieldText[2]='Y') or (FieldText[2]='y') or
                 (FieldText[2]='S') or (FieldText[2]='s') then
                TestValue := True
              else
                TestValue := False;
              Result := (FieldValue<>TestValue);
            end else begin
              if (FieldText[1]='T') or (FieldText[1]='t') or
                 (FieldText[1]='Y') or (FieldText[1]='y') or
                 (FieldText[1]='S') or (FieldText[1]='s') then
                TestValue := True
              else
                TestValue := False;
              Result := (FieldValue<TestValue);
            end;
        end
      else
        Result := False;
     except
       Result := False;
     end;
    end
  else
    Result := False;
end;

function TMDBFTable.FindRecord(Restart, GoForward: Boolean): Boolean;
var
  Status : Boolean;
begin
  CheckBrowseMode;
  DoBeforeScroll;
  UpdateCursorPos;
  CursorPosChanged;
  try
    if GoForward then begin
      if Restart then
        First;
      if Filtered then
        fActiveFilter := True;
      Status := GetNextRecord;
    end else begin
      if Restart then
        Last;
      if Filtered then
        fActiveFilter := True;
      Status := GetPriorRecord;
    end;
  finally
    if Filtered then
      fActiveFilter := False;
  end;
  Result := Status;
  if Result then
    DoAfterScroll;
end;

procedure TMDBFTable.SetFilterActive(const Value: Boolean);
begin
  SetFiltered(Value);
  if Active then
    refresh;
end;

function TMDBFTable.GetFilterActive: Boolean;
begin
  Result:=inherited Filtered;
end;

function TMDBFTable.GetMemoData(Field :TField): string;
var
  TmpS :string;
  Buff :array[1..512] of Char;
  Flag :boolean;
  Block :pinteger;
begin
  if assigned(FMemofile) then
  try
    TmpS:='';
    Flag:=false;
    new(Block);
    getdata(Field,PChar(block),activebuffer);
    FMemoFile.Seek(Block^*512,soFromBeginning);
    while (not Flag) do begin
      if FMemoFile.Read(Buff,512)<512 then
        Flag:=True;
      if Pos(#$1A#$1A,Buff)>0 then begin
        TmpS:=TmpS+Copy(Buff,1,Pos(#$1A#$1A,Buff)-1);
        Flag:=True;
      end else
        TmpS:=TmpS+Copy(Buff,1,Pos(#$1A,Buff)-1);
    end;
    while Pos(#$8D,TmpS)>0 do
      TmpS[Pos(#$8D,TmpS)]:=#$D;
    Result:=TmpS;
    dispose(block);
  except
    raise Exception.Create('Error occured while reading memo data.');
  end;
end;

procedure TMDBFTable.SetMemoData(Field: TField; Text: string);
var
  TmpL : Longint;
  Block: pinteger;
  s :string;
begin
  if assigned(FMemofile) then begin
    new(Block);
    Block^:=DBTHeader.NextBlock;
    SetFieldData(Field,PChar(Block));
    FMemoFile.Seek(-1,soFromEnd);
    s:=#$1A#$1A;
    for TmpL:=1 to Length(s) do
      FMemoFile.write(s[TmpL],1);
    FMemoFile.Seek(DBTHeader.NextBlock*512,soFromBeginning);
    Text:=Text+#$1A#$1A;
    for TmpL:=1 to Length(Text) do
      FMemoFile.Write(Text[TmpL],1);
    inc(DBTHeader.NextBlock);
    dispose(block);
    FModified:=True;
  end;
end;

{function TMDBFTable.GetBLOBData(Field: TField): TMemoryStream;
var
  p :pchar;
  Buff :PChar;
  Flag :boolean;
  Block :pinteger;
begin
  if assigned(FMemofile) then
  try
    result:=tmemorystream.create;
    buff:=stralloc(512);
    Flag:=false;
    new(Block);
    getdata(Field,PChar(block),activebuffer);
    FMemoFile.Seek(Block^*512,soFromBeginning);
    while (not Flag) do begin
      if FMemoFile.Read(Buff,512)<512 then
        Flag:=True;
      p:=StrPos(Buff,#$1A#$1A);
      if assigned(p) then begin
        strlcopy(buff,buff,strlen(buff)-strlen(p)-1);
        Flag:=True;
      end else begin
        p:=strPos(#$1A,Buff);
        strlcopy(buff,buff,strlen(buff)-strlen(p)-1);
      end;
    end;
    result.setsize(strlen(buff));
    result.write(buff,strlen(buff));
    dispose(block);
    strdispose(buff);
  except
    raise Exception.Create('Error occured while reading BLOB data.');
  end;
end;

procedure TMDBFTable.SetBLOBData(Field: TField; BLOB: TMemoryStream);
begin

end;}

procedure TMDBFTable.InternalInsert;
begin
end;

function TMDBFTable.GetCodePage: word;
begin
  Result:=FStructure.CodePage;
end;

function TMDBFTable.GetDeletedCount: integer;
begin
  Result:=FStructure.DeletedCount;
end;

function TMDBFTable.GetEncrypted: boolean;
begin
  Result:=FStructure.Encrypted;
end;

function TMDBFTable.GetPackOnSave: Boolean;
begin
  Result:=FAccess.PackOnSave;
end;

function TMDBFTable.GetTransactionProtected: boolean;
begin
  Result:=FStructure.TransProt;
end;

function TMDBFTable.GetWithMemo: Boolean;
begin
  Result:=FStructure.Memo;
end;

procedure TMDBFTable.SetPackOnSave(const Value: Boolean);
begin
  FAccess.PackOnSave:=Value;
end;

{ TFilenameProperty }

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;

end.


DBFView.exe
0
senadCommented:
this must be the longest post I have ever seen .... :)
0
Mahdi78Commented:
Borland created DBE to access easier to DBase and Paradox Database, to read dbf file you need just TTable and the following even

procedure TForm1.FormCreate(Sender: TObject);
begin
Table1.TableName := 'C:\file.dbf';
Table1.Open;
end;
0
aldahanAuthor Commented:
thank you for your help but the same message appears " could not find language driver "
0
Mahdi78Commented:
Did BDE Borland Database Engine installed?
0
aldahanAuthor Commented:
yes it is  
0
aldahanAuthor Commented:
hello every one
i hope ttaht you will help me. i could finally know that my .dbf file from FoxPro 6.0 and my Delphi is Delph 2007 for win 32 . can any one help me to read this data and get it from it's files
0
senadCommented:
Not sure what you mean....
post/upload the file on rapidshare and give us the link...will see ...
0
aldahanAuthor Commented:
I need to download an engine to be able to read database
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.