home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / INTRFC62.ZIP / DUMP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-12-19  |  2.3 KB  |  125 lines
  1. unit dump;
  2. {  Various routines to dump memory to system.output  }
  3.  
  4. interface
  5.  
  6. procedure dumpbytes(var loc;start,num:word);
  7. procedure dumpwords(var loc;start,num:word);
  8. function hexbyte(b:byte):string;
  9. function hexword(w:word):string;
  10. function hexword2(w:word):string;
  11.  
  12. implementation
  13.  
  14. uses
  15.   util;
  16.  
  17. function hexbyte(b:byte):string;
  18. const
  19.   symbol : array[0..$f] of char = ('0','1','2','3','4','5','6','7',
  20.                                    '8','9','A','B','C','D','E','F');
  21. begin
  22.   hexbyte := symbol[b shr 4] + symbol[b and $f];
  23. end;
  24.  
  25. function hexword(w:word):string;
  26. begin
  27.   hexword := hexbyte(hi(w))+hexbyte(lo(w));
  28. end;
  29.  
  30. function hexword2(w:word):string;
  31. var
  32.   i : byte;
  33.   h : string;
  34. begin
  35.   h := hexword(w);
  36.   for i:=1 to length(h)-1 do
  37.   begin
  38.     if h[i] <> '0' then
  39.     begin
  40.       hexword2 := h;
  41.       exit;
  42.     end;
  43.     h[i] := ' ';
  44.   end;
  45.   hexword2 := h;
  46. end;
  47.  
  48. function legal(b:byte):char;
  49. begin
  50.   if b<32 then
  51.     legal := '.'
  52.   else
  53.     legal := char(b);
  54. end;
  55.  
  56. procedure dumpbytes(var loc;start,num:word);
  57. var
  58.   bytes:array[0..65520] of byte absolute loc;
  59.   i,j:word;
  60. procedure dumpascii(last:word);
  61. var
  62.   j : word;
  63. begin
  64.   for j:=0 to last do
  65.   begin
  66.     write(legal(bytes[i+start-$F+j]));
  67.   end;
  68. end;
  69. begin
  70.   if num = 0 then
  71.     exit;
  72.   for i:=0 to num-1 do
  73.   begin
  74.     case i mod 16 of
  75.     0: begin
  76.          writeln;
  77.          write(hexword(i+start),':');
  78.        end;
  79.     8: write(' ');
  80.     end;
  81.     write(hexbyte(bytes[i+start]):3);
  82.     if i mod 16 = $F then
  83.     begin
  84.       write('  ');
  85.       dumpascii($F);
  86.     end;
  87.   end;
  88.   if (num-1) mod 16 < $F then
  89.   begin
  90.     for j := num mod 16 to $f do
  91.     begin
  92.       write('   ');
  93.       if j = 8 then
  94.       write(' ');
  95.     end;
  96.     write('  ');
  97.     i := 16*((num-1) div 16) + $F;
  98.     dumpascii((num-1) mod 16);
  99.   end;
  100.   writeln;
  101. end;
  102.  
  103. procedure dumpwords(var loc;start,num:word);
  104. var
  105.   words:array[0..32760] of word absolute loc;
  106.   i:word;
  107. begin
  108.   if num = 0 then
  109.     exit;
  110.   repeat
  111.     write(hexword(start):4);
  112.     for i:=1 to minw(15,num) do
  113.       write(hexword(start+i):5);
  114.     writeln;
  115.     write(hexword(words[start]));
  116.     for i:=1 to minw(15,num) do
  117.       write(hexword(words[start+i]):5);
  118.     writeln;
  119.     inc(start,16);
  120.     dec(num,16);
  121.   until num > 65535 - 16;
  122. end;
  123.  
  124. end.
  125.