Turbo Toolbox/Turbo_Toolbox.iso/extra18/compress/compress.pas

Pascal/Delphi Source File | 1992-01-28 | 13.2 KB | 369 lines

(* ------------------------------------------------- *)
(*                    COMPRESS.PAS                   *)
(*                                                   *)
(* Die Unit »CompressU« dient zum Komprimieren und   *)
(* Dekomprimieren von beliebigen Daten. Der Algo-    *)
(* rithmus faßt dabei sich wiederholende Bytes in    *)
(* ein Zählbyte und ein Datenbyte zusammen. Treten   *)
(* in einer Datei keine Wiederholungen auf, so ist   *)
(* der Algorithmus ungeeignet, da er die Datei nur   *)
(* vergrößert.                                       *)
(* Die Unit definiert ein Objekt 'compressOBJ', das  *)
(* dem Benutzer 5 Methoden zur Verfügung stellt. Die *)
(* Methode 'Init' muß vor allen anderen einmal auf-  *)
(* gerufen werden, da sie wichtige Initialisierungen *)
(* vornimmt.                                         *)
(* Die Methode 'Compress' komprimiert ihr übergebene *)
(* Daten und gibt sie an die abstrakte Methode       *)
(* 'Write_bytes' weiter.                             *)
(* Die Methode 'Decompress' dekomprimiert Daten, die *)
(* sie aus der abstrakten Methode 'Read_bytes' liest *)
(*                                                   *)
(*       (c) 1991 Uwe Dirksen & DMV-Verlag           *)
(* ------------------------------------------------- *)
UNIT CompressU;

INTERFACE

TYPE
  compressOBJ = OBJECT

    CONSTRUCTOR Init;
    PROCEDURE   Compress(VAR database;
                         VAR laenge : WORD);
    PROCEDURE   Decompress(VAR database;
                           VAR laenge : WORD);
    PROCEDURE   Read_bytes(VAR database;
                           VAR laenge : WORD);
      VIRTUAL;
    PROCEDURE   Write_bytes(VAR database;
                            VAR laenge : WORD);
      VIRTUAL;
    PRIVATE
    is_command : BOOLEAN;
                         (* TRUE= command enthält    *)
                         (*   restlichen Befehlscode *)
    data       : BYTE;
    command    : WORD;
  END; (* compressOBJ *)

