home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / UTILITY / SYSTEM / PEEPOK12.ZIP / PP12.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1991-10-10  |  4.4 KB  |  134 lines
  1. {$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}
  2. {$M 8096,0,0}
  3.  
  4. program peekpoke;
  5.  
  6. (***********************************************************************
  7.  NOTICE
  8.  ======
  9.      This program and every file distributed with it are copyright (C)
  10.  by the authors, who retain authorship both of the pre-compiled and 
  11.  compiled codes.  Their use and distribution are unrestricted, as long
  12.  as nobody gets any richer in the process.  Although these programs 
  13.  were developed to the best of the authors abilities, no guarantees
  14.  can be given as to their performance.  By using them, the user
  15.  accepts all risks and the authors decline all liability. 
  16. ************************************************************************)
  17.  
  18. uses crt;
  19.  
  20. var
  21.   p1, p2, p3, p4, p5 : string;
  22.   code               : integer;
  23.   segw, ofsw         : word;
  24.   by, oldby          : byte;
  25.   byt                : longint;
  26.  
  27.  
  28. { ************************************************** }
  29. { Tranforms a word into a hex number string.         }
  30. { Taken from MEMMAP in PC Mag, Jun 12 1990, p. 343.  }
  31. { -Jose-                                             }
  32. { ************************************************** }
  33. function w2x(w: word): string;
  34. const hexdigit: array[0..15] of char = '0123456789ABCDEF';
  35. begin
  36.   w2x:= hexdigit[hi(w) shr 4] + hexdigit[hi(w) and $0F] +
  37.         hexdigit[lo(w) shr 4] + hexdigit[lo(w) and $0F];
  38. end;
  39.  
  40.  
  41. { ************************************************** }
  42. { Tranforms a byte into a binary number string.      }
  43. { This one may not be as elegant, but it is mine...  }
  44. { -Jose-                                             }
  45. { ************************************************** }
  46.  
  47. function power(a,b:real):real;
  48. begin
  49.   power:= exp(b * ln(a));
  50. end;
  51.  
  52. function byte2binstr(by: byte): string;
  53. var
  54.   i: integer;
  55.   pow : integer;
  56.   bit : byte;
  57.   strbit : string[1];
  58.   strbin : string[8];
  59. begin
  60.   strbin:= '';
  61.   for i:= 7 downto 0 do begin
  62.     pow:= round(power(2,i));
  63.     bit:= by div pow;
  64.     str(bit,strbit);
  65.     strbin:= strbin + strbit;
  66.     by:= by - pow * bit;
  67.   end;
  68.   byte2binstr:= strbin;
  69. end;
  70.  
  71.  
  72. procedure error;
  73. begin
  74.   writeln('Program PeekPoke v. 1.2');
  75.   writeln('Copyright (c) J. Campione/C.R.Parkinson.');
  76.   writeln('April 29 1991.');
  77.   inc(textattr,128);
  78.   write('   WARNING!');
  79.   dec(textattr,128);
  80.   writeln(' This program can modify the memory of your computer...');
  81.   writeln('   - Peek : <d:>\<path>\pp e $SEGW:$OFSW <!> <return>');
  82.   writeln('   - Poke : <d:>\<path>\pp o $SEGW:$OFSW <byte value> <!> <return>');
  83.   writeln('   In both cases the peeked old byte value is returned as the errorlevel.');
  84.   writeln('   The segment and offset words can be entered as $hex or dec numbers.');
  85.   writeln('   The optional "!" parameter causes the display of the byte value.');
  86.   halt(1);
  87. end;
  88.  
  89.  
  90. begin
  91.  
  92.   { *********************** }
  93.   { Process first parameter }
  94.   { *********************** }
  95.   p1:=  paramstr(1);
  96.   if (ord(p1[0]) <> 1) or not (upcase(p1[1]) in ['E','O']) then error;
  97.   if (upcase(p1[1]) = 'E') and (paramcount < 2) then error;
  98.   if (upcase(p1[1]) = 'O') and (paramcount < 3) then error;
  99.  
  100.   { ********************************** }
  101.   { process second parameter (address) }
  102.   { ********************************** }
  103.   p2:=  paramstr(2);
  104.   p3:= copy(p2,1,pos(':',p2)-1);
  105.   val(p3,segw,code);
  106.   if (code <> 0) or (segw < 0) then error;
  107.   p4:= copy(p2,pos(':',p2)+1,ord(p2[0])-pos(':',p2));
  108.   val(p4,ofsw,code);
  109.   if (code <> 0) or (ofsw < 0) then error;
  110.  
  111.   { ********************************** }
  112.   { Process 3rd parameter (byte value) }
  113.   { ********************************** }
  114.   if upcase(p1[1]) = 'O' then begin
  115.     p5:= paramstr(3);
  116.     val(p5,byt,code);
  117.     if (byt > 255) or (byt < 0) then error else by:= byt;
  118.     if code <> 0 then error;
  119.   end;
  120.  
  121.   { ***************************** }
  122.   { Take action and report result }
  123.   { ***************************** }
  124.   oldby:= mem[segw:ofsw];
  125.   if upcase(p1[1]) = 'O' then mem[segw:ofsw]:= by;
  126.   if (paramstr(3) = '!') or (paramstr(4) = '!') then begin
  127.     if upcase(p1[1]) = 'O' then begin
  128.       writeln('old mem[',w2x(segw),'h:',w2x(ofsw),'h] = ',oldby,'d, ',w2x(oldby),'h, ',byte2binstr(oldby),'b.');
  129.       writeln('new mem[',w2x(segw),'h:',w2x(ofsw),'h] = ',by,'d, ',w2x(by),'h, ',byte2binstr(by),'b.');
  130.     end else writeln('mem[',w2x(segw),'h:',w2x(ofsw),'h] = ',oldby,'d, ',w2x(oldby),'h, ',byte2binstr(oldby),'b.');
  131.   end;
  132.   halt(oldby);
  133.  
  134. end.