10 ' This was written by Fred Kantor when he was tired,
20 '  much of it circa 1989 Feb 21 00:30:39;
30 '  some modification circa 1989 Jul 06 20:04:06
40 '  latest modification circa 1990 Apr 30
50 ' The purpose first was to make it easier for people to adopt ZIP format,
60 ' which Phil Katz has dedicated to the public domain, and to remove
70 ' content(s) signature duplicates.
80 CLS
90 DIM U$(512) ' U -- Unalphabetized
100 UFLAG=0     ' U
110 UDIRS$="DIR99 " ' U
120 UCONT$="                               |" ' U  as in continuation line(s)
130 LUCONT=LEN(UCONT$) ' U
140 S78$=STRING$(78," ")
150 BADCHARS$=" ./\?*"+CHR$(34)
160 LOCATE 5,1
170 PRINT "PLEASE be sure you have proper backups..."
180 LOCATE 11,1
190 PRINT "This program revises text directory(s) DIRnnn. It is supposed to be run in the"
200 PRINT "same logical [sub]directory as the text directory(s) it modifies. One use is"
210 PRINT "to freshen data about files of the form *.ZIP, to match the DOS directory"
220 PRINT "listing, and rename the old DIRnnn file as DIRnnn.OLD. It variously may call"
230 PRINT "FWKDG (Ver. 1.08)), DSA, QSORT; they should be in default directory or on path."
240 LOCATE 22,1
250 PRINT "ZIP format introduced and dedicated to public domain by Phil Katz, 1989;"
260 PRINT "QSORT Ver. 3.20 copyright 1985,86,87,88 by Ben Baker;     |    Please thank all"
270 PRINT "FWKDG (tm) copyright 1988,89,90 by Frederick W. Kantor.   |    of these people.";
280 LOCATE 8,25
290 PRINT "C A V E A T   O P E R A T O R"
300 LOCATE 4,1
310 PRINT "Your use of this program is at solely your own risk: PLEASE HAVE PROPER BACKUPS"
320 LOCATE 1,1
330 PRINT "FWKTDR(tm) Text Directory Reviser,"
340 LOCATE 2,1
350 PRINT "Version 01.9"
360 LOCATE 1,37
370 PRINT "Copyright (C) 1989,90 by Frederick W Kantor."
380 LOCATE 2,61
390 PRINT "All rights reserved."
400 '
410 LOCATE 17,1
420 PRINT "WHAT am i supposed to be doing this time? just type in the number:"
430 PRINT "   1. handle newly zipped files"
440 PRINT "   2. delete obsolete_file listings from the text directories"
450 PRINT "**> press any other alphameric key to abort <**"
460 S11$=INPUT$(1)
470 IF S11$<>"1" AND S11$<>"2" THEN CLOSE:SYSTEM
480 GOSUB 4260
490 IF S11$<>"2" THEN GOTO 760
500 PRINT "WHAT file format should i expect the filenames to be in?
510 PRINT "   1. look in DELETED.LOG, where filenames start at column 18"
520 PRINT "   2. filenames will be listed flush left with no gap in filename.ext"
530 PRINT "**> press any other alphameric key to abort <**"
540 S12$=INPUT$(1)
550 IF S12$<>"1" AND S12$<>"2" THEN CLOSE:SYSTEM
560 GOSUB 4260
570 IF S12$="1" THEN GOTO 760
580 PRINT "If the input file is in the present directory, then the filename.ext"
590 PRINT "is enough; otherwise, please give [d:]\path\filename.ext"
600 LOCATE 20,1:PRINT "**> to abort, press carriage return without filename <**";
610 LOCATE 19,1:INPUT "    where should i look for the list to work from? ",INFILE1$
620 IF INFILE1$="" THEN CLOSE:SYSTEM
630 GOSUB 4260
640 OPEN INFILE1$ FOR INPUT AS 1
650 OPEN "####list.0##" FOR OUTPUT AS 2
660 WHILE NOT EOF(1)
670 LINE INPUT #1,A$
680 IF A$="" THEN GOTO 740
690 IF INSTR(BADCHARS$,LEFT$(A$,1))<>0 THEN GOTO 740
700 JN=INSTR(A$," ")
710 IF JN=1 OR JN>13 THEN GOTO 740
720 IF JN=0 THEN JN=13
730 PRINT #2,LEFT$(A$,JN-1)
740 WEND
750 GOTO 1020
760 PRINT "in which [sub]directory should i look for ";
770 IF S11$<>"2" THEN GOTO 800
780 PRINT "DELETED.LOG ?"
790 GOTO 810
800 PRINT "the newly zipped files?"
810 INPUT "[d:]\path\  [default is the present dir] = ",PATH1$
820 IF PATH1$>"" AND RIGHT$(PATH1$,1)<>"\" AND RIGHT$(PATH1$,1)<>"/" THEN PATH1$=PATH1$+"\"
830 CLS
840 '
850 IF S11$="1" THEN GOTO 1080
860 '
870 'make sorted filename list from DELETED.LOG
880 '
890 OPEN PATH1$+"DELETED.LOG" FOR INPUT AS 1
900 OPEN "####list.0##" FOR OUTPUT AS 2
910 WHILE NOT EOF(1)
920 LINE INPUT #1,A$
930 IF LEN(A$)<18 THEN GOTO 1010
940 B$=MID$(A$,18,13)  ' 13 because some people may have inserted 'd' rather
950 '                    than overwritten the blank in column 17, and moved
960 '                    the column one space to right
970 IF LEFT$(B$,1)=" " AND LEN(B$)>1 THEN B$=MID$(B$,2):GOTO 970
980 IF RIGHT$(B$,1)=" " AND LEN(B$)>1 THEN B$=LEFT$(B$,LEN(B$)-1):GOTO 980
990 IF B$="" OR B$=" " OR B$="." THEN GOTO 1010
1000 PRINT #2,B$
1010 WEND
1020 CLOSE 1,2
1030 SHELL "qsort <####list.0## >####list.1##"
1040 KILL "####list.0##"
1050 ' ####LIST.1## contains list of filenames to clear from text directories
1060 GOTO 1100
1070 '
1080 'make sorted list of .ZIP files
1090 SHELL "dir "+PATH1$+"*.zip|dsa|find "+CHR$(34)+".ZIP"+CHR$(34)+"|qsort >####list.1##"
1100 CLS
1110 OPEN "####list.1##" FOR INPUT AS 1
1120 IF LOF(1)<5 THEN GOTO 2840 ' (includes .exe and CRLF) no work to do
1130 '
1140 DIRSONLY=1:GOSUB 2700 ' to make a current DIRSONLY.TXT
1150 OPEN "dirsonly.txt" FOR INPUT AS 2
1160 IF LOF(2)>4 THEN GOTO 1210
1170 LOCATE 21,1
1180 PRINT "i needed DIRSONLY.TXT: please ask me in same subdir as text directories"
1190 SYSTEM
1200 '
1210 OPEN "####list.2##" FOR OUTPUT AS 3
1220 LOCATE 15,1
1230 PRINT "i'm looking in DIRSONLY.TXT for which text directories have which files"
1240 '
1250 IF EOF(1) THEN GOTO 1680
1260 LINE INPUT #1,A$
1270 '
1280 IF S11$="1" THEN GOTO 1320
1290 P=LEN(A$) ' in this case , #1 labels a list of filenames
1300 GOTO 1340
1310 '
1320 IF MID$(A$,24,1)=" " THEN MID$(A$,24,1)="0" ' as in text dirs
1330 P=INSTR(A$,".") '        for filename comparisons to and including '.'
1340 IF EOF(2) THEN GOTO 1680
1350 LINE INPUT #2,B$
1360 IF LEFT$(A$,P)<LEFT$(B$,P) THEN GOTO 1250
1370 IF LEFT$(A$,P)>LEFT$(B$,P) THEN GOTO 1340
1380 IF MID$(B$,15,3)<>"DIR" THEN GOTO 1250' in DIRGUIDE.TXT, DIRs precede paths
1390 IF S11$="2" THEN GOTO 1570
1400 IF MID$(A$,P+1,3)=MID$(B$,P+1,3) THEN GOTO 1250 ' already has .ZIP, so skip
1410 '
1420 ' make a string for sorting, using these fields:
1430 '
1440 ' case 1, S11$="1": replace old with new
1450 '
1460 ' <DIRnnn>< ><old_name.ext>< ><new_name.ext  filelength date>
1470 '    6     1       12       1               31                bytes
1480 '
1490 '
1500 ' case 2, S11$="2": delete text_directory_entry of deleted file
1510 '
1520 ' <DIRnnn>< ><filename.ext>< ><dddddddddddd>
1530 '    6     1       12       1       12       bytes
1540 '
1550 '
1560 '
1570 S1$=MID$(B$,15,6) '   6 bytes,   e.g., up to and including DIR999
1580 '
1590 IF S11$="1" THEN GOTO 1650
1600 '
1610 C$=S1$+SPACE$(7-LEN(S1$))+LEFT$(B$,13)+"dddddddddddd"
1620 GOTO 1660
1630 '
1640 '
1650 C$=S1$+SPACE$(7-LEN(S1$))+LEFT$(B$,13)+LEFT$(A$,31)
1660 PRINT #3,C$
1670 GOTO 1250 ' go back for more .ZIP filenames
1680 CLOSE
1690 KILL "dirsonly.txt" ' was used to find text_directory file_lines
1700 KILL "####list.1##" ' case 1: that was the list made using the DIR command
1710 '                     case 2: was list of filenames from DELETED.LOG
1720 CLS
1730 SHELL "qsort ####list.2## ####list.3##" 'please see following discussion
1740 CLS
1750 KILL "####list.2##" ' the sorted version is for use
1760 '
1770 'the sorted strings are now grouped by text directory,
1780 'in ascending ASCII (alphabetical) order within each text directory
1790 '
1800 OPEN "####list.3##" FOR INPUT AS 1
1810 IF (S11$="1" AND LOF(1)<50) OR (S11$="2" AND LOF(1)<30) THEN SHORT1=1:GOTO 2820'  too short for even 1 line
1820 IF EOF(1) THEN GOTO 2820
1830 LINE INPUT #1,A$
1840 IF (S11$="1" AND LEN(A$)<50) OR (S11$="2" AND LEN(A$)<30) THEN GOTO 1820' too short
1850 MORE=0
1860 IF LEFT$(A$,3)<>"DIR" THEN GOTO 1820  ' not a DIR line
1870 '
1880 'find first
1890 GOSUB 2900 'open text directory as #2, .TMP output as #3
1900 ' returns TESTNAME$, clears W#, sets FLAG1=1, sets LEFTREF6$=LEFT$(A$,6)
1910 '
1920 ' if this directory is listed as unalphabetized, goto process it:
1930 IF INSTR(UDIRS$,LEFTREF6$)>0 THEN GOSUB 3540:GOTO 2000
1940 '
1950 GOSUB 3110 'process input from #2, output to #3
1960 ' receives TESTNAME$, running subtotal W#
1970 ' proceeds until completing match replacement and/or reaching eof(2)
1980 '
1990 IF EOF(2) THEN GOSUB 2180
2000 IF EOF(1) THEN GOTO 2080
2010 IF MORE=1 THEN GOTO 1840
2020 LINE INPUT #1,A$
2030 IF LEFTREF6$ <> LEFT$(A$,6) THEN GOSUB 2180:GOTO 1890
2040 '
2050 TESTNAME$=MID$(A$,8,12)
2060 GOTO 1950
2070 '
2080 IF FLAG1=1 THEN GOSUB 2180
2090 CLOSE
2100 KILL "####list.3##"
2110 GOSUB 2700' revise DIRGUIDE.TXT; 'if 0 then' supports renumbering
2120 SYSTEM                   ' exit back to system
2130 '
2140 '
2150 '----------------------------------------------------------------
2160 '
2170 '
2180 IF FLAG1=0 THEN GOTO 2650
2190 WHILE NOT EOF(2)           ' finish copying rest of text directory
2200 LINE INPUT #2,B$
2210 NFILES=NFILES+1            ' while counting files
2220 W#=W#+VAL(MID$(B$,14,9))   ' with running subtotal of filelengths
2230 PRINT #3,B$
2240 WEND
2250 CLOSE 2,3
2260 '
2270 IF INFILE$="DIR99" THEN GOTO 2530' DIR99 does not get filelength subtotal
2280 '
2290 ' subroutine for inserting filelength_total in header
2300 OPEN INFILE$+".tmp" FOR INPUT AS 2
2310 OPEN INFILE$+".tp2" FOR OUTPUT AS 3
2320 LINE INPUT #2,B$
2330 IF INSTR(B$,"Total Bytes")>0 THEN GOTO 2370 ' scan for line before total
2340 PRINT #3,B$
2350 IF EOF(2) THEN GOTO 2510
2360 GOTO 2320
2370 PRINT #3,B$
2380 '
2390 LINE INPUT #2,B$                           ' get line with old total
2400 PRINT #3, USING "########,###########";W#; ' use new left 20 bytes
2410 PRINT #3, USING "##########,######";NFILES;' use new mid 17 bytes
2420 IF S11$="2" THEN GOTO 2450
2430 PRINT #3, MID$(B$,38)               'case 1, use rest of old line
2440 GOTO 2470
2450 PRINT #3,"            " DATE$ " at " TIME$ 'case 2, replace rest of line
2460 '
2470 WHILE NOT EOF(2)           ' loop to copy rest of file
2480 LINE INPUT #2,B$
2490 PRINT #3,B$
2500 WEND
2510 CLOSE 2,3
2520 '
2530 W#=0                               ' clear filelength subtotal
2540 NFILES=0                           ' clear filecount subtotal
2550 '
2560 OPEN INFILE$+".old" AS 2 LEN=1     'dummy to clear without error message
2570 CLOSE 2
2580 KILL INFILE$+".old"
2590 '
2600 NAME INFILE$ AS INFILE$+".old"
2610 IF INFILE$="DIR99" THEN NAME INFILE$+".tmp" AS INFILE$:GOTO 2650
2620 NAME INFILE$+".tp2" AS INFILE$
2630 KILL INFILE$+".tmp"
2640 FLAG1=0
2650 RETURN
2660 '
2670 '--------------------------------------------------------------
2680 '
2690 '
2700 CLS                        ' make DIRSONLY.TXT or DIRGUIDE.TXT
2710 QT$=CHR$(34)
2720 CLS
2730 IF DIRSONLY=0 THEN SHELL "makedirg":GOTO 2750 '  fwkdg/g|qsort >dirguide.txt":GOTO 2750
2740 SHELL "fwkdg/t |qsort >dirsonly.txt" ' text dirs in local subdirectory
2750 CLS
2760 DIRSONLY=0
2770 RETURN
2780 '
2790 '------------------------------------------
2800 '
2810 '
2820 CLOSE
2830 KILL "####list.3##"
2840 LOCATE 21,1
2850 PRINT "i have no work to do..."
2860 SYSTEM
2870 '
2880 '--------------------------------------------
2890 '
2900 'subroutine for opening a text directory
2910 LEFTREF6$=LEFT$(A$,6) ' for testing later input to see if for same file
2920 INFILE$=LEFTREF6$
2930 'remove trailing blanks from filename
2940 WHILE RIGHT$(INFILE$,1)=" ":INFILE$=LEFT$(INFILE$,LEN(INFILE$)-1):WEND
2950 '
2960 OPEN INFILE$ FOR INPUT AS 2
2970 OPEN INFILE$+".tmp" FOR OUTPUT AS 3
2980 W#=0                    ' clear for running filelength_subtotal
2990 NFILES=0                ' clear for running filecount_subtotal
3000 LOCATE 12,1
3010 PRINT "now working on " INFILE$ "   ";
3020 FLAG1=1
3030 ' now set for scanning infile$ text directory, modified output into .TMP
3040 TESTNAME$=MID$(A$,8,12)
3050 RETURN
3060 '
3070 '
3080 '----------------------------------------------------
3090 '
3100 '
3110 'subroutine for seeking a match while copying a text directory and
3120 'carrying a running subtotal of filelengths
3130 FOUND=0
3140 LINE INPUT #2,B$
3150 M1$=MID$(B$,25,1)          ' test by looking at 3 bytes in date format
3160 M2$=MID$(B$,26,1)
3170 M3$=MID$(B$,27,1)
3180 IF M1$<"0" OR M1$>"9" OR M2$<>"-" OR M3$<"0" OR M3$>"9" THEN GOTO 3350
3190 '
3200 ' count files
3210 NFILES=NFILES+1
3220 '
3230 IF TESTNAME$<>LEFT$(B$,12) THEN GOTO 3340
3240 FOUND=1
3250 'case 2: delete the text line:
3260 IF S11$="2" THEN NFILES=NFILES-1:GOTO 3390
3270 '
3280 'case 1: revise and replace the text line:
3290 '
3300 ' replace left 31 bytes of text_directory_line with new ext, size [,date]
3310 MID$(B$,1,31)=MID$(A$,21,31) ' for offset, please see chart 'above'
3320 '
3330 '
3340 W#=W#+VAL(MID$(B$,14,9)) ' add new filelength to text_directory_subtotal
3350 PRINT #3,B$
3360 IF FOUND=1 THEN GOTO 3390
3370 IF EOF(2) THEN GOTO 3390
3380 GOTO 3140
3390 RETURN
3400 '
3410 '----------------------------------------------------
3420 '
3430 'This is routine for processing unalphabetized directories:
3440 '
3450 'case 1: revise and replace text line
3460 '
3470 'case 2: delete text line
3480 '
3490 ' #1 -- file with DIRnnn as left six characters, where nnn is numeric
3500 ' #2 -- unalphabetized text directory
3510 ' #3 -- temporary output file
3520 ' A$ -- this is already_read_from_#1 first line for use with #2
3530 '
3540 FILLED=0
3550 '
3560 FOR USCAN=0 TO 512
3570 U$(I)=""
3580 NEXT USCAN
3590 '
3600 IF FILLED=0 THEN GOTO 3650
3610 '
3620 GOSUB 2900
3630 '
3640 ' load U$ array
3650 USCAN=0                                              ' load U$ array
3660 LEAVE=0
3670 WHILE LEFTREF6$=LEFT$(A$,6) AND USCAN<513 AND LEAVE0=0
3680 U$(USCAN)=A$                                         '
3690 USCAN=USCAN+1                                        '
3700 IF EOF(1) THEN LEAVE0=1:GOTO 3720                    '
3710 LINE INPUT #1,A$                                     '
3720 WEND                                                 '
3730 '
3740 'On leaving this WHILE...WEND, A$ can contain a next_directory line
3750 '
3760 '
3770 IF USCAN<513 OR EOF(1) OR LEFTREF6$<>LEFT$(A$,6) THEN FILLED=0 ELSE FILLED=1
3780 '
3790 NMAX=USCAN-1                     ' set scan range
3800 '
3810 IF EOF(2) THEN GOTO 4100
3820 LINE INPUT #2,B$
3830 '
3840 '
3850 M1$=MID$(B$,25,1)          ' test by looking at 3 bytes in date format
3860 M2$=MID$(B$,26,1)
3870 M3$=MID$(B$,27,1)
3880 IF M1$<"0" OR M1$>"9" OR M2$<>"-" OR M3$<"0" OR M3$>"9" THEN GOTO 4060
3890 '
3900 FOR USCAN=0 TO NMAX
3910 IF LEFT$(B$,12)=MID$(U$(USCAN),8,12) THEN GOTO 3950
3920 NEXT USCAN
3930 GOTO 4060 ' did not find match
3940 '
3950 IF S11$<>"2" THEN GOTO 4020
3960 ' case 2: delete text line
3970 IF EOF(2) THEN GOTO 4100                  ' was the comment continued?
3980 LINE INPUT #2,B$                          '
3990 IF LEFT$(B$,LUCONT)=UCONT$ THEN GOTO 3970 ' if yes, then keep looking
4000 GOTO 3850                  ' B$ contains the new work line
4010 '
4020 'case 1:
4030 ' replace left 31 bytes of text_directory_line with new ext, size [,date]
4040 MID$(B$,1,31)=MID$(U$(USCAN),21,31)' for offset, please see chart 'above'
4050 '
4060 PRINT #3,B$
4070 '
4080 GOTO 3810
4090 '
4100 CLOSE 2
4110 CLOSE 3
4120 OPEN INFILE$+".old" AS 2
4130 CLOSE 2
4140 KILL INFILE$+".old"
4150 NAME INFILE$ AS INFILE$+".old"
4160 NAME INFILE$+".tmp" AS INFILE$
4170 IF FILLED=1 THEN GOTO 3560 ' there may have been more to do
4180 IF (S11$="1" AND LEN(A$)>49) OR (S11$="2" AND LEN(A$)>30) THEN MORE=1 ELSE MORE=0
4190 FLAG1=0
4200 RETURN
4210 '
4220 '--------------------------------
4230 '
4240 ' clear part of screen for small menus
4250 '
4260 LOCATE 17,1
4270 PRINT S78$
4280 PRINT S78$
4290 PRINT S78$
4300 PRINT S78$
4310 LOCATE 17,1
4320 RETURN