home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 8 / CDASC08.ISO / VRAC / QUIETDDA.ZIP / QUIET.PAS < prev    next >
Pascal/Delphi Source File  |  1993-08-27  |  8KB  |  198 lines
  1. program silence_noisy_programs ;
  2. uses dos ;
  3. const
  4.      bufsize  = 16384;
  5.      progdata = 'QUIET- Free DOS utility: quiets noisy programs.';
  6.      progdat2 = 'V1.00: August 27, 1993. (c) 1993 by David Daniel Anderson - Reign Ware.';
  7.       usage   = 'Usage:  QUIET noisy_prog  {will OVERWRITE the file - use a backup!!!}';
  8.      outname = 'o$_$_$$!.DDA';
  9.      tmpname = 't$_$_$$!.DDA';
  10. type
  11.    buffer       = array [1..bufsize] of char;
  12. var
  13.    buf          : buffer ;
  14.    infile,
  15.    outfile      : file ;
  16.    bytesread,
  17.    byteswritten : word ;
  18.  
  19.    nextchar     : char ;
  20.  
  21.    checknext,
  22.    extra_char,
  23.    lastbyte     : boolean ;
  24.  
  25.    fdt          : longint ;
  26.  
  27.    dirinfo       : searchrec ;   { contains filespec info.    }
  28.    spath         : pathstr ;     { source file path,          }
  29.    sdir          : dirstr ;      {             directory,     }
  30.    sname         : namestr ;     {             name,          }
  31.    sext          : extstr ;      {             extension.     }
  32.    sfn, dfn, tfn : string [64];  { Source/ Dest/ Temp FileName, including dir }
  33.    filesdone     : array [1..512] of string [64];   { table of each dir+name  }
  34.    done          : boolean ;  { done is used so a file is not processed twice }
  35.                               { used with the array "filesdone" because a bug }
  36.                               { (in DOS I think) causes files to be selected  }
  37.                               { based on FAT placement, rather than name when }
  38.                               { wildcards are implemented.  The BUG allows    }
  39.                               { files to be done repeatedly, every time they  }
  40.                               { are encountered.                              }
  41.  
  42.    i, nmdone      : word ;    { i is a counter,  }
  43.                               { nmdone is number of files wrapped }
  44.  
  45.  
  46. procedure showhelp ( errornum : byte );
  47. var
  48.     message : string [80];
  49. begin
  50.     writeln ( progdata );
  51.     writeln ( progdat2 );
  52.     writeln ;
  53.     writeln ( usage );
  54.     writeln ;
  55.  
  56.     case errornum of
  57.       1 : message := 'you must specify -exactly- one filespec (wildcards are OK).';
  58.       2 : message := 'could not open the "noisy" file: ' + sfn + ' (may be read-only).';
  59.       3 : message := 'could not open the temp file (does ' + outname + ' already exist?).';
  60.       4 : message := 'the blockread procedure failed ( error reading "noisy" file: ' + sfn + '.';
  61.       5 : message := 'rename procedure failed, "quiet" file is ' + outname + '.';
  62.       6 : message := 'original file was read only, is renamed to ' + tmpname + '.';
  63.       7 : message := 'you cannot just specify a path, add "*.*" or "\*.*" for all files.';
  64.       8 : message := 'could not find any matching files.';
  65.     end;
  66.     writeln ( 'ERROR: (#',errornum,') - ', message );
  67.     halt ( errornum );
  68. end;
  69.  
  70. procedure openfiles(var ofl, nfl : file; name1, name2 : string);
  71. begin
  72. {$i-}
  73.      assign ( ofl, name1 );
  74.      reset ( ofl,1 );
  75.      if ioresult <> 0 then
  76.         showhelp (2);                          { unable to open ??? }
  77.  
  78.      assign ( nfl, name2 );
  79.      reset ( nfl );
  80.      if ( ioresult <> 0 ) then begin       {  if file does -NOT- exist  }
  81.         rewrite ( nfl,1 );                 { yet, it is save to proceed }
  82.         if ioresult <> 0 then                  { unable to open ??? }
  83.            showhelp (3) ;
  84.      end
  85.      else
  86.         showhelp (3) ;
  87. {$i+}
  88. end;
  89.  
  90. procedure quietbuf ( var bufr : buffer; var chknext : boolean ; var noises : word );
  91. const
  92.      noisea  = 'µ';
  93.      noiseb  = 'a';
  94.      NOPChar = 'É';
  95. var
  96.      bf_indx  : word ;
  97. begin
  98.      for bf_indx := 1 to ( sizeof ( bufr ) - 1 ) do
  99.          if ( ( bufr [ bf_indx ]    = noisea ) and
  100.               ( bufr [ bf_indx +1 ] = noiseb ) ) then begin
  101.  
  102.                 noises := noises + 1 ;
  103.                 bufr [ bf_indx ]    := NOPChar;
  104.                 bufr [ bf_indx +1 ] := NOPChar;
  105.          end;
  106.      chknext := ( bufr [ sizeof ( bufr ) ] = noisea );
  107. end;
  108.  
  109. procedure quietfile ( var infile, outfile : file );
  110. var
  111.      noises : word ;
  112. begin
  113.      noises := 0;
  114.      repeat
  115. {$i-}     blockread  ( infile, buf, bufsize, bytesread );   {$i+}
  116.           if ioresult <> 0 then
  117.              showhelp (4) ;
  118.           quietbuf ( buf, checknext, noises );
  119.  
  120.           if ( checknext and ( not eof ( infile ))) then begin
  121.              blockread ( infile, nextchar, 1 );
  122.              extra_char := true ;
  123.              if nextchar = 'a' then begin
  124.                 noises := noises + 1 ;
  125.                 buf [ sizeof ( buf ) ] := 'É';
  126.                 nextchar := 'É';
  127.              end;
  128.           end
  129.           else extra_char := false ;
  130.  
  131.           blockwrite ( outfile, buf, bytesread, byteswritten );
  132.           if extra_char then
  133.              blockwrite ( outfile, nextchar, 1 );
  134.           lastbyte := (( bytesread = 0 ) or ( bytesread <> byteswritten ));
  135.      until lastbyte ;
  136.      writeln ( noises, ' noises found.' );
  137. end;
  138.  
  139.  
  140. begin  { MAIN }
  141.      if paramcount <> 1 then showhelp (1);
  142.      nmdone := 1;                       { initialize number done to one since }
  143.                                     { count is incremented after process ends }
  144.  
  145.      for i := 1 to 512 do               { initialize array                    }
  146.          filesdone[i] := '';            { (I'm not sure if this is needed)    }
  147.  
  148.      spath := paramstr (1);             { source path is first parameter      }
  149.  
  150.   fsplit ( fexpand (spath),sdir,sname,sext); { break up path into components  }
  151.      if (sname = '') then               { - but quit if only a path and no    }
  152.          showhelp(7);                   { name is given                       }
  153.  
  154.      findfirst (spath, archive, dirinfo); { find the first match of filespec  }
  155.      if doserror <> 0 then
  156.         showhelp(8);
  157.  
  158.      while doserror = 0 do              { process all specified files         }
  159.      begin
  160.           sfn := sdir+dirinfo.name;    { should have dir info so we are not   }
  161.                                        { confused with current directory (?)  }
  162.                                       { IS needed for dest and temp filenames }
  163.  
  164.           done := false;               { initialize for each "new" file found }
  165.           for i := 1 to 512 do
  166.               if sfn = filesdone[i] then { check entire array to see if we    }
  167.               done := true;              { have done this file already        }
  168.  
  169.           if not done then begin        { if not, then                        }
  170.               filesdone[nmdone] := sfn; { say we have now                     }
  171.               dfn := sdir+outname;      { give both dest and                  }
  172.               tfn := sdir+tmpname;      {       and temp files unique names   }
  173.  
  174.               openfiles ( infile, outfile, sfn, dfn );
  175.               write ( 'Quieting ', sfn, ', ' );
  176.               quietfile ( infile, outfile );
  177.  
  178.               getftime ( infile, fdt );
  179.               setftime ( outfile, fdt );
  180.  
  181.               close (infile);           { close in                            }
  182.               close (outfile);          {   and out files                     }
  183.  
  184. {i-}
  185.               rename ( infile, tfn );   { rename in to temp and then   }
  186.               if ioresult <> 0 then
  187.                  showhelp (5);
  188.               rename ( outfile, sfn );  { out to in, thereby SWITCHING  }
  189.               erase ( infile );         { in with out so we can erase in (!)  }
  190.               if ioresult <> 0 then
  191.                  showhelp (6);
  192. {$i+}
  193.               nmdone := nmdone + 1;     { increment number processed          }
  194.           end;  { if not done }
  195.           findnext(dirinfo);            { go to next (until no more)          }
  196.      end;  { while }
  197. end.
  198.