MODULE Zip;
IMPORT
Streams, Files, Zlib, ZlibReaders, ZlibWriters;
CONST
Ok* = 0;
FileError* = -1;
NotZipArchiveError* = -2;
EntryNotFound* = -3;
EntryAlreadyExists* = -4;
NotSupportedError* = -5;
DataError* = -6;
BadName* = -7;
ReaderError* = -8;
DefaultCompression* = ZlibWriters.DefaultCompression;
NoCompression* = ZlibWriters.NoCompression;
BestSpeed* = ZlibWriters.BestSpeed;
BestCompression* = ZlibWriters.BestCompression;
DefaultStrategy* = ZlibWriters.DefaultStrategy;
Filtered* = ZlibWriters.Filtered;
HuffmanOnly* = ZlibWriters.HuffmanOnly;
Supported = 0;
IncompatibleVersion = 1;
Encrypted = 2;
UnsupCompMethod = 3;
Stored = 0;
Deflated = 8;
SupportedCompMethods = {Stored, Deflated};
CompatibleVersions = 1;
LocalFileHeaderSignature = 04034B50H;
CentralFileHeaderSignature = 02014B50H;
EndOfCentralDirSignature = 06054B50H;
TYPE
Entry* = POINTER TO EntryDesc;
EntryDesc* = RECORD
name-: ARRAY 256 OF CHAR;
method: INTEGER;
time-, date-: LONGINT;
crc32: LONGINT;
compSize-, uncompSize-: LONGINT;
intFileAttr: INTEGER;
extFileAttr: LONGINT;
extraField , comment-: POINTER TO ARRAY OF CHAR;
genPurpBitFlag: INTEGER;
support: SHORTINT;
dataDescriptor: BOOLEAN;
offsetLocal: LONGINT;
offsetFileData: LONGINT;
offsetCentralDir: LONGINT;
next: Entry
END;
Archive* = POINTER TO ArchiveDesc;
ArchiveDesc* = RECORD
nofEntries-: INTEGER;
comment-: POINTER TO ARRAY OF CHAR;
file-: Files.File;
offset: LONGINT;
firstEntry, lastEntry: Entry
END;
Reader* = POINTER TO ReaderDesc;
ReaderDesc* = RECORD
res-: LONGINT;
open: BOOLEAN;
ent: Entry
END;
UncompReader = POINTER TO UncompReaderDesc;
UncompReaderDesc = RECORD (ReaderDesc)
fr: Files.Rider;
crc32: LONGINT;
END;
DefReader = POINTER TO DefReaderDesc;
DefReaderDesc = RECORD (ReaderDesc)
zr: ZlibReaders.Reader
END;
PROCEDURE ShowError*(errorCode : LONGINT; out : Streams.Writer);
BEGIN
ASSERT(out # NIL);
CASE errorCode OF
|Ok: out.String("No Error");
|FileError: out.String("File not found");
|NotZipArchiveError: out.String("File is not in zip format");
|EntryNotFound: out.String("File not found in zip archive");
|EntryAlreadyExists: out.String("File already present in zip archive");
|NotSupportedError: out.String("Compression method not supported or file encrypted");
|DataError: out.String("File is corrupted");
|BadName: out.String("Bad file name");
|ReaderError: out.String("Reader Error");
ELSE
out.String("Unkown error, res: "); out.Int(errorCode, 0);
END;
END ShowError;
PROCEDURE StringLength(CONST str: ARRAY OF CHAR): LONGINT;
VAR i, l: LONGINT;
BEGIN
l := LEN(str); i := 0;
WHILE (i < l) & (str[i] # 0X) DO
INC(i)
END;
RETURN i
END StringLength;
PROCEDURE OberonToDosTime(t: LONGINT): INTEGER;
BEGIN
RETURN SHORT(t DIV 1000H MOD 20H * 800H + t DIV 40H MOD 40H * 20H + t MOD 40H DIV 2)
END OberonToDosTime;
PROCEDURE OberonToDosDate(d: LONGINT): INTEGER;
BEGIN
RETURN SHORT((d DIV 200H + 1900 - 1980) * 200H + d MOD 200H)
END OberonToDosDate;
PROCEDURE DosToOberonTime(t: INTEGER): LONGINT;
BEGIN
RETURN LONG(t) DIV 800H MOD 20H * 1000H + t DIV 20H MOD 40H * 40H + t MOD 20H * 2
END DosToOberonTime;
PROCEDURE DosToOberonDate(d: INTEGER): LONGINT;
BEGIN
RETURN (LONG(d) DIV 200H MOD 80H + 1980 - 1900) * 200H + d MOD 200H
END DosToOberonDate;
PROCEDURE Copy(VAR src, dst: Files.Rider; len: LONGINT; compCRC32: BOOLEAN; VAR crc32: LONGINT);
CONST
BufSize = 4000H;
VAR
n: LONGINT;
buf: ARRAY BufSize OF CHAR;
BEGIN
IF compCRC32 THEN crc32 := Zlib.CRC32(0, buf, -1, -1) END;
REPEAT
IF len < BufSize THEN n := len
ELSE n := BufSize
END;
src.file.ReadBytes(src, buf, 0, n);
IF compCRC32 THEN crc32 := Zlib.CRC32(crc32, buf, 0, n - src.res) END;
dst.file.WriteBytes(dst, buf, 0, n - src.res);
DEC(len, n)
UNTIL len = 0
END Copy;
PROCEDURE ReadEntry(VAR r: Files.Rider): Entry;
VAR
ent: Entry;
intDummy, nameLen, extraLen, commentLen: INTEGER;
longDummy: LONGINT;
BEGIN
Files.ReadLInt(r, longDummy);
IF longDummy = CentralFileHeaderSignature THEN
NEW(ent);
ent.offsetCentralDir := r.file.Pos(r) - 4;
ent.support := 0;
Files.ReadInt(r, intDummy);
Files.ReadInt(r, intDummy);
IF (intDummy MOD 100H) / 10 < CompatibleVersions THEN
ent.support := IncompatibleVersion
END;
Files.ReadInt(r, ent.genPurpBitFlag);
IF ODD(ent.genPurpBitFlag) THEN
ent.support := Encrypted
END;
ent.dataDescriptor := ODD(intDummy DIV 8);
Files.ReadInt(r, ent.method);
IF (ent.support = Supported) & ~(ent.method IN SupportedCompMethods) THEN
ent.support := UnsupCompMethod
END;
Files.ReadInt(r, intDummy); ent.time := DosToOberonTime(intDummy);
Files.ReadInt(r, intDummy); ent.date := DosToOberonDate(intDummy);
Files.ReadLInt(r, ent.crc32);
Files.ReadLInt(r, ent.compSize);
Files.ReadLInt(r, ent.uncompSize);
Files.ReadInt(r, nameLen);
Files.ReadInt(r, extraLen);
Files.ReadInt(r, commentLen);
Files.ReadInt(r, intDummy);
Files.ReadInt(r, ent.intFileAttr);
Files.ReadLInt(r, ent.extFileAttr);
Files.ReadLInt(r, ent.offsetLocal);
r.file.ReadBytes(r, ent.name, 0, nameLen);
IF extraLen # 0 THEN
NEW(ent.extraField, extraLen);
r.file.ReadBytes(r, ent.extraField^, 0, extraLen)
END;
IF commentLen > 0 THEN
NEW(ent.comment, commentLen);
r.file.ReadBytes(r, ent.comment^, 0, commentLen)
END;
longDummy := r.file.Pos(r);
r.file.Set(r, ent.offsetLocal + 28);
Files.ReadInt(r, extraLen);
ent.offsetFileData := ent.offsetLocal + 30 + nameLen + extraLen;
r.file.Set(r, longDummy);
IF r.eof THEN
ent := NIL
END
END;
RETURN ent;
END ReadEntry;
PROCEDURE WriteLocalFileHeader(ent: Entry; VAR r: Files.Rider);
BEGIN
Files.WriteLInt(r, LocalFileHeaderSignature);
Files.WriteInt(r, CompatibleVersions * 10);
Files.WriteInt(r, ent.genPurpBitFlag);
Files.WriteInt(r, ent.method);
Files.WriteInt(r, OberonToDosTime(ent.time));
Files.WriteInt(r, OberonToDosDate(ent.date));
Files.WriteLInt(r, ent.crc32);
Files.WriteLInt(r, ent.compSize);
Files.WriteLInt(r, ent.uncompSize);
Files.WriteInt(r, SHORT(StringLength(ent.name)));
IF ent.extraField # NIL THEN
Files.WriteInt(r, SHORT(LEN(ent.extraField^)))
ELSE
Files.WriteInt(r, 0)
END;
r.file.WriteBytes(r, ent.name, 0, StringLength(ent.name));
IF ent.extraField # NIL THEN
r.file.WriteBytes(r, ent.extraField^, 0, LEN(ent.extraField^))
END
END WriteLocalFileHeader;
PROCEDURE WriteFileHeader(ent: Entry; VAR r: Files.Rider);
BEGIN
ent.offsetCentralDir := r.file.Pos(r);
Files.WriteLInt(r, CentralFileHeaderSignature);
Files.WriteInt(r, CompatibleVersions * 10);
Files.WriteInt(r, CompatibleVersions * 10);
Files.WriteInt(r, ent.genPurpBitFlag);
Files.WriteInt(r, ent.method);
Files.WriteInt(r, OberonToDosTime(ent.time));
Files.WriteInt(r, OberonToDosDate(ent.date));
Files.WriteLInt(r, ent.crc32);
Files.WriteLInt(r, ent.compSize);
Files.WriteLInt(r, ent.uncompSize);
Files.WriteInt(r, SHORT(StringLength(ent.name)));
IF ent.extraField = NIL THEN
Files.WriteInt(r, 0)
ELSE
Files.WriteInt(r, SHORT(LEN(ent.extraField^)));
END;
IF ent.comment = NIL THEN
Files.WriteInt(r, 0)
ELSE
Files.WriteInt(r, SHORT(LEN(ent.comment^)));
END;
Files.WriteInt(r, 0);
Files.WriteInt(r, ent.intFileAttr);
Files.WriteLInt(r, ent.extFileAttr);
Files.WriteLInt(r, ent.offsetLocal);
r.file.WriteBytes(r, ent.name, 0, StringLength(ent.name));
IF ent.extraField # NIL THEN
r.file.WriteBytes(r, ent.extraField^, 0, LEN(ent.extraField^))
END;
IF ent.comment # NIL THEN
r.file.WriteBytes(r, ent.comment^, 0, LEN(ent.comment^))
END
END WriteFileHeader;
PROCEDURE WriteEndOfCentDir(arc: Archive; VAR r: Files.Rider);
BEGIN
Files.WriteLInt(r, EndOfCentralDirSignature);
Files.WriteInt(r, 0);
Files.WriteInt(r, 0);
Files.WriteInt(r, arc.nofEntries);
Files.WriteInt(r, arc.nofEntries);
IF arc.firstEntry # NIL THEN
Files.WriteLInt(r, arc.offset - arc.firstEntry.offsetCentralDir)
ELSE
Files.WriteLInt(r, 0)
END;
IF arc.firstEntry = NIL THEN
Files.WriteLInt(r, arc.offset)
ELSE
Files.WriteLInt(r, arc.firstEntry.offsetCentralDir)
END;
IF arc.comment = NIL THEN
Files.WriteInt(r, 0)
ELSE
Files.WriteInt(r, SHORT(LEN(arc.comment^)));
r.file.WriteBytes(r, arc.comment^, 0, LEN(arc.comment^))
END
END WriteEndOfCentDir;
PROCEDURE WriteCentralDirectory(arc: Archive; VAR r: Files.Rider);
VAR
ent: Entry;
BEGIN
ent := arc.firstEntry;
WHILE ent # NIL DO
WriteFileHeader(ent, r);
ent := ent.next
END;
arc.offset := r.file.Pos(r);
WriteEndOfCentDir(arc, r)
END WriteCentralDirectory;
PROCEDURE OpenArchive*(CONST name: ARRAY OF CHAR; VAR res: LONGINT): Archive;
VAR
arc: Archive;
ent: Entry;
f: Files.File;
r: Files.Rider;
longDummy: LONGINT;
intDummy: INTEGER;
BEGIN
res := Ok;
f := Files.Old(name);
IF f = NIL THEN
res := FileError
ELSIF f.Length() < 22 THEN
res := NotZipArchiveError
ELSE
longDummy := 0;
f.Set(r, f.Length() - 17);
WHILE (longDummy # EndOfCentralDirSignature) & (r.file.Pos(r) > 4) DO
f.Set(r, f.Pos(r) - 5);
Files.ReadLInt(r, longDummy)
END;
IF longDummy # EndOfCentralDirSignature THEN
res := NotZipArchiveError
ELSE
NEW(arc);
arc.file := f;
arc.offset := f.Pos(r) - 4;
Files.ReadInt(r, intDummy);
Files.ReadInt(r, intDummy);
Files.ReadInt(r, intDummy);
Files.ReadInt(r, arc.nofEntries);
Files.ReadLInt(r, longDummy);
Files.ReadLInt(r, longDummy);
Files.ReadInt(r, intDummy);
IF intDummy # 0 THEN
NEW(arc.comment, intDummy);
r.file.ReadBytes(r, arc.comment^, 0, intDummy)
END;
IF r.file.Pos(r) # r.file.Length() THEN
res := NotZipArchiveError;
arc := NIL
ELSE
r.file.Set(r, longDummy);
arc.firstEntry := ReadEntry(r); arc.lastEntry := arc.firstEntry;
ent := arc.firstEntry; intDummy := 0;
WHILE ent # NIL DO
arc.lastEntry := ent; INC(intDummy);
ent.next := ReadEntry(r);
ent := ent.next
END;
IF intDummy # arc.nofEntries THEN
res := NotZipArchiveError;
arc := NIL
END
END;
f.Update();
END
END;
RETURN arc
END OpenArchive;
PROCEDURE CreateArchive*(CONST name: ARRAY OF CHAR; VAR res: LONGINT): Archive;
VAR
f: Files.File;
r: Files.Rider;
arc: Archive;
BEGIN
IF name#"" THEN f := Files.Old(name); END;
IF f # NIL THEN
RETURN OpenArchive(name, res)
ELSE
f := Files.New(name);
NEW(arc);
arc.file := f;
arc.nofEntries := 0;
arc.offset := 0;
f.Set(r, 0);
WriteEndOfCentDir(arc, r);
IF name#"" THEN Files.Register(f) END;
res := Ok;
RETURN arc
END
END CreateArchive;
PROCEDURE FirstEntry*(arc: Archive): Entry;
BEGIN
IF arc = NIL THEN
RETURN NIL
ELSE
RETURN arc.firstEntry
END
END FirstEntry;
PROCEDURE NextEntry*(ent: Entry): Entry;
BEGIN
RETURN ent.next
END NextEntry;
PROCEDURE GetEntry*(arc: Archive; CONST name: ARRAY OF CHAR; VAR res: LONGINT): Entry;
VAR
ent: Entry;
BEGIN
IF arc = NIL THEN
res := NotZipArchiveError
ELSE
ent := arc.firstEntry;
WHILE (ent # NIL) & (ent.name # name) DO
ent := ent.next
END;
IF ent = NIL THEN
res := EntryNotFound
ELSE
res := Ok
END
END;
RETURN ent
END GetEntry;
PROCEDURE ExtractEntry*(arc: Archive; ent: Entry; VAR dst: Files.Rider; VAR res: LONGINT);
VAR
src: Files.Rider; crc32: LONGINT;
BEGIN
IF arc = NIL THEN
res := NotZipArchiveError
ELSIF (dst.file = NIL) THEN
res := BadName
ELSIF (ent = NIL) OR (ent # GetEntry(arc, ent.name, res)) THEN
res := EntryNotFound
ELSIF ~(ent.method IN SupportedCompMethods) OR (ent.support > Supported) THEN
res := NotSupportedError
ELSE
CASE ent.method OF
| Stored:
arc.file.Set(src, ent.offsetFileData);
Copy(src, dst, ent.uncompSize, TRUE, crc32);
IF crc32 = ent.crc32 THEN
res := Ok
ELSE
res := DataError
END
| Deflated:
arc.file.Set(src, ent.offsetFileData);
ZlibReaders.Uncompress(src, dst, crc32, res);
IF (res = ZlibReaders.Ok) & (crc32 = ent.crc32) THEN
res := Ok
ELSE
res := DataError
END
END;
IF res = Ok THEN
dst.file.Update();
END
END
END ExtractEntry;
PROCEDURE AddEntry*(arc: Archive; CONST name: ARRAY OF CHAR; VAR src: Files.Rider; len: LONGINT; level, strategy: SHORTINT; VAR res: LONGINT);
VAR
dst: Files.Rider; ent: Entry; start: LONGINT;
BEGIN
IF arc = NIL THEN
res := NotZipArchiveError
ELSIF (src.file = NIL) THEN
res := BadName
ELSIF (GetEntry(arc, name, res) # NIL) & (res = Ok) THEN
res := EntryAlreadyExists
ELSE
NEW(ent);
COPY(name, ent.name);
ent.genPurpBitFlag := 0;
IF level = NoCompression THEN
ent.method := Stored
ELSE
ent.method := Deflated
END;
src.file.GetDate(ent.time, ent.date);
ent.uncompSize := len;
ent.intFileAttr := 0;
ent.extFileAttr := 0;
ent.comment := NIL;
ent.support := Supported;
ent.dataDescriptor := FALSE;
IF arc.firstEntry # NIL THEN
ent.offsetLocal := arc.firstEntry.offsetCentralDir
ELSE
ent.offsetLocal := 0
END;
arc.file.Set(dst, ent.offsetLocal);
WriteLocalFileHeader(ent, dst);
ent.offsetFileData := dst.file.Pos(dst);
arc.file.Update();
start := src.file.Pos(src);
IF level = 0 THEN
Copy(src, dst, len, TRUE, ent.crc32);
ent.compSize := len;
res := Ok
ELSE
ZlibWriters.Compress(src, dst, len, ent.compSize, level, strategy, ent.crc32, res);
IF res # ZlibWriters.Ok THEN
res := DataError
ELSE
res := Ok
END
END;
IF res = Ok THEN
ent.uncompSize := src.file.Pos(src) - start;
arc.file.Update();
arc.file.Set(dst, ent.offsetLocal + 14);
Files.WriteLInt(dst, ent.crc32);
Files.WriteLInt(dst, ent.compSize);
arc.file.Update;
IF arc.lastEntry # NIL THEN
arc.lastEntry.next := ent
ELSE
arc.firstEntry := ent
END;
arc.lastEntry := ent;
INC(arc.nofEntries);
arc.file.Set(dst, ent.offsetFileData + ent.compSize);
WriteCentralDirectory(arc, dst);
arc.file.Update();
res := Ok
END;
END
END AddEntry;
PROCEDURE DeleteEntry*(arc: Archive; VAR ent: Entry; VAR res: LONGINT);
VAR
f: Files.File; r1, r2: Files.Rider;
ent2: Entry;
arcname: ARRAY 256 OF CHAR;
offset, diff: LONGINT;
BEGIN
IF arc = NIL THEN
res := NotZipArchiveError
ELSIF arc.firstEntry = NIL THEN
res := EntryNotFound
ELSIF arc.firstEntry = ent THEN
offset := arc.firstEntry.offsetLocal;
IF arc.lastEntry = arc.firstEntry THEN
arc.lastEntry := arc.firstEntry.next
END;
arc.firstEntry := arc.firstEntry.next;
ent2 := arc.firstEntry;
res := Ok
ELSE
ent2 := arc.firstEntry;
WHILE (ent2.next # NIL) & (ent2.next # ent) DO
ent2 := ent2.next
END;
IF ent2.next = NIL THEN
res := EntryNotFound
ELSE
IF arc.lastEntry = ent2.next THEN
arc.lastEntry := ent2
END;
offset := ent2.next.offsetLocal;
ent2.next := ent2.next.next;
ent2 := ent2.next;
res := Ok
END
END;
IF res = Ok THEN
arc.file.GetName(arcname);
f := Files.New(arcname);
f.Set(r2, 0);
arc.file.Set(r1, 0);
Copy(r1, r2, offset, FALSE, diff);
f.Update;
ASSERT(ent2 = ent.next);
IF ent2 # NIL THEN
arc.file.Set(r1, ent2.offsetLocal);
Copy(r1, r2, arc.firstEntry.offsetCentralDir - ent2.offsetLocal, FALSE, diff);
f.Update;
diff := ent2.offsetLocal - offset
ELSE
diff := arc.offset - offset
END;
WHILE (ent2 # NIL) DO
DEC(ent2.offsetLocal, diff); DEC(ent2.offsetFileData, diff); DEC(ent2.offsetCentralDir, diff);
ent2 := ent2.next
END;
DEC(arc.offset, diff);
DEC(arc.nofEntries);
WriteCentralDirectory(arc, r2);
Files.Register(f); arc.file := f; ent := NIL
END
END DeleteEntry;
PROCEDURE OpenReader*(arc: Archive; ent: Entry): Reader;
VAR
dummyBuf: ARRAY 1 OF CHAR;
fr: Files.Rider;
r: Reader;
ur: UncompReader;
dr: DefReader;
BEGIN
IF ent.support = Supported THEN
IF ent.method = Stored THEN
NEW(ur);
ur.crc32 := Zlib.CRC32(0, dummyBuf, -1, -1);
arc.file.Set(ur.fr, ent.offsetFileData);
r := ur;
r.open := TRUE;
r.res := Ok
ELSIF ent.method = Deflated THEN
arc.file.Set(fr, ent.offsetFileData);
NEW(dr);
ZlibReaders.Open(dr.zr, FALSE, fr);
dr.res := dr.zr.res;
r := dr;
r.open := TRUE
ELSE
NEW(r);
r.open := FALSE;
r.res := NotSupportedError
END;
ELSE
NEW(r);
r.open := FALSE;
r.res := NotSupportedError
END;
r.ent := ent;
RETURN r;
END OpenReader;
PROCEDURE ReadBytes*(r: Reader; VAR buf: ARRAY OF CHAR; offset, len: LONGINT; VAR read: LONGINT);
VAR
bufp: POINTER TO ARRAY OF CHAR; i: LONGINT;
BEGIN
IF r.open THEN
IF r IS UncompReader THEN
IF offset = 0 THEN
r(UncompReader).fr.file.ReadBytes(r(UncompReader).fr, buf, 0, len);
ELSE
NEW(bufp, len);
r(UncompReader).fr.file.ReadBytes(r(UncompReader).fr, bufp^, 0, len);
FOR i := 0 TO len - 1 DO
buf[offset + i] := bufp[i]
END
END;
read := len - r(UncompReader).fr.res;
r(UncompReader).crc32 := Zlib.CRC32(r(UncompReader).crc32, buf, offset, read)
ELSIF r IS DefReader THEN
ZlibReaders.ReadBytes(r(DefReader).zr, buf, offset, len, read);
r.res := r(DefReader).zr.res
END
ELSE
r.res := ReaderError
END
END ReadBytes;
PROCEDURE Read*(r: Reader; VAR ch: CHAR);
VAR
buf: ARRAY 1 OF CHAR; read: LONGINT;
BEGIN
ReadBytes(r, buf, 0, 1, read);
ch := buf[0];
END Read;
PROCEDURE Close*(r: Reader);
BEGIN
IF r.open THEN
IF r IS UncompReader THEN
IF r(UncompReader).crc32 # r.ent.crc32 THEN
r.res := DataError
ELSE
r.res := Ok
END
ELSIF r IS DefReader THEN
ZlibReaders.Close(r(DefReader).zr);
IF r(DefReader).zr.crc32 # r.ent.crc32 THEN
r.res := DataError
ELSE
r.res := r(DefReader).zr.res
END
ELSE
r.res := ReaderError
END;
r.open := FALSE
ELSE
r.res := ReaderError
END
END Close;
END Zip.