1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285 |
- MODULE HostFiles64; (*AUTHOR "fof,ejz"; PURPOSE "Windows file system for WinAos"; *)
- IMPORT SYSTEM, Machine, Kernel32, KernelLog, Modules, Kernel, Files := Files64, Commands;
- CONST
- PathDelimiter = "\"; BufferSize = 4096;
- (** File flags *)
- ReadOnly* = Files.ReadOnly;
- Directory* = Files.Directory;
- Hidden* = Files.Hidden;
- System* = Files.System;
- Archive* = Files.Archive;
- Temporary* = Files.Temporary;
- TraceFile = 0; TraceFileSystem = 1; TraceCollection = 2; TraceSearch = 3; Trace = {};
- TraceMounting=FALSE;
- deviceArrival* = 08000H; (* DBT_DEVICEARRIVAL = 08000H *)
- deviceRemove* = 08004H; (* DBT_DEVICEREMOVECOMPLETE = 08004H *)
- TYPE
- FileName = ARRAY Kernel32.MaxPath OF CHAR;
- PFileName = POINTER TO FileName;
- NotificationProc* = PROCEDURE ( type: LONGINT; drives: SET );
- Notification = POINTER TO RECORD
- p: NotificationProc;
- next: Notification
- END;
- VAR
- searchPath: ARRAY 4 * Kernel32.MaxPath OF CHAR;
- workPath, tempPath: FileName; notifications: Notification;
- TYPE
- SearchByName = OBJECT
- VAR sname: FileName;
- found: File;
- PROCEDURE Init( name: ARRAY OF CHAR );
- BEGIN
- found := NIL; UpperCase( name, sname )
- END Init;
- PROCEDURE EnumFile( f: ANY; VAR cont: BOOLEAN );
- VAR F: File; fname: FileName;
- BEGIN
- F := f( File ); UpperCase( F.fname, fname );
- IF TraceSearch IN Trace THEN KernelLog.String( "Enumerate: " ); KernelLog.String( fname );
- END;
- IF sname = fname THEN found := F; cont := FALSE ELSE cont := TRUE END;
- IF TraceSearch IN Trace THEN
- IF cont THEN KernelLog.String( " # " ); ELSE KernelLog.String( " = " ); END;
- KernelLog.String( sname ); KernelLog.Ln;
- END;
- END EnumFile;
- END SearchByName;
- FinalizeFiles = OBJECT
- PROCEDURE EnumFile( f: ANY; VAR cont: BOOLEAN );
- VAR F: File;
- BEGIN
- F := f( File ); F.Finalize(); cont := TRUE
- END EnumFile;
- END FinalizeFiles;
- Collection = OBJECT (* methods in Collection shared by objects Filesystem and File *)
- VAR oldFiles, newFiles: Kernel.FinalizedCollection;
- search: SearchByName;
- fileKey: LONGINT;
- PROCEDURE & Init*;
- BEGIN
- NEW( oldFiles ); NEW( newFiles ); NEW( search ); fileKey := -1;
- END Init;
- PROCEDURE GetNextFileKey( ): LONGINT;
- BEGIN {EXCLUSIVE}
- DEC( fileKey ); RETURN fileKey
- END GetNextFileKey;
- PROCEDURE Register( F: File );
- BEGIN {EXCLUSIVE}
- IF TraceCollection IN Trace THEN KernelLog.String( "Collections.Register " ); KernelLog.String( F.fname ); KernelLog.Ln; END;
- oldFiles.Add( F, FinalizeFile ); newFiles.Remove( F ); DEC( fileKey ); F.Init( F.fname, F.hfile, fileKey,F.fileSystem );
- END Register;
- PROCEDURE Unregister( F: File );
- BEGIN {EXCLUSIVE}
- IF TraceCollection IN Trace THEN KernelLog.String( "Unregister " ); KernelLog.String( F.fname ); KernelLog.Ln; END;
- oldFiles.Remove( F ); newFiles.Add( F, FinalizeFile (* FinalizeFile*) ); F.Init( F.fname, Kernel32.InvalidHandleValue, 0, F.fileSystem );
- END Unregister;
- PROCEDURE AddNew( F: File );
- BEGIN {EXCLUSIVE}
- IF TraceCollection IN Trace THEN KernelLog.String( "Collections.AddNew: " ); KernelLog.String( F.fname ); KernelLog.Ln; END;
- newFiles.Add( F, FinalizeFile );
- END AddNew;
- PROCEDURE AddOld( F: File );
- BEGIN {EXCLUSIVE}
- IF TraceCollection IN Trace THEN KernelLog.String( "Collections.AddOld: " ); KernelLog.String( F.fname ); KernelLog.Ln; END;
- oldFiles.Add( F, FinalizeFile );
- END AddOld;
- PROCEDURE ByName( VAR fname: ARRAY OF CHAR ): File;
- BEGIN {EXCLUSIVE}
- IF TraceCollection IN Trace THEN KernelLog.String( "Collections.ByName: " ); KernelLog.String( fname ); KernelLog.Ln; END;
- search.Init( fname ); oldFiles.Enumerate( search.EnumFile ); RETURN search.found
- END ByName;
- PROCEDURE ByNameNotGC( VAR fname: ARRAY OF CHAR ): File;
- BEGIN {EXCLUSIVE}
- IF TraceCollection IN Trace THEN KernelLog.String( "Collections.ByName: " ); KernelLog.String( fname ); KernelLog.Ln; END;
- search.Init( fname ); oldFiles.EnumerateN( search.EnumFile ); RETURN search.found;
- END ByNameNotGC;
- PROCEDURE Finalize;
- VAR fin: FinalizeFiles;
- BEGIN {EXCLUSIVE}
- IF TraceCollection IN Trace THEN KernelLog.String( "Collections.Finalize " ); KernelLog.Ln; END;
- NEW( fin ); newFiles.Enumerate( fin.EnumFile ); newFiles.Clear(); oldFiles.Enumerate( fin.EnumFile ); oldFiles.Clear();
- END Finalize;
- PROCEDURE FinalizeFile( obj: ANY );
- VAR F: File;
- BEGIN
- F := obj( File );
- IF TraceCollection IN Trace THEN KernelLog.String( "Collections.FinalizeFile " ); KernelLog.String( F.fname ); KernelLog.Ln; END;
- F.Finalize()
- END FinalizeFile;
- END Collection;
- AliasFileSystem* = OBJECT (Files.FileSystem)
- VAR fs: WinFileSystem;
- useprefix*: BOOLEAN;
- PROCEDURE Prefix( CONST name: ARRAY OF CHAR; VAR res: ARRAY OF CHAR );
- BEGIN
- IF useprefix & (name # "") THEN Join( prefix, ":", name, res ); ELSE COPY( name, res ); END;
- END Prefix;
- PROCEDURE & Init*;
- BEGIN
- SELF.fs := winFS; useprefix := TRUE; INCL( flags, Files.NeedsPrefix );
- END Init;
- PROCEDURE New0*( name: ARRAY OF CHAR ): Files.File;
- VAR fname: FileName; f: Files.File;
- BEGIN
- Prefix( name, fname ); f := fs.New0( fname ); IF f # NIL THEN f.fs := SELF; END; RETURN f;
- END New0;
- PROCEDURE Old0*( name: ARRAY OF CHAR ): Files.File;
- VAR fname: FileName; f: Files.File;
- BEGIN
- Prefix( name, fname ); f := fs.Old0( fname ); IF f # NIL THEN f.fs := SELF; END; RETURN f;
- END Old0;
- PROCEDURE Delete0*( name: ARRAY OF CHAR; VAR key, res: LONGINT );
- VAR fname: FileName;
- BEGIN
- Prefix( name, fname ); fs.Delete0( fname, key, res );
- END Delete0;
- PROCEDURE Rename0*( old, new: ARRAY OF CHAR; fold: Files.File; VAR res: LONGINT );
- VAR old0, new0: FileName;
- BEGIN
- Prefix( old, old0 ); Prefix( new, new0 ); fs.Rename0( old0, new0, fold, res );
- END Rename0;
- PROCEDURE Enumerate0*( mask: ARRAY OF CHAR; flags: SET; enum: Files.Enumerator );
- VAR fmask: FileName;
- BEGIN
- Prefix( mask, fmask ); fs.Enumerate1( fmask, flags, enum, useprefix );
- END Enumerate0;
- PROCEDURE FileKey*( name: ARRAY OF CHAR ): LONGINT;
- VAR fname: FileName;
- BEGIN
- Prefix( name, fname ); RETURN fs.FileKey( fname );
- END FileKey;
- PROCEDURE CreateDirectory0*( name: ARRAY OF CHAR; VAR res: LONGINT );
- VAR fname: FileName;
- BEGIN
- Prefix( name, fname ); fs.CreateDirectory0( fname, res );
- END CreateDirectory0;
- PROCEDURE RemoveDirectory0*( name: ARRAY OF CHAR; force: BOOLEAN; VAR key, res: LONGINT );
- VAR fname: FileName;
- BEGIN
- Prefix( name, fname ); fs.RemoveDirectory0( fname, force, key, res );
- END RemoveDirectory0;
- PROCEDURE Has*(CONST name: ARRAY OF CHAR; VAR fullName: ARRAY OF CHAR; VAR flags: SET): BOOLEAN;
- VAR fname: FileName;
- BEGIN
- Prefix(name, fname ); RETURN fs.Has(fname, fullName, flags);
- END Has;
- END AliasFileSystem;
- WinFileSystem = OBJECT (* own object for synchronisation of all actions on the (unique) windows file system *)
- VAR collection: Collection;
- PROCEDURE & Init*;
- BEGIN
- NEW( collection );
- END Init;
- PROCEDURE New0( name: ARRAY OF CHAR ): Files.File;
- VAR F: File; fname: FileName;
- BEGIN {EXCLUSIVE}
- ConvertChar( name, Files.PathDelimiter, PathDelimiter );
- IF TraceFileSystem IN Trace THEN KernelLog.String( "New0 " ); KernelLog.String( name ); KernelLog.Ln; END;
- F := NIL;
- IF name = "" THEN (* temporary file *)
- NEW( F, name, Kernel32.InvalidHandleValue, 0, SELF ); collection.AddNew( F );
- ELSIF FullPathName( name, fname ) & CheckPath(fname) THEN
- NEW( F, fname, Kernel32.InvalidHandleValue, 0, SELF ); collection.AddNew( F );
- END;
- IF TraceFileSystem IN Trace THEN KernelLog.String( "failed" ); KernelLog.Ln; END;
- RETURN F;
- END New0;
- PROCEDURE Old0( name: ARRAY OF CHAR ): Files.File;
- VAR F: File; hfile: Kernel32.HANDLE; fname: FileName;
- BEGIN {EXCLUSIVE}
- ConvertChar( name, Files.PathDelimiter, PathDelimiter );
- IF TraceFileSystem IN Trace THEN KernelLog.String( "Old0 " ); KernelLog.String( name ); KernelLog.Ln; END;
- IF (name # "") & FindFile( name, fname ) THEN
- hfile := Kernel32.CreateFile( fname, Kernel32.SetToDW({Kernel32.GenericRead}), Kernel32.SetToDW({Kernel32.FileShareRead, Kernel32.FileShareWrite}), NIL , Kernel32.OpenExisting, Kernel32.SetToDW({Kernel32.FileAttributeNormal}), 0 );
- IF hfile # Kernel32.InvalidHandleValue THEN NEW( F, fname, hfile, collection.GetNextFileKey() , SELF); collection.AddOld( F ); RETURN F END
- END;
- IF TraceFileSystem IN Trace THEN KernelLog.String( "failed" ); KernelLog.Ln; END;
- RETURN NIL
- END Old0;
- PROCEDURE Delete0( name: ARRAY OF CHAR; VAR key, res: LONGINT );
- VAR fname: FileName; F: File; ret: Kernel32.BOOL;
- BEGIN {EXCLUSIVE}
- ConvertChar( name, Files.PathDelimiter, PathDelimiter ); key := 0; res := 1;
- IF FullPathName( name, fname ) THEN
- F := collection.ByName( fname );
- IF F # NIL THEN
- key := F.key;
- IF F.ToTemp() THEN res := 0 END;
- ELSE
- ret := Kernel32.DeleteFile( fname );
- IF ret # 0 THEN res := 0 END
- END
- END
- END Delete0;
- PROCEDURE Rename0( old, new: ARRAY OF CHAR; fold: Files.File; VAR res: LONGINT );
- VAR fnold, fnnew: FileName; Fo, Fn: File; ret: Kernel32.BOOL;
- BEGIN {EXCLUSIVE}
- IF TraceFileSystem IN Trace THEN KernelLog.String( "Rename " ); KernelLog.String( old ); KernelLog.String( " -> " ); KernelLog.String( new ); KernelLog.Ln; END;
- ConvertChar( old, Files.PathDelimiter, PathDelimiter ); ConvertChar( new, Files.PathDelimiter, PathDelimiter ); res := 1;
- IF FullPathName( old, fnold ) & FullPathName( new, fnnew ) THEN
- Fn := collection.ByName( fnnew );
- IF Fn # NIL THEN
- IF ~Fn.ToTemp() THEN RETURN END
- END;
- IF fold # NIL THEN
- Fo := fold( File );
- IF ~Fo.ToTemp() THEN RETURN END;
- ret := Kernel32.CopyFile( Fo.tfname^, fnnew, 0 )
- ELSE ret := Kernel32.MoveFileEx( fnold, fnnew, Kernel32.SetToDW({Kernel32.MoveFileReplaceExisting, Kernel32.MoveFileCopyAllowed}) )
- END;
- IF ret # 0 THEN res := 0 END
- ELSIF TraceFileSystem IN Trace THEN KernelLog.String( "Rename failed :" ); KernelLog.String( fnold ); KernelLog.String( " => " ); KernelLog.String( fnnew ); KernelLog.Ln;
- END
- END Rename0;
- PROCEDURE Enumerate1( mask: ARRAY OF CHAR; flags: SET; enum: Files.Enumerator; useprefix: BOOLEAN );
- VAR i, j: LONGINT;
- path, pattern: ARRAY 256 OF CHAR;
- attr: SET; curPath, longname: FileName;
- PROCEDURE EnumeratePath;
- VAR h: Kernel32.HANDLE; FD: Kernel32.FindData; ft: Kernel32.FileTime; st: Kernel32.SystemTime; i, j, t, d: LONGINT;
- BEGIN
- i := 0;
- WHILE curPath[i] # 0X DO INC( i ) END;
- IF curPath[i - 1] # PathDelimiter THEN curPath[i] := PathDelimiter; INC( i ); curPath[i] := 0X END;
- j := i - 1; h := 0;
- WHILE pattern[h] # 0X DO curPath[i] := pattern[h]; INC( i ); INC( h ) END;
- IF h = 0 THEN curPath[i] := "*"; INC( i ); curPath[i] := "."; INC( i ); curPath[i] := "*"; INC( i ) END;
- curPath[i] := 0X;
- h := Kernel32.FindFirstFile( curPath, FD ); curPath[j] := 0X; ConvertChar( curPath, PathDelimiter, Files.PathDelimiter ); FixDriveLetter (curPath);
- IF h # Kernel32.InvalidHandleValue THEN
- t := 0; d := 0;
- REPEAT
- IF Files.EnumTime IN flags THEN
- Kernel32.FileTimeToLocalFileTime( FD.ftLastWriteTime, ft ); Kernel32.FileTimeToSystemTime( ft, st );
- 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 );
- END;
- Join( curPath, "/", FD.cFileName, longname );
- IF ~(Kernel32.FileAttributeDirectory IN Kernel32.DWToSet(FD.dwFileAttributes)) THEN
- enum.PutEntry( longname, {}, t, d, HUGEINT(UNSIGNED64( FD.nFileSizeHigh ) * UNSIGNED64( 0x100000000 ) + UNSIGNED64( FD.nFileSizeLow )))
- ELSIF (FD.cFileName # ".") & (FD.cFileName # "..") THEN
- enum.PutEntry( longname, {Files.Directory}, t, d, HUGEINT(UNSIGNED64( FD.nFileSizeHigh ) * UNSIGNED64( 0x100000000 ) + UNSIGNED64( FD.nFileSizeLow )))
- END;
- UNTIL Kernel32.FindNextFile( h, FD ) = Kernel32.False;
- Kernel32.FindClose( h )
- END;
- END EnumeratePath;
- BEGIN {EXCLUSIVE}
- COPY( mask, path ); ConvertChar( path, Files.PathDelimiter, PathDelimiter ); attr := ToSet(Kernel32.GetFileAttributes( path )); path := "";
- IF (Kernel32.FileAttributeDirectory IN attr) & (~(Kernel32.FileAttributeTemporary IN attr)) THEN COPY( mask, path ); COPY( "*", pattern ); ELSE Files.SplitPath( mask, path, pattern ); END;
- IF TraceFileSystem IN Trace THEN
- KernelLog.String( "Enumerate0: " ); KernelLog.String( mask ); KernelLog.String( " :: " ); KernelLog.String( path ); KernelLog.String( " :: " ); KernelLog.String( pattern ); KernelLog.Ln;
- END;
- IF enum = NIL THEN RETURN
- END;
- IF path = "." THEN COPY( workPath, curPath ); EnumeratePath()
- ELSIF IsLocalPath(path) THEN
- COPY( workPath, curPath );
- IF path # "" THEN
- ConvertChar(curPath, PathDelimiter, Files.PathDelimiter);
- Files.JoinPath(curPath, path, curPath);
- ConvertChar( curPath, Files.PathDelimiter, PathDelimiter );
- END;
- EnumeratePath();
- IF ~useprefix THEN
- i := 0; j := 0;
- WHILE searchPath[i] # 0X DO
- IF searchPath[i] # ";" THEN curPath[j] := searchPath[i]; INC( j )
- ELSIF j > 0 THEN
- curPath[j] := 0X;
- IF curPath # workPath THEN
- IF path # "" THEN
- ConvertChar(curPath, PathDelimiter, Files.PathDelimiter);
- Files.JoinPath(curPath, path, curPath);
- ConvertChar( curPath, Files.PathDelimiter, PathDelimiter );
- END;
- EnumeratePath()
- END;
- j := 0
- END;
- INC( i )
- END;
- IF j > 0 THEN
- curPath[j] := 0X;
- IF path # "" THEN
- ConvertChar(curPath, PathDelimiter, Files.PathDelimiter);
- Files.JoinPath(curPath, path, curPath);
- ConvertChar( curPath, Files.PathDelimiter, PathDelimiter );
- END;
- IF curPath # workPath THEN EnumeratePath() END
- END;
- END;
- ELSE (* path is an absolute path *)
- COPY( path, curPath ); ConvertChar( curPath, Files.PathDelimiter, PathDelimiter ); EnumeratePath()
- END;
- END Enumerate1;
- PROCEDURE FileKey( name: ARRAY OF CHAR ): LONGINT;
- VAR fname: FileName; F: File;
- BEGIN {EXCLUSIVE}
- (*RETURN 0; (* Finalizers may steal file *) *)
- IF name = "" THEN RETURN 0 END;
- IF TraceFileSystem IN Trace THEN KernelLog.String( "FileKey " ); KernelLog.String( name ); KernelLog.Ln;
- END;
- ConvertChar( name, Files.PathDelimiter, PathDelimiter );
- IF FindFile( name, fname ) (* OR FullPathName(name,fname) *) THEN
- F := collection.ByNameNotGC( fname );
- IF F # NIL THEN RETURN F.key END
- ELSIF TraceFileSystem IN Trace THEN KernelLog.String( "not found: " ); KernelLog.String( name ); KernelLog.String( "(" ); KernelLog.String( fname ); KernelLog.String( ")" ); KernelLog.Ln;
- END;
- IF TraceFileSystem IN Trace THEN KernelLog.String( "no key: " ); KernelLog.String( name ); KernelLog.String( "(" ); KernelLog.String( fname ); KernelLog.String( ")" ); KernelLog.Ln; END;
- RETURN 0
- END FileKey;
- PROCEDURE CreateDirectory0( name: ARRAY OF CHAR; VAR res: LONGINT );
- VAR ret: Kernel32.BOOL;
- BEGIN {EXCLUSIVE}
- ConvertChar( name, Files.PathDelimiter, PathDelimiter ); ret := Kernel32.CreateDirectory( name, NIL );
- IF ret # 0 THEN
- res := 0;
- ELSIF Kernel32.GetLastError() = 183 (*ERROR_ALREADY_EXISTS*) THEN
- res := Files.FileAlreadyExists;
- ELSE
- res := 1
- END
- END CreateDirectory0;
- PROCEDURE RemoveDirectory0( name: ARRAY OF CHAR; force: BOOLEAN; VAR key, res: LONGINT );
- VAR ret: Kernel32.BOOL;
- BEGIN {EXCLUSIVE}
- ConvertChar( name, Files.PathDelimiter, PathDelimiter ); key := 0; res := 1;
- IF ~force THEN
- ret := Kernel32.RemoveDirectory( name );
- IF ret # 0 THEN res := 0 END
- ELSE res := -1
- END
- END RemoveDirectory0;
- PROCEDURE Finalize;
- BEGIN
- collection.Finalize();
- END Finalize;
- PROCEDURE Has*(CONST fileName: ARRAY OF CHAR; VAR fullName: ARRAY OF CHAR; VAR flags: SET): BOOLEAN;
- VAR name: FileName;
- BEGIN
- COPY(fileName, name);
- ConvertChar(name, Files.PathDelimiter, PathDelimiter );
- IF FindFile(fileName, fullName) THEN
- flags := FileFlags(ToSet(Kernel32.GetFileAttributes(fullName)));
- ConvertChar(fullName, PathDelimiter,Files.PathDelimiter);
- RETURN TRUE
- ELSE
- RETURN FALSE
- END;
- END Has;
- END WinFileSystem;
- Buffer = POINTER TO RECORD
- data: ARRAY BufferSize OF CHAR;
- apos: HUGEINT;
- len: LONGINT;
- dirty: BOOLEAN
- END;
- File* = OBJECT (Files.File)
- VAR fname: FileName;
- tfname: PFileName;
- hfile: Kernel32.HANDLE;
- buffer: Buffer;
- fsize, fpos: HUGEINT;
- fileSystem: WinFileSystem;
- PROCEDURE & Init*( VAR name: ARRAY OF CHAR; hfile: Kernel32.HANDLE; key: LONGINT ; fs: WinFileSystem);
- VAR s: SET; res: Kernel32.BOOL;
- BEGIN
- IF TraceFile IN Trace THEN KernelLog.String( "Init: " ); KernelLog.String( name ); KernelLog.String( " (" ); KernelLog.Int( key, 1 ); KernelLog.String( ")" ); KernelLog.Ln; END;
- SELF.key := key; fpos := 0; SELF.hfile := hfile; COPY( name, SELF.fname ); tfname := NIL;
- IF hfile # Kernel32.InvalidHandleValue THEN
- ASSERT(Kernel32.GetFileSizeEx(hfile, fsize) # Kernel32.False);
- s := ToSet(Kernel32.GetFileAttributes( name ));
- IF Kernel32.FileAttributeTemporary IN s THEN EXCL( s, Kernel32.FileAttributeTemporary ); res := Kernel32.SetFileAttributes( name, Kernel32.SetToDW(s) ); ASSERT( res # 0 ); s := ToSet(Kernel32.GetFileAttributes( name )) END;
- flags := FileFlags( s )
- ELSE flags := {Temporary}; fsize := 0
- END;
- IF buffer = NIL THEN NEW( buffer ); END;
- buffer.apos := -1; buffer.len := 0; buffer.dirty := FALSE;
- fileSystem := fs
- END Init;
- PROCEDURE Set*( VAR r: Files.Rider; pos: HUGEINT );
- VAR size: HUGEINT;
- BEGIN {EXCLUSIVE}
- IF hfile # Kernel32.InvalidHandleValue THEN
- 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 *)
- IF size > fsize THEN fsize := size END;
- END;
- r.eof := FALSE; r.res := 0; r.file := SELF; r.fs := fs;
- IF pos < 0 THEN pos := 0
- ELSIF pos > fsize THEN pos := fsize
- END;
- r.apos := pos DIV BufferSize; r.bpos := LONGINT( pos MOD BufferSize )
- END Set;
- PROCEDURE Pos*( VAR r: Files.Rider ): HUGEINT;
- BEGIN
- RETURN r.apos * BufferSize + r.bpos
- END Pos;
- PROCEDURE WriteBuffer;
- VAR pos: HUGEINT; n: LONGINT; res, b: Kernel32.BOOL;
- BEGIN
- ASSERT( buffer.dirty ); ASSERT( buffer.len > 0 );
- pos := buffer.apos * BufferSize;
- IF hfile = Kernel32.InvalidHandleValue THEN
- ASSERT( Temporary IN flags ); NEW( tfname ); TempName( tfname^ );
- hfile := Kernel32.CreateFile( tfname^, Kernel32.SetToDW({Kernel32.GenericRead, Kernel32.GenericWrite}), Kernel32.SetToDW({Kernel32.FileShareRead}), NIL , Kernel32.CreateAlways, Kernel32.SetToDW({Kernel32.FileAttributeTemporary}), 0 );
- ASSERT( hfile # Kernel32.InvalidHandleValue ); fpos := 0
- END;
- IF fpos # pos THEN ASSERT( Kernel32.SetFilePointerEx( hfile, pos, fpos , Kernel32.FileBegin ) # Kernel32.False ); END;
- res := Kernel32.WriteFile( hfile, buffer.data, buffer.len, n, NIL );
- IF (res = Kernel32.False) & ~(ReadOnly IN flags) THEN
- res := Kernel32.CloseHandle( hfile );
- IF TraceFile IN Trace THEN KernelLog.String( "closed handle of " ); KernelLog.String( fname ); KernelLog.Ln; END;
- hfile :=
- Kernel32.CreateFile( fname, Kernel32.SetToDW({Kernel32.GenericRead, Kernel32.GenericWrite}), Kernel32.SetToDW({Kernel32.FileShareRead, Kernel32.FileShareWrite}), NIL , Kernel32.OpenExisting, Kernel32.SetToDW({Kernel32.FileAttributeNormal}), 0 );
- ASSERT( hfile # Kernel32.InvalidHandleValue );
- ASSERT( Kernel32.SetFilePointerEx( hfile, pos, fpos , Kernel32.FileBegin ) # Kernel32.False );
- res := Kernel32.WriteFile( hfile, buffer.data, buffer.len, n, NIL )
- END;
- ASSERT( (res # Kernel32.False) & (n = buffer.len) );
- INC( fpos, n ); buffer.dirty := FALSE
- END WriteBuffer;
- PROCEDURE ReadBuffer( apos: HUGEINT );
- VAR pos: HUGEINT; n: LONGINT; res, b: Kernel32.BOOL;
- BEGIN
- IF buffer.dirty THEN WriteBuffer() END;
- pos := apos * BufferSize;
- IF pos >= fsize THEN buffer.apos := apos; buffer.len := 0; RETURN END;
- IF fpos # pos THEN
- ASSERT( Kernel32.SetFilePointerEx( hfile, pos, fpos , Kernel32.FileBegin ) # Kernel32.False );
- IF (fpos # pos) THEN KernelLog.String( "failed to set buffer: " ); KernelLog.String( fname ); KernelLog.Ln END;
- ASSERT( fpos = pos )
- END;
- res := Kernel32.ReadFile( hfile, buffer.data, BufferSize, n, NIL );
- IF res = 0 THEN KernelLog.String( "read file did not work for: " ); KernelLog.String( fname ); KernelLog.Ln; END;
- ASSERT( res # 0 ); INC( fpos, n ); buffer.apos := apos; buffer.len := n
- END ReadBuffer;
- PROCEDURE Read*( VAR r: Files.Rider; VAR x: CHAR );
- VAR pos: HUGEINT;
- BEGIN {EXCLUSIVE}
- pos := r.apos * BufferSize + r.bpos;
- IF pos < fsize THEN
- IF buffer.apos # r.apos THEN ReadBuffer( r.apos ) END;
- x := buffer.data[r.bpos]; INC( pos ); r.apos := pos DIV BufferSize; r.bpos := LONGINT( pos MOD BufferSize )
- ELSE
- x := 0X; r.eof := TRUE
- END
- END Read;
- PROCEDURE ReadBytes*( VAR r: Files.Rider; VAR x: ARRAY OF CHAR; ofs, len: LONGINT );
- VAR pos: HUGEINT; n: LONGINT;
- BEGIN {EXCLUSIVE}
- ASSERT( (ofs + len) <= LEN( x ) );
- pos := r.apos * BufferSize + r.bpos;
- WHILE (len > 0) & (pos < fsize) DO
- IF buffer.apos # r.apos THEN ReadBuffer( r.apos ) END;
- n := buffer.len - r.bpos;
- IF (n > 0) THEN
- IF n > len THEN n := len END;
- SYSTEM.MOVE( ADDRESSOF( buffer.data[r.bpos] ), ADDRESSOF( x[ofs] ), n );
- INC( pos, n ); INC( ofs, n ); DEC( len, n );
- r.apos := pos DIV BufferSize; r.bpos := LONGINT( pos MOD BufferSize );
- ELSE
- pos := fsize;
- END;
- END;
- r.res := len; r.eof := (pos > fsize) OR ((pos = fsize) & (len > 0));
- END ReadBytes;
- PROCEDURE Write*( VAR r: Files.Rider; x: CHAR );
- VAR pos: HUGEINT;
- BEGIN {EXCLUSIVE}
- pos := r.apos * BufferSize + r.bpos;
- IF buffer.apos # r.apos THEN ReadBuffer( r.apos ) END;
- buffer.data[r.bpos] := x; INC( pos );
- IF (r.bpos + 1) > buffer.len THEN buffer.len := r.bpos + 1 END;
- r.apos := pos DIV BufferSize; r.bpos := LONGINT( pos MOD BufferSize );
- IF pos > fsize THEN fsize := pos END;
- buffer.dirty := TRUE;
- END Write;
- PROCEDURE WriteBytes*( VAR r: Files.Rider; CONST x: ARRAY OF CHAR; ofs, len: LONGINT );
- VAR pos: HUGEINT; n: LONGINT;
- BEGIN {EXCLUSIVE}
- IF len = 0 THEN RETURN END;
- ASSERT( (len > 0) & ((ofs + len) <= LEN( x )) ); pos := r.apos * BufferSize + r.bpos;
- WHILE len > 0 DO
- IF buffer.apos # r.apos THEN ReadBuffer( r.apos ) END;
- n := BufferSize - r.bpos;
- IF n > len THEN n := len END;
- SYSTEM.MOVE( ADDRESSOF( x[ofs] ), ADDRESSOF( buffer.data[r.bpos] ), n );
- IF (r.bpos + n) > buffer.len THEN buffer.len := r.bpos + n END;
- INC( pos, n ); INC( ofs, n ); DEC( len, n ); r.apos := pos DIV BufferSize; r.bpos := LONGINT( pos MOD BufferSize );
- IF pos > fsize THEN fsize := pos END;
- buffer.dirty := TRUE
- END
- END WriteBytes;
- PROCEDURE Length*( ): HUGEINT;
- BEGIN {EXCLUSIVE}
- RETURN fsize
- END Length;
- PROCEDURE GetDate*( VAR t, d: LONGINT );
- VAR ft, lft: Kernel32.FileTime; st: Kernel32.SystemTime; res: Kernel32.BOOL;
- BEGIN {EXCLUSIVE}
- res := Kernel32.GetFileTime( hfile, NIL , NIL , ft );
- (*
- ASSERT ( res # 0 ); (* <- only if file is not temporary ! *)
- *)
- res := Kernel32.FileTimeToLocalFileTime( ft, lft ); res := Kernel32.FileTimeToSystemTime( lft, st ); 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 )
- END GetDate;
- PROCEDURE SetDate*( t, d: LONGINT );
- VAR ft, lft: Kernel32.FileTime; st: Kernel32.SystemTime; res: Kernel32.BOOL; err: LONGINT;
- BEGIN {EXCLUSIVE}
- 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;
- 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 );
- res := Kernel32.LocalFileTimeToFileTime( lft, ft ); res := Kernel32.SetFileTime( hfile, NIL , NIL , ft );
- IF res = 0 THEN err := Kernel32.GetLastError(); DebugFile(SELF) END;
- ASSERT( res # 0 )
- END SetDate;
- PROCEDURE GetAttributes*(): SET;
- VAR s: SET;
- BEGIN
- s := ToSet(Kernel32.GetFileAttributes( fname ));
- RETURN FileFlags(s);
- END GetAttributes;
- PROCEDURE SetAttributes*(a: SET);
- VAR s: SET;
- BEGIN
- s:= WindowsFlags(a);
- SetFileAttributes(fname,s);
- END SetAttributes;
- PROCEDURE GetName*( VAR name: ARRAY OF CHAR );
- VAR i: LONGINT; ch: CHAR;
- BEGIN {EXCLUSIVE}
- COPY( fname, name ); i := 0; ch := name[0];
- WHILE ch # 0X DO
- IF ch = PathDelimiter THEN name[i] := Files.PathDelimiter END;
- INC( i ); ch := name[i]
- END
- END GetName;
- PROCEDURE ToTemp( ): BOOLEAN;
- VAR tfname: PFileName; res: Kernel32.BOOL;
- from, to: ARRAY 256 OF CHAR;
- BEGIN {EXCLUSIVE}
- ASSERT( ~(Temporary IN flags) );
- (*ALEX 2005.12.08*)
- IF hfile = Kernel32.InvalidHandleValue THEN
- hfile := Kernel32.CreateFile( fname, Kernel32.SetToDW({Kernel32.GenericRead}), Kernel32.SetToDW({Kernel32.FileShareRead, Kernel32.FileShareWrite}), NIL , Kernel32.CreateAlways, Kernel32.SetToDW({Kernel32.FileAttributeNormal}), 0 );
- END;
- IF hfile = Kernel32.InvalidHandleValue THEN
- hfile := Kernel32.CreateFile( fname, Kernel32.SetToDW({Kernel32.GenericRead}), Kernel32.SetToDW({Kernel32.FileShareRead, Kernel32.FileShareWrite}), NIL , Kernel32.OpenExisting, Kernel32.SetToDW({Kernel32.FileAttributeNormal}), 0 );
- END;
- IF buffer.dirty THEN WriteBuffer() END;
- (*
- IF hfile # Kernel32.InvalidHandleValue THEN
- *)
- ASSERT(hfile # Kernel32.InvalidHandleValue);
- ASSERT(Kernel32.GetFileSizeEx(hfile, fsize) # Kernel32.False);
- res := Kernel32.CloseHandle( hfile );
- hfile := Kernel32.InvalidHandleValue;
- (*
- END;
- *)
- NEW( tfname ); TempName( tfname^ ); COPY( fname, from ); COPY( tfname^, to );
- IF TraceFile IN Trace THEN KernelLog.String( "toTemp: " ); KernelLog.String( fname ); KernelLog.String( " => " ); KernelLog.String( tfname^ ); KernelLog.Ln; END;
- IF ~MoveFile( fname, tfname^ ) THEN HALT( 1241 ) (* RETURN FALSE *) END;
- winFS.collection.Unregister( SELF );
- hfile := Kernel32.CreateFile( tfname^, Kernel32.SetToDW({Kernel32.GenericRead, Kernel32.GenericWrite}), Kernel32.SetToDW({Kernel32.FileShareRead}), NIL , Kernel32.OpenExisting, Kernel32.SetToDW({Kernel32.FileAttributeTemporary}), 0 );
- (* IF hfile = Kernel32.InvalidHandleValue THEN RETURN FALSE END; *)
- ASSERT( hfile # Kernel32.InvalidHandleValue );
- ASSERT( Kernel32.GetFileSizeEx( hfile, fsize ) # Kernel32.False );
- SELF.tfname := tfname;
- COPY( tfname^, fname );
- RETURN TRUE;
- END ToTemp;
- PROCEDURE Register0*( VAR res: LONGINT );
- VAR F: File; ret: Kernel32.BOOL;
- from, to: ARRAY 256 OF CHAR;
- BEGIN {EXCLUSIVE}
- IF ~(Temporary IN flags) OR (fname = "") THEN res := 1; RETURN END;
- IF buffer.dirty THEN WriteBuffer() END;
- IF hfile # Kernel32.InvalidHandleValue THEN ret := Kernel32.CloseHandle( hfile ); hfile := Kernel32.InvalidHandleValue END;
- IF TraceFile IN Trace THEN KernelLog.String( "Register: existing?: " ); KernelLog.String( fname ); KernelLog.Ln; END;
- F := winFS.collection.ByName( fname );
- IF (TraceFile IN Trace) & (F = NIL ) THEN KernelLog.String( "Register: not existing: " ); KernelLog.String( fname ); KernelLog.Ln; END;
- IF (F # NIL ) THEN
- IF ~F.ToTemp() THEN res := 1; RETURN END
- END; (* registered file stays alive for its users *)
- IF tfname # NIL THEN
- COPY( tfname^, from ); COPY( fname, to );
- IF ~MoveFile( tfname^, fname ) THEN
- (* first try closing file -> for windows versions < 2000 *)
- res := 1; RETURN;
- (* HALT( 1242 )*)
- END;
- hfile := Kernel32.CreateFile( fname, Kernel32.SetToDW({Kernel32.GenericRead, Kernel32.GenericWrite}), Kernel32.SetToDW({Kernel32.FileShareRead, Kernel32.FileShareWrite}), NIL , Kernel32.OpenExisting, Kernel32.SetToDW({Kernel32.FileAttributeNormal}), 0 )
- ELSE hfile := Kernel32.CreateFile( fname, Kernel32.SetToDW({Kernel32.GenericRead, Kernel32.GenericWrite}), Kernel32.SetToDW({Kernel32.FileShareRead, Kernel32.FileShareWrite}), NIL , Kernel32.CreateAlways, Kernel32.SetToDW({Kernel32.FileAttributeNormal}), 0 )
- END;
- IF hfile = Kernel32.InvalidHandleValue THEN res := 1; RETURN END;
- ASSERT( hfile # Kernel32.InvalidHandleValue ); winFS.collection.Register( SELF ); res := 0
- END Register0;
- PROCEDURE Update*;
- BEGIN {EXCLUSIVE}
- IF buffer.dirty THEN WriteBuffer() END
- END Update;
- PROCEDURE Finalize*;
- VAR res: Kernel32.BOOL;
- BEGIN {EXCLUSIVE}
- IF TraceFile IN Trace THEN KernelLog.String( "File.Finalize " ); KernelLog.String( fname ); KernelLog.Ln; END;
- IF hfile # Kernel32.InvalidHandleValue THEN
- IF ~(Temporary IN flags) & buffer.dirty THEN WriteBuffer() END;
- res := Kernel32.CloseHandle( hfile ); hfile := Kernel32.InvalidHandleValue;
- IF (Temporary IN flags) & (tfname # NIL ) THEN
- res := Kernel32.DeleteFile( tfname^ );
- (*
- KernelLog.String("Deleted: "); KernelLog.String(tfname^); KernelLog.Ln;
- IF res = 0 THEN KernelLog.String("failed!"); KernelLog.Ln; END;
- *)
- (* ASSERT ( res # 0 ) *)
- END;
- (* ASSERT ( res # 0 ) *)
- END
- END Finalize;
- PROCEDURE Close*;
- BEGIN
- Finalize;
- fileSystem.collection.oldFiles.Remove(SELF);
- END Close;
- END File;
- VAR
- winFS: WinFileSystem; (* must be unique *)
- PROCEDURE ToSet(d: UNSIGNED32): SET;
- BEGIN
- RETURN SYSTEM.VAL(SET, ADDRESS(d));
- END ToSet;
-
- PROCEDURE DebugFile(f: File);
- BEGIN
- KernelLog.String("fname = "); KernelLog.String(f.fname); KernelLog.Ln;
- KernelLog.String("tname = "); IF f.tfname # NIL THEN KernelLog.String(f.tfname^) ELSE KernelLog.String("(NIL)") END; KernelLog.Ln;
- KernelLog.String("hfile = "); KernelLog.Address(f.hfile); KernelLog.Ln;
- KernelLog.String("fsize = "); KernelLog.Int(f.fsize, 1); KernelLog.Ln;
- KernelLog.String("fpos = "); KernelLog.Int(f.fpos, 1); KernelLog.Ln;
- END DebugFile;
- PROCEDURE IsLocalPath(path: ARRAY OF CHAR): BOOLEAN;
- VAR prefix, name: Files.FileName;
- BEGIN
- ConvertChar(path, PathDelimiter, Files.PathDelimiter);
- Files.SplitName(path, prefix, name);
- RETURN (prefix = "") & (name[0] # "/")
- END IsLocalPath;
- (* WinAPI functions like e.g. GetCurrentDirectory sometimes yield paths with drive letters in lowercase
- which have to be capitalized as they are mapped as filesystems which themselves are case sensitive *)
- PROCEDURE FixDriveLetter (VAR path: ARRAY OF CHAR);
- BEGIN
- IF (LEN (path) >= 2) & (path[0] # 0X) & (path[1] = ':') THEN path[0] := CAP (path[0]) END;
- END FixDriveLetter;
- PROCEDURE MoveFile( VAR from, to: ARRAY OF CHAR ): BOOLEAN;
- BEGIN
- IF Kernel32.MoveFileEx( from, to, Kernel32.SetToDW({Kernel32.MoveFileReplaceExisting, Kernel32.MoveFileCopyAllowed}) ) = Kernel32.False THEN
- IF Kernel32.CopyFile( from, to, Kernel32.False ) = Kernel32.False THEN
- IF TraceFile IN Trace THEN KernelLog.String( "could not copy" ); KernelLog.Ln; END;
- RETURN FALSE
- ELSE
- IF Kernel32.DeleteFile( from ) = Kernel32.False THEN
- END;
- RETURN TRUE; (* warning: Could not delete file ! *)
- END
- ELSE RETURN TRUE
- END
- END MoveFile;
- PROCEDURE UpperCase( VAR src, dst: ARRAY OF CHAR );
- VAR i: LONGINT; ch: CHAR;
- BEGIN
- i := 0; ch := src[0];
- WHILE ch # 0X DO
- IF (ch >= "a") & (ch <= "z") THEN ch := CAP( ch ) END;
- dst[i] := ch; INC( i ); ch := src[i]
- END;
- dst[i] := 0X
- END UpperCase;
- PROCEDURE TempName( VAR name: ARRAY OF CHAR );
- VAR temp: FileName;
- pref: ARRAY 4 OF CHAR;
- ret: LONGINT;
- BEGIN
- ret := Kernel32.GetTempPath( LEN( temp ), temp ); ASSERT( ret > 0 ); pref := "Aos"; ret := Kernel32.GetTempFileName( temp, pref, 0, name ); FixDriveLetter (name); ASSERT( ret # 0 )
- END TempName;
- PROCEDURE FullPathName( name: ARRAY OF CHAR; VAR fname: ARRAY OF CHAR ): BOOLEAN;
- VAR i, fp: LONGINT;
- BEGIN
- i := Kernel32.GetFullPathName( name, Kernel32.MaxPath, fname, fp );
- FixDriveLetter (fname); RETURN i > 0
- END FullPathName;
- (* convert flags from windows file flags to A2 file flags *)
- PROCEDURE FileFlags( flags: SET ): SET;
- VAR s: SET;
- BEGIN
- s := {};
- IF Kernel32.FileAttributeDirectory IN flags THEN INCL( s, Directory ) END;
- IF Kernel32.FileAttributeReadonly IN flags THEN INCL( s, ReadOnly ) END;
- IF Kernel32.FileAttributeHidden IN flags THEN INCL( s, Hidden ) END;
- IF Kernel32.FileAttributeSystem IN flags THEN INCL( s, System ) END;
- IF Kernel32.FileAttributeArchive IN flags THEN INCL( s, Archive ) END;
- IF Kernel32.FileAttributeTemporary IN flags THEN INCL( s, Temporary ) END;
- RETURN s
- END FileFlags;
- (* convert flags from A2 file flags to windows file flags *)
- PROCEDURE WindowsFlags(flags: SET): SET;
- VAR s: SET;
- BEGIN
- s := {};
- IF Directory IN flags THEN INCL( s, Kernel32.FileAttributeDirectory) END;
- IF ReadOnly IN flags THEN INCL( s, Kernel32.FileAttributeReadonly ) END;
- IF Hidden IN flags THEN INCL( s, Kernel32.FileAttributeHidden) END;
- IF System IN flags THEN INCL( s, Kernel32.FileAttributeSystem) END;
- IF Archive IN flags THEN INCL( s, Kernel32.FileAttributeArchive) END;
- IF Temporary IN flags THEN INCL( s, Kernel32.FileAttributeTemporary) END;
- RETURN s
- END WindowsFlags;
- (** Generate a new file system object. Files.NewVol has volume parameter, Files.Par has mount prefix. *)
- PROCEDURE NewFS*(context : Files.Parameters);
- VAR fs: AliasFileSystem;
- BEGIN
- IF (Files.This(context.prefix ) = NIL) THEN
- NEW( fs ); fs.vol := context.vol; Files.Add( fs, context.prefix );
- ELSE
- context.error.String( "HostFiles64: " ); context.error.String( context.prefix ); context.error.String( " already in use" );
- context.error.Ln;
- END;
- END NewFS;
- PROCEDURE Join( a1, a2, a3: ARRAY OF CHAR; VAR res: ARRAY OF CHAR );
- VAR i, j: LONGINT;
- BEGIN
- i := 0;
- WHILE (a1[i] # 0X) DO res[j] := a1[i]; INC( i ); INC( j ) END;
- i := 0;
- WHILE (a2[i] # 0X) DO res[j] := a2[i]; INC( i ); INC( j ) END;
- i := 0;
- WHILE (a3[i] # 0X) DO res[j] := a3[i]; INC( i ); INC( j ) END;
- res[j] := 0X
- END Join;
- (*ALEX 2005.02.10, fof 071008*)
- PROCEDURE MountDrive(CONST drive: ARRAY OF CHAR; context : Commands.Context);
- VAR
- p: Files.Parameters; namebuf1, namebuf2: FileName; size, snum, mlen, sysfl: LONGINT;
- res: LONGINT; prefix: ARRAY 256 OF CHAR;
- BEGIN
- COPY(drive,prefix);
- size := LEN( namebuf1 ); res := Kernel32.GetVolumeInformation( prefix, namebuf1, size, snum, mlen, sysfl, namebuf2, size );
- IF res = 0 THEN
- IF context# NIL THEN
- context.error.String("Not mounted (no volume information): "); context.error.String(prefix); context.error.Ln;
- context.error.Update;
- END;
- ELSE
- IF (context = NIL) THEN
- NEW(context, NIL, NIL, NIL, NIL, NIL);
- END;
- NEW(p, context.in, context.arg, context.out, context.error, context.caller);
- IF TraceMounting THEN
- context.out.String( "Mounting: " ); context.out.String( drive );
- context.out.String( " (" ); context.out.String( namebuf1 ); context.out.String( "), fs = " );
- context.out.String( namebuf2 ); context.out.Ln;
- context.out.Update;
- END;
- prefix[1] := 0X;
- COPY( prefix, p.prefix );
- NewFS( p );
- END;
- END MountDrive;
- PROCEDURE AutoMountWindowsLogicalDrives( drives: SET );
- (* fof 090221
- implemented asynchronously as it blocked execution on A2 startup for a while;
- now some of the drives may get mounted later in the system,
- should not be a problem since the search path is handled through windows anyway
- *)
- VAR
- AutoMountObject: OBJECT
- VAR prefix: ARRAY 4 OF CHAR; i: LONGINT; drives: SET;
- PROCEDURE & Init(drives:SET);
- BEGIN
- SELF.drives := drives
- END Init;
- BEGIN {ACTIVE}
- FOR i := 0 TO MAX( SET ) - 1 DO
- IF i IN drives THEN
- prefix := "X:\"; prefix[0] := CHR( ORD( "A" ) + i );
- MountDrive(prefix, NIL);
- END;
- END;
- END;
- BEGIN
- NEW(AutoMountObject,drives);
- END AutoMountWindowsLogicalDrives;
- PROCEDURE UnmountDrive(CONST drive: ARRAY OF CHAR; context : Commands.Context);
- VAR this: Files.FileSystem;
- BEGIN
- this := Files.This( drive );
- IF (this # NIL ) & (this IS AliasFileSystem) THEN
- IF (context # NIL) THEN
- context.out.String( "Auto Unmount: " ); context.out.String( drive );
- context.out.String( ":" ); context.out.Ln;
- ELSE
- KernelLog.String("Auto Unmount: "); KernelLog.String(drive); KernelLog.String(":"); KernelLog.Ln;
- END;
- Files.Remove( this );
- END;
- END UnmountDrive;
- PROCEDURE AutoUnmountLogicalDrives( drives: SET );
- VAR i: LONGINT;
- prefix: ARRAY 4 OF CHAR;
- BEGIN
- FOR i := 0 TO MAX( SET ) - 1 DO
- IF i IN drives THEN
- prefix[0] := CHR( ORD( "A" ) + i ); prefix[1] := 0X;
- UnmountDrive(prefix, NIL);
- END;
- END;
- END AutoUnmountLogicalDrives;
- PROCEDURE Finalization;
- VAR ft: Files.FileSystemTable; i: LONGINT;
- BEGIN
- Files.GetList( ft );
- IF ft # NIL THEN
- FOR i := 0 TO LEN( ft^ ) - 1 DO
- IF ft[i] IS AliasFileSystem THEN Files.Remove( ft[i] ) END
- END
- END;
- winFS.Finalize;
- END Finalization;
- PROCEDURE FindFile*( name: ARRAY OF CHAR; VAR fullname: ARRAY OF CHAR ): BOOLEAN;
- VAR ret: LONGINT; fileName: Kernel32.LPSTR;
- BEGIN
- ret := Kernel32.SearchPath( workPath, name, NIL , LEN( fullname ), fullname, fileName );
- IF (ret <= 0) THEN ret := Kernel32.SearchPath( searchPath, name, NIL , LEN( fullname ), fullname, fileName ) END;
- FixDriveLetter (fullname);
- RETURN ret > 0;
- END FindFile;
- PROCEDURE ConvertChar*( VAR name: ARRAY OF CHAR; from, to: CHAR );
- VAR i: LONGINT;
- BEGIN
- i := 0;
- WHILE name[i] # 0X DO
- IF name[i] = from THEN name[i] := to END;
- INC( i )
- END
- END ConvertChar;
- PROCEDURE SetPaths;
- VAR ret, i, j, k: LONGINT;
- work, files, temp: ARRAY Kernel32.MaxPath OF CHAR;
- directories, dirs: ARRAY 4 * Kernel32.MaxPath OF CHAR;
- dir, sysPath: FileName;
- PROCEDURE SetSysPath(VAR dir: ARRAY OF CHAR);
- VAR ch: CHAR; i: LONGINT;
- BEGIN
- IF (dir[0] = "~") & (dir[1] = PathDelimiter) THEN
- Kernel32.SetCurrentDirectory( sysPath );
- i := 2;
- REPEAT ch := dir[i]; dir[i-2] := ch; INC(i) UNTIL ch = 0X;
- ELSE
- Kernel32.SetCurrentDirectory(workPath)
- END;
- END SetSysPath;
- PROCEDURE AddDir;
- BEGIN
- IF k > 0 THEN
- dir[k] := 0X;
- IF dir[k - 1] = '"' THEN dir[k - 1] := 0X END;
- ConvertChar( dir, Files.PathDelimiter, PathDelimiter );
- SetSysPath(dir);
- IF Kernel32.SetCurrentDirectory( dir ) # Kernel32.False THEN
- Kernel32.GetCurrentDirectory( LEN( dir ), dir ); searchPath[i] := ";"; INC( i ); k := 0;
- WHILE dir[k] # 0X DO searchPath[i] := dir[k]; INC( i ); INC( k ) END
- END;
- k := 0
- END
- END AddDir;
- BEGIN {EXCLUSIVE}
- Machine.GetConfig( "Paths.Files", files ); Machine.GetConfig( "Paths.Search", directories );
- Machine.GetConfig( "Paths.Temp", temp ); Machine.GetConfig( "Paths.Work", work );
- Kernel32.GetCurrentDirectory( LEN( workPath ), workPath ); i := 0; ret := 0;
- IF files # "" THEN
- COPY( files, sysPath );
- IF Kernel32.SetCurrentDirectory( sysPath ) # Kernel32.False THEN ret := Kernel32.GetCurrentDirectory( LEN( sysPath ), sysPath ) END
- END;
- IF ret = 0 THEN
- Kernel32.GetModuleFileName( Kernel32.hInstance, sysPath, LEN( sysPath ) ); j := -1;
- WHILE sysPath[i] # 0X DO
- IF sysPath[i] = PathDelimiter THEN j := i END;
- INC( i )
- END;
- i := j + 1; sysPath[i] := 0X; COPY( sysPath, searchPath )
- ELSE
- WHILE sysPath[i] # 0X DO searchPath[i] := sysPath[i]; INC( i ) END;
- searchPath[i] := 0X
- END;
- COPY( directories, dirs );
- IF dirs[0] = '"' THEN j := 1 ELSE j := 0 END;
- k := 0;
- WHILE dirs[j] # 0X DO
- IF (dirs[j] = ";") OR (dirs[j] < " ") THEN AddDir() ELSE dir[k] := dirs[j]; INC( k ) END;
- INC( j )
- END;
- AddDir(); searchPath[i] := 0X; ret := 0;
- COPY( temp, tempPath );
- IF tempPath # "" THEN
- ConvertChar( tempPath, Files.PathDelimiter, PathDelimiter );
- SetSysPath(tempPath);
- IF Kernel32.SetCurrentDirectory( tempPath ) # Kernel32.False THEN ret := Kernel32.GetCurrentDirectory( LEN( tempPath ), tempPath ) END
- END;
- IF ret = 0 THEN Kernel32.GetTempPath( LEN( tempPath ), tempPath ) END;
- COPY( work, dir );
- IF dir # "" THEN
- ConvertChar( dir, Files.PathDelimiter, PathDelimiter );
- SetSysPath(dir);
- IF Kernel32.SetCurrentDirectory( dir ) # Kernel32.False THEN Kernel32.GetCurrentDirectory( LEN( workPath ), workPath ) END
- END;
- Kernel32.SetCurrentDirectory( workPath );
- END SetPaths;
- PROCEDURE SameName*( VAR a, b: ARRAY OF CHAR ): BOOLEAN; (** non-portable *)
- VAR i, j: LONGINT;
- BEGIN
- i := 0; j := 0;
- WHILE (a[i] # 0X) & (b[j] # 0X) & (CAP( a[i] ) = CAP( b[j] )) DO INC( i ); INC( j ) END;
- RETURN (a[i] = 0X) & (b[j] = 0X)
- END SameName;
- PROCEDURE CheckPath(fullName: ARRAY OF CHAR ): BOOLEAN;
- VAR i, j: LONGINT; done: BOOLEAN;
- BEGIN
- i := 0; j := -1;
- WHILE fullName[i] # 0X DO
- IF fullName[i] = PathDelimiter THEN j := i END;
- INC( i )
- END;
- IF j > 0 THEN fullName[j] := 0X END;
- BEGIN {EXCLUSIVE}
- done := Kernel32.SetCurrentDirectory( fullName ) # Kernel32.False;
- Kernel32.SetCurrentDirectory( workPath ); RETURN done
- END;
- END CheckPath;
- PROCEDURE CheckName*( name: ARRAY OF CHAR ): BOOLEAN;
- VAR fullName: FileName; fileNamePart: Kernel32.LPSTR; ret, i: SIZE; ch: CHAR; stream, ok: BOOLEAN;
- BEGIN
- ConvertChar( name, Files.PathDelimiter, PathDelimiter ); ret := Kernel32.GetFullPathName( name, Kernel32.MaxPath, fullName, fileNamePart );
- IF (ret > 0) & CheckPath( fullName ) & (fileNamePart # Kernel32.NULL) THEN
- ok := TRUE; stream := FALSE; i := fileNamePart - ADDRESSOF( fullName ); fullName[i - 1] := 0X; ch := fullName[i];
- WHILE (ch # 0X) & ok DO
- IF ch = ":" THEN
- IF stream THEN ok := FALSE ELSE stream := TRUE END
- ELSIF (ch = ":") OR (ch = "\") OR (ch = "?") OR (ch = "|") OR (ch = ">") OR (ch = "<") OR (ch = "/") OR (ch = "*") OR (ch = '"') THEN ok := FALSE;
- END;
- (* \ / : * ? " < > | *)
- INC( i ); ch := fullName[i]
- END
- ELSE ok := FALSE
- END;
- RETURN ok
- END CheckName;
- PROCEDURE GetAttributes*( file: ARRAY OF CHAR ): SET; (** non-portable *)
- VAR attrs: SET;
- BEGIN
- ConvertChar( file, Files.PathDelimiter, PathDelimiter ); attrs := ToSet(Kernel32.GetFileAttributes( file ));
- IF attrs = {0..31} THEN RETURN {} ELSE RETURN attrs END
- END GetAttributes;
- PROCEDURE SetAttributes*( file: ARRAY OF CHAR; attrs: SET ); (** non-portable *)
- BEGIN
- ConvertChar( file, Files.PathDelimiter, PathDelimiter ); Kernel32.SetFileAttributes( file, Kernel32.SetToDW(attrs) )
- END SetAttributes;
- PROCEDURE SetFileAttributes*( file: ARRAY OF CHAR; attrs: SET ); (** non-portable *)
- BEGIN
- ConvertChar( file, Files.PathDelimiter, PathDelimiter ); Kernel32.SetFileAttributes( file, Kernel32.SetToDW(attrs) )
- END SetFileAttributes;
- (** Get the current directory. *)
- PROCEDURE GetWorkingDirectory*( VAR path: ARRAY OF CHAR );
- BEGIN {EXCLUSIVE}
- Kernel32.GetCurrentDirectory( Kernel32.MaxPath, workPath ); COPY( workPath, path ); ConvertChar( path, PathDelimiter, Files.PathDelimiter ); FixDriveLetter (path);
- END GetWorkingDirectory;
- (** Change to directory path. *)
- PROCEDURE ChangeDirectory*( path: ARRAY OF CHAR; VAR done: BOOLEAN );
- BEGIN {EXCLUSIVE}
- ConvertChar( path, Files.PathDelimiter, PathDelimiter ); done := Kernel32.SetCurrentDirectory( path ) # Kernel32.False; Kernel32.GetCurrentDirectory( Kernel32.MaxPath, workPath );
- END ChangeDirectory;
- (** Get the directory for temporary files. *)
- PROCEDURE GetTempDirectory*( VAR path: ARRAY OF CHAR );
- BEGIN
- COPY( tempPath, path ); ConvertChar( path, PathDelimiter, Files.PathDelimiter )
- END GetTempDirectory;
- (** Compute the relative filename (relative to the working directory). *)
- PROCEDURE RelFileName*( fileName: ARRAY OF CHAR; VAR relFileName: ARRAY OF CHAR );
- VAR i, j, k, p: LONGINT; fullName: FileName; fileNamePart: Kernel32.LPSTR;
- BEGIN
- IF ~FindFile( fileName, fullName ) THEN (* file does not exist -> would be created in the current dir *)
- ConvertChar( fileName, Files.PathDelimiter, PathDelimiter ); Kernel32.GetFullPathName( fileName, Kernel32.MaxPath, fullName, fileNamePart ); FixDriveLetter (fullName);
- ELSE ConvertChar( fullName, Files.PathDelimiter, PathDelimiter )
- END; (* from here on all with PathDelimiter and drive letter *)
- IF CAP( workPath[0] ) # CAP( fullName[0] ) THEN (* different drive letters -> nothing to be done *)
- COPY( fullName, relFileName )
- ELSE
- i := 0; j := -1; p := 0;
- WHILE CAP( fullName[i] ) = CAP( workPath[i] ) DO
- IF workPath[i] = PathDelimiter THEN j := i END;
- INC( i )
- END;
- IF workPath[i] = 0X THEN
- IF fullName[i] # PathDelimiter THEN (* first part of directories do match *)
- relFileName[p] := "."; relFileName[p + 1] := "."; relFileName[p + 2] := PathDelimiter; INC( p, 3 ); INC( j );
- WHILE fullName[j] # 0X DO relFileName[p] := fullName[j]; INC( j ); INC( p ) END
- ELSE (* file is in a subdirectory of the current dir *)
- INC( i );
- WHILE fullName[i] # 0X DO relFileName[p] := fullName[i]; INC( i ); INC( p ) END
- END
- ELSIF j > 2 THEN (* first part of directories do match *)
- k := j; i := j + 1;
- WHILE workPath[k] # 0X DO
- IF workPath[k] = PathDelimiter THEN relFileName[p] := "."; relFileName[p + 1] := "."; relFileName[p + 2] := PathDelimiter; INC( p, 3 ) END;
- INC( k )
- END;
- WHILE fullName[i] # 0X DO relFileName[p] := fullName[i]; INC( i ); INC( p ) END
- ELSE (* only drive letters match *)
- i := j;
- WHILE fullName[i] # 0X DO relFileName[p] := fullName[i]; INC( i ); INC( p ) END
- END;
- relFileName[p] := 0X
- END;
- ConvertChar( relFileName, PathDelimiter, Files.PathDelimiter )
- END RelFileName;
- PROCEDURE DeviceNotification*( type: LONGINT; drives: SET );
- VAR n: Notification;
- BEGIN
- IF type = deviceArrival THEN AutoMountWindowsLogicalDrives( drives );
- ELSIF type = deviceRemove THEN AutoUnmountLogicalDrives( drives );
- ELSE
- (* scan for changes *)
- END;
- n := notifications;
- WHILE(n#NIL) DO
- n.p(type,drives);
- n := n.next;
- END;
- END DeviceNotification;
- PROCEDURE RegisterNotification*( p: NotificationProc );
- VAR n: Notification;
- BEGIN
- NEW( n ); n.p := p; n.next := notifications; notifications := n;
- END RegisterNotification;
- PROCEDURE Init;
- VAR
- i, j: LONGINT; sysPath: FileName; p: Files.Parameters; drives: SET; fs : Files.FileSystem;
- BEGIN
- NEW( winFS );
- NEW( p, NIL, NIL, NIL, NIL, NIL); p.prefix := "searcher";
- NewFS( p );
- fs := Files.This(p.prefix);
- IF (fs # NIL) & (fs IS AliasFileSystem) THEN
- fs( AliasFileSystem ).useprefix := FALSE;
- EXCL( fs( AliasFileSystem ).flags, Files.NeedsPrefix );
- END;
- (* now the file system is installed *)
- drives := ToSet(Kernel32.GetLogicalDrives());
- drives := drives - {0,1}; (* do not scan for diskettes *)
- AutoMountWindowsLogicalDrives( drives );
- Kernel32.GetCurrentDirectory( LEN( workPath ), workPath ); i := 0; Kernel32.GetModuleFileName( Kernel32.hInstance, sysPath, LEN( sysPath ) ); j := -1;
- FixDriveLetter (workPath); FixDriveLetter (sysPath);
- WHILE sysPath[i] # 0X DO
- IF sysPath[i] = PathDelimiter THEN j := i END;
- INC( i )
- END;
- i := j + 1; sysPath[i] := 0X; COPY( sysPath, searchPath ); Kernel32.GetTempPath( LEN( tempPath ), tempPath ); Kernel32.SetCurrentDirectory( workPath );
- notifications := NIL;
- END Init;
- PROCEDURE AddSearchPath*(context: Commands.Context);
- VAR name,fullName: FileName; i,j: LONGINT; ch : CHAR; ret: LONGINT; fileNamePart: Kernel32.LPSTR;
- BEGIN
- IF context.arg.GetString(name) THEN
- i := 0; j := 0;
- ConvertChar( name, Files.PathDelimiter, PathDelimiter );
- ret := Kernel32.GetFullPathName( name, Kernel32.MaxPath, fullName, fileNamePart );
- WHILE(searchPath[i] # 0X) DO
- INC(i);
- END;
- searchPath[i] := ";";INC(i);
- REPEAT
- ch := fullName[j];
- searchPath[i] := ch;
- INC(j);INC(i);
- UNTIL ch = 0X;
- END;
- END AddSearchPath;
- PROCEDURE SetWorkPath*(context: Commands.Context);
- VAR name: FileName; done: BOOLEAN;
- BEGIN
- IF context.arg.GetString(name) THEN
- ChangeDirectory(name, done);
- IF ~done THEN
- context.error.String("could not change directory to "); context.error.String(name); context.error.Ln;
- END
- END;
- END SetWorkPath;
- PROCEDURE Mount*(context : Commands.Context);
- VAR diskname: ARRAY 256 OF CHAR;
- BEGIN
- context.arg.SkipWhitespace;
- context.arg.String(diskname);
- MountDrive(diskname, context);
- END Mount;
- PROCEDURE Unmount*(context : Commands.Context);
- VAR diskname: ARRAY 256 OF CHAR;
- BEGIN
- context.arg.SkipWhitespace;
- context.arg.String(diskname);
- UnmountDrive(diskname, context);
- END Unmount;
- BEGIN
- Init(); Modules.InstallTermHandler( Finalization ); SetPaths;
- END HostFiles64.
|