怎样读取dbf文件 ，取出数据部分 (100分)

怎样读取dbf文件 ，取出数据部分

不是说使用BDE->Standard->Forpro的吧。
看来你是需要读取物理文件了，估计需要分析结构了。偶不是特别清楚，帮你澄清一下题意。[8D]

你会不会问问题啊？？
Desktop Database 就可以了

數據部份???
如果在程序中取,又不想用bde的話,
用ado控件通過odbc取就行了

一般dbf文件数据结构定义在文件头，里面定义了字段信息，记录数等等
之后的就是数据区！ 具体的解决就看你自己了

如果你只是存无结构的数据 ，XML包 最有效！ （瞎猜）

参考下面的代码吧

(*
Turbo Pascal routines to access dBASE III [+] files
By J. Troutman <JT> CompuServe PPN 74746,1567
Revision history
Version 1.1 - enhancements to cause the header to be updated
when changing the .DBF file and to ensure that the
End Of File marker is written and to simplify use
5/6/86
1.2 - cleans up (some of) the absurdities in the code and
allocates the current record buffer on the heap rather than
in the data segment. A few comments added and a few symbol
names changed. Error checking has been improved with the
addition of two global status variables.
5/27/86

!!!!ATTENTION!!!!
If you have downloaded an earlier version of this file, please note that
several of the TYPEs and VARs have been changed. You will have to make
some adjustments to any existing programs you have that use these routines.
Why have they been changed? Several have been changed to decrease the
data segment storage demands of the code (declaring some variables as
pointers, for example); others in order to avoid conflicts with any
Types and Variables your program might define.

The routines in this file present some tools for accessing dBASE III and
dBASE III Plus files from within a Turbo Pascal program. There is MUCH
room for improvement: the error checking is simplistic, there are no routines
to access memo files, no buffering of data, no support for index files,
etc. The main routines are:

PROCEDURE OpenDbf(VAR D : dbfRecord : Integer;
PROCEDURE CloseDbf(VAR D : dbfRecord) : Integer;
PROCEDURE GetDbfRecord(VAR D : dbfRecord; RecNum : Real);
PROCEDURE PutDbfRecord(VAR D : dbfRecord; RecNum : Real);
PROCEDURE AppendDbf(VAR D : dbfRecord);

The error checking has been improved somewhat in this version with the
addition of two global variables: dbfOK and dbfError. After calling one of
the procedures, checking the status of the Boolean variable dbfOK will
reveal the success or failure of the operation. If it failed, the Integer
variable dbfError will contain a value corresponding to the IOResult value or
to a specially assigned value for several special conditions. Notice in
particular that an unsuccessful call to CloseDbf will leave the file status
unchanged and the memory still allocated. It is your program's
responsibility to take appropriate action. OpenDbf and CloseDbf have
now become procedures.

A skeletal program might go something like:
VAR
D : dbfRecord; { declare your dBASE file variable }
BEGIN
{...initialize and get filename of .dbf file into FileName field
of D variable ... }
OpenDbf(D); { to open the file }
IF NOT dbfOK THEN { check dbfError and process error };
{... the rest of your program including calls to
GetDbfRecord, PutDbfRecord, AppendDbf as needed
always remembering to interrogate the two global status
variables after each procedure call }
CloseDbf (D); { to close the file }
IF NOT dbfOK THEN { check dbfError and process error };
END.

Upon exit from the GetDbfRecord Procedure, the CurRecord of the
dbfRecord variable points to the current record contents. Each field
can be accessed using its offset into the CurRecord^ with the variable
Off in the Fields^ array.
Upon entry to the PutDbfRecord Procedure, the CurRecord^ should contain
the data that you want to write.
AppendDbf automatically adds a record to the end of the file (the
CurRecord^ should contain the data that you want to write).

Notice that the OpenDbf routine does allocate a buffer on the heap for
the current record. You can, of course, override this by pointing
CurRecord to any data structure that you wish.

See the demo program for some examples.
If you should have any problems with these routines, please leave me a
note.
*)

(*
dBASE III Database File Structure
The structure of a dBASE III database file is composed of a
header and data records. The layout is given below.
dBASE III DATABASE FILE HEADER:
+---------+-------------------+---------------------------------+
| BYTE | CONTENTS | MEANING |
+---------+-------------------+---------------------------------+
| 0 | 1 byte | dBASE III version number |
| | | (03H without a .DBT file) |
| | | (83H with a .DBT file) |
+---------+-------------------+---------------------------------+
| 1-3 | 3 bytes | date of last update |
| | | (YY MM DD) in binary format |
+---------+-------------------+---------------------------------+
| 4-7 | 32 bit number | number of records in data file |
+---------+-------------------+---------------------------------+
| 8-9 | 16 bit number | length of header structure |
+---------+-------------------+---------------------------------+
| 10-11 | 16 bit number | length of the record |
+---------+-------------------+---------------------------------+
| 12-31 | 20 bytes | reserved bytes (version 1.00) |
+---------+-------------------+---------------------------------+
| 32-n | 32 bytes each | field descriptor array |
| | | (see below) | --+
+---------+-------------------+---------------------------------+ |
| n+1 | 1 byte | 0DH as the field terminator | |
+---------+-------------------+---------------------------------+ |
|
|
A FIELD DESCRIPTOR: <------------------------------------------+
+---------+-------------------+---------------------------------+
| BYTE | CONTENTS | MEANING |
+---------+-------------------+---------------------------------+
| 0-10 | 11 bytes | field name in ASCII zero-filled |
+---------+-------------------+---------------------------------+
| 11 | 1 byte | field type in ASCII |
| | | (C N L D or M) |
+---------+-------------------+---------------------------------+
| 12-15 | 32 bit number | field data address |
| | | (address is set in memory) |
+---------+-------------------+---------------------------------+
| 16 | 1 byte | field length in binary |
+---------+-------------------+---------------------------------+
| 17 | 1 byte | field decimal count in binary |
+---------+-------------------+--------------------------------
| 18-31 | 14 bytes | reserved bytes (version 1.00) |
+---------+-------------------+---------------------------------+
The data records are layed out as follows:
1. Data records are preceeded by one byte that is a
space (20H) if the record is not deleted and an
asterisk (2AH) if it is deleted.
2. Data fields are packed into records with no field
separators or record terminators.
3. Data types are stored in ASCII format as follows:
DATA TYPE DATA RECORD STORAGE
--------- --------------------------------------------
Character (ASCII characters)
Numeric - . 0 1 2 3 4 5 6 7 8 9
Logical ? Y y N n T t F f (? when not initialized)
Memo (10 digits representing a .DBT block number)
Date (8 digits in YYYYMMDD format, such as
19840704 for July 4, 1984)

This information came directly from the Ashton-Tate Forum.
It can also be found in the Advanced Programmer's Guide available
from Ashton-Tate.
*)

CONST
DB3File = 3;
DB3WithMemo = $83;
ValidTypes : SET OF Char = ['C', 'N', 'L', 'M', 'D'];
MAX_HEADER = 4129; { = maximum length of dBASE III header }
MAX_BYTES_IN_RECORD = 4000; { dBASE III record limit }
MAX_FIELDS_IN_RECORD = 128; { dBASE III field limit }
BYTES_IN_MEMO_RECORD = 512; { dBASE III memo field record size }

{ Special Error codes for .DBF files }
NOT_DB_FILE = $80; { indicates the first byte was not a $3 or $83 }
INVALID_FIELD = $81;{ an invalid field type was found }
REC_TOO_HIGH = $82; { tried to read a record beyond the correct range }

(*
Although there are some declarations for memo files, the routines to access
them have not been implemented.
*)

TYPE
_HeaderType = ARRAY[0..MAX_HEADER] OF Byte;
_HeaderPrologType = ARRAY[0..31] OF Byte; { dBASE III header prolog }
_FieldDescType = ARRAY[0..31] OF Byte; { dBASE III field definitions }
_dRec = ^_DataRecord;
_DataRecord = ARRAY[0..MAX_BYTES_IN_RECORD] OF Byte; {the 0 offset represents
the 'deleted' flag. }
_Str255 = STRING[255];
_Str80 = STRING[80];
_Str64 = STRING[64];
_Str10 = STRING[10];
_Str8 = STRING[8];
_Str2 = STRING[2];
_dbfFile = FILE;
_FieldRecord = RECORD
Name : _Str10;
Typ : Char;
Len : Byte;
Dec : Byte;
Off : Integer;
END;
_FieldArray = ARRAY[1..MAX_FIELDS_IN_RECORD] OF _FieldRecord;
_dFields = ^_FieldArray;
_MemoRecord = ARRAY[1..BYTES_IN_MEMO_RECORD] OF Byte;
_MemoFile = FILE OF _MemoRecord;
_StatusType = (NotOpen, NotUpdated, Updated);
dbfRecord = RECORD
FileName : _Str64;
dFile : _dbfFile;
HeadProlog : _HeaderPrologType;
dStatus : _StatusType;
WithMemo : Boolean;
DateOfUpdate : _Str8;
NumRecs : Real;
HeadLen : Integer;
RecLen : Integer;
NumFields : Integer;
Fields : _dFields;
CurRecord : _dRec;
END;

(*
Notice that if you need to access more than one .DBF file simultaneously
you could declare an ARRAY of dbfRecord.
*)
VAR
dbfError : Integer; { global error indicators }
dbfOK : Boolean;

FUNCTION MakeReal(VAR b) : Real;
{ takes a long 32-bit integer and converts it to a real }

VAR
r : ARRAY[1..4] OF Byte ABSOLUTE b;

BEGIN
MakeReal := (r[1]*1)+(r[2]*256)+(r[3]*65536.0)+(r[4]*16777216.0);
END;

FUNCTION MakeInt(VAR b) : Integer;
VAR
i : Integer ABSOLUTE b;

BEGIN
MakeInt := i;
END;

FUNCTION MakeStr(b : Byte) : _Str2;
VAR
i : Integer;
s : _Str2;
BEGIN
i := b;
Str(i:2, s);
MakeStr := s;
END;

PROCEDURE GetDbfRecord(VAR D : dbfRecord; RecNum : Real);

VAR
Result : Integer;

BEGIN
IF RecNum > D.NumRecs THEN
BEGIN
dbfError := REC_TOO_HIGH;
dbfOK := FALSE;
Exit;
END;
{$I-} LongSeek(D.dFile, D.HeadLen+(RecNum-1)*D.RecLen); {$I+}
dbfError := IOResult;
dbfOK := (dbfError = 0);
IF dbfOK THEN
BEGIN
{$I-} BlockRead(D.dFile, D.CurRecord^, D.RecLen, Result); {$I+}
dbfError := IOResult;
dbfOK := (dbfError = 0);
END;
END; {GetDbfRecord}

PROCEDURE PutDbfRecord(VAR D : dbfRecord; RecNum : Real);

VAR
Result : Integer;

BEGIN
IF RecNum > D.NumRecs THEN
BEGIN
RecNum := D.NumRecs+1;
D.NumRecs := RecNum;
END;
{$I-} LongSeek(D.dFile, D.HeadLen+(RecNum-1)*D.RecLen); {$I+}
dbfError := IOResult;
dbfOK := (dbfError = 0);
IF dbfOK THEN
BEGIN
{$I-} BlockWrite(D.dFile, D.CurRecord^, D.RecLen, Result); {$I+}
dbfError := IOResult;
dbfOK := (dbfError = 0);
END;
IF dbfOK THEN D.dStatus := Updated;
END; {PutDbfRecord}

PROCEDURE AppendDbf(VAR D : dbfRecord);

BEGIN
PutDbfRecord(D, D.NumRecs+1);
END;

PROCEDURE CloseDbf(VAR D : dbfRecord);

PROCEDURE UpdateHeader;

TYPE
RegType = RECORD CASE Byte OF
1 : (AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Integer);
2 : (AL, AH, BL, BH, CL, CH, DL, DH : Byte);
END;

VAR
Reg : RegType;
r : Real;

BEGIN { UpdateHeader }
Reg.AX := $2A00; { Get DOS Date }
Intr($21, Reg);
D.HeadProlog[1] := Reg.CX-1900; {Year}
D.HeadProlog[2] := Reg.DH; {Month}
D.HeadProlog[3] := Reg.DL; {Day}
r := D.NumRecs;
D.HeadProlog[7] := Trunc(r/16777216.0);
r := r-(D.HeadProlog[7]*16777216.0);
D.HeadProlog[6] := Trunc(r/65536.0);
r := r-(D.HeadProlog[6]*65536.0);
D.HeadProlog[5] := Trunc(r/256);
r := r-(D.HeadProlog[5]*256);
D.HeadProlog[4] := Trunc(r);
{$I-}LongSeek(D.dFile, 0);{$I+}
dbfError := IOResult;
dbfOK := (dbfError = 0);
IF dbfOK THEN
BEGIN
{$I-} BlockWrite(D.dFile, D.HeadProlog, SizeOf(D.HeadProlog)); {$I+}
dbfError := IOResult;
dbfOK := (dbfError = 0);
END;
END; { UpdateHeader }

CONST
EofMark : Byte = $1A;

BEGIN { CloseDbf }
dbfOK := TRUE;
IF D.dStatus = Updated THEN
BEGIN
UpdateHeader;
IF dbfOK THEN
BEGIN
{$I-} LongSeek(D.dFile, D.HeadLen+D.NumRecs*D.RecLen); {$I+}
dbfError := IOResult;
dbfOK := (dbfError = 0);
END;
IF dbfOK THEN
BEGIN
{$I-} BlockWrite(D.dFile, EofMark, 1); {$I+} {Put EOF marker }
dbfError := IOResult;
dbfOK := (dbfError = 0);
END;
END; { IF Updated }
IF dbfOK THEN
BEGIN
{$I-} Close(D.dFile); {$I+}
dbfError := IOResult;
dbfOK := (dbfError = 0);
END;
IF dbfOK THEN
BEGIN
D.dStatus := NotOpen;
FreeMem(D.CurRecord, D.RecLen);
FreeMem(D.Fields, D.NumFields*SizeOf(_FieldRecord));
END;
END; { CloseDbf }

PROCEDURE OpenDbf(VAR D : dbfRecord);

PROCEDURE ProcessHeader(VAR Header : _HeaderType; NumBytes : Integer);

PROCEDURE GetOneFieldDesc(VAR F; VAR Field : _FieldRecord;
VAR Offset : Integer);

VAR
i : Integer;
FD : _FieldDescType ABSOLUTE F;

BEGIN { GetOneFieldDesc }
i := 0;
Field.Name := ' ';
REPEAT
Field.Name[Succ(i)] := Chr(FD);
i := Succ(i);
UNTIL FD = 0;
Field.Name[0] := Chr(i);
Field.Typ := Char(FD[11]);
Field.Len := FD[16];
Field.Dec := FD[17];
Field.Off := Offset;
Offset := Offset+Field.Len;
IF NOT(Field.Typ IN ValidTypes) THEN
dbfError := INVALID_FIELD;
END; { GetOneFieldDesc }

VAR
o, i, tFieldsLen : Integer;
tempFields : _FieldArray;

BEGIN {ProcessHeader}
CASE Header[0] OF
DB3File : D.WithMemo := False;
DB3WithMemo : D.WithMemo := True;
ELSE
BEGIN
dbfError := NOT_DB_FILE;
Close(D.dFile);
Exit;
END;
END; {CASE}
D.DateOfUpdate := MakeStr(Header[2])+'/'+MakeStr(Header[3])+'/'+MakeStr(Heade
r[1]);
D.NumRecs := MakeReal(Header[4]);
D.HeadLen := MakeInt(Header[8]);
IF NumBytes < D.HeadLen THEN
BEGIN
dbfError := NOT_DB_FILE;
Close(D.dFile);
Exit;
END;
D.RecLen := MakeInt(Header[10]); { Includes the Deleted Record Flag }
GetMem(D.CurRecord, D.RecLen); { Allocate some memory for a buffer }
D.dStatus := NotUpdated;
D.NumFields := 0;
Move(Header, D.HeadProlog, SizeOf(D.HeadProlog));
o := 1; {Offset within dbf record of current field }
i := 32; {Index for Header }
WHILE Header <> $0D DO
BEGIN
D.NumFields := Succ(D.NumFields);
GetOneFieldDesc(Header, tempFields[D.NumFields], o);
IF dbfError <> 0 THEN
BEGIN
Close(D.dFile);
Exit;
END;
i := i+32;
END; { While Header <> $0D }
tFieldsLen := D.NumFields*SizeOf(_FieldRecord);
GetMem(D.Fields, tFieldsLen);
Move(tempFields, D.Fields^, tFieldsLen);
IF Header[Succ(D.HeadLen)] = 0 THEN D.HeadLen := Succ(D.HeadLen);
END; {ProcessHeader}

PROCEDURE GetHeader;

VAR
Result : Integer;
H : _HeaderType;

BEGIN { GetHeader }
{$I-} BlockRead(D.dFile, H, MAX_HEADER, Result); {$I+}
dbfError := IOResult;
IF dbfError = 0 THEN ProcessHeader(H, Result);
END; { GetHeader }

BEGIN { OpenDbf }
Assign(D.dFile, D.FileName);
{$I-} Reset(D.dFile, 1); {$I+} {the '1' parameter sets the record size}
dbfError := IOResult;
IF dbfError = 0 THEN GetHeader;
dbfOK := (dbfError = 0);
END; { OpenDbf }

(* !!!!!!!!! To enable the Demo program, delete the next line. !!!!!!!!! *)
(*

PROCEDURE ErrorHalt(errorCode : Integer);
{ a VERY crude error handler }
VAR
errorMsg : _Str80;

BEGIN
CASE errorCode OF
00 : Exit; { no error occurred }
$01 : errorMsg := 'Not found';
$02 : errorMsg := 'Not open for input';
$03 : errorMsg := 'Not open for output';
$04 : errorMsg := 'Just not open';
$91 : errorMsg := 'Seek beyond EOF';
$99 : errorMsg := 'Unexpected EOF';
$F0 : errorMsg := 'Disk write error';
$F1 : errorMsg := 'Directory full';
$F3 : errorMsg := 'Too many files';
$FF : errorMsg := 'Where did that file go?';
NOT_DB_FILE : errorMsg := 'Not a dBASE data file';
INVALID_FIELD : errorMsg := 'Invalid field type encountered';
REC_TOO_HIGH : errorMsg := 'Requested record beyond range';
ELSE
errorMsg := 'Undefined error';
END;
WriteLn;
WriteLn(errorMsg);
Halt(1);
END;

TYPE
PseudoStr = ARRAY[1..255] OF Char;

VAR
Demo : dbfRecord;
j, i : Integer;
blanks : _Str255;
SizeOfFile, r : Real;
fn : _Str64;

PROCEDURE Wait;
VAR
c : Char;

BEGIN
Write('Press any key to continue . . .');
Read(Kbd, c);
END;


PROCEDURE List(VAR D : dbfRecord);

PROCEDURE ShowField(VAR a; VAR F : _FieldRecord);

VAR
Data : PseudoStr ABSOLUTE a;

BEGIN
WITH F DO
BEGIN
CASE Typ OF
'C', 'N', 'L' : Write(Copy(Data, 1, Len));
'M' : Write('Memo ');
'D' : Write(Copy(Data, 5, 2), '/',
Copy(Data, 7, 2), '/',
Copy(Data, 1, 2));
END; {CASE}
IF Len <= Length(Name) THEN
Write(Copy(blanks, 1, Length(Name)-Pred(Len)))
ELSE
Write(' ');
END; {WITH F}
END; {ShowField}

BEGIN {List}
WriteLn;
Write('Rec Num ');
WITH D DO
BEGIN
FOR i := 1 TO NumFields DO
WITH Fields^ DO
IF Len >= Length(Name) THEN
Write(Name, Copy(blanks, 1, Succ(Len-Length(Name))))
ELSE
Write(Name, ' ');
WriteLn;
r := 1;
WHILE r <= NumRecs DO
BEGIN
GetDbfRecord(Demo, r);
IF NOT dbfOK THEN ErrorHalt(dbfError);
WriteLn;
Write(r:7:0, ' ');
Write(Chr(CurRecord^[0])); { the 'deleted' indicator }
FOR i := 1 TO NumFields DO
ShowField(CurRecord^[Fields^.Off], Fields^);
r := r+1;
END; {WHILE r }
END; {WITH D }
END; {List}

PROCEDURE DisplayStructure(VAR D : dbfRecord);

VAR
i : Integer;

BEGIN
WITH D DO
BEGIN
ClrScr;
Write(' # Field Name Type Length Decimal');
FOR i := 1 TO NumFields DO
BEGIN
WITH Fields^ DO
BEGIN
IF i MOD 20 = 0 THEN
BEGIN
WriteLn;
Wait;
ClrScr;
Write(' # Field Name Type Length Decimal');
END;
GoToXY(1, Succ(WhereY));
Write(i:2, Name:12, Typ:5, Len:9);
IF Typ = 'N' THEN Write(Dec:5);
END; {WITH Fields^}
END; {FOR}
WriteLn;
Wait;
END; {WITH D}
END; { DisplayStructure }


BEGIN {Demonstration of DBF routines}
WITH Demo DO
BEGIN
FillChar(blanks, SizeOf(blanks), $20);
blanks[0] := Chr(255);
ClrScr;
GoToXY(10, 10);
Write('Name of dBASE file (.DBF assumed): ');
Read(FileName);
IF Pos('.', FileName) = 0 THEN FileName := FileName+'.DBF';
OpenDbf(Demo);
IF NOT dbfOK THEN ErrorHalt(dbfError);
ClrScr;
SizeOfFile := LongFileSize(dFile);
WriteLn('File Name: ', FileName);
WriteLn('Date Of Last Update: ', DateOfUpdate);
WriteLn('Number of Records: ', NumRecs:10:0);
WriteLn('Size of File: ', SizeOfFile:15:0);
WriteLn('Length of Header: ', HeadLen:11);
WriteLn('Length of One Record: ', RecLen:7);
IF WithMemo THEN WriteLn('This file contains Memo fields.');
Wait;
ClrScr;
DisplayStructure(Demo);
ClrScr;
List(Demo);
WriteLn;
Wait;
CloseDbf(Demo);
IF NOT dbfOK THEN ErrorHalt(dbfError);
END; {WITH}
END. {of Demo program }

用控件apollo vcl 或halcyon67可读取。

最简单：用EXCEL就可以了。