Syntax10.Scn.FntSyntax10i.Scn.Fnt ](v% IiParcElemsAlloc Syntax10b.Scn.FntSyntax8i.Scn.Fnt        !        Z  M  8FoldElemsNew 8888o,8Z < >8 D&DGW8 MarkElemsAlloczσ>8,8 {σP8,8#Syntax10.Scn.FntERROR_FILE_NOT_FOUND88#Syntax10.Scn.FntERROR_INVALID_NAME88#Syntax10.Scn.FntERROR_DIRECTORY88#Syntax10.Scn.FntERROR_INVALID_DRIVE88#Syntax10.Scn.FntERROR_FILENAME_EXCED_RANGE88#Syntax10.Scn.FntERROR_HANDLE_DISK_FULL88#Syntax10.Scn.FntERROR_DISK_FULL88#Syntax10.Scn.FntERROR_EA_TABLE_FULL88#Syntax10.Scn.FntERROR_END_OF_MEDIA88#Syntax10.Scn.FntERROR_LOCK_VIOLATION88#Syntax10.Scn.FntERROR_ACCESS_DENIED88#Syntax10.Scn.FntERROR_WRITE_PROTECT88#Syntax10.Scn.FntERROR_DRIVE_LOCKED88#Syntax10.Scn.FntERROR_DIR_NOT_EMPTY88#Syntax10.Scn.FntERROR_CURRENT_DIRECTORY88#Syntax10.Scn.FntERROR_BAD_PATHNAME88#Syntax10.Scn.FntERROR_PATH_NOT_FOUND88#Syntax10.Scn.FntERROR_DUP_NAME8B8& d QσE,88 B*8.8σ@-8 8 σ'88 σ'81 8 σ 88 σ88 σ8I8 σ8.8 σ88 σ8*8 "88#Syntax10.Scn.FntERROR_NOT_SAME_DEVICE8)c8 σ88 σ86*i=Z8 288885MODULE Directories; (* CS Sept 96 based on Windows-FileDir from MH Feb 93 / 2.6.94 and PowerMac-Directories from HM Oct 95 *) IMPORT S := SYSTEM, Registry, Kernel, C := Console, ShowError; CONST InvalidHandle = 0FFFFFFFFH; NULL = 0; FileAttrNormal = 8; FileAttrDirectory = 4; FileAttribReadonly = 0; (* file attributes (set elements) *)  noErr* = 0; (**no error*) badName* = 1; (**bad file or directory name*) mediumFull* = 2; (**disk or directory full*) mediumLocked* = 3; (**hardware or software lock*) dirInUse* = 4; (**directory in use or not empty*) notADir* = 5; (**name does not specify a directory*) alreadyExists* = 6; (**directory already exists*) otherError* = 7; (**other OS-specific error*) delete* = 0; insert* = 1; change* = 2; (** notify operations **) delimiter* = "/"; (** delimiter in path names **)  TYPE Directory* = POINTER TO DirectoryDesc; Directories = POINTER TO ARRAY OF Directory; DirectoryDesc* = RECORD  path*: ARRAY 128 OF CHAR; (* in URL format *) immutable: BOOLEAN END ; FileTime = RECORD  low, high: LONGINT END ; Win32FindData = RECORD (* WIN32_FIND_DATA *) attrib: SET; (* file attributes *) creation, lastAcc, lastWrite: FileTime; sizeH, sizeL: LONGINT; res0, res1: LONGINT; name: ARRAY 260 (* = MAX_PATH *) OF CHAR; altName: ARRAY 14 OF CHAR END ; FileProc* = PROCEDURE (d: Directory; name: ARRAY OF CHAR; isDir: BOOLEAN; VAR continue: BOOLEAN); PathProc* = PROCEDURE (path: ARRAY OF CHAR; VAR continue: BOOLEAN); Notifier* = PROCEDURE (op: INTEGER; path, name: ARRAY OF CHAR); VAR res*: INTEGER; notify*: Notifier; startupPath: ARRAY 128 OF CHAR; (* in URL format *) (*path containing the Oberon application*) nofPaths: INTEGER; CurrentDir: Directory; DirTab: Directories; (* table of directories corresponding to Directories in Oberon.Ini *) mod: LONGINT; SetCurrentDirectory: PROCEDURE (path: LONGINT): BOOLEAN; GetCurrentDirectory: PROCEDURE (buflen: LONGINT; path: LONGINT); MoveFile: PROCEDURE (oldName, newName: LONGINT): BOOLEAN; FindFirstFile: PROCEDURE (filename: LONGINT; data: LONGINT): LONGINT; FindNextFile: PROCEDURE (hFindFile: LONGINT; data: LONGINT): BOOLEAN; FindClose: PROCEDURE (hFindFile: LONGINT); GetFileAttributes: PROCEDURE (name: LONGINT): SET; CreateDirectory: PROCEDURE (name: LONGINT; secAttr: LONGINT): BOOLEAN; RemoveDirectory: PROCEDURE (name: LONGINT): BOOLEAN; GetLastError: PROCEDURE (): LONGINT; PROCEDURE AppendFile (VAR path: ARRAY OF CHAR; filename: ARRAY OF CHAR); VAR i, j, max: LONGINT; BEGIN i := 0; j := 0; max := LEN(path)-1; WHILE path[i] # 0X DO INC(i) END ; IF (i > 0) & (path[i-1] # delimiter) THEN path[i] := delimiter; INC(i) END ; WHILE (i < max) & (filename[j] # 0X) DO path[i] := filename[j]; INC(i); INC(j) END ; path[i] := 0X END AppendFile;  PROCEDURE MapError(VAR res: INTEGER); (* maps the operating system dependent error to the exported error constants *) VAR err: LONGINT; BEGIN err := GetLastError(); CASE err OF 2, 123, 267, 15, 206: res := badName | 39, 112, 277(*, 1100*): res := mediumFull | 33, 5, 19, 108: res := mediumLocked | 145, 16: res := dirInUse | 161, 3: res := notADir | 52: res := alreadyExists ELSE res := otherError END END MapError;  PROCEDURE Replace (VAR str: ARRAY OF CHAR; from, to: CHAR); VAR i: INTEGER; BEGIN i := 0; WHILE str[i]#0X DO IF str[i]=from THEN str[i]:=to END ; INC (i) END END Replace; PROCEDURE Prepend (VAR str: ARRAY OF CHAR; c: CHAR); VAR i: INTEGER; BEGIN i := 0; WHILE str[i] # 0X DO INC(i) END ; INC(i); WHILE i > 0 DO str[i] := str[i - 1]; DEC(i) END ; str[0] := c END Prepend; PROCEDURE DeleteFirst (VAR str: ARRAY OF CHAR); VAR i: INTEGER; BEGIN i := 0; WHILE str[i] # 0X DO str[i] := str[i + 1]; INC(i) END ; END DeleteFirst; PROCEDURE LocalToURL* (VAR name: ARRAY OF CHAR); (* $file => $file $dir => $dir $\file => $/file $dir\file => $dir/file file => file dir => dir dir\file => dir/file vol:\dir => /vol:/dir \\computer\dir => //computer/dir *) BEGIN IF (name[0] # "$") & (LEN(name) > 2) & (name[1] = ":") THEN Prepend(name, "/") END ; Replace(name, "\", "/") END LocalToURL; PROCEDURE URLToLocal* (VAR name: ARRAY OF CHAR); (* $file => $file $dir => $dir $/file => $\file $dir/file => $dir\file file => file dir => dir dir/file => dir\file /vol:/dir => vol:\dir //computer/dir => \\computer\dir *) BEGIN IF (name[0] = "/") & (name[1] # "/") THEN DeleteFirst(name) END ; Replace(name, "/", "\") END URLToLocal; PROCEDURE ExpandPath (this: ARRAY OF CHAR; VAR absPathLocal: ARRAY OF CHAR); (* this in URL format, absPath in local format *) VAR done: BOOLEAN; current: ARRAY 128 OF CHAR; i, j: INTEGER; BEGIN GetCurrentDirectory(128, S.ADR(current)); IF this[0] = "$" THEN COPY(startupPath, absPathLocal); i := 0; WHILE absPathLocal[i] # 0X DO INC(i) END ; IF this[1] # delimiter THEN absPathLocal[i] := delimiter; INC(i) END ; j := 1; WHILE this[j] # 0X DO absPathLocal[i] := this[j]; INC(i); INC(j) END ; absPathLocal[i] := 0X ELSE COPY(this, absPathLocal) END ; URLToLocal(absPathLocal); done := SetCurrentDirectory(S.ADR(absPathLocal)); IF done THEN GetCurrentDirectory(LEN(absPathLocal), S.ADR(absPathLocal)); done := SetCurrentDirectory(S.ADR(current)) ELSE absPathLocal[0] := 0X END END ExpandPath;  PROCEDURE Split (path: ARRAY OF CHAR; VAR path0, dirName: ARRAY OF CHAR); (* path in local format, path0 in URL format *) VAR i, j: INTEGER; BEGIN LocalToURL(path); i := 0; j := 0; WHILE path[i] # 0X DO path0[i] := path[i]; IF path[i] = delimiter THEN j := i END ; INC(i) END ; path0[j] := 0X; INC(j); i := 0; WHILE path[j] # 0X DO dirName[i] := path[j]; INC(i); INC(j) END ; dirName[i] := 0X END Split;  PROCEDURE Found (VAR str: ARRAY OF CHAR; c: CHAR): BOOLEAN; VAR i: INTEGER; BEGIN i := 0; WHILE (str[i] # 0X) & (str[i] # c) DO INC(i) END ; RETURN str[i] = c END Found; PROCEDURE OpenDirectory (VAR absPath: ARRAY OF CHAR; VAR D: Directory); (* absPath in URL format, D.path in URL format *) VAR done: BOOLEAN; current, absPathLocal: ARRAY 128 OF CHAR; attribs: SET; BEGIN NEW(D); GetCurrentDirectory(128, S.ADR(current)); COPY(absPath, absPathLocal); URLToLocal(absPathLocal); done := SetCurrentDirectory(S.ADR(absPathLocal)); IF ~done THEN C.Str("absPath="); C.Str(absPath); C.Str(", absPathLocal="); C.Str(absPathLocal); D := NIL; MapError(res); ShowError.Do("Directories.OpenDirectory"); RETURN END ; GetCurrentDirectory(128, S.ADR(absPathLocal)); COPY(absPathLocal, D.path); LocalToURL(D.path); attribs := GetFileAttributes(S.ADR(absPathLocal)); D.immutable := FileAttribReadonly IN attribs; done := SetCurrentDirectory(S.ADR(current)) END OpenDirectory;  PROCEDURE Match (s1, s2: ARRAY OF CHAR): BOOLEAN; VAR i: INTEGER; BEGIN i := 0; WHILE (s1[i] # 0X) & (s2[i] # 0X) & (CAP(s1[i]) = CAP(s2[i])) DO INC(i) END ; RETURN (s1[i] = 0X) & (s2[i] = 0X) END Match;  PROCEDURE This* (path: ARRAY OF CHAR): Directory; (* path in URL format *) VAR D: Directory; i: LONGINT; absPathLocal, absPath: ARRAY 128 OF CHAR; BEGIN ExpandPath(path, absPathLocal); IF absPathLocal = "" THEN RETURN NIL END ; COPY(absPathLocal, absPath); LocalToURL(absPath); FOR i := 0 TO LEN(DirTab^) - 1 DO IF DirTab[i] # NIL THEN D := DirTab[i]; IF Match(D.path, absPath) THEN RETURN D END END END ; OpenDirectory(absPath, D); RETURN D END This;  PROCEDURE Enumerate* (D: Directory; H: FileProc); VAR localPath: ARRAY 128 OF CHAR; name: ARRAY 32 OF CHAR; b: Win32FindData; sh: LONGINT; found: BOOLEAN; continue: BOOLEAN; BEGIN COPY(D.path, localPath); AppendFile(localPath, "*.*"); URLToLocal(localPath); sh := FindFirstFile(S.ADR(localPath), S.ADR(b)); IF sh # InvalidHandle THEN found := TRUE; continue := TRUE; WHILE found & continue DO COPY(b.name, name); H(D, name, FileAttrDirectory IN b.attrib, continue); found := FindNextFile(sh, S.ADR(b)) END ; FindClose(sh) END END Enumerate;  PROCEDURE Current* (): Directory; VAR current: ARRAY 128 OF CHAR; BEGIN GetCurrentDirectory(128, S.ADR(current)); LocalToURL(current); CurrentDir := This(current); RETURN CurrentDir END Current;  PROCEDURE Change* (path: ARRAY OF CHAR); VAR D: Directory; pathLocal: ARRAY 128 OF CHAR; BEGIN D := This(path); IF D # NIL THEN COPY(D.path, pathLocal); URLToLocal(pathLocal); IF SetCurrentDirectory(S.ADR(pathLocal)) THEN res := noErr; CurrentDir := D; notify(change, "", "") ELSE MapError(res); ShowError.Do("Directories.Change") END END END Change;  PROCEDURE  Startup* (): Directory; BEGIN RETURN This(startupPath) END Startup;  PROCEDURE Create* (path: ARRAY OF CHAR); VAR localPath: ARRAY 128 OF CHAR; dirName: ARRAY 32 OF CHAR; i, j: INTEGER; BEGIN IF path[0] = "$" THEN COPY(startupPath, localPath); i := 0; WHILE localPath[i] # 0X DO INC(i) END ; IF path[1] # delimiter THEN localPath[i] := delimiter; INC(i) END ; j := 1; WHILE path[j] # 0X DO localPath[i] := path[j]; INC(i); INC(j) END ; localPath[i] := 0X ELSE COPY(path, localPath) END ; URLToLocal(localPath); IF CreateDirectory(S.ADR(localPath), NULL) THEN LocalToURL(localPath); ExpandPath(localPath, localPath); Split(localPath, path, dirName); notify(insert, path, dirName); res := noErr ELSE MapError(res); ShowError.Do("Directories.Create") END END Create;  PROCEDURE Delete* (path: ARRAY OF CHAR); VAR localPath: ARRAY 128 OF CHAR; dirName: ARRAY 32 OF CHAR; BEGIN ExpandPath(path, localPath); IF RemoveDirectory(S.ADR(localPath)) THEN Split(localPath, path, dirName); notify(delete, path, dirName); res := noErr ELSE MapError(res); ShowError.Do("Directories.Delete") END END Delete;  PROCEDURE Rename* (oldPath, newPath: ARRAY OF CHAR); VAR oldPath0, newPath0: ARRAY 128 OF CHAR; (* in local format *) oldName, newName: ARRAY 32 OF CHAR; (* in URL format *) i, j: INTEGER; BEGIN res := otherError; ExpandPath(oldPath, oldPath0); IF oldPath0[0] # 0X THEN IF newPath[0] = "$" THEN COPY(startupPath, newPath0); i := 0; WHILE newPath0[i] # 0X DO INC(i) END ; IF newPath[1] # delimiter THEN newPath0[i] := delimiter; INC(i) END ; j := 1; WHILE newPath[j] # 0X DO newPath0[i] := newPath[j]; INC(i); INC(j) END ; newPath0[i] := 0X ELSE COPY(newPath, newPath0) END ; URLToLocal(newPath0); IF MoveFile(S.ADR(oldPath0), S.ADR(newPath0)) THEN Split(oldPath0, oldPath, oldName); notify(delete, oldPath, oldName); LocalToURL(newPath0); ExpandPath(newPath0, newPath0); Split(newPath0, newPath, newName); notify(insert, newPath, newName); res := noErr ELSIF GetLastError() = 17 THEN (* copy directory and subdirectories *) res := otherError ELSE MapError(res); ShowError.Do("Directories.Rename") END END END Rename;  PROCEDURE EnumeratePaths* (proc: PathProc); VAR pathNo: LONGINT; continue: BOOLEAN; BEGIN pathNo := 0; continue := TRUE; WHILE continue & (pathNo < nofPaths) DO proc(DirTab[pathNo].path, continue); INC(pathNo) END END EnumeratePaths; PROCEDURE InitDirectories; VAR strPtr: POINTER TO RECORD name: ARRAY 128 OF CHAR END ; path, localPath: ARRAY 128 OF CHAR; i, j, dir, nofDirs: INTEGER; dirs: ARRAY 2048 OF CHAR; BEGIN (* get number of directories in registry section [System] *) Kernel.GetAdr(0, "SystemDirectory", S.VAL(LONGINT, strPtr)); COPY(strPtr.name, startupPath); LocalToURL(startupPath); Registry.Get("System", "Directories", dirs); nofDirs := 0; i := 0; WHILE dirs[i] # 0X DO IF dirs[i] = ";" THEN INC(nofDirs) END ; INC(i) END ; IF (i > 0) & (dirs[i-1] # ";") THEN INC(nofDirs) END ; i := 0; j := 0; dir := 0; nofPaths := 0; NEW(DirTab, nofDirs + 2); (* initialize directories in section [System] *) WHILE dir < nofDirs DO IF (dirs[i] = ";") OR (dirs[i] = 0X) THEN path[j] := 0X; INC(i); j := 0; WHILE (dirs[i] # 0X) & (dirs[i] <= " ") DO INC(i) END ; (* skip WS between paths *) ExpandPath(path, localPath); COPY(localPath, path); LocalToURL(path); OpenDirectory(path, DirTab[nofPaths]); IF DirTab[nofPaths] # NIL THEN INC(nofPaths) END ; INC(dir) ELSE path[j] := dirs[i]; INC(j); INC(i) END END ; (* initialize System Directory *) OpenDirectory(startupPath, DirTab[nofPaths]); IF DirTab[nofPaths] # NIL THEN INC(nofPaths) END ; (* initialize Font Directory (subdirectory of system directory) *) COPY(startupPath, path); AppendFile(path, "Fonts"); OpenDirectory(path, DirTab[nofPaths]); IF DirTab[nofPaths] # NIL THEN INC(nofPaths) END ; (* initialize current directory *) GetCurrentDirectory(128, S.ADR(path)); CurrentDir := This(path) END InitDirectories;  PROCEDURE NoNotify (op: INTEGER; path, name: ARRAY OF CHAR); END NoNotify; BEGIN mod := Kernel.LoadLibrary("Kernel32"); Kernel.GetAdr(mod, "SetCurrentDirectoryA", S.VAL(LONGINT, SetCurrentDirectory)); Kernel.GetAdr(mod, "GetCurrentDirectoryA", S.VAL(LONGINT, GetCurrentDirectory)); Kernel.GetAdr(mod, "MoveFileA", S.VAL(LONGINT, MoveFile)); Kernel.GetAdr(mod, "FindFirstFileA", S.VAL(LONGINT, FindFirstFile)); Kernel.GetAdr(mod, "FindNextFileA", S.VAL(LONGINT, FindNextFile)); Kernel.GetAdr(mod, "FindClose", S.VAL(LONGINT, FindClose)); Kernel.GetAdr(mod, "GetFileAttributesA", S.VAL(LONGINT, GetFileAttributes)); Kernel.GetAdr(mod, "CreateDirectoryA", S.VAL(LONGINT, CreateDirectory)); Kernel.GetAdr(mod, "RemoveDirectoryA", S.VAL(LONGINT, RemoveDirectory)); Kernel.GetAdr(mod, "GetLastError", S.VAL(LONGINT, GetLastError)); notify := NoNotify; InitDirectories END Directories.