'===========================================================================
' Subject: DISPLAY CONTENTS OF HARDDISK       Date: 12-20-97 (10:24)       
'  Author: Rick Elbers                        Code: QB, QBasic, PDS        
'  Origin: authentic@tip.nl                 Packet: DISK.ABC
'===========================================================================
DECLARE SUB recursdirs (cluster1&)
DECLARE FUNCTION entrancestart& (offset%)
DECLARE SUB scan4dirs ()
DECLARE FUNCTION entranceatt% (offset%)
DECLARE SUB readdirstruc (file$)
DECLARE FUNCTION comparestring$ ()
DECLARE FUNCTION insector2% (match$)
DECLARE SUB readstring (match$)
DECLARE FUNCTION insector% (match$)
DECLARE SUB scan4string (match$)
DECLARE SUB readpath (path$, sector&)
DECLARE FUNCTION entrancename$ (offset%)
DECLARE FUNCTION name$ (offset%)
DECLARE FUNCTION shortpath$ (path$)
DECLARE SUB separate (part$, path$)
DECLARE SUB scan4path (sector&, path$)
DECLARE FUNCTION inroot& (subdir$)
DECLARE SUB errorhandling (errs%)
DECLARE FUNCTION clus2sec& (cluster&)
DECLARE SUB scan4file (cluster1&, subfile$)
DECLARE FUNCTION islastcluster% (cluster&)
DECLARE SUB getdisknr ()
DECLARE SUB initprogram ()
DECLARE SUB initdrive ()
DECLARE SUB moreclusters (cluster1&)
DECLARE SUB displayclusters (cluster1&, subfile$)
DECLARE FUNCTION fatentrie% (startcluster&)
DECLARE FUNCTION indir& (sector&, subdir$)
DECLARE SUB readfile (file$, sector&)
DECLARE SUB readsector (sector&)
DECLARE SUB readboot ()
DECLARE SUB readdisk ()
DECLARE SUB statusline ()
DECLARE SUB printfile (sector&)
DECLARE SUB printdata (sector&)
DECLARE SUB printnameattr (offset%)
DECLARE SUB printlong (offset%)
DECLARE SUB printshort (offset%)
DECLARE SUB exits ()
DECLARE SUB keyproces (sector&)
DECLARE SUB printdir (sector&)
DECLARE SUB printboot ()
DECLARE SUB printfat (sector&)
DECLARE SUB sectorread (asmstore%())
DECLARE FUNCTION userinput$ (message$)

'---------------------------------------------------------------------------
'XS2DISK: A program that displays the contents of your harddisk( all of it)
'Necessary requirement: DOS 4+( since there is made use of longsectors!)
'And also it probably won't work on a FAT32, and certainly not at NTfilesys.

'Rick Elbers december 1996
'---------------------------------------------------------------------------
'Note a year later: After all I will contribute this to public domain.
'The approach is that I donate highly configurable programs which have
'good structure already. That way it will be very easy, even for beginners,
'to "own" this program and its underlying knowledge.
'This program is easy extendable:
'1)You could make the path scanner return to the first sector scanned,
'  instead of to the sector at which the search started.
'2)Look at the sub keyproces in which you find a grey-ed option.

'Have joy forever,
'Rick


DEFINT A-Z

'As much as I hate shared types, I do not want to drag bootinfo around
DIM SHARED nrfat       'number of FATs on disk
DIM SHARED fatsec:     'nr of sectors per FAT

DIM SHARED startroot&  'sector where dos root directory starts
DIM SHARED direntrances'number of entrances in rootdirectory

DIM SHARED bytepsec    'bytes per sector
DIM SHARED secpclus    'sectors per cluster
DIM SHARED ressec:     'nr of reserved sectors
DIM SHARED hiddensec:  'nr of hidden sectors

DIM SHARED startdata&  'sector where data sectors start
DIM SHARED total&      'total number of sectors on disk
DIM SHARED totalclus&  'total number of clusters on disk

DIM SHARED sectorbuffer(&H100) 'Where we put the sectors in.
DIM SHARED asmstore(28)        'Where we saved our assembly routine
DIM SHARED asmsegment          'Location of our asmcode
DIM SHARED disknr              '0=A,1=B,2=C enz..
DIM SHARED empty               'keybuff empty value
DIM SHARED stringcmp$          'stringcompare routine


'Initializing..
CLEAR

'Execute demoprogram

CALL readdisk

'
'Translates a clusternr found in FAT to DOS sector nr
'
FUNCTION clus2sec& (cluster&)

clus2sec& = (cluster& - 2) * secpclus + startdata&


END FUNCTION

DEFSNG B-Z
DEFSTR A
FUNCTION comparestring$
'----------------------------------------
'Compares string with an array
'USING smart method( first a character match)

'STACKPASSING SRC%(),STRING2MATCH,RESULT

'IN    :SRC%() WHICH HAS TO BE CHECKED
'       STRING2MATCH AGAINST THIS STRING
'OUT   :IF RESULT=1 THEN MATCH FOUND

