home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 08 / dump.pas next >
Encoding:
Pascal/Delphi Source File  |  1987-05-28  |  13.1 KB  |  330 lines

  1. (* ----------------------------------------------------------------------- *)
  2. (*                              DUMP.PAS                                   *)
  3. (*                    Datei-Inhalt als (HEX-) DUMP                         *)
  4. (* Das Programm gibt den Inhalt einer Datei als DUMP auf die Ausgabe aus.
  5.    Der Aufruf kann mit DUMP Filename /Optionen erfolgen. Die Eingabe der
  6.    Optionen ist nicht zwingend erforderlich. Es sollte immer nur der erst
  7.    Buchstabe der Option eingegeben werden. Der Aufruf kann in folgender
  8.    Form erfolgen:
  9.               >DUMP Dateiname.ext -Optionen
  10.    Wird nur DUMP eingegeben, werden Filename und Optionen explizit erfragt:
  11.               Datei  : DUMP.PAS
  12.               Option : -ab...
  13.    Es stehen folgende Optionen zur Verfuegung:
  14.                 -A   ASCII: Anzeige nur ASCII Zeichen
  15.                 -K   KeinASCII: Anzeige nur Dump Zeile
  16.                 -N   Normal: 1 Zeile Dump, 1 Zeile ASCII
  17.                 -B   Breit: ASCII Darst. hinter Dump
  18.                 -M   Mehr: Unterbrechung alle n Zeilen
  19.                 -H   Base = hex.  -O Base = okt.  -D Base = dez.
  20.                 -C   Ausgabe auf Console    -P Ausgabe auf Printer
  21.    Standardmaessig wird -NHCM eingestellt. Die Mehr-Option ist nur im Con-
  22.    sole-Mode aktiv. Die Printer-Option erzeugt eine seitenorientierte Dar-
  23.    stellung mit einer Kopfzeile und Seitennummerierung.                    *)
  24. (* ----------------------------------------------------------------------- *)
  25.  
  26. PROGRAM Dump (Input, Output, InFile, OutFile);
  27.  
  28. CONST
  29.   Word_Len         = 2;                             (* Laenge Word         *)
  30.   Byte_Len         = 1;                             (*   "    Byte         *)
  31.   Max_Column       = 16;                            (* 16 Werte pro Zeile  *)
  32.   Max_Column_ascii = 60;                            (* 60  "    bei Ascii  *)
  33.   Max_Screen       = 20;                            (* Zeilen pro Screen   *)
  34.   Page_Length      = 65;                            (*  "      "  Seite    *)
  35.   Space_Wide       = '  ';
  36.   CR               = 10;                         (* ASCII: Carriage Return *)
  37.   LF               = 13;                         (*   "  : Line Feed       *)
  38.   FF               = 12;                         (*   "  : Form Feed       *)
  39.   BufSize          = 128;                        (* 128 Bytes Einlese-Puf. *)
  40.  
  41. TYPE File_Name_Typ = STRING[65];
  42.      File_Typ_Byte = FILE OF BYTE;             (* fuer CP/M: nur "FILE" !! *)
  43.      Zahlen_System = (hex,okt,dez);
  44.      Modus         = (ascii,compressed,normal,wide);
  45.  
  46. VAR
  47.   Row, Adr, i,
  48.   Max_Spalte,
  49.   Line_step,
  50.   Line, Page,
  51.   BufPos,                                    (* Position im Einlese-Puffer *)
  52.   EOFPos      : INTEGER;           (* Position des letzten Bytes im Puffer *)
  53.   Code        : ARRAY [1..Max_Column_ascii] OF BYTE;
  54.   Buffer      : ARRAY [1..BufSize] OF BYTE;
  55.   more,
  56.   EndOfFile   : BOOLEAN;
  57.   Space_Pred          : STRING [2];
  58.   Space_Suc           : STRING [2];
  59.   Space_Zeilen_Anfang : STRING [7];
  60.   Space_Code_Base     : STRING [4];
  61.   End_Line            : STRING [8];
  62.   Mode                : STRING [10];
  63.   HexZif              : ARRAY [0..15] OF CHAR;
  64.   Base                : Zahlen_System;
  65.   Switch              : Modus;
  66.   File_Name : File_Name_Typ;
  67.   InFile    : File_Typ_Byte;
  68.   Device    : STRING [4];
  69.   OutFile   : TEXT;
  70.  
  71. (* ----------------------------------------------------------------------- *)
  72. (* Ausgabe eines Wertes als Zahl auf der Standardausgabe. Durch Len wird
  73.    festgelegt, ob ein Byte (Len = 1) oder Wort (Len = 2) ausgegeben werden
  74.    soll. Das Format wird durch die eingestellte Basis bestimmt => Hex xx
  75.    oder xxxx. Die hier verwendeten Turbo-Funktionen 'Lo' und 'Hi' liefern
  76.    jeweils das nieder- bzw. hoeherwertige Byte einer Integer-Zahl. Implemen-
  77.    tations-Vorschlag: Lo := value MOD 256;  Hi := value DIV 256            *)
  78.  
  79. PROCEDURE Write_val (value, len : INTEGER);
  80.  
  81.  VAR temp, carry : INTEGER;
  82.  
  83.  BEGIN
  84.    CASE Base OF
  85.      hex: BEGIN  (* Format : High Low  Byte
  86.                              xxxx xxxx      Hex -> xx = 4 bit pro Ziffer   *)
  87.             IF len = Word_Len THEN
  88.               BEGIN
  89.                 temp := Hi (value);
  90.                 Write (OutFile,HexZif[temp DIV 16]:1,HexZif[temp MOD 16]:1);
  91.               END;
  92.             temp := Lo (value);
  93.             Write (OutFile,HexZif[temp DIV 16]:1,HexZif[temp MOD 16]:1,' ');
  94.           END;
  95.      okt: BEGIN (* Format : High Byte  Low Byte   a..f = bits
  96.                             abbb cccd  ddee efff  3 bit pro Ziffer         *)
  97.             carry := 0;
  98.             IF len = Word_Len THEN
  99.               BEGIN
  100.                 temp := Hi (value);
  101.                 Write (OutFile,(temp DIV 128):1);
  102.                 Write (OutFile,(temp AND 112) DIV 16:1);
  103.                 Write (OutFile,(temp AND  14) DIV  2:1);
  104.                 IF Odd (temp) THEN  carry := 256;
  105.               END;
  106.             temp := Lo (value) + carry;
  107.             Write (OutFile,(temp DIV 64):1);
  108.             Write (OutFile,(temp AND 56) DIV 8:1);
  109.             Write (OutFile,(temp AND 7):1,' ');
  110.           END;
  111.      dez: BEGIN
  112.             IF len = Word_Len THEN  Write (OutFile,value:5,' ')
  113.             ELSE Write (OutFile,value:3,' ');
  114.           END;
  115.    END; { case }
  116.  END;
  117.  
  118. (* ----------------------------------------------------------------------- *)
  119. (* Ausgabe der n Codewerte in einer Zeile. Bei korrekter Einstellung wer-
  120.   den die ASCII-Aequivalente im zweiten Schritt ausgegeben.                *)
  121.  
  122. PROCEDURE Write_line;
  123.  
  124.  VAR i : INTEGER;
  125.  
  126.  BEGIN
  127.    Write_val (Adr,Word_Len);                           (* Adresse ausgeben *)
  128.    IF Switch <> ascii THEN           (* Hex-, Okt- oder Dez-Werte ausgeben *)
  129.      BEGIN
  130.        FOR i := 1 TO Row DO  Write_val (Code[i],Byte_Len);
  131.        Write (OutFile,End_Line);     (* Cursor in n. Zeile oder nur Blanks *)
  132.      END;
  133.    IF Switch <> compressed THEN                       (* als Text ausgeben *)
  134.      BEGIN
  135.        IF Switch = wide THEN
  136.          BEGIN
  137.            FOR i:= Row + 1 TO Max_Spalte DO  Write (OutFile,Space_Code_Base);
  138.            Write (OutFile,Space_Wide);
  139.          END
  140.        ELSE
  141.          Write (OutFile,Space_Zeilen_Anfang);
  142.        FOR i := 1 TO Row DO
  143.          IF Code[i] IN [32..126] THEN              (* druckbares Zeichen ? *)
  144.            Write (OutFile,Space_Pred,Chr(Code[i]),Space_Suc)
  145.          ELSE
  146.            Write (OutFile,Space_Pred,'.',Space_Suc);
  147.        WriteLn (OutFile);
  148.      END;
  149.    Line := Line + Line_step;
  150.  END;
  151.  
  152. (* ----------------------------------------------------------------------- *)
  153. (*                      Versuche, Datei zu oeffnen                         *)
  154.  
  155. FUNCTION Open(VAR fp:File_Typ_Byte; File_Name: File_Name_Typ): BOOLEAN;
  156.  
  157.  BEGIN
  158.    Assign(fp,File_Name);        (* andere Dialekte: entfaellt, s.u.: ReSet *)
  159.    {$I-}     (* Turbo-I/O-Fehlerbehandlung durch Laufzeitsystem auschalten *)
  160.    ReSet(fp);                     (* andere Dialekte: ReSet(fp, File_Name) *)
  161.    {$I+}             (* Fehlerbehandlung durch Laufzeitsystem wieder aktiv *)
  162.    IF IOResult <> 0 THEN     (* wenn <> 0 trat ein Fehler bei ReSet auf... *)
  163.      BEGIN Open := FALSE; Close(fp); END   (* ja, "Close" schliesst wieder *)
  164.    ELSE
  165.      Open := TRUE;
  166.  END;
  167.  
  168. (* ----------------------------------------------------------------------- *)
  169. (*                    Einstellung der Standard-Optionen                    *)
  170.  
  171. PROCEDURE Init;
  172.  
  173.  VAR i: INTEGER;
  174.  
  175.  BEGIN
  176.    WriteLn; WriteLn;
  177.    Device     := 'CON:';                            (* Ausgabe auf Console *)
  178.    Base       := hex;
  179.    Switch     := normal;
  180.    Space_Code_Base := '   ';                                   (* 3 blanks *)
  181.    End_Line   := Chr(CR) + Chr(LF);
  182.    Space_Pred := ' ';
  183.    Space_Suc  := ' ';
  184.    Space_Zeilen_Anfang := '     ';                             (* 4 Blanks *)
  185.    Space_Code_Base := '   ';                                   (* 3 Blanks *)
  186.    Max_Spalte := Max_Column;   Line := 0;   Page := 1;   more := TRUE;
  187.    FOR i := 0 TO 9 DO HexZif[i] := Chr(Ord('0')+i);
  188.    FOR i := 10 TO 15 DO HexZif[i] := Chr(Ord('A')-10+i);
  189.  END;
  190.  
  191. (* ----------------------------------------------------------------------- *)
  192. (* pruefe, ob Parameter und Filename vom Betriebssystem uebergeben wurde,
  193.    sonst frage sie ab und setze die neuen Optionen                         *)
  194.  
  195. PROCEDURE get_parameter;
  196.  
  197.  VAR i : INTEGER;
  198.  
  199.  BEGIN
  200.    IF ParamCount = 0 THEN          (* wieviel Parameter in Kommandozeile ? *)
  201.      BEGIN                         (* keine -> jetzt erfragen:             *)
  202.        WriteLn ('Optionen: ASCII    KeinASCII    Normal   Breit  Mehr ');
  203.        WriteLn ('          Printer  Console      Hex      Oct    Dez  ');
  204.        WriteLn;
  205.        Write (' Datei: ');  ReadLn (File_Name);
  206.        Write ('Option: ');  ReadLn (Mode);
  207.        WriteLn;
  208.      END
  209.    ELSE       (* Parameter aus Kommandozeile holen. Falls dies im Pascal-  *)
  210.      BEGIN    (* Dialekt nicht moeglich, nur oberen Dialog-Teil verwenden! *)
  211.        File_Name := ParamStr(1);        (* 1. Parameter: anzusehende Datei *)
  212.        IF ParamCount > 1 THEN Mode := ParamStr(2); (* Optionen angegeben ? *)
  213.        IF ParamCount > 2 THEN
  214.          BEGIN
  215.            WriteLn ('**** zu viel Parameter...');
  216.            WriteLn ('**** Gebrauch: "DUMP Dateiname.ext -Optionen" ',
  217.                     ' oder einfach "DUMP" !');
  218.            Halt;                                    (* Programm abbrechen! *)
  219.          END;
  220.      END;
  221.    FOR i := 1 TO Length (Mode) DO Mode[i] := UpCase (Mode[i]);
  222.               (* pruefe, welche Optionen gesetzt wurden und aktiviere sie. *)
  223.    IF Pos ('O',Mode) <> 0 THEN           (* Pos sucht 'O' im String 'mode' *)
  224.      BEGIN
  225.        Base := okt;
  226.        Space_Pred := '  ';                                     (* 2 Blanks *)
  227.        Space_Zeilen_Anfang := '       ';                       (* 7 Blanks *)
  228.        Space_Code_Base := '    ';                              (* 4 Blanks *)
  229.      END
  230.    ELSE IF Pos('D',Mode) <> 0 THEN
  231.      BEGIN
  232.        Base := dez;
  233.        Space_Pred := '  ';                                     (* 2 Blanks *)
  234.        Space_Zeilen_Anfang := '      ';                        (* 6 Blanks *)
  235.        Space_Code_Base := '    ';                              (* 4 Blanks *)
  236.      END;
  237.    IF Pos ('A',Mode) <> 0 THEN
  238.      BEGIN
  239.        Switch := ascii;
  240.        Space_Pred := '';      (* keine Leerzeichen zwischen den Buchstaben *)
  241.        Space_Suc  := '';
  242.        Max_Spalte := Max_Column_ascii;
  243.      END
  244.    ELSE IF Pos('K',Mode) <> 0 THEN
  245.      BEGIN  Switch := compressed  END
  246.    ELSE IF Pos ('B',Mode) <> 0 THEN
  247.      BEGIN
  248.        Switch := wide; Space_Pred := ''; Space_Suc := ''; End_Line := '';
  249.      END;
  250.    IF Pos ('P',Mode) <> 0 THEN                      (* Ausgabe auf Drucker *)
  251.      BEGIN  Device := 'LST:';  Line := Page_Length + 1; more := FALSE;  END;
  252.    IF Pos ('M',Mode) <> 0 THEN more := FALSE;
  253.    IF Switch = normal THEN Line_step := 2             (* 2 Zeilen Ausdruck *)
  254.    ELSE Line_step := 1;
  255.  END;
  256.  
  257. (* ----------------------------------------------------------------------- *)
  258. (* ein Byte aus der Datei lesen. Um mit CP/M kompatibel zu sein, werden
  259.    128 Bytes in einen Buffer gelesen und dann Byte fuer Byte an das Pro-
  260.    gramm weitergegeben. Siehe Kommentare hier und bei der TYPE-Definition. *)
  261.  
  262. PROCEDURE Get_Byte (VAR f: File_Typ_Byte; VAR byt: BYTE);
  263.  
  264.   PROCEDURE FillBuf;
  265.     VAR i: INTEGER;
  266.   BEGIN
  267.   (* fuer CP/M:
  268.      BlockRead(f, buffer, 1);
  269.      IF eof(f) then EOFPos := BufSize;
  270.   *)
  271.   (* fuer MS-DOS und Pascal ohne BlockRead: *)
  272.      i := 0;
  273.      REPEAT  i := Succ(i);  Read (f, Buffer[i]);  UNTIL Eof(f) OR (i = 128);
  274.      IF Eof(f) THEN EOFPos := i;
  275.   (* *)
  276.   END;
  277.  
  278. BEGIN
  279.   BufPos := Succ(BufPos);
  280.   IF BufPos > BufSize THEN BEGIN BufPos := 1; FillBuf; END;
  281.   byt := Buffer[BufPos];
  282.   IF EOFPos > 0 THEN IF BufPos = EOFPos THEN EndOfFile := TRUE;
  283. END;
  284.  
  285. (* ----------------------------------------------------------------------- *)
  286.  
  287. BEGIN
  288.  EndOfFile := FALSE;   BufPos := BufSize;  EOFPos := -1;
  289.  Init;
  290.  WriteLn ('DUMP 1.0          (C) Born & PASCAL International');
  291.  WriteLn;
  292.  get_parameter;
  293.  Assign (OutFile,Device);                         (* Ausgabe-Datei oeffnen *)
  294.  ReWrite (OutFile);
  295.  IF NOT Open(InFile,File_Name) THEN
  296.    BEGIN
  297.      WriteLn('Fehler: Datei "',File_Name,'" nicht gefunden !');
  298.      Halt;
  299.    END;
  300.  Row := 0;  Adr := 0;
  301.  WHILE NOT EndOfFile DO
  302.    BEGIN
  303.      Row := Row + 1;
  304.      IF Pos ('P',Mode) <> 0 THEN
  305.        IF Line >= Page_Length THEN
  306.          BEGIN
  307.            Write(OutFile,Chr(FF),'Datei : ',File_Name,'   ');
  308.            WriteLn (OutFile,'  Seite :',Page);   WriteLn;
  309.            Page := Page + 1;   Line := 1;
  310.          END;
  311.      Get_Byte (InFile,Code[Row]);
  312.      IF Row = Max_Spalte THEN
  313.        BEGIN
  314.          Write_line;   Adr := Adr + Max_Spalte;  Row := 0;
  315.        END;
  316.      IF more THEN
  317.        BEGIN
  318.          IF Line >= Max_Screen THEN
  319.            BEGIN
  320.              WriteLn;  WriteLn ('Mehr - eine Taste druecken...');
  321.              REPEAT UNTIL KeyPressed;
  322.              Line := 0;  WriteLn;
  323.            END;
  324.        END;
  325.    END; (* WHILE *)
  326.  Write_line;
  327.  Close (InFile);
  328.  Close (OutFile);
  329. END.
  330.