'===========================================================================
' Subject: DIRECTORY SCAN                    Date: 06-23-98 (01:48)       
' Author:  Antoni Gual                       Code: QB, PDS                
' Origin:  agual@eic.ictnet.es             Packet: DISK.ABC
'===========================================================================
DECLARE SUB ShowHelp ()
DECLARE SUB Scan (sumbyte&, sumfiles&, sumcluster&, FirstOfLevel%, newlevel$)
DECLARE SUB dosprint (txt$)
DEFINT A-Z
'------------------------------------------------------------------------
'DIRSCAN.BAS
'Antoni Gual 1998   agual@eic.ictnet.es    PUBLIC DOMAIN

'This program is a ShowHelp to disk maintenanceit scans directories in a disk and
'displays:
'        tree structure
'        directory (short) name
'        total files
'        size
'        % of filling
'for the single directory and for the whole branch.
'It runs from parameters passed from command line, and uses DOS interrupts
'to print, so you can redirect and sort his output.
'I prevent you: the grand total never matches with the disk size! ;-)
'Needs the /lqb parameter in Quick Basic.Does not work in QBasic, i've lost
'the interrupt calling routine somewhere in my HD

'Try      DIRSCAN c:          or      DIRSCAN /?     for Help

'------------------------------------------------------------------------
'programming features:
'---------------------
'does not use a single float related function - shorter code when compiled
'does use recursion, no arrays, it can handle up to 2000 000 000 files
'at the price of displaying the directory tree upside down
'limited to 2 Gb disks, due to the limitations of the LONG integer type
'-----------------------------------------------------------------------
'Help needed!!!
'--------------
'Not tested with FAT 32
'Does not check for removable disks-How to do it for floppies, CD's, Zips?
'The total size of clusters is never equal to size given by the Disk Size
'function'minus the free space.Is there any hidden sectors?Where are LFN stored?
'For the CD's the total size of clusters is bigger?? than the total disk space
'Why? Is the concept of cluster size valid for CD's?
'Should display LFN
'------------------------------------------------------------------------
'general constants
'-----------------
CONST false = 0, true = NOT false

'interrupt call structures
'-------------------------
TYPE RegTypeX
     ax    AS INTEGER
     bx    AS INTEGER
     cx    AS INTEGER
     dx    AS INTEGER
     bp    AS INTEGER
     si    AS INTEGER
     di    AS INTEGER
     flags AS INTEGER
     ds    AS INTEGER
     es    AS INTEGER
END TYPE

DECLARE SUB interruptx (intnum AS INTEGER, inreg AS RegTypeX, outreg AS RegTypeX)
CONST CarryFlag = 1


'dos structures
'--------------
TYPE dtatype
 reserved AS STRING * 21
 atr  AS STRING * 1
 tim  AS INTEGER
 dat  AS INTEGER
 siz  AS LONG
 nam  AS STRING * 13
END TYPE

CONST DtaHour = &HF800, DtaMin = &H7E0, DtaSec = &H1F
CONST DtaYear = &HFE00, DtaMonth = &H1E0, DtaDay = &H1F
CONST AttRO = 1, AttHid = 2, AttSys = 4, attfile = &H6, AttLab = 8
CONST AttSub = &H10
CONST AttArch = &H20, AttNotAFile = &H18

'dos calls constants
'-------------------
CONST DosInt = &H21
CONST DisplString = &H900, SetDisk = &HE00, SearchFirst = &H4E00
CONST SearchNext = &H4F00, SetDta = &H1A00, GetDTA = &H2F00, GetDOSVer = &H3000
CONST GetDiskSpace = &H3600, SetDir = &H3B00, GetDir = &H4700, GetDeFDrive = &H1900

'functions
'---------

