Files.txt 38 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219
  1. MODULE HostFiles;
  2. (* THIS IS TEXT COPY OF Files.odc *)
  3. (* DO NOT EDIT *)
  4. IMPORT SYSTEM, WinApi, Files, Kernel;
  5. CONST
  6. tempName = "odcxxxxx.tmp";
  7. docType = "odc";
  8. serverVersion = TRUE;
  9. pathLen* = 260;
  10. nofbufs = 4; (* max number of buffers per file *)
  11. bufsize = 2 * 1024; (* size of each buffer *)
  12. invalid = WinApi.INVALID_HANDLE_VALUE;
  13. temp = 0; new = 1; shared = 2; hidden = 3; exclusive = 4; closed = 5; (* file states *)
  14. create = -1;
  15. ok = 0;
  16. invalidName = 1; invalidNameErr = 123;
  17. notFound = 2; fileNotFoundErr = 2; pathNotFoundErr = 3;
  18. existsAlready = 3; fileExistsErr = 80; alreadyExistsErr = 183;
  19. writeProtected = 4; writeProtectedErr = 19;
  20. ioError = 5;
  21. accessDenied = 6; accessDeniedErr = 5; sharingErr = 32; netAccessDeniedErr = 65;
  22. notEnoughMem = 80; notEnoughMemoryErr = 8;
  23. notEnoughDisk = 81; diskFullErr = 39; tooManyOpenFilesErr = 4; noSystemResourcesErr = 1450;
  24. noMoreFilesErr = 18;
  25. cancel = -8; retry = -9;
  26. TYPE
  27. FullName* = ARRAY pathLen OF CHAR;
  28. Locator* = POINTER TO RECORD (Files.Locator)
  29. path-: FullName; (* without trailing "/" *)
  30. maxLen-: INTEGER; (* maximum name length *)
  31. caseSens-: BOOLEAN; (* case sensitive file compares *)
  32. rootLen-: INTEGER (* for network version *)
  33. END;
  34. Buffer = POINTER TO RECORD
  35. dirty: BOOLEAN;
  36. org, len: INTEGER;
  37. data: ARRAY bufsize OF BYTE
  38. END;
  39. File = POINTER TO RECORD (Files.File)
  40. state: INTEGER;
  41. name: FullName;
  42. ref: WinApi.HANDLE;
  43. loc: Locator;
  44. swapper: INTEGER; (* index into file table / next buffer to swap *)
  45. len: INTEGER;
  46. bufs: ARRAY nofbufs OF Buffer;
  47. t: LONGINT (* time stamp of last file operation *)
  48. END;
  49. Reader = POINTER TO RECORD (Files.Reader)
  50. base: File;
  51. org, offset: INTEGER;
  52. buf: Buffer
  53. END;
  54. Writer = POINTER TO RECORD (Files.Writer)
  55. base: File;
  56. org, offset: INTEGER;
  57. buf: Buffer
  58. END;
  59. Directory = POINTER TO RECORD (Files.Directory)
  60. temp, startup: Locator
  61. END;
  62. Identifier = RECORD (Kernel.Identifier)
  63. name: FullName
  64. END;
  65. Searcher = RECORD (Kernel.Identifier)
  66. t0: INTEGER;
  67. f: File
  68. END;
  69. Counter = RECORD (Kernel.Identifier)
  70. count: INTEGER
  71. END;
  72. VAR
  73. MapParamString*: PROCEDURE(in, p0, p1, p2: ARRAY OF CHAR; OUT out: ARRAY OF CHAR);
  74. appName-: FullName;
  75. dir: Directory;
  76. wildcard: Files.Type;
  77. startupDir: FullName;
  78. startupLen: INTEGER;
  79. res: INTEGER;
  80. PROCEDURE Error (n: INTEGER): INTEGER;
  81. VAR res: INTEGER;
  82. BEGIN
  83. IF n = ok THEN res := ok
  84. ELSIF n = invalidNameErr THEN res := invalidName
  85. ELSIF (n = fileNotFoundErr) OR (n = pathNotFoundErr) THEN res := notFound
  86. ELSIF (n = fileExistsErr) OR (n = alreadyExistsErr) THEN res := existsAlready
  87. ELSIF n = writeProtectedErr THEN res := writeProtected
  88. ELSIF (n = sharingErr) OR (n = accessDeniedErr) OR (n = netAccessDeniedErr) THEN res := accessDenied
  89. ELSIF n = notEnoughMemoryErr THEN res := notEnoughMem
  90. ELSIF (n = diskFullErr) OR (n = tooManyOpenFilesErr) THEN res := notEnoughDisk
  91. ELSE res := -n
  92. END;
  93. RETURN res
  94. END Error;
  95. PROCEDURE Diff (IN a, b: ARRAY OF CHAR; caseSens: BOOLEAN): INTEGER;
  96. VAR i: INTEGER; cha, chb: CHAR;
  97. BEGIN
  98. i := 0;
  99. REPEAT
  100. cha := a[i]; chb := b[i]; INC(i);
  101. IF cha # chb THEN
  102. IF ~caseSens THEN
  103. IF (cha >= "a") & ((cha <= "z") OR (cha >= 0E0X) & (cha <= 0FEX) & (cha # 0F7X)) THEN
  104. cha := CAP(cha)
  105. END;
  106. IF (chb >= "a") & ((chb <= "z") OR (chb >= 0E0X) & (chb <= 0FEX) & (chb # 0F7X)) THEN
  107. chb := CAP(chb)
  108. END
  109. END;
  110. IF cha = "\" THEN cha := "/" END;
  111. IF chb = "\" THEN chb := "/" END;
  112. IF cha # chb THEN RETURN ORD(cha) - ORD(chb) END
  113. END
  114. (*
  115. IF (cha = chb)
  116. OR ~caseSens & (CAP(cha) = CAP(chb)) & (CAP(cha) >= "A") & ((CAP(cha) <= "Z") OR (cha >= "À"))
  117. OR ((cha = "/") OR (cha = "\")) & ((chb = "/") OR (chb = "\")) THEN (* ok *)
  118. ELSE RETURN 1
  119. END
  120. *)
  121. UNTIL cha = 0X;
  122. RETURN 0
  123. END Diff;
  124. PROCEDURE NewLocator* (IN fname: ARRAY OF CHAR): Locator;
  125. VAR loc: Locator; res, n, max, i: INTEGER; root: FullName; ch: CHAR; f: SET;
  126. BEGIN
  127. NEW(loc); loc.path := fname$; i := 0;
  128. WHILE loc.path[i] # 0X DO INC(i) END;
  129. IF (loc.path[i-1] = "/") OR (loc.path[i-1] = "\") THEN loc.path[i-1] := 0X END;
  130. i := 0; n := 1;
  131. IF ((fname[0] = "\") OR (fname[0] = "/")) & ((fname[1] = "\") OR (fname[1] = "/")) THEN n := 4 END;
  132. REPEAT
  133. ch := fname[i]; root[i] := ch; INC(i);
  134. IF (ch = "/") OR (ch = "\") THEN DEC(n) END
  135. UNTIL (ch = 0X) OR (n = 0);
  136. IF ch = 0X THEN root[i-1] := "\" END;
  137. root[i] := 0X; res := WinApi.GetVolumeInformationW(root, NIL, 0, n, max, f, NIL, 0);
  138. IF res = 0 THEN
  139. max := 12; f := {} (* FAT values *)
  140. END;
  141. loc.maxLen := max; loc.caseSens := FALSE; (* 0 IN f; *) (* NT erroneously returns true here *)
  142. RETURN loc
  143. END NewLocator;
  144. PROCEDURE GetType (IN name: ARRAY OF CHAR; VAR type: Files.Type);
  145. VAR i, j: INTEGER; ch: CHAR;
  146. BEGIN
  147. i := 0; j := 0;
  148. WHILE name[i] # 0X DO INC(i) END;
  149. WHILE (i > 0) & (name[i] # ".") DO DEC(i) END;
  150. IF i > 0 THEN
  151. INC(i); ch := name[i];
  152. WHILE (j < LEN(type) - 1) & (ch # 0X) DO
  153. IF (ch >= "A") & (ch <= "Z") THEN ch := CHR(ORD(ch) + (ORD("a") - ORD("A"))) END;
  154. type[j] := ch; INC(j);
  155. INC(i); ch := name[i]
  156. END
  157. END;
  158. type[j] := 0X
  159. END GetType;
  160. PROCEDURE Append (IN path, name: ARRAY OF CHAR; type: Files.Type; max: INTEGER;
  161. VAR res: ARRAY OF CHAR
  162. );
  163. VAR i, j, n, m, dot: INTEGER; ch: CHAR;
  164. BEGIN
  165. i := 0;
  166. WHILE path[i] # 0X DO res[i] := path[i]; INC(i) END;
  167. IF path # "" THEN
  168. ASSERT((res[i-1] # "/") & (res[i-1] # "\"), 100);
  169. res[i] := "\"; INC(i)
  170. END;
  171. j := 0; ch := name[0]; n := 0; m := max; dot := -1;
  172. IF max = 12 THEN m := 8 END;
  173. WHILE (i < LEN(res) - 1) & (ch # 0X) DO
  174. IF (ch = "/") OR (ch = "\") THEN
  175. res[i] := ch; INC(i); n := 0; m := max; dot := -1;
  176. IF max = 12 THEN m := 8 END
  177. ELSIF (n < m) OR (ch = ".") & (n = 8) THEN
  178. res[i] := ch; INC(i); INC(n);
  179. IF ch = "." THEN dot := n;
  180. IF max = 12 THEN m := n + 3 END
  181. END
  182. END;
  183. INC(j); ch := name[j]
  184. END;
  185. IF (dot = -1) & (type # "") THEN
  186. IF max = 12 THEN m := n + 4 END;
  187. IF (n < m) & (i < LEN(res) - 1) THEN res[i] := "."; INC(i); INC(n); dot := n END
  188. END;
  189. IF n = dot THEN j := 0;
  190. WHILE (n < m) & (i < LEN(res) - 1) & (type[j] # 0X) DO res[i] := type[j]; INC(i); INC(j) END
  191. END;
  192. res[i] := 0X
  193. END Append;
  194. PROCEDURE CloseFileHandle (f: File; VAR res: INTEGER);
  195. BEGIN
  196. IF (f.ref = invalid) OR (WinApi.CloseHandle(f.ref) # 0) THEN res := ok (* !!! *)
  197. ELSE res := WinApi.GetLastError()
  198. END;
  199. f.ref := invalid
  200. END CloseFileHandle;
  201. PROCEDURE CloseFile (f: File; VAR res: INTEGER);
  202. VAR s: INTEGER;
  203. BEGIN
  204. IF f.state = exclusive THEN
  205. f.Flush;
  206. res := WinApi.FlushFileBuffers(f.ref)
  207. END;
  208. s := f.state; f.state := closed;
  209. CloseFileHandle (f, res);
  210. IF (s IN {temp, new, hidden}) & (f.name # "") THEN
  211. res := WinApi.DeleteFileW(f.name)
  212. END
  213. END CloseFile;
  214. PROCEDURE (f: File) FINALIZE;
  215. VAR res: INTEGER;
  216. BEGIN
  217. IF f.state # closed THEN CloseFile(f, res) END
  218. END FINALIZE;
  219. PROCEDURE (VAR id: Identifier) Identified (): BOOLEAN;
  220. VAR f: File;
  221. BEGIN
  222. f := id.obj(File);
  223. RETURN (f.state IN {shared, exclusive}) & (Diff(f.name, id.name, f.loc.caseSens) = 0)
  224. END Identified;
  225. PROCEDURE ThisFile (IN name: FullName): File;
  226. VAR id: Identifier; p: ANYPTR;
  227. BEGIN
  228. id.typ := SYSTEM.TYP(File); id.name := name$;
  229. p := Kernel.ThisFinObj(id);
  230. IF p # NIL THEN RETURN p(File)
  231. ELSE RETURN NIL
  232. END
  233. END ThisFile;
  234. PROCEDURE (VAR s: Searcher) Identified (): BOOLEAN;
  235. VAR f: File;
  236. BEGIN
  237. f := s.obj(File);
  238. IF (f.ref # invalid) & ((s.f = NIL) OR (f.t < s.f.t)) THEN s.f := f END;
  239. RETURN FALSE
  240. END Identified;
  241. PROCEDURE SearchFileToClose;
  242. VAR s: Searcher; p: ANYPTR; (* res: LONGINT; *)
  243. BEGIN
  244. s.typ := SYSTEM.TYP(File); s.f := NIL;
  245. p := Kernel.ThisFinObj(s);
  246. IF s.f # NIL THEN
  247. res := WinApi.CloseHandle(s.f.ref); s.f.ref := invalid;
  248. IF res = 0 THEN res := WinApi.GetLastError(); HALT(100) END
  249. END
  250. END SearchFileToClose;
  251. PROCEDURE NewFileRef (state: INTEGER; VAR name: FullName): WinApi.HANDLE;
  252. BEGIN
  253. IF state = create THEN
  254. RETURN WinApi.CreateFileW(name, WinApi.GENERIC_READ + WinApi.GENERIC_WRITE, {},
  255. NIL, WinApi.CREATE_NEW, WinApi.FILE_ATTRIBUTE_TEMPORARY, 0)
  256. ELSIF state = shared THEN
  257. RETURN WinApi.CreateFileW(name, WinApi.GENERIC_READ, WinApi.FILE_SHARE_READ,
  258. NIL, WinApi.OPEN_EXISTING, {}, 0)
  259. ELSE
  260. RETURN WinApi.CreateFileW(name, WinApi.GENERIC_READ + WinApi.GENERIC_WRITE, {},
  261. NIL, WinApi.OPEN_EXISTING, {}, 0)
  262. END
  263. END NewFileRef;
  264. PROCEDURE OpenFile (state: INTEGER; VAR name: FullName; VAR ref, res: INTEGER);
  265. BEGIN
  266. ref := NewFileRef(state, name);
  267. IF ref = invalid THEN
  268. res := WinApi.GetLastError();
  269. IF (res = tooManyOpenFilesErr) OR (res = noSystemResourcesErr) THEN
  270. Kernel.Collect;
  271. ref := NewFileRef(state, name);
  272. IF ref = invalid THEN
  273. res := WinApi.GetLastError();
  274. IF (res = tooManyOpenFilesErr) OR (res = noSystemResourcesErr) THEN
  275. SearchFileToClose;
  276. ref := NewFileRef(state, name);
  277. IF ref = invalid THEN
  278. res := WinApi.GetLastError()
  279. ELSE res := ok
  280. END
  281. END
  282. ELSE res := ok
  283. END
  284. END
  285. ELSE res := ok
  286. END
  287. END OpenFile;
  288. PROCEDURE GetTempFileName (IN path: FullName; OUT name: FullName; num: INTEGER);
  289. VAR i: INTEGER; str: ARRAY 16 OF CHAR;
  290. BEGIN
  291. str := tempName; i := 7;
  292. WHILE i > 2 DO
  293. str[i] := CHR(num MOD 10 + ORD("0")); DEC(i); num := num DIV 10
  294. END;
  295. Append(path, str, "", 8, name)
  296. END GetTempFileName;
  297. PROCEDURE CreateFile (f: File; VAR res: INTEGER);
  298. VAR num, n: INTEGER;
  299. BEGIN
  300. IF f.name = "" THEN
  301. num := WinApi.GetTickCount(); n := 200;
  302. REPEAT
  303. GetTempFileName(f.loc.path, f.name, num); INC(num); DEC(n);
  304. OpenFile(create, f.name, f.ref, res)
  305. UNTIL (res # fileExistsErr) & (res # alreadyExistsErr) & (res # 87) OR (n = 0)
  306. ELSE
  307. OpenFile(f.state, f.name, f.ref, res)
  308. END
  309. END CreateFile;
  310. PROCEDURE Delete (IN fname, path: FullName; VAR res: INTEGER);
  311. VAR num, n, s: INTEGER; f: File; new: FullName; attr: SET;
  312. BEGIN
  313. ASSERT(fname # "", 100);
  314. f := ThisFile(fname);
  315. IF f = NIL THEN
  316. IF WinApi.DeleteFileW(fname) # 0 THEN res := ok
  317. ELSE res := WinApi.GetLastError()
  318. END
  319. ELSE (* still in use => make it anonymous *)
  320. IF f.ref # invalid THEN res := WinApi.CloseHandle(f.ref); f.ref := invalid END; (* !!! *)
  321. attr := BITS(WinApi.GetFileAttributesW(fname));
  322. ASSERT(attr # {0..MAX(SET)}, 101);
  323. IF WinApi.FILE_ATTRIBUTE_READONLY * attr = {} THEN
  324. s := f.state; num := WinApi.GetTickCount(); n := 200;
  325. REPEAT
  326. GetTempFileName(path, new, num); INC(num); DEC(n);
  327. IF WinApi.MoveFileW(fname, new) # 0 THEN res := ok
  328. ELSE res := WinApi.GetLastError()
  329. END
  330. UNTIL (res # fileExistsErr) & (res # alreadyExistsErr) & (res # 87) OR (n = 0);
  331. IF res = ok THEN
  332. f.state := hidden; f.name := new$
  333. END
  334. ELSE
  335. res := writeProtectedErr
  336. END
  337. END
  338. END Delete;
  339. PROCEDURE FlushBuffer (f: File; i: INTEGER);
  340. VAR buf: Buffer; res, h: INTEGER;
  341. BEGIN
  342. buf := f.bufs[i];
  343. IF (buf # NIL) & buf.dirty THEN
  344. IF f.ref = invalid THEN CreateFile(f, res) (* ASSERT(res = ok, 100) *) END;
  345. IF f.ref # invalid THEN
  346. h := 0; h := WinApi.SetFilePointer(f.ref, buf.org, h, 0);
  347. IF (WinApi.WriteFile(f.ref, SYSTEM.ADR(buf.data), buf.len, h, NIL) = 0) OR (h < buf.len) THEN
  348. res := WinApi.GetLastError(); HALT(101)
  349. END;
  350. buf.dirty := FALSE; f.t := Kernel.Time()
  351. END
  352. END
  353. END FlushBuffer;
  354. (* File *)
  355. PROCEDURE (f: File) NewReader (old: Files.Reader): Files.Reader;
  356. VAR r: Reader;
  357. BEGIN (* portable *)
  358. ASSERT(f.state # closed, 20);
  359. IF (old # NIL) & (old IS Reader) THEN r := old(Reader) ELSE NEW(r) END;
  360. IF r.base # f THEN
  361. r.base := f; r.buf := NIL; r.SetPos(0)
  362. END;
  363. r.eof := FALSE;
  364. RETURN r
  365. END NewReader;
  366. PROCEDURE (f: File) NewWriter (old: Files.Writer): Files.Writer;
  367. VAR w: Writer;
  368. BEGIN (* portable *)
  369. ASSERT(f.state # closed, 20); ASSERT(f.state # shared, 21);
  370. IF (old # NIL) & (old IS Writer) THEN w := old(Writer) ELSE NEW(w) END;
  371. IF w.base # f THEN
  372. w.base := f; w.buf := NIL; w.SetPos(f.len)
  373. END;
  374. RETURN w
  375. END NewWriter;
  376. PROCEDURE (f: File) Length (): INTEGER;
  377. BEGIN (* portable *)
  378. RETURN f.len
  379. END Length;
  380. PROCEDURE (f: File) Flush;
  381. VAR i: INTEGER;
  382. BEGIN (* portable *)
  383. i := 0; WHILE i # nofbufs DO FlushBuffer(f, i); INC(i) END
  384. END Flush;
  385. PROCEDURE GetPath (IN fname: FullName; OUT path: FullName);
  386. VAR i: INTEGER;
  387. BEGIN
  388. path := fname$; i := LEN(path$);
  389. WHILE (i > 0) & (path[i] # "\") & (path[i] # "/") & (path[i-1] # ":") DO DEC(i) END;
  390. path[i] := 0X
  391. END GetPath;
  392. PROCEDURE CreateDir (IN path: FullName; OUT res: INTEGER);
  393. VAR sec: WinApi.SECURITY_ATTRIBUTES; p: FullName;
  394. BEGIN
  395. ASSERT(path # "", 100);
  396. sec.nLength :=SIZE(WinApi.SECURITY_ATTRIBUTES);
  397. sec.lpSecurityDescriptor := 0; sec.bInheritHandle := 0;
  398. res := WinApi.CreateDirectoryW(path, sec);
  399. IF res = 0 THEN res := WinApi.GetLastError() ELSE res := ok END;
  400. IF (res = fileNotFoundErr) OR (res = pathNotFoundErr) THEN
  401. GetPath(path, p);
  402. CreateDir(p, res); (* recursive call *)
  403. IF res = ok THEN
  404. res := WinApi.CreateDirectoryW(path, sec);
  405. IF res = 0 THEN res := WinApi.GetLastError() ELSE res := ok END
  406. END
  407. END
  408. END CreateDir;
  409. PROCEDURE CheckPath (VAR path: FullName; ask: BOOLEAN; VAR res: INTEGER);
  410. VAR s: ARRAY 300 OF CHAR; t: ARRAY 32 OF CHAR;
  411. BEGIN
  412. IF ask THEN
  413. IF MapParamString # NIL THEN
  414. MapParamString("#Host:CreateDir", path, "", "", s);
  415. MapParamString("#Host:MissingDirectory", "", "", "", t)
  416. ELSE
  417. s := path$; t := "Missing Directory"
  418. END;
  419. res := WinApi.MessageBoxW(Kernel.mainWnd, s, t, {0, 6}) (* ok cancel, icon information *)
  420. ELSE
  421. res := 1
  422. END;
  423. IF res = 1 THEN CreateDir(path, res)
  424. ELSIF res = 2 THEN res := cancel
  425. END
  426. END CheckPath;
  427. PROCEDURE CheckDelete (IN fname, path: FullName; ask: BOOLEAN; VAR res: INTEGER);
  428. VAR s: ARRAY 300 OF CHAR; t: ARRAY 16 OF CHAR;
  429. BEGIN
  430. REPEAT
  431. Delete(fname, path, res);
  432. IF (res = writeProtectedErr) OR (res = sharingErr) OR (res = accessDeniedErr)
  433. OR (res = netAccessDeniedErr)
  434. THEN
  435. IF ask THEN
  436. IF MapParamString # NIL THEN
  437. IF res = writeProtectedErr THEN
  438. MapParamString("#Host:ReplaceWriteProtected", fname, 0DX, "", s)
  439. ELSIF (res = accessDeniedErr) OR (res = netAccessDeniedErr) THEN
  440. MapParamString("#Host:ReplaceAccessDenied", fname, 0DX, "", s)
  441. ELSE
  442. MapParamString("#Host:ReplaceInUse", fname, 0DX, "", s)
  443. END;
  444. MapParamString("#Host:FileError", "", "", "", t)
  445. ELSE
  446. s := fname$; t := "File Error"
  447. END;
  448. res := WinApi.MessageBoxW(Kernel.mainWnd, s, t, {0, 2, 4, 5}); (* retry cancel, icon warning *)
  449. IF res = 2 THEN res := cancel
  450. ELSIF res = 4 THEN res := retry
  451. END
  452. ELSE
  453. res := cancel
  454. END
  455. ELSE
  456. res := ok
  457. END
  458. UNTIL res # retry
  459. END CheckDelete;
  460. PROCEDURE (f: File) Register (name: Files.Name; type: Files.Type; ask: BOOLEAN; OUT res: INTEGER);
  461. VAR b: INTEGER; fname: FullName;
  462. BEGIN
  463. ASSERT(f.state = new, 20); ASSERT(name # "", 21);
  464. Append(f.loc.path, name, type, f.loc.maxLen, fname);
  465. CheckDelete(fname, f.loc.path, ask, res);
  466. ASSERT(res # 87, 100);
  467. IF res = ok THEN
  468. IF f.name = "" THEN
  469. f.name := fname$;
  470. OpenFile(create, f.name, f.ref, res);
  471. IF res = ok THEN
  472. f.state := exclusive; CloseFile(f, res);
  473. b := WinApi.SetFileAttributesW(f.name, WinApi.FILE_ATTRIBUTE_ARCHIVE)
  474. END
  475. ELSE
  476. f.state := exclusive; CloseFile(f, res);
  477. IF WinApi.MoveFileW(f.name, fname) # 0 THEN
  478. res := ok; f.name := fname$;
  479. b := WinApi.SetFileAttributesW(f.name, WinApi.FILE_ATTRIBUTE_ARCHIVE)
  480. ELSE
  481. res := WinApi.GetLastError();
  482. ASSERT(res # 87, 101);
  483. b := WinApi.DeleteFileW(f.name)
  484. END
  485. END
  486. END;
  487. res := Error(res)
  488. END Register;
  489. PROCEDURE (f: File) Close;
  490. VAR res: INTEGER;
  491. BEGIN (* portable *)
  492. IF f.state # closed THEN
  493. (*
  494. IF f.state = exclusive THEN
  495. CloseFile(f, res)
  496. ELSE
  497. CloseFileHandle(f, res)
  498. END
  499. *)
  500. CloseFile(f, res)
  501. END
  502. END Close;
  503. (* Locator *)
  504. PROCEDURE (loc: Locator) This* (IN path: ARRAY OF CHAR): Locator;
  505. VAR new: Locator; i: INTEGER;
  506. BEGIN
  507. IF path = "" THEN
  508. NEW(new); new^ := loc^
  509. ELSIF path[1] = ":" THEN (* absolute path *)
  510. new := NewLocator(path);
  511. new.rootLen := 0
  512. ELSIF (path[0] = "\") OR (path[0] = "/") THEN
  513. IF (path[1] = "\") OR (path[1] = "/") THEN (* network path *)
  514. new := NewLocator(path);
  515. new.rootLen := 0
  516. ELSE
  517. NEW(new); new^ := dir.startup^;
  518. new.res := invalidName;
  519. RETURN new
  520. END
  521. ELSE
  522. NEW(new); Append(loc.path, path, "", loc.maxLen, new.path);
  523. i := 0; WHILE new.path[i] # 0X DO INC(i) END;
  524. IF (new.path[i-1] = "/") OR (new.path[i-1] = "\") THEN new.path[i-1] := 0X END;
  525. new.maxLen := loc.maxLen;
  526. new.caseSens := loc.caseSens;
  527. new.rootLen := loc.rootLen
  528. END;
  529. new.res := ok;
  530. RETURN new
  531. END This;
  532. (* Reader *)
  533. PROCEDURE (r: Reader) Base (): Files.File;
  534. BEGIN (* portable *)
  535. RETURN r.base
  536. END Base;
  537. (*
  538. PROCEDURE (r: Reader) Available (): INTEGER;
  539. BEGIN (* portable *)
  540. ASSERT(r.base # NIL, 20);
  541. RETURN r.base.len - r.org - r.offset
  542. END Available;
  543. *)
  544. PROCEDURE (r: Reader) SetPos (pos: INTEGER);
  545. VAR f: File; org, offset, i, count, res: INTEGER; buf: Buffer;
  546. BEGIN
  547. f := r.base; ASSERT(f # NIL, 20); ASSERT(f.state # closed, 25);
  548. ASSERT(pos >= 0, 22); ASSERT(pos <= f.len, 21);
  549. offset := pos MOD bufsize; org := pos - offset;
  550. i := 0; WHILE (i # nofbufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END;
  551. IF i # nofbufs THEN
  552. buf := f.bufs[i];
  553. IF buf = NIL THEN (* create new buffer *)
  554. NEW(buf); f.bufs[i] := buf; buf.org := -1
  555. END
  556. ELSE (* choose an existing buffer *)
  557. f.swapper := (f.swapper + 1) MOD nofbufs;
  558. FlushBuffer(f, f.swapper); buf := f.bufs[f.swapper]; buf.org := -1
  559. END;
  560. IF buf.org # org THEN
  561. IF org + bufsize > f.len THEN buf.len := f.len - org ELSE buf.len := bufsize END;
  562. count := buf.len;
  563. IF count > 0 THEN
  564. IF f.ref = invalid THEN CreateFile(f, res) (* ASSERT(res = ok, 100) *) END;
  565. IF f.ref # invalid THEN
  566. i := 0; i := WinApi.SetFilePointer(f.ref, org, i, 0);
  567. IF (WinApi.ReadFile(f.ref, SYSTEM.ADR(buf.data), count, i, NIL) = 0) OR (i < count) THEN
  568. res := WinApi.GetLastError(); res := Error(res); HALT(101)
  569. END;
  570. f.t := Kernel.Time()
  571. END
  572. END;
  573. buf.org := org; buf.dirty := FALSE
  574. END;
  575. r.buf := buf; r.org := org; r.offset := offset; r.eof := FALSE
  576. (* 0<= r.org <= r.base.len *)
  577. (* 0 <= r.offset < bufsize *)
  578. (* 0 <= r.buf.len <= bufsize *)
  579. (* r.offset <= r.base.len *)
  580. (* r.offset <= r.buf.len *)
  581. END SetPos;
  582. PROCEDURE (r: Reader) Pos (): INTEGER;
  583. BEGIN (* portable *)
  584. ASSERT(r.base # NIL, 20);
  585. RETURN r.org + r.offset
  586. END Pos;
  587. PROCEDURE (r: Reader) ReadByte (OUT x: BYTE);
  588. BEGIN (* portable *)
  589. IF (r.org # r.buf.org) OR (r.offset >= bufsize) THEN r.SetPos(r.org + r.offset) END;
  590. IF r.offset < r.buf.len THEN
  591. x := r.buf.data[r.offset]; INC(r.offset)
  592. ELSE
  593. x := 0; r.eof := TRUE
  594. END
  595. END ReadByte;
  596. PROCEDURE (r: Reader) ReadBytes (VAR x: ARRAY OF BYTE; beg, len: INTEGER);
  597. VAR from, to, count, restInBuf: INTEGER;
  598. BEGIN (* portable *)
  599. ASSERT(beg >= 0, 21);
  600. IF len > 0 THEN
  601. ASSERT(beg + len <= LEN(x), 23);
  602. WHILE len # 0 DO
  603. IF (r.org # r.buf.org) OR (r.offset >= bufsize) THEN r.SetPos(r.org + r.offset) END;
  604. restInBuf := r.buf.len - r.offset;
  605. IF restInBuf = 0 THEN r.eof := TRUE; RETURN
  606. ELSIF restInBuf <= len THEN count := restInBuf
  607. ELSE count := len
  608. END;
  609. from := SYSTEM.ADR(r.buf.data[r.offset]); to := SYSTEM.ADR(x) + beg;
  610. SYSTEM.MOVE(from, to, count);
  611. INC(r.offset, count); INC(beg, count); DEC(len, count)
  612. END;
  613. r.eof := FALSE
  614. ELSE ASSERT(len = 0, 22)
  615. END
  616. END ReadBytes;
  617. (* Writer *)
  618. PROCEDURE (w: Writer) Base (): Files.File;
  619. BEGIN (* portable *)
  620. RETURN w.base
  621. END Base;
  622. PROCEDURE (w: Writer) SetPos (pos: INTEGER);
  623. VAR f: File; org, offset, i, count, res: INTEGER; buf: Buffer;
  624. BEGIN
  625. f := w.base; ASSERT(f # NIL, 20); ASSERT(f.state # closed, 25);
  626. ASSERT(pos >= 0, 22); ASSERT(pos <= f.len, 21);
  627. offset := pos MOD bufsize; org := pos - offset;
  628. i := 0; WHILE (i # nofbufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END;
  629. IF i # nofbufs THEN
  630. buf := f.bufs[i];
  631. IF buf = NIL THEN (* create new buffer *)
  632. NEW(buf); f.bufs[i] := buf; buf.org := -1
  633. END
  634. ELSE (* choose an existing buffer *)
  635. f.swapper := (f.swapper + 1) MOD nofbufs;
  636. FlushBuffer(f, f.swapper); buf := f.bufs[f.swapper]; buf.org := -1
  637. END;
  638. IF buf.org # org THEN
  639. IF org + bufsize > f.len THEN buf.len := f.len - org ELSE buf.len := bufsize END;
  640. count := buf.len;
  641. IF count > 0 THEN
  642. IF f.ref = invalid THEN CreateFile(f, res) (* ASSERT(res = ok, 100) *) END;
  643. IF f.ref # invalid THEN
  644. i := 0; i := WinApi.SetFilePointer(f.ref, org, i, 0);
  645. IF (WinApi.ReadFile(f.ref, SYSTEM.ADR(buf.data), count, i, NIL) = 0) OR (i < count) THEN
  646. res := WinApi.GetLastError(); res := Error(res); HALT(101)
  647. END;
  648. f.t := Kernel.Time()
  649. END
  650. END;
  651. buf.org := org; buf.dirty := FALSE
  652. END;
  653. w.buf := buf; w.org := org; w.offset := offset
  654. (* 0<= w.org <= w.base.len *)
  655. (* 0 <= w.offset < bufsize *)
  656. (* 0 <= w.buf.len <= bufsize *)
  657. (* w.offset <= w.base.len *)
  658. (* w.offset <= w.buf.len *)
  659. END SetPos;
  660. PROCEDURE (w: Writer) Pos (): INTEGER;
  661. BEGIN (* portable *)
  662. ASSERT(w.base # NIL, 20);
  663. RETURN w.org + w.offset
  664. END Pos;
  665. PROCEDURE (w: Writer) WriteByte (x: BYTE);
  666. BEGIN (* portable *)
  667. ASSERT(w.base.state # closed, 25);
  668. IF (w.org # w.buf.org) OR (w.offset >= bufsize) THEN w.SetPos(w.org + w.offset) END;
  669. w.buf.data[w.offset] := x; w.buf.dirty := TRUE;
  670. IF w.offset = w.buf.len THEN INC(w.buf.len); INC(w.base.len) END;
  671. INC(w.offset)
  672. END WriteByte;
  673. PROCEDURE (w: Writer) WriteBytes (IN x: ARRAY OF BYTE; beg, len: INTEGER);
  674. VAR from, to, count, restInBuf: INTEGER;
  675. BEGIN (* portable *)
  676. ASSERT(beg >= 0, 21); ASSERT(w.base.state # closed, 25);
  677. IF len > 0 THEN
  678. ASSERT(beg + len <= LEN(x), 23);
  679. WHILE len # 0 DO
  680. IF (w.org # w.buf.org) OR (w.offset >= bufsize) THEN w.SetPos(w.org + w.offset) END;
  681. restInBuf := bufsize - w.offset;
  682. IF restInBuf <= len THEN count := restInBuf ELSE count := len END;
  683. from := SYSTEM.ADR(x) + beg; to := SYSTEM.ADR(w.buf.data[w.offset]);
  684. SYSTEM.MOVE(from, to, count);
  685. INC(w.offset, count); INC(beg, count); DEC(len, count);
  686. IF w.offset > w.buf.len THEN INC(w.base.len, w.offset - w.buf.len); w.buf.len := w.offset END;
  687. w.buf.dirty := TRUE
  688. END
  689. ELSE ASSERT(len = 0, 22)
  690. END
  691. END WriteBytes;
  692. (* Directory *)
  693. PROCEDURE (d: Directory) This (IN path: ARRAY OF CHAR): Files.Locator;
  694. BEGIN
  695. RETURN d.startup.This(path)
  696. END This;
  697. PROCEDURE (d: Directory) New (loc: Files.Locator; ask: BOOLEAN): Files.File;
  698. VAR f: File; res: INTEGER; attr: SET;
  699. BEGIN
  700. ASSERT(loc # NIL, 20); f := NIL; res := ok;
  701. WITH loc: Locator DO
  702. IF loc.path # "" THEN
  703. attr := BITS(WinApi.GetFileAttributesW(loc.path));
  704. IF attr = {0..MAX(SET)} THEN (* error *)
  705. res := WinApi.GetLastError();
  706. IF (res = fileNotFoundErr) OR (res = pathNotFoundErr) THEN
  707. IF loc.res = 76 THEN CreateDir(loc.path, res)
  708. ELSE CheckPath(loc.path, ask, res)
  709. END
  710. ELSE res := pathNotFoundErr
  711. END
  712. ELSIF WinApi.FILE_ATTRIBUTE_DIRECTORY * attr = {} THEN res := fileExistsErr
  713. END
  714. END;
  715. IF res = ok THEN
  716. NEW(f); f.loc := loc; f.name := "";
  717. f.state := new; f.swapper := -1; f.len := 0; f.ref := invalid
  718. END
  719. ELSE res := invalidNameErr
  720. END;
  721. loc.res := Error(res);
  722. RETURN f
  723. END New;
  724. PROCEDURE (d: Directory) Temp (): Files.File;
  725. VAR f: File;
  726. BEGIN
  727. NEW(f); f.loc := d.temp; f.name := "";
  728. f.state := temp; f.swapper := -1; f.len := 0; f.ref := invalid;
  729. RETURN f
  730. END Temp;
  731. PROCEDURE GetShadowDir (loc: Locator; OUT dir: FullName);
  732. VAR i, j: INTEGER;
  733. BEGIN
  734. dir := startupDir$; i := startupLen; j := loc.rootLen;
  735. WHILE loc.path[j] # 0X DO dir[i] := loc.path[j]; INC(i); INC(j) END;
  736. dir[i] := 0X
  737. END GetShadowDir;
  738. PROCEDURE (d: Directory) Old (loc: Files.Locator; name: Files.Name; shrd: BOOLEAN): Files.File;
  739. VAR res, i, j: INTEGER; f: File; ref: WinApi.HANDLE; fname: FullName; type: Files.Type; s: BYTE;
  740. BEGIN
  741. ASSERT(loc # NIL, 20); ASSERT(name # "", 21);
  742. res := ok; f := NIL;
  743. WITH loc: Locator DO
  744. Append(loc.path, name, "", loc.maxLen, fname);
  745. f := ThisFile(fname);
  746. IF f # NIL THEN
  747. IF ~shrd OR (f.state = exclusive) THEN loc.res := Error(sharingErr); RETURN NIL
  748. ELSE loc.res := ok; RETURN f
  749. END
  750. END;
  751. IF shrd THEN s := shared ELSE s := exclusive END;
  752. OpenFile(s, fname, ref, res);
  753. IF ((res = fileNotFoundErr) OR (res = pathNotFoundErr)) & (loc.rootLen > 0) THEN
  754. GetShadowDir(loc, fname);
  755. Append(fname, name, "", loc.maxLen, fname);
  756. f := ThisFile(fname);
  757. IF f # NIL THEN
  758. IF ~shrd OR (f.state = exclusive) THEN loc.res := Error(sharingErr); RETURN NIL
  759. ELSE loc.res := ok; RETURN f
  760. END
  761. END;
  762. OpenFile(s, fname, ref, res)
  763. END;
  764. IF res = ok THEN
  765. NEW(f); f.loc := loc;
  766. f.swapper := -1; i := 0;
  767. GetType(name, type);
  768. f.InitType(type);
  769. ASSERT(ref # invalid, 107);
  770. f.ref := ref; f.name := fname$; f.state := s; f.t := Kernel.Time();
  771. f.len := WinApi.GetFileSize(ref, j)
  772. END
  773. END;
  774. loc.res := Error(res);
  775. RETURN f
  776. END Old;
  777. PROCEDURE (d: Directory) Delete* (loc: Files.Locator; name: Files.Name);
  778. VAR res: INTEGER; fname: FullName;
  779. BEGIN
  780. ASSERT(loc # NIL, 20);
  781. WITH loc: Locator DO
  782. Append(loc.path, name, "", loc.maxLen, fname);
  783. Delete(fname, loc.path, res)
  784. ELSE res := invalidNameErr
  785. END;
  786. loc.res := Error(res)
  787. END Delete;
  788. PROCEDURE (d: Directory) Rename* (loc: Files.Locator; old, new: Files.Name; ask: BOOLEAN);
  789. VAR res, i: INTEGER; oldname, newname, tn: FullName; f: File; attr: SET;
  790. BEGIN
  791. ASSERT(loc # NIL, 20);
  792. WITH loc: Locator DO
  793. Append(loc.path, old, "", loc.maxLen, oldname); Append(loc.path, new, "", loc.maxLen, newname);
  794. attr :=BITS( WinApi.GetFileAttributesW(oldname));
  795. IF ORD(attr) # -1 THEN
  796. f := ThisFile(oldname);
  797. IF (f # NIL) & (f.ref # invalid) THEN res := WinApi.CloseHandle(f.ref); f.ref := invalid END;
  798. IF Diff(oldname, newname, loc.caseSens) # 0 THEN
  799. CheckDelete(newname, loc.path, ask, res);
  800. IF res = ok THEN
  801. IF WinApi.MoveFileW(oldname, newname) # 0 THEN
  802. IF f # NIL THEN (* still in use => update file table *)
  803. f.name := newname$
  804. END
  805. ELSE res := WinApi.GetLastError()
  806. END
  807. END
  808. ELSE (* destination is same file as source *)
  809. tn := oldname$; i := LEN(tn$) - 1;
  810. REPEAT
  811. tn[i] := CHR(ORD(tn[i]) + 1);
  812. IF WinApi.MoveFileW(oldname, tn) # 0 THEN res := ok
  813. ELSE res := WinApi.GetLastError()
  814. END
  815. UNTIL (res # fileExistsErr) & (res # alreadyExistsErr) & (res # 87);
  816. IF res = ok THEN
  817. IF WinApi.MoveFileW(tn, newname) = 0 THEN res := WinApi.GetLastError() END
  818. END
  819. END
  820. ELSE res := fileNotFoundErr
  821. END
  822. ELSE res := invalidNameErr
  823. END;
  824. loc.res := Error(res)
  825. END Rename;
  826. PROCEDURE (d: Directory) SameFile* (loc0: Files.Locator; name0: Files.Name;
  827. loc1: Files.Locator; name1: Files.Name): BOOLEAN;
  828. VAR p0, p1: FullName;
  829. BEGIN
  830. ASSERT(loc0 # NIL, 20); ASSERT(loc1 # NIL, 21);
  831. WITH loc0: Locator DO Append(loc0.path, name0, "", loc0.maxLen, p0) END;
  832. WITH loc1: Locator DO Append(loc1.path, name1, "", loc1.maxLen, p1) END;
  833. RETURN Diff(p0, p1, loc0(Locator).caseSens) = 0
  834. END SameFile;
  835. PROCEDURE (d: Directory) FileList* (loc: Files.Locator): Files.FileInfo;
  836. VAR i, res, diff: INTEGER; info, first, last: Files.FileInfo; s: FullName;
  837. find: WinApi.HANDLE; fd: WinApi.WIN32_FIND_DATAW; st: WinApi.SYSTEMTIME;
  838. BEGIN
  839. ASSERT(loc # NIL, 20);
  840. first := NIL; last :=NIL;
  841. WITH loc: Locator DO
  842. Append(loc.path, wildcard, wildcard, loc.maxLen, s);
  843. find := WinApi.FindFirstFileW(s, fd);
  844. IF find # invalid THEN
  845. REPEAT
  846. IF ~(WinApi.FILE_ATTRIBUTE_DIRECTORY * fd.dwFileAttributes # {})
  847. & (LEN(fd.cFileName$) < LEN(info.name)) THEN
  848. info := first; last := NIL; s := fd.cFileName$;
  849. WHILE (info # NIL) & (Diff(info.name, s, loc.caseSens) < 0) DO last := info; info := info.next END;
  850. NEW(info);
  851. info.name := fd.cFileName$;
  852. info.length := fd.nFileSizeLow;
  853. res := WinApi.FileTimeToSystemTime(fd.ftLastWriteTime, st);
  854. info.modified.year := st.wYear;
  855. info.modified.month := st.wMonth;
  856. info.modified.day := st.wDay;
  857. info.modified.hour := st.wHour;
  858. info.modified.minute := st.wMinute;
  859. info.modified.second := st.wSecond;
  860. info.attr := {};
  861. IF WinApi.FILE_ATTRIBUTE_HIDDEN * fd.dwFileAttributes # {} THEN
  862. INCL(info.attr, Files.hidden)
  863. END;
  864. IF WinApi.FILE_ATTRIBUTE_READONLY * fd.dwFileAttributes # {} THEN
  865. INCL(info.attr, Files.readOnly)
  866. END;
  867. IF WinApi.FILE_ATTRIBUTE_SYSTEM * fd.dwFileAttributes # {} THEN
  868. INCL(info.attr, Files.system)
  869. END;
  870. IF WinApi.FILE_ATTRIBUTE_ARCHIVE * fd.dwFileAttributes # {} THEN
  871. INCL(info.attr, Files.archive)
  872. END;
  873. GetType(fd.cFileName, info.type);
  874. IF last = NIL THEN info.next := first; first := info ELSE info.next := last.next; last.next := info END
  875. END;
  876. i := WinApi.FindNextFileW(find, fd)
  877. UNTIL i = 0;
  878. res := WinApi.GetLastError(); i := WinApi.FindClose(find)
  879. ELSE res := WinApi.GetLastError()
  880. END;
  881. IF res = noMoreFilesErr THEN res := ok END;
  882. (* check startup directory *)
  883. IF (loc.rootLen > 0) & ((res = ok) OR (res = fileNotFoundErr) OR (res = pathNotFoundErr)) THEN
  884. GetShadowDir(loc, s);
  885. Append(s, wildcard, wildcard, loc.maxLen, s);
  886. find := WinApi.FindFirstFileW(s, fd);
  887. IF find # invalid THEN
  888. REPEAT
  889. IF ~(WinApi.FILE_ATTRIBUTE_DIRECTORY * fd.dwFileAttributes # {})
  890. & (LEN(fd.cFileName$) < LEN(info.name)) THEN
  891. info := first; last := NIL; s := fd.cFileName$;
  892. IF info # NIL THEN diff := Diff(info.name, s, loc.caseSens) END;
  893. WHILE (info # NIL) & (diff < 0) DO
  894. last := info; info := info.next;
  895. IF info # NIL THEN diff := Diff(info.name, s, loc.caseSens) END
  896. END;
  897. IF (info = NIL) OR (diff # 0) THEN
  898. NEW(info);
  899. info.name := fd.cFileName$;
  900. info.length := fd.nFileSizeLow;
  901. res := WinApi.FileTimeToSystemTime(fd.ftLastWriteTime, st);
  902. info.modified.year := st.wYear;
  903. info.modified.month := st.wMonth;
  904. info.modified.day := st.wDay;
  905. info.modified.hour := st.wHour;
  906. info.modified.minute := st.wMinute;
  907. info.modified.second := st.wSecond;
  908. info.attr := {};
  909. IF WinApi.FILE_ATTRIBUTE_HIDDEN * fd.dwFileAttributes # {} THEN
  910. INCL(info.attr, Files.hidden)
  911. END;
  912. IF WinApi.FILE_ATTRIBUTE_READONLY * fd.dwFileAttributes # {} THEN
  913. INCL(info.attr, Files.readOnly)
  914. END;
  915. IF WinApi.FILE_ATTRIBUTE_SYSTEM * fd.dwFileAttributes # {} THEN
  916. INCL(info.attr, Files.system)
  917. END;
  918. IF WinApi.FILE_ATTRIBUTE_ARCHIVE * fd.dwFileAttributes # {} THEN
  919. INCL(info.attr, Files.archive)
  920. END;
  921. GetType(fd.cFileName, info.type);
  922. IF last = NIL THEN info.next := first; first := info ELSE info.next := last.next; last.next := info END
  923. END
  924. END;
  925. i := WinApi.FindNextFileW(find, fd)
  926. UNTIL i = 0;
  927. res := WinApi.GetLastError(); i := WinApi.FindClose(find)
  928. ELSE res := WinApi.GetLastError()
  929. END;
  930. IF res = noMoreFilesErr THEN res := ok END
  931. END;
  932. loc.res := Error(res)
  933. ELSE loc.res := invalidName
  934. END;
  935. RETURN first
  936. END FileList;
  937. PROCEDURE (d: Directory) LocList* (loc: Files.Locator): Files.LocInfo;
  938. VAR i, res, diff: INTEGER; first, last, info: Files.LocInfo; s: FullName;
  939. find: WinApi.HANDLE; fd: WinApi.WIN32_FIND_DATAW;
  940. BEGIN
  941. ASSERT(loc # NIL, 20);
  942. first := NIL; last :=NIL;
  943. WITH loc: Locator DO
  944. Append(loc.path, wildcard, wildcard, loc.maxLen, s);
  945. find := WinApi.FindFirstFileW(s, fd);
  946. IF find # invalid THEN
  947. REPEAT
  948. IF (WinApi.FILE_ATTRIBUTE_DIRECTORY * fd.dwFileAttributes # {})
  949. & (fd.cFileName[0] # ".") & (LEN(fd.cFileName$) < LEN(info.name)) THEN
  950. info := first; last := NIL; s := fd.cFileName$;
  951. WHILE (info # NIL) & (Diff(info.name, s, loc.caseSens) < 0) DO last := info; info := info.next END;
  952. NEW(info);
  953. info.name := fd.cFileName$;
  954. info.attr := {};
  955. IF WinApi.FILE_ATTRIBUTE_HIDDEN * fd.dwFileAttributes # {} THEN
  956. INCL(info.attr, Files.hidden)
  957. END;
  958. IF WinApi.FILE_ATTRIBUTE_READONLY * fd.dwFileAttributes # {} THEN
  959. INCL(info.attr, Files.readOnly)
  960. END;
  961. IF WinApi.FILE_ATTRIBUTE_SYSTEM * fd.dwFileAttributes # {} THEN
  962. INCL(info.attr, Files.system)
  963. END;
  964. IF WinApi.FILE_ATTRIBUTE_ARCHIVE * fd.dwFileAttributes # {} THEN
  965. INCL(info.attr, Files.archive)
  966. END;
  967. IF last = NIL THEN info.next := first; first := info ELSE info.next := last.next; last.next := info END
  968. END;
  969. i := WinApi.FindNextFileW(find, fd)
  970. UNTIL i = 0;
  971. res := WinApi.GetLastError(); i := WinApi.FindClose(find)
  972. ELSE res := WinApi.GetLastError()
  973. END;
  974. IF res = noMoreFilesErr THEN res := ok END;
  975. (* check startup directory *)
  976. IF (loc.rootLen > 0) & ((res = ok) OR (res = fileNotFoundErr) OR (res = pathNotFoundErr)) THEN
  977. GetShadowDir(loc, s);
  978. Append(s, wildcard, wildcard, loc.maxLen, s);
  979. find := WinApi.FindFirstFileW(s, fd);
  980. IF find # invalid THEN
  981. REPEAT
  982. IF (WinApi.FILE_ATTRIBUTE_DIRECTORY * fd.dwFileAttributes # {})
  983. & (fd.cFileName[0] # ".") & (LEN(fd.cFileName$) < LEN(info.name)) THEN
  984. info := first; last := NIL; s := fd.cFileName$;
  985. IF info # NIL THEN diff := Diff(info.name, s, loc.caseSens) END;
  986. WHILE (info # NIL) & (diff < 0) DO
  987. last := info; info := info.next;
  988. IF info # NIL THEN diff := Diff(info.name, s, loc.caseSens) END
  989. END;
  990. IF (info = NIL) OR (diff # 0) THEN
  991. NEW(info);
  992. info.name := fd.cFileName$;
  993. info.attr := {};
  994. IF WinApi.FILE_ATTRIBUTE_HIDDEN * fd.dwFileAttributes # {} THEN
  995. INCL(info.attr, Files.hidden)
  996. END;
  997. IF WinApi.FILE_ATTRIBUTE_READONLY * fd.dwFileAttributes # {} THEN
  998. INCL(info.attr, Files.readOnly)
  999. END;
  1000. IF WinApi.FILE_ATTRIBUTE_SYSTEM * fd.dwFileAttributes # {} THEN
  1001. INCL(info.attr, Files.system)
  1002. END;
  1003. IF WinApi.FILE_ATTRIBUTE_ARCHIVE * fd.dwFileAttributes # {} THEN
  1004. INCL(info.attr, Files.archive)
  1005. END;
  1006. IF last = NIL THEN info.next := first; first := info ELSE info.next := last.next; last.next := info END
  1007. END
  1008. END;
  1009. i := WinApi.FindNextFileW(find, fd)
  1010. UNTIL i = 0;
  1011. res := WinApi.GetLastError(); i := WinApi.FindClose(find)
  1012. ELSE res := WinApi.GetLastError()
  1013. END;
  1014. IF res = noMoreFilesErr THEN res := ok END
  1015. END;
  1016. loc.res := Error(res)
  1017. ELSE loc.res := invalidName
  1018. END;
  1019. RETURN first
  1020. END LocList;
  1021. PROCEDURE (d: Directory) GetFileName (name: Files.Name; type: Files.Type; OUT filename: Files.Name);
  1022. BEGIN
  1023. Append("", name, type, LEN(filename), filename)
  1024. END GetFileName;
  1025. (** Miscellaneous **)
  1026. PROCEDURE (VAR id: Counter) Identified (): BOOLEAN;
  1027. VAR f: File;
  1028. BEGIN
  1029. f := id.obj(File);
  1030. IF f.state # closed THEN INC(id.count) END;
  1031. RETURN FALSE
  1032. END Identified;
  1033. PROCEDURE NofFiles* (): INTEGER;
  1034. VAR p: ANYPTR; cnt: Counter;
  1035. BEGIN
  1036. cnt.typ := SYSTEM.TYP(File);
  1037. cnt.count := 0; p := Kernel.ThisFinObj(cnt);
  1038. RETURN cnt.count
  1039. END NofFiles;
  1040. PROCEDURE GetModDate* (f: Files.File; VAR year, month, day, hour, minute, second: INTEGER);
  1041. VAR res: INTEGER; ft: WinApi.FILETIME; st: WinApi.SYSTEMTIME;
  1042. BEGIN
  1043. ASSERT(f IS File, 20);
  1044. res := WinApi.GetFileTime(f(File).ref, NIL, NIL, ft);
  1045. res := WinApi.FileTimeToSystemTime(ft, st);
  1046. year := st.wYear; month := st.wMonth; day := st.wDay;
  1047. hour := st.wHour; minute := st.wMinute; second := st.wSecond
  1048. END GetModDate;
  1049. PROCEDURE SetRootDir* (path: ARRAY OF CHAR);
  1050. VAR i: INTEGER;
  1051. BEGIN
  1052. dir.startup := NewLocator(path);
  1053. dir.startup.rootLen := 0; i := 0;
  1054. WHILE startupDir[i] # 0X DO INC(i) END;
  1055. startupLen := i
  1056. END SetRootDir;
  1057. PROCEDURE GetName (VAR p: WinApi.PtrWSTR; VAR i: INTEGER; OUT name, opt: FullName);
  1058. VAR ch, tch: CHAR; j: INTEGER;
  1059. BEGIN
  1060. j := 0; ch := p[i]; tch := " ";
  1061. WHILE ch = " " DO INC(i); ch := p[i] END;
  1062. IF (ch = "'") OR (ch = '"') THEN tch := ch; INC(i); ch := p[i] END;
  1063. WHILE (ch >= " ") & (ch # tch) DO
  1064. name[j] := ch;
  1065. IF (ch >= "a") & (ch <= "z") OR (ch >= "à") & (ch <= "ö") OR (ch >= "ø") & (ch <= "þ") THEN ch := CAP(ch)
  1066. ELSIF ch = "-" THEN ch := "/"
  1067. END;
  1068. opt[j] := ch; INC(j); INC(i); ch := p[i]
  1069. END;
  1070. IF ch > " " THEN INC(i); ch := p[i] END;
  1071. WHILE (ch # 0X) & (ch <= " ") DO INC(i); ch := p[i] END;
  1072. name[j] := 0X; opt[j] := 0X
  1073. END GetName;
  1074. PROCEDURE Init;
  1075. VAR res, res1, i, j: INTEGER; path, opt, s: FullName; attr: SET; p: WinApi.PtrWSTR;
  1076. find: WinApi.HANDLE; fd: WinApi.WIN32_FIND_DATAW;
  1077. BEGIN
  1078. wildcard := "*"; NEW(dir);
  1079. res := WinApi.GetModuleFileNameW(0, path, LEN(path));
  1080. GetPath(path, startupDir);
  1081. dir.startup := NewLocator(startupDir);
  1082. dir.startup.rootLen := 0;
  1083. i := LEN(startupDir$); startupLen := i;
  1084. find := WinApi.FindFirstFileW(path, fd);
  1085. IF find # invalid THEN
  1086. appName := fd.cFileName$; res := WinApi.FindClose(find)
  1087. ELSE
  1088. INC(i); j := 0;
  1089. WHILE path[i] # 0X DO appName[j] := path[i]; INC(i); INC(j) END
  1090. END;
  1091. i := 0; j := -1;
  1092. WHILE appName[i] # 0X DO
  1093. IF appName[i] = "." THEN j := i END;
  1094. INC(i)
  1095. END;
  1096. IF j > 0 THEN appName[j] := 0X END;
  1097. p := WinApi.GetCommandLineW(); i := 0; res := 1;
  1098. REPEAT
  1099. GetName(p, i, path, opt);
  1100. IF opt = "/USE" THEN
  1101. GetName(p, i, path, opt);
  1102. res1 := WinApi.ExpandEnvironmentStringsW(path, s, LEN(s) - 2);
  1103. IF (res1 = 0) OR (res1 > LEN(s) - 2) THEN s := path ELSE path := s$ END;
  1104. attr := BITS(WinApi.GetFileAttributesW(s));
  1105. IF (attr # {0..MAX(SET)}) & (WinApi.FILE_ATTRIBUTE_DIRECTORY * attr # {}) THEN res := 0
  1106. ELSIF (path[1] = ":") & ((path[2] = 0X) OR (path[2] = "\") & (path[3] = 0X))
  1107. & (WinApi.GetDriveTypeW(s) >= 2) THEN res := 0
  1108. END
  1109. END
  1110. UNTIL (res = 0) OR (p[i] < " ");
  1111. IF serverVersion & (res = 0) THEN
  1112. i := LEN(path$);
  1113. IF (path[i-1] = "/") OR (path[i-1] = "\") THEN DEC(i); path[i] := 0X END;
  1114. dir.startup := NewLocator(path);
  1115. dir.startup.rootLen := i
  1116. END;
  1117. res := WinApi.GetTempPathW(LEN(path), path);
  1118. dir.temp := NewLocator(path);
  1119. Files.SetDir(dir)
  1120. END Init;
  1121. BEGIN
  1122. Init
  1123. END HostFiles.