NextDosFile

Ever felt the need to scan the "DOS" directory tree of your host's filesystem from SBASIC to process a selection of files?

I had good cause to do that recently, as I promised to help a friend bring some kind of order into her 30k+ collection of photos that are spread across numerous media and folders. She would like her photos to be arranged all in one place on an external hard disk, in folders according to year and month. Obviously QPC2 is not going to be used to do the actual copying. My intention is to output an "MSDOS" script with the necessary instructions and leave Windows to do the grunt work. Now, I wont get into the weeds on all that here and now - maybe another time. This part will just be about scanning the various directories for the photos, or whatever. Im sure there are adequate ways of doing it in Windows, but hey, where's the fun in that!

So the demo presented here does not include any filtering or real output, just the list of files. It demonstrates a generalised version of a "DOS" directory tree scanner for the "QL".

How to use

The demo uses a couple of my toolkit commands. If you cant be bothered to load them, then edit them away in the code below. You do need the LONG function, though, or replace it with something else such as Turbo TK's LONGINTEGER or my (slow) S*BASIC version here . Once youve done that, edit the top few lines to suit your own circumstances: Set the DOS anchor drive, dos%, you wish to use to a number between 1 and 8 (the orginal setting is restored after a (successful) run.) Then set the DOS directory you wish to start from, eg root$ = "%homepath%\Pictures" (Yes, %homepath% is a valid specification! - in QPC2, at least.) Next you need to specify the max directory depth, max%, you expect to encounter. (I guess the limit for QPC2 is an unlikely 97 or so.) If you need a "printed" list of the output, set co to the channel you wish it to go to. Then you should be ready to roll! Should the program fall over and fail at any point, remember to close all channels! There could be quite a few open ones. Type CloseAll to reset everything - or just type CLOSE and be done.

Program notes

The whole thing got a bit messier once I added in the extra clauses for SMSQmulator. There are slight differences in the kind of files and folders the different emulators will accept. I havent really had cause to test the code extensively in SMSQmulator yet, so please let me know if you discover any bugs and anomalies!

I left a couple of debug lines in the code (search for Debug) as I thought they were illustrative. These could safely be removed.

Note: Remember that any files and folders in the Windows file system with names longer than 36 characters will simply not show in the SMSQ/E-side directories! The 36 character limit applies to each segment, not the whole directory string, which, in QPC2, can be up to 200 characters long IIRC.

New in this version

In practical use on both QPC2 and SMSQmulator it turned out to make sense to consistently terminate folder names with the separator, so that modification has been added to DosDn and DosUp.