DEF FNLONG2STR$ (x&, L%)
'converts a LONG to a right justificated string, with thousand'separators
'------------------------------------------------------------------------ 
    y& = x&: i = L%: FNLONG2STR$ = SPACE$(L%)
    DO
	IF (L% - i) MOD 4 = 3 THEN MID$(FNLONG2STR$, i, 1) = ".": i = i - 1
	MID$(FNLONG2STR$, i, 1) = CHR$((y& MOD 10) + 48): y& = y& \ 10: i = i - 1
    LOOP UNTIL y& = 0 OR i = 0
    IF y& THEN FNLONG2STR$ = STRING$(L%, 35)
END DEF

DEF fnAsciiz2Str$ (txt$)
'truncates a string before ascii 0 char 
'-------------------------------------- 
    fnAsciiz2Str$ = LEFT$(txt$, INSTR(txt$, CHR$(0)) - 1)
END DEF

DEF fnWord2Long& (x)
'converts an unsigned integer (2 bytes) to a LONG
'------------------------------------------------
    fnWord2Long& = x
    IF x < 0 THEN fnWord2Long& = x + 65536
END DEF

'variables
'---------
DIM SHARED tree$: tree$ = SPACE$(10)
DIM SHARED temp$: temp$ = SPACE$(83)
DIM SHARED regs AS RegTypeX
DIM SHARED BytesSector&, SectorsCluster&, ClustersDrive&, FreeClusters&
DIM SHARED FreeBytes&, bytescluster&, TotalBytes&
DIM SHARED DriveToScan
'StartDir$ = SPACE$(65)
DIM SHARED builddir AS STRING
DIM SHARED screenline AS STRING: screenline = SPACE$(79)
DIM StartDrive AS INTEGER
DIM SHARED maxlevel AS INTEGER
DIM SHARED mode AS INTEGER

'parameters read from command line
'---------------------------------
maxlevel = 10
mode = 1
a$ = UCASE$(COMMAND$)
dp% = INSTR(a$, ":")
IF dp% THEN DriveToScan = ASC(MID$(a$, dp% - 1, 1)) - 64
ba% = INSTR(a$, "/")

IF ba% THEN
	IF INSTR(ba%, a$, "?") THEN ShowHelp: END
	IF INSTR(ba%, a$, "H") THEN ShowHelp: END
	IF INSTR(ba%, a$, "S") THEN mode = 2
	lp% = INSTR(ba%, a$, "L")
	IF lp% THEN maxlevel = ASC(MID$(a$, lp% + 1, 1)) - 47
	a1% = ba% - 1
ELSE
	a1% = LEN(a$)
END IF
IF (a1% - dp%) > 0 THEN StartDir$ = LTRIM$(RTRIM$(MID$(a$, dp% + 1, a1% - dp%)))




CLS

'get general disk data
'---------------------
'current disk
'------------
regs.ax = GetDeFDrive
CALL interruptx(DosInt, regs, regs)
CurDrive = (regs.ax AND 255) + 1
IF mode = 1 THEN dosprint "Current Drive: " + CHR$(CurDrive + 64)


'current dir
'-----------
regs.ax = GetDir
regs.dx = StartDrive
regs.ds = VARSEG(CurDir$)
regs.si = SADD(CurDir$)
CALL interruptx(DosInt, regs, regs)
IF regs.flags AND CarryFlag THEN dosprint "Invalid Drive": END
IF mode = 1 THEN dosprint "Current Dir: " + CurDir$
IF DriveToScan = 0 THEN DriveToScan = CurDrive
IF mode = 1 THEN dosprint "Scanning Disk " + CHR$(DriveToScan + 64) + ":"

'get disk general values
'-----------------------
regs.ax = GetDiskSpace
regs.dx = DriveToScan
CALL interruptx(DosInt, regs, regs)
BytesSector& = fnWord2Long&(regs.cx)
SectorsCluster& = fnWord2Long&(regs.ax)
ClustersDrive& = fnWord2Long&(regs.dx)
FreeClusters& = fnWord2Long&(regs.bx)
bytescluster& = BytesSector& * SectorsCluster&
TotalBytes& = bytescluster& * ClustersDrive&
FreeBytes& = bytescluster& * FreeClusters&
sumbyte& = 0: sumfiles& = 0