'-----------------------------------------
'SET UP STACK FRAME..
asm = asm + CHR$(&H55)               'PUSH BP
asm = asm + CHR$(&H89) + CHR$(&HE5)  'MOV BP,SP
asm = asm + CHR$(&H6)                'PUSH ES
asm = asm + CHR$(&H1E)               'PUSH DS
'GET POINTERS FROM THE STACK
asm = asm + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)'MOV BX,[BP+08]
asm = asm + CHR$(&H8B) + CHR$(&H76) + CHR$(&HA)'MOV SI,[BP+0A]
'SET UP ES[DI] TO SOURCE, CX TO SECTOR LENGTH,AL TO FIRST CHAR TO MATCH
asm = asm + CHR$(&HC4) + CHR$(&H3C)            'LES DI,[SI]
asm = asm + CHR$(&H8B) + CHR$(&H77) + CHR$(&H2)'MOV SI,[BX+2]
asm = asm + CHR$(&HB9) + CHR$(&H12) + CHR$(&H5)'MOV CX, 512
asm = asm + CHR$(&H8A) + CHR$(&H4)             'MOV AL,[SI] first char
'SCAN FOR THE FIRST CHARACTER..
asm = asm + CHR$(&HF2) + CHR$(&HAE)            'REPNZ SCASB
asm = asm + CHR$(&H75) + CHR$(30)              'JNZ DONE +30  no hit
asm = asm + CHR$(&H51)                         'PUSH CX   save CX
asm = asm + CHR$(&H89) + CHR$(&HFA)            'MOV DX,DI save DI
asm = asm + CHR$(&H4F)                         'DEC DI
asm = asm + CHR$(&H8B) + CHR$(&HF)             'MOV CX, [BX] len of string
asm = asm + CHR$(&HF3) + CHR$(&HA6)            'REP CMPSB
asm = asm + CHR$(&H89) + CHR$(&HD7)            'MOV DI, DX restore DI
asm = asm + CHR$(&H8B) + CHR$(&H77) + CHR$(2)  'MOV SI, [BX+2]restore SI
asm = asm + CHR$(&H59)                         'POP CX     restore CX
asm = asm + CHR$(&H75) + CHR$(&HEC)            'JNZ AGAIN -20  no hit yet
'REPORT HIT           14
asm = asm + CHR$(&H1F)                         'POP DS
asm = asm + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)'MOV BX,[BP+06]
asm = asm + CHR$(&HB8) + CHR$(&H1) + CHR$(&H0) 'MOV AX,1
asm = asm + CHR$(&H89) + CHR$(&H7)             'MOV [BX], AX
asm = asm + CHR$(&H7)                          'POP ES
asm = asm + CHR$(&H5D)                         'POP BP
asm = asm + CHR$(&HCA) + CHR$(&H6) + CHR$(&H0) 'RETF 6
'REPORT NO HIT
asm = asm + CHR$(&H1F)                         'POP DS
asm = asm + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)'MOV BX,[BP+06]
asm = asm + CHR$(&H31) + CHR$(&HC0)            'XOR AX, AX
asm = asm + CHR$(&H89) + CHR$(&H7)             'MOV [BX], AX
asm = asm + CHR$(&H7)                          'POP ES
asm = asm + CHR$(&H5D)                         'POP BP
asm = asm + CHR$(&HCA) + CHR$(&H6) + CHR$(&H0) 'RETF 6

comparestring$ = asm

END FUNCTION

DEFINT A-Z
'
'Gets the attribute from a (sub) directory entrance.
'
FUNCTION entranceatt (offset)

entranceatt = PEEK(offset + 11)


END FUNCTION

'
'Gets the name of an entrance( with extension) from a directory
'
FUNCTION entrancename$ (offset)


j = 0
DO WHILE PEEK(offset + j) <> 32 AND j < 8
  a$ = a$ + CHR$(PEEK(offset + j))
  j = j + 1
LOOP
j = 8
DO WHILE PEEK(offset + j) <> 32 AND j < 11
  a$ = a$ + CHR$(PEEK(offset + j))
  j = j + 1
LOOP
entrancename$ = a$


END FUNCTION

'
'Reads the startcluster from a (sub) directory entrance
'
FUNCTION entrancestart& (offset)

entrancestart& = PEEK(offset + 27) * &H100& OR PEEK(offset + 26)


END FUNCTION

'
'Called when DOS knows about err
'
SUB errorhandling (errs)

doserrs = (errs / &H100) AND &HFF
bioserrs = errs AND &HFF

DIM errors$(1 TO 4)
errors$(1) = "bad command": errors$(2) = "bad adress mark"
errors$(3) = "write protect": errors$(4) = "sector not found"

SELECT CASE doserrs
  CASE 1 TO 4: PRINT "Because "; errors$(doserrs);
  CASE 8: PRINT "Because DMA failure";
  CASE &H10: PRINT "Because bad CRC";
  CASE &H20: PRINT "Because controller failed";
  CASE &H40: PRINT "Because seek failed";
  CASE &H80: PRINT "Because attachment failed to respond";
  CASE IS > 0: PRINT "Because unknown doserror";
END SELECT

DIM bioserr$(0 TO 12)
'BIOSERRORS
bioserr$(0) = "write protect error"
bioserr$(1) = "unknown unit": bioserr$(2) = "drive not ready"
bioserr$(3) = "unknown command": bioserr$(4) = "bad CRC"
bioserr$(5) = "bad request structure length": bioserr$(6) = "seek error"
bioserr$(7) = "unknown media type": bioserr$(8) = "sector not found"
bioserr$(10) = "write fault": bioserr$(11) = "read fault"
bioserr$(12) = "general failure"

IF bioserrs >= 0 AND bioserrs > 0 AND bioserrs < &HC THEN
  PRINT "and because "; bioserr$(bioserrs);
ELSEIF bioserrs = &H80 THEN
  PRINT "and because time out, drive not ready "
ELSEIF bioserrs > 0 THEN
  PRINT "and because unknown bioserror";
END IF
PRINT




