home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / misc.swg / 0090_Info on DBASE3 Files.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-01-27  |  14.6 KB  |  482 lines
  1. Unit dbfinfo;
  2. interface
  3. uses
  4.         crt;
  5.  
  6. var
  7.         dbfile : file;
  8.         currentrec : longint;
  9.         dbfilename : string;
  10.         dbfileok : boolean;
  11.         dberr : integer;
  12.  
  13.  
  14. procedure dbwrthd;      {writes the header info}
  15. procedure disprec;      {displays the record data}
  16. procedure dbhdrd;       {reads the header info}
  17. procedure waitforkey;   {waits for key to be hit}
  18.  
  19. implementation
  20. const
  21.      dbmaxflds = 128;   {max. number of fields }
  22.      dbmaxrecsize = 4000; {max. size of a record }
  23.  
  24.  
  25. Type
  26.  
  27.     DBfileinfo = record      { first 32 bytes of DBF }
  28.         version : byte;
  29.                 year : byte;
  30.         month : byte;
  31.                 day : byte;
  32.                 norecord : longint;
  33.                 headlen : integer;
  34.                 reclen : integer;
  35.                 res : array[1..20] of byte;
  36.                 end;
  37.  
  38.         DBfieldinfo = record            { 32 byte field info }
  39.                 name  : array[1..11] of char;
  40.                 ftype : byte;
  41.                 addr  : longint;
  42.                 len   : byte;
  43.                 dcnt  : byte;
  44.                 res   : array[1..14] of char;
  45.                 end;
  46.  
  47.         dbfldar = array[1..dbmaxflds] of dbfieldinfo;
  48.         dbrecar = array[1..dbmaxrecsize] of char;
  49.  
  50. var
  51.         dbhead : dbfileinfo;
  52.         dbfield : dbfldar;
  53.         dbnofld : integer;
  54.         dbrecord : dbrecar;
  55.  
  56.  
  57. procedure waitforkey;
  58. var
  59.         junk : char;
  60. begin
  61.         writeln;
  62.         write('Hit any key to continue');
  63.         junk := readkey;
  64. end;
  65.  
  66.  
  67. { read rdbase III  header info }
  68. { blockread error - dberr = h = 0, l = number of records read}
  69. { bad header - dberr - h = 1, l = version }
  70. procedure dbhdrd;
  71. var
  72.    i : integer;
  73. begin
  74.         blockread(dbfile,dbhead,32,dberr);
  75.         dbfileok := (dberr = 32);
  76.         dbnofld := (dbhead.headlen - 33) div 32;
  77.         if not dbfileok then exit;
  78.  
  79.         if not ((dbhead.version = $83) or (dbhead.version = $03)) then
  80.         begin
  81.                 dbfileok := false;
  82.                 dberr := dbhead.version or $100;
  83.                 exit;
  84.         end;
  85.  
  86.         for i := 1 to dbnofld do
  87.         begin
  88.                 blockread(dbfile,dbfield[i],32,dberr);
  89.                 dbfileok := (dberr = 32);
  90.         if not dbfileok then exit;
  91.     end;
  92.  
  93. end;
  94.  
  95. { writes field titles on screen }
  96. procedure dbwrfldtit(line : integer);
  97. begin
  98.         gotoxy(1,line);
  99.         write('Field Name   Type  Len  Dec');
  100.     gotoxy(40,line);
  101.     writeln('Field Name   Type Len  Dec');
  102.         write('-----------------------------------------------------------------');
  103. end;
  104.  
  105.  
  106. { writes all header info to the screen }
  107. procedure dbwrthd;
  108. var
  109.         line,j,i : integer;
  110.  
  111. begin
  112.     clrscr;
  113.     gotoxy(29,1);
  114.     write('DBase file ',dbfilename);
  115.     gotoxy(1,3);
  116.     with dbhead do
  117.     begin
  118.         write('Last Time File Updated  - ',month:2,'/',day:2,'/',year:2);
  119.                 gotoxy(40,3);
  120.                 write('Number of records in file - ',norecord);
  121.                 gotoxy(1,4);
  122.                 write('Length of each record   - ',reclen);
  123.                 gotoxy(40,4);
  124.         end;
  125.         write('Number of fields          - ',dbnofld);
  126.         dbwrfldtit(6);
  127.         line := 8;
  128.         for i := 1 to dbnofld do
  129.         begin
  130.         if odd(i) then gotoxy(1,line) else gotoxy(40,line);
  131.                 with dbfield[i] do
  132.                 begin
  133.                         for j := 1 to 11 do write(name[j]);
  134.                         write('    ',chr(ftype),'   ',len:3,' ',dcnt:3);
  135.                 end;
  136.         if not odd(i) then
  137.         begin
  138.             line := succ(line);
  139.             if line = 24 then
  140.             begin
  141.                  if i < dbnofld then
  142.                  begin
  143.                       line := 3;
  144.                       writeln;
  145.                       write('More ....');
  146.                       waitforkey;
  147.                       clrscr;
  148.                       dbwrfldtit(1);
  149.                       end;
  150.                  end;
  151.             end;
  152.         end;
  153.         waitforkey;
  154. end;
  155.  
  156. { read and display a DBase III record }
  157. { if field data is larger than one line if will be truncated }
  158.  
  159. procedure dbreadrec(rec : longint);
  160. const
  161.         maxchar = 65;   {maximum characters to display from record}
  162. var
  163.     temp : longint;
  164.         i,j,stoppos,startpos,maxlen : integer;
  165.         linecnt : integer;
  166.  
  167. begin
  168.         with dbhead do
  169.         begin
  170.              if (rec < 1) or (rec > norecord) then
  171.              begin
  172.                   dberr := 0;
  173.                   dbfileok := false;
  174.                   exit;
  175.              end;
  176.              temp := rec;
  177.              rec := (rec - 1) * reclen + headlen;
  178.              seek(dbfile,rec);
  179.              blockread(dbfile,dbrecord,reclen,dberr);
  180.         end;
  181.         clrscr;
  182.         write('DBASE file ',dbfilename,'   Record No. ',temp);
  183.         if dbrecord[1] = '*' then writeln('    DELETED') else writeln;
  184.         writeln;
  185.         startpos := 2;
  186.         linecnt := 1;
  187.         for i := 1 to dbnofld do
  188.         begin
  189.              with dbfield[i] do
  190.              begin
  191.                   for j := 1 to 11 do write(name[j]);
  192.                   write(' -- ');
  193.                   if len > maxchar then maxlen := maxchar
  194.                   else maxlen := len;
  195.                   stoppos := startpos + maxlen;
  196.                   for j := startpos to stoppos -1 do write(dbrecord[j]);
  197.                   startpos := startpos + len;
  198.                   writeln;
  199.                   linecnt := succ(linecnt);
  200.                   if linecnt = 22 then
  201.                   begin
  202.                        if i < dbnofld then
  203.                        begin
  204.                             linecnt := 1;
  205.                             write('More ....');
  206.                             waitforkey;
  207.                             for j := 3 to 25 do
  208.                             begin
  209.                                  gotoxy(1,j);
  210.                                  clreol;
  211.                             end;
  212.                             gotoxy(1,3);
  213.                        end;
  214.                   end;
  215.              end;
  216.         end;
  217.         waitforkey;
  218. end;
  219.  
  220. procedure disprec;
  221. var
  222.         rec : string;
  223.         treal : real;
  224.         error : integer;
  225.  
  226. begin
  227.         repeat
  228.               clrscr;
  229.               writeln('DBASE file -- ',dbfilename);
  230.               writeln;
  231.               write('Total records = ',dbhead.norecord);
  232.               writeln('   Current Record = ',currentrec);
  233.               writeln;
  234.               write('Enter record to display (0 = exit, cr = next, - = previous)? ');
  235.               readln(rec);
  236.               if (rec = '') or (rec[1] = '-') then
  237.               begin
  238.                    if rec = '' then currentrec := succ(currentrec)
  239.                    else
  240.                    currentrec := pred(currentrec);
  241.               end
  242.               else
  243.               begin
  244.                    val(rec,treal,error);
  245.                    if error <> 0 then treal := 0.0;
  246.                    currentrec := trunc(treal);
  247.               end;
  248.               if currentrec = 0 then exit;
  249.               if currentrec < 0 then currentrec := 1;
  250.               if currentrec > dbhead.norecord then currentrec := dbhead.norecord;
  251.               dbreadrec(currentrec);
  252.         until false
  253.  
  254. end;
  255. begin
  256. end.
  257.  
  258.                        Dbase III DBF File Structure
  259.  
  260.  
  261. Header
  262. ------
  263.  
  264.  
  265.         
  266. BYTE #                Type                Example           Description
  267. ------                ----            -------           -----------
  268.         
  269. 0                Byte                   1              DBASE Version
  270.                                                   (83H with DBT file)
  271.                                                   (03H without DBT file)
  272.  
  273. 1                Byte                   2                  Year - Binary
  274.  
  275. 2                Byte                   3                  Month - Binary
  276.  
  277. 3               Byte                   4                  Day - Binary
  278.  
  279. 4-7                32 bit integer     5              Number of records in file
  280.  
  281. 8-9                16 bit integer           6                  Length of header
  282.  
  283. 10-11                16 bit integer     7                  Length of record
  284.  
  285. 12-31                20 Bytes           8              Reserved
  286.  
  287. 32-n                32 Bytes                          Field Descriptor
  288.                                                   (See below)
  289.                                         
  290. n+1                Byte               9              0Dh field terminator
  291.  
  292. N+2                  Byte              10              00h In some older versions
  293.                                                   (The length of header byte
  294.                                                   reflects this if present)
  295. .pa
  296.  
  297. Field Descriptor
  298. ----------------
  299.  
  300. BYTE #                Type                Example           Description
  301. ------                ----            -------           -----------
  302.  
  303. 0-10                byte                   11             Field name 
  304.                                                   (Zero filled)
  305.  
  306. 11                Byte                   12                  Field Type
  307.                                                   (N D L C M)
  308.  
  309. 12-15                32 bit integer           13                  Field data address
  310.                                                   (Internal use)
  311.  
  312. 16                Byte                   14                  Field length - Binary
  313.  
  314. 17                Byte                   15                  Field decimal count - Binary
  315.  
  316. 18-31                14 bytes           16                  Reserved
  317.  
  318.  
  319.  
  320. Field Types
  321. -----------
  322.  
  323.  
  324. N        Numeric - 0 1 2 3 4 5 6 7 8 . -
  325.  
  326.  
  327. D        Date - 8 Bytes (YYYYMMDD)
  328.  
  329.  
  330. L        Logical - Y y N n T t F f ? (? = Not initialized)
  331.  
  332.  
  333. C        Character - Any Ascii Character
  334.  
  335.  
  336. M        Memo - 10 digits (DBT block Number)
  337.  
  338.  
  339.  
  340. Data Records
  341. ------------
  342.  
  343.  
  344.         All data is in Ascii.
  345.  
  346.  
  347.         There is no field seperators or record terminators.
  348.  
  349.         The first byte is a space (20h) if record not deleted and an
  350.         asterick (2AH) if deleted.
  351.  
  352.  
  353.  
  354. DBASE Limitations
  355. -----------------
  356.  
  357. Fields - 128 Max.
  358.  
  359. Record - 4000 bytes Max.
  360.  
  361. Header - 4130 bytes Max.
  362.  
  363.           (128 Fields * 32 bytes) + 32 bytes + 1 terminator + (1 null)
  364.  
  365. Number - 19 digits
  366.  
  367.  
  368.  
  369.  
  370. Example File
  371. ------------
  372.  
  373.  
  374.          1  2  3  4     5         6     7          8
  375.         || || || || |---------| |---| |---| |---------- 
  376. 000000  83 55 0B 0E 31 00 00 00-81 01 89 00 00 00 00 00  .U..1...........
  377.  
  378.         ----------------------------------------------|
  379. 000010  00 00 00 00 00 00 00 00-00 00 00 00 00 00 00 00  ................
  380.  
  381.                       11                 12     13
  382.         |------------------------------| || |---------| 
  383. 000020  46 49 52 53 54 4E 41 4D-45 00 00 43 13 01 9D 41  FIRSTNAME..C...A
  384.  
  385.         14 15                     16
  386.         || || |---------------------------------------|
  387. 000030  14 00 00 00 01 00 00 00-00 00 00 00 00 00 00 00  ................
  388.  
  389. 000040  4C 41 53 54 4E 41 4D 45-00 00 00 43 27 01 9D 41  LASTNAME...C'..A
  390.  
  391. 000050  14 00 00 00 01 00 00 00-00 00 00 00 00 00 00 00  ................
  392.  
  393. 000060  50 48 4F 4E 45 00 00 00-00 00 00 43 3B 01 9D 41  PHONE......C;..A
  394.  
  395. 000070  0D 00 00 00 01 00 00 00-00 00 00 00 00 00 00 00  ................
  396.  
  397. 000080  54 52 41 56 45 4C 43 4F-44 45 00 43 48 01 9D 41  TRAVELCODE.CH..A
  398.  
  399. 000090  04 00 00 00 01 00 00 00-00 00 00 00 00 00 00 00  ................
  400.  
  401. 0000A0  54 52 41 56 45 4C 50 4C-41 4E 00 43 4C 01 9D 41  TRAVELPLAN.CL..A
  402.  
  403. 0000B0  28 00 00 00 01 00 00 00-00 00 00 00 00 00 00 00  (...............
  404.  
  405. 0000C0  44 45 50 41 52 54 55 52-45 00 00 44 74 01 9D 41  DEPARTURE..Dt..A
  406.  
  407. 0000D0  08 00 00 00 01 00 00 00-00 00 00 00 00 00 00 00  ................
  408.  
  409. 0000E0  43 4F 53 54 00 50 41 49-44 00 00 4E 7C 01 9D 41  COST.PAID..N|..A
  410.  
  411. 0000F0  0A 02 00 00 01 00 00 00-00 00 00 00 00 00 00 00  ................
  412.  
  413. 000100  50 41 49 44 00 4F 54 45-53 00 00 4C 86 01 9D 41  PAID.OTES..L...A
  414.  
  415. 000110  01 00 00 00 01 00 00 00-00 00 00 00 00 00 00 00  ................
  416.  
  417. 000120  41 47 45 4E 54 00 00 00-00 00 00 43 87 01 9D 41  AGENT......C...A
  418.  
  419. 000130  02 00 00 00 01 00 00 00-00 00 00 00 00 00 00 00  ................
  420.  
  421. 000140  52 45 53 45 52 56 44 41-54 45 00 44 89 01 9D 41  RESERVDATE.D...A
  422.  
  423. 000150  08 00 00 00 01 00 00 00-00 00 00 00 00 00 00 00  ................
  424.  
  425. 000160  4E 4F 54 45 53 00 00 00-00 00 00 4D 91 01 9D 41  NOTES......M...A
  426.  
  427. 000170  0A 00 00 00 01 00 00 00-00 00 00 00 00 00 00 00  ................
  428.  
  429.                 Firstname
  430.            || |----------------------------------------
  431. 000180  0D 20 43 6C 61 69 72 65-20 20 20 20 20 20 20 20  . Claire        
  432.                            
  433.                             Lastname
  434.         ----------------| |----------------------------
  435. 000190  20 20 20 20 20 20 42 75-63 6B 6D 61 6E 20 20 20        Buckman   
  436.  
  437.                                         Phone
  438.         ----------------------------| |----------------
  439. 0001A0  20 20 20 20 20 20 20 20-20 20 28 35 35 35 29 34            (555)4
  440.  
  441.                                T - code     T - plan
  442.         -------------------| |---------| |-------------
  443. 0001B0  35 36 2D 39 30 35 39 43-49 31 30 31 30 2D 6E 69  56-9059CI1010-ni
  444.  
  445.         -----------------------------------------------
  446. 0001C0  67 68 74 20 43 61 72 69-62 62 65 61 6E 20 49 73  ght Caribbean Is
  447.  
  448.         -----------------------------------------------
  449. 0001D0  6C 61 6E 64 20 43 72 75-69 73 65 20 20 20 20 20  land Cruise     
  450.  
  451.                    Departure Date          Cost
  452.         -------| |---------------------| |-------------                  
  453. 0001E0  20 20 20 31 39 38 35 31-30 32 34 20 20 20 31 31     19851024   11
  454.  
  455.                        PD  Age    Res. Date
  456.         -------------| || |---| |---------------------|
  457. 0001F0  39 39 2E 30 30 54 4D 4D-31 39 38 35 30 37 31 35  99.00TMM19850715
  458.  
  459. .pa
  460.             Notes
  461.         |---------------------------|
  462. 000200  20 20 20 20 20 20 20 20-20 31 20 52 69 63 6B 20           1 Rick 
  463.  
  464. 000210  20 20 20 20 20 20 20 20-20 20 20 20 20 20 20 4C                 L
  465.  
  466. 000220  69 73 62 6F 6E 6E 20 20-20 20 20 20 20 20 20 20  isbonn          
  467.  
  468. 000230  20 20 20 28 35 35 35 29-34 35 35 2D 33 33 34 34     (555)455-3344
  469.  
  470. 000240  41 56 31 30 39 2D 6E 69-67 68 74 20 41 6C 61 73  AV109-night Alas
  471.  
  472. 000250  6B 61 2F 56 61 6E 63 6F-75 76 65 72 20 43 72 75  ka/Vancouver Cru
  473.  
  474. 000260  69 73 65 20 20 20 20 20-20 20 20 20 31 39 38 35  ise         1985
  475.  
  476. 000270  30 38 30 35 20 20 20 31-33 37 38 2E 30 30 54 4A  0805   1378.00TJ
  477.  
  478. 000280  54 31 39 38 35 30 37 31-35 20 20 20 20 20 20 20  T19850715       
  479.  
  480. 000290  20 20 32 20 48 61 6E 6B-20 20 20 20 20 20 20 20    2 Hank
  481.  
  482.