'scans disk
'----------
'IF LEN(StartDir$) THEN StartDir$ = "\" + StartDir$
StartDir$ = CHR$(DriveToScan + 64) + ":" + StartDir$
Scan sumbyte&, sumfiles&, sumcluster&, true, StartDir$

'write disk space
'----------------
IF mode = 1 THEN
	LSET screenline = ""
	MID$(screenline, 14) = FNLONG2STR$(BytesSector& * SectorsCluster& * FreeClusters&, 13)
	MID$(screenline, 49) = " bytes Free  disk Space"
	dosprint screenline
	LSET screenline = ""
	MID$(screenline, 14) = FNLONG2STR$(BytesSector& * SectorsCluster& * ClustersDrive&, 13)
	MID$(screenline, 49) = " bytes Total disk Space"
	dosprint screenline
	dosprint ""
END IF

END

SUB dosprint (txt$)
'-----------------------------------------------------------------
'prints a string using DOS Interrupt, the output can be redirected
'and sorted. Adds a return at the end
'-----------------------------------------------------------------
LSET temp$ = txt$ + CHR$(13) + CHR$(10) + "$"
regs.ax = DisplString
regs.ds = VARSEG(temp$)
regs.dx = SADD(temp$)
CALL interruptx(DosInt, regs, regs)

END SUB

SUB Scan (sumbyte&, sumfiles&, sumcluster&, FirstOfLevel, newdir$)
'------------------------------------------------------------------------
'Uses DOS services to scan a directory and get each file in turn
'gets file data and adds to statistics
'When it finds a subdirectory it calls himself recursively
'Before exiting it prints the info found, so the program does'nt need big data
'arrays. It returns data needed to accumulate sizes, and file nrs
'-------------------------------------------------------------------------
DIM dta AS dtatype    'new dta for this level
STATIC level         'only one var for all levels
'local values
'-----------------
level = level + 1

locbyte& = 0: locfiles& = 0: loccluster& = 0
sumbyte& = 0: sumfiles& = 0: sumcluster& = 0
Startlen = LEN(builddir)
fol = true

'init file search
'----------------
IF LEN(newdir$) THEN builddir = builddir + newdir$ + "\"
Filename$ = builddir + "*.*" + CHR$(0)
GOSUB changedta
firstfile = true
atribute = &HFFFF                  'find files with any attribute

'loop for all entries in dir
'---------------------------
GOSUB findfile
DO
    'process the values found fy findfile
    '------------------------------------
    loccluster& = loccluster& + (dta.siz \ bytescluster&)
    IF dta.siz MOD bytescluster& THEN loccluster& = loccluster& + 1
    locbyte& = locbyte& + dta.siz
   
    IF (ASC(dta.atr) AND AttNotAFile) = 0 THEN locfiles& = locfiles& + 1
   
    'new dir found, if it's not . or .. call Scan again
    '--------------------------------------------------
    IF ASC(dta.atr) AND AttSub THEN
	namedir$ = fnAsciiz2Str$(dta.nam)

	'forget . and .. that are not entries to sub-directories
	'-------------------------------------------------------
	IF ASC(namedir$) <> ASC(".") THEN
	   
	   
	    'call Scan again for the subdir
	    '-------------------------------
	    Scan ThisByte&, ThisFiles&, ThisCluster&, fol, namedir$
	    fol = false

	    'accumulate values found by scan in the subdir
	    '---------------------------------------------
	    sumbyte& = sumbyte& + ThisByte&: sumfiles& = sumfiles& + ThisFiles&
	    sumcluster& = sumcluster& + ThisCluster&
	   
	    'back to this level's DTA
	    '------------------------
	    GOSUB changedta
	   
	END IF
    END IF
    GOSUB findfile
LOOP UNTIL enddir

'accumulate values of this dir
'-----------------------------

sumbyte& = sumbyte& + locbyte&: sumfiles& = sumfiles& + locfiles&
sumcluster& = sumcluster& + loccluster&
IF locbyte& THEN locpercent& = (locbyte& \ loccluster&) * 100 \ bytescluster& ELSE locpercent& = 100

