ftp.barnyard.co.uk/2015.02.ftp.barnyard.co.uk.tar/ftp.barnyard.co.uk/cpm/walnut-creek-CDROM/CPM/TURBOPAS/TP-UTIL.ARK/HEXDUMP.PAS

Pascal/Delphi Source File | 1986-01-06 | 6KB | 183 lines

{--------------------------------------------------------------}
{                          HEXDUMP                             }
{                                                              }
{            Hex dump program for all disk files               }
{                                                              }
{                             by Jeff Duntemann                }
{                             Turbo Pascal V2.0                }
{                             Last update 12/11/84             }
{                                                              }
{                 (c) 1984 by Jeff Duntemann                   }
{                     ALL RIGHTS RESERVED                      }
{--------------------------------------------------------------}

PROGRAM HEXDUMP;

{$V-}  { Relaxes string length type checking on VAR paramaters }

CONST UP   = TRUE;
      DOWN = FALSE;

TYPE STRING255   = STRING[255];
     STRING128   = STRING[128];
     STRING80    = STRING[80];
     STRING40    = STRING[40];
     PARM_ARRAY  = ARRAY[1..10] OF STRING40;  { Command line   }
                                   { parms are stored here     }
     BLOCK       = ARRAY[0..127] OF BYTE;  { One disk sector   }
     BLOCK_ARRAY = ARRAY[0..15] OF BLOCK;  { BLOCKREAD reads   }
                                           { 16 blocks at once }


