QL Software
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".
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.
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.
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 :
QL Software