rmcvsdir.pp 1.2 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152
  1. uses
  2. sysutils;
  3. procedure deltree(const dirname : string);
  4. var
  5. rec : tsearchrec;
  6. begin
  7. writeln('Deleting ',dirname);
  8. if findfirst(dirname+'/*.*',faanyfile,rec)=0 then
  9. begin
  10. repeat
  11. if (rec.attr and fadirectory)<>0 then
  12. begin
  13. if (rec.name<>'.') and (rec.name<>'..') then
  14. deltree(dirname+'/'+rec.name)
  15. end
  16. else
  17. deletefile(dirname+'/'+rec.name);
  18. until findnext(rec)<>0;
  19. findclose(rec);
  20. end;
  21. rmdir(dirname);
  22. end;
  23. procedure searchcvsdir(const dirname : string);
  24. var
  25. rec : tsearchrec;
  26. begin
  27. writeln('Searching ',dirname);
  28. if findfirst(dirname+'/*.*',faanyfile,rec)=0 then
  29. begin
  30. repeat
  31. if (rec.attr and fadirectory)<>0 then
  32. begin
  33. if rec.name='CVS' then
  34. deltree(dirname+'/CVS')
  35. else
  36. if (rec.name<>'.') and (rec.name<>'..') then
  37. searchcvsdir(dirname+'/'+rec.name)
  38. end;
  39. until findnext(rec)<>0;
  40. findclose(rec);
  41. end;
  42. end;
  43. begin
  44. searchcvsdir('.');
  45. end.