2
0

Win32.WinFS.Mod 46 KB

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