home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / UTILITY / LIBMANAG.M < prev    next >
Encoding:
Text File  |  1991-01-14  |  10.9 KB  |  410 lines
  1. MODULE LibManager;
  2.  
  3. (*
  4.  * Ermöglicht Zugriff auf den Inhalt von Megamax Library-Dateien
  5.  *
  6.  * Erstellt Frühjahr/Sommer 1989 von Thomas Tempelmann      (Stand: 14.01.91)
  7.  *
  8.  *   Hier noch ein paar Anregungen für lange Winterabende, an denen
  9.  * sonst nix zu tun ist:
  10.  *   - Mit dem Modul 'WindowLists' könnte die Anzeige und Auswahl der Dateien
  11.  *     in der Library übersichtlicher gestaltet werden.
  12.  *   - Das Löschen oder Anzeigen der Dateien in der Lib könnte mit der
  13.  *     Funktion 'NameMatching' aus 'FileNames' auch über sog. 'Wildcards'
  14.  *     ermöglicht werden.
  15.  *   Und wenn Sie tatsächlich solche oder andere Verbesserungen an den
  16.  * Megamax-Hilfsprogrammen vorgenommen haben, schicken Sie sie uns doch
  17.  * zurück. Wir würden sie dann gerne durch unsere Versionen ersetzen.
  18.  * Auch wenn es keine echten MEMOX-Beiträge wären, bieten wir Ihnen trotzdem
  19.  * eine MEMOX-Disk im Tausch.
  20.  *)
  21.  
  22. IMPORT GEMIO;
  23. IMPORT VT52;
  24. FROM EasyGEM1 IMPORT SelectFile, SelectMask;
  25. FROM BinOps IMPORT LowerLCard;
  26. IMPORT Clock, TimeConvert, MOSGlobals, Files, Binary;
  27. FROM Directory IMPORT Delete, DirQuery, DirQueryProc, DirEntry, FileAttrSet,
  28.         SetFileAttr;
  29. FROM FileNames IMPORT FileName, FilePath, ConcatName, FileSuffix, ValidatePath;
  30. FROM MOSGlobals IMPORT FileStr, PathStr, fNoMatchingFiles;
  31. FROM InOut IMPORT Write, WriteString, WriteCard, WriteLn, Read, WritePg,
  32.         ReadString, GotoXY;
  33. IMPORT LibFiles;
  34. FROM Strings IMPORT Assign, Space, Length, Empty, Append, String;
  35. FROM FuncStrings IMPORT ConcStr;
  36. FROM SYSTEM IMPORT ADDRESS, ADR, TSIZE, BYTE, WORD, LONGWORD;
  37.  
  38. TYPE Cmd = (quit, open, list, add, remove, extract);
  39.      Ascii = SET OF CHAR;
  40.  
  41. VAR ok: BOOLEAN;
  42.     ch: CHAR;
  43.     f: Files.File;
  44.     path, libName: FileStr;
  45.     lib: LibFiles.LibFile;
  46.     r: INTEGER;
  47.     all: BOOLEAN;
  48.     count: CARDINAL;
  49.     copybuffer: ARRAY [1..$2000] OF CARDINAL;
  50.  
  51.  
  52. PROCEDURE get (a: Ascii): CHAR;
  53.   VAR c: CHAR;
  54.   BEGIN
  55.     REPEAT
  56.       Read (c);
  57.       IF c >= ' ' THEN Write (CHR (8)) END;
  58.       c:= CAP (c);
  59.     UNTIL c IN a;
  60.     RETURN c
  61.   END get;
  62.  
  63. PROCEDURE yes (): BOOLEAN;
  64.   BEGIN
  65.     RETURN get (Ascii{'J','N'}) = 'J'
  66.   END yes;
  67.  
  68. PROCEDURE wait;
  69.   VAR c: CHAR;
  70.   BEGIN
  71.     WriteString ('Taste...');
  72.     Read (c)
  73.   END wait;
  74.  
  75. PROCEDURE weiter (): BOOLEAN;
  76.   VAR c: CHAR;
  77.   BEGIN
  78.     WriteString ('Weiter? (J/N) ');
  79.     RETURN yes ()
  80.   END weiter;
  81.  
  82. PROCEDURE error (taste: BOOLEAN);
  83.   VAR s: ARRAY [0..31] OF CHAR;
  84.   BEGIN
  85.     WriteLn;
  86.     Files.GetStateMsg (r, s);
  87.     WriteString ('Fehler: ');
  88.     WriteString (s);
  89.     WriteLn;
  90.     IF taste THEN wait END;
  91.     r:= 0
  92.   END error;
  93.  
  94. PROCEDURE ferror (f: Files.File);
  95.   BEGIN
  96.     r:= Files.State (f);
  97.     error (TRUE)
  98.   END ferror;
  99.  
  100.  
  101. PROCEDURE openLib;
  102.   VAR s: FileStr;
  103.   BEGIN
  104.     WritePg;
  105.     s:= '';
  106.     ConcatName (SelectMask, 'M2L', SelectMask);
  107.     SelectFile ('Wähle Library', s, ok);
  108.     ConcatName (SelectMask, '*', SelectMask);
  109.     IF NOT ok OR (LENGTH (FileName (s)) = 0) THEN RETURN END;
  110.     IF LENGTH (FileSuffix (s)) = 0 THEN
  111.       ConcatName (s, 'M2L', s)
  112.     END;
  113.     LibFiles.OpenLib (lib, s, r);
  114.     IF (r = MOSGlobals.fPathNotFound) OR (r = MOSGlobals.fFileNotFound) THEN
  115.       WriteLn;
  116.       WriteString (
  117.         'Library existiert nicht. Soll sie neu angelegt werden ? (J/N) ');
  118.       IF yes () THEN
  119.         LibFiles.CreateLib (s, r);
  120.         IF r < 0 THEN
  121.           libName:= '';
  122.           error (TRUE);
  123.           RETURN
  124.         END;
  125.         LibFiles.OpenLib (lib, s, r)
  126.       END
  127.     END;
  128.     IF r < 0 THEN
  129.       error (TRUE)
  130.     ELSE
  131.       libName:= s
  132.     END;
  133.     LibFiles.CloseLib (lib);
  134.   END openLib;
  135.  
  136.  
  137. PROCEDURE showEntry ( f: LibFiles.LibEntry ): BOOLEAN;
  138.   VAR s: String;
  139.   BEGIN
  140.     IF count = 0 THEN
  141.       count:= 18;
  142.       wait;
  143.       WritePg
  144.     END;
  145.     DEC (count);
  146.     WriteString (f.name);
  147.     WriteString (Space (14-Length (f.name)));
  148.     WriteCard (f.size,7);
  149.     WriteString ('   ');
  150.     TimeConvert.DateToText ( Clock.UnpackDate (f.date), '', s);
  151.     WriteString (s);
  152.     WriteString ('   ');
  153.     TimeConvert.TimeToText ( Clock.UnpackTime (f.time), '', s);
  154.     WriteString (s);
  155.     WriteLn;
  156.     RETURN TRUE
  157.   END showEntry;
  158.  
  159. PROCEDURE showLib;
  160.   BEGIN
  161.     WritePg;
  162.     count:= 18;
  163.     LibFiles.OpenLib (lib, libName, r);
  164.     IF r < 0 THEN error (TRUE); RETURN END;
  165.     LibFiles.LibQuery (lib, showEntry, r);
  166.     LibFiles.CloseLib (lib);
  167.     WriteLn;
  168.     IF r < 0 THEN error (TRUE) ELSE WriteLn; wait END
  169.   END showLib;
  170.  
  171.  
  172. PROCEDURE readEntry ( d: LibFiles.LibEntry ): BOOLEAN;
  173.   VAR f: Files.File; rd,n: LONGCARD;
  174.   BEGIN
  175.     WriteLn;
  176.     WriteString (d.name);
  177.     WriteString (VT52.Seq[VT52.flush]);
  178.     Files.Create (f, ConcStr (path, d.name),
  179.                   Files.writeOnly, Files.noReplace);
  180.     IF Files.State (f) = MOSGlobals.fFileExists THEN
  181.       WriteString ('  -  Datei existiert schon ! Überschreiben ? (J/N) ');
  182.       IF yes () THEN
  183.         Files.Create (f, ConcStr (path, d.name), Files.writeOnly,
  184.                 Files.replaceOld);
  185.       ELSE
  186.         RETURN TRUE
  187.       END
  188.     END;
  189.     IF Files.State (f) < 0 THEN
  190.       ferror (f);
  191.       RETURN FALSE
  192.     END;
  193.     Binary.Seek (lib.f, d.start, Binary.fromBegin);
  194.     rd:= LowerLCard (SIZE (copybuffer), d.size);
  195.     n:= d.size;
  196.     REPEAT
  197.       Binary.ReadBytes (lib.f, ADR (copybuffer), rd, rd);
  198.       Binary.WriteBytes (f, ADR (copybuffer), rd);
  199.       n:= n - rd;
  200.       IF Files.State (f) < 0 THEN
  201.         ferror (f); Files.Remove (f); RETURN FALSE
  202.       END;
  203.     UNTIL n = 0L;
  204.     Files.Close (f);
  205.     IF Files.State (f) < 0 THEN ferror (f); RETURN FALSE END;
  206.     Files.Open (f, ConcStr (path, d.name), Files.readOnly);
  207.     Files.SetDateTime (f, Clock.UnpackDate(d.date), Clock.UnpackTime(d.time));
  208.     Files.Close (f);
  209.     SetFileAttr (ConcStr (path, d.name), d.attr, r);
  210.     RETURN TRUE
  211.   END readEntry;
  212.  
  213. PROCEDURE readFile;
  214.   VAR d: LibFiles.LibEntry; l,c: CHAR;
  215.       s: FileStr;
  216.   BEGIN
  217.     WritePg;
  218.     LibFiles.OpenLib (lib, libName, r);
  219.     IF r < 0 THEN error (TRUE); RETURN END;
  220.     WriteString ('Alle Dateien oder Eine ? (A/E) ');
  221.     c:= get (Ascii{'A','E',33C});
  222.     IF c=33C THEN LibFiles.CloseLib (lib); RETURN END;
  223.     WriteLn;
  224.     WriteLn;
  225.     WriteString ('Ziel-Verzeichnis: ');
  226.     s:= '';
  227.     SelectFile ('Ziel-Verzeichnis?', s, ok);
  228.     IF NOT ok THEN LibFiles.CloseLib (lib); RETURN END;
  229.     Assign (FilePath (SelectMask), path, ok);
  230.     WriteString (path);
  231.     IF c = 'A' THEN
  232.       LibFiles.LibQuery (lib, readEntry, r);
  233.     ELSE
  234.       WriteLn;
  235.       WriteString ('Welche Datei aus der Library herauskopieren? ');
  236.       ReadString (s);
  237.       LibFiles.LookUp (lib, s, d, r);
  238.       IF r >= 0 THEN
  239.         IF readEntry (d) THEN END;
  240.       END
  241.     END;
  242.     LibFiles.CloseLib (lib);
  243.     IF r < 0 THEN error (TRUE) END;
  244.   END readFile;
  245.  
  246.  
  247. PROCEDURE delLib;
  248.   BEGIN
  249.     WriteLn;
  250.     WriteString ('Library ist beschädigt und wird gelöscht.');
  251.     Delete (libName, r);
  252.     libName:= '';
  253.     WriteLn;
  254.     wait;
  255.   END delLib;
  256.  
  257. PROCEDURE insFile (REF path: ARRAY OF CHAR; e: DirEntry): BOOLEAN;
  258.  
  259.   VAR c: CHAR; dam: BOOLEAN;
  260.       d: LibFiles.LibEntry;
  261.       l, f: Files.File;
  262.       n: LONGCARD;
  263.  
  264.   BEGIN
  265.     WriteLn;
  266.     WriteString (e.name);
  267.     WriteString (VT52.Seq[VT52.flush]);
  268.     IF ~all THEN
  269.       WriteString (' ? (Ja/Nein/Alle/Fertig) ');
  270.       c:= get (Ascii{'J','N','A','F'});
  271.       IF c='F' THEN
  272.         RETURN FALSE
  273.       ELSIF c='N' THEN
  274.         RETURN TRUE
  275.       ELSIF c='A' THEN
  276.         all:= TRUE
  277.       END
  278.     END;
  279.     WITH d DO
  280.       name:= e.name;
  281.       size:= e.size;
  282.       attr:= e.attr;
  283.       date:= Clock.PackDate (e.date);
  284.       time:= Clock.PackTime (e.time);
  285.     END;
  286.     LibFiles.AddFile (libName, d, dam, r);
  287.     IF r < 0 THEN
  288.       error (FALSE); (* hier noch nicht auf Taste warten *)
  289.       IF dam THEN
  290.         delLib; (* wartet auf Taste *)
  291.         RETURN FALSE
  292.       END;
  293.       RETURN weiter ()
  294.     END;
  295.     Files.Open (l, libName, Files.writeOnly);
  296.     Binary.Seek (l, d.start, Binary.fromBegin);
  297.     Files.Open (f, ConcStr (path, e.name), Files.readOnly);
  298.     n:= SIZE (copybuffer);
  299.     REPEAT
  300.       Binary.ReadBytes (f, ADR (copybuffer), n, n);
  301.       Binary.WriteBytes (l, ADR (copybuffer), n);
  302.     UNTIL n = 0L;
  303.     Files.Close (f);
  304.     Files.Close (l);
  305.     IF Files.State (l) < 0 THEN ferror (l); delLib; RETURN FALSE END;
  306.     RETURN TRUE
  307.   END insFile;
  308.  
  309. PROCEDURE newFile;
  310.   VAR s: FileStr;
  311.   BEGIN
  312.     WritePg;
  313.     WriteString ('Name der einzufügenden Datei(en) (auch Wildcards, z.B "*.DEF")? ');
  314.     WriteString (VT52.Seq[VT52.flush]);
  315.     WriteLn;
  316.     s:= '';
  317.     SelectFile ('Wähle Datei(en)', s, ok);
  318.     IF NOT ok OR (LENGTH (FileName (s)) = 0) THEN RETURN END;
  319.     all:= FALSE;
  320.     DirQuery (s, FileAttrSet {}, insFile, r);
  321.     IF r < 0 THEN
  322.       error (TRUE)
  323.     ELSIF r = fNoMatchingFiles THEN
  324.       WriteLn;
  325.       WriteString ('Keine passenden Dateien gefunden!');
  326.       WriteLn;
  327.       wait
  328.     END
  329.   END newFile;
  330.  
  331.  
  332. PROCEDURE delFile;
  333.   VAR s: FileStr; dam: BOOLEAN;
  334.   BEGIN
  335.     WritePg;
  336.     WriteString ('Name der in der Library zu löschenden Datei? ');
  337.     ReadString (s);
  338.     IF Empty (s) THEN RETURN END;
  339.     LibFiles.RemoveFile (libName, s, dam, r);
  340.     IF r < 0 THEN
  341.       error (TRUE);
  342.       IF dam THEN delLib END
  343.     END
  344.   END delFile;
  345.  
  346.  
  347. PROCEDURE menu (onlyOpen: BOOLEAN);
  348.   BEGIN
  349.     WritePg;
  350.     GotoXY (20, 1);
  351.     WriteString ('Megamax Modula-2 Library Manager');
  352.     GotoXY (0, 3);
  353.     IF Empty (libName) THEN
  354.       WriteString ('Noch keine Library gewählt');
  355.     ELSE
  356.       WriteString ('Aktuelle Library: ');
  357.       WriteString (libName);
  358.     END;
  359.     GotoXY (0, 6);
  360.     WriteString (' W - Library wählen / anlegen');
  361.     WriteLn;
  362.     IF NOT onlyOpen THEN
  363.       WriteString (' I - Inhalt der Library zeigen');
  364.       WriteLn;
  365.       WriteString (' L - Eine Datei aus Library löschen');
  366.       WriteLn;
  367.       WriteString (' E - Neue Datei(en) in Library einfügen');
  368.       WriteLn;
  369.       WriteString (' K - Datei(en) aus Library herauskopieren');
  370.       WriteLn;
  371.     END;
  372.     WriteString (' Q - Ende');
  373.   END menu;
  374.  
  375. PROCEDURE wahl (onlyOpen: BOOLEAN): Cmd;
  376.   VAR c: CHAR; s: Ascii;
  377.   BEGIN
  378.     IF onlyOpen THEN
  379.       s:= Ascii {'W','Q'};
  380.     ELSE
  381.       s:= Ascii {'W','I','E','L','K','Q'};
  382.     END;
  383.     GotoXY (0, 5);
  384.     WriteString ('Wähle: ');
  385.     CASE get (s) OF
  386.       'W': RETURN open |
  387.       'I': RETURN list |
  388.       'E': RETURN add |
  389.       'L': RETURN remove |
  390.       'K': RETURN extract |
  391.       'Q': RETURN quit
  392.     END
  393.   END wahl;
  394.  
  395. BEGIN
  396.   SelectMask:= '*.*';
  397.   WriteString (VT52.Seq[VT52.enhancedOn]); (* Global: schnelle Ausgaben *)
  398.   LOOP
  399.     menu (Empty (libName));
  400.     CASE wahl (Empty (libName)) OF
  401.       open: openLib |
  402.       list: showLib |
  403.       add: newFile |
  404.       remove: delFile |
  405.       extract: readFile |
  406.       quit: EXIT
  407.     END
  408.   END
  409. END LibManager.
  410.