MODULE HostPackedFiles;
(**
project = "BlackBox"
organization = "www.oberon.ch"
contributors = "Oberon microsystems"
version = "System/Rsrc/About"
copyright = "System/Rsrc/About"
license = "Docu/BB-License"
changes = ""
issues = ""
**)
(* This module depends on the implementation of DevPacker. *)
IMPORT SYSTEM, Files, HostFiles (*, Dialog*);
CONST
packTag* = 12681268H;
version = 1; (* same as in DevPacker *)
TYPE
Directory = POINTER TO RECORD (Files.Directory) END;
PackedDirectory = POINTER TO RECORD (Files.Directory) END;
FileList = POINTER TO RECORD
path, name: Files.Name;
adr, len: INTEGER;
year, month, day, hour, minute, second: INTEGER;
next: FileList
END;
Locator = POINTER TO RECORD
name: Files.Name;
files: FileList;
sublocs: Locator;
next: Locator
END;
File = POINTER TO RECORD (Files.File)
l: FileList;
f: Files.File
END;
Reader = POINTER TO RECORD (Files.Reader)
r: Files.Reader;
base: File
END;
VAR
orgdir: Files.Directory;
stdDir-, packedDir-: Files.Directory;
roots: Locator;
exefile: Files.File;
curloc: HostFiles.Locator;
(* Auxiliary procedures *)
PROCEDURE DebugPrint(IN str: ARRAY OF CHAR);
BEGIN
(*
Dialog.ShowMsg(str)
*)
END DebugPrint;
PROCEDURE ReadInt (r: Files.Reader; OUT x: INTEGER);
VAR b: ARRAY 4 OF BYTE;
BEGIN
r.ReadBytes(b, 0, 4);
x := b[0] MOD 256 + 256 * (b[1] MOD 256 + 256 * (b[2] MOD 256 + 256 * (b[3] MOD 256)))
END ReadInt;
PROCEDURE ReadChar (r: Files.Reader; OUT x: CHAR);
VAR b: ARRAY 2 OF BYTE;
BEGIN
r.ReadBytes(b, 0, 2);
x := SYSTEM.VAL(CHAR, b)
END ReadChar;
PROCEDURE ReadString (r: Files.Reader; OUT x: ARRAY OF CHAR);
VAR i: INTEGER; ch: CHAR;
BEGIN
i := 0; REPEAT ReadChar(r, ch); x[i] := ch; INC(i) UNTIL ch = 0X
END ReadString;
PROCEDURE Diff (VAR a, b: ARRAY OF CHAR; caseSens: BOOLEAN): INTEGER;
VAR i: INTEGER; cha, chb: CHAR;
BEGIN
i := 0;
REPEAT
cha := a[i]; chb := b[i]; INC(i);
IF cha # chb THEN
IF ~caseSens THEN
IF (cha >= "a") & ((cha <= "z") OR (cha >= 0E0X) & (cha <= 0FEX) & (cha # 0F7X)) THEN cha := CAP(cha)
END;
IF (chb >= "a") & ((chb <= "z") OR (chb >= 0E0X) & (chb <= 0FEX) & (chb # 0F7X)) THEN chb := CAP(chb)
END
END;
IF cha = "\" THEN cha := "/" END;
IF chb = "\" THEN chb := "/" END;
IF cha # chb THEN RETURN ORD(cha) - ORD(chb) END
END
UNTIL cha = 0X;
RETURN 0
END Diff;
PROCEDURE GetType(name: Files.Name; OUT type: Files.Type);
VAR l, i: INTEGER;
BEGIN
l := LEN(name$); type := "";
WHILE (l > 0) & (name[l - 1] # '.') DO DEC(l) END;
FOR i := 0 TO LEN(name$) - l DO type[i] := name[l + i] END
END GetType;
PROCEDURE GetNextSubLoc (path: Files.Name; beg: INTEGER; OUT res: Files.Name; OUT end: INTEGER);
VAR i: INTEGER;
BEGIN
i := 0; res := "";
WHILE (beg < LEN(path$)) & (path[beg] # '/') & (path[beg] # '\') & (path[beg] # ':') DO
res[i] := path[beg];
INC(beg); INC(i)
END;
res[i] := 0X; end := beg
END GetNextSubLoc;
PROCEDURE GetLoc(path: Files.Name; create: BOOLEAN): Locator;
VAR end, diff: INTEGER;sp: Files.Name; loc, tl, last: Locator;
BEGIN
sp := "";
IF path = '' THEN
DebugPrint("Cannot use an empty path.");
RETURN NIL
ELSIF (path[0] = '/') OR (path[0] = '\') THEN (* network path *)
IF (path[1] = '/') OR (path[1] = '\') THEN
GetNextSubLoc(path, 2, sp, end)
ELSE
DebugPrint("Invalid network path.");
RETURN NIL
END
ELSIF path[1] = ':' THEN (* absolute path *)
GetNextSubLoc(path, 0, sp, end)
ELSE
DebugPrint("No absolute path.");
RETURN NIL
END;
IF sp # "" THEN
loc := roots; last := loc;
IF loc # NIL THEN diff := Diff(sp, loc.name, FALSE) END;
WHILE (loc # NIL) & (diff > 0) DO
last := loc; loc := loc.next;
IF loc # NIL THEN diff := Diff(sp, loc.name, FALSE) END
END;
IF ((loc = NIL) OR (diff # 0)) & ~create THEN RETURN NIL END;
IF (loc = NIL) OR (diff < 0) THEN
NEW(loc); loc.name := sp;
IF roots = NIL THEN
roots := loc
ELSE
loc.next := last.next; last.next := loc
END
END;
GetNextSubLoc(path, 3, sp, end);
WHILE sp # "" DO
tl := loc.sublocs; last := NIL;
IF tl # NIL THEN diff := Diff(sp, tl.name, FALSE) END;
WHILE (tl # NIL) & (diff > 0) DO
last := tl; tl := tl.next;
IF tl # NIL THEN diff := Diff(sp, tl.name, FALSE) END
END;
IF (tl = NIL) OR (diff < 0) THEN
IF create THEN
NEW(tl); tl.name := sp;
IF last = NIL THEN
tl.next := loc.sublocs; loc.sublocs := tl
ELSE
tl.next := last.next; last.next := tl
END
ELSE
RETURN NIL
END
END;
loc := tl;
GetNextSubLoc(path, end + 1, sp, end)
END;
RETURN loc
END;
RETURN NIL
END GetLoc;
PROCEDURE ReadResourceTable;
VAR r: Files.Reader; tableadr, int, noff, i: INTEGER; str: Files.Name; l: FileList; loc: Locator;
BEGIN
roots := NIL; r := exefile.NewReader(NIL);
r.SetPos(exefile.Length() - 12);
ReadInt(r, int);
IF int = packTag THEN
ReadInt(r, int);
IF int = version THEN
ReadInt(r, tableadr);
r.SetPos(tableadr); ReadInt(r, noff);
NEW(roots);
FOR i := 0 TO noff - 1 DO
(* Files are packed in reversed alphabetical order,
so adding files at the beginning of the list renders an alphabetically sorted list. *)
NEW(l);
ReadString(r, str); l.path := str; ReadString(r, str); l.name := str;
ReadInt(r, int); l.adr := int; ReadInt(r, int); l.len := int;
ReadInt(r, int); l.year := int; ReadInt(r, int); l.month := int; ReadInt(r, int); l.day := int;
ReadInt(r, int); l.hour := int; ReadInt(r, int); l.minute := int; ReadInt(r, int); l.second := int;
loc := GetLoc(curloc.path + '/' + l.path, TRUE);
l.next := loc.files; loc.files := l
END
END
END
END ReadResourceTable;
PROCEDURE Get (path: HostFiles.FullName; name: Files.Name): Files.File;
VAR
l: FileList; f: File; loc: Locator;
type: Files.Type;
diff: INTEGER;
BEGIN
loc := GetLoc(path$, FALSE);
IF loc # NIL THEN l := loc.files ELSE RETURN NIL END;
IF l # NIL THEN diff := Diff(l.name, name, FALSE) END;
WHILE (l # NIL) & (diff < 0) DO
l := l.next;
IF l # NIL THEN diff := Diff(l.name, name, FALSE) END
END;
IF (l # NIL) & (diff = 0) THEN
NEW(f); f.l := l; f.f := exefile;
GetType(name, type); f.InitType(type);
RETURN f
END;
RETURN NIL
END Get;
(* Files.Directory *)
PROCEDURE (d: Directory) Delete (loc: Files.Locator; name: Files.Name);
BEGIN
orgdir.Delete(loc, name)
END Delete;
PROCEDURE (d: Directory) FileList (floc: Files.Locator): Files.FileInfo;
VAR pi, fi, tfi, nfi, last: Files.FileInfo; diff: INTEGER; caseSens: BOOLEAN;
BEGIN
ASSERT(floc IS HostFiles.Locator, 20);
fi := orgdir.FileList(floc); (* Gives an alphabetically sorted list of files. *)
pi := packedDir.FileList(floc); (* Gives an alphabetically sorted list of files. *)
nfi := NIL; last := NIL; tfi := NIL;
(* Both fi and l are alphabetically sorted. And the returned list also has to be alphabetically sorted. *)
caseSens := floc(HostFiles.Locator).caseSens;
WHILE (pi # NIL) & (fi # NIL) DO
diff := Diff(pi.name, fi.name, caseSens);
IF diff >= 0 THEN
tfi := fi;
fi := fi.next;
IF diff = 0 THEN pi := pi.next END
ELSE
tfi := pi;
pi := pi.next
END;
IF nfi = NIL THEN nfi := tfi ELSE last.next := tfi END;
last := tfi
END;
IF pi # NIL THEN
IF nfi = NIL THEN nfi := pi ELSE last.next := pi END
ELSIF fi # NIL THEN
IF nfi = NIL THEN nfi := fi ELSE last.next := fi END
END;
RETURN nfi
END FileList;
PROCEDURE (d: Directory) GetFileName (name: Files.Name; type: Files.Type; OUT filename: Files.Name);
BEGIN
orgdir.GetFileName(name, type, filename)
END GetFileName;
PROCEDURE (d: Directory) LocList (floc: Files.Locator): Files.LocInfo;
VAR pi, li, nli, last: Files.LocInfo; diff: INTEGER; caseSens: BOOLEAN;
BEGIN
li := orgdir.LocList(floc);
pi := packedDir.LocList(floc);
caseSens := floc(HostFiles.Locator).caseSens;
nli := NIL;
(* Both pi and li are alphabetically ordered. *)
WHILE (pi # NIL) & (li # NIL) DO
diff := Diff(pi.name, li.name, caseSens);
IF diff >= 0 THEN
IF nli = NIL THEN nli := li ELSE last.next := li END; last := li;
li := li.next;
IF diff = 0 THEN pi := pi.next END
ELSE
IF nli = NIL THEN nli := pi ELSE last.next := pi END; last := pi;
pi := pi.next
END
END;
IF pi = NIL THEN
IF nli = NIL THEN nli := li ELSE last.next := li END
ELSE
IF nli = NIL THEN nli := pi ELSE last.next := pi END
END;
RETURN nli
END LocList;
PROCEDURE (d: Directory) New (loc: Files.Locator; ask: BOOLEAN): Files.File;
BEGIN
RETURN orgdir.New(loc, ask)
END New;
PROCEDURE (d: Directory) Old (loc: Files.Locator; name: Files.Name; shared: BOOLEAN): Files.File;
VAR f: Files.File;
BEGIN
f := orgdir.Old(loc, name, shared);
IF f = NIL THEN f := packedDir.Old(loc, name, shared) END;
RETURN f
END Old;
PROCEDURE (d: Directory) Rename (loc: Files.Locator; old, new: Files.Name; ask: BOOLEAN);
BEGIN
orgdir.Rename(loc, old, new, ask)
END Rename;
PROCEDURE (d: Directory) SameFile (
loc0: Files.Locator; name0: Files.Name; loc1: Files.Locator; name1: Files.Name
): BOOLEAN;
BEGIN
RETURN orgdir.SameFile(loc0, name0, loc1, name1)
END SameFile;
PROCEDURE (d: Directory) Temp (): Files.File;
BEGIN
RETURN orgdir.Temp()
END Temp;
PROCEDURE (d: Directory) This (IN path: ARRAY OF CHAR): Files.Locator;
BEGIN
RETURN orgdir.This(path)
END This;
(* PackedDirectory *)
PROCEDURE (d: PackedDirectory) Delete (loc: Files.Locator; name: Files.Name);
BEGIN
loc.res := 4 (* write-protection *)
END Delete;
PROCEDURE (d: PackedDirectory) FileList (floc: Files.Locator): Files.FileInfo;
VAR nfi, tfi, last: Files.FileInfo; loc: Locator; l: FileList; type: Files.Type; hloc: HostFiles.Locator;
BEGIN
ASSERT(floc IS HostFiles.Locator, 20);
hloc := floc(HostFiles.Locator);
loc := GetLoc(hloc.path$, FALSE);
nfi := NIL;
IF loc # NIL THEN
l := loc.files; last := NIL; tfi := NIL;
(* l is alphabetically sorted. And the returned list also has to be alphabetically sorted. *)
WHILE l # NIL DO
GetType(l.name, type);
NEW(tfi); tfi.name := l.name; tfi.type := type; tfi.attr := {Files.readOnly};
tfi.modified.year := l.year; tfi.modified.month := l.month; tfi.modified.day := l.day;
tfi.modified.hour := l.hour; tfi.modified.minute := l.minute; tfi.modified.second := l.second;
IF nfi = NIL THEN nfi := tfi ELSE last.next := tfi END;
last := tfi;
l := l.next
END
END;
RETURN nfi
END FileList;
PROCEDURE (d: PackedDirectory) GetFileName (name: Files.Name; type: Files.Type; OUT filename: Files.Name);
BEGIN
orgdir.GetFileName(name, type, filename)
END GetFileName;
PROCEDURE (d: PackedDirectory) LocList (floc: Files.Locator): Files.LocInfo;
VAR nli, tli, last: Files.LocInfo; loc: Locator; hloc: HostFiles.Locator;
BEGIN
hloc := floc(HostFiles.Locator); nli := NIL;
loc := GetLoc(hloc.path$, FALSE);
IF loc # NIL THEN loc := loc.sublocs END;
(* loc is alphabetically ordered. *)
WHILE loc # NIL DO
NEW(tli); tli.name := loc.name; tli.attr := {Files.readOnly};
IF nli = NIL THEN nli := tli ELSE last.next := tli END;
last := tli;
loc := loc.next
END;
RETURN nli
END LocList;
PROCEDURE (d: PackedDirectory) New (loc: Files.Locator; ask: BOOLEAN): Files.File;
BEGIN
loc.res := 4; (* write-protection *)
RETURN NIL
END New;
PROCEDURE (d: PackedDirectory) Old (loc: Files.Locator; name: Files.Name; shared: BOOLEAN): Files.File;
VAR f: Files.File;
BEGIN
f := NIL;
IF shared THEN
WITH loc: HostFiles.Locator DO
f := Get(loc.path, name);
IF f # NIL THEN
loc.res := 0
END
ELSE
DebugPrint("HostPackedFiles: Directory.Old - This operation requires HostFiles. ")
END
END;
RETURN f
END Old;
PROCEDURE (d: PackedDirectory) Rename (loc: Files.Locator; old, new: Files.Name; ask: BOOLEAN);
BEGIN
loc.res := 4 (* write-protection *)
END Rename;
PROCEDURE (d: PackedDirectory) SameFile (loc0: Files.Locator; name0: Files.Name; loc1: Files.Locator; name1: Files.Name): BOOLEAN;
BEGIN
RETURN orgdir.SameFile(loc0, name0, loc1, name1)
END SameFile;
PROCEDURE (d: PackedDirectory) Temp (): Files.File;
BEGIN
RETURN orgdir.Temp()
END Temp;
PROCEDURE (d: PackedDirectory) This (IN path: ARRAY OF CHAR): Files.Locator;
BEGIN
RETURN orgdir.This(path)
END This;
(* Files.Reader *)
PROCEDURE (r: Reader) Base (): File;
BEGIN
RETURN r.base
END Base;
PROCEDURE (r: Reader) Pos (): INTEGER;
BEGIN
RETURN r.r.Pos() - r.base.l.adr
END Pos;
PROCEDURE (r: Reader) SetPos (pos: INTEGER);
BEGIN
ASSERT(pos <= r.base.l.len, 20);
r.r.SetPos(pos + r.base.l.adr);
r.eof := FALSE
END SetPos;
PROCEDURE (r: Reader) ReadByte (OUT x: BYTE);
BEGIN
IF (r.r.Pos() - r.base.l.adr) >= r.base.l.len THEN
r.eof := TRUE; x := 0
ELSE
r.r.ReadByte(x)
END
END ReadByte;
PROCEDURE (r: Reader) ReadBytes (VAR x: ARRAY OF BYTE; beg, len: INTEGER);
BEGIN
ASSERT(beg >= 0, 20); ASSERT(len >= 0, 21);
ASSERT(beg + len <= LEN(x), 22);
len := MIN(r.base.l.len, len);
r.r.ReadBytes(x, beg, len);
IF (r.r.Pos() - r.base.l.adr) >= r.base.l.len THEN r.eof := TRUE END
END ReadBytes;
(* Files.File *)
PROCEDURE (f: File) Close;
BEGIN
(* Do nothing since all packed files are opened on the exe file which should stay open. *)
END Close;
PROCEDURE (f: File) Flush;
BEGIN
(* Do nothing since all packed files are read only. *)
END Flush;
PROCEDURE (f: File) Length(): INTEGER;
BEGIN
RETURN f.l.len
END Length;
PROCEDURE (f: File) NewReader(old: Files.Reader): Files.Reader;
VAR r: Reader; hr: Files.Reader;
BEGIN
ASSERT(f.f # NIL, 20); ASSERT(f.l # NIL, 21);
hr := f.f.NewReader(old);
IF hr = NIL THEN RETURN NIL END;
hr.SetPos(f.l.adr);
NEW(r); r.base := f; r.r := hr; r.eof := FALSE;
RETURN r
END NewReader;
PROCEDURE (f: File) NewWriter(old: Files.Writer): Files.Writer;
BEGIN
(* Return NIL since all packed files are read only. *)
RETURN NIL
END NewWriter;
PROCEDURE (f: File) Register (name: Files.Name; type: Files.Type; ask: BOOLEAN; OUT res: INTEGER);
BEGIN
HALT(20)
(* Do nothing since all packed files are opened using Old and only files opened using New can be registered. *)
END Register;
(* Inititlization and uninitialization *)
PROCEDURE SetFilesDir*;
BEGIN
orgdir := Files.dir;
IF orgdir # NIL THEN
IF roots # NIL THEN
curloc := Files.dir.This("")(HostFiles.Locator);
Files.SetDir(stdDir)
END
ELSE
END
END SetFilesDir;
PROCEDURE RestoreFilesDir*;
BEGIN
IF orgdir # NIL THEN Files.SetDir(orgdir) END
END RestoreFilesDir;
PROCEDURE IsInstalled*;
BEGIN
IF Files.dir IS Directory THEN
DebugPrint("HostPackedFiles is installed")
ELSE
DebugPrint("HostPackedFiles is NOT installed")
END
END IsInstalled;
PROCEDURE GetModDate* (f: Files.File; VAR year, month, day, hour, minute, second: INTEGER);
BEGIN
ASSERT(f IS File);
WITH f: File DO
year := f.l.year; month := f.l.month; day := f.l.day;
hour := f.l.hour; minute := f.l.minute; second := f.l.second
END
END GetModDate;
PROCEDURE Init;
VAR loc: Files.Locator; appName: Files.Name; pDir: PackedDirectory; sDir: Directory;
BEGIN
loc := Files.dir.This(""); Files.dir.GetFileName(HostFiles.appName$, "EXE", appName);
exefile := Files.dir.Old(loc, appName, Files.shared);
IF exefile # NIL THEN
curloc := loc(HostFiles.Locator);
ReadResourceTable;
NEW(pDir); packedDir := pDir; NEW(sDir); stdDir := sDir;
SetFilesDir
ELSE
DebugPrint("HostPackedFiles: Could not open " + appName)
END
END Init;
BEGIN
Init
CLOSE
RestoreFilesDir;
IF exefile # NIL THEN exefile.Close END
END HostPackedFiles.
HostPackedFiles.SetFilesDir
HostPackedFiles.RestoreFilesDir
HostPackedFiles.PackStat
HostPackedFiles.IsInstalled