home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / TURBOPAS / TP / UTL3 / IOPIPE.PZS / IOPIPE.PAS
Pascal/Delphi Source File  |  2000-06-30  |  3KB  |  145 lines
  1. {$V-}
  2. (*           Console IO redirection routines.
  3.  
  4.    Allows all console IO during program to be captured in disk file,
  5.    with or without IO to console also.
  6.  
  7.    To start capture:
  8.         IOP_OPEN ( FileName : AnyString );
  9.         Opens disk file of name FileName and redirects Console output to
  10.         both the console and the disk file.  If file already exists it
  11.         is deleted and re-created.  This routine turns on output to both
  12.         the console and the disk file.
  13.  
  14.    To end capture:
  15.         IOP_CLOSE;
  16.         Closes the disk file and directs console output to console only.
  17.         This  call is essential to guarantee that the file buffer is
  18.         flushed.
  19.  
  20.    To temporarily turn off capture while leaving disk file open:
  21.         IOP_Wanted:=False;
  22.  
  23.    To turn capture back on for same disk file:
  24.         IOP_Wanted:=True;
  25.  
  26.    To temporarily turn off output to console:
  27.         CONIO_Wanted:=False;
  28.  
  29.    To turn console output back on:
  30.         CONIO_Wanted:=True;
  31.  
  32.    Adjustable parameters:
  33.         IOP_BufSize = 127;
  34.         May be increased to any value of (N * 128) - 1 to decrease
  35.         disk accesses.
  36.    Required declarations:
  37.         Type AnyString = string[255];
  38.         {$V-} string relaxation
  39.  
  40. *)
  41.  
  42. type
  43.   anystring  = string[255];
  44.  
  45. const
  46.   iop_bufsize = 127;
  47.  
  48. var
  49.    iop_buf       : array [0..iop_bufsize] of char;
  50.    iop_x         : integer;
  51.    iop_file      : file;
  52.  
  53.    iop_wanted,
  54.    conio_wanted  : boolean;
  55.  
  56. { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  57.  
  58. procedure iop_outflush;
  59. var i : integer;
  60.  
  61. begin
  62.   if iop_x <> 0 then
  63.     begin
  64.       i := 0;
  65.       repeat
  66.         bdos($1A, addr(iop_buf) + i);     {Set DMA}
  67.         bdos($15 , addr(iop_file) + 12);  {Write sequential}
  68.         i := i + 128;
  69.       until i >= iop_x;
  70.     end;
  71.   iop_x:=0;
  72. end;
  73.  
  74. { - - - - - - - - - - - - - - - - - - - }
  75.  
  76. procedure iop_outc( c :char);
  77. begin
  78.   iop_buf[iop_x] := c;
  79.   iop_x := iop_x + 1;
  80.   if iop_x > iop_bufsize then iop_outflush;
  81. end;
  82.  
  83. { - - - - - - - - - - - - - - - - - - - }
  84.  
  85. procedure iopipe_out(c :char);
  86. begin
  87.  
  88.   if conio_wanted then bios(3,ord(c));
  89.   if iop_wanted then iop_outc(c);
  90. end;
  91.  
  92. { - - - - - - - - - - - - - - - - - - - }
  93.  
  94. procedure iop_close;
  95. begin
  96.  
  97.   iop_outc(^Z);
  98.   iop_outflush;
  99.   close(iop_file);
  100.  
  101.   iop_wanted:=false;
  102. end;
  103.  
  104. { - - - - - - - - - - - - - - - - - - - }
  105.  
  106. procedure iop_open( iop_fname : anystring );
  107. begin
  108.  
  109.   assign(iop_file, iop_fname);
  110.   rewrite(iop_file);
  111.  
  112.   iop_wanted := true;
  113.   conoutptr  := addr(iopipe_out);
  114.  
  115.   conio_wanted:=true;
  116.   iop_x:=0;
  117. end;
  118.  
  119. { = = = = = = = = = = = = = = = = = = = }
  120.  
  121.  
  122. {  Example Code  }
  123.  
  124. var
  125.    line    : string[80];
  126.     i,j,k  : integer;
  127.  
  128. begin
  129.   write('Name of log file: ');
  130.   readln(line);
  131.   iop_open(line);
  132.   i := 0;
  133.  
  134.   repeat
  135.     i := i + 1;
  136.  
  137.     write('Prompt ',i:2,': ');
  138.     readln(line);
  139.  
  140.   until length(line) = 0;
  141.  
  142.   iop_close;
  143.  
  144. end.
  145.