home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / pctchnqs / 1990 / number3 / clone.pas < prev    next >
Pascal/Delphi Source File  |  1990-04-24  |  2KB  |  54 lines
  1. { CLONE.PAS -- Clone Directories with TDRF, by Tom Swan }
  2. {$M 2048, 0, 0}   {- Small stack, no heap }
  3. program clone;
  4. uses  dos;
  5. const batchFile = 'C:\CLONE@@@.BAT';
  6. var   originalPath : pathStr;
  7.       bf : text;  {- Batch file }
  8.  
  9. {---- Write TDRF commands to batch file bf }
  10. procedure preparePath;
  11. var   plainPath : pathStr;
  12. begin
  13.    plainPath := copy( fExpand( '.' ), 3, 255 );
  14.    if plainPath <> '\' then begin
  15.       writeln( bf, 'tdrf md ', plainPath );
  16.       writeln( bf, 'tdrf del ', plainPath, '\*.*' );
  17.       writeln( bf, 'tdrf t ', plainPath, '\*.* ', plainPath )
  18.    end { if }
  19. end; { preparePath }
  20.  
  21. {---- Walk through all paths from current directory }
  22. procedure readDirectory;
  23. var   sr : searchRec;
  24. begin
  25.    preparePath;
  26.    findFirst( '*.*', directory, sr );
  27.    while dosError = 0 do begin
  28.       if ( sr.name[ 1 ] <> '.' ) and
  29.          ( sr.attr and directory <> 0 ) then begin
  30.          chDir( sr.name ); {- Change to next level }
  31.          readDirectory;    {- Process files there }
  32.          chDir( '..' )     {- Return to previous level }
  33.       end; { if }
  34.       findNext( sr )
  35.    end { while }
  36. end; { readDirectory }
  37.  
  38. begin
  39.    getDir( 0, originalPath );
  40.    {$i-} chDir( paramStr( 1 ) ); {$i+}
  41.    if ioResult = 0 then begin
  42.       assign( bf, batchFile );
  43.       rewrite( bf );    {- Create new batch file }
  44.       readDirectory;    {- Write commands to batch file }
  45.       close( bf );      {- Close batch file before running }
  46.       exec( getEnv( 'COMSPEC' ), '/C ' + batchFile );
  47.       erase( bf );      {- Erase the batch file }
  48.       chDir( originalPath )
  49.    end else begin
  50.       writeln( 'Clone Directories with TDRF, by Tom Swan' );
  51.       writeln( 'Syntax: CLONE [-?] [pathName]' )
  52.    end { else }
  53. end.
  54.