END SUB

'
'This sub cleans up and exits
'
SUB exits

'clean up ?

END



END SUB

'
'Gets a FAT entries for a calcalated startcluster.
'
FUNCTION fatentrie (startcluster&)

'The fat starts at sector 1
'And ends at the rootstart sector

'determine which sector of FAT to read first

fatsector& = 1 + startcluster& * 2 \ bytepsec   '2 bytes per FAT entrance

'PRINT fatsector&, bytepsec, fatentrancenr&


CALL readsector(fatsector&)

'Get the FAT entrie

'PRINT startcluster&, startcluster& MOD bytepsec, fatsector&

fatentrie = sectorbuffer(startcluster& MOD bytepsec \ 2)








END FUNCTION

DEFSTR A
'
'
'Gets the default drive in 0=A,etc format
'
SUB getdisknr

'STACKPASSING: DISKNR

'SET UP STACKFRAME
asm = asm + CHR$(&H55)                          'POP BP
asm = asm + CHR$(&H89) + CHR$(&HE5)             'MOV BP,SP
'GET DEFAULT DRIVE..
asm = asm + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6) 'MOV BX,[BP+6]
asm = asm + CHR$(&HB4) + CHR$(&H19)             'MOV AH,19
asm = asm + CHR$(&HCD) + CHR$(&H21)             'INT 21
'STORE VALUE
asm = asm + CHR$(&H88) + CHR$(&H7)              'MOV [BX],AL
'AND RETURN TO QBASIC
asm = asm + CHR$(&H5D)                          'POP BP
asm = asm + CHR$(&HCA) + MKI$(2)                'RETF 2

DEF SEG = VARSEG(asm$): CALL absolute(disknr, SADD(asm$))
DEF SEG : asm$ = "":

END SUB

DEFINT A
'
'This sub checks if the file/sub name is mentioned in this sector('s names)
'
FUNCTION indir& (cluster1&, path$)

sector& = clus2sec&(cluster1&): endsector& = sector& + secpclus
path$ = shortpath$(path$)
fileentrances = bytepsec \ 32 - 1

DO UNTIL cluster& > 0 OR sector& >= endsector&

  CALL readsector(sector&)
  DEF SEG = VARSEG(sectorbuffer(0))
  i = 0

  DO WHILE PEEK(i * 32) <> 32 AND i <= fileentrances AND cluster& = 0
 
    offset = i * 32
    IF entrancename$(offset) = path$ THEN cluster& = PEEK(offset + 27) * &H100& OR PEEK(offset + 26)
    i = i + 1

  LOOP
 
  sector& = sector& + 1

LOOP

DEF SEG

indir& = cluster&




END FUNCTION

'
'Getting the parameters of a drive( called when a new one)
'
SUB initdrive

VIEW PRINT 24 TO 25: CLS 2:
'start with bootsector for the new drive
CALL readboot
COLOR 7, 0: CALL statusline


END SUB

'
'Initializes the program
'
SUB initprogram

'Initializing:
CALL sectorread(asmstore()) 'initialize assembly prog
asmsegment = VARSEG(asmstore(0))
stringcmp$ = comparestring$

'And the header:
LOCATE 1, 1: PRINT "READ SECTOR :"; : LOCATE 1, 30: PRINT " AREA : ";
LOCATE 2, 1: PRINT STRING$(80, "_")

'And the footer:
LOCATE 19, 1: PRINT STRING$(80, "_")
CALL statusline

'Lets start with the default drive
getdisknr


'Start with reading the bootsector
CALL initdrive


END SUB

'
'This function checks if this file/directory is in the root
'
'
FUNCTION inroot& (path$)

nextsector& = startroot&
path$ = shortpath$(path$)

fileentrances = bytepsec \ 32 - 1
DO UNTIL cluster1& > 0 OR nextsector& >= startdata&

  CALL readsector(nextsector&)
  DEF SEG = VARSEG(sectorbuffer(0))

  i = 0
  DO WHILE PEEK(i * 32) <> 32 AND i <= fileentrances AND cluster1& = 0
  
    offset = i * 32
    IF entrancename$(offset) = path$ THEN cluster1& = PEEK(offset + 27) * &H100& OR PEEK(offset + 26)
    i = i + 1

  LOOP

  nextsector& = nextsector& + 1

LOOP

DEF SEG

inroot& = cluster1&









END FUNCTION

'
'Looking for a specified string in a 512 byte sector
'
FUNCTION insector (match$)

DEF SEG = VARSEG(stringcmp$)
CALL absolute(sectorbuffer(), match$, res, SADD(stringcmp$))
DEF SEG
insector = res


END FUNCTION

'
'Recognizes a marker for an end of the file chain
'
FUNCTION islastcluster (cluster&)


IF cluster& > -8 AND cluster& < 0 THEN islastcluster = 1



END FUNCTION

'
SUB keyproces (sector&)

DEF SEG = &H40: empty = PEEK(&H1A): DEF SEG

