DataMuseum.dk

top - download

    Length: 2048 (0x800)
    Types: TextFile
    Names: »HEXDUMP.PAS«

└─⟦0d02879d3⟧ Bits:30004605 COMPAS Pascal version 3.03
    └─ ⟦this⟧ »HEXDUMP.PAS« 
└─⟦8e533ec5a⟧ Bits:30004189 COMPAS Pascal v3.02 til CR7
    └─ ⟦this⟧ »HEXDUMP.PAS« 
└─⟦b6ad1e534⟧ Bits:30002857 COMPAS-80 V3.03 for JET80 CP/M
    └─ ⟦this⟧ »HEXDUMP.PAS« 

TextFile

PROGRAM HEXDUMP; (*$A+,R-*)

(* This program will output a hex dump af any disk file. Each	*)
(* line shows the address of the first byte of the line, then	*)
(* 16 bytes in hex, and then the same bytes in ASCII, if they	*)
(* are printable. On running the program, you must specify the	*)
(* name of the disk file to be dumped, and the name of the disk	*)
(* file or logical device (CON:, LST:, etc.), which is to reci-	*)
(* eve the dump.						*)

LABEL EXIT;

TYPE
  SECTOR = ARRAYÆ0..7,0..15Å OF BYTE;
  HEXSTRING = STRINGÆ4Å;
  FILENAME = STRINGÆ14Å;

VAR
  ADDRESS,L,P,I,J: INTEGER;
  CH: CHAR;
  INNAME,OUTNAME: FILENAME;
  BUFFER: SECTOR;
  INFILE: FILE;
  OUTFILE: TEXT;

FUNCTION HEX(NUMBER,DIGITS: INTEGER): HEXSTRING;
CONST
  HEXDIGIT: ARRAYÆ0..15Å OF CHAR = '0123456789ABCDEF';
VAR
  D: INTEGER;
  H: HEXSTRING;
BEGIN
  HÆ0Å:=CHR(DIGITS);
  FOR D:=DIGITS DOWNTO 1 DO
  BEGIN
    HÆDÅ:=HEXDIGITÆNUMBER AND 15Å;
    NUMBER:=NUMBER SHR 4;
  END;
  HEX:=H;
END;

BEGIN
  WRITE('Input file name? '); READLN(INNAME);
  IF INNAME='' THEN GOTO EXIT;
  WRITE('Output file name? '); READLN(OUTNAME);
  IF OUTNAME='' THEN GOTO EXIT;
  ASSIGN(INFILE,INNAME); (*$I-*) RESET(INFILE) (*$I+*);
  IF IORES>0 THEN
  BEGIN
    WRITELN(INNAME,' does not exist'); GOTO EXIT;
  END;
  ASSIGN(OUTFILE,OUTNAME); REWRITE(OUTFILE);
  ADDRESS:=0;
  WHILE NOT EOF(INFILE) DO
  BEGIN
    BLOCKREAD(INFILE,BUFFER,1);
    FOR L:=0 TO 7 DO
    BEGIN
      WRITE(OUTFILE,HEX(ADDRESS,4),' ');
      FOR P:=0 TO 15 DO
      BEGIN
	IF P=8 THEN WRITE(OUTFILE,' ');
	WRITE(OUTFILE,HEX(BUFFERÆL,PÅ,2):3);
      END;
      WRITE(OUTFILE,'  ');
      FOR P:=0 TO 15 DO
      BEGIN
	CH:=CHR(BUFFERÆL,PÅ);
	IF (CH>=@32) AND (CH<=@126) THEN
	WRITE(OUTFILE,CH) ELSE WRITE(OUTFILE,'.');
      END;
      WRITELN(OUTFILE);
      ADDRESS:=ADDRESS+16;
    END;
  END;
  CLOSE(INFILE); CLOSE(OUTFILE);
  EXIT:
END.
«eof»