home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 September / Simtel20_Sept92.cdr / msdos / pascal / surpas.arc / HEXDUMP.PAS < prev    next >
Pascal/Delphi Source File  |  1980-01-01  |  2KB  |  79 lines
  1. PROGRAM HEXDUMP; (*$R-,K-*)
  2.  
  3. (* This program will output a hex dump af any disk file. Each    *)
  4. (* line shows the address of the first byte of the line, then    *)
  5. (* 16 bytes in hex, and then the same bytes in ASCII, if they    *)
  6. (* are printable. On running the program, you must specify the    *)
  7. (* name of the disk file to be dumped, and the name of the disk    *)
  8. (* file or logical device (CON:, LST:, etc.), which is to reci-    *)
  9. (* eve the dump.                        *)
  10.  
  11. LABEL EXIT;
  12.  
  13. TYPE
  14.   SECTOR = ARRAY[0..7,0..15] OF BYTE;
  15.   HEXSTRING = STRING[4];
  16.   FILENAME = STRING[14];
  17.  
  18. VAR
  19.   ADDRESS,L,P,I,J: INTEGER;
  20.   CH: CHAR;
  21.   INNAME,OUTNAME: FILENAME;
  22.   BUFFER: SECTOR;
  23.   INFILE: FILE;
  24.   OUTFILE: TEXT;
  25.  
  26. FUNCTION HEX(NUMBER,DIGITS: INTEGER): HEXSTRING;
  27. CONST
  28.   HEXDIGIT: ARRAY[0..15] OF CHAR = '0123456789ABCDEF';
  29. VAR
  30.   D: INTEGER;
  31.   H: HEXSTRING;
  32. BEGIN
  33.   H[0]:=CHR(DIGITS);
  34.   FOR D:=DIGITS DOWNTO 1 DO
  35.   BEGIN
  36.     H[D]:=HEXDIGIT[NUMBER AND 15];
  37.     NUMBER:=NUMBER SHR 4;
  38.   END;
  39.   HEX:=H;
  40. END;
  41.  
  42. BEGIN
  43.   WRITE('Input file name? '); READLN(INNAME);
  44.   IF INNAME='' THEN GOTO EXIT;
  45.   WRITE('Output file name? '); READLN(OUTNAME);
  46.   IF OUTNAME='' THEN GOTO EXIT;
  47.   ASSIGN(INFILE,INNAME); (*$I-*) RESET(INFILE,128) (*$I+*);
  48.   IF IORES>0 THEN
  49.   BEGIN
  50.     WRITELN(INNAME,' does not exist'); GOTO EXIT;
  51.   END;
  52.   ASSIGN(OUTFILE,OUTNAME); REWRITE(OUTFILE);
  53.   ADDRESS:=0;
  54.   WHILE NOT EOF(INFILE) DO
  55.   BEGIN
  56.     BLOCKREAD(INFILE,BUFFER,1);
  57.     FOR L:=0 TO 7 DO
  58.     BEGIN
  59.       WRITE(OUTFILE,HEX(ADDRESS,4),' ');
  60.       FOR P:=0 TO 15 DO
  61.       BEGIN
  62.     IF P=8 THEN WRITE(OUTFILE,' ');
  63.     WRITE(OUTFILE,HEX(BUFFER[L,P],2):3);
  64.       END;
  65.       WRITE(OUTFILE,'  ');
  66.       FOR P:=0 TO 15 DO
  67.       BEGIN
  68.     CH:=CHR(BUFFER[L,P]);
  69.     IF (CH>=@32) AND (CH<=@126) THEN
  70.     WRITE(OUTFILE,CH) ELSE WRITE(OUTFILE,'.');
  71.       END;
  72.       WRITELN(OUTFILE);
  73.       ADDRESS:=ADDRESS+16;
  74.     END;
  75.   END;
  76.   CLOSE(INFILE); CLOSE(OUTFILE);
  77.   EXIT:
  78. END.
  79.