Category : File Managers
Archive   : DISKVAC.ZIP
Filename : DISKVAC.BAS

DEFINT A-Z: ON ERROR GOTO ANYERROR
D$ = UCASE$(COMMAND$)

IF LEN(D$) = 1 AND D$ > "@" AND LEFT$(D$, 1) < "Z" THEN
D$ = D$ + ":": COLOR 15, 1: CLS
ELSE
SOUND 1700, 2: PRINT "Syntax: DISKVAC [drive]"; : END
END IF

' -- Program Initialization --
DIM SUB$(1000), CDIR$(500), TDIR$(500)
DIM INREG%(7), OUTREG%(7), MC$(3), M$(4)
SBAR$ = STRING$(41, 196): MBAR$ = STRING$(41, 205)
BLANK$ = STRING$(41, 32): W$ = CHR$(186)
M$(1) = CHR$(218) + SBAR$ + CHR$(191)
M$(2) = CHR$(179) + BLANK$ + CHR$(179)
M$(3) = CHR$(192) + SBAR$ + CHR$(217)
M$(4) = CHR$(195) + SBAR$ + CHR$(180)
MC$(1) = CHR$(201) + MBAR$ + CHR$(187)
MC$(2) = W$ + " (C)ontinue (D)elete (E)xit " + W$
MC$(3) = CHR$(200) + MBAR$ + CHR$(188)
HEADER$ = "Filename Ext Size Date Time"
GOSUB GETFREESPACE: GOSUB DISPLAYSCREEN: GOSUB DISPLAYSCREEN1

DO
GOSUB RPROMPT
COLOR 15, 1: LOCATE 17, 20: PRINT "<1> Selected Search ";
LOCATE 18, 20: PRINT "<2> Find Duplicate Files ";
LOCATE 19, 20: PRINT "<3> Quit ";
DO
X$ = INKEY$
X$ = UCASE$(RIGHT$(X$, 1))
SELECT CASE X$
CASE "1"
GOSUB RPROMPT: GOSUB ADDONE
GOSUB GETDIRS: GOSUB SELECTED
EXIT DO
CASE "2"
GOSUB RPROMPT: GOSUB GETDIRS
GOSUB GETDUPLICATES
EXIT DO
CASE "3"
IF WORKED THEN
KILL "DIRECT.DOC"
KILL "DIRTREE.DOC"
END IF
CLS : SYSTEM
CASE ELSE
END SELECT
LOOP

CLS : GOSUB DISPLAYSCREEN: GOSUB DISPLAYSCREEN1: WORKED = 1
COLOR 15, 4: LOCATE 16, 21: PRINT " SEARCH COMPLETE ";
COLOR 15, 1: LOCATE 17, 21: PRINT " Log a new drive? (y/n)";

DO
X$ = INKEY$
X$ = UCASE$(RIGHT$(X$, 1))
SELECT CASE X$
CASE "Y"
GOSUB NEWDRIVE: EXIT DO
CASE "N"
GOSUB RPROMPT: EXIT DO
CASE ELSE
END SELECT
LOOP
LOOP

' -- Log new drive --
NEWDRIVE:
GOSUB RPROMPT: COLOR 15, 1
LOCATE 16, 15: INPUT "Drive letter "; D$

D$ = UCASE$(D$)
IF LEN(D$) = 1 AND D$ > "@" AND D$ < "Z" THEN
D$ = D$ + ":": RETURN
ELSE
SOUND 700, 1: GOTO NEWDRIVE
END IF

'-- Build directory tree --
GETDIRS:
ERASE SUB$, CDIR$, TDIR$
DIRCOUNT = 1: SUB$(DIRCOUNT) = "\"
DIRCOUNT = DIRCOUNT + 1
LOCATE 16, 20: COLOR 15, 4
PRINT "Building Directory Tree "; : COLOR 15, 1
LOCATE 17, 20

SHELL "TREE " + D$ + " > DIRTREE.DOC"
OPEN "DIRTREE.DOC" FOR INPUT AS #1