IMPLEMENTATION

  PROCEDURE compressOBJ.Read_bytes(VAR database;
                                   VAR laenge : WORD);
    (* abstrakte Methode, Definition erfolgt bei     *)
    (* Bildung eines Nachfahren von »compressOBJ«    *)
    (*  IN : laenge   = Anzahl der zu lesenen Bytes  *)
    (* OUT : database = untypisierte Variable        *)
    (*                  ( d.h. Typ ist beliebig )    *)
    (* OUT : laenge   = Länge der wirklich gelesenen *)
    (*                  Bytes                        *)
  BEGIN
  END;

  PROCEDURE compressOBJ.Write_bytes(VAR database;
                                    VAR laenge : WORD);
    (* abstrakte Methode, Definition erfolgt bei     *)
    (* Bildung eines Nachfahren von »compressOBJ«    *)
    (*  IN : database = untypisierte Variable        *)
    (*                  ( d.h. Typ ist beliebig )    *)
    (*  IN : laenge   = Anzahl der zu schreibenen    *)
    (*                  Bytes                        *)
    (* OUT : laenge   = Länge der wirklich           *)
    (*                  geschriebenen Bytes          *)
  BEGIN
  END;

  CONSTRUCTOR compressOBJ.Init;
  BEGIN
    is_command:= FALSE;
      (* kein restlicher Befehlscode in 'command'    *)
      (* vorhanden                                   *)
  END;

  PROCEDURE compressOBJ.Compress(VAR database;
                                 VAR laenge : WORD);
    (* »Compress« komprimiert Daten und gibt sie an  *)
    (* die Methode »Write_bytes« weiter.             *)
    (*  IN : database = untypisierte Variable        *)
    (*                  ( d.h. Typ ist beliebig )    *)
    (*  IN : laenge   = Länge der zu komprimierenden *)
    (*                  Daten in Bytes               *)
    (* OUT : laenge   = Länge der wirklich           *)
    (*                  komprimierten Bytes          *)
  VAR
    Befehlscode,
    Groesse,
    Datum            : BYTE;
    Data_Seg,
    Data_Ofs,
    Anzahl,
    Laenge1,
    Bytes_Write,
    Bytes_Real_Write : WORD;
    Status : (_start, _eins, _compress_a, _compress_b,
              _compress_c, _not_compress_a,
              _not_compress_b, _not_compress_c);
  BEGIN
    Data_Seg         := Seg(database);
    Data_Ofs         := Ofs(database);
    Bytes_Write      := 0;
    Bytes_Real_Write := 0;
    Status           := _start;
    REPEAT
      CASE status OF
        _compress_b :
          BEGIN
            IF datum=Mem[data_seg:data_ofs] THEN BEGIN
              INC(anzahl);
              INC(data_ofs);
            END ELSE
              Status := _compress_c;
          END;
        _compress_a :
          BEGIN
            IF datum=Mem[data_seg:data_ofs] THEN
              status:= _compress_b
            ELSE BEGIN
              status:= _not_compress_a;
              datum:= MEM[data_seg:data_ofs];
            END; (* if *)
            INC (anzahl);
            INC (data_ofs);
          END;
        _not_compress_a :
          BEGIN
            IF datum = MEM[data_seg:data_ofs] THEN
              status:= _not_compress_b
            ELSE
              datum:= MEM[data_seg:data_ofs];
            INC (anzahl);
            INC (data_ofs);
          END;
        _not_compress_b :
          BEGIN
           IF datum = MEM[data_seg:data_ofs] THEN BEGIN
              DEC(anzahl,2);
              DEC(data_ofs,2);
              status := _not_compress_c;
            END ELSE BEGIN
              datum := MEM[data_seg:data_ofs];
              INC(anzahl);
              INC(data_ofs);
              status := _not_compress_a;
            END;
          END;
        _start :
          BEGIN
            datum  := MEM[data_seg:data_ofs];
            anzahl := 1;
            INC(data_ofs);
            status := _eins;
          END;
        _eins :
          BEGIN
            IF datum = MEM[data_seg:data_ofs] THEN
              status := _compress_a
            ELSE BEGIN
              status := _not_compress_a;
              datum  := MEM[data_seg:data_ofs];
            END;
            INC(anzahl);
            INC(data_ofs);
          END;
        _compress_c :
          BEGIN
            befehlscode := 257 - anzahl;
            laenge1 := 1;
            Write_bytes(befehlscode, laenge1);
            Write_bytes(datum, laenge1);
              (* wenn »befehlscode« nicht, »datum«   *)
              (* aber geschrieben werden konnte ->   *)
              (* keine Fehlererkennung               *)
            INC(bytes_write, anzahl);
            IF laenge1 = 1 THEN
              bytes_real_write := bytes_write;
            anzahl := 0;
            status := _start;
          END;
        _not_compress_c :
          BEGIN
            befehlscode := anzahl - 1;
            laenge1     := 1;
            Write_bytes(befehlscode, laenge1);
            laenge1 := anzahl;
            Write_bytes(MEM[data_seg:data_ofs-anzahl],
                        laenge1);
            INC(bytes_write, anzahl);
            INC(bytes_real_write, laenge1);
            anzahl := 0;
            status := _start;
          END;
        END;
        IF (bytes_write+anzahl = laenge) OR
           (anzahl = 127) THEN BEGIN
          IF status = _compress_b THEN
            status := _compress_c
          ELSE
            status := _not_compress_c;
        END;
      UNTIL (bytes_write = laenge) OR
            (bytes_real_write <> bytes_write);
      laenge := bytes_real_write;
    END;

    PROCEDURE compressOBJ.Decompress(VAR database;
                                    VAR laenge : WORD);
      (* »Decompress« liest Daten von der Methode    *)
      (* »Read_bytes« und dekomprimiert sie.         *)
      (*  IN : laenge   = Länge der zu dekomprimie-  *)
      (*                  renden Daten in Bytes      *)
      (* OUT : database = untypisierte Variable      *)
      (*                  ( d.h. Typ ist beliebig )  *)
      (* OUT : laenge   = Länge der wirklich dekom-  *)
      (*                  primierten Bytes           *)
    VAR
      commandlaenge : BYTE;
      laenge1       : WORD;

      PROCEDURE Read_compress_data(VAR database;
                                   VAR laenge : WORD);
        (* »Read_compress_data« liest Daten von der  *)
        (* Methode »Read_bytes« und dekomprimiert    *)
        (* sie.                                      *)
        (*  IN : laenge   = Länge der zu dekompri-   *)
        (*                  mierenden Daten in Bytes *)
        (* OUT : database = untypisierte Variable    *)
        (*                 ( d.h. Typ ist beliebig ) *)
        (* OUT : laenge   = Länge der wirklich dekom-*)
        (*                  primierten Bytes         *)
      VAR
        ende : BOOLEAN;
        commandlaenge : BYTE;
        laenge1,data_seg,data_ofs,bytes_read : WORD;
      BEGIN
        data_seg   := Seg(database);
        data_ofs   := Ofs(database);
        bytes_read := 0;
        ende       := FALSE;
        command    := 0;
        REPEAT
          laenge1 := 1;
          Read_bytes(command, laenge1);
          IF laenge1 = 1 THEN BEGIN
            IF command < 128 THEN BEGIN
              commandlaenge := BYTE(command)+1;
              IF laenge <= commandlaenge THEN BEGIN
                laenge1 := laenge;
                Read_bytes(MEM[data_seg:data_ofs +
                               bytes_read], laenge1);
                IF laenge1 = commandlaenge THEN
                  is_command := FALSE
                ELSE BEGIN
                  DEC(command, laenge1);
                  is_command := TRUE;
                END;
                laenge := bytes_read + laenge1;
                ende   := TRUE;
              END ELSE BEGIN
                laenge1 := commandlaenge;
                Read_bytes(MEM[data_seg:data_ofs +
                               bytes_read], laenge1);
                IF laenge1 = commandlaenge THEN BEGIN
                  INC(bytes_read, laenge1);
                  DEC(laenge, laenge1);
                END ELSE BEGIN
                  laenge := bytes_read + laenge1;
                  ende   := TRUE;
                END;
              END;
            END ELSE BEGIN   (* command  > 128 *)
              commandlaenge := BYTE(257 - command);
              laenge1 := 1;
              Read_bytes(data, laenge1);
              IF laenge1 = 1 THEN BEGIN
                IF laenge <= commandlaenge THEN BEGIN
                  FillChar(MEM[data_seg:data_ofs +
                            bytes_read], laenge, data);
                  IF laenge = commandlaenge THEN
                    is_command := FALSE
                  ELSE BEGIN
                    INC(command, laenge);
                    is_command := TRUE;
                  END;
                  INC(laenge, bytes_read);
                  ende := TRUE;
                END ELSE BEGIN
                  FillChar(MEM[data_seg:data_ofs +
                             bytes_read],commandlaenge,
                             data);
                  INC(bytes_read, commandlaenge);
                  DEC(laenge, commandlaenge);
                END;
              END ELSE BEGIN
                laenge     := bytes_read;
                is_command := FALSE;
                ende       := TRUE;
              END;
            END;
          END ELSE BEGIN
            laenge := bytes_read;
            ende   := TRUE;
          END;
        UNTIL ende;
      END;

    BEGIN
      IF is_command THEN BEGIN
        IF command < 128 THEN BEGIN
          commandlaenge:= BYTE(command) + 1;
          IF laenge <= commandlaenge THEN BEGIN
            laenge1:= laenge;
            Read_bytes(database, laenge1);
            IF laenge1 = commandlaenge THEN
              is_command:= FALSE
            ELSE
              DEC(command, laenge1);
            laenge:= laenge1;
          END ELSE BEGIN
            laenge1 := commandlaenge;
            Read_bytes(database, laenge1);
            IF laenge1 = commandlaenge THEN BEGIN
              DEC(laenge, laenge1);
              Read_compress_data(MEM[Seg(database):
                                Ofs(database)+laenge1],
                                laenge);
              INC(laenge, laenge1);
            END ELSE BEGIN
              laenge := laenge1;
              DEC(command, laenge1);
            END;
          END
        END ELSE BEGIN
          commandlaenge := BYTE(257 - command);
          IF laenge <= commandlaenge THEN BEGIN
            FillChar(database, laenge, data);
            IF laenge = commandlaenge THEN
              is_command := FALSE
            ELSE
              INC(command, laenge);
          END ELSE BEGIN
            FillChar(database, commandlaenge, data);
            DEC(laenge, commandlaenge);
            Read_compress_data(MEM[Seg(database):
                               Ofs(database)+
                               commandlaenge],
                               laenge);
            INC(laenge, commandlaenge);
          END;
        END;
      END ELSE
        Read_compress_data(database, laenge);
    END;

BEGIN
  (* keine Initialisierung notwendig *)
END.
(* ------------------------------------------------- *)
(*               Ende von COMPRESS.PAS               *)