home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol064 / locate.pas < prev    next >
Pascal/Delphi Source File  |  1984-04-29  |  5KB  |  173 lines
  1. program xlocate;{$P,c-,m-,f-}
  2.  
  3. {A program to locate the starting and ending address of an array of charac-}
  4. {ters within a .com file.  Enter the characters with a carriage return.}
  5. {Written by: Craig Rudlin, M.D.}
  6.  
  7.  
  8. label 1;
  9. type 
  10. byte = 0..255;
  11. f = file of byte;
  12. $string14 = string 14;
  13.  
  14. var
  15. length,match,c,b:byte;
  16. charsub:array[1..80] of byte;
  17. input:f;
  18. ch:char;
  19. i:real;
  20. filename:$string14;
  21. found,first_occurrence,continue:boolean;
  22.  
  23. procedure keyin(var cix:char);external; {this procedure is on a previous user
  24.                      group disc}
  25.  
  26. begin
  27. continue:=true;
  28. write(chr(27),'*',chr(0),chr(0),chr(0),chr(0));     {clear screen code for Soroc
  29.                             or Televideo}
  30. writeln;
  31. writeln(' PROGRAM TO LOCATE MEMORY ADDRESS OF AN ARRAY OF CHARACTERS ');
  32. writeln;
  33. writeln('Enter the NAME of the .COM file you wish to search ');
  34. write  ('as Drive:name.COM.    The file must be a .COM file ');
  35. readln(filename);
  36.  
  37. writeln;
  38. writeln;
  39.  
  40.  
  41. {a com file is nothing more than an file of bytes, and thus can be either
  42. sequentially or randomly read just like any other file. Each "record" in
  43. the COM file is a single byte.  Note we must declare the type byte = 0..255}
  44.  
  45.  
  46.  
  47. while continue do
  48. begin
  49. found:=false;
  50. write(chr(27),'*',chr(0),chr(0),chr(0),chr(0));         {clear screen}
  51. reset(filename,INPUT);
  52. if eof(input) then
  53.     begin
  54.     writeln('File ',filename, 'not present on disk. ');
  55.     goto 1;
  56.     end;
  57. i:=0.0;       {initialize values}
  58. c:=0;
  59. for b:= 1 to 80 do charsub[b]:=32;   {initialize array to all spaces}
  60.  
  61. repeat
  62. write(' Enter the LENGTH (up to 80 characters) of the array:   ');
  63. readln(length);
  64. until (length > 0) and (length < 81);
  65.  
  66. {I chose to limit the size to one line on my CRT, hence a max length of 80}
  67. writeln;
  68. writeln;
  69. repeat
  70. writeln('Do you want (1) only the first occurrence or (2) all occurrences of');
  71. write  ('the array of characters?   Enter either a  1  or a  2 :   ');
  72. keyin(ch);
  73. until (ch = '1') or (ch = '2');
  74. if ch = '1' then first_occurrence:= true else first_occurrence:= false;
  75. write(chr(27),'*',chr(0),chr(0),chr(0),chr(0));         {clear screen}
  76. writeln;
  77. writeln('When prompted, enter ',length:4,'  characters or spaces.');
  78. writeln;
  79. writeln('DO NOT ENTER A CARRIAGE RETURN AT ANY TIME.'); {keyin doesnt need one}
  80. writeln;
  81. writeln('If you make a mistake, type a control-C after ');
  82. writeln('entering all the characters or spaces.');
  83. writeln;
  84. writeln;
  85.  
  86.  
  87. write('---> ');
  88. for b:=length downto 1 do 
  89.               {pascal stores an array of char backwards in .com file}
  90. begin    
  91.   repeat
  92.     keyin(ch);   
  93.     until ((ord(ch) > 64) and (ord(ch) < 91)) or 
  94.           ((ord(ch) > 96) and (ord(ch) < 123)) or (ch = ' ');
  95.  
  96.     {permit only lower case or capital letters, or a space}
  97.  
  98.     charsub[b]:=ord(ch);
  99.     if ch = ' ' then write('-') else write(ch);
  100. end;    {ouput a "-" instead of a space, so can see all characters}
  101.  
  102. writeln;
  103. writeln;
  104.  
  105. match:=0;
  106.  
  107.     repeat
  108.     i:=i+1.0;
  109.     c:=c+1;
  110.     read(input,b);
  111.     if charsub[c] = b then match:=match + 1;
  112.  
  113. {the problem is that parts of the desired array may match at many locations }
  114. { in the file.  For example, if you were looking for the string RICHMOND, the}
  115. {letters R I C might be present numerous times in the file. The ONLY time you} 
  116. {want the program to acknowledge a match is when ALL the characters in the }
  117. {array, match in the PROPER ORDER.  So when the first character matches, you}
  118. {start counting...if the next character matches, you continue to count. If}
  119. {it does not, start over-- When the count = the length of the array, then}
  120. {(1) all the characters in the desired array are present in the file AND}
  121. {(2) they appear in the file in the SAME ORDER as in the desired array..ie}
  122. {a MATCH }
  123.  
  124.     if charsub[c] <> b then 
  125.         begin
  126.         match:=0;
  127.         c:=0;
  128.         end;
  129.         
  130.     if match = length then 
  131.     begin    
  132.     found:=true;
  133.     write('ARRAY LOCATED AT:  ');  
  134.     writeln('starting address: ',i-20.0:5:0,'   last address: ',i-1.0:5:0);
  135.     writeln;
  136.     writeln('If you plan to use these values for installing a new array');
  137.     writeln('of characters into ',filename,'  then use: ');
  138.     writeln('start = ',i-19.0:5:0,'  finish = ',i:5:0);
  139.     writeln;
  140.     writeln;
  141.     if first_occurrence = false then match:=0;  
  142.         {set up for next occurrence of string}
  143.     end;
  144.  
  145.  
  146. {The starting and last address are offset 100H (<) the address in DDT. 
  147.  Remember that :
  148.  (1) the program begins at 100H in DDT  and 
  149.  (2) the first byte of memory is 0000H.  
  150.  Hence, in the install program the start and finish must be 100H <
  151.  the value of DDT PLUS 1, to allow for not starting at 0000H but at a
  152.  decimal value of 1 }
  153.  
  154.   until (eof(input)) or ((match = length) and (first_occurrence = true));
  155.  
  156. if (eof(input)) and (found = false) then writeln('Array not found in file. ');
  157.  
  158. writeln;
  159. writeln;
  160. repeat
  161. write('Do you wish to locate another array of characters?  y/n  ');
  162. keyin(ch);
  163. until ch in ['y','n','Y','N'];
  164. if (ch = 'n') or (ch = 'N') then continue:= false else 
  165.             begin
  166.             continue:= true;
  167.             write(chr(27),'*',chr(0),chr(0),chr(0),chr(0));    
  168.             end;            
  169.  
  170. end; {of continue}
  171.  
  172. 1:
  173. end.