10 EXT_FN 'PROMPT', 'ERRM$':                       rem Optional, for harness.
11 EXT_FN 'LONG':                                  rem Necessary, but alternatives exist
12 EXT_PROC "NFA_USE":   EXT_FN "NFA_USE$":        rem To compile on QPC2
13 EXT_PROC "DOS_DRIVE": EXT_FN "DOS_DRIVE$":      rem To compile on SMSQmulator
14 :
15 rem + ************************************************************************ +
16 rem *<                            Next (DOS) File                             >*
17 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +
18 rem *     Routines to traverse a "DOS" directory as a stream of filenames      *
19 rem *                                                                          *
20 rem * All the directory business is handled inside the routines so it          *
21 rem * appears the the user program as a continuous stream of file names.       *
22 rem * The user program need only check for the filetype, eg directory or       *
23 rem * other, and for EOF, to control the flow, and otherwise get on with       *
24 rem * the business of processing each file as it appears.                      *
25 rem * The first bit of this program is just a demo of capabilities. It         *
26 rem * expects the program to be RUN in the standard 3-window SBASIC console.   *
27 rem *                                                                          *
28 rem * This version is for QPC2 (V5+) and SMSQmulator (V2.3+) on Windows only!  *
29 rem * It will probably not work with Linux as host OS without modification.    *
30 rem *                                                                          *
31 rem * V0.03: DOS and NFA have evolved over time with different behaviours.     *
32 rem * This patch to DosDn enforces that all directory names returned end on    *
33 rem * the folder separator. This could make these routines more compatible     *
34 rem * with earlier versions of SMSQmulator.                                    *
35 rem + ------------------------------------------------------------------------ +
36 rem * V0.01, pjw, 2022 May 26, Initial, QPC2 only, version                     *
37 rem * V0.02, pjw, 2022 May 27, Added NFA, DosDirInit, channel stack only       *
38 rem * V0.03, pjw, 2022 Jul 02, Ensure all folder names end on seperator        *
39 rem + ************************************************************************ +
40 :
41 :
100 rem     User-editable variables
102 dos%  = 6:                              rem Dos drive anchor
104 root$ = 'D:\Temp':                      rem Starting position
106 max%  = 30:                             rem Max directory depth
108 slow% =  1:                             rem Slow, <> 1 => Fast
110 :
112 rem     Log file, REM out for no output
114 co = -1:                                rem co < 0 => no log output
116 co = FOP_OVER("ram1_dir_txt"): PRINT#co; root$
118 :
120 rem     Init program variables
122 ERT DosDirInit(max%, dos%, root$):      rem "Hard error" if init fails
124 :
126 rem     Start harness
128 FOR i = 0 TO 2: CLS#i
130 dc = 0: fc = 0: md% = 0:                rem Counters
132 :
134 REPeat main
136  er = NextFile(fnm$, fdt, ftp%)
138  IF er < 0 THEN
140   IF er = -10: er = 0
142   EXIT main
144  END IF
146  :
148  rem    Display
150  IF ftp% = 255 THEN
152   PRINT "> "; fnm$\, DATE$(fdt)
154   IF co >= 0: PRINT#co; "> "; d_dir$
156   dc = dc + 1
158  ELSE
160   PRINT fnm$\, DATE$(fdt)
162   IF co >= 0: PRINT#co; FILL$(" ", d_lev%); fnm$
164   fc = fc + 1
166  END IF
168  :
170  rem    User interaction
172  IF slow% = 1 THEN
174   AT#0; 0, 0: CLS#0; 3
176   slow% = PROMPT(#0; "Next, Fast, Quit ", 'Nn ', 'Ff' & CHR$(10), 'Qq' & CHR$(27))
178   SELect ON slow%
180    = 2: CLS#0: PRINT#0; 'Press any key to pause..'
182    = 3: er = -1: EXIT main
184   END SELect
186  ELSE
188   IF INKEY$(#0; 0) <> '': slow% = 1
190  END IF
192 END REPeat main
194 :
196 rem     Endgame
198 CLS#0
200 IF er THEN
202  PRINT#0; 'Error:'! ERRM$(er); '. Channels closed.'
204  IF co >= 0: PRINT#co; 'Error'! ERRM$(er)
206 ELSE
208  PRINT#0; 'Dirs:'! dc; ', Files:'! fc; ', max depth:'! md%
210  IF co >= 0 THEN
212   PRINT#co; 'Dirs: '; dc; ', Files: '; fc; ', max depth: '; md%
214  END IF
216 END IF
218 CloseAll
220 :
222 :
1000 rem + ------------------------------------------------------------------------ +
1002 rem |<                               Next File                                >|
1004 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +
1006 rem |                  Get the next file in a DOS directory                    |
1008 rem |                                                                          |
1010 rem | The GLOBal variables must have been set up first followed by a call to   |
1012 rem | DosDirInit.                                                              |
1014 rem |                                                                          |
1016 rem | The parameters are return parameters only. They are all altered unless   |
1018 rem | error return.                                                            |
1020 rem |                                                                          |
1022 rem | GLObal d_dir$, d_chn%(), d_lev%; d_dos%, d_dos$, d_qpc                   |
1024 rem | Dependency: LONG (or use Turbo_TK's LONGINTEGER, etc)                    |
1026 rem + ------------------------------------------------------------------------ +
1028 rem | V0.01, pjw, 1gg5, Original Qdos FS scanner                               |
1030 rem | V0.02, pjw, 2022 May 25, -> DOS                                          |
1032 rem | V0.03, pjw, 2022 May 27, Only channel stacked, NFA added                 |
1034 rem + ------------------------------------------------------------------------ +
1036 :
1038 DEFine FuNction NextFile(r.nm$, r.dt, r.tp%)
1040 LOCal lp, ch%, l%, rec$(64)
1042 :
1044 REPeat lp
1046  IF EOF(#d_chn%(d_lev%)) THEN
1048   CLOSE#d_chn%(d_lev%)
1050   IF d_lev% = 0: RETurn -10:                            rem End of tree
1052   :
1054   d_lev% = d_lev% - 1: DosUp:                           rem Up one level
1056   PRINT#2; ''! d_lev%! d_dir$:                         rem ###Debug line
1058   NEXT lp
1060  END IF
1062  :
1064  BGET#d_chn%(d_lev%); rec$(1 TO 64):                    rem Get file record
1066  r.tp% = CODE(rec$(6)):                                 rem Get file type
1068  l% = CODE(rec$(16)):                                   rem Get file name length
1070  IF l% = 0: NEXT lp:                                    rem File not present
1072  r.nm$ = rec$(17 TO 16 + l%):                           rem File name
1074  r.dt = LONG(rec$(53 TO 56)):                           rem Get file date
1076  :
1078  IF r.tp% = 255 THEN :                                  rem If directory:
1080   IF d_lev% >= d_max%: RETurn -18:                      rem Max depth reached
1082   :
1084   IF DosDn(r.nm$) = 0 THEN
1086    d_lev% = d_lev% + 1:                                 rem Go down one level
1088    IF d_lev% > md%: md% = d_lev%:                       rem ###Debug line
1090    PRINT#2; ''! d_lev%! d_dir$:                        rem ###Debug line
1092    ch% = FOP_DIR(d_dos$)
1094    IF ch% < 0: d_lev% = d_lev% - 1: RETurn ch%:         rem Some file problem
1096    d_chn%(d_lev%) = ch%
1098   ELSE
1100    PRINT#2; '-'! d_lev%! d_dir$:                        rem ###Debug line
1102   END IF
1104  END IF
1106  EXIT lp
1108 END REPeat lp
1110 RETurn 0
1112 END DEFine NextFile
1114 :
1116 :
1118 rem + ------------------------------------------------------------------------ +
1120 rem |<                               DosDirInit                               >|
1122 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +
1124 rem |                    Main DosDir system initialisation                     |
1126 rem |                                                                          |
1128 rem | Initialise all GLOBal variables                                          |
1130 rem |                                                                          |
1132 rem | Parameters:                                                              |
1134 rem |   mx% = max folder levels to descend                                     |
1136 rem |   ds% = DOS anchor drive number                                          |
1138 rem |   rt$ = Starting point in DOS folders (root for this scan)               |
1140 rem + ------------------------------------------------------------------------ +
1142 rem | V0.01, pjw, 2022 May 27                                                  |
1144 rem + ------------------------------------------------------------------------ +
1146 :
1148 DEFine FuNction DosDirInit(mx%, ds%, rt$)
1150 LOCal ch%
1152 rem     QPC2 and SMSQmulator only
1154 d_qpc = MACHINE
1156 SELect ON d_qpc
1158  = 20: d_qpc = 0: d_dos$ = DevGet$("NFA"):      rem Get usage name for NFA
1160  = 30: d_qpc = 1: d_dos$ = DevGet$("DOS"):      rem Get usage name for DOS
1162  = REMAINDER : RETurn -19:      rem Unsupported platform
1164 END SELect
1166 d_dos% = ds%:                   rem Anchor device
1168 d_dos$ = d_dos$ & ds% & '_':    rem "dos" name
1170 d_max% = mx%:                   rem Max estd folder depth
1172 :
1174 d_sep$  = '\':                  rem DOS filename seperator
1176 d_bas$ = rt$:                   rem Root = start of tree to descend
1178 d_dir$ = d_bas$:                rem Dynamic dir name
1180 :
1182 d_lev% = 0:                     rem Current level
1184 DIM d_chn%(d_max%):             rem Channel stack
1186 :
1188 IF d_qpc THEN
1190  d_org$ = DOS_DRIVE$(d_dos%):   rem Original Dos designation; to be restored
1192  DOS_DRIVE d_dos%, d_bas$:      rem Set current root
1194 ELSE
1196  d_org$ = nfa_use$(d_dos%):     rem Original Dos designation; to be restored
1198  nfa_use d_dos%, d_bas$:        rem Set current root
1200 END IF
1202 ch% = FOP_DIR(d_dos$)
1204 IF ch% >= 0: d_chn%(d_lev%) = ch%:       rem First init
1206 RETurn ch%
1208 END DEFine DosDirInit
1210 :
1212 :
1214 rem + ------------------------------------------------------------------------ +
1216 rem |<                                CloseAll                                >|
1218 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +
1220 rem |          In case of interruption, close all associated channels          |
1222 rem |                                                                          |
1224 rem + ------------------------------------------------------------------------ +
1226 rem | V0.02, pjw, 2022 May 25                                                  |
1228 rem + ------------------------------------------------------------------------ +
1230 :
1232 DEFine PROCedure CloseAll
1234 LOCal l%
1236 FOR l% = d_lev% TO 0 STEP -1: CLOSE#d_chn%(l%)
1238 IF co >= 0: CLOSE#co: co = -1
1240 d_lev% = 0
1242 d_dir$ = d_bas$
1244 IF d_qpc THEN
1246  DOS_DRIVE d_dos%, d_org$:              rem Restore original setting
1248 ELSE
1250  nfa_use d_dos%, d_org$:                rem Restore original setting
1252 END IF
1254 END DEFine CloseAll
1256 :
1258 :
1260 rem + ------------------------------------------------------------------------ +
1262 rem |<                                 DosDn                                  >|
1264 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +
1266 rem |           Dos directory Down: Descend into given sub directory           |
1268 rem |                                                                          |
1270 rem | GLOBal d_dos%, d_dos$, d_dir$; d_sep$                                    |
1272 rem + ------------------------------------------------------------------------ +
1274 rem | V0.02, pjw, 2022 May 27, QPC2 and NFA version, -> function               |
1276 rem | V0.03, pjw, 2022 Jul 02, ensure dirs always end in seperator             |
1278 rem + ------------------------------------------------------------------------ +
1280 :
1282 DEFine FuNction DosDn(dr$)
1284 LOCal er
1286 IF dr$ = '': RETurn -1
1288 IF d_qpc THEN
1290  rem    QPC2 variant
1292  d_dir$ = DOS_DRIVE$(d_dos%):              rem Afirm
1294  IF d_dir$(LEN(d_dir$)) = d_sep$ THEN
1296   DOS_DRIVE d_dos%, d_dir$ & dr$:          rem Test waters
1298  ELSE
1300   DOS_DRIVE d_dos%, d_dir$ & d_sep$ & dr$: rem Test waters
1302  END IF
1304  er = FTEST(d_dos$)
1306  IF er = 0 THEN
1308   d_dir$ = DOS_DRIVE$(d_dos%):             rem It seems ok!
1310  ELSE
1312   DOS_DRIVE d_dos%, d_dir$:                rem Ooops! Revert
1314   BEEP 2000, 200
1316  END IF
1318 ELSE
1320  rem    SMSQmulator variant
1322  d_dir$ = nfa_use$(d_dos%):                rem Afirm
1324  nfa_use d_dos%, d_dir$ & dr$:             rem Test waters
1326  er = FTEST(d_dos$)
1328  IF er = 0 THEN
1330   d_dir$ = nfa_use$(d_dos%):               rem It seems ok!
1332  ELSE
1334   nfa_use d_dos%, d_dir$:                  rem Ooops! Revert
1336   BEEP 2000, 200
1338  END IF
1340 END IF
1342 IF d_dir$(LEN(d_dir$)) <> d_sep$: d_dir$ = d_dir$ & d_sep$
1344 RETurn er
1346 END DEFine DosDn
1348 :
1350 rem + ------------------------------------------------------------------------ +
1352 rem |<                                 DosUp                                  >|
1354 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +
1356 rem |                Dos directory Up: Ascend to previous level                |
1358 rem |                                                                          |
1360 rem | GLOBal d_dos%, d_dir$; d_sep$                                            |
1362 rem + ------------------------------------------------------------------------ +
1364 rem | V0.02, pjw, 2022 May 27, QPC2 and NFA version                            |
1366 rem | V0.03, pjw, 2022 Jul 02, End on d_sep$                                   |
1368 rem + ------------------------------------------------------------------------ +
1370 :
1372 DEFine PROCedure DosUp
1374 LOCal i%, l%
1376 l% = LEN(d_dir$)
1378 IF l% <= 3: BEEP 2000, 200: RETurn :            rem Top level! (Shouldnt happen?)
1380 IF d_dir$(l%) = d_sep$: l% = l% - 1:            rem Skip terminal sep
1382 FOR i% = l% TO 3 STEP -1
1384  IF d_dir$(i%) = d_sep$ THEN
1386   d_dir$ = d_dir$(1 TO i%)
1388   IF d_qpc THEN
1390    DOS_DRIVE d_dos%, d_dir$
1392   ELSE
1394    nfa_use d_dos%, d_dir$
1396   END IF
1398   EXIT i%
1400  END IF
1402 END FOR i%
1404 END DEFine DosUp
1406 :
1408 :
1410 rem + ------------------------------------------------------------------------ +
1412 rem |<                                DevGet$                                 >|
1414 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +
1416 rem |                             Get device name                              |
1418 rem |                                                                          |
1420 rem | Given real device name, return Usage. Given Usage, return real device    |
1422 rem | name. If neither found, return nothing.                                  |
1424 rem |                                                                          |
1426 rem | SMSQ/E 3+                                                                |
1428 rem + ------------------------------------------------------------------------ +
1430 rem | V0.06, December 18th 2018 (check length)                                 |
1432 rem | V0.07, pjw, 2020 Dec 18, combined Real and Use                           |
1434 rem + ------------------------------------------------------------------------ +
1436 :
1438 DEFine FuNction DevGet$(dev$)
1440 LOCal gdl, l%, p
1442 p = PEEK_L(!! $48)
1444 REPeat gdl
1446 :
1448  IF PeekStrg$(p + $2A) == dev$ THEN
1450   RETurn PeekStrg$(p + $24)
1452  ELSE
1454   IF PeekStrg$(p + $24) == dev$ THEN
1456    RETurn PeekStrg$(p + $2A)
1458   END IF
1460  END IF
1462 :
1464  p = PEEK_L(p): IF p = 0: EXIT gdl
1466 END REPeat gdl
1468 RETurn '':                         rem Or  RETurn dev$
1470 END DEFine DevGet$
1472 :
1474 DEFine FuNction PeekStrg$(ad)
1476 l% = PEEK_W(ad)
1478 SELect ON l%: = 1 TO 4: RETurn PEEK$(ad + 2, l%)
1480 RETurn ''
1482 END DEFine PeekStrg$
1484 :
1486 :

  
Generated with sb2htm on 2022 Jul 02
©pjwitte 2oo1 - 2o22