Unit dbfinfo; interface uses crt; var dbfile : file; currentrec : longint; dbfilename : string; dbfileok : boolean; dberr : integer; procedure dbwrthd; {writes the header info} procedure disprec; {displays the record data} procedure dbhdrd; {reads the header info} procedure waitforkey; {waits for key to be hit} implementation const dbmaxflds = 128; {max. number of fields } dbmaxrecsize = 4000; {max. size of a record } Type DBfileinfo = record { first 32 bytes of DBF } version : byte; year : byte; month : byte; day : byte; norecord : longint; headlen : integer; reclen : integer; res : array[1..20] of byte; end; DBfieldinfo = record { 32 byte field info } name : array[1..11] of char; ftype : byte; addr : longint; len : byte; dcnt : byte; res : array[1..14] of char; end; dbfldar = array[1..dbmaxflds] of dbfieldinfo; dbrecar = array[1..dbmaxrecsize] of char; var dbhead : dbfileinfo; dbfield : dbfldar; dbnofld : integer; dbrecord : dbrecar; procedure waitforkey; var junk : char; begin writeln; write('Hit any key to continue'); junk := readkey; end; { read rdbase III header info } { blockread error - dberr = h = 0, l = number of records read} { bad header - dberr - h = 1, l = version } procedure dbhdrd; var i : integer; begin blockread(dbfile,dbhead,32,dberr); dbfileok := (dberr = 32); dbnofld := (dbhead.headlen - 33) div 32; if not dbfileok then exit; if not ((dbhead.version = $83) or (dbhead.version = $03)) then begin dbfileok := false; dberr := dbhead.version or $100; exit; end; for i := 1 to dbnofld do begin blockread(dbfile,dbfield[i],32,dberr); dbfileok := (dberr = 32); if not dbfileok then exit; end; end; { writes field titles on screen } procedure dbwrfldtit(line : integer); begin gotoxy(1,line); write('Field Name Type Len Dec'); gotoxy(40,line); writeln('Field Name Type Len Dec'); write('-----------------------------------------------------------------'); end; { writes all header info to the screen } procedure dbwrthd; var line,j,i : integer; begin clrscr; gotoxy(29,1); write('DBase file ',dbfilename); gotoxy(1,3); with dbhead do begin write('Last Time File Updated - ',month:2,'/',day:2,'/',year:2); gotoxy(40,3); write('Number of records in file - ',norecord); gotoxy(1,4); write('Length of each record - ',reclen); gotoxy(40,4); end; write('Number of fields - ',dbnofld); dbwrfldtit(6); line := 8; for i := 1 to dbnofld do begin if odd(i) then gotoxy(1,line) else gotoxy(40,line); with dbfield[i] do begin for j := 1 to 11 do write(name[j]); write(' ',chr(ftype),' ',len:3,' ',dcnt:3); end; if not odd(i) then begin line := succ(line); if line = 24 then begin if i < dbnofld then begin line := 3; writeln; write('More ....'); waitforkey; clrscr; dbwrfldtit(1); end; end; end; end; waitforkey; end; { read and display a DBase III record } { if field data is larger than one line if will be truncated } procedure dbreadrec(rec : longint); const maxchar = 65; {maximum characters to display from record} var temp : longint; i,j,stoppos,startpos,maxlen : integer; linecnt : integer; begin with dbhead do begin if (rec < 1) or (rec > norecord) then begin dberr := 0; dbfileok := false; exit; end; temp := rec; rec := (rec - 1) * reclen + headlen; seek(dbfile,rec); blockread(dbfile,dbrecord,reclen,dberr); end; clrscr; write('DBASE file ',dbfilename,' Record No. ',temp); if dbrecord[1] = '*' then writeln(' DELETED') else writeln; writeln; startpos := 2; linecnt := 1; for i := 1 to dbnofld do begin with dbfield[i] do begin for j := 1 to 11 do write(name[j]); write(' -- '); if len > maxchar then maxlen := maxchar else maxlen := len; stoppos := startpos + maxlen; for j := startpos to stoppos -1 do write(dbrecord[j]); startpos := startpos + len; writeln; linecnt := succ(linecnt); if linecnt = 22 then begin if i < dbnofld then begin linecnt := 1; write('More ....'); waitforkey; for j := 3 to 25 do begin gotoxy(1,j); clreol; end; gotoxy(1,3); end; end; end; end; waitforkey; end; procedure disprec; var rec : string; treal : real; error : integer; begin repeat clrscr; writeln('DBASE file -- ',dbfilename); writeln; write('Total records = ',dbhead.norecord); writeln(' Current Record = ',currentrec); writeln; write('Enter record to display (0 = exit, cr = next, - = previous)? '); readln(rec); if (rec = '') or (rec[1] = '-') then begin if rec = '' then currentrec := succ(currentrec) else currentrec := pred(currentrec); end else begin val(rec,treal,error); if error <> 0 then treal := 0.0; currentrec := trunc(treal); end; if currentrec = 0 then exit; if currentrec < 0 then currentrec := 1; if currentrec > dbhead.norecord then currentrec := dbhead.norecord; dbreadrec(currentrec); until false end; begin end. Dbase III DBF File Structure Header ------ BYTE # Type Example Description ------ ---- ------- ----------- 0 Byte 1 DBASE Version (83H with DBT file) (03H without DBT file) 1 Byte 2 Year - Binary 2 Byte 3 Month - Binary 3 Byte 4 Day - Binary 4-7 32 bit integer 5 Number of records in file 8-9 16 bit integer 6 Length of header 10-11 16 bit integer 7 Length of record 12-31 20 Bytes 8 Reserved 32-n 32 Bytes Field Descriptor (See below) n+1 Byte 9 0Dh field terminator N+2 Byte 10 00h In some older versions (The length of header byte reflects this if present) .pa Field Descriptor ---------------- BYTE # Type Example Description ------ ---- ------- ----------- 0-10 byte 11 Field name (Zero filled) 11 Byte 12 Field Type (N D L C M) 12-15 32 bit integer 13 Field data address (Internal use) 16 Byte 14 Field length - Binary 17 Byte 15 Field decimal count - Binary 18-31 14 bytes 16 Reserved Field Types ----------- N Numeric - 0 1 2 3 4 5 6 7 8 . - D Date - 8 Bytes (YYYYMMDD) L Logical - Y y N n T t F f ? (? = Not initialized) C Character - Any Ascii Character M Memo - 10 digits (DBT block Number) Data Records ------------ All data is in Ascii. There is no field seperators or record terminators. The first byte is a space (20h) if record not deleted and an asterick (2AH) if deleted. DBASE Limitations ----------------- Fields - 128 Max. Record - 4000 bytes Max. Header - 4130 bytes Max. (128 Fields * 32 bytes) + 32 bytes + 1 terminator + (1 null) Number - 19 digits Example File ------------ 1 2 3 4 5 6 7 8 || || || || |---------| |---| |---| |---------- 000000 83 55 0B 0E 31 00 00 00-81 01 89 00 00 00 00 00 .U..1........... ----------------------------------------------| 000010 00 00 00 00 00 00 00 00-00 00 00 00 00 00 00 00 ................ 11 12 13 |------------------------------| || |---------| 000020 46 49 52 53 54 4E 41 4D-45 00 00 43 13 01 9D 41 FIRSTNAME..C...A 14 15 16 || || |---------------------------------------| 000030 14 00 00 00 01 00 00 00-00 00 00 00 00 00 00 00 ................ 000040 4C 41 53 54 4E 41 4D 45-00 00 00 43 27 01 9D 41 LASTNAME...C'..A 000050 14 00 00 00 01 00 00 00-00 00 00 00 00 00 00 00 ................ 000060 50 48 4F 4E 45 00 00 00-00 00 00 43 3B 01 9D 41 PHONE......C;..A 000070 0D 00 00 00 01 00 00 00-00 00 00 00 00 00 00 00 ................ 000080 54 52 41 56 45 4C 43 4F-44 45 00 43 48 01 9D 41 TRAVELCODE.CH..A 000090 04 00 00 00 01 00 00 00-00 00 00 00 00 00 00 00 ................ 0000A0 54 52 41 56 45 4C 50 4C-41 4E 00 43 4C 01 9D 41 TRAVELPLAN.CL..A 0000B0 28 00 00 00 01 00 00 00-00 00 00 00 00 00 00 00 (............... 0000C0 44 45 50 41 52 54 55 52-45 00 00 44 74 01 9D 41 DEPARTURE..Dt..A 0000D0 08 00 00 00 01 00 00 00-00 00 00 00 00 00 00 00 ................ 0000E0 43 4F 53 54 00 50 41 49-44 00 00 4E 7C 01 9D 41 COST.PAID..N|..A 0000F0 0A 02 00 00 01 00 00 00-00 00 00 00 00 00 00 00 ................ 000100 50 41 49 44 00 4F 54 45-53 00 00 4C 86 01 9D 41 PAID.OTES..L...A 000110 01 00 00 00 01 00 00 00-00 00 00 00 00 00 00 00 ................ 000120 41 47 45 4E 54 00 00 00-00 00 00 43 87 01 9D 41 AGENT......C...A 000130 02 00 00 00 01 00 00 00-00 00 00 00 00 00 00 00 ................ 000140 52 45 53 45 52 56 44 41-54 45 00 44 89 01 9D 41 RESERVDATE.D...A 000150 08 00 00 00 01 00 00 00-00 00 00 00 00 00 00 00 ................ 000160 4E 4F 54 45 53 00 00 00-00 00 00 4D 91 01 9D 41 NOTES......M...A 000170 0A 00 00 00 01 00 00 00-00 00 00 00 00 00 00 00 ................ Firstname || |---------------------------------------- 000180 0D 20 43 6C 61 69 72 65-20 20 20 20 20 20 20 20 . Claire Lastname ----------------| |---------------------------- 000190 20 20 20 20 20 20 42 75-63 6B 6D 61 6E 20 20 20 Buckman Phone ----------------------------| |---------------- 0001A0 20 20 20 20 20 20 20 20-20 20 28 35 35 35 29 34 (555)4 T - code T - plan -------------------| |---------| |------------- 0001B0 35 36 2D 39 30 35 39 43-49 31 30 31 30 2D 6E 69 56-9059CI1010-ni ----------------------------------------------- 0001C0 67 68 74 20 43 61 72 69-62 62 65 61 6E 20 49 73 ght Caribbean Is ----------------------------------------------- 0001D0 6C 61 6E 64 20 43 72 75-69 73 65 20 20 20 20 20 land Cruise Departure Date Cost -------| |---------------------| |------------- 0001E0 20 20 20 31 39 38 35 31-30 32 34 20 20 20 31 31 19851024 11 PD Age Res. Date -------------| || |---| |---------------------| 0001F0 39 39 2E 30 30 54 4D 4D-31 39 38 35 30 37 31 35 99.00TMM19850715 .pa Notes |---------------------------| 000200 20 20 20 20 20 20 20 20-20 31 20 52 69 63 6B 20 1 Rick 000210 20 20 20 20 20 20 20 20-20 20 20 20 20 20 20 4C L 000220 69 73 62 6F 6E 6E 20 20-20 20 20 20 20 20 20 20 isbonn 000230 20 20 20 28 35 35 35 29-34 35 35 2D 33 33 34 34 (555)455-3344 000240 41 56 31 30 39 2D 6E 69-67 68 74 20 41 6C 61 73 AV109-night Alas 000250 6B 61 2F 56 61 6E 63 6F-75 76 65 72 20 43 72 75 ka/Vancouver Cru 000260 69 73 65 20 20 20 20 20-20 20 20 20 31 39 38 35 ise 1985 000270 30 38 30 35 20 20 20 31-33 37 38 2E 30 30 54 4A 0805 1378.00TJ 000280 54 31 39 38 35 30 37 31-35 20 20 20 20 20 20 20 T19850715 000290 20 20 32 20 48 61 6E 6B-20 20 20 20 20 20 20 20 2 Hank