Win32.HostFiles64.Mod 48 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285
  1. MODULE HostFiles64; (*AUTHOR "fof,ejz"; PURPOSE "Windows file system for WinAos"; *)
  2. IMPORT SYSTEM, Machine, Kernel32, KernelLog, Modules, Kernel, Files := Files64, Commands;
  3. CONST
  4. PathDelimiter = "\"; BufferSize = 4096;
  5. (** File flags *)
  6. ReadOnly* = Files.ReadOnly;
  7. Directory* = Files.Directory;
  8. Hidden* = Files.Hidden;
  9. System* = Files.System;
  10. Archive* = Files.Archive;
  11. Temporary* = Files.Temporary;
  12. TraceFile = 0; TraceFileSystem = 1; TraceCollection = 2; TraceSearch = 3; Trace = {};
  13. TraceMounting=FALSE;
  14. deviceArrival* = 08000H; (* DBT_DEVICEARRIVAL = 08000H *)
  15. deviceRemove* = 08004H; (* DBT_DEVICEREMOVECOMPLETE = 08004H *)
  16. TYPE
  17. FileName = ARRAY Kernel32.MaxPath OF CHAR;
  18. PFileName = POINTER TO FileName;
  19. NotificationProc* = PROCEDURE ( type: LONGINT; drives: SET );
  20. Notification = POINTER TO RECORD
  21. p: NotificationProc;
  22. next: Notification
  23. END;
  24. VAR
  25. searchPath: ARRAY 4 * Kernel32.MaxPath OF CHAR;
  26. workPath, tempPath: FileName; notifications: Notification;
  27. TYPE
  28. SearchByName = OBJECT
  29. VAR sname: FileName;
  30. found: File;
  31. PROCEDURE Init( name: ARRAY OF CHAR );
  32. BEGIN
  33. found := NIL; UpperCase( name, sname )
  34. END Init;
  35. PROCEDURE EnumFile( f: ANY; VAR cont: BOOLEAN );
  36. VAR F: File; fname: FileName;
  37. BEGIN
  38. F := f( File ); UpperCase( F.fname, fname );
  39. IF TraceSearch IN Trace THEN KernelLog.String( "Enumerate: " ); KernelLog.String( fname );
  40. END;
  41. IF sname = fname THEN found := F; cont := FALSE ELSE cont := TRUE END;
  42. IF TraceSearch IN Trace THEN
  43. IF cont THEN KernelLog.String( " # " ); ELSE KernelLog.String( " = " ); END;
  44. KernelLog.String( sname ); KernelLog.Ln;
  45. END;
  46. END EnumFile;
  47. END SearchByName;
  48. FinalizeFiles = OBJECT
  49. PROCEDURE EnumFile( f: ANY; VAR cont: BOOLEAN );
  50. VAR F: File;
  51. BEGIN
  52. F := f( File ); F.Finalize(); cont := TRUE
  53. END EnumFile;
  54. END FinalizeFiles;
  55. Collection = OBJECT (* methods in Collection shared by objects Filesystem and File *)
  56. VAR oldFiles, newFiles: Kernel.FinalizedCollection;
  57. search: SearchByName;
  58. fileKey: LONGINT;
  59. PROCEDURE & Init*;
  60. BEGIN
  61. NEW( oldFiles ); NEW( newFiles ); NEW( search ); fileKey := -1;
  62. END Init;
  63. PROCEDURE GetNextFileKey( ): LONGINT;
  64. BEGIN {EXCLUSIVE}
  65. DEC( fileKey ); RETURN fileKey
  66. END GetNextFileKey;
  67. PROCEDURE Register( F: File );
  68. BEGIN {EXCLUSIVE}
  69. IF TraceCollection IN Trace THEN KernelLog.String( "Collections.Register " ); KernelLog.String( F.fname ); KernelLog.Ln; END;
  70. oldFiles.Add( F, FinalizeFile ); newFiles.Remove( F ); DEC( fileKey ); F.Init( F.fname, F.hfile, fileKey,F.fileSystem );
  71. END Register;
  72. PROCEDURE Unregister( F: File );
  73. BEGIN {EXCLUSIVE}
  74. IF TraceCollection IN Trace THEN KernelLog.String( "Unregister " ); KernelLog.String( F.fname ); KernelLog.Ln; END;
  75. oldFiles.Remove( F ); newFiles.Add( F, FinalizeFile (* FinalizeFile*) ); F.Init( F.fname, Kernel32.InvalidHandleValue, 0, F.fileSystem );
  76. END Unregister;
  77. PROCEDURE AddNew( F: File );
  78. BEGIN {EXCLUSIVE}
  79. IF TraceCollection IN Trace THEN KernelLog.String( "Collections.AddNew: " ); KernelLog.String( F.fname ); KernelLog.Ln; END;
  80. newFiles.Add( F, FinalizeFile );
  81. END AddNew;
  82. PROCEDURE AddOld( F: File );
  83. BEGIN {EXCLUSIVE}
  84. IF TraceCollection IN Trace THEN KernelLog.String( "Collections.AddOld: " ); KernelLog.String( F.fname ); KernelLog.Ln; END;
  85. oldFiles.Add( F, FinalizeFile );
  86. END AddOld;
  87. PROCEDURE ByName( VAR fname: ARRAY OF CHAR ): File;
  88. BEGIN {EXCLUSIVE}
  89. IF TraceCollection IN Trace THEN KernelLog.String( "Collections.ByName: " ); KernelLog.String( fname ); KernelLog.Ln; END;
  90. search.Init( fname ); oldFiles.Enumerate( search.EnumFile ); RETURN search.found
  91. END ByName;
  92. PROCEDURE ByNameNotGC( VAR fname: ARRAY OF CHAR ): File;
  93. BEGIN {EXCLUSIVE}
  94. IF TraceCollection IN Trace THEN KernelLog.String( "Collections.ByName: " ); KernelLog.String( fname ); KernelLog.Ln; END;
  95. search.Init( fname ); oldFiles.EnumerateN( search.EnumFile ); RETURN search.found;
  96. END ByNameNotGC;
  97. PROCEDURE Finalize;
  98. VAR fin: FinalizeFiles;
  99. BEGIN {EXCLUSIVE}
  100. IF TraceCollection IN Trace THEN KernelLog.String( "Collections.Finalize " ); KernelLog.Ln; END;
  101. NEW( fin ); newFiles.Enumerate( fin.EnumFile ); newFiles.Clear(); oldFiles.Enumerate( fin.EnumFile ); oldFiles.Clear();
  102. END Finalize;
  103. PROCEDURE FinalizeFile( obj: ANY );
  104. VAR F: File;
  105. BEGIN
  106. F := obj( File );
  107. IF TraceCollection IN Trace THEN KernelLog.String( "Collections.FinalizeFile " ); KernelLog.String( F.fname ); KernelLog.Ln; END;
  108. F.Finalize()
  109. END FinalizeFile;
  110. END Collection;
  111. AliasFileSystem* = OBJECT (Files.FileSystem)
  112. VAR fs: WinFileSystem;
  113. useprefix*: BOOLEAN;
  114. PROCEDURE Prefix( CONST name: ARRAY OF CHAR; VAR res: ARRAY OF CHAR );
  115. BEGIN
  116. IF useprefix & (name # "") THEN Join( prefix, ":", name, res ); ELSE COPY( name, res ); END;
  117. END Prefix;
  118. PROCEDURE & Init*;
  119. BEGIN
  120. SELF.fs := winFS; useprefix := TRUE; INCL( flags, Files.NeedsPrefix );
  121. END Init;
  122. PROCEDURE New0*( name: ARRAY OF CHAR ): Files.File;
  123. VAR fname: FileName; f: Files.File;
  124. BEGIN
  125. Prefix( name, fname ); f := fs.New0( fname ); IF f # NIL THEN f.fs := SELF; END; RETURN f;
  126. END New0;
  127. PROCEDURE Old0*( name: ARRAY OF CHAR ): Files.File;
  128. VAR fname: FileName; f: Files.File;
  129. BEGIN
  130. Prefix( name, fname ); f := fs.Old0( fname ); IF f # NIL THEN f.fs := SELF; END; RETURN f;
  131. END Old0;
  132. PROCEDURE Delete0*( name: ARRAY OF CHAR; VAR key, res: LONGINT );
  133. VAR fname: FileName;
  134. BEGIN
  135. Prefix( name, fname ); fs.Delete0( fname, key, res );
  136. END Delete0;
  137. PROCEDURE Rename0*( old, new: ARRAY OF CHAR; fold: Files.File; VAR res: LONGINT );
  138. VAR old0, new0: FileName;
  139. BEGIN
  140. Prefix( old, old0 ); Prefix( new, new0 ); fs.Rename0( old0, new0, fold, res );
  141. END Rename0;
  142. PROCEDURE Enumerate0*( mask: ARRAY OF CHAR; flags: SET; enum: Files.Enumerator );
  143. VAR fmask: FileName;
  144. BEGIN
  145. Prefix( mask, fmask ); fs.Enumerate1( fmask, flags, enum, useprefix );
  146. END Enumerate0;
  147. PROCEDURE FileKey*( name: ARRAY OF CHAR ): LONGINT;
  148. VAR fname: FileName;
  149. BEGIN
  150. Prefix( name, fname ); RETURN fs.FileKey( fname );
  151. END FileKey;
  152. PROCEDURE CreateDirectory0*( name: ARRAY OF CHAR; VAR res: LONGINT );
  153. VAR fname: FileName;
  154. BEGIN
  155. Prefix( name, fname ); fs.CreateDirectory0( fname, res );
  156. END CreateDirectory0;
  157. PROCEDURE RemoveDirectory0*( name: ARRAY OF CHAR; force: BOOLEAN; VAR key, res: LONGINT );
  158. VAR fname: FileName;
  159. BEGIN
  160. Prefix( name, fname ); fs.RemoveDirectory0( fname, force, key, res );
  161. END RemoveDirectory0;
  162. PROCEDURE Has*(CONST name: ARRAY OF CHAR; VAR fullName: ARRAY OF CHAR; VAR flags: SET): BOOLEAN;
  163. VAR fname: FileName;
  164. BEGIN
  165. Prefix(name, fname ); RETURN fs.Has(fname, fullName, flags);
  166. END Has;
  167. END AliasFileSystem;
  168. WinFileSystem = OBJECT (* own object for synchronisation of all actions on the (unique) windows file system *)
  169. VAR collection: Collection;
  170. PROCEDURE & Init*;
  171. BEGIN
  172. NEW( collection );
  173. END Init;
  174. PROCEDURE New0( name: ARRAY OF CHAR ): Files.File;
  175. VAR F: File; fname: FileName;
  176. BEGIN {EXCLUSIVE}
  177. ConvertChar( name, Files.PathDelimiter, PathDelimiter );
  178. IF TraceFileSystem IN Trace THEN KernelLog.String( "New0 " ); KernelLog.String( name ); KernelLog.Ln; END;
  179. F := NIL;
  180. IF name = "" THEN (* temporary file *)
  181. NEW( F, name, Kernel32.InvalidHandleValue, 0, SELF ); collection.AddNew( F );
  182. ELSIF FullPathName( name, fname ) & CheckPath(fname) THEN
  183. NEW( F, fname, Kernel32.InvalidHandleValue, 0, SELF ); collection.AddNew( F );
  184. END;
  185. IF TraceFileSystem IN Trace THEN KernelLog.String( "failed" ); KernelLog.Ln; END;
  186. RETURN F;
  187. END New0;
  188. PROCEDURE Old0( name: ARRAY OF CHAR ): Files.File;
  189. VAR F: File; hfile: Kernel32.HANDLE; fname: FileName;
  190. BEGIN {EXCLUSIVE}
  191. ConvertChar( name, Files.PathDelimiter, PathDelimiter );
  192. IF TraceFileSystem IN Trace THEN KernelLog.String( "Old0 " ); KernelLog.String( name ); KernelLog.Ln; END;
  193. IF (name # "") & FindFile( name, fname ) THEN
  194. hfile := Kernel32.CreateFile( fname, Kernel32.SetToDW({Kernel32.GenericRead}), Kernel32.SetToDW({Kernel32.FileShareRead, Kernel32.FileShareWrite}), NIL , Kernel32.OpenExisting, Kernel32.SetToDW({Kernel32.FileAttributeNormal}), 0 );
  195. IF hfile # Kernel32.InvalidHandleValue THEN NEW( F, fname, hfile, collection.GetNextFileKey() , SELF); collection.AddOld( F ); RETURN F END
  196. END;
  197. IF TraceFileSystem IN Trace THEN KernelLog.String( "failed" ); KernelLog.Ln; END;
  198. RETURN NIL
  199. END Old0;
  200. PROCEDURE Delete0( name: ARRAY OF CHAR; VAR key, res: LONGINT );
  201. VAR fname: FileName; F: File; ret: Kernel32.BOOL;
  202. BEGIN {EXCLUSIVE}
  203. ConvertChar( name, Files.PathDelimiter, PathDelimiter ); key := 0; res := 1;
  204. IF FullPathName( name, fname ) THEN
  205. F := collection.ByName( fname );
  206. IF F # NIL THEN
  207. key := F.key;
  208. IF F.ToTemp() THEN res := 0 END;
  209. ELSE
  210. ret := Kernel32.DeleteFile( fname );
  211. IF ret # 0 THEN res := 0 END
  212. END
  213. END
  214. END Delete0;
  215. PROCEDURE Rename0( old, new: ARRAY OF CHAR; fold: Files.File; VAR res: LONGINT );
  216. VAR fnold, fnnew: FileName; Fo, Fn: File; ret: Kernel32.BOOL;
  217. BEGIN {EXCLUSIVE}
  218. IF TraceFileSystem IN Trace THEN KernelLog.String( "Rename " ); KernelLog.String( old ); KernelLog.String( " -> " ); KernelLog.String( new ); KernelLog.Ln; END;
  219. ConvertChar( old, Files.PathDelimiter, PathDelimiter ); ConvertChar( new, Files.PathDelimiter, PathDelimiter ); res := 1;
  220. IF FullPathName( old, fnold ) & FullPathName( new, fnnew ) THEN
  221. Fn := collection.ByName( fnnew );
  222. IF Fn # NIL THEN
  223. IF ~Fn.ToTemp() THEN RETURN END
  224. END;
  225. IF fold # NIL THEN
  226. Fo := fold( File );
  227. IF ~Fo.ToTemp() THEN RETURN END;
  228. ret := Kernel32.CopyFile( Fo.tfname^, fnnew, 0 )
  229. ELSE ret := Kernel32.MoveFileEx( fnold, fnnew, Kernel32.SetToDW({Kernel32.MoveFileReplaceExisting, Kernel32.MoveFileCopyAllowed}) )
  230. END;
  231. IF ret # 0 THEN res := 0 END
  232. ELSIF TraceFileSystem IN Trace THEN KernelLog.String( "Rename failed :" ); KernelLog.String( fnold ); KernelLog.String( " => " ); KernelLog.String( fnnew ); KernelLog.Ln;
  233. END
  234. END Rename0;
  235. PROCEDURE Enumerate1( mask: ARRAY OF CHAR; flags: SET; enum: Files.Enumerator; useprefix: BOOLEAN );
  236. VAR i, j: LONGINT;
  237. path, pattern: ARRAY 256 OF CHAR;
  238. attr: SET; curPath, longname: FileName;
  239. PROCEDURE EnumeratePath;
  240. VAR h: Kernel32.HANDLE; FD: Kernel32.FindData; ft: Kernel32.FileTime; st: Kernel32.SystemTime; i, j, t, d: LONGINT;
  241. BEGIN
  242. i := 0;
  243. WHILE curPath[i] # 0X DO INC( i ) END;
  244. IF curPath[i - 1] # PathDelimiter THEN curPath[i] := PathDelimiter; INC( i ); curPath[i] := 0X END;
  245. j := i - 1; h := 0;
  246. WHILE pattern[h] # 0X DO curPath[i] := pattern[h]; INC( i ); INC( h ) END;
  247. IF h = 0 THEN curPath[i] := "*"; INC( i ); curPath[i] := "."; INC( i ); curPath[i] := "*"; INC( i ) END;
  248. curPath[i] := 0X;
  249. h := Kernel32.FindFirstFile( curPath, FD ); curPath[j] := 0X; ConvertChar( curPath, PathDelimiter, Files.PathDelimiter ); FixDriveLetter (curPath);
  250. IF h # Kernel32.InvalidHandleValue THEN
  251. t := 0; d := 0;
  252. REPEAT
  253. IF Files.EnumTime IN flags THEN
  254. Kernel32.FileTimeToLocalFileTime( FD.ftLastWriteTime, ft ); Kernel32.FileTimeToSystemTime( ft, st );
  255. d := LONG( st.wYear - 1900 ) * 200H + LONG( st.wMonth ) * 20H + LONG( st.wDay ); t := LONG( st.wHour ) * 1000H + LONG( st.wMinute ) * 40H + LONG( st.wSecond );
  256. END;
  257. Join( curPath, "/", FD.cFileName, longname );
  258. IF ~(Kernel32.FileAttributeDirectory IN Kernel32.DWToSet(FD.dwFileAttributes)) THEN
  259. enum.PutEntry( longname, {}, t, d, HUGEINT(UNSIGNED64( FD.nFileSizeHigh ) * UNSIGNED64( 0x100000000 ) + UNSIGNED64( FD.nFileSizeLow )))
  260. ELSIF (FD.cFileName # ".") & (FD.cFileName # "..") THEN
  261. enum.PutEntry( longname, {Files.Directory}, t, d, HUGEINT(UNSIGNED64( FD.nFileSizeHigh ) * UNSIGNED64( 0x100000000 ) + UNSIGNED64( FD.nFileSizeLow )))
  262. END;
  263. UNTIL Kernel32.FindNextFile( h, FD ) = Kernel32.False;
  264. Kernel32.FindClose( h )
  265. END;
  266. END EnumeratePath;
  267. BEGIN {EXCLUSIVE}
  268. COPY( mask, path ); ConvertChar( path, Files.PathDelimiter, PathDelimiter ); attr := ToSet(Kernel32.GetFileAttributes( path )); path := "";
  269. IF (Kernel32.FileAttributeDirectory IN attr) & (~(Kernel32.FileAttributeTemporary IN attr)) THEN COPY( mask, path ); COPY( "*", pattern ); ELSE Files.SplitPath( mask, path, pattern ); END;
  270. IF TraceFileSystem IN Trace THEN
  271. KernelLog.String( "Enumerate0: " ); KernelLog.String( mask ); KernelLog.String( " :: " ); KernelLog.String( path ); KernelLog.String( " :: " ); KernelLog.String( pattern ); KernelLog.Ln;
  272. END;
  273. IF enum = NIL THEN RETURN
  274. END;
  275. IF path = "." THEN COPY( workPath, curPath ); EnumeratePath()
  276. ELSIF IsLocalPath(path) THEN
  277. COPY( workPath, curPath );
  278. IF path # "" THEN
  279. ConvertChar(curPath, PathDelimiter, Files.PathDelimiter);
  280. Files.JoinPath(curPath, path, curPath);
  281. ConvertChar( curPath, Files.PathDelimiter, PathDelimiter );
  282. END;
  283. EnumeratePath();
  284. IF ~useprefix THEN
  285. i := 0; j := 0;
  286. WHILE searchPath[i] # 0X DO
  287. IF searchPath[i] # ";" THEN curPath[j] := searchPath[i]; INC( j )
  288. ELSIF j > 0 THEN
  289. curPath[j] := 0X;
  290. IF curPath # workPath THEN
  291. IF path # "" THEN
  292. ConvertChar(curPath, PathDelimiter, Files.PathDelimiter);
  293. Files.JoinPath(curPath, path, curPath);
  294. ConvertChar( curPath, Files.PathDelimiter, PathDelimiter );
  295. END;
  296. EnumeratePath()
  297. END;
  298. j := 0
  299. END;
  300. INC( i )
  301. END;
  302. IF j > 0 THEN
  303. curPath[j] := 0X;
  304. IF path # "" THEN
  305. ConvertChar(curPath, PathDelimiter, Files.PathDelimiter);
  306. Files.JoinPath(curPath, path, curPath);
  307. ConvertChar( curPath, Files.PathDelimiter, PathDelimiter );
  308. END;
  309. IF curPath # workPath THEN EnumeratePath() END
  310. END;
  311. END;
  312. ELSE (* path is an absolute path *)
  313. COPY( path, curPath ); ConvertChar( curPath, Files.PathDelimiter, PathDelimiter ); EnumeratePath()
  314. END;
  315. END Enumerate1;
  316. PROCEDURE FileKey( name: ARRAY OF CHAR ): LONGINT;
  317. VAR fname: FileName; F: File;
  318. BEGIN {EXCLUSIVE}
  319. (*RETURN 0; (* Finalizers may steal file *) *)
  320. IF name = "" THEN RETURN 0 END;
  321. IF TraceFileSystem IN Trace THEN KernelLog.String( "FileKey " ); KernelLog.String( name ); KernelLog.Ln;
  322. END;
  323. ConvertChar( name, Files.PathDelimiter, PathDelimiter );
  324. IF FindFile( name, fname ) (* OR FullPathName(name,fname) *) THEN
  325. F := collection.ByNameNotGC( fname );
  326. IF F # NIL THEN RETURN F.key END
  327. ELSIF TraceFileSystem IN Trace THEN KernelLog.String( "not found: " ); KernelLog.String( name ); KernelLog.String( "(" ); KernelLog.String( fname ); KernelLog.String( ")" ); KernelLog.Ln;
  328. END;
  329. IF TraceFileSystem IN Trace THEN KernelLog.String( "no key: " ); KernelLog.String( name ); KernelLog.String( "(" ); KernelLog.String( fname ); KernelLog.String( ")" ); KernelLog.Ln; END;
  330. RETURN 0
  331. END FileKey;
  332. PROCEDURE CreateDirectory0( name: ARRAY OF CHAR; VAR res: LONGINT );
  333. VAR ret: Kernel32.BOOL;
  334. BEGIN {EXCLUSIVE}
  335. ConvertChar( name, Files.PathDelimiter, PathDelimiter ); ret := Kernel32.CreateDirectory( name, NIL );
  336. IF ret # 0 THEN
  337. res := 0;
  338. ELSIF Kernel32.GetLastError() = 183 (*ERROR_ALREADY_EXISTS*) THEN
  339. res := Files.FileAlreadyExists;
  340. ELSE
  341. res := 1
  342. END
  343. END CreateDirectory0;
  344. PROCEDURE RemoveDirectory0( name: ARRAY OF CHAR; force: BOOLEAN; VAR key, res: LONGINT );
  345. VAR ret: Kernel32.BOOL;
  346. BEGIN {EXCLUSIVE}
  347. ConvertChar( name, Files.PathDelimiter, PathDelimiter ); key := 0; res := 1;
  348. IF ~force THEN
  349. ret := Kernel32.RemoveDirectory( name );
  350. IF ret # 0 THEN res := 0 END
  351. ELSE res := -1
  352. END
  353. END RemoveDirectory0;
  354. PROCEDURE Finalize;
  355. BEGIN
  356. collection.Finalize();
  357. END Finalize;
  358. PROCEDURE Has*(CONST fileName: ARRAY OF CHAR; VAR fullName: ARRAY OF CHAR; VAR flags: SET): BOOLEAN;
  359. VAR name: FileName;
  360. BEGIN
  361. COPY(fileName, name);
  362. ConvertChar(name, Files.PathDelimiter, PathDelimiter );
  363. IF FindFile(fileName, fullName) THEN
  364. flags := FileFlags(ToSet(Kernel32.GetFileAttributes(fullName)));
  365. ConvertChar(fullName, PathDelimiter,Files.PathDelimiter);
  366. RETURN TRUE
  367. ELSE
  368. RETURN FALSE
  369. END;
  370. END Has;
  371. END WinFileSystem;
  372. Buffer = POINTER TO RECORD
  373. data: ARRAY BufferSize OF CHAR;
  374. apos: HUGEINT;
  375. len: LONGINT;
  376. dirty: BOOLEAN
  377. END;
  378. File* = OBJECT (Files.File)
  379. VAR fname: FileName;
  380. tfname: PFileName;
  381. hfile: Kernel32.HANDLE;
  382. buffer: Buffer;
  383. fsize, fpos: HUGEINT;
  384. fileSystem: WinFileSystem;
  385. PROCEDURE & Init*( VAR name: ARRAY OF CHAR; hfile: Kernel32.HANDLE; key: LONGINT ; fs: WinFileSystem);
  386. VAR s: SET; res: Kernel32.BOOL;
  387. BEGIN
  388. IF TraceFile IN Trace THEN KernelLog.String( "Init: " ); KernelLog.String( name ); KernelLog.String( " (" ); KernelLog.Int( key, 1 ); KernelLog.String( ")" ); KernelLog.Ln; END;
  389. SELF.key := key; fpos := 0; SELF.hfile := hfile; COPY( name, SELF.fname ); tfname := NIL;
  390. IF hfile # Kernel32.InvalidHandleValue THEN
  391. ASSERT(Kernel32.GetFileSizeEx(hfile, fsize) # Kernel32.False);
  392. s := ToSet(Kernel32.GetFileAttributes( name ));
  393. IF Kernel32.FileAttributeTemporary IN s THEN EXCL( s, Kernel32.FileAttributeTemporary ); res := Kernel32.SetFileAttributes( name, Kernel32.SetToDW(s) ); ASSERT( res # 0 ); s := ToSet(Kernel32.GetFileAttributes( name )) END;
  394. flags := FileFlags( s )
  395. ELSE flags := {Temporary}; fsize := 0
  396. END;
  397. IF buffer = NIL THEN NEW( buffer ); END;
  398. buffer.apos := -1; buffer.len := 0; buffer.dirty := FALSE;
  399. fileSystem := fs
  400. END Init;
  401. PROCEDURE Set*( VAR r: Files.Rider; pos: HUGEINT );
  402. VAR size: HUGEINT;
  403. BEGIN {EXCLUSIVE}
  404. IF hfile # Kernel32.InvalidHandleValue THEN
  405. ASSERT( Kernel32.GetFileSizeEx( hfile, size ) # Kernel32.False ); (* maybe Windows has modified the file since last access, but we ignore file changes once the file rider is set *)
  406. IF size > fsize THEN fsize := size END;
  407. END;
  408. r.eof := FALSE; r.res := 0; r.file := SELF; r.fs := fs;
  409. IF pos < 0 THEN pos := 0
  410. ELSIF pos > fsize THEN pos := fsize
  411. END;
  412. r.apos := pos DIV BufferSize; r.bpos := LONGINT( pos MOD BufferSize )
  413. END Set;
  414. PROCEDURE Pos*( VAR r: Files.Rider ): HUGEINT;
  415. BEGIN
  416. RETURN r.apos * BufferSize + r.bpos
  417. END Pos;
  418. PROCEDURE WriteBuffer;
  419. VAR pos: HUGEINT; n: LONGINT; res, b: Kernel32.BOOL;
  420. BEGIN
  421. ASSERT( buffer.dirty ); ASSERT( buffer.len > 0 );
  422. pos := buffer.apos * BufferSize;
  423. IF hfile = Kernel32.InvalidHandleValue THEN
  424. ASSERT( Temporary IN flags ); NEW( tfname ); TempName( tfname^ );
  425. hfile := Kernel32.CreateFile( tfname^, Kernel32.SetToDW({Kernel32.GenericRead, Kernel32.GenericWrite}), Kernel32.SetToDW({Kernel32.FileShareRead}), NIL , Kernel32.CreateAlways, Kernel32.SetToDW({Kernel32.FileAttributeTemporary}), 0 );
  426. ASSERT( hfile # Kernel32.InvalidHandleValue ); fpos := 0
  427. END;
  428. IF fpos # pos THEN ASSERT( Kernel32.SetFilePointerEx( hfile, pos, fpos , Kernel32.FileBegin ) # Kernel32.False ); END;
  429. res := Kernel32.WriteFile( hfile, buffer.data, buffer.len, n, NIL );
  430. IF (res = Kernel32.False) & ~(ReadOnly IN flags) THEN
  431. res := Kernel32.CloseHandle( hfile );
  432. IF TraceFile IN Trace THEN KernelLog.String( "closed handle of " ); KernelLog.String( fname ); KernelLog.Ln; END;
  433. hfile :=
  434. Kernel32.CreateFile( fname, Kernel32.SetToDW({Kernel32.GenericRead, Kernel32.GenericWrite}), Kernel32.SetToDW({Kernel32.FileShareRead, Kernel32.FileShareWrite}), NIL , Kernel32.OpenExisting, Kernel32.SetToDW({Kernel32.FileAttributeNormal}), 0 );
  435. ASSERT( hfile # Kernel32.InvalidHandleValue );
  436. ASSERT( Kernel32.SetFilePointerEx( hfile, pos, fpos , Kernel32.FileBegin ) # Kernel32.False );
  437. res := Kernel32.WriteFile( hfile, buffer.data, buffer.len, n, NIL )
  438. END;
  439. ASSERT( (res # Kernel32.False) & (n = buffer.len) );
  440. INC( fpos, n ); buffer.dirty := FALSE
  441. END WriteBuffer;
  442. PROCEDURE ReadBuffer( apos: HUGEINT );
  443. VAR pos: HUGEINT; n: LONGINT; res, b: Kernel32.BOOL;
  444. BEGIN
  445. IF buffer.dirty THEN WriteBuffer() END;
  446. pos := apos * BufferSize;
  447. IF pos >= fsize THEN buffer.apos := apos; buffer.len := 0; RETURN END;
  448. IF fpos # pos THEN
  449. ASSERT( Kernel32.SetFilePointerEx( hfile, pos, fpos , Kernel32.FileBegin ) # Kernel32.False );
  450. IF (fpos # pos) THEN KernelLog.String( "failed to set buffer: " ); KernelLog.String( fname ); KernelLog.Ln END;
  451. ASSERT( fpos = pos )
  452. END;
  453. res := Kernel32.ReadFile( hfile, buffer.data, BufferSize, n, NIL );
  454. IF res = 0 THEN KernelLog.String( "read file did not work for: " ); KernelLog.String( fname ); KernelLog.Ln; END;
  455. ASSERT( res # 0 ); INC( fpos, n ); buffer.apos := apos; buffer.len := n
  456. END ReadBuffer;
  457. PROCEDURE Read*( VAR r: Files.Rider; VAR x: CHAR );
  458. VAR pos: HUGEINT;
  459. BEGIN {EXCLUSIVE}
  460. pos := r.apos * BufferSize + r.bpos;
  461. IF pos < fsize THEN
  462. IF buffer.apos # r.apos THEN ReadBuffer( r.apos ) END;
  463. x := buffer.data[r.bpos]; INC( pos ); r.apos := pos DIV BufferSize; r.bpos := LONGINT( pos MOD BufferSize )
  464. ELSE
  465. x := 0X; r.eof := TRUE
  466. END
  467. END Read;
  468. PROCEDURE ReadBytes*( VAR r: Files.Rider; VAR x: ARRAY OF CHAR; ofs, len: LONGINT );
  469. VAR pos: HUGEINT; n: LONGINT;
  470. BEGIN {EXCLUSIVE}
  471. ASSERT( (ofs + len) <= LEN( x ) );
  472. pos := r.apos * BufferSize + r.bpos;
  473. WHILE (len > 0) & (pos < fsize) DO
  474. IF buffer.apos # r.apos THEN ReadBuffer( r.apos ) END;
  475. n := buffer.len - r.bpos;
  476. IF (n > 0) THEN
  477. IF n > len THEN n := len END;
  478. SYSTEM.MOVE( ADDRESSOF( buffer.data[r.bpos] ), ADDRESSOF( x[ofs] ), n );
  479. INC( pos, n ); INC( ofs, n ); DEC( len, n );
  480. r.apos := pos DIV BufferSize; r.bpos := LONGINT( pos MOD BufferSize );
  481. ELSE
  482. pos := fsize;
  483. END;
  484. END;
  485. r.res := len; r.eof := (pos > fsize) OR ((pos = fsize) & (len > 0));
  486. END ReadBytes;
  487. PROCEDURE Write*( VAR r: Files.Rider; x: CHAR );
  488. VAR pos: HUGEINT;
  489. BEGIN {EXCLUSIVE}
  490. pos := r.apos * BufferSize + r.bpos;
  491. IF buffer.apos # r.apos THEN ReadBuffer( r.apos ) END;
  492. buffer.data[r.bpos] := x; INC( pos );
  493. IF (r.bpos + 1) > buffer.len THEN buffer.len := r.bpos + 1 END;
  494. r.apos := pos DIV BufferSize; r.bpos := LONGINT( pos MOD BufferSize );
  495. IF pos > fsize THEN fsize := pos END;
  496. buffer.dirty := TRUE;
  497. END Write;
  498. PROCEDURE WriteBytes*( VAR r: Files.Rider; CONST x: ARRAY OF CHAR; ofs, len: LONGINT );
  499. VAR pos: HUGEINT; n: LONGINT;
  500. BEGIN {EXCLUSIVE}
  501. IF len = 0 THEN RETURN END;
  502. ASSERT( (len > 0) & ((ofs + len) <= LEN( x )) ); pos := r.apos * BufferSize + r.bpos;
  503. WHILE len > 0 DO
  504. IF buffer.apos # r.apos THEN ReadBuffer( r.apos ) END;
  505. n := BufferSize - r.bpos;
  506. IF n > len THEN n := len END;
  507. SYSTEM.MOVE( ADDRESSOF( x[ofs] ), ADDRESSOF( buffer.data[r.bpos] ), n );
  508. IF (r.bpos + n) > buffer.len THEN buffer.len := r.bpos + n END;
  509. INC( pos, n ); INC( ofs, n ); DEC( len, n ); r.apos := pos DIV BufferSize; r.bpos := LONGINT( pos MOD BufferSize );
  510. IF pos > fsize THEN fsize := pos END;
  511. buffer.dirty := TRUE
  512. END
  513. END WriteBytes;
  514. PROCEDURE Length*( ): HUGEINT;
  515. BEGIN {EXCLUSIVE}
  516. RETURN fsize
  517. END Length;
  518. PROCEDURE GetDate*( VAR t, d: LONGINT );
  519. VAR ft, lft: Kernel32.FileTime; st: Kernel32.SystemTime; res: Kernel32.BOOL;
  520. BEGIN {EXCLUSIVE}
  521. res := Kernel32.GetFileTime( hfile, NIL , NIL , ft );
  522. (*
  523. ASSERT ( res # 0 ); (* <- only if file is not temporary ! *)
  524. *)
  525. res := Kernel32.FileTimeToLocalFileTime( ft, lft ); res := Kernel32.FileTimeToSystemTime( lft, st ); d := LONG( st.wYear - 1900 ) * 200H + LONG( st.wMonth ) * 20H + LONG( st.wDay );
  526. t := LONG( st.wHour ) * 1000H + LONG( st.wMinute ) * 40H + LONG( st.wSecond )
  527. END GetDate;
  528. PROCEDURE SetDate*( t, d: LONGINT );
  529. VAR ft, lft: Kernel32.FileTime; st: Kernel32.SystemTime; res: Kernel32.BOOL; err: LONGINT;
  530. BEGIN {EXCLUSIVE}
  531. st.wDay := SHORT( d MOD 20H ); d := ASH( d, -5 ); st.wMonth := SHORT( d MOD 10H ); d := ASH( d, -4 ); st.wYear := SHORT( d MOD 80H ) + 1900; st.wMilliseconds := 0;
  532. st.wSecond := SHORT( t MOD 40H ); t := ASH( t, -6 ); st.wMinute := SHORT( t MOD 40H ); t := ASH( t, -6 ); st.wHour := SHORT( t MOD 20H ); res := Kernel32.SystemTimeToFileTime( st, lft );
  533. res := Kernel32.LocalFileTimeToFileTime( lft, ft ); res := Kernel32.SetFileTime( hfile, NIL , NIL , ft );
  534. IF res = 0 THEN err := Kernel32.GetLastError(); DebugFile(SELF) END;
  535. ASSERT( res # 0 )
  536. END SetDate;
  537. PROCEDURE GetAttributes*(): SET;
  538. VAR s: SET;
  539. BEGIN
  540. s := ToSet(Kernel32.GetFileAttributes( fname ));
  541. RETURN FileFlags(s);
  542. END GetAttributes;
  543. PROCEDURE SetAttributes*(a: SET);
  544. VAR s: SET;
  545. BEGIN
  546. s:= WindowsFlags(a);
  547. SetFileAttributes(fname,s);
  548. END SetAttributes;
  549. PROCEDURE GetName*( VAR name: ARRAY OF CHAR );
  550. VAR i: LONGINT; ch: CHAR;
  551. BEGIN {EXCLUSIVE}
  552. COPY( fname, name ); i := 0; ch := name[0];
  553. WHILE ch # 0X DO
  554. IF ch = PathDelimiter THEN name[i] := Files.PathDelimiter END;
  555. INC( i ); ch := name[i]
  556. END
  557. END GetName;
  558. PROCEDURE ToTemp( ): BOOLEAN;
  559. VAR tfname: PFileName; res: Kernel32.BOOL;
  560. from, to: ARRAY 256 OF CHAR;
  561. BEGIN {EXCLUSIVE}
  562. ASSERT( ~(Temporary IN flags) );
  563. (*ALEX 2005.12.08*)
  564. IF hfile = Kernel32.InvalidHandleValue THEN
  565. hfile := Kernel32.CreateFile( fname, Kernel32.SetToDW({Kernel32.GenericRead}), Kernel32.SetToDW({Kernel32.FileShareRead, Kernel32.FileShareWrite}), NIL , Kernel32.CreateAlways, Kernel32.SetToDW({Kernel32.FileAttributeNormal}), 0 );
  566. END;
  567. IF hfile = Kernel32.InvalidHandleValue THEN
  568. hfile := Kernel32.CreateFile( fname, Kernel32.SetToDW({Kernel32.GenericRead}), Kernel32.SetToDW({Kernel32.FileShareRead, Kernel32.FileShareWrite}), NIL , Kernel32.OpenExisting, Kernel32.SetToDW({Kernel32.FileAttributeNormal}), 0 );
  569. END;
  570. IF buffer.dirty THEN WriteBuffer() END;
  571. (*
  572. IF hfile # Kernel32.InvalidHandleValue THEN
  573. *)
  574. ASSERT(hfile # Kernel32.InvalidHandleValue);
  575. ASSERT(Kernel32.GetFileSizeEx(hfile, fsize) # Kernel32.False);
  576. res := Kernel32.CloseHandle( hfile );
  577. hfile := Kernel32.InvalidHandleValue;
  578. (*
  579. END;
  580. *)
  581. NEW( tfname ); TempName( tfname^ ); COPY( fname, from ); COPY( tfname^, to );
  582. IF TraceFile IN Trace THEN KernelLog.String( "toTemp: " ); KernelLog.String( fname ); KernelLog.String( " => " ); KernelLog.String( tfname^ ); KernelLog.Ln; END;
  583. IF ~MoveFile( fname, tfname^ ) THEN HALT( 1241 ) (* RETURN FALSE *) END;
  584. winFS.collection.Unregister( SELF );
  585. hfile := Kernel32.CreateFile( tfname^, Kernel32.SetToDW({Kernel32.GenericRead, Kernel32.GenericWrite}), Kernel32.SetToDW({Kernel32.FileShareRead}), NIL , Kernel32.OpenExisting, Kernel32.SetToDW({Kernel32.FileAttributeTemporary}), 0 );
  586. (* IF hfile = Kernel32.InvalidHandleValue THEN RETURN FALSE END; *)
  587. ASSERT( hfile # Kernel32.InvalidHandleValue );
  588. ASSERT( Kernel32.GetFileSizeEx( hfile, fsize ) # Kernel32.False );
  589. SELF.tfname := tfname;
  590. COPY( tfname^, fname );
  591. RETURN TRUE;
  592. END ToTemp;
  593. PROCEDURE Register0*( VAR res: LONGINT );
  594. VAR F: File; ret: Kernel32.BOOL;
  595. from, to: ARRAY 256 OF CHAR;
  596. BEGIN {EXCLUSIVE}
  597. IF ~(Temporary IN flags) OR (fname = "") THEN res := 1; RETURN END;
  598. IF buffer.dirty THEN WriteBuffer() END;
  599. IF hfile # Kernel32.InvalidHandleValue THEN ret := Kernel32.CloseHandle( hfile ); hfile := Kernel32.InvalidHandleValue END;
  600. IF TraceFile IN Trace THEN KernelLog.String( "Register: existing?: " ); KernelLog.String( fname ); KernelLog.Ln; END;
  601. F := winFS.collection.ByName( fname );
  602. IF (TraceFile IN Trace) & (F = NIL ) THEN KernelLog.String( "Register: not existing: " ); KernelLog.String( fname ); KernelLog.Ln; END;
  603. IF (F # NIL ) THEN
  604. IF ~F.ToTemp() THEN res := 1; RETURN END
  605. END; (* registered file stays alive for its users *)
  606. IF tfname # NIL THEN
  607. COPY( tfname^, from ); COPY( fname, to );
  608. IF ~MoveFile( tfname^, fname ) THEN
  609. (* first try closing file -> for windows versions < 2000 *)
  610. res := 1; RETURN;
  611. (* HALT( 1242 )*)
  612. END;
  613. hfile := Kernel32.CreateFile( fname, Kernel32.SetToDW({Kernel32.GenericRead, Kernel32.GenericWrite}), Kernel32.SetToDW({Kernel32.FileShareRead, Kernel32.FileShareWrite}), NIL , Kernel32.OpenExisting, Kernel32.SetToDW({Kernel32.FileAttributeNormal}), 0 )
  614. ELSE hfile := Kernel32.CreateFile( fname, Kernel32.SetToDW({Kernel32.GenericRead, Kernel32.GenericWrite}), Kernel32.SetToDW({Kernel32.FileShareRead, Kernel32.FileShareWrite}), NIL , Kernel32.CreateAlways, Kernel32.SetToDW({Kernel32.FileAttributeNormal}), 0 )
  615. END;
  616. IF hfile = Kernel32.InvalidHandleValue THEN res := 1; RETURN END;
  617. ASSERT( hfile # Kernel32.InvalidHandleValue ); winFS.collection.Register( SELF ); res := 0
  618. END Register0;
  619. PROCEDURE Update*;
  620. BEGIN {EXCLUSIVE}
  621. IF buffer.dirty THEN WriteBuffer() END
  622. END Update;
  623. PROCEDURE Finalize*;
  624. VAR res: Kernel32.BOOL;
  625. BEGIN {EXCLUSIVE}
  626. IF TraceFile IN Trace THEN KernelLog.String( "File.Finalize " ); KernelLog.String( fname ); KernelLog.Ln; END;
  627. IF hfile # Kernel32.InvalidHandleValue THEN
  628. IF ~(Temporary IN flags) & buffer.dirty THEN WriteBuffer() END;
  629. res := Kernel32.CloseHandle( hfile ); hfile := Kernel32.InvalidHandleValue;
  630. IF (Temporary IN flags) & (tfname # NIL ) THEN
  631. res := Kernel32.DeleteFile( tfname^ );
  632. (*
  633. KernelLog.String("Deleted: "); KernelLog.String(tfname^); KernelLog.Ln;
  634. IF res = 0 THEN KernelLog.String("failed!"); KernelLog.Ln; END;
  635. *)
  636. (* ASSERT ( res # 0 ) *)
  637. END;
  638. (* ASSERT ( res # 0 ) *)
  639. END
  640. END Finalize;
  641. PROCEDURE Close*;
  642. BEGIN
  643. Finalize;
  644. fileSystem.collection.oldFiles.Remove(SELF);
  645. END Close;
  646. END File;
  647. VAR
  648. winFS: WinFileSystem; (* must be unique *)
  649. PROCEDURE ToSet(d: UNSIGNED32): SET;
  650. BEGIN
  651. RETURN SYSTEM.VAL(SET, ADDRESS(d));
  652. END ToSet;
  653. PROCEDURE DebugFile(f: File);
  654. BEGIN
  655. KernelLog.String("fname = "); KernelLog.String(f.fname); KernelLog.Ln;
  656. KernelLog.String("tname = "); IF f.tfname # NIL THEN KernelLog.String(f.tfname^) ELSE KernelLog.String("(NIL)") END; KernelLog.Ln;
  657. KernelLog.String("hfile = "); KernelLog.Address(f.hfile); KernelLog.Ln;
  658. KernelLog.String("fsize = "); KernelLog.Int(f.fsize, 1); KernelLog.Ln;
  659. KernelLog.String("fpos = "); KernelLog.Int(f.fpos, 1); KernelLog.Ln;
  660. END DebugFile;
  661. PROCEDURE IsLocalPath(path: ARRAY OF CHAR): BOOLEAN;
  662. VAR prefix, name: Files.FileName;
  663. BEGIN
  664. ConvertChar(path, PathDelimiter, Files.PathDelimiter);
  665. Files.SplitName(path, prefix, name);
  666. RETURN (prefix = "") & (name[0] # "/")
  667. END IsLocalPath;
  668. (* WinAPI functions like e.g. GetCurrentDirectory sometimes yield paths with drive letters in lowercase
  669. which have to be capitalized as they are mapped as filesystems which themselves are case sensitive *)
  670. PROCEDURE FixDriveLetter (VAR path: ARRAY OF CHAR);
  671. BEGIN
  672. IF (LEN (path) >= 2) & (path[0] # 0X) & (path[1] = ':') THEN path[0] := CAP (path[0]) END;
  673. END FixDriveLetter;
  674. PROCEDURE MoveFile( VAR from, to: ARRAY OF CHAR ): BOOLEAN;
  675. BEGIN
  676. IF Kernel32.MoveFileEx( from, to, Kernel32.SetToDW({Kernel32.MoveFileReplaceExisting, Kernel32.MoveFileCopyAllowed}) ) = Kernel32.False THEN
  677. IF Kernel32.CopyFile( from, to, Kernel32.False ) = Kernel32.False THEN
  678. IF TraceFile IN Trace THEN KernelLog.String( "could not copy" ); KernelLog.Ln; END;
  679. RETURN FALSE
  680. ELSE
  681. IF Kernel32.DeleteFile( from ) = Kernel32.False THEN
  682. END;
  683. RETURN TRUE; (* warning: Could not delete file ! *)
  684. END
  685. ELSE RETURN TRUE
  686. END
  687. END MoveFile;
  688. PROCEDURE UpperCase( VAR src, dst: ARRAY OF CHAR );
  689. VAR i: LONGINT; ch: CHAR;
  690. BEGIN
  691. i := 0; ch := src[0];
  692. WHILE ch # 0X DO
  693. IF (ch >= "a") & (ch <= "z") THEN ch := CAP( ch ) END;
  694. dst[i] := ch; INC( i ); ch := src[i]
  695. END;
  696. dst[i] := 0X
  697. END UpperCase;
  698. PROCEDURE TempName( VAR name: ARRAY OF CHAR );
  699. VAR temp: FileName;
  700. pref: ARRAY 4 OF CHAR;
  701. ret: LONGINT;
  702. BEGIN
  703. ret := Kernel32.GetTempPath( LEN( temp ), temp ); ASSERT( ret > 0 ); pref := "Aos"; ret := Kernel32.GetTempFileName( temp, pref, 0, name ); FixDriveLetter (name); ASSERT( ret # 0 )
  704. END TempName;
  705. PROCEDURE FullPathName( name: ARRAY OF CHAR; VAR fname: ARRAY OF CHAR ): BOOLEAN;
  706. VAR i, fp: LONGINT;
  707. BEGIN
  708. i := Kernel32.GetFullPathName( name, Kernel32.MaxPath, fname, fp );
  709. FixDriveLetter (fname); RETURN i > 0
  710. END FullPathName;
  711. (* convert flags from windows file flags to A2 file flags *)
  712. PROCEDURE FileFlags( flags: SET ): SET;
  713. VAR s: SET;
  714. BEGIN
  715. s := {};
  716. IF Kernel32.FileAttributeDirectory IN flags THEN INCL( s, Directory ) END;
  717. IF Kernel32.FileAttributeReadonly IN flags THEN INCL( s, ReadOnly ) END;
  718. IF Kernel32.FileAttributeHidden IN flags THEN INCL( s, Hidden ) END;
  719. IF Kernel32.FileAttributeSystem IN flags THEN INCL( s, System ) END;
  720. IF Kernel32.FileAttributeArchive IN flags THEN INCL( s, Archive ) END;
  721. IF Kernel32.FileAttributeTemporary IN flags THEN INCL( s, Temporary ) END;
  722. RETURN s
  723. END FileFlags;
  724. (* convert flags from A2 file flags to windows file flags *)
  725. PROCEDURE WindowsFlags(flags: SET): SET;
  726. VAR s: SET;
  727. BEGIN
  728. s := {};
  729. IF Directory IN flags THEN INCL( s, Kernel32.FileAttributeDirectory) END;
  730. IF ReadOnly IN flags THEN INCL( s, Kernel32.FileAttributeReadonly ) END;
  731. IF Hidden IN flags THEN INCL( s, Kernel32.FileAttributeHidden) END;
  732. IF System IN flags THEN INCL( s, Kernel32.FileAttributeSystem) END;
  733. IF Archive IN flags THEN INCL( s, Kernel32.FileAttributeArchive) END;
  734. IF Temporary IN flags THEN INCL( s, Kernel32.FileAttributeTemporary) END;
  735. RETURN s
  736. END WindowsFlags;
  737. (** Generate a new file system object. Files.NewVol has volume parameter, Files.Par has mount prefix. *)
  738. PROCEDURE NewFS*(context : Files.Parameters);
  739. VAR fs: AliasFileSystem;
  740. BEGIN
  741. IF (Files.This(context.prefix ) = NIL) THEN
  742. NEW( fs ); fs.vol := context.vol; Files.Add( fs, context.prefix );
  743. ELSE
  744. context.error.String( "HostFiles64: " ); context.error.String( context.prefix ); context.error.String( " already in use" );
  745. context.error.Ln;
  746. END;
  747. END NewFS;
  748. PROCEDURE Join( a1, a2, a3: ARRAY OF CHAR; VAR res: ARRAY OF CHAR );
  749. VAR i, j: LONGINT;
  750. BEGIN
  751. i := 0;
  752. WHILE (a1[i] # 0X) DO res[j] := a1[i]; INC( i ); INC( j ) END;
  753. i := 0;
  754. WHILE (a2[i] # 0X) DO res[j] := a2[i]; INC( i ); INC( j ) END;
  755. i := 0;
  756. WHILE (a3[i] # 0X) DO res[j] := a3[i]; INC( i ); INC( j ) END;
  757. res[j] := 0X
  758. END Join;
  759. (*ALEX 2005.02.10, fof 071008*)
  760. PROCEDURE MountDrive(CONST drive: ARRAY OF CHAR; context : Commands.Context);
  761. VAR
  762. p: Files.Parameters; namebuf1, namebuf2: FileName; size, snum, mlen, sysfl: LONGINT;
  763. res: LONGINT; prefix: ARRAY 256 OF CHAR;
  764. BEGIN
  765. COPY(drive,prefix);
  766. size := LEN( namebuf1 ); res := Kernel32.GetVolumeInformation( prefix, namebuf1, size, snum, mlen, sysfl, namebuf2, size );
  767. IF res = 0 THEN
  768. IF context# NIL THEN
  769. context.error.String("Not mounted (no volume information): "); context.error.String(prefix); context.error.Ln;
  770. context.error.Update;
  771. END;
  772. ELSE
  773. IF (context = NIL) THEN
  774. NEW(context, NIL, NIL, NIL, NIL, NIL);
  775. END;
  776. NEW(p, context.in, context.arg, context.out, context.error, context.caller);
  777. IF TraceMounting THEN
  778. context.out.String( "Mounting: " ); context.out.String( drive );
  779. context.out.String( " (" ); context.out.String( namebuf1 ); context.out.String( "), fs = " );
  780. context.out.String( namebuf2 ); context.out.Ln;
  781. context.out.Update;
  782. END;
  783. prefix[1] := 0X;
  784. COPY( prefix, p.prefix );
  785. NewFS( p );
  786. END;
  787. END MountDrive;
  788. PROCEDURE AutoMountWindowsLogicalDrives( drives: SET );
  789. (* fof 090221
  790. implemented asynchronously as it blocked execution on A2 startup for a while;
  791. now some of the drives may get mounted later in the system,
  792. should not be a problem since the search path is handled through windows anyway
  793. *)
  794. VAR
  795. AutoMountObject: OBJECT
  796. VAR prefix: ARRAY 4 OF CHAR; i: LONGINT; drives: SET;
  797. PROCEDURE & Init(drives:SET);
  798. BEGIN
  799. SELF.drives := drives
  800. END Init;
  801. BEGIN {ACTIVE}
  802. FOR i := 0 TO MAX( SET ) - 1 DO
  803. IF i IN drives THEN
  804. prefix := "X:\"; prefix[0] := CHR( ORD( "A" ) + i );
  805. MountDrive(prefix, NIL);
  806. END;
  807. END;
  808. END;
  809. BEGIN
  810. NEW(AutoMountObject,drives);
  811. END AutoMountWindowsLogicalDrives;
  812. PROCEDURE UnmountDrive(CONST drive: ARRAY OF CHAR; context : Commands.Context);
  813. VAR this: Files.FileSystem;
  814. BEGIN
  815. this := Files.This( drive );
  816. IF (this # NIL ) & (this IS AliasFileSystem) THEN
  817. IF (context # NIL) THEN
  818. context.out.String( "Auto Unmount: " ); context.out.String( drive );
  819. context.out.String( ":" ); context.out.Ln;
  820. ELSE
  821. KernelLog.String("Auto Unmount: "); KernelLog.String(drive); KernelLog.String(":"); KernelLog.Ln;
  822. END;
  823. Files.Remove( this );
  824. END;
  825. END UnmountDrive;
  826. PROCEDURE AutoUnmountLogicalDrives( drives: SET );
  827. VAR i: LONGINT;
  828. prefix: ARRAY 4 OF CHAR;
  829. BEGIN
  830. FOR i := 0 TO MAX( SET ) - 1 DO
  831. IF i IN drives THEN
  832. prefix[0] := CHR( ORD( "A" ) + i ); prefix[1] := 0X;
  833. UnmountDrive(prefix, NIL);
  834. END;
  835. END;
  836. END AutoUnmountLogicalDrives;
  837. PROCEDURE Finalization;
  838. VAR ft: Files.FileSystemTable; i: LONGINT;
  839. BEGIN
  840. Files.GetList( ft );
  841. IF ft # NIL THEN
  842. FOR i := 0 TO LEN( ft^ ) - 1 DO
  843. IF ft[i] IS AliasFileSystem THEN Files.Remove( ft[i] ) END
  844. END
  845. END;
  846. winFS.Finalize;
  847. END Finalization;
  848. PROCEDURE FindFile*( name: ARRAY OF CHAR; VAR fullname: ARRAY OF CHAR ): BOOLEAN;
  849. VAR ret: LONGINT; fileName: Kernel32.LPSTR;
  850. BEGIN
  851. ret := Kernel32.SearchPath( workPath, name, NIL , LEN( fullname ), fullname, fileName );
  852. IF (ret <= 0) THEN ret := Kernel32.SearchPath( searchPath, name, NIL , LEN( fullname ), fullname, fileName ) END;
  853. FixDriveLetter (fullname);
  854. RETURN ret > 0;
  855. END FindFile;
  856. PROCEDURE ConvertChar*( VAR name: ARRAY OF CHAR; from, to: CHAR );
  857. VAR i: LONGINT;
  858. BEGIN
  859. i := 0;
  860. WHILE name[i] # 0X DO
  861. IF name[i] = from THEN name[i] := to END;
  862. INC( i )
  863. END
  864. END ConvertChar;
  865. PROCEDURE SetPaths;
  866. VAR ret, i, j, k: LONGINT;
  867. work, files, temp: ARRAY Kernel32.MaxPath OF CHAR;
  868. directories, dirs: ARRAY 4 * Kernel32.MaxPath OF CHAR;
  869. dir, sysPath: FileName;
  870. PROCEDURE SetSysPath(VAR dir: ARRAY OF CHAR);
  871. VAR ch: CHAR; i: LONGINT;
  872. BEGIN
  873. IF (dir[0] = "~") & (dir[1] = PathDelimiter) THEN
  874. Kernel32.SetCurrentDirectory( sysPath );
  875. i := 2;
  876. REPEAT ch := dir[i]; dir[i-2] := ch; INC(i) UNTIL ch = 0X;
  877. ELSE
  878. Kernel32.SetCurrentDirectory(workPath)
  879. END;
  880. END SetSysPath;
  881. PROCEDURE AddDir;
  882. BEGIN
  883. IF k > 0 THEN
  884. dir[k] := 0X;
  885. IF dir[k - 1] = '"' THEN dir[k - 1] := 0X END;
  886. ConvertChar( dir, Files.PathDelimiter, PathDelimiter );
  887. SetSysPath(dir);
  888. IF Kernel32.SetCurrentDirectory( dir ) # Kernel32.False THEN
  889. Kernel32.GetCurrentDirectory( LEN( dir ), dir ); searchPath[i] := ";"; INC( i ); k := 0;
  890. WHILE dir[k] # 0X DO searchPath[i] := dir[k]; INC( i ); INC( k ) END
  891. END;
  892. k := 0
  893. END
  894. END AddDir;
  895. BEGIN {EXCLUSIVE}
  896. Machine.GetConfig( "Paths.Files", files ); Machine.GetConfig( "Paths.Search", directories );
  897. Machine.GetConfig( "Paths.Temp", temp ); Machine.GetConfig( "Paths.Work", work );
  898. Kernel32.GetCurrentDirectory( LEN( workPath ), workPath ); i := 0; ret := 0;
  899. IF files # "" THEN
  900. COPY( files, sysPath );
  901. IF Kernel32.SetCurrentDirectory( sysPath ) # Kernel32.False THEN ret := Kernel32.GetCurrentDirectory( LEN( sysPath ), sysPath ) END
  902. END;
  903. IF ret = 0 THEN
  904. Kernel32.GetModuleFileName( Kernel32.hInstance, sysPath, LEN( sysPath ) ); j := -1;
  905. WHILE sysPath[i] # 0X DO
  906. IF sysPath[i] = PathDelimiter THEN j := i END;
  907. INC( i )
  908. END;
  909. i := j + 1; sysPath[i] := 0X; COPY( sysPath, searchPath )
  910. ELSE
  911. WHILE sysPath[i] # 0X DO searchPath[i] := sysPath[i]; INC( i ) END;
  912. searchPath[i] := 0X
  913. END;
  914. COPY( directories, dirs );
  915. IF dirs[0] = '"' THEN j := 1 ELSE j := 0 END;
  916. k := 0;
  917. WHILE dirs[j] # 0X DO
  918. IF (dirs[j] = ";") OR (dirs[j] < " ") THEN AddDir() ELSE dir[k] := dirs[j]; INC( k ) END;
  919. INC( j )
  920. END;
  921. AddDir(); searchPath[i] := 0X; ret := 0;
  922. COPY( temp, tempPath );
  923. IF tempPath # "" THEN
  924. ConvertChar( tempPath, Files.PathDelimiter, PathDelimiter );
  925. SetSysPath(tempPath);
  926. IF Kernel32.SetCurrentDirectory( tempPath ) # Kernel32.False THEN ret := Kernel32.GetCurrentDirectory( LEN( tempPath ), tempPath ) END
  927. END;
  928. IF ret = 0 THEN Kernel32.GetTempPath( LEN( tempPath ), tempPath ) END;
  929. COPY( work, dir );
  930. IF dir # "" THEN
  931. ConvertChar( dir, Files.PathDelimiter, PathDelimiter );
  932. SetSysPath(dir);
  933. IF Kernel32.SetCurrentDirectory( dir ) # Kernel32.False THEN Kernel32.GetCurrentDirectory( LEN( workPath ), workPath ) END
  934. END;
  935. Kernel32.SetCurrentDirectory( workPath );
  936. END SetPaths;
  937. PROCEDURE SameName*( VAR a, b: ARRAY OF CHAR ): BOOLEAN; (** non-portable *)
  938. VAR i, j: LONGINT;
  939. BEGIN
  940. i := 0; j := 0;
  941. WHILE (a[i] # 0X) & (b[j] # 0X) & (CAP( a[i] ) = CAP( b[j] )) DO INC( i ); INC( j ) END;
  942. RETURN (a[i] = 0X) & (b[j] = 0X)
  943. END SameName;
  944. PROCEDURE CheckPath(fullName: ARRAY OF CHAR ): BOOLEAN;
  945. VAR i, j: LONGINT; done: BOOLEAN;
  946. BEGIN
  947. i := 0; j := -1;
  948. WHILE fullName[i] # 0X DO
  949. IF fullName[i] = PathDelimiter THEN j := i END;
  950. INC( i )
  951. END;
  952. IF j > 0 THEN fullName[j] := 0X END;
  953. BEGIN {EXCLUSIVE}
  954. done := Kernel32.SetCurrentDirectory( fullName ) # Kernel32.False;
  955. Kernel32.SetCurrentDirectory( workPath ); RETURN done
  956. END;
  957. END CheckPath;
  958. PROCEDURE CheckName*( name: ARRAY OF CHAR ): BOOLEAN;
  959. VAR fullName: FileName; fileNamePart: Kernel32.LPSTR; ret, i: SIZE; ch: CHAR; stream, ok: BOOLEAN;
  960. BEGIN
  961. ConvertChar( name, Files.PathDelimiter, PathDelimiter ); ret := Kernel32.GetFullPathName( name, Kernel32.MaxPath, fullName, fileNamePart );
  962. IF (ret > 0) & CheckPath( fullName ) & (fileNamePart # Kernel32.NULL) THEN
  963. ok := TRUE; stream := FALSE; i := fileNamePart - ADDRESSOF( fullName ); fullName[i - 1] := 0X; ch := fullName[i];
  964. WHILE (ch # 0X) & ok DO
  965. IF ch = ":" THEN
  966. IF stream THEN ok := FALSE ELSE stream := TRUE END
  967. ELSIF (ch = ":") OR (ch = "\") OR (ch = "?") OR (ch = "|") OR (ch = ">") OR (ch = "<") OR (ch = "/") OR (ch = "*") OR (ch = '"') THEN ok := FALSE;
  968. END;
  969. (* \ / : * ? " < > | *)
  970. INC( i ); ch := fullName[i]
  971. END
  972. ELSE ok := FALSE
  973. END;
  974. RETURN ok
  975. END CheckName;
  976. PROCEDURE GetAttributes*( file: ARRAY OF CHAR ): SET; (** non-portable *)
  977. VAR attrs: SET;
  978. BEGIN
  979. ConvertChar( file, Files.PathDelimiter, PathDelimiter ); attrs := ToSet(Kernel32.GetFileAttributes( file ));
  980. IF attrs = {0..31} THEN RETURN {} ELSE RETURN attrs END
  981. END GetAttributes;
  982. PROCEDURE SetAttributes*( file: ARRAY OF CHAR; attrs: SET ); (** non-portable *)
  983. BEGIN
  984. ConvertChar( file, Files.PathDelimiter, PathDelimiter ); Kernel32.SetFileAttributes( file, Kernel32.SetToDW(attrs) )
  985. END SetAttributes;
  986. PROCEDURE SetFileAttributes*( file: ARRAY OF CHAR; attrs: SET ); (** non-portable *)
  987. BEGIN
  988. ConvertChar( file, Files.PathDelimiter, PathDelimiter ); Kernel32.SetFileAttributes( file, Kernel32.SetToDW(attrs) )
  989. END SetFileAttributes;
  990. (** Get the current directory. *)
  991. PROCEDURE GetWorkingDirectory*( VAR path: ARRAY OF CHAR );
  992. BEGIN {EXCLUSIVE}
  993. Kernel32.GetCurrentDirectory( Kernel32.MaxPath, workPath ); COPY( workPath, path ); ConvertChar( path, PathDelimiter, Files.PathDelimiter ); FixDriveLetter (path);
  994. END GetWorkingDirectory;
  995. (** Change to directory path. *)
  996. PROCEDURE ChangeDirectory*( path: ARRAY OF CHAR; VAR done: BOOLEAN );
  997. BEGIN {EXCLUSIVE}
  998. ConvertChar( path, Files.PathDelimiter, PathDelimiter ); done := Kernel32.SetCurrentDirectory( path ) # Kernel32.False; Kernel32.GetCurrentDirectory( Kernel32.MaxPath, workPath );
  999. END ChangeDirectory;
  1000. (** Get the directory for temporary files. *)
  1001. PROCEDURE GetTempDirectory*( VAR path: ARRAY OF CHAR );
  1002. BEGIN
  1003. COPY( tempPath, path ); ConvertChar( path, PathDelimiter, Files.PathDelimiter )
  1004. END GetTempDirectory;
  1005. (** Compute the relative filename (relative to the working directory). *)
  1006. PROCEDURE RelFileName*( fileName: ARRAY OF CHAR; VAR relFileName: ARRAY OF CHAR );
  1007. VAR i, j, k, p: LONGINT; fullName: FileName; fileNamePart: Kernel32.LPSTR;
  1008. BEGIN
  1009. IF ~FindFile( fileName, fullName ) THEN (* file does not exist -> would be created in the current dir *)
  1010. ConvertChar( fileName, Files.PathDelimiter, PathDelimiter ); Kernel32.GetFullPathName( fileName, Kernel32.MaxPath, fullName, fileNamePart ); FixDriveLetter (fullName);
  1011. ELSE ConvertChar( fullName, Files.PathDelimiter, PathDelimiter )
  1012. END; (* from here on all with PathDelimiter and drive letter *)
  1013. IF CAP( workPath[0] ) # CAP( fullName[0] ) THEN (* different drive letters -> nothing to be done *)
  1014. COPY( fullName, relFileName )
  1015. ELSE
  1016. i := 0; j := -1; p := 0;
  1017. WHILE CAP( fullName[i] ) = CAP( workPath[i] ) DO
  1018. IF workPath[i] = PathDelimiter THEN j := i END;
  1019. INC( i )
  1020. END;
  1021. IF workPath[i] = 0X THEN
  1022. IF fullName[i] # PathDelimiter THEN (* first part of directories do match *)
  1023. relFileName[p] := "."; relFileName[p + 1] := "."; relFileName[p + 2] := PathDelimiter; INC( p, 3 ); INC( j );
  1024. WHILE fullName[j] # 0X DO relFileName[p] := fullName[j]; INC( j ); INC( p ) END
  1025. ELSE (* file is in a subdirectory of the current dir *)
  1026. INC( i );
  1027. WHILE fullName[i] # 0X DO relFileName[p] := fullName[i]; INC( i ); INC( p ) END
  1028. END
  1029. ELSIF j > 2 THEN (* first part of directories do match *)
  1030. k := j; i := j + 1;
  1031. WHILE workPath[k] # 0X DO
  1032. IF workPath[k] = PathDelimiter THEN relFileName[p] := "."; relFileName[p + 1] := "."; relFileName[p + 2] := PathDelimiter; INC( p, 3 ) END;
  1033. INC( k )
  1034. END;
  1035. WHILE fullName[i] # 0X DO relFileName[p] := fullName[i]; INC( i ); INC( p ) END
  1036. ELSE (* only drive letters match *)
  1037. i := j;
  1038. WHILE fullName[i] # 0X DO relFileName[p] := fullName[i]; INC( i ); INC( p ) END
  1039. END;
  1040. relFileName[p] := 0X
  1041. END;
  1042. ConvertChar( relFileName, PathDelimiter, Files.PathDelimiter )
  1043. END RelFileName;
  1044. PROCEDURE DeviceNotification*( type: LONGINT; drives: SET );
  1045. VAR n: Notification;
  1046. BEGIN
  1047. IF type = deviceArrival THEN AutoMountWindowsLogicalDrives( drives );
  1048. ELSIF type = deviceRemove THEN AutoUnmountLogicalDrives( drives );
  1049. ELSE
  1050. (* scan for changes *)
  1051. END;
  1052. n := notifications;
  1053. WHILE(n#NIL) DO
  1054. n.p(type,drives);
  1055. n := n.next;
  1056. END;
  1057. END DeviceNotification;
  1058. PROCEDURE RegisterNotification*( p: NotificationProc );
  1059. VAR n: Notification;
  1060. BEGIN
  1061. NEW( n ); n.p := p; n.next := notifications; notifications := n;
  1062. END RegisterNotification;
  1063. PROCEDURE Init;
  1064. VAR
  1065. i, j: LONGINT; sysPath: FileName; p: Files.Parameters; drives: SET; fs : Files.FileSystem;
  1066. BEGIN
  1067. NEW( winFS );
  1068. NEW( p, NIL, NIL, NIL, NIL, NIL); p.prefix := "searcher";
  1069. NewFS( p );
  1070. fs := Files.This(p.prefix);
  1071. IF (fs # NIL) & (fs IS AliasFileSystem) THEN
  1072. fs( AliasFileSystem ).useprefix := FALSE;
  1073. EXCL( fs( AliasFileSystem ).flags, Files.NeedsPrefix );
  1074. END;
  1075. (* now the file system is installed *)
  1076. drives := ToSet(Kernel32.GetLogicalDrives());
  1077. drives := drives - {0,1}; (* do not scan for diskettes *)
  1078. AutoMountWindowsLogicalDrives( drives );
  1079. Kernel32.GetCurrentDirectory( LEN( workPath ), workPath ); i := 0; Kernel32.GetModuleFileName( Kernel32.hInstance, sysPath, LEN( sysPath ) ); j := -1;
  1080. FixDriveLetter (workPath); FixDriveLetter (sysPath);
  1081. WHILE sysPath[i] # 0X DO
  1082. IF sysPath[i] = PathDelimiter THEN j := i END;
  1083. INC( i )
  1084. END;
  1085. i := j + 1; sysPath[i] := 0X; COPY( sysPath, searchPath ); Kernel32.GetTempPath( LEN( tempPath ), tempPath ); Kernel32.SetCurrentDirectory( workPath );
  1086. notifications := NIL;
  1087. END Init;
  1088. PROCEDURE AddSearchPath*(context: Commands.Context);
  1089. VAR name,fullName: FileName; i,j: LONGINT; ch : CHAR; ret: LONGINT; fileNamePart: Kernel32.LPSTR;
  1090. BEGIN
  1091. IF context.arg.GetString(name) THEN
  1092. i := 0; j := 0;
  1093. ConvertChar( name, Files.PathDelimiter, PathDelimiter );
  1094. ret := Kernel32.GetFullPathName( name, Kernel32.MaxPath, fullName, fileNamePart );
  1095. WHILE(searchPath[i] # 0X) DO
  1096. INC(i);
  1097. END;
  1098. searchPath[i] := ";";INC(i);
  1099. REPEAT
  1100. ch := fullName[j];
  1101. searchPath[i] := ch;
  1102. INC(j);INC(i);
  1103. UNTIL ch = 0X;
  1104. END;
  1105. END AddSearchPath;
  1106. PROCEDURE SetWorkPath*(context: Commands.Context);
  1107. VAR name: FileName; done: BOOLEAN;
  1108. BEGIN
  1109. IF context.arg.GetString(name) THEN
  1110. ChangeDirectory(name, done);
  1111. IF ~done THEN
  1112. context.error.String("could not change directory to "); context.error.String(name); context.error.Ln;
  1113. END
  1114. END;
  1115. END SetWorkPath;
  1116. PROCEDURE Mount*(context : Commands.Context);
  1117. VAR diskname: ARRAY 256 OF CHAR;
  1118. BEGIN
  1119. context.arg.SkipWhitespace;
  1120. context.arg.String(diskname);
  1121. MountDrive(diskname, context);
  1122. END Mount;
  1123. PROCEDURE Unmount*(context : Commands.Context);
  1124. VAR diskname: ARRAY 256 OF CHAR;
  1125. BEGIN
  1126. context.arg.SkipWhitespace;
  1127. context.arg.String(diskname);
  1128. UnmountDrive(diskname, context);
  1129. END Unmount;
  1130. BEGIN
  1131. Init(); Modules.InstallTermHandler( Finalization ); SetPaths;
  1132. END HostFiles64.