10   '
20   '  ZDBUTIL.BAS, ZDB Conversion and Listing Utility
30   '
40   '  Date written: 7,8 Dec 90
50   '
60   '  Update log:
70   '
80   '  Added file output selection. 12/11/90.
90   '  Incorporated suggestions made by Steve Dresser. 12/12/90.
100  '  Added command tail processing. 12/31/90.
110  '  Enhanced command tail processing. 12/31/90.
120  '  Changed user interface. 1/1/91.
130  '
140  '  BASCOM =ZDBUTIL/E/Z
150  '  L80 ZDBUTIL/E,GOTCHA,ZDBUTIL/N
160  '
170  '  Purpose: Convert old format ZDB databases to new format databases
180  '  and display or print new format databases.
190  '
200  '  Author: Lee Bradley, Small Computer Support
210  '
220  '  (203) 665-1100 (modem)  (203) 666-3139 (voice)
230  '
240  '  The "old" ZDB database structure is ... (all CAPs fields are obsol.)
250  '
260  '  olname  001-025  ofstnm  026-046  OTITLE  047-061  OSPOUSE 062-073
270  '  OSALUTE 074-083  oaddr1  084-108  oaddr2  109-133  ocity   134-158
280  '  ostate  159-161  ozip    162-172  octry   173-187  ophon   188-208
290  '  ocmnts  209-253                   odatmod 254-256
300  '
310  '  The "new" ZDB database structure is ... (all CAPs field is new)
320  '
330  '  nfname  001-021  nlstnm  022-042  
340  '                   naddr1  043-066  naddr2  067-090  ncity  091-108
350  '  nstate  109-111  nzip    112-122  nctry   123-136  nphon  137-175
360  '  ncmnt1  176-214  NCMNT2  215-253  ndatmod 254-256
370  '
380 ON ERROR GOTO 1880 ' Error handler
390 VER$="1.5" 
400 DEF FND$(X)=HEX$(ASC(MID$(NDATMOD$,X,1))) ' BCD date conversion fctn
410 DEF FNT$(S$)=MID$(S$,1,INSTR(S$,CHR$(0))-1) ' Truncate trailing nulls fctn
420 NULPAD$=STRING$(18,0) ' Needed for phone field
430 NUL$=CHR$(0)
440 CALL GOTCHA(TAIL$) ' Check command tail
450 IF LEN(TAIL$)=0 THEN 470
460 GOSUB 1970 : MENU$="NO" : GOTO 610 ' Parse tail, skip menu
470 PRINT : PRINT
480 PRINT "            ZDB Utility, Version ";VER$
490 PRINT
500 PRINT "C old.fil new.fil    ( Convert old ZDB database to new format ) "
510 PRINT "                                                                "
520 PRINT "P new.fil            ( Print new ZDB database )                 "
530 PRINT "D new.fil            ( Display new ZDB database )               "
540 PRINT "O new.fil new.txt    ( Output new ZDB database to text file )   "
550 PRINT "                                                                "
560 PRINT "H elp                                                           "
570 PRINT "Q uit                                                           "
580 PRINT
590 INPUT "> ",F$ : GOSUB 1790 : TAIL$=F$ : GOSUB 1970 ' Parse tail
600 '
610 IF TAIL$="H" OR TAIL$="//" OR TAIL$="/" OR TAIL$="?" THEN 2150 ' Get help
620 IF NOT X$="C" THEN 940
630 '
640 ' Convert code
650 '
660 IF LEN(TAIL$)>1 THEN 720
670 PRINT : PRINT
680 PRINT "Enter name of old format ZDB database (eg. MY.ZDB) ";
690 INPUT "",F$ : GOSUB 1790 : FI$=F$ ' Upper case it
700 PRINT "Enter name of new format ZDB database (eg. ZDB.DTA) ";
710 INPUT "",F$ : GOSUB 1790 : FO$=F$ 
720 OPEN "I",1,FI$ : OPEN "O",2,FO$
730 PRINT
740 IF NOT EOF(1) THEN RI$=INPUT$(108,#1) ELSE 1440 ' can't grab all 256 so
750 NFSTNM$=MID$(RI$,26,20)+NUL$                    ' we do it in two pieces
760 NLNAME$=MID$(RI$,1,20)+NUL$
770 NADDR1$=MID$(RI$,84,23)+NUL$
780 PRINT #2,NFSTNM$;NLNAME$;NADDR1$;
790 RI$=INPUT$(148,#1)                              ' 2nd piece
800 NADDR2$=MID$(RI$,109-108,23)+NUL$
810 NCITY$=MID$(RI$,134-108,17)+NUL$
820 NSTATE$=MID$(RI$,159-108,2)+NUL$
830 NZIP$=MID$(RI$,162-108,10)+NUL$
840 NCTRY$=MID$(RI$,173-108,13)+NUL$
850 NPHON$=MID$(RI$,188-108,20)+NUL$+NULPAD$ ' new phone is longer
860 NCMNT1$=MID$(RI$,209-108,38)+NUL$        ' might truncate ...
870 NCMNT2$=SPACE$(38)+NUL$                  ' new field
880 NDATMOD$=MID$(RI$,254-108,3)
890 PRINT #2,NADDR2$;NCITY$;NSTATE$;NZIP$;NCTRY$;NPHON$;
900 PRINT #2,NCMNT1$;NCMNT2$;NDATMOD$;
910 PRINT "."; ' Report progress ...
920 GOTO 740
930 '
940 IF NOT (X$="P" OR X$="D" OR X$="O") THEN 1400
950 '
960 ' List contents of new format ZDB database
970 '
980 IF LEN(TAIL$)>1 THEN 1020
990 PRINT : PRINT
1000 PRINT "Enter name of new format ZDB database (eg. ZDB.DTA) ";
1010 INPUT "",F$ : GOSUB 1790 : FI$=F$
1020 OPEN "I",1,FI$
1030 CTR=0 : DEL$="N"
1040 IF NOT X$="O" THEN 1100
1050 IF LEN(TAIL$)>1 THEN 1080
1060 PRINT "Enter name of ascii text file (eg. ZDB.TXT) ";
1070 INPUT "",F$ : GOSUB 1790 : FO$=F$
1080 OPEN "O",2,FO$
1090 '
1100 IF EOF(1) THEN 1500
1110 RI$=INPUT$(108,#1)
1120 NFSTNM$=MID$(RI$,1,21)
1130 IF LEFT$(NFSTNM$,1)=CHR$(255) THEN DEL$="Y" : GOTO 1180
1140 NLNAME$=MID$(RI$,22,21)
1150 NADDR1$=MID$(RI$,43,24)
1160 NADDR2$=MID$(RI$,67,24)
1170 NCITY$=MID$(RI$,91,18)
1180 IF EOF(1) THEN 1500
1190 RI$=INPUT$(148,#1)
1200 IF DEL$="Y" THEN DEL$="N" : GOTO 1100
1210 NSTATE$=MID$(RI$,109-108,3)
1220 NZIP$=MID$(RI$,112-108,11)
1230 NCTRY$=MID$(RI$,123-108,14)
1240 NPHON$=MID$(RI$,137-108,39)
1250 NCMNT1$=MID$(RI$,176-108,39)
1260 NCMNT2$=MID$(RI$,215-108,39)
1270 NDATMOD$=MID$(RI$,254-108,3)
1280 RO1$=FNT$(NFSTNM$)+" "+FNT$(NLNAME$)
1290 RO2$=FNT$(NADDR1$)
1300 RO3$=FNT$(NADDR2$)
1310 RO4$=FNT$(NCITY$)+" "+FNT$(NSTATE$)+" "+FNT$(NZIP$)+" "+FNT$(NCTRY$)
1320 RO5$=FNT$(NPHON$)
1330 RO6$=FNT$(NCMNT1$)
1340 RO7$=FNT$(NCMNT2$)
1350 RO8Y$=FND$(1)
1360 RO8M$=FND$(2)
1370 RO8D$=FND$(3)
1380 GOSUB 1550 ' Print, Display or Output record
1390 GOTO 1090
1400 '
1410 IF NOT X$="Q" THEN PRINT : GOTO 470
1420 PRINT
1430 SYSTEM
1440 '
1450 PRINT #2,STRING$(255,255);  ' NOTE: should "pack" this via a sort (^S)
1460 CLOSE #1 : CLOSE #2
1470 IF MENU$="NO" THEN SYSTEM
1480 PRINT : GOTO 470
1490 '
1500 CLOSE #1
1510 IF X$="O" THEN CLOSE #2
1520 IF MENU$="NO" THEN SYSTEM
1530 PRINT : GOTO 470
1540 '
1550 ' Print, Display or Output record subroutine
1560 '
1570 IF NOT X$="P" THEN 1640
1580 '
1590 LPRINT "----"
1600 LPRINT RO1$ : LPRINT RO2$ : LPRINT RO3$ : LPRINT RO4$ : LPRINT RO5$
1610 LPRINT RO6$ : LPRINT RO7$ : LPRINT RO8M$;"/";RO8D$;"/";RO8Y$
1620 CTR=CTR+1 : IF CTR=6 THEN LPRINT CHR$(12) : CTR=0 ' form feed every 6
1630 RETURN
1640 '
1650 IF NOT X$="D" THEN 1710
1660 PRINT "-----"
1670 PRINT RO1$ : PRINT RO2$ : PRINT RO3$ : PRINT RO4$ : PRINT RO5$
1680 PRINT RO6$ : PRINT RO7$
1690 PRINT RO8M$;"/";RO8D$;"/";RO8Y$
1700 RETURN
1710 '
1720 PRINT #2,"-----"
1730 PRINT #2,RO1$ : PRINT #2,RO2$ : PRINT #2,RO3$
1740 PRINT #2,RO4$ : PRINT #2,RO5$
1750 PRINT #2,RO6$ : PRINT #2,RO7$
1760 PRINT #2,RO8M$;"/";RO8D$;"/";RO8Y$
1770 RETURN
1780 '
1790 ' Upper case F$ subroutine
1800 '
1810 G$=""
1820 FOR I=1 TO LEN(F$)
1830 F1$=MID$(F$,I,1)
1840 IF F1$>="a" THEN F1$=CHR$(ASC(F1$)-32)
1850 G$=G$+F1$
1860 NEXT I
1870 F$=G$ : RETURN
1880 '
1890 ' Error handler
1900 '
1910 IF ERR<>62 THEN 1940 ' Input past end of file
1920 CLOSE : PRINT
1930 IF MENU$="NO" THEN SYSTEM ELSE RESUME 470
1940 PRINT "Error reason " ERR : PRINT "Error line " ERL
1950 SYSTEM
1960 '
1970 ' Parse command tail subroutine
1980 '
1990 X$=LEFT$(TAIL$,1)
2000 IF LEN(TAIL$)<3 THEN RETURN
2010 TAIL$=MID$(TAIL$,3)
2020 IF MID$(TAIL$,1,1)=" " THEN TAIL$=MID$(TAIL$,2) : GOTO 2020
2030 X=INSTR(TAIL$," ")
2040 IF NOT (X$="D" OR X$="P") THEN 2070
2050 IF X<>0 THEN 2150
2060 FI$=TAIL$ : RETURN
2070 IF X=0 THEN 2150
2080 FI$=MID$(TAIL$,1,X-1) : TAIL$=MID$(TAIL$,X+1)
2090 IF MID$(TAIL$,1,1)=" " THEN TAIL$=MID$(TAIL$,2) : GOTO 2090
2100 X=INSTR(TAIL$," ")
2110 IF X<>0 THEN 2150
2120 FO$=TAIL$
2130 RETURN
2140 '
2150 ' Print usage message subroutine
2160 '
2170 PRINT
2180 PRINT "ZDBUTIL Version " VER$
2190 PRINT 
2200 PRINT "Usage:"
2210 PRINT
2220 PRINT "ZDBUTIL                  ( menu mode )"
2230 PRINT "ZDBUTIL D fn.ft          ( Display ZDB database )"
2240 PRINT "ZDBUTIL P fn.ft          ( Print ZDB database )"
2250 PRINT "ZDBUTIL C old.ft new.ft  ( Convert old ZDB database to new )" 
2260 PRINT "ZDBUTIL O fn.ft fn.txt   ( Output ZDB database to a text file )"
2270 PRINT
2280 PRINT "Strike Any Key ... " : A$=INPUT$(1)
2290 GOTO 470