VAR I,J,K       : INTEGER;
    PARMS       : PARM_ARRAY;
    CH          : CHAR;
    DUMPFILE    : FILE;
    XBLOCK      : BLOCK;
    DISKDATA    : BLOCK_ARRAY;
    IOCODE      : INTEGER;
    BLOCKS      : INTEGER;        { Counts blocks within }
                                  { BLOCK_ARRAY }
    BLOCK_COUNT : INTEGER;        { Tallies total # blocks read }
    BUFFERS     : INTEGER;
    REMAINS     : INTEGER;
    DEVICE      : TEXT;           { Will be either LST: or CON: }


           {<<<<LOCATION OF THE COMMAND LINE TAIL>>>>}

    {Only ONE of the following two declarations applies to any }
    {given version of Turbo Pascal.  Choose the one that       }
    {matches your operating system and un-comment it.  Then    }
    {comment out the other one!                                }

     RAM_TAIL : STRING128 ABSOLUTE CSEG : $80;   { MS/PC DOS }
    {RAM_TAIL : STRING128 ABSOLUTE $80;}         { CP/M }


{$I FRCECASE.SRC }   { Contains FORCE_CASE }

{$I STRIPWHT.SRC }   { Contains STRIP_WHITE }

{$I PARSTAIL.SRC }   { Contains PARSE_TAIL }

{$I YES.SRC }        { Contains YES }


{>>>>WRITE_HEX<<<<}

PROCEDURE WRITE_HEX(VAR DEVICE : TEXT; BT : BYTE);

CONST HEXDIGITS : ARRAY[0..15] OF CHAR = '0123456789ABCDEF';

VAR BZ : BYTE;

BEGIN
  BZ := BT AND $0F;
  BT := BT SHR 4;
  WRITE(DEVICE,HEXDIGITS[BT],HEXDIGITS[BZ])
END;


{>>>>DUMPBLOCK<<<<}

PROCEDURE DUMPBLOCK(XBLOCK : BLOCK; VAR DEVICE : TEXT);

VAR I,J,K : INTEGER;
    CH    : CHAR;

BEGIN
  FOR I:=0 TO 7 DO        { Do a hexdump of 8 lines of 16 chars }
    BEGIN
      FOR J:=0 TO 15 DO   { Show hex values }
        BEGIN
          WRITE_HEX(DEVICE,ORD(XBLOCK[(I*16)+J]));
          WRITE(DEVICE,' ')
        END;
      WRITE(DEVICE,'   |');    { Bar to separate hex & ASCII }
      FOR J:=0 TO 15 DO        { Show printable chars or '.' }
        BEGIN
          CH:=CHR(XBLOCK[(I*16)+J]);
          IF ((ORD(CH)<127) AND (ORD(CH)>31))
          THEN WRITE(DEVICE,CH) ELSE WRITE(DEVICE,'.')
        END;
      WRITELN(DEVICE,'|')
    END;
  FOR I:=0 TO 1 DO WRITELN(DEVICE,'')
END;  { DUMPBLOCK }


{<<<<SHOW_HELP>>>>}

PROCEDURE SHOW_HELP(HELPNAME : STRING80);

VAR HELPFILE : TEXT;
    HELPLINE : STRING80;
    I        : INTEGER;

BEGIN
  WRITELN;
  ASSIGN(HELPFILE,HELPNAME);
  {$I-} RESET(HELPFILE); {$I+}
  IF IORESULT = 0 THEN
    FOR I := 1 TO 20 DO
      BEGIN
        READLN(HELPFILE,HELPLINE);
        WRITELN(HELPLINE)
      END;
  CLOSE(HELPFILE)
END;


BEGIN
  CLRSCR;                            { Clear the CRT }
  PARSE_TAIL(I,PARMS);               { Parse the command tail }
                                { Caps lock printer parameter }
  IF I > 1 THEN PARMS[2] := FORCE_CASE(UP,PARMS[2]);
  IF I < 1 THEN                      { Error - no parms given }
    BEGIN
      WRITELN('<<Error!>> You must enter a filename after invoking');
      WRITE  ('           HEXDUMP.COM.  Display help screen? (Y/N): ');
      IF YES THEN SHOW_HELP('DUMPHELP.TXT')
    END
  ELSE
    BEGIN
      ASSIGN(DUMPFILE,PARMS[1]);  { Attempt to open the file }
      {$I-} RESET(DUMPFILE); {$I+}
      IF IORESULT <> 0 THEN       { Error if file won't open }
        BEGIN
          WRITELN('<<Error!>> File ',PARMS[1],' does not exist.');
          WRITE  ('           Display help screen? (Y/N): ');
          IF YES THEN SHOW_HELP('DUMPHELP.TXT');
        END
      ELSE
        BEGIN                     { See if print parm was entered; }
                                  { and select output device }
          IF (POS('PRINT',PARMS[2]) = 1) OR (POS('P',PARMS[2]) = 1) THEN
            ASSIGN(DEVICE,'LST:') ELSE ASSIGN(DEVICE,'CON:');
          RESET(DEVICE);
          BLOCK_COUNT := FILESIZE(DUMPFILE);  { Filesize in 128-byte blocks }
          IF BLOCK_COUNT = 0 THEN
            WRITELN('File ',PARMS[1],' is empty.')
          ELSE
            BEGIN
              BUFFERS := BLOCK_COUNT DIV 16;  { # of 16-block buffers }
              REMAINS := BLOCK_COUNT MOD 16;  { # of blocks in last buffer }
              FOR I := 1 TO BUFFERS DO        { Dump full 16-block buffers }
                BEGIN
                  BLOCKREAD(DUMPFILE,DISKDATA,16); { Read 16 disk blocks }
                  FOR J := 0 TO 15 DO
                    DUMPBLOCK(DISKDATA[J],DEVICE)  { Dump 'em... }
                END;
              IF REMAINS > 0 THEN  { If fractional buffer remains, dump it }
                BEGIN
                  BLOCKREAD(DUMPFILE,DISKDATA,REMAINS); { Read last buffer }
                  FOR I := 0 TO REMAINS-1 DO
                    DUMPBLOCK(DISKDATA[I],DEVICE)       { Dump it }
                END
            END;
          CLOSE(DUMPFILE)
        END
    END
END.
ZIFIXASTQKSNCAEXJECZUKCTGTYRWPOLBCJKBHNTQQQPCOUUUMZIX