QL Software
I had a need for this recently, so after applying some spit and polish I decided to share it to possibly save someone else the fiddle.
I hope it is commented well enough so those who are not yet familiar with how these things are done on the QL can see it, in all its gory glory.
Note: Qdos requires variable names containg dots to be renamed. Change r.date to r_date, etc
Note: The toolkit commands LONG and INTEGER% could be replaced by these SuperBASIC routines instead.
10 rem + ************************************************************************ + 12 rem *< NextFile >* 14 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + 16 rem * A utility to extract one file at a time from a directory tree * 18 rem * * 20 rem * Uses Natural Order, top down traversal, ie unsuiatble for deletions. * 22 rem * * 24 rem * Toolkits: TK2 and DDL2 required. Also LONG and INTEGER%, or similar * 26 rem * commands needed. (These latter could also be implemented in S*BASIC, if * 28 rem * required.) * 30 rem + ------------------------------------------------------------------------ + 32 rem * © pjwitte 1gg5 - 2oi4 * 34 rem * V0.02, pjw, August 23rd 2006 * 36 rem * V0.03, pjw, July 31st 2014 * 38 rem * V0.04, pjw, 2021 Oct 04, variable name changes, commentary * 40 rem * V0.05, pjw, 2022 May 23, fixed wee bug in harness: BGET#1 ! * 42 rem + ************************************************************************ + 44 : 46 : 48 rem Test Harness 50 : 52 dev$ = 'win2_': dir$ = 'arc_': rem Fill in own location! 54 ERT NextFileInit(dev$, dir$, 1) 56 CLS: PRINT 'Directory of'! dev$; dir$ 58 : 60 REPeat main 62 er = NextFile(dev$, dir$, fleng, fdate, ftype%, fvers%) 64 IF er < 0 THEN 66 IF er = -10: er = 0 68 EXIT main 70 END IF 72 IF ftype% = 255 THEN 74 PRINT dir$ TO 38; '->' 76 ELSE 78 PRINT dir$; TO 38; ftype%! fvers%\, DATE$(fdate), fleng 80 END IF 82 BGET#1; k%: IF k% = 27: CloseAll: STOP 84 END REPeat main 86 : 88 IF er: CloseAll: ERT er 90 : 92 : 100 rem + ------------------------------------------------------------------------ + 102 rem |< NextFileInit >| 104 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + 106 rem | Open and initialise directory structure | 108 rem | | 110 rem | Parameters: | 112 rem | dv$ = device name | 114 rem | dr$ = starting directory | 116 rem | subd = traverse = 1, or not = 0 | 118 rem | | 120 rem | GLOBals: | 122 rem | nf_chan%() - Array of channel numbers | 124 rem | nf_level% - Current sub directory level | 126 rem | nf_subdir - Sub directory flag: | 128 rem | 0 => this dir only, 1 => sub dirs | 130 rem + ------------------------------------------------------------------------ + 132 rem | V0.04, pjw, 2021 Oct 04 | 134 rem + ------------------------------------------------------------------------ + 136 : 138 DEFine FuNction NextFileInit(dv$, dr$, subd) 140 LOCal ch 142 DIM nf_chan%(17): nf_level% = 0 144 ch = FOP_DIR(dv$ & dr$): IF ch < 0: RETurn ch 146 nf_chan%(nf_level%) = ch 148 nf_subdir = subd 150 RETurn 0 152 END DEFine NextFileInit 154 : 156 : 158 rem + ------------------------------------------------------------------------ + 160 rem |< NextFile >| 162 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + 164 rem | Get Next file in a directory (tree) | 166 rem | | 168 rem | Gets the next file on each call - as if it were a stream of files and | 170 rem | directories | 172 rem | | 174 rem | Parameters: | 176 rem | dv$ = device name | 178 rem | dr$ = current directory. Updated! | 180 rem | r.xxx = return parameters | 182 rem | | 184 rem | The r.xxx variables are just a selection of possible other file | 186 rem | information that can be returned, depending on requirements of | 188 rem | calling program. | 190 rem | | 192 rem | Dependencies: | 194 rem | Must be initialised with NextFileInit, which sets certain GLOBal | 196 rem | variables (see NextFileInit) and opens the first directory. | 198 rem | CloseAll can be used to close all open sub directories should the need | 200 rem | arise to abort before the whole directory tree has been exhaustively | 202 rem | traversed. | 204 rem | | 206 rem | Dependencies: tk LONG, INTEGER% | 208 rem + ------------------------------------------------------------------------ + 210 rem | V0.04, pjw, 2021 Oct 04 | 212 rem + ------------------------------------------------------------------------ + 214 : 216 DEFine FuNction NextFile(dv$, dr$, r.flen, r.date, r.type%, r.vers%) 218 LOCal loop, l%, er, rec$(64) 220 er = 0: rem Init error variable 222 REPeat loop 224 IF EOF(#nf_chan%(nf_level%)) THEN 226 CLOSE#nf_chan%(nf_level%) 228 nf_level% = nf_level% - 1: rem Up level 230 IF nf_level% < 0: er = -10: EXIT loop 232 ELSE 234 BGET#nf_chan%(nf_level%); rec$(1 TO 64): rem Get file record 236 l% = CODE(rec$(16)): IF l% = 0: NEXT loop: rem Name length 238 dr$ = rec$(17 TO l% + 16): rem Name 240 r.type% = CODE(rec$(6)): rem File type 242 IF r.type% = 255 THEN 244 IF nf_subdir THEN 246 er = FOP_DIR(dv$ & dr$ & '_'): rem Next level 248 IF er < 0: EXIT loop 250 nf_level% = nf_level% + 1: rem Down level 252 nf_chan%(nf_level%) = er 254 END IF 256 ELSE 258 r.date = LONG(rec$(53 TO 56)): rem File date 260 r.vers% = INTEGER%(rec$(57 TO 58)): rem File version 262 r.flen = LONG(rec$(1 TO 4)) - 64: rem File length 264 END IF 266 EXIT loop 268 END IF 270 END REPeat loop 272 RETurn er 274 END DEFine NextFile 276 : 278 : 280 rem + ------------------------------------------------------------------------ + 282 rem |< CloseAll >| 284 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + 286 rem | Close all open channels in the event NextFile was interrupted | 288 rem | | 290 rem + ------------------------------------------------------------------------ + 292 rem | V0.04, pjw, 2021 Oct 04 | 294 rem + ------------------------------------------------------------------------ + 296 : 298 DEFine PROCedure CloseAll 300 LOCal cl 302 REPeat cl 304 IF nf_level% < 0: EXIT cl 306 CLOSE#nf_chan%(nf_level%) 308 nf_level% = nf_level% - 1 310 END REPeat cl 312 END DEFine CloseAll 314 : 316 :
QL Software