Turbo Toolbox/Turbo_Toolbox.iso/dtx9202/tvision/hexview.pas

Pascal/Delphi Source File | 1991-12-15 | 20.1 KB | 489 lines

(* ---------------------------------------------------------------- *)
(*                            HEXVIEW.PAS                           *)
(*                                                                  *)
(* Diese Unit stellt zwei Objekte, tHexMemWindow und tHexFileView-  *)
(* Win bereit, die das Ansehen des Hauptspeichers oder einer Datei  *)
(* hexadezimal und im Norton-Stil erlauben. Die eigentlichen Objekte*)
(* dafür sind die von tScroller abstammenden tHexMemView und        *)
(* tHexFileView, die von den Fensterobjekten eingefügt werden. Als  *)
(* abstrakter Grundtyp dient tHexViewer. Die Funktion HexViewDialog *)
(* kümmert sich um die Ausführung eines "FileOpen"-Dialoges und gibt*)
(* einen Zeiger auf ein tHexFileWindow zurück.                      *)
(* Die (Mini-)Hierarchie (Kommentare im Implementationsteil):       *)
(*                                                                  *)
(*  tView                                                           *)
(*    tScroller                                                     *)
(*       tHexViewer                                                 *)
(*          tHexMemView                                             *)
(*          tHexFileView                                            *)
(*    tGroup                                                        *)
(*       tWindow                                                    *)
(*        tHexMemWindow                                             *)
(*        tHexFileWindow                                            *)
(*                                                                  *)
(* (c) '91 by R.Reichert & DOS-toolbox                              *)
(* ---------------------------------------------------------------- *)
UNIT HexView;

INTERFACE

USES Objects, Views, Drivers, StdDlg, MsgBox, App;

CONST
  thvMaxBufSize = MaxInt * 2 - 16;
    { maximale Puffergrösse für tHexFileView }
  MaxMemPerBuf  : WORD = 8;
    { MaxMemPerBuf KB werden höchstens PRO tHexFileView-Objekt
      benutzt }

TYPE
  tViewBuffer = ARRAY [0..thvMaxBufSize] OF BYTE;

  pHexViewer = ^tHexViewer;
  tHexViewer = OBJECT (tScroller)
    FirstPos,
    LastPos,
    BufFirst,
    BufLast,
    MaxLength : LongInt;
    Scroll    : BYTE;
    Range     : INTEGER;
    BufSize   : WORD;
    Buffer    : ^tViewBuffer;

    CONSTRUCTOR Init
      (VAR Bounds: tRect;
       ahScrollBar, avScrollBar: pScrollBar);
    PROCEDURE InitBuffer;                                     VIRTUAL;
    PROCEDURE ScrollDraw;                                     VIRTUAL;
    PROCEDURE Draw;                                           VIRTUAL;
    PROCEDURE ScrollCalc (dy : LongInt);                      VIRTUAL;
    PROCEDURE ReadBuffer (rPos : LongInt);                    VIRTUAL;
  END;

  pHexMemView = ^tHexMemView;
  tHexMemView = OBJECT (tHexViewer)
    PROCEDURE InitBuffer;                                     VIRTUAL;
    PROCEDURE ReadBuffer (rPos : LongInt);                    VIRTUAL;
  END;

  pHexFileView = ^thexFileView;
  tHexFileView = OBJECT (thexViewer)
    f    : FILE;
    CONSTRUCTOR Init
      (VAR Bounds: tRect;
       ahScrollBar, avScrollBar: pScrollBar;
       FileName: STRING);
    PROCEDURE InitBuffer;                                     VIRTUAL;
    PROCEDURE ReadBuffer (rPos : LongInt);                    VIRTUAL;
    DESTRUCTOR Done;                                          VIRTUAL;
  END;

  pHexMemWindow = ^tHexMemWindow;
  tHexMemWindow = OBJECT (tWindow)
    CONSTRUCTOR Init (VAR Bounds: tRect; aNumber: INTEGER);
  END;

  pHexFileWindow = ^tHexFileWindow;
  tHexFileWindow = OBJECT (tWindow)
    CONSTRUCTOR Init (VAR Bounds: tRect;
                      aNumber: INTEGER; fName: STRING);
  END;

FUNCTION ByteToHex (X: BYTE): STRING;

FUNCTION LongToHex (X: LongInt; Length: BYTE): STRING;

FUNCTION HexViewDialog (aNumber: INTEGER): pView;

IMPLEMENTATION

FUNCTION ByteToHex (X: BYTE): STRING;
  CONST
    HexTable : ARRAY [0..15] OF CHAR = '0123456789ABCDEF';
  VAR s: STRING;
BEGIN
  S := '';
  s := HexTable [X DIV 16] + HexTable [X MOD 16];
  ByteToHex := S;
END;

FUNCTION LongToHex (X: LongInt; Length: BYTE): STRING;
  TYPE
    LongRec = RECORD  a, b, c, d: BYTE;  END;
  VAR
    S: STRING;
BEGIN
  S := ByteToHex (LongRec (X).D)+
       ByteTohex (LongRec (X).C)+
       ByteToHex (LongRec (X).B)+
       ByteTohex (LongRec (X).A);
  Delete (S, 1, 8-Length);
  LongToHex := S;
END;

(* ================================================================ *)
(*                            tHexViewer                            *)
(* ================================================================ *)
(* tHexViewer ist der abstrakte Grundtyp für tHexMemView und tHex-  *)
(* FileView. Die Felder im einzelnen: FirstPos gibt das erste darge-*)
(* stellte Byte innerhalb des Fenster an; LastPos das letzte; Buf-  *)
(* First und BufLast geben an, welcher Bereich sich im Speicher be- *)
(* findet (für tHexMemView eigentlich überflüssig), wobei gilt:     *)
(* BufLast >= FirstPos >= BufFirst; BufLast >= LastPos >= BufFirst; *)
(* MaxLength gibt die Länge des Bereichs (der Datei) an; um Scroll  *)
(* Zeilen wird jeweils gescrollt (siehe tHexMemView); Range gibt die*)
(* Anzahl Zeilen an, die der vertikale Scrollbalken darstellt;      *)
(* BufSize die Grösse des Puffers und Buffer schliesslich ist der   *)
(* eigentliche Puffer.                                              *)
(* ---------------------------------------------------------------- *)
CONSTRUCTOR tHexViewer.Init
  (VAR Bounds: tRect; ahScrollBar, avScrollBar: pScrollBar);
BEGIN
  tScroller.Init (Bounds, ahScrollBar, avScrollBar);
  InitBuffer;
  IF MaxLength <= 0 THEN Exit;   { MaxLength muss gesetzt werden ! }
  FirstPos := 0;
  LastPos := Size.Y*16;
  ReadBuffer (0);
  ScrollCalc (0);

  Range := MaxLength DIV (16 * Scroll);
  IF MaxLength MOD 16 > 0 THEN Inc (Range);
  GrowMode := gfGrowHiX + gfGrowHiY;
  SetLimit (78, Range);
  IF Scroll > 1 THEN
    vScrollBar^.SetRange (0, Range-Size.Y DIV 2);
END;

(* ---------------------------------------------------------------- *)
(* InitBuffer ist abstrakt und muss die Variablen BufFirst, BufLast,*)
(* MaxLength, Scroll, BufSize und Buffer initialisieren.            *)
(* ---------------------------------------------------------------- *)
PROCEDURE tHexViewer.InitBuffer;
BEGIN
END;

(* ---------------------------------------------------------------- *)
(* ScrollDraw ist in tScroller definiert. "Es stellt das Objekt     *)
(* immer dann neu dar, wenn das Feld Value der verbundenen Roll-    *)
(* balken sich infolge eines Maus- oder Tastatur-Ereignisses ändert.*)
(* Solche Änderungen werden über den Vergleich von Delta.X mit      *)
(* HScrollBar^.Value bzw. Delta.Y mit VScrollBar^.Value ermittelt.  *)
(* Vor der Neuausgabe werden der Cursor neu positioniert und die neu*)
(* ermittelten Werte in Delta gespeichert." (Soweit die Hilfe von   *)
(* Turbo Pascal.) Anschliessend wird ScrollCalc aufgerufen, das die *)
(* Berechnung von FirstPos und LastPos vornimmt. Dazu wird er-      *)
(* mittelt, wieviele Zeilen gescrollt werden müssen. Das explizite  *)
(* Typecasting ist notwendig, so die Variablen vom Typ Integer und  *)
(* Byte sind.                                                       *)
(* ---------------------------------------------------------------- *)
PROCEDURE tHexViewer.ScrollDraw;
BEGIN
  IF Scroll > 1 THEN
    vScrollBar^.SetRange (0, Range-Size.Y DIV 2);
    { "Hochrechnung", falls mehr als 512KB dargestellt werden sollen }
  ScrollCalc (LongInt ((vScrollBar^.Value-Delta.Y))*LongInt (Scroll));
  tScroller.ScrollDraw;
END;

(* ---------------------------------------------------------------- *)
(* ScrollCalc berechnet FirstPos und LastPos neu und veranlasst das *)
(* Lesen in den Puffer, wenn die neuen Werte nicht mehr im Puffer   *)
(* liegen.                                                          *)
(* ---------------------------------------------------------------- *)
PROCEDURE tHexViewer.ScrollCalc (dy: LongInt);
BEGIN
  FirstPos := FirstPos + dy * 16;
  IF FirstPos < 0 THEN FirstPos := 0;

  LastPos := FirstPos + Size.Y * 16;
  IF LastPos > MaxLength THEN LastPos := MaxLength - 1;

  IF (FirstPos < BufFirst) OR (LastPos > BufLast) THEN
    ReadBuffer (FirstPos);
END;

(* ---------------------------------------------------------------- *)
(* ReadBuffer ist abstrakt und hat ab der Position rPos BufSize     *)
(* Bytes in den Puffer zu lesen.                                    *)
(* ---------------------------------------------------------------- *)
PROCEDURE tHexViewer.ReadBuffer (rPos: LongInt);
BEGIN
END;

(* ---------------------------------------------------------------- *)
(* Draw übernimmt die Ausgabe, wobei die Methode des Vorgängers     *)
(* nicht ausgerufen wird, da es selbst immer den ganzen Fensterraum *)
(* ausfüllt. Zeile für Zeile wird Byte für Byte umgewandelt oder    *)
(* durch Leerzeichen ersetzt, sollte LastPos überschritten worden   *)
(* sein. Danach werden noch wie beim Norton Commander senkrechte    *)
(* Trennstriche eingefügt, die ein besseres Abzählen der Byteposi-  *)
(* tionen erlauben. Rechts aussen werden die Zeichen dargestellt.   *)
(* ---------------------------------------------------------------- *)
PROCEDURE tHexViewer.Draw;
  VAR
    y, i   : BYTE;
    LineBeg: LongInt;
    LineBuf: tDrawBuffer;
    Line   : STRING;
BEGIN
  ScrollCalc (0); { nur zur Korrektur, falls nötig }
  FOR y := 0 TO Size.Y-1 DO BEGIN
    Line := '';
    LineBeg := FirstPos + y * 16;
    Line := LongToHex (LineBeg, 5)+ '  ';
    FOR i := 0 TO 15 DO
      IF LineBeg+i <= LastPos THEN
        Line := Line + ByteToHex (Buffer ^[LineBeg-BufFirst+i])+ ' '
      ELSE
        Line := Line + '   ';
    System.Insert ('│ ', Line, 20);
    System.Insert ('│ ', Line, 34);
    System.Insert ('│ ', Line, 48);
    Line := Line + ' ';
    FOR i := 0 TO 15 DO
      IF LineBeg+i <= LastPos THEN
        Line := Line + CHAR (Buffer ^[LineBeg-BufFirst+i])
      ELSE
        Line := Line + ' ';

    MoveBuf (LineBuf, Line [Delta.X+1],
             GetColor (1), Length (Line)-Delta.X);
    WriteLine (0, y, Size.X, 1, LineBuf);
  END;
END;

(* ================================================================ *)
(*                         tHexMemView                              *)
(* ================================================================ *)
(* tHexMemView braucht nur InitBuffer und ReadBuffer, die beiden ab-*)
(* strakten Methoden, zu überschreiben. InitBuffer setzt BufSize auf*)
(* thvMaxBufSize. MemAvail braucht nicht überprüft zu werden, weil  *)
(* kein Speicher reserviert, sondern nur Buffer umgebogen wird. Buf-*)
(* First ist Null, BufLast BufSize. Es kann maximal 1MB dargestellt *)
(* werden (MaxLength). Da die Scrollbalken nur mit Integer arbeiten *)
(* und eine Zeile 16 Bytes darstellt, könnten eigentlich nur 512KB  *)
(* (16*32767 DIV 1024) dargestellt werden. Durch den Faktor von     *)
(* Scroll=2 ist ein MB möglich, allerdings wird auch immer um zwei  *)
(* Zeilen gescrollt. Daher in tHexViewer.ScrollDraw auch die Multi- *)
(* plikation mit Scroll (Anzahl Zeilen = ScrollBalken-Wert*2).      *)
(* Dadurch entsteht das Problem, das man die letzten Zeilen vor der *)
(* 1MB-Genze nicht anzeigen kann, da diese "Hochrechnung" bei Grenz-*)
(* werten nicht funktioniert.                                       *)
(* ---------------------------------------------------------------- *)
PROCEDURE tHexMemView.InitBuffer;
BEGIN
  BufSize  := thvMaxBufSize;
  BufFirst := 0;
  BufLast  := BufSize;
  MaxLength:= 1024 * 1024 - 32;
  Scroll   := 2;
END;

(* ---------------------------------------------------------------- *)
(* ReadBuffer braucht nicht aus dem Speicher in den Speicher zu     *)
(* lesen. Daher wird nur Buffer entsprechend rPos zurechtgebogen und*)
(* BufFirst und BufLast neu gesetzt, da ein Zeiger auf eine Array-of*)
(* Byte-Struktur nicht über die 64KB Grenze hinaus adressiert werden*)
(* kann.                                                            *)
(* ---------------------------------------------------------------- *)
PROCEDURE tHexMemView.ReadBuffer (rPos: LongInt);
BEGIN
  BufFirst := rPos;
  BufLast  := rPos + BufSize;
  Buffer   := Ptr (rPos DIV 16, rPos MOD 16);
END;

(* ================================================================ *)
(*                            tHexFileView                          *)
(* ================================================================ *)
(* tHexFileView.Init hat ein Problem: Wird der übergebene Dateiname *)
(* FileName in einer Variable abgelegt, die InitBuffer benutzen     *)
(* soll, geht das nicht: tScroller.Init ruft tView.Init auf, das    *)
(* alle Variablen auf Null (und somit den String leer) setzt. Aus   *)
(* demselben Grund kann Init auch nicht vor dem Aufruf die Datei    *)
(* öffnen und so f initialisieren, da auch diese Variable durch den *)
(* Aufruf von tScroller.Init ungültig wird. Daher wird der Dateiname*)
(* in der Konstanten fName zwischengespeichert.                     *)
(* ---------------------------------------------------------------- *)
CONST
  fName : STRING = '';

CONSTRUCTOR tHexFileView.Init
  (VAR Bounds: tRect; ahScrollBar, avScrollBar: pScrollBar;
   FileName: STRING);
BEGIN
  fName := FileName;
  tHexViewer.Init (Bounds, ahScrollBar, avScrollBar);
  IF MaxLength = 0 THEN Fail;
END;

(* ---------------------------------------------------------------- *)
(* InitBuffer versucht die Datei fName zu öffnen. Schlägt der Ver-  *)
(* such fehl, so wird in MaxLength -1 abgelegt, was Init bedeutet,  *)
(* das das Objekt ungültig ist. Sonst werden die Variablen gesetzt. *)
(* Dateien grösser als 1024KB sind aus den in tHexMemView.Init ge-  *)
(* nannten Gründen der Einfachkeit halber nicht erlaubt. Bei der    *)
(* Speicherbelegung für den Puffer wird dafür gesorgt, dass min-    *)
(* destens LetFree KB Speicher freibleiben. Kann die Datei nicht ge-*)
(* laden werden, so wird der Benutzer via MessageBox darüber infor- *)
(* miert.                                                           *)
(* ---------------------------------------------------------------- *)
PROCEDURE tHexFileView.InitBuffer;
BEGIN
  {$I-}
    Assign (f, fName);
    ReSet (f, 1);
  {$I+}
  IF IoResult <> 0 THEN BEGIN
    MaxLength := 0;
    MessageBox ('Die Datei konnte nicht geöffnet werden!',
                NIL, mfError+mfOkButton);
    Exit;
  END;

  MaxLength := FileSize (f);
  Scroll := 1;
  IF MaxLength > 1024*1024 THEN BEGIN
    MaxLength := 0;
    MessageBox ('Die Datei ist zu gross (>512KB) !',
                NIL, mfError+mfOkButton);
    Exit;
  END ELSE
    IF MaxLength > 512*1024 THEN
      Scroll := 2;

  BufSize   := thvMaxBufSize;
  IF BufSize > MaxLength THEN
    BufSize := MaxLength;
  IF BufSize > MaxMemPerBuf*1024 THEN
    BufSize := MaxMemPerBuf*1024;
  BufFirst  := 0;
  BufLast   := BufSize;
  GetMem (Buffer, BufSize);
END;

(* ---------------------------------------------------------------- *)
(* ReadBuffer liest den Puffer voll oder bis zum Ende der Datei, je *)
(* nachdem, welche Position rPos bezeichnet.                        *)
(* ---------------------------------------------------------------- *)
PROCEDURE tHexFileView.ReadBuffer (rPos: LongInt);
BEGIN
  BufFirst := rPos;
  Seek (f, rPos);
  IF MaxLength-rPos > BufSize THEN BEGIN
    BufLast := rPos+BufSize;
    BlockRead (f, Buffer^, BufSize);
  END ELSE BEGIN
    BufLast := MaxLength;
    BlockRead (f, Buffer^, MaxLength-rPos);
  END;
END;

(* ---------------------------------------------------------------- *)
(* Done gibt den von Buffer belegten Speicher frei und schliesst    *)
(* Datei.                                                           *)
(*----------------------------------------------------------------- *)
DESTRUCTOR tHexFileView.Done;
BEGIN
  tHexViewer.Done;
  IF Buffer <> NIL THEN
    FreeMem (Buffer, BufSize);
  {$I-} Close (f); {$I+}
END;

(* ================================================================ *)
(*                             tHexMemWindow                        *)
(* ================================================================ *)
(* tHexMemWindow fügt ein tHexMemView-Objekt in die Gruppe ein, ver-*)
(* sieht das Fenster mit einem Namen. Eine Nummer erhält es nicht.  *)
(* ist das erzeugt Objekt gültig, so wird es in die Gruppe einge-   *)
(* fügt, ansonsten wird Fail aufgerufen, und das Fenster dadurch    *)
(* nicht in die Arbeitsfläche eingefügt.                            *)
(* ---------------------------------------------------------------- *)
CONSTRUCTOR tHexMemWindow.Init (VAR Bounds: tRect; aNumber: INTEGER);
  VAR
    R: tRect;
    P: pView;
BEGIN
  tWindow.Init (Bounds, ' Memory Viewer ', aNumber);
  R.Assign (1, 1, Size.X-1, Size.Y-1);
  P := New (pHexMemView,
            Init (R,
                  StandardScrollBar (sbHorizontal+sbHandleKeyboard),
                  StandardScrollBar (sbVertical+sbHandleKeyboard)));
  IF Application^.ValidView (P) <> NIL THEN Insert (P)
                                       ELSE Fail;
  Options := Options OR ofTileable;
END;

(* ================================================================ *)
(*                          tHexFileView                            *)
(* ================================================================ *)
(* Init prüft nach dem Aufruf von tWindow.Init zunächst. Ist das er-*)
(* zeugte tHexFileView-Objekt gültig, wird es in die Gruppe einge-  *)
(* fügt, ansonsten ist das Fensterobjekt ungültig.                  *)
(* ---------------------------------------------------------------- *)
CONSTRUCTOR tHexFileWindow. Init (VAR Bounds: tRect;
                                  aNumber: INTEGER; fName: STRING);
  VAR
    R: tRect;
    P: pView;
BEGIN
  tWindow.Init (Bounds, ' FileViewer: '+FName, aNumber);
  R.Assign (1, 1, Size.X-1, Size.Y-1);
  P := New (pHexFileView,
            Init (R,
                  StandardScrollBar (sbHorizontal+sbHandleKeyboard),
                  StandardScrollBar (sbVertical+sbHandleKeyboard),
                  fName));
  IF Application^.ValidView (P) <> NIL THEN Insert (P)
                                       ELSE Fail;
  Options := Options OR ofTileable;
END;

(* ================================================================ *)
(*                          DoHexViewDialog                         *)
(* ================================================================ *)
(* HexViewDialog führt einen "FileOpen"-Dialog durch. Wurde er nicht*)
(* abgebrochen, so wird versucht, ein tHexFileWindow zu errichten,  *)
(* unter Berücksichtigung der Sicherheitszone. Ist die Operation ge-*)
(* lungen, so wird ein Zeiger auf das Objekt zurück gegeben, den der*)
(* Aufrufer in die Arbeitsfläche oder auf Programmebene einfügen    *)
(* kann. HexViewDialog tut dies nicht, damit der Aufrufer (meist das*)
(* Programmobjekt) seine Fenster selber nummerieren kann; daher auch*)
(* der Parameter aNumber.                                           *)
(* ---------------------------------------------------------------- *)
FUNCTION HexViewDialog (aNumber: INTEGER): pView;
  VAR
    fName : STRING;
    Dialog: pFileDialog;
    Win   : pHexFileWindow;
    R     : tRect;
BEGIN
  HexViewDialog := NIL;
  Dialog := New (pFileDialog, Init ('*.*', ' Datei auswählen ',
                                    ' Dateiname ',
                                    fdOkButton + fdOpenButton, 0));
  IF Application^.ValidView (Dialog) <> NIL THEN BEGIN
    IF Application^.ExecView (Dialog) <> cmCancel THEN BEGIN
      Dialog^.GetFileName (FName);
      R.Assign (0, 0, 60, 16);
      Win := New (pHexFileWindow, Init (R, aNumber, fName));
      IF Win <> NIL THEN BEGIN
        Win^.Options := Win^.Options OR ofCentered;
        HexViewDialog := Win;
      END;
    END;
    Dispose (Dialog, Done);
  END;
END;

BEGIN
END.

(* ---------------------------------------------------------------- *)
(*                         Ende von HEXVIEW.PAS                     *)
(* ---------------------------------------------------------------- *)