home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / sonderh1 / unpress.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-10-12  |  4.1 KB  |  124 lines
  1. (* -------------------------------------------------------------------------
  2.        Ein Utility zum platzsparenden Abspeichern von ASCII-Dateien
  3.    ------------------------------------------------------------------------- *)
  4. PROGRAM UnPress (INPUT, OUTPUT);
  5.  
  6. VAR   eindatnam, ausdatnam     : STRING [20];
  7.       eindatei, ausdatei       : TEXT;
  8.  
  9. (* ------------------------------------------------------------------------- *)
  10.  
  11. PROCEDURE HoleDatNam;
  12.  
  13. BEGIN
  14.   WriteLn; WriteLn;
  15.   WriteLn ('------------------------');
  16.   WriteLn ('  U N P R E S S  v0.1   ');
  17.   WriteLn ('------------------------');
  18.   WriteLn; WriteLn;
  19.   Write ('Welche Datei soll bearbeitet werden ? ');
  20.   Read (eindatnam);
  21.   WriteLn; WriteLn;
  22.   Write ('Wie soll die Ausgabedatei heissen   ? ');
  23.   Read (ausdatnam);
  24.   WriteLn; WriteLn;
  25. END; (* HoleDatNam *)
  26.  
  27. (* ------------------------------------------------------------------------- *)
  28.  
  29. PROCEDURE OeffneDateien;
  30.  
  31. BEGIN
  32.   Assign (eindatei, eindatnam);                            (* Quelldatei zum *)
  33.   Reset (eindatei);                                        (* lesen oeffnen. *)
  34.   Assign (ausdatei, ausdatnam);                        (* Zieldatei zum      *)
  35.   Rewrite (ausdatei);                                  (* schreiben oeffnen. *)
  36. END; (* OeffneDateien *)
  37.  
  38. (* ------------------------------------------------------------------------- *)
  39.  
  40. PROCEDURE UnPress;
  41.  
  42. CONST EofMarker = 26;                    (* Markiert Ende der Datei bei CP/M *)
  43.             ESC = 27;
  44.            Mask = 128;                         (* 8. Bit setzen bei Wordende *)
  45.           Blank = ' ';
  46.  
  47. VAR   ch, chtmp         : CHAR;
  48.       einanz, ausanz, i : INTEGER;
  49.       BlankFg           : BOOLEAN;
  50.  
  51.   (* -----------------------------------------------------------------------
  52.      Pruefen, ob 'gepresstes' Zeichen am Ende eines Wortes. Wenn ja, Bit 7
  53.      zuruecksetzen und melden, dass nach dem Zeichen ein Leerzeichen
  54.      folgen muss.                                                            *)
  55.  
  56.   FUNCTION BlankApp (VAR ch : CHAR) : BOOLEAN;
  57.  
  58.   BEGIN
  59.     BlankApp := False;
  60.     IF NOT (Ord (ch) < Mask) THEN
  61.       BEGIN
  62.         ch := Chr (Ord (ch) - Mask);
  63.         BlankApp := True;
  64.       END;
  65.   END; (* BlankApp *)
  66.  
  67. (* ------------------------------------------------------------------------- *)
  68.  
  69. BEGIN (* UnPress *)
  70.   einanz := 1; ausanz := 1;
  71.   Read (eindatei, ch);
  72.   WHILE NOT Eof (eindatei) DO BEGIN
  73.     einanz := Succ (einanz);
  74.     CASE Ord (ch) OF
  75.       ESC : BEGIN                                  (* komprimiertes Zeichen! *)
  76.               Read (eindatei, ch, chtmp);
  77.               einanz := einanz + 2;
  78.               CASE Ord (ch) OF
  79.                 ESC : BEGIN                         (* Anzahl = EOF-Kennung! *)
  80.                         BlankFg := BlankApp (chtmp);
  81.                         For i := 1 TO EofMarker DO
  82.                           Write (ausdatei, chtmp);
  83.                         ausanz := ausanz + EofMarker;
  84.                       END
  85.                 ELSE
  86.                       BEGIN                        (* Anzahl <> EOF-Kennung! *)
  87.                         BlankFg := BlankApp (ch);
  88.                         For i := 1 TO Ord (chtmp) DO
  89.                           Write (ausdatei, ch);
  90.                         ausanz := ausanz + Ord (chtmp);
  91.                       END;
  92.               END;
  93.             END;
  94.       ELSE
  95.             BEGIN                                      (* einzelnes Zeichen! *)
  96.               BlankFg := BlankApp (ch);
  97.               Write (ausdatei, ch);
  98.               ausanz := Succ (ausanz);
  99.             END;
  100.     END;
  101.     If BlankFg THEN                (* Am Wortende ein Leerzeichen einfuegen. *)
  102.       BEGIN
  103.         Write (ausdatei, Blank);
  104.         ausanz := Succ (ausanz);
  105.       END;
  106.     IF ausanz MOD 1024 < 2 THEN
  107.       Write ('.');
  108.     Read (eindatei, ch);
  109.   END;
  110.   Close (eindatei);
  111.   Close (ausdatei);
  112.   WriteLn; WriteLn;
  113.   WriteLn (einanz:7,' Zeichen aus ''',eindatnam,''' gelesen,');
  114.   WriteLn (ausanz:7,' Zeichen nach ''',ausdatnam,''' geschrieben.');
  115. END; (* UnPress *)
  116.  
  117.  
  118. BEGIN
  119.   HoleDatNam;
  120.   OeffneDateien;
  121.   UnPress;
  122. END.
  123.  
  124.