Win32.WinFS.Mod 46 KB

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