home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / FDUMP.ZIP / FDUMP.PAS
Encoding:
Pascal/Delphi Source File  |  1986-11-07  |  3.8 KB  |  157 lines
  1. {FileDump.pas                             Typed in by Lem Hill from the
  2.  Turbo Pascal Ver. 2.0                    Micro/Systems Journal Vol. 1/3
  3.  PC-DOS Version                           July/Aug 1985  page 19.
  4.  Copyright 1985 by David W. Carroll
  5.  Date:  4/23/85                           Modifications by Lem 7/1/85
  6.  Version: 10                                called FDump.pas/com
  7.  }
  8.  
  9. program filedump;
  10. const
  11.    bell       = 07;
  12.    version    = '10';
  13.  
  14. type
  15.    datstr     = string[20];
  16.    datafile   = file of byte;
  17.  
  18. var
  19.    infile     : datafile;
  20.    infname    : string[20];
  21.    asciitext  : string[20];
  22.    sec        : real;
  23.    sec1       : real;
  24.    col        : byte;
  25.    dat        : byte;
  26.    msec       : byte;
  27.    hsec       : byte;
  28.    lsec       : byte;
  29.    goodfile   : boolean;
  30.    quit       : boolean;
  31.  
  32. procedure trans(indat: byte);
  33. var
  34.    ch  :  char;
  35.  
  36.    function xlt(bdat: byte): char;
  37.       begin
  38.         case bdat of
  39.         0..9   : xlt := chr(bdat + ord('0'));
  40.         10..15 : xlt := chr(bdat + ord('A') - 10);
  41.         else
  42.         ch := 'X';
  43.         end;
  44.       end;
  45.  
  46. begin
  47.    ch := xlt(indat div 16);
  48.    write(ch);
  49.    ch := xlt(indat mod 16);
  50.    write(ch);
  51. end;
  52.  
  53. procedure Uppercase(var str: datstr);
  54. var
  55.   indx, len    : integer;
  56.  
  57. begin
  58.   len := length(str);
  59.   for indx := 1 to len do
  60.     str[indx] := UpCase(str[indx])
  61. end;
  62.  
  63. begin
  64.    asciitext[0] := chr(16); {set ASCII string length}
  65.    sec := 256;              {set initial .COM address}
  66.    quit := false;
  67.    ClrScr;
  68.    writeln;
  69.    write('File HEX and ASCII DUMP program Version ');
  70.    write(version);
  71.    writeln('  |   Mods by Lem Hill 7/1/85 and');
  72.    write('Copyright 1985 by David W. Carroll');
  73.    writeln('          |      now called FDump.com');
  74.    writeln;
  75.    window(1,5,80,25);
  76.    repeat
  77.      ClrScr;
  78.      write('Input filename -->  ');
  79.      readln(infname);
  80.      if length(infname) > 0 then
  81.      begin
  82.        assign(infile,infname);
  83.        {$I-} reset(infile) {$I+};
  84.        goodfile := (IOresult = 0);
  85.        if not goodfile then
  86.        begin
  87.          write(chr(bell));
  88.          writeln('FILE ',infname,' NOT FOUND');
  89.          delay(3000)
  90.        end;
  91.      end
  92.      else
  93.      quit := true;
  94.    until goodfile or quit;
  95.    if not quit then
  96.    begin
  97.  
  98.      {reset start address if not .COM}
  99.      uppercase(infname);
  100.      if (pos('.COM',infname)=0) then sec := 0;
  101.  
  102.      writeln;
  103.      write('Address   00 01 02 03 04 05 06 07  08 09 0A 0B 0C 0D 0E 0F  ');
  104.      writeln('     ASCII TEXT');
  105.      write('-------   -- -- -- -- -- -- -- --  -- -- -- -- -- -- -- --  ');
  106.      writeln('     ----------');
  107.      window(1,9,80,25);
  108.      while not eof(infile) do
  109.        begin
  110.          msec := trunc(sec / 65536.0);
  111.          trans(msec);
  112.          write(' ');
  113.          sec1 := sec - (msec * 65536.0);
  114.          hsec := trunc(sec1 / 256);
  115.          lsec := trunc(sec1 - (hsec * 256.0));
  116.          trans(hsec);
  117.          trans(lsec);
  118.          write('   ');
  119.          for col := 1 to 16 do
  120.          begin
  121.            if not eof(infile) then
  122.            begin
  123.              read(infile,dat);
  124.              trans(dat);
  125.              if dat in [32..126] then
  126.                asciitext[col] := chr(dat)
  127.              else
  128.                asciitext[col] := '.';
  129.            end
  130.            else
  131.            begin
  132.              write('   ');
  133.              dat := 0;
  134.              asciitext[col] := ' ';
  135.            end;
  136.            write(' ');
  137.            if col = 8 then write(' ');
  138.          end;
  139.        writeln('  *',asciitext,'*');
  140.        if lsec = 240 then
  141.          begin
  142.            repeat until KeyPressed;
  143.            writeln;
  144.          end;
  145.        sec := sec + 16
  146.        end;
  147.      close(infile);
  148.    end;
  149.    if not quit then
  150.    begin
  151.      writeln;
  152.      writeln(' - eof -');
  153.    end;
  154. end.
  155.  
  156.  
  157.