DO
  SLEEP: FIRSTKEY = INP(&H60) AND &H7F       'GET FIRST KEY
  DEF SEG = &H40: POKE &H1C, empty: DEF SEG  'EMPTY KEYBUF
  gotone = 1                                 'ASSUME KEY=OKE

  SELECT CASE FIRSTKEY
   
    CASE 1       'ESCAPE PRESSED
    CALL exits

    CASE 59      'F1 = MENUDISPLAY

    CASE 60      'F2 = NEXT SECTORNUMBER
    a$ = userinput$("NEXT SECTOR( HEX) ")
    sector& = VAL("&h" + a$)                  'Sign extend
    IF sector& < 0 AND sector& < &H10000 THEN sector& = &H10000 + sector&
    

    CASE 61      'F3 = NEXT CLUSTERNUMBER

    a$ = userinput$("NEXT CLUSTER( HEX)")
    sector& = ((VAL("&h" + a$) AND &HFFFF&) - 2) * secpclus + startdata&

    CASE 62      'F4 = PATH TO READ
   
    path$ = userinput$("PATH TO DISPLY SECTORS OF ")
    CALL readpath(UCASE$(path$), sector&)


    CASE 63      'F5 = NEXT SECTOR
    sector& = sector& + 1

    CASE 64      'F6 = ONE SECTOR BACK
    sector& = sector& - 1

    CASE 65      'F7 = CHANGE DRIVE
    DO
      drive$ = userinput$("DISK TO READ(A,B,C etc..) ")
      disknr = ASC(LEFT$(UCASE$(drive$), 1)) - &H41
    LOOP UNTIL disknr >= 0 AND disknr < 25
    CALL initdrive
   
    CASE 66      'F8 = (REDIRECTABLE) DISPLAY DIRECTORY STRUCTURE
    'not yet.
    ''file$ = userinput$("FILE TO READ DIR STRUCTURE TO ")
    'CALL readdirstruc(file$)

    CASE 67      'F9 = STRINGSEARCH
    match$ = userinput$("STRING TO SEARCH FIRST 100 MATCHES ON DISK FROM ")
    CALL readstring(UCASE$(match$))

    CASE ELSE     'just get a new key
    gotone = 0

  END SELECT
LOOP UNTIL gotone

END SUB

'
'This sub displays all clusters a file or subdirectory occupies
'(mostly called on the last part of the lookupstring
'
SUB moreclusters (cluster1&)

DO
  PRINT RIGHT$(HEX$(cluster1&), 4); ", ";
  cluster1& = fatentrie(cluster1&)
LOOP WHILE islastcluster(cluster1&) = 0
PRINT "EOFC.<"


END SUB

'
'Calculates and prints the bootsector variables
'
SUB printboot

'First the header
VIEW PRINT
sec$ = HEX$(sector&): LOCATE 1, 15: COLOR O, 7: PRINT STRING$(8 - LEN(sec$), "0") + sec$: COLOR 7, 0:
LOCATE 1, 38: COLOR 0, 7: PRINT "BOOTSECTOR OF "; CHR$(&H41 + disknr); " PARTITION": COLOR 7, 0:
VIEW PRINT 20 TO 23: CLS 2: VIEW PRINT 3 TO 18: CLS 2: LOCATE 3, 1:

'Oke let us print the relevant details...

COLOR 7, 0: PRINT "BYTES per sector                  :"; : COLOR 0, 13: PRINT bytepsec
COLOR 7, 0: PRINT "SECTORs per cluster               :"; : COLOR 0, 2: PRINT secpclus
COLOR 7, 0: PRINT "NUMBER of FATs                    :"; : COLOR 0, 3: PRINT nrfat
COLOR 7, 0: PRINT "SECTORS per FAT                   :"; : COLOR 0, 4: PRINT fatsec
COLOR 7, 0: PRINT "Number of reserved sectors        :"; : COLOR 0, 5: PRINT ressec
COLOR 7, 0: PRINT "Number of hidden sectors          :"; : COLOR 0, 6: PRINT hiddensec
COLOR 7, 0: PRINT "TOTAL NUMBER OF SECTORS(dec)      :"; : COLOR 0, 15: PRINT total&
COLOR 7, 0: PRINT "START OF DOSDIRECTORY at sector   :"; : COLOR 0, 11: PRINT startroot&; "("; HEX$(startroot&); ")"
COLOR 7, 0: PRINT "START OF DATA(FILE/SUB directory) :"; : COLOR 0, 2: PRINT startdata&; "("; HEX$(startdata&); ")"
COLOR 7, 0: PRINT "TOTAL SPACE( BYTES) ON DISK       :"; : COLOR 0, 11: PRINT total& * bytepsec
COLOR 7, 0: PRINT "TOTAL CLUSTERS ON DISK(hex)       :"; : COLOR 0, 10: PRINT " "; HEX$(totalclus&)
COLOR 7, 0: PRINT "BYTES PER CLUSTER                 :"; : COLOR 0, 12: PRINT secpclus * bytepsec
COLOR 7, 0

END SUB

'
'Prints a sector that is not root, not FAT and not bootsector
'
SUB printdata (sector&)

DEF SEG = VARSEG(sectorbuffer(0))

'Lets see: is this one empty ?

IF PEEK(0) = 0 THEN CALL printfile(sector&): EXIT SUB

'Lets determine if this might be a a sub directory:
 
DO UNTIL isfile > 0 OR i > bytepsec \ 32 - 1
  offset = i * 32:
  FOR j = 0 TO 10    'filename +attrib possibly ?
    a = PEEK(offset + j):
    IF (a > 126 AND a <> &HE5 AND a <> &HFF) THEN isfile = 1'file for sure
  NEXT
  i = i + 1
LOOP

DEF SEG

IF isfile THEN       'probably a dir
  CALL printfile(sector&)
ELSE
  CALL printdir(sector&)
END IF



END SUB

SUB printdir (sector&)

DEF SEG = VARSEG(sectorbuffer(0))

