MODULE DevPacker;
(**
project = "BlackBox"
organization = "www.oberon.ch"
contributors = "Oberon microsystems"
version = "System/Rsrc/About"
copyright = "System/Rsrc/About"
license = "Docu/BB-License"
changes = ""
issues = ""
**)
(* !!! HostPackedFiles depends on the way files are packed into the exe file by DevPacker. !!!! *)
IMPORT
Kernel, Services, Strings, Files, Dialog, Stores, Views, HostFiles, HostPackedFiles,
TextModels, TextViews, TextMappers, StdLog, DevCommanders;
CONST
chunksize = 65536;
version = 1; (* same as in HostPackedFiles *)
TYPE
FileList = POINTER TO RECORD
path, name: Files.Name;
aliasPath, aliasName: Files.Name;
adr, len: INTEGER;
year, month, day, hour, minute, second: INTEGER;
next: FileList
END;
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 SplitName (IN name: Files.Name; OUT path, fname: Files.Name);
VAR i, l, sp: INTEGER;
BEGIN
path := ""; fname := "";
l := LEN(name$);
i := 0; sp := -1;
WHILE i < l DO
path[i] := name[i];
IF (name[i] = "\") OR (name[i] = "/") THEN sp := i END;
INC(i)
END;
IF sp < 0 THEN
fname := name; path := ""
ELSE
path[sp] := 0X;
i := 0; INC(sp);
WHILE name[sp] # 0X DO fname[i] := name[sp]; INC(sp); INC(i) END;
fname[i] := 0X
END
END SplitName;
PROCEDURE PackExe(files: FileList; exe: Files.File);
VAR tableadr, tot, err, ok, i, dl: INTEGER; l: FileList;
wr: Files.Writer; sw: Stores.Writer;
bytes: ARRAY chunksize OF BYTE;
loc: Files.Locator; f: Files.File; r: Files.Reader; shared: BOOLEAN;
num: ARRAY 7 OF CHAR;
BEGIN
tot := 0; err := 0; ok := 0;
l := files; wr := exe.NewWriter(NIL);
Dialog.ShowStatus('Packing...');
WHILE l # NIL DO
StdLog.String("Packing file: " + l.path + '/' + l.name); StdLog.Ln;
INC(tot);
loc := Files.dir.This(l.path); shared := FALSE;
f := Files.dir.Old(loc, l.name, shared);
IF f = NIL THEN shared := TRUE; f := Files.dir.Old(loc, l.name, shared) END;
IF f # NIL THEN
l.len := f.Length();
l.adr := exe.Length();
IF Services.Is(f, "HostFiles.File") THEN
(* If HostFiles.File is exported this can be replaced by an explicit type guard*)
HostFiles.GetModDate(f, l.year, l.month, l.day, l.hour, l.minute, l.second)
ELSIF Services.Is(f, "HostPackedFiles.File") THEN
(* could also be replaced by an explicit type guard*)
HostPackedFiles.GetModDate(f, l.year, l.month, l.day, l.hour, l.minute, l.second)
ELSE
l.year := 0; l.month := 0; l.day := 0; l.hour := 0; l.minute := 0; l.second := 0
END;
r := f.NewReader(NIL); r.SetPos(0);
wr.SetPos(l.adr);
i := 0; dl := MIN(chunksize, l.len);
WHILE dl > 0 DO
r.ReadBytes(bytes, 0, dl);
wr.WriteBytes(bytes, 0, dl); exe.Flush;
INC(i); dl := MIN(chunksize, l.len - i * chunksize)
END;
IF ~shared THEN f.Close END;
INC(ok);
Kernel.Collect
ELSE
StdLog.String("Could not read file: " + l.path + '/' + l.name); StdLog.Ln; INC(err)
END;
l := l.next
END;
l := files; tableadr := exe.Length();
sw.ConnectTo(exe); sw.SetPos(tableadr);
sw.WriteInt(tot);
WHILE l # NIL DO
sw.WriteString(l.aliasPath); sw.WriteString(l.aliasName);
sw.WriteInt(l.adr); sw.WriteInt(l.len);
sw.WriteInt(l.year); sw.WriteInt(l.month); sw.WriteInt(l.day);
sw.WriteInt(l.hour); sw.WriteInt(l.minute); sw.WriteInt(l.second);
l := l.next
END;
sw.WriteInt(HostPackedFiles.packTag);
sw.WriteInt(version);
sw.WriteInt(tableadr);
IF err > 0 THEN
Strings.IntToString(err, num);
Dialog.ShowMsg("Pack failed for: " + num + " files.");
Dialog.ShowStatus("failed")
ELSE
StdLog.String("Packed files: "); StdLog.Int(ok); StdLog.Ln;
Dialog.ShowStatus("ok")
END
END PackExe;
PROCEDURE RecAdd(path: Files.Name; VAR files: FileList; VAR tot: INTEGER);
VAR loc: Files.Locator; fi: Files.FileInfo; li: Files.LocInfo; l: FileList;
BEGIN
loc := Files.dir.This(path); fi := Files.dir.FileList(loc);
WHILE fi # NIL DO
NEW(l); l.path := path$; l.name := fi.name;
l.next := files; files := l; INC(tot);
fi := fi.next
END;
li := Files.dir.LocList(loc);
WHILE li # NIL DO
IF path = "" THEN RecAdd(li.name, files, tot) ELSE RecAdd(path + '/' + li.name, files, tot) END;
li := li.next
END
END RecAdd;
PROCEDURE ListFromSub* (sdir: ARRAY OF CHAR);
CONST colPerRow = 3;
VAR tot, col: INTEGER; files: FileList; t: TextModels.Model; f: TextMappers.Formatter; tv: TextViews.View;
name: Files.Name;
BEGIN
StdLog.String("Examining subdirectory: " + sdir); StdLog.Ln;
files := NIL; tot := 0;
RecAdd(sdir$, files, tot);
IF files # NIL THEN
t := TextModels.dir.New(); f.ConnectTo(t); f.SetPos(0);
f.WriteView(DevCommanders.dir.New()); f.WriteString(' DevPacker.PackThis exefilename.exe :='); f.WriteLn;
col := 0;
WHILE files # NIL DO
IF files.path # "" THEN name := '"' + files.path + '/' ELSE name := '"' END;
name := name + files.name + '"';
IF files.next # NIL THEN name := name + ' ' END;
f.WriteString(name);
INC(col); IF col >= colPerRow THEN f.WriteLn; col := 0 END; (* To avoid long lines *)
files := files.next
END;
f.WriteView(DevCommanders.dir.NewEnd()); f.WriteLn;
tv := TextViews.dir.New(t);
Views.OpenView(tv)
END;
StdLog.String("Found "); StdLog.Int(tot); StdLog.String(" files."); StdLog.Ln
END ListFromSub;
PROCEDURE ListLoadedModules*;
VAR
t: TextModels.Model; f: TextMappers.Formatter; tv: TextViews.View;
path, name: Files.Name; m: Kernel.Module;
BEGIN
t := TextModels.dir.New(); f.ConnectTo(t); f.SetPos(0);
f.WriteView(DevCommanders.dir.New()); f.WriteString(' DevPacker.PackThis exefilename.exe :='); f.WriteLn;
m := Kernel.modList;
WHILE m # NIL DO
Kernel.SplitName(m.name$, path, name);
IF path = "" THEN path := 'System' END;
path := path + '/Code/';
f.WriteString(path + name + '.ocf ');
m := m.next
END;
f.WriteView(DevCommanders.dir.NewEnd()); f.WriteLn;
tv := TextViews.dir.New(t);
Views.OpenView(tv)
END ListLoadedModules;
PROCEDURE FilesOk(files: FileList; exeloc: Files.Locator; IN exefile: Files.Name): BOOLEAN;
VAR l: FileList; loc: Files.Locator; fi: Files.FileInfo; ret: BOOLEAN;
err, tot: INTEGER;
BEGIN
StdLog.String("Validating files..."); StdLog.Ln;
IF files = NIL THEN StdLog.String("No files to pack."); StdLog.Ln; RETURN FALSE END;
l := files; ret := TRUE; err := 0; tot := 0;
WHILE l # NIL DO
loc := Files.dir.This(l.path);
IF loc # NIL THEN
fi := Files.dir.FileList(loc);
WHILE (fi # NIL) & (Diff(l.name, fi.name, FALSE) # 0) DO fi := fi.next END
END;
IF (loc = NIL) OR (fi = NIL) THEN
IF l.path # "" THEN StdLog.String(l.path + "/") END;
StdLog.String(l.name);
StdLog.String(" ...not found"); ret := FALSE; INC(err);
StdLog.Ln
ELSIF Files.dir.SameFile(exeloc, exefile, loc, fi.name) THEN
StdLog.String(
'Cannot pack a file into itself. (' + l.name + ' cannot be both the target exe and included in the list)');
StdLog.Ln; ret := FALSE; INC(err)
END;
INC(tot); l := l.next
END;
IF err > 0 THEN
StdLog.Int(err); StdLog.String(" files of"); StdLog.Int(tot); StdLog.String(" not correct.");
Dialog.ShowStatus("failed")
ELSE
StdLog.String("All"); StdLog.Int(tot); StdLog.String(" files found.")
END;
StdLog.Ln;
RETURN ret
END FilesOk;
(* Parse the file list *)
PROCEDURE GetCh (rd: TextModels.Reader);
BEGIN
REPEAT rd.Read UNTIL rd.char # TextModels.viewcode
END GetCh;
PROCEDURE RemoveWhiteSpaces (rd: TextModels.Reader; end: INTEGER);
BEGIN
WHILE (rd.Pos() <= end) & (rd.char <= 20X) DO GetCh(rd) END
END RemoveWhiteSpaces;
PROCEDURE FileName (rd: TextModels.Reader; end: INTEGER;
OUT name: ARRAY OF CHAR; OUT ok: BOOLEAN
);
VAR i: INTEGER; dquote, squote: BOOLEAN;
PROCEDURE ValidChar(ch: CHAR): BOOLEAN;
BEGIN
IF dquote THEN RETURN ch # '"'
ELSIF squote THEN RETURN ch # "'"
ELSE RETURN ch > 20X
END
END ValidChar;
BEGIN
ok := TRUE;
RemoveWhiteSpaces(rd, end);
i := 0; dquote := FALSE; squote := FALSE;
IF rd.char = '"' THEN dquote := TRUE
ELSIF rd.char = "'" THEN squote := TRUE
END;
IF dquote OR squote THEN GetCh(rd) END;
WHILE (rd.Pos() <= end) & ValidChar(rd.char) DO
name[i] := rd.char;
INC(i);
GetCh(rd)
END;
name[i] := 0X;
IF dquote THEN ok := rd.char = '"'; rd.Read END;
IF squote THEN ok := rd.char = "'"; rd.Read END
END FileName;
PROCEDURE GetNextFileName (rd: TextModels.Reader; end: INTEGER; VAR file: FileList; OUT ok: BOOLEAN);
VAR name: Files.Name;
BEGIN
FileName(rd, end, name, ok);
SplitName(name, file.path, file.name);
RemoveWhiteSpaces(rd, end);
IF ok & (rd.char = "=") THEN
GetCh(rd);
IF rd.char = ">" THEN
GetCh(rd);
FileName(rd, end, name, ok);
IF name # "" THEN
SplitName(name, file.aliasPath, file.aliasName)
ELSE
ok := FALSE
END
ELSE
ok := FALSE
END
ELSE
file.aliasPath := file.path; file.aliasName := file.name
END
END GetNextFileName;
PROCEDURE ParseExe (rd: TextModels.Reader; end: INTEGER;
OUT exepath, exefile: Files.Name; OUT ok: BOOLEAN
);
VAR name: Files.Name;
BEGIN
ok := FALSE;
GetCh(rd);
FileName(rd, end, name, ok);
IF ok THEN
SplitName(name, exepath, exefile);
RemoveWhiteSpaces(rd, end);
IF ok & (rd.char = ":") THEN
GetCh(rd);
IF rd.char = "=" THEN
GetCh(rd);
ok := TRUE
END
END
END
END ParseExe;
PROCEDURE AlreadyPacked (f: Files.File): BOOLEAN;
VAR rd: Stores.Reader; int: INTEGER;
BEGIN
rd.ConnectTo(f);
rd.SetPos(f.Length() - 12);
rd.ReadInt(int);
rd.ConnectTo(NIL);
RETURN int = HostPackedFiles.packTag
END AlreadyPacked;
PROCEDURE PackThis*;
VAR rd: TextModels.Reader; end, diff: INTEGER; exepath, exefile: Files.Name; ok: BOOLEAN;
files, l, tf, last: FileList; f: Files.File; loc: Files.Locator;
BEGIN
StdLog.String("Sorting file list..."); StdLog.Ln;
rd := DevCommanders.par.text.NewReader(NIL);
rd.SetPos(DevCommanders.par.beg);
end := DevCommanders.par.end;
ParseExe(rd, end, exepath, exefile, ok);
IF ~ok THEN
StdLog.String("exe file not correctly specified"); StdLog.Ln
ELSE
files := NIL; NEW(l);
GetNextFileName(rd, end, l, ok);
WHILE ok & (l.name # "") DO
IF files = NIL THEN
files := l
ELSE
tf := files; last := NIL;
diff := Diff(l.aliasPath, tf.aliasPath, FALSE);
WHILE (tf # NIL) & (diff < 0) DO
last := tf; tf := tf.next;
IF tf # NIL THEN diff := Diff(l.aliasPath, tf.aliasPath, FALSE) END
END;
IF (tf = NIL) OR (diff > 0) THEN
IF last = NIL THEN
l.next := files; files := l
ELSE
l.next := last.next; last.next := l
END
ELSE
diff := Diff(l.aliasName, tf.aliasName, FALSE);
WHILE (tf # NIL) & (diff < 0) & (Diff(l.aliasPath, tf.aliasPath, FALSE) = 0) DO
last := tf; tf := tf.next;
IF tf # NIL THEN diff := Diff(l.aliasName, tf.aliasName, FALSE) END
END;
IF (diff = 0) & (Diff(l.aliasPath, tf.aliasPath, FALSE) = 0) THEN
StdLog.String("File " + l.path + "/" + l.name + " appears more than once in the list."); StdLog.Ln
ELSE
IF last = NIL THEN
l.next := files; files := l
ELSE
l.next := last.next; last.next := l
END
END
END
END;
NEW(l);
GetNextFileName(rd, end, l, ok)
END;
loc := Files.dir.This(exepath$)
END;
IF ok & FilesOk(files, loc, exefile) THEN
f := Files.dir.Old(loc, exefile$, Files.exclusive);
IF f # NIL THEN
IF ~AlreadyPacked(f) THEN
StdLog.String("Packing files to exe..."); StdLog.Ln;
PackExe(files, f);
f.Flush; f.Close;
StdLog.String("Done."); StdLog.Ln
ELSE
f.Flush; f.Close;
IF exepath # "" THEN exepath := exepath + "/" END;
StdLog.String(
"Executable (" + exepath + exefile + ") already contains packed files. Link a new executable.");
StdLog.Ln;
Dialog.ShowMsg("failed")
END
ELSE
IF exepath # "" THEN exepath := exepath + "/" END;
StdLog.String("Could not open exe file: " + exepath + exefile); StdLog.Ln;
Dialog.ShowStatus("failed")
END
ELSE
StdLog.String("Packing canceled."); StdLog.Ln;
Dialog.ShowStatus("failed")
END
END PackThis;
END DevPacker.
"DevPacker.ListFromSub('')"
"DevPacker.ListLoadedModules"
DevPacker.PackThis BlackBoxP.exe := Host/Mod/files.odc
Host/Mod/cmds.odc Std\mod\log.odc Host/Sym\CFrames.osf host\Mod\CFrames.odc
DevPacker.PackThis exefile.exe := Host/Mod/files.odc => Host/Mod/Hoi.odc "host\Mod\CFrames.odc" Std/Mod/Log.odc => 'Std/Mod/Logg.odc'
DevLinker.Link BlackBoxP.exe := Kernel$+ Files HostFiles HostPackedFiles StdLoader
1 Applogo.ico 2 Doclogo.ico 3 SFLogo.ico 4 CFLogo.ico 5 DtyLogo.ico 6 folderimg.ico 7 openimg.ico
8 leafimg.ico
1 Move.cur 2 Copy.cur 3 Link.cur 4 Pick.cur 5 Stop.cur 6 Hand.cur 7 Table.cur