Turbo Toolbox/Turbo_Toolbox.iso/spezial/22/buffer/diskbuf.pas

Pascal/Delphi Source File | 1991-01-04 | 14.1 KB | 454 lines

(* ----------------------------------------------------- *)
(*                    DISKBUF.PAS                        *)
(*                                                       *)
(* ■ DiskBuffer: Lagert Daten, die nicht mehr in Heap auf*)
(*   Diskette oder Festplatte aus. Diese Vorgänge laufen *)
(*   automatisch intern ab; es sei denn, es tritt ein    *)
(*   Fehler beim Lesen/Schreiben statt, dann können z.B. *)
(*   keine neuen Zeilen mehr angehängt werden.           *)
(*                                                       *)
(*             (c) 1991 by R.Reichert & toolbox          *)
(* ----------------------------------------------------- *)
UNIT DiskBuf;

INTERFACE

USES UBuffer;

CONST
  BufDiskFull = 10;
  BufFileErr  = 11;

TYPE
  DiskBufferPtr = ^DiskBuffer;
  DiskBuffer    = OBJECT (Buffer)

      AllSaved,                   { Alles gespeichert ?   }
      SaveData : BOOLEAN;         { File löschen ?        }
      BufDosErr: BYTE;            { Dos-Fehlercode        }
      SEFileName,               { Dateiname zum Auslagern }
      EndName,     { Name falls Daten endgültig speichern }
      SEPath   : STRING;       { Laufwerk und Verzeichnis }
      f        : FILE;

      CONSTRUCTOR Init
        (MC, ML, BegLines : WORD; FrHeap : LONGINT);
      PROCEDURE ErrorHandling (Nr : WORD);         VIRTUAL;
      {---------- Interne Methoden zum Auslagern: --------}
      PROCEDURE NewLines (Num : WORD);             VIRTUAL;
      PROCEDURE KillLines (Num : WORD);            VIRTUAL;
      PROCEDURE SaveAll;                           VIRTUAL;
      PROCEDURE SaveFrom (y : WORD);               VIRTUAL;
      PROCEDURE SaveLine (y : WORD);               VIRTUAL;
      PROCEDURE SaveNewLine
        (y : WORD; VAR Line : OneLine);            VIRTUAL;
      PROCEDURE SaveNewDrive (NewDrive : STRING);  VIRTUAL;
      PROCEDURE Flush;                             VIRTUAL;
      PROCEDURE LoadLine
        (y : WORD; VAR Line : OneLine);            VIRTUAL;
      PROCEDURE LoadPart (y1, y2 : WORD);          VIRTUAL;
      PROCEDURE CleanMem;                          VIRTUAL;
      PROCEDURE CloseFile;                         VIRTUAL;
      {--------- Methoden für "Aussenwelt": --------------}
      PROCEDURE WriteStrXY
        (x, y : WORD; Str : STRING);               VIRTUAL;
      PROCEDURE SetSaveData (SD : BOOLEAN);        VIRTUAL;
      PROCEDURE SetEndFileName (EFN : STRING);     VIRTUAL;
      PROCEDURE SetSaveExtPath (Path : STRING);    VIRTUAL;

      FUNCTION GetAllSaved : BOOLEAN;              VIRTUAL;
      FUNCTION GetSaveData : BOOLEAN;              VIRTUAL;
      FUNCTION GetErrorL1 : WORD;                  VIRTUAL;
      FUNCTION GetDosErr : WORD;                   VIRTUAL;
      DESTRUCTOR Done;                             VIRTUAL;
    END;

IMPLEMENTATION

CONSTRUCTOR DiskBuffer.Init
              (MC, ML, BegLines : WORD; FrHeap : LONGINT);
BEGIN
  IF Buffer.Init (MC, ML, BegLines, Frheap) THEN BEGIN
    AllSaved  := FALSE;  SaveData := FALSE;
    BufDosErr := 0;
    SEFilename:= '';     EndName  := '';
    SEPath    := '';
  END ELSE
    Fail;
END;

PROCEDURE DiskBuffer.ErrorHandling (Nr : WORD);
BEGIN
    { BufErrorL1: Nur DISKETTENFEHLER,
      BufErrorL2: alle anderen Fehler. }
  IF (Nr=BufDiskFull) OR
     (Nr=BufFileErr) THEN
    BufErrorL1 := Nr
  ELSE
    BufErrorL2 := Nr;
END;

PROCEDURE DiskBuffer.KillLines (Num : WORD);
  VAR TempLines, l, i : WORD;
