home *** CD-ROM | disk | FTP | other *** search
/ Frostbyte's 1980s DOS Shareware Collection / floppyshareware.zip / floppyshareware / USCX / TPCOMPLT.ZIP / HEXDUMP.PAS < prev    next >
Pascal/Delphi Source File  |  1986-05-06  |  5KB  |  156 lines
  1. {--------------------------------------------------------------}
  2. {                          HexDump                             }
  3. {                                                              }
  4. {            Hex dump program for all disk files               }
  5. {                                                              }
  6. {                             by Jeff Duntemann                }
  7. {                             Turbo Pascal V3.0                }
  8. {                             Last update 2/1/86               }
  9. {                                                              }
  10. {    From the book, COMPLETE TURBO PASCAL, by Jeff Duntemann   }
  11. {    Scott, Foresman & Co. (c) 1986,1987  ISBN 0-673-18600-8   }
  12. {--------------------------------------------------------------}
  13.  
  14. PROGRAM HexDump;
  15.  
  16. {$V-}  { Relaxes String length type checking on VAR paramaters }
  17.  
  18. CONST
  19.   Up   = True;
  20.   Down = False;
  21.  
  22. TYPE
  23.   String255   = String[255];
  24.   String128   = String[128];
  25.   String80    = String[80];
  26.   String40    = String[40];
  27.   Block       = ARRAY[0..127] OF Byte;  { One disk sector   }
  28.   BlockArray  = ARRAY[0..15] OF Block;  { BlockRead reads   }
  29.                                         { 16 Blocks at once }
  30.  
  31.  
  32. VAR
  33.   I,J,K       : Integer;
  34.   Parm        : String80;
  35.   Ch          : Char;
  36.   DumpFile    : FILE;
  37.   XBlock      : Block;
  38.   DiskData    : BlockArray;
  39.   Blocks      : Integer;        { Counts Blocks within }
  40.                                 { BlockArray }
  41.   BlockCount  : Integer;        { Tallies total # Blocks Read }
  42.   Buffers     : Integer;
  43.   Remains     : Integer;
  44.   Device      : Text;           { Will be either LST: or CON: }
  45.  
  46.  
  47.  
  48. {$I FRCECASE.SRC }   { Described in Section 15.3 }
  49. {$I YES.SRC }        { Described in Section 17.2 }
  50. {$I WRITEHEX.SRC }   { Described in Section 20.2 }
  51.  
  52.  
  53. {>>>>DumpBlock<<<<}
  54.  
  55. PROCEDURE DumpBlock(XBlock : Block; VAR Device : Text);
  56.  
  57. VAR
  58.   I,J,K : Integer;
  59.   Ch    : Char;
  60.  
  61. BEGIN
  62.   FOR I:=0 TO 7 DO        { Do a hexdump of 8 lines of 16 chars }
  63.     BEGIN
  64.       FOR J:=0 TO 15 DO   { Show hex values }
  65.         BEGIN
  66.           WriteHex(Device,Ord(XBlock[(I*16)+J]));
  67.           Write(Device,' ')
  68.         END;
  69.       Write(Device,'   |');    { Bar to separate hex & ASCII }
  70.       FOR J:=0 TO 15 DO        { Show printable chars or '.' }
  71.         BEGIN
  72.           Ch:=Chr(XBlock[(I*16)+J]);
  73.           IF ((Ord(Ch)<127) AND (Ord(Ch)>31))
  74.           THEN Write(Device,Ch) ELSE Write(Device,'.')
  75.         END;
  76.       Writeln(Device,'|')
  77.     END;
  78.   FOR I:=0 TO 1 DO Writeln(Device,'')
  79. END;  { DumpBlock }
  80.  
  81.  
  82. {<<<<ShowHelp>>>>}
  83.  
  84. PROCEDURE ShowHelp(HelpName : String80);
  85.  
  86. VAR
  87.   HelpFile : Text;
  88.   HelpLine : String80;
  89.   I        : Integer;
  90.  
  91. BEGIN
  92.   Writeln;
  93.   Assign(HelpFile,HelpName);
  94.   {$I-} Reset(HelpFile); {$I+}
  95.   IF IOResult = 0 THEN
  96.     FOR I := 1 TO 20 DO
  97.       BEGIN
  98.         Readln(HelpFile,HelpLine);
  99.         Writeln(HelpLine)
  100.       END;
  101.   Close(HelpFile)
  102. END;
  103.  
  104.  
  105. BEGIN
  106.   CLRSCR;                        { Clear the CRT }
  107.   Parm := '';
  108.                                  { Caps lock printer parameter }
  109.   IF ParamCount > 1 THEN Parm := ForceCase(Up,ParamStr(2));
  110.   IF ParamCount < 1 THEN         { Error - no parms given }
  111.     BEGIN
  112.       Writeln('<<Error!>> You must enter a filename after invoking');
  113.       Write  ('           HexDump.COM.  Display help screen? (Y/N): ');
  114.       IF Yes THEN ShowHelp('DUMPHELP.TXT')
  115.     END
  116.   ELSE
  117.     BEGIN
  118.       Assign(DumpFile,ParamStr(1));  { Attempt to open the file }
  119.       {$I-} Reset(DumpFile); {$I+}
  120.       IF IOResult <> 0 THEN       { Error if file won't open }
  121.         BEGIN
  122.           Writeln('<<Error!>> File ',ParamStr(1),' does not exist.');
  123.           Write  ('           Display help screen? (Y/N): ');
  124.           IF Yes THEN ShowHelp('DUMPHELP.TXT');
  125.         END
  126.       ELSE
  127.         BEGIN                     { See if print Parm was entered; }
  128.                                   { and select output Device }
  129.           IF (Pos('PRINT',Parm) = 1) OR (Pos('P',Parm) = 1) THEN
  130.             Assign(Device,'LST:') ELSE Assign(Device,'CON:');
  131.           Reset(Device);
  132.           BlockCount := FileSize(DumpFile);  { FileSize in 128-Byte Blocks }
  133.           IF BlockCount = 0 THEN
  134.             Writeln('File ',ParamStr(1),' is empty.')
  135.           ELSE
  136.             BEGIN
  137.               Buffers := BlockCount DIV 16;  { # of 16-Block Buffers }
  138.               Remains := BlockCount MOD 16;  { # of Blocks in last buffer }
  139.               FOR I := 1 TO Buffers DO       { Dump full 16-Block Buffers }
  140.                 BEGIN
  141.                   BlockRead(DumpFile,DiskData,16); { Read 16 disk Blocks }
  142.                   FOR J := 0 TO 15 DO
  143.                     DumpBlock(DiskData[J],Device)  { Dump 'em... }
  144.                 END;
  145.               IF Remains > 0 THEN  { If fractional buffer Remains, dump it }
  146.                 BEGIN
  147.                   BlockRead(DumpFile,DiskData,Remains); { Read last buffer }
  148.                   FOR I := 0 TO Remains-1 DO
  149.                     DumpBlock(DiskData[I],Device)       { Dump it }
  150.                 END
  151.             END;
  152.           Close(DumpFile)
  153.         END
  154.     END
  155. END.
  156.