IF sumbyte& THEN sumpercent& = (sumbyte& \ sumcluster&) * 100 \ bytescluster& ELSE sumpercent& = 100


'display accumulated only if below maxlevel
'------------------------------------------

IF level <= maxlevel THEN
  
   LSET screenline = ""
   MID$(screenline, 1) = FNLONG2STR$(loccluster& * bytescluster&, 13)
   MID$(screenline, 14) = FNLONG2STR$(sumcluster& * bytescluster&, 13)
  
   IF mode% = 1 THEN
	'create tree line
	'----------------

	IF level > 1 THEN
	   FOR i = 1 TO level - 1
	   IF MID$(tree$, i, 1) <> CHR$(32) THEN MID$(tree$, i) = CHR$(186)
	   NEXT
		  
	END IF
	IF FirstOfLevel THEN MID$(tree$, level) = CHR$(201) ELSE MID$(tree$, level) = CHR$(204)
	LSET tree$ = LEFT$(tree$, level)
		  

	   
	'MID$(screenline, 1) = FNLONG2STR$(locbyte&, 13)
	'MID$(screenline, 14) = FNLONG2STR$(sumbyte&, 13)
		  
		  
	MID$(screenline, 28) = FNLONG2STR$(locfiles&, 5)
	MID$(screenline, 34) = FNLONG2STR$(sumfiles&, 6)
	MID$(screenline, 42) = FNLONG2STR$(locpercent&, 3)
	MID$(screenline, 46) = FNLONG2STR$(sumpercent&, 3)
	MID$(screenline, 50) = LEFT$(tree$, level) + newdir$
   ELSE
	MID$(screenline, 28) = builddir
   END IF
   dosprint screenline
END IF

'reset level parameter and back to previous level
'------------------------------------------------
level = level - 1
builddir = LEFT$(builddir, Startlen)

EXIT SUB

'GO SUBS
'-------

findfile:
'finds any file that match path in Filename$ and attribute in "atribute"
'-----------------------------------------------------------------------
'a DTA must be set before first call
'first search must use SearchFirst function

IF firstfile THEN
    regs.ax = SearchFirst
    regs.cx = atribute
    regs.ds = VARSEG(Filename$)
    regs.dx = SADD(Filename$)
    CALL interruptx(DosInt, regs, regs)
    firstfile = false
ELSE
    regs.ax = SearchNext
    CALL interruptx(DosInt, regs, regs)
END IF

'detection of no more files error

IF regs.flags AND CarryFlag THEN
IF regs.ax = &H12 THEN enddir = true ELSE PRINT "Error:", regs.ax: END
END IF
RETURN

changedta:  
'sets a new DTA for this level of search
'---------------------------------------
regs.ax = SetDta
regs.ds = VARSEG(dta)
regs.dx = VARPTR(dta)
CALL interruptx(DosInt, regs, regs)
RETURN

END SUB

SUB ShowHelp
CLS
dosprint "DIRSCAN [disk:][path] [/[Lx][?|H]"
dosprint "Scans a dir and his sub-dirs and outputs values to screen"
dosprint ""
dosprint "If you omit parameters it will scan default disk/ base directory,10 levels"
dosprint "and display tree"
dosprint "Options: "
dosprint "Lx     -Displays x directory levels under path "
dosprint "S      -Displays no header and footer, only sizes and path, this way"
dosprint "        the output can be sorted"
dosprint "? or H -Displays Help"
dosprint "All screen prints ar done thru'DOS services, you can use DOS sort and redirect"
dosprint " DIRSCAN a:/S |SORT |MORE   will sort and stop between pages"
dosprint " DIRSCAN C:  >LPT1          will print the listing"
dosprint " DIRSCAN A: |SORT >FILENAME will direct the sorted output to a file "
dosprint ""
dosprint ""
dosprint "Programmed 1998 in QuickBasic by Antoni Gual       agual@eic.ictnet.es"
END SUB