BEGIN
  TempLines := Lines;
  Lines := Lines-Num;
  FOR i := TempLines DOWNTO Succ (Lines) DO
    IF (TextBuf^[i] <> NIL) THEN BEGIN
      FreeMem (TextBuf^[i], 2 * Succ (MaxColumns));
      TextBuf^[i] := NIL;
    END ELSE
      IF (AllSaved) AND
         (BufErrorL1<>BufFileErr) THEN BEGIN
        Seek (f, i);
        l := filesize (f);
        Truncate (f); l := filesize(f);
        l := filePos(f);
        IF BufErrorL1=BufDiskFull THEN
          BufErrorL1 := BufOk;
      END;
END;

PROCEDURE DiskBuffer.NewLines (Num : WORD);
  VAR i,
      TLines : WORD;
      MemLimit : LONGINT;
      DL : WORD; l : integer;
BEGIN
  TLines := Lines;
  Lines := Lines+Num;
  DL := 0;
  MemLimit  := 2 * Succ (MaxColumns) + FreeHeap;
  FOR i := Succ (TLines) TO Lines DO
    IF (MemAvail > MemLimit) THEN BEGIN
      GetMem (TextBuf^[i], 2 * Succ (MaxColumns));
      GetNewLine (Attr, TextBuf^[i]^);
    END ELSE BEGIN
      IF (NOT AllSaved) THEN
        SaveAll;
      IF GetErrorL1=BufOk THEN BEGIN
        GetNewLine (Attr, TempLines [SetMLTL]^);
        l := filesize (f);
        SaveNewLine (i, TempLines [SetMLTL]^);
      END ELSE
        Inc (DL);
    END;
  Dec (Lines, DL);
END;

