home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MADTRB11.ZIP / FILEDUMP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-07-13  |  3.3 KB  |  133 lines
  1. PROGRAM FileDump;
  2.  
  3. {
  4. This program displays or prints the contents of a file. The
  5. hexadecimal value of each byte in the file is displayed,
  6. along with its corresponding ASCII character (if there is
  7. one).
  8.  
  9. Source: "FILEDUMP: Displaying a File's Contents", TUG Lines Volume I Issue 5
  10. Author: Kuang-Hsing Tseng
  11. Date: 11/24/84
  12. Application: All systems
  13. }
  14.  
  15. CONST bufnumber =32;
  16.       buflength = 8191;
  17. TYPE  STRING14=STRING[14];
  18. VAR   SOURCE,DESTINATION : FILE;
  19.       CH:CHAR;
  20.       outfile:TEXT;
  21.       FILENAME:STRING14;
  22.       BUFFER : ARRAY[0..buflength] OF BYTE;
  23.       SCRNNO,K,bufno,NOOFRECSTOREAD,REMAINING:INTEGER;
  24.  
  25. FUNCTION EXIST (FILENAME:STRING14):BOOLEAN;
  26. VAR INFILE : FILE;
  27. BEGIN
  28.   ASSIGN(INFILE,FILENAME);
  29.   {$I-*}
  30.   RESET (INFILE);
  31.   {$I+*}
  32.   EXIST := (IORESULT=0);
  33. END;
  34.  
  35. PROCEDURE HEX(N:INTEGER);
  36. VAR A,B : INTEGER;
  37.     CHS : STRING[16];
  38. BEGIN
  39.   CHS := '0123456789ABCDEF';
  40.   A := TRUNC(N/16);
  41.   B := N - A*16;
  42.   IF (A >= 0) AND (A <=15) THEN WRITE(outfile,CHS[A+1])
  43.   ELSE WRITE(outfile,'?');
  44.  
  45.   IF (B >=0) AND (B <=15) THEN WRITE(outfile,CHS[B+1])
  46.   ELSE WRITE(outfile,'?');
  47.   WRITE(outfile,' ');
  48. END;
  49.  
  50. PROCEDURE displaybuffer;
  51. VAR I,J,N,M,OFFSET,L:INTEGER;
  52. BEGIN
  53.     CLRSCR;
  54.     WRITELN(outfile,' ':15,'FILE NAME : ',FILENAME,
  55. '        PART : ',K+1+bufno*(bufnumber DIV 2),' OF ',SCRNNO);
  56.     WRITELN(outfile);
  57.     WRITELN(outfile,'OFFSET',' ':24,'HEXADECIMAL',' ':25,'ASCII');
  58.     WRITELN(outfile,'------  ',
  59.     '  -0--1--2--3--4--5--6--7--8--9--10-11-12-13-14-15   0123456789012345');
  60.     WRITELN(outfile);
  61.     FOR I := 0 TO 15 DO
  62.       BEGIN
  63.         L :=  K * 256 + I*16;
  64.         OFFSET := bufno*256 + L;
  65.         WRITE(outfile,L:5,'      ');
  66.         {HEX DUMP}
  67.         FOR J := 0 TO 15 DO
  68.           BEGIN
  69.             N := OFFSET + J;
  70.             HEX(ORD(BUFFER[N]));
  71.           END;
  72.  
  73.         WRITE(outfile,'  ');
  74.         {ASCII DUMP}
  75.         FOR J := 0 TO 15 DO
  76.           BEGIN
  77.             N := OFFSET + J;
  78.             M := ORD(BUFFER[N]);
  79.             IF M > 127 THEN M := m - 128;
  80.             IF (M>31) AND (m <127) THEN
  81.               WRITE(outfile,CHR(M))
  82.             ELSE
  83.               WRITE(outfile,' ');
  84.           END;
  85.       WRITELN(outfile);
  86.       END;
  87. END;
  88.  
  89. BEGIN
  90.   CLRSCR;
  91.   REPEAT
  92.    WRITE('   FILE TO HEX DUMP -> '); READLN(FILENAME);
  93.  UNTIL EXIST(FILENAME) OR (LENGTH(FILENAME)=0);
  94.  IF LENGTH(FILENAME)=0 THEN HALT;
  95.  ASSIGN(SOURCE,FILENAME);
  96.  RESET(SOURCE);
  97.  
  98.  WRITE('   OUTPUT TO Printer/Console -> ');
  99.  repeat read(TRM,ch) until upcase(ch) in ['P','C'];
  100.  if upcase(ch) = 'C' THEN ASSIGN(outfile,'CON:')
  101.  ELSE ASSIGN(outfile,'LST:');
  102.  RESET(outfile);
  103.  REMAINING := FILESIZE(SOURCE);
  104.  if odd(remaining) then SCRNNO := (REMAINING DIV 2) + 1
  105.  else SCRNNO := REMAINING DIV 2;
  106.  bufno := 0;
  107.  WHILE REMAINING > 0 DO
  108.    BEGIN
  109.      IF bufnumber <= REMAINING THEN NOOFRECSTOREAD := bufnumber
  110.      ELSE NOOFRECSTOREAD := REMAINING;
  111.  
  112.     BLOCKREAD(SOURCE,BUFFER,NOOFRECSTOREAD);
  113.     FOR K := 0 TO ((NOOFRECSTOREAD-1) DIV 2) DO
  114.      BEGIN
  115.        displaybuffer;
  116.        WRITELN;
  117.        WRITE(' ':6,'<< PRESS <ESC> TO EXIT OR ANY OTHER KEY TO CONTINUE >>');
  118.        READ(KBD,CH);
  119.        IF ORD(CH)=27 THEN HALT;
  120.      END;
  121.  
  122.      bufno := bufno + 1;
  123.      REMAINING := REMAINING - nOOFRECSTOREAD;
  124.    END;
  125.   WRITELN(outfile);
  126.   WRITELN(OUTFILE,'END OF PROCESS');
  127. END.
  128.  
  129.  
  130.  
  131.  
  132.  
  133.