Code:
' The basics:' 1. Only when going UP (or on initialization):' > Get all folders from current directory, seek file' 2. Seek next folder we should search' > If there's a folder, enter it (going UP) and repeat all steps.' > If there's no folder left, go to parent (going DOWN), repeat all steps.' You're done when you're no longer allowed to go DOWN.'$INCLUDE: 'QB.BI'DEFINT A-ZCONST debugLevel = 1 ' set to 0 for silent, 1 for path, 2 for path & bufferDECLARE SUB searchFile (where AS STRING, query AS STRING)DECLARE SUB getObjects (where AS STRING, query AS STRING)DECLARE SUB debugBuffer ()DECLARE FUNCTION scopeDown% ()DECLARE FUNCTION scopeUp$ ()DECLARE FUNCTION scopeAppend% (folder AS STRING)DECLARE FUNCTION INSTRREV% (source AS STRING, find AS STRING)CONST moveROOT = 0CONST moveDOWN = -1CONST moveUP = 1TYPE scopeInfo ' OFS SZE DESCRIPTION start AS INTEGER ' 000 ..2 Starting offset in pathLst (starts at 1) count AS INTEGER ' 002 ..2 Number of folders visit AS INTEGER ' 004 ..2 Index of last visited folder (0 for none)END TYPE ' 6 BYTES - Scope descriptorDIM SHARED pathLst AS STRING * 20000 ' Parent and current sub-foldersDIM SHARED pathOfs AS INTEGER ' Writing offset for pathLstDIM SHARED levlNfo(0 TO 63) AS scopeInfo ' Root plus 63 levels deepDIM SHARED levlNow AS INTEGER ' How deep we are' Search for all files named "duke3d.grp" starting from "c:/games/"' Note: the program assumes more than one file can have this name; finding a' file won't stop the program. There's not user escape implemented.searchFile "c:/games/", "duke3d.grp"'''' Display folder name buffer, DEBUG PURPOSE ONLY''SUB debugBuffer DIM length AS INTEGER, offset AS INTEGER, scopeId AS INTEGER offset = 1 DO IF (offset = levlNfo(scopeId).start) THEN COLOR 1 + (scopeId AND &HF) scopeId = scopeId + 1 END IF length = ASC(MID$(pathLst, offset, 1)) PRINT MID$(pathLst, offset + 1, length); " "; offset = offset + length + 1 LOOP WHILE (offset < pathOfs) COLOR 8: PRINT pathOfsEND SUB'''' Get all objects in current directory''SUB getObjects (where AS STRING, query AS STRING) DIM DTA AS STRING * 44, MaskZ AS STRING DIM regs AS RegTypeX, objName AS STRING '' SETUP DTA SO WE DON'T DESTROY COMMAND$ '' regs.ax = &H1A00 ' Set DTA function regs.dx = VARPTR(DTA) ' DS:DX points to our DTA regs.ds = -1 ' Use current value for DS CALL INTERRUPTX(&H21, regs, regs) ' Do the interrupt MaskZ = where + "*.*" + CHR$(0) ' Mask (search all) regs.ax = &H4E00 ' FindFirst regs.cx = 16 ' Get all object types regs.dx = SADD(MaskZ) ' DS:DX points to ASCIIZ file mask regs.ds = -1 ' Use current DS '' PARSE ALL OBJECTS '' DO CALL INTERRUPTX(&H21, regs, regs) ' Do the interrupt IF (regs.flags AND &H1) THEN EXIT DO ' No object left objName = UCASE$(MID$(DTA, 31, INSTR(31, DTA, CHR$(0)) - 31)) ' Folder, append to scope IF (ASC(MID$(DTA, &H15 + 1, 1)) AND &H10) THEN IF ((objName <> ".") AND (objName <> "..")) THEN IF scopeAppend%(objName) THEN PRINT "Buffer overflow!": END END IF ' File, compare with query ELSE IF (objName = query) THEN PRINT "Found file in " + CHR$(34) + where + CHR$(34) + " there might be more! (PRESS ANY KEY)": SLEEP END IF END IF ' FindNext regs.ax = &H4F00 LOOPEND SUB'''' Last occurence of a string''FUNCTION INSTRREV% (source AS STRING, find AS STRING) DIM ofs AS INTEGER DO INSTRREV% = ofs ofs = INSTR(ofs + 1, source, find) LOOP WHILE ofsEND FUNCTION'''' Append subfolder to scope. One byte is reserved to provide the length in'' bytes of the folder name. This takes less memory than assuming that all'' folders have 12-byte long names. This function returns -1 if the memory'' buffer is saturated. Returns 0 if the sub-folder was successfully added.''FUNCTION scopeAppend% (folder AS STRING) DIM tmp AS STRING IF (levlNfo(levlNow).start = 0) THEN levlNfo(levlNow).start = pathOfs levlNfo(levlNow).count = levlNfo(levlNow).count + 1 tmp = LTRIM$(RTRIM$(UCASE$(folder))) tmp = CHR$(LEN(tmp)) + tmp IF ((pathOfs + LEN(tmp)) >= LEN(pathLst)) THEN scopeAppend% = -1 ELSE MID$(pathLst, pathOfs, LEN(tmp)) = tmp pathOfs = pathOfs + LEN(tmp) scopeAppend% = 0 END IFEND FUNCTION'''' Free current scope and go back to parent. Freeing means that we no longer'' need the sub-folder list for this scope so we can rewrite it. We also clear'' the descriptor so it can be re-used. This function returns -1 if root as'' been reached (there's no parent directory.)''FUNCTION scopeDown% IF levlNfo(levlNow).start THEN pathOfs = levlNfo(levlNow).start levlNfo(levlNow).start = 0 levlNfo(levlNow).count = 0 levlNfo(levlNow).visit = 0 scopeDown% = (levlNow = 0)END FUNCTION'''' Search for the next sub-folder in this scope we should be browsing. The'' "folder" argument returns the name of the next folder to enter (variable is'' never read, only written.) If there is no more folder to visit, "folder" is'' empty (you have to scopeDown.)''FUNCTION scopeUp$ DIM offset AS INTEGER, length AS INTEGER levlNfo(levlNow).visit = levlNfo(levlNow).visit + 1 IF (levlNfo(levlNow).visit > levlNfo(levlNow).count) THEN scopeUp$ = "" ' nothing left to see here ELSE ' get next folder in line to browse offset = levlNfo(levlNow).start FOR i% = 1 TO levlNfo(levlNow).visit length = ASC(MID$(pathLst, offset, 1)) offset = offset + length + 1 NEXT i% scopeUp$ = MID$(pathLst, offset - length, length) END IFEND FUNCTION'''' Where is the base directory (where we start looking for the file,) it must'' be an absolute path and be terminated with a forward slash ("/".) Query is'' the file name we're looking for.''SUB searchFile (where AS STRING, query AS STRING) DIM pathNxt AS STRING, pathAll AS STRING DIM move AS INTEGER pathOfs = 1 ' Always set to 1 before starting move = moveROOT ' Pretend we're moving up (for folder list) levlNow = 0 ' We start at level 0 pathAll = where query = LTRIM$(RTRIM$(UCASE$(query))) DO IF (move <> moveDOWN) THEN if (debugLevel = 1) then PRINT CHR$(34) + pathAll + CHR$(34) ' Append directories, search for file IF (move) THEN levlNow = levlNow + 1 CALL getObjects(pathAll, query) END IF if (debugLevel = 2) then CLS : PRINT CHR$(34) + pathAll + CHR$(34); TAB(75); levlNow: debugBuffer end if ' Enter next sub-directory pathNxt = scopeUp$ IF LEN(pathNxt) THEN pathAll = pathAll + pathNxt + "/" move = moveUP ELSE IF (scopeDown%) THEN EXIT DO levlNow = levlNow - 1 pathAll = LEFT$(pathAll, INSTRREV%(LEFT$(pathAll, LEN(pathAll) - 1), "/")) move = moveDOWN END IF LOOPEND SUB
Statistics: Posted by MikeHawk — Wed Aug 18, 2021 9:28 pm
Statistics: Posted by Erik — Mon Aug 02, 2021 11:51 pm
Code:
Assume our X filesystem has this directory tree:In X:Folder: QBFolder: WINIn X:\QBFolder: ASICFolder: 45In X:\WINFolder: SYSAnd no folders in either ASIC, 45, or SYS.Pseudo code: 1. Build empty array of x bytes to hold all folders.2. Set 2 variables: s = number of folders found, p = our progress in folders2. Set 1st index (s=1) of that array to root drive. example: "X:" (# folders found=1)3. Load 1st index (p=1) and get directory list (= DIR X: in DOS)4. Array now contains:Index 1 = X:index 2 = X:\QBIndex 3 = X:\WIN5. s = 3 (as there's 3 entries in the folder array). increment p and get next list (= DIR X:\QB)6. Array now contains:Index 1 = X:index 2 = X:\QBIndex 3 = X:\WINindex 4 = X:\QB\ASICindex 5 = X:\QB\457. s = 5 (as there's 5 entries in the folder array). increment p and get next list (= DIR X:\WIN)8. Array now contains:Index 1 = X:index 2 = X:\QBIndex 3 = X:\WINindex 4 = X:\QB\ASICindex 5 = X:\QB\45index 6 = X:\WIN\SYS9. s = 6 (as there's 6 entries in the folder array). increment p and get next list (= DIR X:\QB\ASIC)....Now this time the list won't grow because the remaining folders don't have folders inside of them. p will keep incrementing until it reaches 6 them the program ends.
Code:
folder$() variable represents all folders collected so far.myfol$ = RTRIM$(myfol$)x.func = 0: x.filespec = myfol$ + "\*.*" + CHR$(0): x.mask = &H1F: xx& = 0DOCALL runcode: obj$ = LEFT$(x.fname, x.flen)IF x.fattr = 16 THENIF obj$ <> "." AND obj$ <> ".." THENfolct& = folct& + 1: folders$(folct&) = myfol$ + "\" + obj$END IFELSEmat$ = LEFT$(x.fname, x.flen)IF RTRIM$(UCASE$(mat$)) = RTRIM$(UCASE$(matf$)) THEN findinfol% = 1: EXIT DOEND IFxx& = xx& + 1LOOP UNTIL x.errc > 0 OR xx& > 32766
Statistics: Posted by mikefromca — Sat Jul 10, 2021 9:44 pm