(* ----------------------------------------------------- *)
(* Bildet einen Dateinamen aus der aktuellen Uhrzeit. In *)
(* diese temporäre Datei wird ausgelagert.               *)
(* ----------------------------------------------------- *)
PROCEDURE DiskBuffer.SaveAll;
BEGIN
  AllSaved := FALSE;
  Str (Time, SEFileName);
  IF Length (SEFileName) > 8 THEN
    Delete (SEFileName, 1, Length(SEFileName)-8);
  IF (SEPath<>'') AND
     (SEPath [Length (SEPath)]<>'\') AND
     (SEPath [Length (SEPath)]<>':') THEN
    SEPath := SEPath+'\';
  SEFileName := SEPath+SEFileName+'.$$$';
{$I-}
  Assign (f, SEFileName);
  ReWrite (f, Succ (MaxColumns)*2);
{$I+}
  BufDosErr := IoResult;
  IF BufDosErr<>0 THEN
    ErrorHandling (BufFileErr)
  ELSE BEGIN
    AllSaved := TRUE;
    SaveFrom (0);
  END;
END;

PROCEDURE DiskBuffer.SaveFrom (y : WORD);
  VAR i : WORD;
BEGIN
  IF AllSaved THEN BEGIN     { schon einmal gespeichert ? }
    i := y;
    IF (BufErrorL1<>BufFileErr) THEN
      WHILE (NOT (i>Lines)) AND
            (BufErrorL1<>BufDiskFull) DO BEGIN
        SaveLine (i);             { Zeilenweise speichern }
        Inc (i);
      END;
  END;
END;

(* ----------------------------------------------------- *)
(* Speichert eine Zeile aus dem Speicher ab. Prüft nur,  *)
(* ob Zeile nicht ausgelagert ist, nimmt aber keine Be-  *)
(* reichsüberprüfung vor. Als 0.te Zeile wird InfoLine   *)
(* gespeichert.                                          *)
(* ----------------------------------------------------- *)
PROCEDURE DiskBuffer.SaveLine (y : WORD);
BEGIN
  IF (AllSaved) AND
     (BufErrorL1<>BufFileErr) AND
     (y>=0) AND (y<=Lines) THEN BEGIN
  {$I-}
    Seek (f, y);
    IF (y=0) THEN
      BlockWrite (f, InfoLine^, 1)
    ELSE
      IF (TextBuf^[y]<>NIL) THEN
        BlockWrite (f, TextBuf^[y]^, 1);
  {$I+}
    BufDosErr := IoResult;
    IF (BufDosErr <> 0) THEN
      Errorhandling (BufDiskFull);
  END;
END;

(* ----------------------------------------------------- *)
(* Speichert an y die übergebene Zeile Line ab. Hier wird*)
(* auf Bereichsgültigkeit und Dateifehler geprüft. Wenn  *)
(* die Zeile y nicht ausgelagert ist, wird Line nicht auf*)
(* Diskette gespeichert, sondern im Speicher abgelegt.   *)
(* ----------------------------------------------------- *)
PROCEDURE DiskBuffer.SaveNewLine (y : WORD;
                                  VAR Line : OneLine);
BEGIN
  IF (XYInBuf (1, y)) AND (AllSaved) AND
     (TextBuf^[y]=NIL) AND
     (BufErrorL1 <> BufFileErr) THEN BEGIN
  {$I-}
    Seek (f, y);
    BlockWrite (f, Line, 1);
  {$I+}
    BufDosErr := IoResult;
    IF (BufDosErr <> 0) THEN
      Errorhandling (BufDiskFull);
  END;
  IF (XYInBuf (1, y)) AND
     (TextBuf^[y]<>NIL) THEN
    Move (Line, TextBuf^[y]^, 2 * Succ (Columns));
END;

(* ----------------------------------------------------- *)
(* Falls eine Diskette voll ist, kann mit SaveNewDrive   *)
(* auf einen anderen Datenträger gespeichert werden.     *)
(* ----------------------------------------------------- *)
PROCEDURE DiskBuffer.SaveNewDrive (NewDrive : STRING);
BEGIN
  IF AllSaved THEN BEGIN
    BufErrorL1 := BufOk;            { Fehler zurücksetzen }
  {$I-}
    Close (f);
  {$I+}
    SEPath := NewDrive;  AllSaved := FALSE;
    SaveAll;
  END;
END;

(* ----------------------------------------------------- *)
(* Bildet die Turbo-Prozedur Flush () nach, die nur für  *)
(* Textdateien gültig ist.                               *)
(* ----------------------------------------------------- *)
PROCEDURE DiskBuffer.Flush;
BEGIN
  IF (AllSaved) AND
     (BufErrorL1<>BufFileErr) THEN BEGIN
    Close (f);
    ReSet (f, 2 * Succ (MaxColumns));
  END;
END;

(* ----------------------------------------------------- *)
(* Lädt eine Zeile aus Datei oder aus Speicher           *)
(* ----------------------------------------------------- *)
PROCEDURE DiskBuffer.LoadLine (y : WORD;
                              VAR Line : OneLine);
BEGIN
  IF (y>=0) AND (y<=Lines) AND
     (AllSaved) AND
     (BufErrorL1 <> BufFileErr) AND
     (TextBuf^[y]=NIL) THEN BEGIN
  {$I-}
    Seek (f, y);
    BlockRead (f, Line, 1);
  {$I+}
    BufDosErr := IoResult;
    IF BufDosErr<>0 THEN
      ErrorHandling (BufFileErr);
  END ELSE BEGIN
    IF y>Lines THEN
      NewLines (Lines-y);
    IF (TextBuf^[y] <> NIL) THEN
      Move (TextBuf^[y]^, Line, 2 * Succ (Columns));
  END;
END;

(* ----------------------------------------------------- *)
(* Lädt (aus ausgelagerter Datei) den Teil von y1 bis y2,*)
(* sofern möglich. Dafür werden vor und hinter diesem    *)
(* Teilstück Zeilen ausgelagert. Diese Prozedur ist dazu *)
(* da, dass ein Teil geladen werden kann für anschliessen*)
(* de Bearbeitung, ohne dauernd jede Zeile einzeln laden *)
(* zu müssen.                                            *)
(* ----------------------------------------------------- *)
PROCEDURE DiskBuffer.LoadPart (y1, y2 : WORD);
  VAR i, j, No : WORD;

  (* --------------------------------------------------- *)
  (*   Diese Prozedur sucht den Bereich zw BegCol und    *)
  (*   EndCol nach Zeilen ab, die ausgelagert werden     *)
  (*   können. Max enthält die maximale Anzahl Zeilen,   *)
  (*   die ausgelagert werden sollen, Counter gibt die   *)
  (*   Anzahl der tatsächlich ausgelagerten Zeilen zu-   *)
  (*   rück, da nicht immer Max Zeilen gefunden werden   *)
  PROCEDURE SearchSave (BegCol, EndCol, Max : WORD;
                        VAR Counter : WORD);
    VAR i : WORD;
  BEGIN
    i := BegCol;
    WHILE NOT (i > EndCol) AND
          NOT (Counter >= Max) DO BEGIN
      IF TextBuf^[i] <> NIL THEN BEGIN
        SaveLine (i);         Inc (Counter);
        FreeMem (TextBuf^[i], 2 * Succ (MaxColumns));
        TextBuf^[i] := NIL;
      END;
      Inc (i);
    END;
  END;

BEGIN  {  LoadPart  }
  IF y1<1 THEN y1 := 1;
  IF y2>Lines THEN y2 := Lines;
  IF (AllSaved) AND
     (BufErrorL1 <> BufFileErr) AND
     (BufErrorL2 <> BufDiskFull) THEN BEGIN
    No := 0; j := 0;
    FOR i := y1 TO y2 DO
      IF TextBuf^[i]=NIL THEN
        Inc (No);
    SearchSave (1, y1, No, j);
    IF j > 0 THEN
      j := j;
    SearchSave (Succ (y2), Lines, No, j);
    IF j = 0 THEN
      j := j;
    IF MemAvail>FreeHeap+2*Succ (MaxColumns)*j THEN
      Inc (j, (MemAvail-FreeHeap-
               2*Succ (MaxColumns)*j) DIV
              (2 * Succ (MaxColumns)));
    i := y1; No := 0;
    WHILE NOT (i > y2) AND
          NOT (No >= j) DO BEGIN
      IF TextBuf^[i]=NIL THEN BEGIN
        LoadLine (i, TempLines [LPTL]^);
        Inc (No);
        GetMem (TextBuf^[i], 2 * Succ (MaxColumns));
        Move (TempLines [LPTL]^, TextBuf^[i]^,
              2 * Succ (Columns));
      END;
      Inc (i);
    END;
  END;
END;

(* ----------------------------------------------------- *)
(* Speichert gesamten sich im Speicher befindenden Puffer*)
(* auf Diskette und löscht in aus dem Speicher (im Gegen-*)
(* satz zu SaveLine/SaveNewLine).                        *)
(* ----------------------------------------------------- *)
PROCEDURE DiskBuffer.CleanMem;
  VAR i : WORD;
BEGIN
  IF GetAllSaved THEN SaveFrom (0)
                 ELSE SaveAll;
  IF GetErrorL1=0 THEN
    FOR i := 1 TO Lines DO
      IF TextBuf^[i]<>NIL THEN BEGIN
        FreeMem (TextBuf^[i], 2*Succ (MaxColumns));
        TextBuf^[i] := NIL;
      END;
END;

(* ----------------------------------------------------- *)
(* Wenn SaveData FALSE ist, wird die temporäre Datei ge- *)
(* löscht, ansonsten alles nochmal gespeichert und wenn  *)
(* EndName<>'' ist, die Datei in EndName umbenannt.      *)
(* ACHTUNG: Nur am Ende von Done aus aufrufen !          *)
(* ----------------------------------------------------- *)
PROCEDURE DiskBuffer.CloseFile;
BEGIN
  IF AllSaved THEN BEGIN
    IF SaveData THEN SaveFrom (0);
  {$I-}
    Close (f);
  {$I+}
    BufDosErr := IoResult;
    IF (BufDosErr<>0) THEN
      ErrorHandling (BufFileErr)
    ELSE BEGIN
      IF (NOT SaveData) AND (EndName='') THEN
        Erase (f)       { wenn nicht retten, dann löschen }
      ELSE IF EndName<>'' THEN
        Rename (f, EndName);            { oder umbenennen }
             { ACHTUNG: Es darf keine Datei mit dem Namen
               EndName existieren, sonst bleibt die Umbe-
               nennung erfolglos.                         }
    END;
  END;
END;

PROCEDURE DiskBuffer.WriteStrXY (x,y : WORD; Str : STRING);
BEGIN
  IF (y=Succ (Lines)) AND
     (MemAvail-FreeHeap<2*Succ (MaxColumns)) AND
     (NOT AllSaved) THEN
    SaveAll;
  Buffer.WriteStrXY (x, y, Str);
END;

PROCEDURE DiskBuffer.SetSaveData (SD : BOOLEAN);
BEGIN
  SaveData := SD;
END;

PROCEDURE DiskBuffer.SetEndFileName (EFN : STRING);
BEGIN
  Endname := EFN;
END;

PROCEDURE DiskBuffer.SetSaveExtPath (Path : STRING);
BEGIN
  SEPath := Path;
END;

FUNCTION DiskBuffer.GetAllSaved : BOOLEAN;
BEGIN
  GetAllSaved := AllSaved;
END;

FUNCTION DiskBuffer.GetSaveData : BOOLEAN;
BEGIN
  GetSaveData := SaveData;
END;

FUNCTION DiskBuffer.GetErrorL1 : WORD;
BEGIN
  GetErrorL1 := BufErrorL1;
END;

FUNCTION DiskBuffer.GetDosErr : WORD;
BEGIN
  GetDosErr := BufDosErr;
END;

DESTRUCTOR DiskBuffer.Done;
BEGIN
  CloseFile;
  Buffer.Done;
END;

END.
(* ----------------------------------------------------- *)
(*                 Ende von DISKBUF.PAS                  *)
(* ----------------------------------------------------- *)