Win32.WinFiles64.Mod 47 KB

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