DO WHILE NOT EOF(1)
LINE INPUT #1, A$
IF INSTR(A$, "\") THEN
TEMPDIR$ = ""
FOR JW = 1 TO LEN(A$)
AA$ = MID$(A$, JW, 1)
IF AA$ > " " THEN TEMPDIR$ = TEMPDIR$ + AA$
NEXT
SUB$(DIRCOUNT) = RIGHT$(TEMPDIR$, LEN(TEMPDIR$) - 5)
DIRCOUNT = DIRCOUNT + 1
END IF
LOOP
GOSUB RPROMPT: CLOSE 1: RETURN
' -- Add a new search string --
ADDONE:
COLOR 15, 1
LOCATE 17, 21: PRINT " Add a search string ? (y/n)";
DO
X$ = INKEY$
X$ = UCASE$(RIGHT$(X$, 1))
SELECT CASE X$
CASE "Y"
GOSUB SFILE: GOSUB RPROMPT: EXIT DO
CASE "N"
GOSUB RPROMPT: EXIT DO
CASE ELSE
END SELECT
LOOP
RETURN

' -- Check entries for string matches --
SELECTED:
DIR = 1
WHILE DIR < DIRCOUNT
LOCATE 3, 27: PRINT STRING$(28, 32); : LOCATE 3, 27
COLOR 15, 4: PRINT D$; SUB$(DIR); : COLOR 15, 1

SHELL "DIR " + D$ + SUB$(DIR) + " >DIRECT.DOC"
OPEN "DIRECT.DOC" FOR INPUT AS #1

DUMPLINES = 0
WHILE DUMPLINES < 6
LINE INPUT #1, BYPASS$
DUMPLINES = DUMPLINES + 1
WEND

'-- Check for matching string mask --
DO WHILE NOT EOF(1)
LINE INPUT #1, F$
IF LEFT$(F$, 1) <> " " AND MID$(F$, 14, 1) <> "<" THEN
IF INSTR(F$, " BAK ") THEN MATCH = 1
IF INSTR(F$, " $$$ ") THEN MATCH = 1
IF INSTR(F$, " BK! ") THEN MATCH = 1
IF INSTR(F$, " TMP ") THEN MATCH = 1
IF MASK$ > "" THEN IF INSTR(F$, MASK$) THEN MATCH = 1
COLOR 15, 4: LOCATE 10, 14: PRINT F$; : COLOR 15, 1
IF MATCH THEN MATCH = 0: GOSUB ASK
IF CUT THEN CUT = 0: COLOR 15, 1: CLOSE 1: RETURN
END IF
LOOP
CLOSE 1: DIR = DIR + 1
WEND
RETURN

ASK:
COLOR 24, 15: LOCATE 10, 14: PRINT F$; : COLOR 15, 1
GOSUB DPROMPT
ASK1:
DO
X$ = INKEY$
X$ = UCASE$(RIGHT$(X$, 1))
SELECT CASE X$
CASE "C"
GOSUB RPROMPT: RETURN
CASE "D"
GOSUB DELETE: GOSUB RPROMPT: RETURN
CASE "E"
CUT = 1: GOSUB RPROMPT: RETURN
CASE ELSE
END SELECT
LOOP
'-- Display menu box --
DPROMPT:
FOR ROW = 17 TO 19
LOCATE ROW, 13: PRINT MC$(ROW - 16);
NEXT
RETURN

'-- Erase menu box --
RPROMPT:
FOR ROW = 16 TO 24
LOCATE ROW, 1: PRINT STRING$(80, 32);
NEXT
LOCATE 16, 20, 0: RETURN
' -- Delete file routine --
DELETE:
IF DUP THEN
IF CURDIR = 1 THEN SUB$(CURDIR) = ""
GOSUB PRINTCHOICES
ELSE
LOCATE 16, 20
COLOR 15, 4: PRINT "Delete this file (y/n) ?";
COLOR 15, 1
END IF

DO
X$ = INKEY$
X$ = UCASE$(RIGHT$(X$, 1))
SELECT CASE X$
CASE "Y"
IF DIR = 1 THEN SUB$(DIR) = ""
THISDIR$ = SUB$(DIR)
GOSUB STRIP: GOSUB KILLFILE: RETURN
CASE "N"
RETURN
CASE "1"
IF DUP THEN
THISDIR$ = SUB$(CURDIR)
F$ = CDIR$(DIR): GOSUB STRIP
GOSUB KILLFILE
GOSUB RPROMPT: RETURN
END IF
CASE "2"
IF DUP THEN
THISDIR$ = SUB$(TAGDIR)
F$ = TDIR$(MC): GOSUB STRIP
GOSUB KILLFILE: GOSUB RPROMPT: RETURN
END IF
CASE "3"
IF DUP THEN
GOSUB RPROMPT: RETURN
END IF
CASE ELSE
END SELECT
LOOP

' -- Kill selected file --
KILLFILE:
GOSUB GETFREESPACE
OLDSPACE# = FREESPACE#
OLDFREE# = NEWSPACE#
KILL D$ + THISDIR$ + "\" + FILENAME$
GOSUB GETFREESPACE
NEWSPACE# = FREESPACE# - OLDSPACE#
NEWSPACE# = NEWSPACE# + OLDFREE#
LOCATE 4, 27: PRINT FREESPACE#;
LOCATE 5, 27: PRINT NEWSPACE#;
RETURN
' -- Select new search mask string --
SFILE:
GOSUB RPROMPT: COLOR 15, 1
LOCATE 16, 15: INPUT "Enter search string: "; MASK$
MASK$ = UCASE$(MASK$)
LOCATE 16, 15: PRINT STRING$(26, 32); : RETURN

' -- Calculate free disk space --
GETFREESPACE:
DRIVE = ASC(LEFT$(D$, 1)) - 64
INREG%(0) = &H3600: INREG%(1) = DRIVE
CALL INT86OLD(&H21, INREG%(), OUTREG%())
IF OUTREG%(0) = &HFFFF THEN BEEP: BEEP: RETURN
SECTORSPERCLUSTER = OUTREG%(0)
FREECLUSTERS! = OUTREG%(1)
BYTESPERSECTOR = OUTREG%(2)
TOTALCLUSTERS! = OUTREG%(3)
SECTORS! = FREECLUSTERS! * SECTORSPERCLUSTER
FREESPACE# = SECTORS! * BYTESPERSECTOR
RETURN

' -- Extract filename from directory string --
STRIP:
LOCATE 22, 14: PRINT STRING$(20, 32);
NAME$ = RTRIM$(LEFT$(F$, 8))
EXT$ = RTRIM$(MID$(F$, 10, 3))

IF EXT$ > "" THEN
FILENAME$ = NAME$ + "." + EXT$
ELSE FILENAME$ = NAME$
END IF
RETURN

'-- Locate files with duplicate names --
GETDUPLICATES:
GOSUB DISPLAYMATCH: GOSUB DISPLAYSCREEN: NUMDIR = 1
COLOR 15, 4: LOCATE 3, 14: PRINT " to abort search";
COLOR 15, 1

WHILE SUB$(NUMDIR) > ""
NUMDIR = NUMDIR + 1
WEND

IF NUMDIR = 1 THEN RETURN
' -- Evaluate directory entries --
CURDIR = 1: AD = 1: TAGDIR = CURDIR + 1: MC = 1

WHILE AD < NUMDIR
GOSUB GETINDEX
WHILE TAGDIR < NUMDIR
GOSUB GETSEARCH
DIR = 1

DO WHILE DIR <= LASTCUR

IF INSTR(CDIR$(DIR), "<") = 0 THEN
COLOR 15, 4: LOCATE 10, 14: PRINT CDIR$(DIR);
END IF

DO WHILE MC <= LASTTAG

IF INSTR(TDIR$(MC), "<") = 0 THEN
COLOR 15, 4: LOCATE 14, 14: PRINT TDIR$(MC);
IF LEFT$(TDIR$(MC), 12) = LEFT$(CDIR$(DIR), 12) THEN
IF CUT THEN CUT = 0: COLOR 15, 1: RETURN
GOSUB DISPLAYNAMES
END IF
END IF
MC = MC + 1
LOOP
DIR = DIR + 1: MC = 1
LOOP
TAGDIR = TAGDIR + 1
WEND
AD = AD + 1: CURDIR = CURDIR + 1
TAGDIR = CURDIR + 1
WEND
RETURN

' -- Get index directory entries --
GETINDEX:
DUMPLINES = 0: COLOR 15, 1
LOCATE 8, 14: PRINT STRING$(62, 32); : COLOR 15, 4
LOCATE 8, 14: PRINT "INDEX: "; D$; SUB$(CURDIR);
COLOR 15, 1

SHELL "DIR " + D$ + SUB$(CURDIR) + " >DIRECT.DOC"
OPEN "DIRECT.DOC" FOR INPUT AS #1

' -- Skip first 6 lines of ASCII file --
WHILE DUMPLINES < 6
LINE INPUT #1, A$
DUMPLINES = DUMPLINES + 1
WEND

COUNTER = 0
DO WHILE COUNTER < 501 AND NOT EOF(1)
COUNTER = COUNTER + 1
LINE INPUT #1, CDIR$(COUNTER)
LOOP

LASTCUR = COUNTER - 1
CLOSE 1: RETURN
' -- Get search directory entries --
GETSEARCH:
X$ = INKEY$
IF X$ = CHR$(27) THEN CUT = 1

DUMPLINES = 0

COLOR 15, 1
LOCATE 12, 14: PRINT STRING$(62, 32); : COLOR 15, 4
LOCATE 12, 14: PRINT "SEARCHING: "; D$; SUB$(TAGDIR);
COLOR 15, 1

SHELL "DIR " + D$ + SUB$(TAGDIR) + " >DIRECT.DOC"
OPEN "DIRECT.DOC" FOR INPUT AS #1

WHILE DUMPLINES < 6
LINE INPUT #1, A$
DUMPLINES = DUMPLINES + 1
WEND
' -- Gather entries from search directory --
COUNTER = 0
DO WHILE COUNTER < 501 AND NOT EOF(1)
COUNTER = COUNTER + 1

LINE INPUT #1, TDIR$(COUNTER)
LOOP
LASTTAG = COUNTER - 1: CLOSE 1: RETURN

' -- Display matching filenames --
DISPLAYNAMES:
COLOR 24, 15
LOCATE 10, 14: PRINT CDIR$(DIR);
LOCATE 14, 14: PRINT TDIR$(MC);
COLOR 15, 1: GOSUB DPROMPT: SOUND 300, .5
DUP = 1: GOSUB ASK1: DUP = 0: RETURN

' -- Display workscreen --
DISPLAYSCREEN:
LOCATE 2, 13: PRINT M$(1); : ROW = 3
WHILE ROW < 6
LOCATE ROW, 13: PRINT M$(2);
ROW = ROW + 1
WEND
LOCATE 6, 13: PRINT M$(3)
LOCATE 3, 14: PRINT "Drive/Path : ";
LOCATE 4, 14: PRINT "Bytes Free : "; FREESPACE#;
LOCATE 5, 14: PRINT "Reclaimed :"; NEWSPACE#;
RETURN

DISPLAYSCREEN1:
LOCATE 7, 13: PRINT M$(1); : LOCATE 8, 13: PRINT M$(2);
LOCATE 9, 13: PRINT M$(4); : LOCATE 10, 13: PRINT M$(2);
LOCATE 11, 13: PRINT M$(3); : LOCATE 8, 15: PRINT HEADER$;
RETURN

DISPLAYMATCH:
COLOR 15, 1: CLS : GOSUB DISPLAYSCREEN
FOR ROW = 9 TO 11
LOCATE ROW, 13: PRINT M$(ROW - 8);
NEXT
FOR ROW = 13 TO 15
LOCATE ROW, 13: PRINT M$(ROW - 12);
NEXT
RETURN

PRINTCHOICES:
GOSUB RPROMPT: COLOR 15, 4
F3$ = RTRIM$(MID$(CDIR$(DIR), 10, 3))
F4$ = RTRIM$(MID$(TDIR$(MC), 10, 3))
F1$ = RTRIM$(LEFT$(CDIR$(DIR), 8)) + "." + F3$
F2$ = RTRIM$(LEFT$(TDIR$(MC), 8)) + "." + F4$

LOCATE 16, 20: PRINT " DELETE ": COLOR 15, 1
PRINT TAB(19); "<1> "; D$; SUB$(CURDIR); "\"; F1$
PRINT TAB(19); "<2> "; D$; SUB$(TAGDIR); "\"; F2$
PRINT TAB(19); "<3> CONTINUE"
RETURN
ANYERROR:
CLOSE : CLS : SYSTEM