home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol064 / install.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  3.9 KB  |  135 lines
  1.  
  2.  
  3. PROGRAM INSTALL;{$P+}
  4.  
  5. {This program will install an array of characters into a .com file.  You}
  6. {merely enter the beginning and ending address of the array, and the char-}
  7. {acters you wish to insert.  No carriage return is needed when entering the}
  8. {characters.  Use the program "locate" to determine the address of the array.}
  9. {Since pascal/z limits the size of an integer to 32768, and the record number}
  10. {must be an integer, I am not sure this will work if the array is located }
  11. {beyond 32768 bytes...}
  12. {Written by: Craig Rudlin, M.D.}
  13.  
  14. {$C-,M-,F-}
  15. label 2;
  16.  
  17. CONST
  18. index = 20;  {this is the only change needed to alter the length of the array}
  19.  
  20. TYPE
  21. byte = 0..255;
  22. F = file of  byte;
  23. $string14 = string 14;
  24.  
  25. VAR
  26. start, finish, I:integer;
  27. INPUT:F;
  28. C:char;
  29. SUB:array[1..index] OF byte;
  30. continue:boolean;
  31. filename:$string14;
  32.  
  33. PROCEDURE KEYIN(VAR CIX:CHAR);EXTERNAL;
  34.  
  35.  
  36. {************** READ FILE AND SUBSTITUTE VALUES ********************}
  37. PROCEDURE PUT_VALUES( var start,finish:integer);
  38. label 1;
  39. begin
  40.     
  41. for I:= start to finish do read(INPUT:I,SUB[I-(start-1)]);
  42.     write('     ');
  43.     for I:=index downto 1 do     
  44.         if SUB[I] = 32 then write('-') else
  45.                       write(chr(SUB[I]));
  46.         {32 = a space..want to visualize this so write a dash}
  47.  
  48.     writeln;
  49.     write('---> ');
  50.     for I:=index downto 1 do 
  51.             {pascal stores the string backwards in com file}
  52.             {e.g. notsob for boston; so must use downto}
  53.             begin          
  54.             repeat
  55.             keyin(C);
  56.             until ((ord(C) >31) AND (ord(C) < 127)) OR 
  57.                 (ord(c) = 27) ;
  58. {permit only entry of letters, numbers or printable symbols}
  59.         
  60.             if ord(c) = 27 then goto 1;  
  61. {entering an esc keeps the array presently in the file unchanged}
  62.  
  63.             if C = ' ' then write('-') else write(C);
  64.             SUB[I]:=ORD(C); {note use of an array to store values}
  65.             end;
  66.  
  67. 1:  for I:=start to finish do write(INPUT:I,SUB[I-(start-1)]);
  68.  
  69. end; {of procedure}
  70.  
  71. {************************* main program *************************************}
  72. begin
  73. continue:=true;
  74. write(CHR(27),'*',CHR(0),CHR(0),CHR(0),CHR(0));   {clear screen}
  75.  
  76. writeln('PROGRAM TO INSTALL AN ARRAY OF CHARACTERS IN A .COM FILE ');
  77. writeln;
  78. writeln;
  79. writeln('Enter the name of the .COM file you wish to alter. ');
  80. write('Enter the name as DRIVE: NAME.COM:  ');
  81. readln(filename);
  82.     reset(filename,INPUT);
  83.     if eof(input) then
  84.         begin
  85.         writeln;
  86.         writeln('ERROR:  FILE NOT FOUND ON DISK! ');    
  87.         goto 2;
  88.         end;
  89.  
  90. while continue do
  91. begin
  92. write(CHR(27),'*',CHR(0),CHR(0),CHR(0),CHR(0));   {clear screen}
  93. writeln('When prompted, enter the array of characters you wish to install   ');
  94. writeln;
  95. writeln('You must enter all ',index:2,' characters. ');
  96. writeln;
  97. writeln('The characters may be any displayable letter, numeral or symbol  ');
  98. writeln;
  99. writeln('NOTE: The program will display a space as a ''-''; do NOT enter ');
  100. writeln('      a carriage return after you type each character !  ');
  101. writeln;
  102. writeln('      Entering an ESC will cause the program to leave the array ');
  103. writeln('      presently in the file unchanged.');
  104.  
  105. writeln('      If you make a mistake, complete the entry, ask the program ');
  106. writeln('      to allow you to make another alteration, and then re-enter ');
  107. writeln('      the correct array of characters.');
  108. writeln;
  109. writeln;
  110. write  ('Enter the starting "address" for the array:  ');
  111. readln(start);
  112. writeln;
  113. write('Enter the final "address" for the array:  ');
  114. readln(finish);
  115. writeln;
  116. if (finish -start + 1) <> index then
  117.     begin
  118.     writeln;
  119.     writeln('ERROR: addresses do not match the length of the array!' );
  120.     goto 2;
  121.     end;
  122.  
  123. writeln('FILE CURRENTLY CONTAINS THE FOLLOWING ARRAY AT THIS LOCATION: ');
  124. put_values(start,finish);
  125. writeln;
  126. repeat
  127. write('Do you wish to make another alteration to ' ,filename,'  ? y/n  ');
  128. keyin(c);
  129. until c in ['n','y','N','Y'];
  130. if (c = 'y') or (c = 'Y') then continue:= true else continue:=false;
  131.  
  132. end; {of while}
  133. 2:
  134. END.
  135.