home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MOS / FILEMANA.I < prev    next >
Encoding:
Text File  |  1991-04-09  |  33.9 KB  |  3 lines
  1. ⓪ IMPLEMENTATION MODULE FileManagement;
  2. ⓪ (*$R-,Y+*)
  3. ⓪ (*$H+*)
  4. ⓪ 
  5. ⓪ (*FROM InOut IMPORT WriteString, WriteLn, Read, WriteCard, WriteInt;*)
  6. ⓪ 
  7. ⓪ 
  8. ⓪ (*  --------------------------------------------------------------------------
  9. ⓪!*  System-Version: MOS 1.1
  10. ⓪!*  --------------------------------------------------------------------------
  11. ⓪!*  Version       : 1.01
  12. ⓪!*  --------------------------------------------------------------------------
  13. ⓪!*  Text-Version  : V#0262
  14. ⓪!*  --------------------------------------------------------------------------
  15. ⓪!*  Modul-Holder  : Manuel Chakravarty
  16. ⓪!*  --------------------------------------------------------------------------
  17. ⓪!*  Copyright August 1988 by Manuel Chakravarty
  18. ⓪!*  Vertriebsrechte für ATARI ST unter MEGAMAX Modula-2
  19. ⓪!*                  liegen bei Application Systems Heidelberg
  20. ⓪!*  --------------------------------------------------------------------------
  21. ⓪!*  MCH : Manuel Chakravarty
  22. ⓪!*  DS  : Dirk Steins 
  23. ⓪!*  --------------------------------------------------------------------------
  24. ⓪!*  Datum    Autor  Version  Bemerkung (Arbeitsbericht)
  25. ⓪!*
  26. ⓪!*  07.08.88 MCH    V0.01    Erste Definitionen
  27. ⓪!*  08.08.88 MCH    V0.01    'fileList' + 'insertFileInList'
  28. ⓪!*  09.08.88 MCH    V0.01    Austesten der 'fileList'-Verwaltung + 'DeleteFiles'
  29. ⓪!*  09.08.88 MCH    V0.02    Nochmal
  30. ⓪!*  10.08.88 MCH    V0.02    'FormatDisk' (norm. SS und DS) + 'DeleteFiles'
  31. ⓪!*  11.08.88 MCH    V0.02    'CopyFiles' läuft (Tra-Ra!)
  32. ⓪!*  24.08.88 MCH    V0.03    'CountFilesAndDirs' extern
  33. ⓪!*  25.08.88 MCH    V0.03    Geänderte Status-Verwaltung
  34. ⓪!*  27.08.88 MCH    V0.03    'minExternalSpace' eingeführt.
  35. ⓪!*  28.08.88 MCH    V0.04    'FileInformation' Def. + Imp.
  36. ⓪!*  11.08.88 MCH    V0.04    Datum/Uhrzeit bleibt beim Kopieren erhalten
  37. ⓪!*  03.09.89 MCH    V0.04    Fehlerbehandlung verbessert
  38. ⓪!*  11.09.89 TT     V0.05    readIntoBuffer: Fehlerabfrage entfernt
  39. ⓪!*  30.6.90  DS     V0.06    DestPath von Files wird bei geändertem Ordnername
  40. ⓪!*                           jetzt korrekt geändert. Änderungen sind gekenn-
  41. ⓪!*                           zeichnet mit %%.
  42. ⓪!*  24.10.90 TT     V0.07    Doku im Def-Text korrigiert; FormatDrive mit
  43. ⓪!*                           mit Directory.Drive-Werten definiert (Def-Text);
  44. ⓪!*                           $H+ eingebaut
  45. ⓪!*  10.11.90 TT     V0.07    $R-
  46. ⓪!*  11.03.91 TT     V1.01    FileInformation berücksichtigt Ordner und kann
  47. ⓪!*                           auch Zeit/Datum neu setzen.
  48. ⓪!*  09.04.91 TT     V1.02    FormatDisk wertet 'drive' nun richtig aus (bisher
  49. ⓪!*                           wurde bei 'drvA' LW B: formatiert.
  50. ⓪!*  --------------------------------------------------------------------------
  51. ⓪!*  Modul-Beschreibung:
  52. ⓪!*
  53. ⓪!*  Dieses Modul stellt Routinen für die Dateiverwaltung zur Verfügung.
  54. ⓪!*  --------------------------------------------------------------------------
  55. ⓪!*)
  56. ⓪ 
  57. ⓪ (*  -- Wie sieht es mit Datum und Zeit bei Ordnern aus??????
  58. ⓪!*  -- Wird beim Namenskonflikt von Ordnern ein neuer Name angegeben, so muß
  59. ⓪!*     der DestPath der Ordnerelemente entsprechend geändert werden.
  60. ⓪!*     Behoben Dirk Steins
  61. ⓪!*  -- Tritt bei 'flushBufferElem' während des Schreibens ein Fehler auf, so
  62. ⓪!*     ist nicht gewährleistet, daß das File anständig geschlossen wird.
  63. ⓪!*  -- Evtl. 'queryFileList' exportieren (z.B für Modul-Loading in der Shell).
  64. ⓪!*)
  65. ⓪ 
  66. ⓪ 
  67. ⓪ FROM SYSTEM IMPORT ADDRESS, TSIZE,
  68. ⓪3ASSEMBLER, ADR;
  69. ⓪ 
  70. ⓪ FROM Storage IMPORT ALLOCATE, DEALLOCATE, MemAvail;
  71. ⓪ 
  72. ⓪ FROM Strings IMPORT Length, Concat, Append, Empty, Insert, Copy, StrEqual,
  73. ⓪4Assign;
  74. ⓪ 
  75. ⓪ IMPORT Strings, FastStrings, FuncStrings;
  76. ⓪ 
  77. ⓪ FROM MOSGlobals IMPORT OutOfMemory, GeneralErr, fOK, fFileNotFound,
  78. ⓪7fPathNotFound, fAccessDenied, fFileExists,
  79. ⓪7fDiskFull, fIllegalCall, DriveStr, PathStr,
  80. ⓪7FileStr;
  81. ⓪ 
  82. ⓪ FROM Clock IMPORT Time, Date;
  83. ⓪ 
  84. ⓪ FROM Directory IMPORT FileAttr, FileAttrSet, DirEntry,
  85. ⓪6SetFileAttr, Delete, Rename, GetDirEntry,
  86. ⓪6DirQuery, CreateDir, DeleteDir;
  87. ⓪ 
  88. ⓪ FROM FileNames IMPORT SplitPath;
  89. ⓪ 
  90. ⓪ FROM Files IMPORT File, Access, ReplaceMode,
  91. ⓪2Create, Open, Close, SetDateTime, GetDateTime, State,
  92. ⓪2GetStateMsg, ResetState, Remove;
  93. ⓪ 
  94. ⓪ FROM Binary IMPORT SeekMode,
  95. ⓪3ReadBytes, WriteBytes, FileSize, Seek, FilePos;
  96. ⓪ 
  97. ⓪ FROM Lists IMPORT List, CreateList, DeleteList, RemoveEntry, AppendEntry,
  98. ⓪2ResetList, NextEntry, PrevEntry, CurrentEntry, NoOfEntries;
  99. ⓪ 
  100. ⓪ FROM SysUtil0 IMPORT VarEqual;
  101. ⓪ 
  102. ⓪ 
  103. ⓪ CONST   (*  MOS const.s  *)
  104. ⓪ 
  105. ⓪(noErrorTrap     = 6;
  106. ⓪ 
  107. ⓪((*  system call opcodes  *)
  108. ⓪ 
  109. ⓪(flopwr          = 9;
  110. ⓪(flopfmt         = 10;
  111. ⓪(protobt         = 18;
  112. ⓪(
  113. ⓪(xbios           = 14;
  114. ⓪(
  115. ⓪((*  misc  *)
  116. ⓪(
  117. ⓪(filesAndSubdirs = FileAttrSet {subdirAttr};
  118. ⓪(
  119. ⓪(
  120. ⓪(minCopySpace    = 10L * 1024L;  (*  10k minimal  *)
  121. ⓪(minExternalSpace= 30L * 1024L;  (*  30k minimal for other prog.s  *)
  122. ⓪((* erweitert auf 30k für Pfadlisten *)
  123. ⓪ 
  124. ⓪ TYPE    ptrMaxStr       = POINTER TO ARRAY[0..32767] OF CHAR;
  125. ⓪(str128          = ARRAY[0..127] OF CHAR;
  126. ⓪(fileName        = ARRAY[0..11] OF CHAR;
  127. ⓪(ptrCardinal     = POINTER TO CARDINAL;
  128. ⓪(
  129. ⓪(
  130. ⓪ TYPE    statusRecord    = RECORD
  131. ⓪<fileErrAlert: FileErrorAlertProc;
  132. ⓪<
  133. ⓪<showStatus  : FileOpStatusProc;
  134. ⓪<noFiles     : CARDINAL;
  135. ⓪:END;
  136. ⓪(ptrStatusRecord = POINTER TO statusRecord;
  137. ⓪(
  138. ⓪((*  types for the copy buffer  *)
  139. ⓪(
  140. ⓪(copyBufferElem  = POINTER TO RECORD
  141. ⓪<next    : copyBufferElem;   (*  NIL <=> not used  *)
  142. ⓪<newPath : str128;
  143. ⓪<isSubdir: BOOLEAN;
  144. ⓪<date    : Date;             (*  of creation  *)
  145. ⓪<time    : Time;             (*  of creation  *)
  146. ⓪<seekPos : LONGCARD;         (*  append if > 0L  *)
  147. ⓪<start   : ADDRESS;          (*  start of data  *)
  148. ⓪<length  : LONGCARD;         (*  length of data  *)
  149. ⓪:END;
  150. ⓪(
  151. ⓪(copyBuffer      = POINTER TO RECORD
  152. ⓪<bottom,                     (*  first buffer elem *)
  153. ⓪<next      : copyBufferElem; (*  next elem. to use *)
  154. ⓪<length    : LONGCARD;       (*  buffer length  *)
  155. ⓪<
  156. ⓪<status    : statusRecord;
  157. ⓪<
  158. ⓪<feAlert   : FileExistsAlertProc;
  159. ⓪<oldPathLen: CARDINAL;
  160. ⓪<newPath   : str128;
  161. ⓪<
  162. ⓪<success   : BOOLEAN;        (*  FALSE ~ Error  *)
  163. ⓪:END;
  164. ⓪'
  165. ⓪ 
  166. ⓪ VAR     voidO : BOOLEAN;
  167. ⓪(voidI : INTEGER;
  168. ⓪(voidFN: fileName;
  169. ⓪(void128: str128;
  170. ⓪(
  171. ⓪ 
  172. ⓪ CONST   DebugInfo = FALSE;
  173. ⓪ 
  174. ⓪ (*$? DebugInfo:
  175. ⓪ 
  176. ⓪ PROCEDURE wLn (REF str: ARRAY OF CHAR);
  177. ⓪ 
  178. ⓪"BEGIN
  179. ⓪$WriteString (str); WriteLn;
  180. ⓪"END wLn;
  181. ⓪ 
  182. ⓪ PROCEDURE w (REF str: ARRAY OF CHAR);
  183. ⓪ 
  184. ⓪"BEGIN
  185. ⓪$WriteString (str);
  186. ⓪"END w;
  187. ⓪ 
  188. ⓪ PROCEDURE wc (c: LONGCARD);
  189. ⓪ 
  190. ⓪"BEGIN
  191. ⓪$WriteCard (c, 6);
  192. ⓪"END wc;
  193. ⓪ 
  194. ⓪ PROCEDURE wi (c: INTEGER);
  195. ⓪ 
  196. ⓪"BEGIN
  197. ⓪$WriteInt (c, 6);
  198. ⓪"END wi;
  199. ⓪ 
  200. ⓪ PROCEDURE wsiLn (REF str: ARRAY OF CHAR; i: INTEGER);
  201. ⓪ 
  202. ⓪"BEGIN
  203. ⓪$w (str); wi (i); WriteLn;
  204. ⓪"END wsiLn;
  205. ⓪ 
  206. ⓪ PROCEDURE wcsLn (l: LONGCARD; REF str: ARRAY OF CHAR);
  207. ⓪ 
  208. ⓪"BEGIN
  209. ⓪$wc (l); wLn (str);
  210. ⓪"END wcsLn;
  211. ⓪"
  212. ⓪ PROCEDURE wscLn (REF str: ARRAY OF CHAR; l: LONGCARD);
  213. ⓪ 
  214. ⓪"BEGIN
  215. ⓪$w (str); wc (l); WriteLn;
  216. ⓪"END wscLn;
  217. ⓪"
  218. ⓪ PROCEDURE Wait;
  219. ⓪ 
  220. ⓪"VAR ch: CHAR;
  221. ⓪"
  222. ⓪"BEGIN
  223. ⓪$Read (ch);
  224. ⓪"END Wait;
  225. ⓪!*)
  226. ⓪"
  227. ⓪8(*  misc. proc.s  *)
  228. ⓪8(*  ============  *)
  229. ⓪ 
  230. ⓪ PROCEDURE reportOutOfMemory;
  231. ⓪ 
  232. ⓪"(*$L-*)
  233. ⓪"BEGIN
  234. ⓪$ASSEMBLER
  235. ⓪(TRAP    #noErrorTrap
  236. ⓪(DC.W    OutOfMemory - $4000
  237. ⓪$END;
  238. ⓪"END reportOutOfMemory;
  239. ⓪"(*$L=*)
  240. ⓪"
  241. ⓪ PROCEDURE reportPathFault;
  242. ⓪ 
  243. ⓪"(*$L-*)
  244. ⓪"BEGIN
  245. ⓪$ASSEMBLER
  246. ⓪(TRAP    #noErrorTrap
  247. ⓪(DC.W    GeneralErr - $C000
  248. ⓪(ACZ     'FileManagement: Illegal path!'
  249. ⓪(SYNC
  250. ⓪$END;
  251. ⓪"END reportPathFault;
  252. ⓪"(*$L=*)
  253. ⓪"
  254. ⓪ 
  255. ⓪ PROCEDURE isSubdir (attrs: FileAttrSet): BOOLEAN;
  256. ⓪ 
  257. ⓪"BEGIN
  258. ⓪$RETURN subdirAttr IN attrs
  259. ⓪"END isSubdir;
  260. ⓪ 
  261. ⓪ 
  262. ⓪ PROCEDURE GetFileAttr (REF name  : ARRAY OF CHAR;
  263. ⓪7VAR attr  : FileAttrSet;
  264. ⓪7VAR result: INTEGER);
  265. ⓪"
  266. ⓪"VAR   entry: DirEntry;
  267. ⓪"
  268. ⓪"BEGIN
  269. ⓪$GetDirEntry (name, entry, result);
  270. ⓪&(* -> Directory.GetFileAttr geht nicht bei Subdirs. *)
  271. ⓪$attr := entry.attr;
  272. ⓪"END GetFileAttr;
  273. ⓪ 
  274. ⓪ PROCEDURE doShowStatus (    statusRecPtr: ptrStatusRecord;
  275. ⓪<ioRes       : INTEGER;
  276. ⓪8VAR stop        : BOOLEAN);
  277. ⓪ 
  278. ⓪"VAR   report,
  279. ⓪(continue: BOOLEAN;
  280. ⓪(
  281. ⓪"BEGIN
  282. ⓪$WITH statusRecPtr^ DO
  283. ⓪$
  284. ⓪&report := (ioRes = fFileNotFound) OR (ioRes = fPathNotFound)
  285. ⓪0OR (ioRes = fAccessDenied) OR (ioRes = fDiskFull);
  286. ⓪&continue := (ioRes = fOK) OR (ioRes = fFileNotFound)
  287. ⓪2OR (ioRes = fPathNotFound) OR (ioRes = fAccessDenied)
  288. ⓪2OR (ioRes = fFileExists);
  289. ⓪$
  290. ⓪&IF report THEN fileErrAlert (ioRes) END;
  291. ⓪&stop := ~ continue;
  292. ⓪$
  293. ⓪&IF ~ stop THEN
  294. ⓪(IF noFiles > 0 THEN DEC (noFiles) END;
  295. ⓪(showStatus (noFiles, stop);
  296. ⓪&END;
  297. ⓪&
  298. ⓪$END;
  299. ⓪"END doShowStatus;
  300. ⓪ 
  301. ⓪ 
  302. ⓪0(*  operations on the 'copyBuffer'  *)
  303. ⓪0(*  ==============================  *)
  304. ⓪0
  305. ⓪ 
  306. ⓪ (*  createCopyBuffer -- Alloc.s as much memory as possible and creates
  307. ⓪!*                      a 'copyBuffer' with it.
  308. ⓪!*                      'useAllMem = FALSE' means to use 2/5 of the largest
  309. ⓪!*                      avaible mem. block, else the whole block is used.
  310. ⓪!*                      'success = FALSE' means, not enough memory.
  311. ⓪!*)
  312. ⓪!
  313. ⓪ PROCEDURE createCopyBuffer (VAR cb       : copyBuffer;
  314. ⓪@useAllMem: BOOLEAN;
  315. ⓪<VAR success  : BOOLEAN);
  316. ⓪ 
  317. ⓪"PROCEDURE memAvail (): LONGCARD;
  318. ⓪"
  319. ⓪$VAR res: LONGCARD;
  320. ⓪"
  321. ⓪$BEGIN
  322. ⓪&IF useAllMem THEN
  323. ⓪(res := MemAvail ();
  324. ⓪(IF res < minExternalSpace THEN res := 0
  325. ⓪(ELSE res := res - minExternalSpace END;
  326. ⓪&ELSE
  327. ⓪(res := MemAvail () * 2L DIV 5L;
  328. ⓪(IF res < minExternalSpace THEN res := 0 END;
  329. ⓪&END;
  330. ⓪&
  331. ⓪&res := res - res MOD 2L;          (*  make even  *)
  332. ⓪&
  333. ⓪&RETURN res
  334. ⓪$END memAvail;
  335. ⓪$
  336. ⓪ 
  337. ⓪"BEGIN
  338. ⓪$success := (memAvail () >= minCopySpace );
  339. ⓪$IF ~ success THEN RETURN END;
  340. ⓪$
  341. ⓪$NEW (cb);
  342. ⓪$WITH cb^ DO
  343. ⓪&length := memAvail ();       (*  take as much as possible  *)
  344. ⓪&ALLOCATE (bottom, length);
  345. ⓪&next := bottom;              (*  next elem. to use is the first elem.  *)
  346. ⓪&bottom^.next := NIL;         (*  first elem. is not yet in use  *)
  347. ⓪$END;
  348. ⓪"END createCopyBuffer;
  349. ⓪ 
  350. ⓪ PROCEDURE deleteCopyBuffer (cb: copyBuffer);
  351. ⓪ 
  352. ⓪"BEGIN
  353. ⓪$DEALLOCATE (cb^.bottom, 0L);
  354. ⓪$DISPOSE (cb);
  355. ⓪"END deleteCopyBuffer;
  356. ⓪"
  357. ⓪ 
  358. ⓪ (*  bufAvail -- Determines the maximum amount of bytes, that are avaible
  359. ⓪!*              in the 'cb'.
  360. ⓪!*)
  361. ⓪ 
  362. ⓪ PROCEDURE bufAvail (cb: copyBuffer): LONGCARD;
  363. ⓪ 
  364. ⓪"BEGIN
  365. ⓪$RETURN cb^.length - (LONGCARD (cb^.next) - LONGCARD (cb^.bottom))
  366. ⓪+- SIZE (cb^.next^)
  367. ⓪"END bufAvail;
  368. ⓪"
  369. ⓪ (*  flushCopyBuffer -- Writes the data in 'cb' to the destination.
  370. ⓪!*)
  371. ⓪ 
  372. ⓪((* %% added 27.6.90 DS             *)
  373. ⓪((* pc: short for PathChange     *)
  374. ⓪ (*   The 'pcList' is the pathChangedList. In this list all path's
  375. ⓪!*   which were changed during flushBuffer will be stored. 
  376. ⓪!*   This Types and vars are global because the 'pcList' is initialised in
  377. ⓪!*   the procedure 'copyFiles'. And it has to be global because otherwise
  378. ⓪!*   some entries would be forgotten.
  379. ⓪!*)
  380. ⓪!
  381. ⓪"TYPE    pcEntry         = RECORD
  382. ⓪>oldPath,
  383. ⓪>newPath     : str128;
  384. ⓪<END;
  385. ⓪*pcPtr           = POINTER TO pcEntry;
  386. ⓪*
  387. ⓪"VAR     pcList  : List;
  388. ⓪ 
  389. ⓪ PROCEDURE flushCopyBuffer (cb: copyBuffer);
  390. ⓪ 
  391. ⓪"VAR   elem : copyBufferElem;
  392. ⓪(ioRes: INTEGER;
  393. ⓪(f    : File;
  394. ⓪(mode : ReplaceMode;
  395. ⓪(path : str128;
  396. ⓪(fn,
  397. ⓪(orgFn,                  (* %% added 30.6.90 DS: is needed for the
  398. ⓪A* pcList and the original pathname in it.
  399. ⓪A*)
  400. ⓪(oldFn: fileName;
  401. ⓪(stop : BOOLEAN;
  402. ⓪(
  403. ⓪"PROCEDURE stateErr (): BOOLEAN;
  404. ⓪$
  405. ⓪$BEGIN
  406. ⓪&ioRes := State (f);
  407. ⓪&IF ioRes # fOK THEN ResetState (f) END;
  408. ⓪&RETURN ioRes # fOK
  409. ⓪$END stateErr;
  410. ⓪$
  411. ⓪((* %% added 27.6.90 DS *)
  412. ⓪"PROCEDURE insertChangeEntry (VAR path : ARRAY OF CHAR;
  413. ⓪?VAR old, new : ARRAY OF CHAR;
  414. ⓪?start : CARDINAL) : BOOLEAN;
  415. ⓪$(* inserts the newPath corresponding to oldPath in the 
  416. ⓪%* pathList. If no oldPath is found a new entry is created.
  417. ⓪%* Creating a new entry is the normal case due to changes in
  418. ⓪%* development.
  419. ⓪%*)
  420. ⓪$VAR sPath : str128;
  421. ⓪(pc    : pcPtr;
  422. ⓪"BEGIN
  423. ⓪$FastStrings.Concat (path, old, sPath);
  424. ⓪$ResetList (pcList);
  425. ⓪$REPEAT 
  426. ⓪&pc := NextEntry (pcList);
  427. ⓪$UNTIL (pc = NIL) OR StrEqual (sPath, pc^.oldPath);
  428. ⓪$IF pc # NIL
  429. ⓪$THEN
  430. ⓪&FastStrings.Concat (path, new, sPath);
  431. ⓪&FastStrings.Assign (sPath, pc^.newPath);
  432. ⓪$ELSE
  433. ⓪&ALLOCATE (pc, TSIZE (pcEntry));
  434. ⓪&IF pc = NIL THEN reportOutOfMemory; RETURN FALSE END;
  435. ⓪&FastStrings.Concat (path, old, pc^.oldPath);
  436. ⓪&FastStrings.Concat (path, new, pc^.newPath);
  437. ⓪&AppendEntry (pcList, pc, voidO);
  438. ⓪&IF voidO THEN reportOutOfMemory; RETURN FALSE END;
  439. ⓪$END;
  440. ⓪$RETURN TRUE
  441. ⓪"END insertChangeEntry;
  442. ⓪"
  443. ⓪"(* %% added 27.6.90 DS *)
  444. ⓪"PROCEDURE TestAndChange (VAR path : ARRAY OF CHAR;
  445. ⓪;last : CARDINAL);
  446. ⓪"(* If path is in the pcList, path will be replaced by the newPath.
  447. ⓪#* this proc call's itself recursively to change previous changed 
  448. ⓪#* parts of a path correct.
  449. ⓪#* 'last' is a control-parameter to pretend infinite loops. (i don't 
  450. ⓪#* know if it's necessary).
  451. ⓪#*)
  452. ⓪%VAR p : INTEGER;
  453. ⓪)l : CARDINAL;
  454. ⓪)pc: pcPtr;
  455. ⓪)tPath : str128;
  456. ⓪)tName : fileName;
  457. ⓪"BEGIN
  458. ⓪$l := Length (path);
  459. ⓪$IF (l > 2) AND ~(l = last)
  460. ⓪$THEN
  461. ⓪&SplitPath (path, tPath, tName);
  462. ⓪&tPath[Length(tPath)-1] := 0c;     (* '\' löschen *)
  463. ⓪&TestAndChange (tPath, l);
  464. ⓪&Append ('\',tPath, voidO);        (* '\' wieder anfügen *)
  465. ⓪&FastStrings.Concat (tPath, tName, path);
  466. ⓪&ResetList (pcList);
  467. ⓪&REPEAT
  468. ⓪(pc := NextEntry (pcList);
  469. ⓪&UNTIL (pc = NIL) OR StrEqual (path, pc^.oldPath);
  470. ⓪&IF pc # NIL
  471. ⓪&THEN
  472. ⓪(FastStrings.Assign (pc^.newPath, path);
  473. ⓪&END;
  474. ⓪$END;
  475. ⓪"END TestAndChange;
  476. ⓪"
  477. ⓪"PROCEDURE flushOneElem;
  478. ⓪"
  479. ⓪$VAR pathChanged : BOOLEAN;
  480. ⓪"
  481. ⓪$BEGIN
  482. ⓪&WITH elem^ DO IF isSubdir THEN
  483. ⓪&
  484. ⓪((* %% added by DS 27.6.90: *)
  485. ⓪(SplitPath (newPath, path, orgFn);
  486. ⓪(TestAndChange (path, 0);
  487. ⓪(FastStrings.Concat (path, orgFn, newPath);
  488. ⓪*
  489. ⓪(pathChanged := FALSE;
  490. ⓪(
  491. ⓪(LOOP
  492. ⓪*CreateDir (newPath, ioRes);
  493. ⓪*IF ioRes = fAccessDenied THEN               (*  folder exists  *)
  494. ⓪*
  495. ⓪,SplitPath (newPath, path, oldFn);
  496. ⓪,fn := oldFn;
  497. ⓪,IF ~ cb^.feAlert (fn) THEN ioRes := fFileExists; EXIT END;
  498. ⓪,
  499. ⓪,(* %% added by DS 27.6.90: *)
  500. ⓪,IF ~StrEqual (oldFn, fn)
  501. ⓪,THEN 
  502. ⓪.pathChanged := TRUE
  503. ⓪,ELSE
  504. ⓪.ioRes := fFileExists;
  505. ⓪.EXIT
  506. ⓪,END;
  507. ⓪,
  508. ⓪,FastStrings.Concat (path, fn, newPath);
  509. ⓪,
  510. ⓪*ELSE EXIT END;                              (*  success  *)
  511. ⓪(END;
  512. ⓪(
  513. ⓪((* %% added by DS 27.6.90: *)
  514. ⓪(IF pathChanged THEN
  515. ⓪+IF ~insertChangeEntry (path, orgFn, fn, cb^.oldPathLen)
  516. ⓪+THEN stop := TRUE
  517. ⓪+END;
  518. ⓪(END;
  519. ⓪(
  520. ⓪&ELSE
  521. ⓪&
  522. ⓪(IF seekPos > 0L THEN                    (*  append  *)
  523. ⓪(
  524. ⓪*Open (f, newPath, writeOnly);
  525. ⓪*IF stateErr () THEN Remove (f); RETURN END;
  526. ⓪*Seek (f, seekPos, fromBegin);
  527. ⓪*IF stateErr () THEN Remove (f); RETURN END;
  528. ⓪*
  529. ⓪(ELSE                                    (*  new file  *)
  530. ⓪*mode := noReplace;
  531. ⓪*
  532. ⓪*TestAndChange (newPath, 0);
  533. ⓪*
  534. ⓪*LOOP
  535. ⓪*
  536. ⓪,Create (f, newPath, writeOnly, mode);
  537. ⓪,IF State (f) = fFileExists THEN             (*  file exists  *)
  538. ⓪,
  539. ⓪.ResetState (f);
  540. ⓪.SplitPath (newPath, path, oldFn);
  541. ⓪.fn := oldFn;
  542. ⓪.IF ~ cb^.feAlert (fn) THEN ioRes := fFileExists; RETURN END;
  543. ⓪.IF StrEqual (fn, oldFn) THEN mode := replaceOld
  544. ⓪.ELSE FastStrings.Concat (path, fn, newPath) END;
  545. ⓪.
  546. ⓪,ELSIF stateErr () THEN RETURN               (*  file error!  *)
  547. ⓪,ELSE EXIT END;                              (*  success  *)
  548. ⓪,
  549. ⓪*END;
  550. ⓪*
  551. ⓪(END;
  552. ⓪(
  553. ⓪(WriteBytes (f, start, length);
  554. ⓪(IF stateErr () THEN Remove (f); RETURN END;
  555. ⓪(Close (f);
  556. ⓪(Open (f, newPath, writeOnly);
  557. ⓪(SetDateTime (f, date, time);
  558. ⓪((* IF stateErr () THEN Remove (f); RETURN END; *)
  559. ⓪(Close (f);
  560. ⓪(
  561. ⓪&END END;
  562. ⓪$END flushOneElem;
  563. ⓪$
  564. ⓪"BEGIN
  565. ⓪$elem := cb^.bottom;
  566. ⓪$LOOP
  567. ⓪&IF elem^.next = NIL THEN EXIT END;
  568. ⓪&
  569. ⓪&flushOneElem;
  570. ⓪&
  571. ⓪&doShowStatus (ADR (cb^.status), ioRes, stop);        (*  communicate  *)
  572. ⓪&IF stop THEN cb^.success := FALSE; EXIT END;
  573. ⓪&
  574. ⓪&elem := elem^.next;
  575. ⓪$END;
  576. ⓪$
  577. ⓪$cb^.next := cb^.bottom;             (*  free buffer contens  *)
  578. ⓪$cb^.next^.next := NIL;
  579. ⓪"END flushCopyBuffer;
  580. ⓪"
  581. ⓪ 
  582. ⓪ (*  createCopyBufferElem -- Creates a new elem. in the 'copyBuffer', if
  583. ⓪!*                          there is not enough room to do so, the buffer
  584. ⓪!*                          is flushed first.
  585. ⓪!*                          Call only, if there are no open files.
  586. ⓪!*)
  587. ⓪ 
  588. ⓪ PROCEDURE createCopyBufferElem (    cb  : copyBuffer;
  589. ⓪@VAR elem: copyBufferElem);
  590. ⓪ 
  591. ⓪"BEGIN
  592. ⓪$IF bufAvail (cb) < (minCopySpace DIV 2L) THEN
  593. ⓪&flushCopyBuffer (cb); IF ~ cb^.success THEN RETURN END;
  594. ⓪$END;
  595. ⓪$
  596. ⓪$WITH cb^ DO
  597. ⓪&elem := next;
  598. ⓪&next := copyBufferElem (LONGCARD (bottom) + length - SIZE (cb^.next^));
  599. ⓪&elem^.next := next;
  600. ⓪&elem^.next^.next := NIL;          (*  mark next elem as free  *)
  601. ⓪&elem^.start := ADDRESS (elem) + ADDRESS (SIZE (elem^));
  602. ⓪&elem^.length := LONGCARD (elem^.next) - LONGCARD (elem^.start);
  603. ⓪$END;
  604. ⓪"END createCopyBufferElem;
  605. ⓪ 
  606. ⓪ (* deleteCopyBufferElem -- Deletes a 'copyBufferElem'. The element must
  607. ⓪!*                         be the last in the 'copyBuffer'!
  608. ⓪!*)
  609. ⓪ 
  610. ⓪ PROCEDURE deleteCopyBufferElem (    cb: copyBuffer;
  611. ⓪@VAR elem: copyBufferElem);
  612. ⓪ 
  613. ⓪"BEGIN
  614. ⓪$cb^.next := elem;
  615. ⓪$elem^.next := NIL;
  616. ⓪"END deleteCopyBufferElem;
  617. ⓪"
  618. ⓪ (*  shrinkBufferElem -- Reduces the length of 'elem' to 'bytes' byte.
  619. ⓪!*
  620. ⓪!*                      ATTENTION: -- Could only be used for the last
  621. ⓪!*                                    used element of a buffer.
  622. ⓪!*                                 -- Length of the elem. and start of
  623. ⓪!*                                    the next differ, if 'bytes' is odd.
  624. ⓪!*)
  625. ⓪ 
  626. ⓪ PROCEDURE shrinkBufferElem (cb   : copyBuffer;
  627. ⓪<elem : copyBufferElem;
  628. ⓪<bytes: LONGCARD);
  629. ⓪ 
  630. ⓪"BEGIN
  631. ⓪$(*  if not last used elem. or trying to enlarge elem. size
  632. ⓪%*)
  633. ⓪$IF (elem^.next^.next # NIL) OR (elem^.length < bytes) THEN HALT END;
  634. ⓪$
  635. ⓪$elem^.length := bytes;
  636. ⓪$elem^.next := ADDRESS (elem^.start) + ADDRESS (bytes + bytes MOD 2L);
  637. ⓪$elem^.next^.next := NIL;
  638. ⓪$cb^.next := elem^.next;
  639. ⓪"END shrinkBufferElem;
  640. ⓪"
  641. ⓪"
  642. ⓪ PROCEDURE readIntoBuffer (REF path: ARRAY OF CHAR;
  643. ⓪:VAR pos : LONGCARD;
  644. ⓪>cb  : copyBuffer);
  645. ⓪ 
  646. ⓪"VAR   f        : File;
  647. ⓪(bufElem  : copyBufferElem;
  648. ⓪(readBytes: LONGCARD;
  649. ⓪(success  : BOOLEAN;
  650. ⓪"
  651. ⓪"PROCEDURE stateErr (): BOOLEAN;
  652. ⓪"
  653. ⓪$BEGIN
  654. ⓪&cb^.success := (State (f) = fOK);
  655. ⓪&IF ~ cb^.success THEN
  656. ⓪(cb^.status.fileErrAlert (State (f));
  657. ⓪(ResetState (f);
  658. ⓪(pos := 0L;
  659. ⓪(Close (f);
  660. ⓪(bufElem^.next := NIL;
  661. ⓪&END;
  662. ⓪&RETURN ~ cb^.success
  663. ⓪$END stateErr;
  664. ⓪$
  665. ⓪ 
  666. ⓪"BEGIN
  667. ⓪$
  668. ⓪$(*  alloc. room in the buffer for the new file (or part of it).
  669. ⓪%*)
  670. ⓪%
  671. ⓪$createCopyBufferElem (cb, bufElem);
  672. ⓪$IF ~ cb^.success THEN
  673. ⓪$pos := 0L; RETURN END;
  674. ⓪$WITH bufElem^ DO
  675. ⓪&Copy (path, cb^.oldPathLen, Length (path) - cb^.oldPathLen, newPath,
  676. ⓪,voidO);
  677. ⓪&Insert (cb^.newPath, 0, newPath, success);
  678. ⓪&IF ~ success THEN
  679. ⓪(reportPathFault;
  680. ⓪(deleteCopyBufferElem (cb, bufElem);
  681. ⓪(pos := 0L;
  682. ⓪(RETURN
  683. ⓪&END;
  684. ⓪&isSubdir := FALSE;
  685. ⓪&seekPos := pos;
  686. ⓪&
  687. ⓪&Open (f, path, readOnly); IF stateErr () THEN RETURN END;
  688. ⓪&GetDateTime (f, date, time);
  689. ⓪&Seek (f, pos, fromBegin); IF stateErr () THEN RETURN END;
  690. ⓪&ReadBytes (f, start, length, readBytes); IF stateErr () THEN RETURN END;
  691. ⓪&pos := FilePos (f);
  692. ⓪&IF pos = FileSize (f) THEN pos := 0L END;         (*  EOF  *)
  693. ⓪&Close (f);
  694. ⓪&
  695. ⓪&shrinkBufferElem (cb, bufElem, readBytes);
  696. ⓪&
  697. ⓪$END;
  698. ⓪"END readIntoBuffer;
  699. ⓪ 
  700. ⓪"
  701. ⓪0(*  proc.s for query through file list  *)
  702. ⓪0(*  ==================================  *)
  703. ⓪0
  704. ⓪0
  705. ⓪((*  The following proc.s shouldn't directly or indirectly be
  706. ⓪)*  recursive. Cause the caller is working with global var.s
  707. ⓪)*)
  708. ⓪)
  709. ⓪ TYPE    fileHandleProc      = PROCEDURE (REF (*file: *) ARRAY OF CHAR,
  710. ⓪I(*env : *) ADDRESS): BOOLEAN;
  711. ⓪(dirHandleProc       = PROCEDURE (REF (*dir: *) ARRAY OF CHAR,
  712. ⓪I(*env: *) ADDRESS): BOOLEAN;
  713. ⓪I
  714. ⓪(oldPathLenToEnvProc = PROCEDURE ((*oldLen: *) CARDINAL,
  715. ⓪I(*env   : *) ADDRESS);
  716. ⓪I
  717. ⓪(queryEnv        = RECORD
  718. ⓪<handleFile: fileHandleProc;
  719. ⓪<handleDir : dirHandleProc;
  720. ⓪<handleEnv : ADDRESS;
  721. ⓪<dirFirst  : BOOLEAN;
  722. ⓪<
  723. ⓪<stop      : BOOLEAN;
  724. ⓪<pathChanged : BOOLEAN;
  725. ⓪<newPath   : PathStr;
  726. ⓪:END;
  727. ⓪ 
  728. ⓪ VAR     dontKnowANameEnv: queryEnv;
  729. ⓪(dontKnowANameStr: str128;
  730. ⓪(
  731. ⓪(
  732. ⓪ 
  733. ⓪ PROCEDURE dontKnowAName (REF path: ARRAY OF CHAR; entry: DirEntry): BOOLEAN;
  734. ⓪ 
  735. ⓪"VAR   success: BOOLEAN;
  736. ⓪(ioRes  : INTEGER;
  737. ⓪((* %% added 30.6.90 DS: because dontKnowAName calls itself recursively
  738. ⓪)* the following var has to be local. Otherwise some pathes will
  739. ⓪)* not be set correct! See remark 34 lines above!!
  740. ⓪)*)
  741. ⓪(dontKnowANameStr: str128;
  742. ⓪ 
  743. ⓪"BEGIN
  744. ⓪$IF entry.name[0] # '.' THEN WITH dontKnowANameEnv DO
  745. ⓪$
  746. ⓪&Concat (path, entry.name, dontKnowANameStr, success);
  747. ⓪&IF ~ success THEN reportPathFault; stop := TRUE; RETURN FALSE END;
  748. ⓪&IF isSubdir (entry.attr) THEN
  749. ⓪&
  750. ⓪(IF dirFirst THEN
  751. ⓪*stop := ~ handleDir (dontKnowANameStr, handleEnv);
  752. ⓪*IF stop THEN RETURN FALSE END;
  753. ⓪(END;
  754. ⓪(
  755. ⓪(Append ('\*.*', dontKnowANameStr, success);
  756. ⓪(IF ~ success THEN reportPathFault; stop := TRUE; RETURN FALSE END;
  757. ⓪(DirQuery (dontKnowANameStr, filesAndSubdirs, dontKnowAName, ioRes);
  758. ⓪(IF stop OR (ioRes # fOK) THEN stop := TRUE; RETURN FALSE END;
  759. ⓪(
  760. ⓪(IF ~ dirFirst THEN
  761. ⓪*Concat (path, entry.name, dontKnowANameStr, success);
  762. ⓪*stop := ~ handleDir (dontKnowANameStr, handleEnv);
  763. ⓪*IF stop THEN RETURN FALSE END;
  764. ⓪(END;
  765. ⓪(
  766. ⓪&ELSE stop := ~ handleFile (dontKnowANameStr, handleEnv) END;
  767. ⓪&
  768. ⓪&IF stop THEN RETURN FALSE END;
  769. ⓪&
  770. ⓪$END END;
  771. ⓪$
  772. ⓪$RETURN TRUE
  773. ⓪"END dontKnowAName;
  774. ⓪ 
  775. ⓪ PROCEDURE queryFileList (REF path          : ARRAY OF CHAR;
  776. ⓪=files         : List;
  777. ⓪=workOnFile    : fileHandleProc;
  778. ⓪=workOnDir     : dirHandleProc;
  779. ⓪=setOldPathLen : oldPathLenToEnvProc;
  780. ⓪=workEnv       : ADDRESS;
  781. ⓪=workOnDirFirst: BOOLEAN);
  782. ⓪ 
  783. ⓪"VAR   entry  : ptrMaxStr;
  784. ⓪(str,
  785. ⓪(str2,
  786. ⓪(str3   : str128;
  787. ⓪(ioRes  : INTEGER;
  788. ⓪(attrs  : FileAttrSet;
  789. ⓪(success: BOOLEAN;
  790. ⓪ 
  791. ⓪"BEGIN
  792. ⓪$WITH dontKnowANameEnv DO
  793. ⓪$
  794. ⓪&handleFile := workOnFile;
  795. ⓪&handleDir  := workOnDir;
  796. ⓪&handleEnv  := workEnv;
  797. ⓪&dirFirst   := workOnDirFirst;
  798. ⓪&stop := FALSE;
  799. ⓪&pathChanged := FALSE;
  800. ⓪&
  801. ⓪&IF path[0]#0C THEN
  802. ⓪(IF path [Length (path) - 1] = '\' THEN FastStrings.Assign (path, str3)
  803. ⓪(ELSE Concat (path, '\', str3, success) END;
  804. ⓪&ELSE str3 := '' END;
  805. ⓪&
  806. ⓪&ResetList (files);
  807. ⓪&entry := NextEntry (files);
  808. ⓪&WHILE entry # NIL DO
  809. ⓪&
  810. ⓪(FastStrings.Assign (entry^, str2); (*  !!! 'entry^' by reference !!!  *)
  811. ⓪(
  812. ⓪(Concat (str3, str2, str, success);
  813. ⓪(IF ~ success THEN reportPathFault; RETURN END;
  814. ⓪(
  815. ⓪(SplitPath (str, str2, voidFN);
  816. ⓪(setOldPathLen (Length (str2), workEnv);
  817. ⓪(
  818. ⓪(GetFileAttr (str, attrs, ioRes); IF ioRes # fOK THEN RETURN END;
  819. ⓪(IF isSubdir (attrs) THEN
  820. ⓪(
  821. ⓪*IF dirFirst THEN
  822. ⓪,IF ~ handleDir (str, handleEnv) THEN RETURN END
  823. ⓪*END;
  824. ⓪*
  825. ⓪*Concat (str, '\*.*', str2, success);
  826. ⓪*IF ~ success THEN reportPathFault; RETURN END;
  827. ⓪*DirQuery (str2, filesAndSubdirs, dontKnowAName, ioRes);
  828. ⓪*IF stop OR (ioRes # fOK) THEN RETURN END;
  829. ⓪(
  830. ⓪*IF ~ dirFirst THEN
  831. ⓪,IF ~ handleDir (str, handleEnv) THEN RETURN END
  832. ⓪*END;
  833. ⓪*
  834. ⓪(ELSE IF ~ handleFile (str, handleEnv) THEN RETURN END END;
  835. ⓪(
  836. ⓪(entry := NextEntry (files);
  837. ⓪&END;
  838. ⓪&
  839. ⓪$END;
  840. ⓪"END queryFileList;
  841. ⓪!
  842. ⓪!
  843. ⓪ PROCEDURE statusDummy (c: CARDINAL; VAR s: BOOLEAN);
  844. ⓪ 
  845. ⓪"BEGIN
  846. ⓪$s := FALSE;
  847. ⓪"END statusDummy;
  848. ⓪ 
  849. ⓪ PROCEDURE setLenDummy (c: CARDINAL; env: ADDRESS);
  850. ⓪ 
  851. ⓪"END setLenDummy;
  852. ⓪ 
  853. ⓪ 
  854. ⓪8(*  proc.s for query  *)
  855. ⓪8(*  ================  *)
  856. ⓪ 
  857. ⓪ PROCEDURE countEntry (REF path: ARRAY OF CHAR; env: ADDRESS): BOOLEAN;
  858. ⓪ 
  859. ⓪"BEGIN
  860. ⓪$INC (env^);         (*  not clean, but saves a cast  *)
  861. ⓪$RETURN TRUE
  862. ⓪"END countEntry;
  863. ⓪"
  864. ⓪ PROCEDURE deleteFile (REF path: ARRAY OF CHAR; env: ADDRESS): BOOLEAN;
  865. ⓪ 
  866. ⓪"VAR   ioRes: INTEGER;
  867. ⓪(stop : BOOLEAN;
  868. ⓪ 
  869. ⓪"BEGIN
  870. ⓪$Delete (path, ioRes);
  871. ⓪$doShowStatus (env, ioRes, stop);
  872. ⓪$RETURN ~ stop
  873. ⓪"END deleteFile;
  874. ⓪"
  875. ⓪ PROCEDURE deleteDir (REF path: ARRAY OF CHAR; env: ADDRESS): BOOLEAN;
  876. ⓪ 
  877. ⓪"VAR   ioRes: INTEGER;
  878. ⓪(stop : BOOLEAN;
  879. ⓪"
  880. ⓪"BEGIN
  881. ⓪$DeleteDir (path, ioRes);
  882. ⓪$doShowStatus (env, ioRes, stop);
  883. ⓪$RETURN ~ stop
  884. ⓪"END deleteDir;
  885. ⓪ 
  886. ⓪ 
  887. ⓪ PROCEDURE fileInBuffer (REF path: ARRAY OF CHAR; env: ADDRESS): BOOLEAN;
  888. ⓪ 
  889. ⓪"VAR   cb  : copyBuffer;
  890. ⓪(pos : LONGCARD;
  891. ⓪ 
  892. ⓪"BEGIN
  893. ⓪$cb := copyBuffer (env);
  894. ⓪$
  895. ⓪$pos := 0L;
  896. ⓪$REPEAT
  897. ⓪&readIntoBuffer (path, pos, cb);
  898. ⓪$UNTIL pos = 0L;
  899. ⓪$
  900. ⓪$RETURN cb^.success
  901. ⓪"END fileInBuffer;
  902. ⓪"
  903. ⓪ PROCEDURE dirInBuffer (REF path: ARRAY OF CHAR; env: ADDRESS): BOOLEAN;
  904. ⓪ 
  905. ⓪"VAR   cb     : copyBuffer;
  906. ⓪(bufElem: copyBufferElem;
  907. ⓪(success: BOOLEAN;
  908. ⓪(tPath  : str128;
  909. ⓪(
  910. ⓪ 
  911. ⓪"BEGIN
  912. ⓪$cb := copyBuffer (env);
  913. ⓪$
  914. ⓪$createCopyBufferElem (cb, bufElem);
  915. ⓪$IF ~ cb^.success THEN RETURN FALSE END;
  916. ⓪$WITH bufElem^ DO
  917. ⓪&Concat (cb^.newPath,
  918. ⓪.FuncStrings.DelStr (path, 0, cb^.oldPathLen), tPath, success);
  919. ⓪&IF ~ success THEN
  920. ⓪(reportPathFault;
  921. ⓪(deleteCopyBufferElem (cb, bufElem);
  922. ⓪(RETURN FALSE
  923. ⓪&END;
  924. ⓪&FastStrings.Assign (tPath, newPath);
  925. ⓪&
  926. ⓪&isSubdir := TRUE;
  927. ⓪&
  928. ⓪$END;
  929. ⓪$
  930. ⓪$shrinkBufferElem (cb, bufElem, 0L);
  931. ⓪$
  932. ⓪$RETURN TRUE
  933. ⓪"END dirInBuffer;
  934. ⓪ 
  935. ⓪ PROCEDURE setOldPathLen (len: CARDINAL; env: ADDRESS);
  936. ⓪ 
  937. ⓪"VAR   cb: copyBuffer;
  938. ⓪ 
  939. ⓪"BEGIN
  940. ⓪$cb := copyBuffer (env);
  941. ⓪$
  942. ⓪$cb^.oldPathLen := len;
  943. ⓪"END setOldPathLen;
  944. ⓪"
  945. ⓪"
  946. ⓪8(*  Die exportierten Routinen  *)
  947. ⓪8(*  =========================  *)
  948. ⓪"
  949. ⓪ PROCEDURE CountFilesAndDirs (REF path: ARRAY OF CHAR;
  950. ⓪Al   : List;
  951. ⓪=VAR no  : CARDINAL);
  952. ⓪ 
  953. ⓪"BEGIN
  954. ⓪$no := 0;
  955. ⓪$queryFileList (path, l, countEntry, countEntry, setLenDummy, ADR (no),
  956. ⓪3TRUE);
  957. ⓪"END CountFilesAndDirs;
  958. ⓪"
  959. ⓪ PROCEDURE DeleteFiles (REF path        : ARRAY OF CHAR;
  960. ⓪7files       : List;
  961. ⓪7noFiles     : CARDINAL;
  962. ⓪7showStatus  : FileOpStatusProc;
  963. ⓪7fileErrAlert: FileErrorAlertProc);
  964. ⓪ 
  965. ⓪"VAR   status: statusRecord;
  966. ⓪(stop  : BOOLEAN;
  967. ⓪ 
  968. ⓪"BEGIN
  969. ⓪$showStatus (noFiles, stop); IF stop THEN RETURN END;
  970. ⓪&
  971. ⓪$status.fileErrAlert := fileErrAlert;
  972. ⓪$status.showStatus := showStatus;
  973. ⓪$status.noFiles := noFiles;
  974. ⓪$
  975. ⓪$queryFileList (path, files, deleteFile, deleteDir, setLenDummy,
  976. ⓪3ADR (status), FALSE);
  977. ⓪"END DeleteFiles;
  978. ⓪ 
  979. ⓪ PROCEDURE CopyFiles (REF path        : ARRAY OF CHAR;
  980. ⓪5files       : List;
  981. ⓪5noFiles     : CARDINAL;
  982. ⓪5REF newPath     : ARRAY OF CHAR;
  983. ⓪5deleteOld,
  984. ⓪5useAllMem   : BOOLEAN;
  985. ⓪5feAlert     : FileExistsAlertProc;
  986. ⓪5showStatus  : FileOpStatusProc;
  987. ⓪5fileErrAlert: FileErrorAlertProc);
  988. ⓪ 
  989. ⓪"VAR   buffer : copyBuffer;
  990. ⓪(len    : CARDINAL;
  991. ⓪(success,
  992. ⓪(stop   : BOOLEAN;
  993. ⓪(entry  : pcPtr;
  994. ⓪ 
  995. ⓪"BEGIN
  996. ⓪$showStatus (noFiles, stop); IF stop THEN RETURN END;
  997. ⓪&
  998. ⓪$(* %% added 27.6.90 DS *)
  999. ⓪$CreateList (pcList, success);
  1000. ⓪$IF success (* TRUE means error, but i don't wanted another var *)
  1001. ⓪$THEN reportOutOfMemory; RETURN END;
  1002. ⓪$
  1003. ⓪$createCopyBuffer (buffer, useAllMem, success);
  1004. ⓪$IF ~ success THEN reportOutOfMemory; RETURN END;
  1005. ⓪$buffer^.feAlert := feAlert;
  1006. ⓪$Assign (newPath, buffer^.newPath, success);
  1007. ⓪$len := Length (newPath);
  1008. ⓪$IF ~ success OR (len < 2) THEN
  1009. ⓪&reportPathFault;
  1010. ⓪&deleteCopyBuffer (buffer);
  1011. ⓪&RETURN
  1012. ⓪$END;
  1013. ⓪$IF newPath[len - 1] # '\' THEN Append ('\', buffer^.newPath, voidO) END;
  1014. ⓪$buffer^.status.fileErrAlert := fileErrAlert;
  1015. ⓪$buffer^.status.showStatus := showStatus;
  1016. ⓪$buffer^.status.noFiles := noFiles;
  1017. ⓪$buffer^.success := TRUE;
  1018. ⓪$
  1019. ⓪$queryFileList (path, files, fileInBuffer, dirInBuffer, setOldPathLen,
  1020. ⓪3buffer, TRUE);
  1021. ⓪$flushCopyBuffer (buffer);
  1022. ⓪$
  1023. ⓪$deleteCopyBuffer (buffer);
  1024. ⓪$
  1025. ⓪$(* %% added 27.6.90 DS *)
  1026. ⓪$(* delete pathList *)
  1027. ⓪$ResetList (pcList);
  1028. ⓪$entry := PrevEntry (pcList);
  1029. ⓪$WHILE entry # NIL DO
  1030. ⓪&RemoveEntry (pcList, voidO);
  1031. ⓪&DEALLOCATE (entry, 0L);
  1032. ⓪&entry := CurrentEntry (pcList);
  1033. ⓪$END;
  1034. ⓪$DeleteList (pcList, success)
  1035. ⓪$
  1036. ⓪"END CopyFiles;
  1037. ⓪"
  1038. ⓪ PROCEDURE FileInformation (REF name        : ARRAY OF CHAR;
  1039. ⓪;showFileInfo: FileInfoProc;
  1040. ⓪;fileErrorAlt: FileErrorAlertProc);
  1041. ⓪ 
  1042. ⓪"VAR   entry,
  1043. ⓪(oldEntry: DirEntry;
  1044. ⓪(ioRes   : INTEGER;
  1045. ⓪(path,
  1046. ⓪(newName : str128;
  1047. ⓪(f: File;
  1048. ⓪(success : BOOLEAN;
  1049. ⓪ 
  1050. ⓪"PROCEDURE error (): BOOLEAN;
  1051. ⓪$BEGIN
  1052. ⓪&IF ioRes < fOK THEN fileErrorAlt (ioRes); RETURN TRUE END;
  1053. ⓪&RETURN FALSE
  1054. ⓪$END error;
  1055. ⓪ 
  1056. ⓪"PROCEDURE errorF (): BOOLEAN;
  1057. ⓪$BEGIN
  1058. ⓪&ioRes:= State (f);
  1059. ⓪&RETURN error ()
  1060. ⓪$END errorF;
  1061. ⓪ 
  1062. ⓪"BEGIN
  1063. ⓪$GetDirEntry (name, entry, ioRes);
  1064. ⓪$IF error () THEN RETURN END;
  1065. ⓪$oldEntry := entry;
  1066. ⓪$
  1067. ⓪$showFileInfo (entry);
  1068. ⓪$
  1069. ⓪$SplitPath (name, path, voidFN);
  1070. ⓪$Concat (path, entry.name, newName, success);
  1071. ⓪$IF ~ success THEN reportPathFault; RETURN END;
  1072. ⓪$
  1073. ⓪$IF ~ StrEqual (entry.name, oldEntry.name) THEN
  1074. ⓪&Rename (name, newName, ioRes);
  1075. ⓪&IF error () THEN RETURN END;
  1076. ⓪$END;
  1077. ⓪$IF NOT (subdirAttr IN oldEntry.attr) THEN
  1078. ⓪&IF ~VarEqual (entry.date, oldEntry.date)
  1079. ⓪&OR ~VarEqual (entry.time, oldEntry.time) THEN
  1080. ⓪(Open (f, newName, readOnly);
  1081. ⓪(IF errorF () THEN RETURN END;
  1082. ⓪(SetDateTime (f, entry.date, entry.time);
  1083. ⓪(IF errorF () THEN RETURN END;
  1084. ⓪(Close (f);
  1085. ⓪(IF errorF () THEN RETURN END;
  1086. ⓪&END;
  1087. ⓪&IF (entry.attr # oldEntry.attr) THEN
  1088. ⓪(SetFileAttr (newName, entry.attr, ioRes);
  1089. ⓪(IF error () THEN RETURN END;
  1090. ⓪&END;
  1091. ⓪$END;
  1092. ⓪"END FileInformation;
  1093. ⓪ 
  1094. ⓪ PROCEDURE FormatDisk (    drive          : FormatDrive;
  1095. ⓪:sides,
  1096. ⓪:tracks,
  1097. ⓪:sectorsPerTrack,
  1098. ⓪:interleave     : CARDINAL;
  1099. ⓪:REF name           : ARRAY OF CHAR;
  1100. ⓪:showStatus     : FileOpStatusProc;
  1101. ⓪6VAR result         : FormatResult);
  1102. ⓪ 
  1103. ⓪"CONST fmtBufferSize   = 11L * 1024L;
  1104. ⓪ 
  1105. ⓪"VAR   fmtBuffer       : ADDRESS;
  1106. ⓪"
  1107. ⓪"PROCEDURE write(* (noSectors, side, track, sector: CARDINAL) on the A7 *);
  1108. ⓪3
  1109. ⓪$(*$L-*)
  1110. ⓪$BEGIN
  1111. ⓪&ASSEMBLER
  1112. ⓪(MOVE.L  (A7)+,(A3)+             ; save ret. addr.
  1113. ⓪(
  1114. ⓪(MOVE.W  drive(A6),-(A7)
  1115. ⓪(CLR.L   -(A7)                   ; not used
  1116. ⓪(MOVE.L  fmtBuffer(A6),-(A7)
  1117. ⓪(MOVE.W  #flopwr,-(A7)           ; write the boot sector
  1118. ⓪(TRAP    #xbios
  1119. ⓪(LEA     $14(A7),A7
  1120. ⓪(
  1121. ⓪(MOVE.L  -(A3),-(A7)             ; restore ret. addr.
  1122. ⓪&END;
  1123. ⓪$END write;
  1124. ⓪$(*$L=*)
  1125. ⓪ 
  1126. ⓪"BEGIN
  1127. ⓪$ASSEMBLER
  1128. ⓪(MOVEM.L D4-D6,-(A7)
  1129. ⓪(
  1130. ⓪(SUBQ.W  #1,drive(A6)            ; 'drvA' ist 1
  1131. ⓪(
  1132. ⓪(MOVE.L  result(A6),A0
  1133. ⓪(MOVE.W  #failedFR,(A0)          ; be pessimistic
  1134. ⓪#
  1135. ⓪(;  format media
  1136. ⓪(;
  1137. ⓪(;  D6.W ~ counts tracks | D4.W ~ counts sides
  1138. ⓪(
  1139. ⓪(LEA     fmtBuffer(A6),A0
  1140. ⓪(MOVE.L  A0,(A3)+
  1141. ⓪(MOVE.L  #fmtBufferSize,(A3)+
  1142. ⓪(JSR     ALLOCATE                ; alloc. 'fmtBuffer'
  1143. ⓪(TST.L   fmtBuffer(A6)
  1144. ⓪(BNE     allocOk
  1145. ⓪(
  1146. ⓪(TRAP    #noErrorTrap            ; not enough memory avaible
  1147. ⓪(DC.W    OutOfMemory - $4000
  1148. ⓪(BRA.W   ende
  1149. ⓪ allocOk
  1150. ⓪(
  1151. ⓪(MOVE.W  tracks(A6),D6
  1152. ⓪(SUBQ.W  #1,D6
  1153. ⓪ trackLoop
  1154. ⓪ 
  1155. ⓪(MOVE.W  sides(A6),D4
  1156. ⓪(SUBQ.W  #1,D4
  1157. ⓪ sideLoop
  1158. ⓪ 
  1159. ⓪(MOVE.W  #$E5E5,-(A7)            ; virgin word
  1160. ⓪(MOVE.L  #$87654321,-(A7)        ; magic
  1161. ⓪(MOVE.W  interleave(A6),-(A7)
  1162. ⓪(MOVE.W  D4,-(A7)
  1163. ⓪(MOVE.W  D6,-(A7)
  1164. ⓪(MOVE.W  sectorsPerTrack(A6),-(A7)
  1165. ⓪(MOVE.W  drive(A6),-(A7)
  1166. ⓪(CLR.L   -(A7)                   ; not used
  1167. ⓪(MOVE.L  fmtBuffer(A6),-(A7)
  1168. ⓪(MOVE.W  #flopfmt,-(A7)
  1169. ⓪(TRAP    #xbios                  ; format one track
  1170. ⓪(LEA     $1A(A7),A7
  1171. ⓪(TST.W   D0
  1172. ⓪(BNE.W   stop                    ; bad sectors (no marking yet)
  1173. ⓪ 
  1174. ⓪(DBF     D4,sideLoop
  1175. ⓪(
  1176. ⓪(MOVE.W  D6,(A3)+
  1177. ⓪(SUBQ.W  #2,A7
  1178. ⓪(MOVE.L  A7,(A3)+
  1179. ⓪(MOVE.L  showStatus(A6),A0
  1180. ⓪(JSR     (A0)
  1181. ⓪(TST.W   (A7)+
  1182. ⓪(BNE.W   stop                    ; check user break
  1183. ⓪ 
  1184. ⓪(DBF     D6, trackLoop
  1185. ⓪(
  1186. ⓪(;  write boot sector
  1187. ⓪(
  1188. ⓪(MOVE.L  fmtBuffer(A6),A0
  1189. ⓪(MOVE.W  #127,D0
  1190. ⓪ clr1Loop
  1191. ⓪(CLR.L   (A0)+
  1192. ⓪(DBF     D0,clr1Loop
  1193. ⓪(
  1194. ⓪(CLR.W   -(A7)                   ; not executable
  1195. ⓪(MOVEQ   #1,D0
  1196. ⓪(ADD.W   sides(A6),D0            ; 2 ~ SS, 3 ~ DS
  1197. ⓪(MOVE.W  D0,-(A7)
  1198. ⓪(MOVE.L  #$1000000,-(A7)         ; random serial no.
  1199. ⓪(MOVE.L  fmtBuffer(A6),-(A7)
  1200. ⓪(MOVE.W  #protobt,-(A7)          ; make a boot sector
  1201. ⓪(TRAP    #xbios
  1202. ⓪(LEA     $E(A7),A7
  1203. ⓪(
  1204. ⓪(MOVE.W  #1,-(A7)                ; one sector
  1205. ⓪(CLR.W   -(A7)                   ; side 1
  1206. ⓪(CLR.W   -(A7)                   ; track 0
  1207. ⓪(MOVE.W  #1,-(A7)                ; sector 1
  1208. ⓪(BSR     write                   ; write boot sector
  1209. ⓪(TST.W   D0
  1210. ⓪(BNE.W   stop                    ; stop, if write err
  1211. ⓪(
  1212. ⓪(;  write FATs
  1213. ⓪(
  1214. ⓪(MOVE.L  fmtBuffer(A6),A0
  1215. ⓪(MOVE.W  #895,D0                 ; clear 7 sectors
  1216. ⓪ clr2Loop
  1217. ⓪(CLR.L   (A0)+
  1218. ⓪(DBF     D0,clr2Loop
  1219. ⓪(MOVE.L  fmtBuffer(A6),A0
  1220. ⓪(MOVE.L  #$F7FFFF00,(A0)         ; FAT-start must be $F7 FF FF
  1221. ⓪(
  1222. ⓪(MOVE.W  #5,-(A7)                ; 5 sectors
  1223. ⓪(CLR.W   -(A7)                   ; side 1
  1224. ⓪(CLR.W   -(A7)                   ; track 0
  1225. ⓪(MOVE.W  #2,-(A7)                ; sector 2
  1226. ⓪(BSR     write                   ; write FAT 1
  1227. ⓪(TST.W   D0
  1228. ⓪(BNE.W   stop                    ; stop, if write err
  1229. ⓪(
  1230. ⓪(MOVEQ   #5,D6                   ; 5 sectors
  1231. ⓪(MOVE.W  sectorsPerTrack(A6),D4
  1232. ⓪(SUBQ.W  #6,D4                   ; 'sectorsPerTrack' - alreadyUsed -> D4
  1233. ⓪(SUB.W   D4,D6                   ; remaining sectors -> D6
  1234. ⓪(
  1235. ⓪(MOVE.W  D4,-(A7)                ; x sectors
  1236. ⓪(CLR.W   -(A7)                   ; side 1
  1237. ⓪(CLR.W   -(A7)                   ; track 0
  1238. ⓪(MOVE.W  #7,-(A7)                ; sector 7
  1239. ⓪(BSR     write                   ; write FAT 2 Part 1
  1240. ⓪(TST.W   D0
  1241. ⓪(BNE     stop                    ; stop, if write err
  1242. ⓪(
  1243. ⓪(MOVE.W  sides(A6),D0            ; if two sides then
  1244. ⓪(MOVEQ   #1,D5                   ;   side 2, track 0
  1245. ⓪(SUB.W   D5,D0                   ; else
  1246. ⓪(SUB.W   D0,D5                   ;   side 1, track 1
  1247. ⓪(EXG.L   D0,D4                   ; D4 = side, D5 = track
  1248. ⓪(
  1249. ⓪(TST.W   D6
  1250. ⓪(BEQ     noPart2                 ; jump, if no sectors left
  1251. ⓪(
  1252. ⓪(MOVE.W  D6,-(A7)
  1253. ⓪(MOVE.W  D4,-(A7)
  1254. ⓪(MOVE.W  D5,-(A7)
  1255. ⓪(MOVE.W  #1,-(A7)                ; sector 1
  1256. ⓪(MOVE.W  drive(A6),-(A7)
  1257. ⓪(CLR.L   -(A7)                   ; not used
  1258. ⓪(MULU    #512,D0
  1259. ⓪(ADD.L   fmtBuffer(A6),D0
  1260. ⓪(MOVE.L  D0,-(A7)                ; alreadyWrittenSecs * 512 + 'fmtBuffer'
  1261. ⓪(MOVE.W  #flopwr,-(A7)           ; write the boot sector
  1262. ⓪(TRAP    #xbios
  1263. ⓪(LEA     $14(A7),A7
  1264. ⓪(TST.W   D0
  1265. ⓪(BNE     stop                    ; stop, if write err
  1266. ⓪(
  1267. ⓪ noPart2
  1268. ⓪ 
  1269. ⓪(;  write root directory
  1270. ⓪(
  1271. ⓪(MOVE.L  fmtBuffer(A6),A0
  1272. ⓪(MOVE.L  name(A6),A1             ; ADR (name) -> A1
  1273. ⓪(MOVE.W  name+4(A6),D1           ; HIGH (name) -> D1
  1274. ⓪(MOVEQ   #11,D0
  1275. ⓪(
  1276. ⓪(BRA     nameStart
  1277. ⓪ nameLoop
  1278. ⓪(MOVE.B  D2,(A0)+
  1279. ⓪(SUBQ.W  #1,D1
  1280. ⓪(BMI     nameSpaces
  1281. ⓪ nameStart
  1282. ⓪(MOVE.B  (A1)+,D2
  1283. ⓪(DBEQ    D0,nameLoop
  1284. ⓪(BNE     nameOk
  1285. ⓪(
  1286. ⓪ nameSpaces
  1287. ⓪(BRA     nameSpcStart
  1288. ⓪ nameSpcLoop
  1289. ⓪(MOVE.B  #' ',(A0)+
  1290. ⓪ nameSpcStart
  1291. ⓪(DBF     D0,nameSpcLoop
  1292. ⓪(
  1293. ⓪ nameOk
  1294. ⓪(MOVE.B  #08,(A0)+               ;  attribute set for volume label
  1295. ⓪(
  1296. ⓪(MOVE.W  #7,-(A7)                ; directory length = 7 sectors
  1297. ⓪(MOVE.W  D4,-(A7)
  1298. ⓪(MOVE.W  D5,-(A7)
  1299. ⓪(ADDQ.W  #1,D6
  1300. ⓪(MOVE.W  D6,-(A7)
  1301. ⓪(BSR     write                   ; write directory
  1302. ⓪(TST.W   D0
  1303. ⓪(BNE     stop                    ; stop, if write err
  1304. ⓪(
  1305. ⓪(MOVE.L  result(A6),A0
  1306. ⓪(MOVE.W  #okFR,(A0)              ; flag success!
  1307. ⓪(
  1308. ⓪ stop
  1309. ⓪(LEA     fmtBuffer(A6),A0
  1310. ⓪(MOVE.L  A0,(A3)+
  1311. ⓪(CLR.L   (A3)+
  1312. ⓪(JSR     DEALLOCATE              ; dealloc. 'fmtBuffer'
  1313. ⓪ ende
  1314. ⓪(MOVEM.L (A7)+,D4-D6
  1315. ⓪$END;
  1316. ⓪"END FormatDisk;
  1317. ⓪"
  1318. ⓪ END FileManagement.
  1319. ⓪ ə
  1320. (* $FFEA89F2$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96$00006B12$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96$FFF57E96Ç$00000A48T.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$00000933$0000093E$0000094B$00000168$0000094B$000009B7$00006A40$00007088$000071F9$000071CE$00000933$00000A4B$000009C2$000009D2$00000A48$00006E6D¶Çâ*)
  1321.