')DIRECTORY
'-----------
'First the header:
'-------------------
VIEW PRINT
sec$ = HEX$(sector&): LOCATE 1, 15: COLOR O, 7: PRINT STRING$(8 - LEN(sec$), "0") + sec$: COLOR 7, 0:
LOCATE 1, 38: COLOR 0, 7: PRINT "DOS (SUB)DIRECTORY AREA   ": COLOR 7, 0:

'Second print footer
'------------------
VIEW PRINT 20 TO 23: CLS 2: LOCATE 20, 1:
PRINT "                                 T^^^D^^^S^^^FS^^^^^^"
COLOR 0, 5: PRINT " "; : COLOR 7, 0: PRINT "Filenm ";
COLOR 0, 2: PRINT " "; : COLOR 7, 0: PRINT "Attr ";
COLOR 0, 7: PRINT " "; : COLOR 7, 0: PRINT "Startcluster( flipped) ";
COLOR 4, 7: PRINT CHR$(&HE5); : COLOR 7, 0: PRINT "Undelete marker!";
COLOR 0, 7: PRINT "FILE/SUBDIR START AT(hex) : "; HEX$(startdata&)
COLOR 0, 14: PRINT "STARTSECTOR FILE:= (STARTCLUSTER-2)*"; secpclus; " + "; HEX$(startdata&); : COLOR 7, 0:

'Display the sectornr
'---------------------------------------
VIEW PRINT
sec$ = HEX$(sector&): LOCATE 1, 15: COLOR O, 7: PRINT STRING$(8 - LEN(sec$), "0") + sec$: COLOR 7, 0:

'---------------------------------------
'Display the sector in directory format
'---------------------------------------
VIEW PRINT 3 TO 18: CLS 2: LOCATE 3, 1:

fileentrances = bytepsec \ 32 - 1
FOR i = 0 TO fileentrances
 
  offset = i * 32                            '32 bytes per direntrance
  CALL printnameattr(offset)                 'first bytes are the same
 
  'Lets see if we have a LFN here..
  IF PEEK(offset + 11) = &HF THEN
    CALL printlong(offset)
  ELSE                                       'IF startsec=0 then
    CALL printshort(offset)                  'assume LFN( can be empty too)
  END IF
IF i < fileentrances THEN PRINT :

NEXT

DEF SEG

END SUB

SUB printfat (sector&)

DEF SEG = VARSEG(sectorbuffer(0))

'1)FAT AREA:
'-----------
'first the header:
VIEW PRINT
LOCATE 1, 38: COLOR 0, 7: PRINT "FATAREA                    ": COLOR 7, 0:
'Second the footer
VIEW PRINT 20 TO 23: CLS 2
LOCATE 20, 1: PRINT "FAT 1 until sector "; : COLOR 0, 7: PRINT fatsec; "("; HEX$(fatsec); "h)";
COLOR 7, 0: PRINT " FAT 2 until sector "; : COLOR 0, 7: PRINT startroot&; "("; HEX$(startroot&); "h)"
LOCATE 21, 1: PRINT "CODED LIKE:"; : COLOR 0, 7: PRINT "'0000'=FREE "; "'FFF8-FFFF'=END OF FAIL CHAIN "; "'FFF1--FFF7'=BAD SECTORS "; "OTHER=FILE CHAIN NEXT ENTRY ";
COLOR 7, 0:
'Third lets roll the program
'----------------------------

VIEW PRINT
sec$ = HEX$(sector&): LOCATE 1, 15: COLOR O, 7: PRINT STRING$(8 - LEN(sec$), "0") + sec$: COLOR 7, 0:
i$ = ""
'-------------------------
'Let us display the data:
'-------------------------

VIEW PRINT 3 TO 18: CLS 2: LOCATE 3, 1:
FOR i% = offset% TO offset% + &H200 - 1
    a$ = HEX$(PEEK(i%))
    PRINT STRING$(2 - LEN(a$), "0") + a$;
    IF i% MOD 2 = 1 THEN PRINT " ";
    IF i% - offset% MOD 32 = 31 THEN PRINT
NEXT

DEF SEG
END SUB

'
'Prints a sector in raw binary data format
'
SUB printfile (sector&)

DEF SEG = VARSEG(sectorbuffer(0))

'First the header
'-----------------
VIEW PRINT
LOCATE 1, 38: COLOR 0, 7: PRINT "DATAAREA                   ": COLOR 7, 0:

'Second the footer
'------------------
VIEW PRINT 20 TO 23: CLS 2

VIEW PRINT
clushelp& = (sector& \ secpclus%): clushelp& = clushelp& AND &HFFFF&
clus% = clushelp& AND &H7FFF: clus% = clus% OR -(clushelp& AND &H8000)
clus$ = HEX$(clus%)

LOCATE 20, 1: PRINT "CLUSTER NUMBER DISPLAYED: "; : COLOR 0, 7: PRINT STRING$(4 - LEN(clus$), "0") + clus$; : COLOR 7, 0
PRINT SPACE$(10); "ROOTDIR: "; : COLOR 0, 7: PRINT HEX$(startroot&); : COLOR 7, 0
PRINT " START DATA "; : COLOR 0, 7: PRINT HEX$(startdata&); : COLOR 7, 0
LOCATE 21, 1: PRINT " 32 <   ASCII  < 126      DISPLAYED IN:"; : COLOR 0, 7: PRINT " CHARACTERS+SPACE"; : COLOR 7, 0:
LOCATE 22, 1: PRINT "ASCII < 33 OR ASCII > 126 DISPLAYED AS:"; : COLOR 0, 7: PRINT " HEXADECIMAL BYTE": COLOR 7, 0:
sec$ = HEX$(sector&): LOCATE 1, 15: COLOR O, 7: PRINT STRING$(8 - LEN(sec$), "0") + sec$: COLOR 7, 0:

'Print a sector in raw binary data format
'-----------------------------------------
VIEW PRINT 3 TO 18: CLS 2: LOCATE 3, 1:
FOR i% = 0 TO &H200 - 1
  a% = PEEK(i%)
  IF a% < 32 OR a% > 126 THEN PRINT STRING$(2 - LEN(HEX$(a%)), "0") + HEX$(a%);  ELSE PRINT CHR$(a%) + " ";
  IF (i%) MOD 32 = 31 AND i% <> &H200 - 1 THEN PRINT
NEXT
DEF SEG

END SUB

'
'Prints the bytes 14 to 31 for LFN( different from SHORT)
'
SUB printlong (offset)

COLOR 0, 5:
FOR j = 14 TO 25
  PRINT CHR$(PEEK(offset + j)); " ";          'chars 5..10 lfn NAME
NEXT

COLOR 0, 7: a$ = HEX$(PEEK(offset + 26)): PRINT STRING$(2 - LEN(a$), "0") + a$;
a$ = HEX$(PEEK(offset + 27)): PRINT STRING$(2 - LEN(a$), "0") + a$; : COLOR 7, 0
 
COLOR 0, 5:
FOR j = 28 TO 31
  PRINT CHR$(PEEK(offset + j)); " ";          'chars 11,12 lfn NAME
NEXT
COLOR 7, 0


END SUB

'
'Prints the name and attribute( same for LFN and SHORT)
'
SUB printnameattr (offset)

'The first 11 bytes always point to the name

COLOR 0, 5:

a = PEEK(offset) 'recognize undelete marker
IF a = &HE5 THEN COLOR 4, 7: PRINT CHR$(a); : COLOR 0, 5:  ELSE PRINT CHR$(a);
FOR j = 1 TO 10                           'first 11 bytes
  PRINT CHR$(PEEK(offset + j));           'short or lfn id+ 0..4
NEXT

'bytes 11 always is pointing to the attribute(&hF for LFN)
COLOR 0, 2:
b$ = HEX$(PEEK(offset + 11)): PRINT STRING$(2 - LEN(b$), "0") + b$;

COLOR 7, 0
PRINT SPACE$(3);   'reserved..by DOS


END SUB

'
'Prints the bytes 14 to 31 for SHORT( different from LFN)
'
SUB printshort (offset)

FOR j = 14 TO 25
  b$ = HEX$(PEEK(offset + j)): PRINT STRING$(2 - LEN(b$), "0") + b$;
NEXT

COLOR 0, 7: a$ = HEX$(PEEK(offset + 26)): PRINT STRING$(2 - LEN(a$), "0") + a$;
a$ = HEX$(PEEK(offset + 27)): PRINT STRING$(2 - LEN(a$), "0") + a$; : COLOR 7, 0
  
FOR j = 28 TO 31
  b$ = HEX$(PEEK(offset + j)): PRINT STRING$(2 - LEN(b$), "0") + b$;
NEXT



END SUB

'
'Reads the bootsector
'
SUB readboot

'Do bootsector on beforehand..(we need that anyway)


sector& = 0
CALL readsector(sector&)

DEF SEG = VARSEG(sectorbuffer(0))

secpclus = PEEK(&HD)
nrfat = PEEK(&H10):
direntrances = PEEK(&H12) * 256& OR PEEK(&H11)
bytepsec = PEEK(&HC) * 256& OR PEEK(&HB)
fatsec = PEEK(&H16) + PEEK(&H17) * 256
ressec = PEEK(&HF) * 256& + PEEK(&HE)
help = PEEK(&H13) + PEEK(&H14) * 256
IF help THEN
  total& = help
ELSE
  total& = 256& * PEEK(&H21) + PEEK(&H20) + 65535 * (PEEK(&H22) + PEEK(&H23) * 256&)
END IF

hiddensec = PEEK(&H1C) + PEEK(&H1D) * 256
startroot& = nrfat * fatsec + ressec
startdata& = startroot& + (direntrances * 32 / bytepsec)
totalclus& = total& \ secpclus

DEF SEG
DEF SEG
CALL printboot




END SUB

'
'Read the whole directory structure of a disk
'
SUB readdirstruc (file$)

OPEN file$ FOR OUTPUT AS #2
CALL scan4dirs
CLOSE #2


END SUB

'
'What could be called the main program.
'
SUB readdisk


CALL initprogram

'Do as you like..

DO

  'Get a key for next sector

   CALL keyproces(sector&)

  'CONTROL REQUEST FOR NEW SECTOR

  IF (sector& AND &H7FFFFFFF) > total& THEN sector& = 0

  'AND READ THE NEW SECTOR
  CALL readsector(sector&)

  SELECT CASE sector&
 
  CASE 0                              'boot sector
  CALL printboot
 
  CASE IS < startroot&                  'a fat sector
  CALL printfat(sector&)

  CASE startroot& TO startdata& - 1      'a rootdirectory sector
  CALL printdir(sector&)
 
  CASE startdata& - 2 TO total&        'a data/subdir sector
  CALL printdata(sector&)

  END SELECT

LOOP    'break out on the keyprocessing(esc)


END SUB

'
'Handles the request for a file
'
SUB readpath (path$, sector&)

PCOPY 0, 3: VIEW PRINT: CLS  'get screen saved and clear screen 0


'handle disk

