home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / UTILITY / DECODE.M < prev    next >
Encoding:
Text File  |  1990-12-14  |  4.5 KB  |  175 lines
  1. MODULE Decode;
  2.  
  3. (* Dekomprimiert Dateien.
  4.  *
  5.  * Eine komprimierte Datei hat folgenden Header:
  6.  * 8 Zeichen: "MM2Comp"+0C
  7.  * ...die komprimierten Daten
  8.  *)
  9.  
  10. IMPORT GEMIO;
  11. FROM EasyGEM1 IMPORT SelectFile;
  12. FROM MOSGlobals IMPORT fNoMatchingFiles, PathStr, FileStr;
  13. FROM BinOps IMPORT LowerLCard;
  14. IMPORT Files, Binary;
  15. FROM Directory IMPORT Delete, DirQuery, DirQueryProc, DirEntry, FileAttrSet,
  16.         SetFileAttr;
  17. FROM FileNames IMPORT SplitPath, PathConc;
  18. FROM InOut IMPORT Write, WriteString, WriteCard, WriteLn, Read, WritePg,
  19.         BusyRead, ReadString, GotoXY;
  20. FROM Strings IMPORT Space, Length, Empty, Append, String, Compare, Relation;
  21. FROM SYSTEM IMPORT ADDRESS, ADR, TSIZE, BYTE, WORD, LONGWORD;
  22. FROM Storage IMPORT ALLOCATE, DEALLOCATE;
  23. IMPORT Compressions;
  24.  
  25. TYPE Ascii = SET OF CHAR;
  26.  
  27. VAR ok: BOOLEAN;
  28.     r: INTEGER;
  29.     all: BOOLEAN;
  30.     destPath: PathStr;
  31.  
  32.  
  33. PROCEDURE get (a: Ascii): CHAR;
  34.   VAR c: CHAR;
  35.   BEGIN
  36.     REPEAT
  37.       Read (c);
  38.       IF c >= ' ' THEN Write (CHR (8)) END;
  39.       c:= CAP (c);
  40.     UNTIL c IN a;
  41.     RETURN c
  42.   END get;
  43.  
  44. PROCEDURE yes (): BOOLEAN;
  45.   BEGIN
  46.     RETURN get (Ascii{'J','N'}) = 'J'
  47.   END yes;
  48.  
  49. PROCEDURE wait;
  50.   VAR c: CHAR;
  51.   BEGIN
  52.     WriteLn;
  53.     WriteLn;
  54.     WriteString ('Taste zum Beenden...');
  55.     Read (c)
  56.   END wait;
  57.  
  58. PROCEDURE error;
  59.   VAR s: ARRAY [0..31] OF CHAR;
  60.   BEGIN
  61.     WriteLn;
  62.     Files.GetStateMsg (r, s);
  63.     WriteString ('Fehler: ');
  64.     WriteString (s);
  65.     WriteLn;
  66.     r:= 0
  67.   END error;
  68.  
  69. PROCEDURE ferror (f: Files.File);
  70.   BEGIN
  71.     r:= Files.State (f);
  72.     error
  73.   END ferror;
  74.  
  75. PROCEDURE insFile (REF path: ARRAY OF CHAR; e: DirEntry): BOOLEAN;
  76.  
  77.   VAR c: CHAR; dam: BOOLEAN;
  78.       f: Files.File;
  79.       n: LONGCARD;
  80.       source, dest: ADDRESS;
  81.       newlen, slen, dlen: LONGCARD;
  82.       type: CARDINAL;
  83.       str: POINTER TO ARRAY [0..7] OF CHAR;
  84.  
  85.   BEGIN
  86.     WriteLn;
  87.     WriteString (e.name);
  88.     IF ~all THEN
  89.       WriteString (' ? (Ja/Nein/Alle/Fertig) ');
  90.       c:= get (Ascii{'J','N','A','F'});
  91.       IF c='F' THEN
  92.         RETURN FALSE
  93.       ELSIF c='N' THEN
  94.         RETURN TRUE
  95.       ELSIF c='A' THEN
  96.         all:= TRUE
  97.       END
  98.     END;
  99.     ALLOCATE (source, e.size);
  100.     Files.Open (f, PathConc (path, e.name), Files.readOnly);
  101.     Binary.ReadBytes (f, source, e.size, n);
  102.     IF e.size # n THEN HALT END;
  103.     Files.Close (f);
  104.     str:= source;
  105.     IF Compare ("MM2Comp", str^) # equal THEN
  106.       WriteString (' ist nicht komprimiert!')
  107.     ELSE
  108.       Compressions.GetInfo (source+8L, type, dlen);
  109.       ALLOCATE (dest, dlen);
  110.       IF dest = NIL THEN HALT END;
  111.       DEC (n, 8);
  112.       Compressions.Decode (source+8L, n, dest, dlen, ok);
  113.       IF NOT ok THEN
  114.         DEALLOCATE (dest, 0);
  115.         WriteString ('  Fehler beim Dekodieren!');
  116.         WriteLn;
  117.         WriteString ('Weiter? (J/N) ');
  118.         RETURN yes ()
  119.       ELSE
  120.         Files.Create (f, PathConc (destPath, e.name),
  121.                          Files.writeOnly, Files.replaceOld);
  122.         Binary.WriteBytes (f, dest, dlen);
  123.         Files.Close (f);
  124.         DEALLOCATE (dest, 0);
  125.         (* Datum/Zeit der dekomprimierten Datei übernehmen *)
  126.         Files.Open (f, PathConc (destPath, e.name), Files.readWrite);
  127.         Files.SetDateTime (f, e.date, e.time);
  128.         Files.Close (f);
  129.         IF Files.State (f) < 0 THEN ferror (f); RETURN FALSE END;
  130.         WriteString (' dekodiert');
  131.       END;
  132.     END;
  133.     DEALLOCATE (source, 0);
  134.     RETURN TRUE
  135.   END insFile;
  136.  
  137. PROCEDURE newFile;
  138.   VAR s: FileStr; dummy: ARRAY [0..11] OF CHAR;
  139.   BEGIN
  140.     WriteString ('Name der zu dekomprimierenden Datei (Wildcards sind erlaubt, z.B "*.DEF"):');
  141.     WriteLn;
  142.     s:= '';
  143.     SelectFile ('Gepackte Datei(en)?', s, ok);
  144.     IF NOT ok THEN RETURN END;
  145.     WriteString (s);
  146.     WriteLn;
  147.     WriteLn;
  148.     WriteString ('Ziel-Pfad: ');
  149.     destPath:= '';
  150.     SelectFile ('Ziel-Pfad?', destPath, ok);
  151.     IF NOT ok THEN RETURN END;
  152.     SplitPath (destPath, destPath, dummy);
  153.     WriteString (destPath);
  154.     all:= FALSE;
  155.     DirQuery (s, FileAttrSet {}, insFile, r);
  156.     IF r < 0 THEN
  157.       error
  158.     ELSIF r = fNoMatchingFiles THEN
  159.       WriteLn;
  160.       WriteString ('Keine passenden Dateien gefunden!');
  161.       WriteLn;
  162.     END
  163.   END newFile;
  164.  
  165. BEGIN
  166.   WriteLn ();
  167.   WriteString (' Dekodierer für Megamax Modula-2');
  168.   WriteLn ();
  169.   WriteString (' Erstellt 8/1989 von Gabi Keller, Manuel Chakravarty & Thomas Tempelmann');
  170.   WriteLn ();
  171.   WriteLn ();
  172.   newFile;
  173.   wait;
  174. END Decode.
  175.