To: Sysop

From :Mike Grumboski & Doug Hansen
      U. S. Business Computing, Inc.
      26877 Northwestern Hwy.
      Suite 107
      Southfield, MI 48034

Re:   Microsoft Basic program to decode a dBASE II file directory
      If you ever wondered what type of stuff was stored in you
      dBASE file header this routine might answer your questions.
      If you find out any other tricks that you care to share
      please drop us a note.


100 REMARK DBASE.BAS  --  PRINT THE .DBF DIRECTORY OF A dBASE II FILE
110 REMARK
120 REMARK We know the first 520 bytes of a dBASE II file contains header
130 REMARK records.  This is a summary of our knowledge.
140 REMARK 
150 REMARK HEX     COL         COMMENTS
160 REMARK ------- --------    ----------------------------------------
170 REMARK 01      1           HEX 02 IDENTIFIES A DBASE II FILE (.DBF)
180 REMARK 02 03   2-3         CONTAINS IN BINARY NUMBER OF RECORDS FOR FILE
190 REMARK 04      4           DATE MM  LAST UPDATED
200 REMARK 05      5           DATE DD  LAST UPDATED
210 REMARK 06      6           DATE YY  LAST UPDATED
220 REMARK 07 08   7-8         SIZE OF ALL VARIABLES FOR THIS DBASE
230 REMARK 
240 REMARK 09 12   9-18        1ST ENTRY - Variable name
250 REMARK 13      19                      For some reason always a zero
260 REMARK 14      20                      ASCII value for C, N, L (Character, numeric, logical)
270 REMARK 15      21                      Size of field
280 REMARK 16 17   22-23       Location in memory for SELECT PRIMARY in dBASE II
290 REMARK 18                  Location to place decimal point if numeric field          
300 CLEAR 1000
310 WIDTH 80
320 WH = 0 :TS = 0
330 NUL$=CHR$(0)
340 B$ = "                                                        If   Primary       If Secondary             "
350 E$ = "        ..Field...      -0-  Type   Size  Decimal    Memory Location    Memory Location  Total Bytes"
360 A$ = "#####   \        \      ###    \\    ###      ###              #####             ######        #####"
370 PRINT CHR$(26); :FILES "*.DBF"
380 LINE INPUT "FILE NAME "; Z$
390 Z$ = Z$ + ".DBF"
400 OPEN "R",1,Z$
410 FIELD #1, 1 AS ID$, 2 AS RC$, 1 AS MM$, 1 AS DD$, 1 AS YY$, 2 AS SI$, 16 AS X1$, 16 AS X2$, 16 AS X3$, 16 AS X4$, 16 AS X5$, 16 AS X6$, 16 AS X7$, 8 AS DUMMY$
420 GET 1,1
430 ID$ = ID$ + CHR$(0) :ID = CVI(ID$)
440 IF ID <> 2 THEN LPRINT "Not a dBASE II file" :LPRINT
450 IF ID = 2 THEN LPRINT "dBASE II directory list ";
460 IF ID <> 2 THEN PRINT "Not a dBASE II file" :PRINT
470 IF ID = 2 THEN PRINT "dBASE II directory list" :PRINT
480 MM$ = MM$ + CHR$(0) :MM = CVI(MM$)
490 DD$ = DD$ + CHR$(0) :DD = CVI(DD$)
500 YY$ = YY$ + CHR$(0) :YY = CVI(YY$)
510 LPRINT "Data base file ";Z$; " Record size "; CVI(SI$); " Total records "; CVI(RC$); " Last updated "; :LPRINT USING "##/##/##"; MM,DD,YY
520 LPRINT
530 PRINT "Data base file ";Z$; " Record size "; CVI(SI$); " Total records "; CVI(RC$); " Last updated "; :PRINT USING "##/##/##"; MM,DD,YY
540 PRINT
550 REMARK DO FIELDS 1 THRU 7
560 F1$=X1$ :GOSUB 1030
570 F1$=X2$ :GOSUB 1030
580 F1$=X3$ :GOSUB 1030
590 F1$=X4$ :GOSUB 1030
600 F1$=X5$ :GOSUB 1030
610 F1$=X6$ :GOSUB 1030
620 F1$=X7$ :GOSUB 1030
630 XX$=DUMMY$
640 FIELD #1, 8 AS ID$, 16 AS X1$, 16 AS X2$, 16 AS X3$, 16 AS X4$, 16 AS X5$, 16 AS X6$, 16 AS X7$, 8 AS DUMMY$
650 GET 1,2
660 REMARK DO FIELDS 8 THRU 15
670 F1$=XX$+ID$ :GOSUB 1030
680 F1$=X1$ :GOSUB 1030
690 F1$=X2$ :GOSUB 1030
700 F1$=X3$ :GOSUB 1030
710 F1$=X4$ :GOSUB 1030
720 F1$=X5$ :GOSUB 1030
730 F1$=X6$ :GOSUB 1030
740 F1$=X7$ :GOSUB 1030
750 XX$=DUMMY$
760 GET 1,3
770 REMARK DO FIELDS 16 THRU 23
780 F1$=XX$+ID$ :GOSUB 1030
790 F1$=X1$ :GOSUB 1030
800 F1$=X2$ :GOSUB 1030
810 F1$=X3$ :GOSUB 1030
820 F1$=X4$ :GOSUB 1030
830 F1$=X5$ :GOSUB 1030
840 F1$=X6$ :GOSUB 1030
850 F1$=X7$ :GOSUB 1030
860 XX$=DUMMY$
870 GET 1,4
880 REMARK DO FIELDS 24 THRU 31
890 F1$=XX$+ID$ :GOSUB 1030
900 F1$=X1$ :GOSUB 1030
910 F1$=X2$ :GOSUB 1030
920 F1$=X3$ :GOSUB 1030
930 F1$=X4$ :GOSUB 1030
940 F1$=X5$ :GOSUB 1030
950 F1$=X6$ :GOSUB 1030
960 F1$=X7$ :GOSUB 1030
970 XX$=DUMMY$
980 GET 1,5
990 REMARK DO FIELD 32
1000 F1$=XX$+ID$ :GOSUB 1030
1010 CLOSE
1020 END
1030 REM SUBROUTINE TO BREAK DOWN FIELD NAME
1040 NA$ = LEFT$(F1$,10) :DP$ = MID$(F1$,11,1) :IS$ = MID$(F1$,12,1) 
1050 CA$=""
1060 FOR I = 1 TO 10
1070 IF MID$(NA$,I,1) = NUL$ OR MID$(NA$,I,1) = CHR$(13) THEN CA$=CA$+" " ELSE CA$=CA$+MID$(NA$,I,1)
1080 REM ARK PRINT ASC(MID$(NA$,I,1)), ASC(MID$(CA$,I,1))
1090 NEXT I
1100 IF IS$ = CHR$(13) OR IS$ = NUL$ THEN IS$ = " "
1110 RS$ = MID$(F1$,13,1):UK$ = MID$(F1$,14,2) :FT$ = MID$(F1$,16,1)
1120 IF WH = 0 THEN LPRINT E$: LPRINT B$ :LPRINT:PRINT E$ :PRINT B$ :PRINT
1130 WH = WH + 1
1140 NB = CVI(DP$ + CHR$(0))
1150 NC = CVI(RS$+CHR$(0))
1160 NF = CVI(UK$)
1170 NH = NF - 1521
1180 NG = CVI(FT$+CHR$(0))
1190 TS = TS + NC
1200 IF WH <> 1 THEN 1260
1210 LPRINT USING A$; 0, "Flag", 0, "*", 1, 0, NH-1, NF-1, 1
1220 LPRINT
1230 PRINT USING A$; 0, "Flag", 0, "*", 1, 0, NH-1, NF-1, 1
1240 PRINT
1250 TS = TS + 1
1260 IF CA$ = "          " THEN 1310
1270 LPRINT USING A$; WH, CA$, NB, IS$, NC, NG, NH, NF, TS
1280 LPRINT
1290 PRINT USING A$; WH, CA$, NB, IS$, NC, NG, NH, NF, TS
1300 PRINT
1310 RETURN
                                                                                                                                