IF INSTR(path$, ":\") OR INSTR(path$, ".\") OR INSTR(path$, "\") = 1 THEN
  path$ = MID$(path$, INSTR(path$, "\") + 1)
END IF

'And look path up into the directory structure.
CALL scan4path(sector&, path$)


PRINT : PRINT "Press a key for return to main progam"
'En eindig met de calculatie van de sector op een ander screen denk ik
SLEEP: PCOPY 3, 0


END SUB

'
'Reads the sector& into the buffer
'
SUB readsector (sector&)

DEF SEG = asmsegment
CALL absolute(disknr, sector&, errs, 0)
DEF SEG
IF errs THEN
  VIEW PRINT 22 TO 25: CLS 2:
  PRINT "Error while reading sector : "; HEX$(sector&)
  CALL errorhandling(errs)
  PRINT " End exiting.."; : END
END IF



END SUB

'
'Handles the request for a string search
'
SUB readstring (match$)


PCOPY 0, 3: VIEW PRINT: CLS  'get screen saved and clear screen 0

'And look path up string on harddisk
CALL scan4string(match$)


PRINT : PRINT "Press a key for return to main progam"
SLEEP: PCOPY 3, 0

END SUB

'
'Recursivaly searches and prints all sub directories..
'
SUB recursdirs (cluster1&)

STATIC pass
pass = pass + 1

sector& = clus2sec&(cluster1&): endsector& = sector& + secpclus
fileentrances = bytepsec \ 32 - 1

DO UNTIL sector& >= endsector&

  CALL readsector(sector&)
  DEF SEG = VARSEG(sectorbuffer(0))
  i = 0

  DO WHILE PEEK(i * 32) <> 32 AND i <= fileentrances

    offset = i * 32
    IF entranceatt(offset) = &H10 THEN
      path$ = entrancename$(offset)
      IF path$ <> "." AND path$ <> ".." THEN
        PRINT #2, SPACE$(pass * 2) + path$
        cluster& = entrancestart&(offset)
        DO
          CALL recursdirs(cluster&)
          cluster& = fatentrie(cluster&)
        LOOP UNTIL islastcluster(cluster&)  'this dir more clusters ?
        pass = 1
        CALL readsector(sector&)
        DEF SEG = VARSEG(sectorbuffer(0))
      END IF
    END IF
    i = i + 1

  LOOP
   
  sector& = sector& + 1

LOOP
pass = 0

DEF SEG





END SUB

'
'Recursivaly searches for directories from the root..and prints them to the file
'
SUB scan4dirs

nextsector& = startroot&
fileentrances = bytepsec \ 32 - 1

DO UNTIL nextsector& >= startdata&    'root only

  CALL readsector(nextsector&)
  DEF SEG = VARSEG(sectorbuffer(0))

  i = 0
  DO WHILE PEEK(i * 32) <> 32 AND i <= fileentrances
 
    offset = i * 32
    IF entranceatt(offset) = &H10 THEN
      path$ = entrancename$(offset)
      IF path$ <> "." AND path$ <> ".." THEN
        PRINT #2, path$
        cluster1& = entrancestart&(offset)
        DO
          CALL recursdirs(cluster1&)
          cluster1& = fatentrie(cluster1&)
        LOOP UNTIL islastcluster(cluster1&)  'this dir more clusters ?
        CALL readsector(nextsector&)
        DEF SEG = VARSEG(sectorbuffer(0))
      END IF
    END IF
    i = i + 1

  LOOP

  nextsector& = nextsector& + 1

LOOP

DEF SEG


END SUB

'
'Scans the disk until the startcluster of the file/dir is found
'
SUB scan4path (sector&, path$)

PRINT "We have to look up the file's startcluster of course": PRINT

totalpath$ = CHR$(disknr + &H41) + ":\" + path$
CALL separate(part$, path$)
PRINT "The first part of the path is : "; part$

'Lookup 1st cluster of this first subdir/file into the root

cluster1& = inroot&(part$)


DO WHILE LEN(path$) > 0 AND cluster1& <> 0
  CALL separate(part$, path$)
  PRINT "Next part of the path is      : "; part$
  DO
    startcluster& = indir&(cluster1&, part$)
    cluster1& = fatentrie(cluster1&)
  LOOP UNTIL startcluster& > 0 OR islastcluster(cluster1&)' gevonden path deel
  cluster1& = startcluster&
LOOP

PRINT :
IF cluster1& THEN
  PRINT "The path "; : COLOR 0, 7: PRINT totalpath$;
  COLOR 7, 0: PRINT " occupies clusters: "
  'Reads up all other clusters of this file/sub:
  CALL moreclusters(cluster1&)
ELSE
   PRINT "The path "; : COLOR 0, 7: PRINT totalpath$;
   COLOR 7, 0: PRINT " is not found "
   EXIT SUB
END IF





END SUB

'
'Scans whole disk for a match , reporting the first 100 hits
'
SUB scan4string (match$)

PRINT "Looking up the string "; : COLOR 0, 7: PRINT match$; : COLOR 7, 0
PRINT : PRINT "Currently investigating sector "; SPACE$(8); " of a total of "; total&

DIM hits&(100)

sector& = startroot&
DO
  CALL readsector(sector&)
  IF insector(match$) THEN hits&(i) = sector&: i = i + 1
  sector& = sector& + 1
  IF sector& MOD 1000 = 0 THEN LOCATE 2, 32: PRINT sector&;
LOOP UNTIL sector& > total& OR i > 99

PRINT : PRINT "Found the following sectors that contained the string :"
FOR i = 0 TO 99: IF hits&(i) <> 0 THEN PRINT HEX$(hits&(i)); " ,";
NEXT

END SUB

DEFSTR A-Z
SUB sectorread (asmstore%())
'-------------------------------------------------------------------------
'STACKPASSING : DISKNR%,SECTOR& by reference,ERRS
'DRIVENR      : 0=A, 1=B enz
'IN           : SECTOR&
'OUT          : SECTORBUFFER IS FILLED
'               ERRS=0 OR ERROR

'The sector is read into the parameterblock and the routine executed.
'notice: You need to pass a sectorbuffer of &h100 integers( 512 bytes),
'        and a storagearray of 28 integers.

'--------------------------********---------------------------------------
'                          *DGROUP*
'                          ********
'0 :..           = assembly routine
'44:....         = parameterblock as:
'                0:DW      = sector2start
'                4:W       = nrsector2read
'                6:DW      = offset:segment van buffer
'------------------------------------------------------------------------
'------------------------------------------------------------------------
'DGROUP:0 CODE
asm = asm + CHR$(&H55)                          'PUSH BP
asm = asm + CHR$(&H89) + CHR$(&HE5)             'MOV BP,SP
asm = asm + CHR$(&H1E)                          'PUSH DS
'GET POINTERS
asm = asm + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8) 'MOV BX,[BP+08]
asm = asm + CHR$(&H8B) + CHR$(&H7E) + CHR$(&HA) 'MOV DI,[BP+0A]
'SET UP DS[BX] TO PARAMS WITH SECTOR&, AX TO DRIVENR
asm = asm + CHR$(&H66) + CHR$(&H8B) + CHR$(&HF) 'MOV ECX,[BX] SECTOR&
asm = asm + CHR$(&H8B) + CHR$(&H5)              'MOV AX,[DI] DRIVE
asm = asm + CHR$(&HBB) + MKI$(44)               'MOV BX, OFFSET(PARAMS)
asm = asm + CHR$(&HE) + CHR$(&H1F)              'PUSH CS:POP DS  DS[BX] PARAMS
asm = asm + CHR$(&H66) + CHR$(&H89) + CHR$(&HF) 'MOV DWORDPTR [BX],ECX
asm = asm + CHR$(&HB9) + CHR$(&HFF) + CHR$(&HFF)'MOV CX,-1 READ EXTENDED
asm = asm + CHR$(&HCD) + CHR$(&H25)             'INT 25
'RESTORE STACK, RETURN (NO)ERROR AND TO QBASIC
asm = asm + CHR$(&H44) + CHR$(&H44)             'INC SP: INC SP
asm = asm + CHR$(&H1F)                          'POP DS
asm = asm + CHR$(&H72) + CHR$(&H4)              'JC +4 ERROR
asm = asm + CHR$(&H5D)                          'POP BP
asm = asm + CHR$(&HCA) + MKI$(6)                'RETF 6
'ERROR RETURN..
asm = asm + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6) 'MOV BX,[BP+06]
asm = asm + CHR$(&H88) + CHR$(&H27)             'MOV [BX],AH
asm = asm + CHR$(&HEB) + CHR$(&HF5)             'JMP -11 RETURN TO QB

CLS : PRINT LEN(asm)
DEF SEG = VARSEG(asmstore%(0))
FOR i% = 0 TO LEN(asm$) - 1: POKE i%, ASC(MID$(asm$, i% + 1, 1)): NEXT

'DGROUP:44 PARAMS:!
asmstore%(22) = &H0: asmstore%(23) = 0        '0: sectornr&
asmstore%(24) = 1                             '4:1 sector to read
asmstore%(25) = VARPTR(sectorbuffer%(0))      '6: offset buffer
asmstore%(26) = VARSEG(sectorbuffer%(0))      '8: segment buffer

END SUB

DEFINT A-Z
'
'Separates a part$ from the path$
'
SUB separate (part$, path$)

hitslash = INSTR(path$, "\")
IF hitslash THEN
  part$ = LEFT$(path$, hitslash - 1): path$ = MID$(path$, hitslash + 1)
ELSE
  part$ = path$: path$ = ""
END IF


END SUB

'
'Creates a shortalias( the ~1 only) for a (possible lfn-)path
'
FUNCTION shortpath$ (path$)

hitpoint = INSTR(path$, ".")
IF hitpoint > 9 OR (hitpoint = 0 AND LEN(path$) > 8) THEN
  shortpath$ = LEFT$(path$, 6) + "~1" + MID$(path$, hitpoint + 1)
ELSEIF hitpoint THEN
  shortpath$ = LEFT$(path$, hitpoint - 1) + MID$(path$, hitpoint + 1)
ELSE
  shortpath$ = path$
END IF              'although can be ~2/~3 etc





END FUNCTION

'
'Displays the statusline
'
SUB statusline

VIEW PRINT 24 TO 25: LOCATE 24, 1: COLOR 17, 0
PRINT "<F2>SECTOR,<F3>CLUSTER,<F4>PATH,<F5>NEXT,<F6>BACK,<F7>DISK,<F9>STRING";
COLOR 7, 0: PRINT SPACE$(10); : VIEW PRINT



END SUB

DEFSTR A-Z
'
'Gets a string from the user and restore statusline
'
FUNCTION userinput$ (message$)

VIEW PRINT 24 TO 25: CLS 2:
COLOR 29, 0: PRINT message$; : INPUT ; a$
COLOR 7, 0: CALL statusline

userinput$ = a$


END FUNCTION