paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-11 04:01:37 +02:00
Code Issues Packages Projects Releases Wiki Activity

* first version

Browse Source
This commit is contained in:
florian 2000-12-19 21:48:01 +00:00
parent 823b0277bc
commit 1aad3ddf9a
1 changed files with 52 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
utils/rmcvsdir.pp Normal file
View File

@ -0,0 +1,52 @@
uses
sysutils;
procedure deltree(const dirname : string);
var
rec : tsearchrec;
begin
writeln('Deleting ',dirname);
if findfirst(dirname+'/*.*',faanyfile,rec)=0 then
begin
repeat
if (rec.attr and fadirectory)<>0 then
begin
if (rec.name<>'.') and (rec.name<>'..') then
deltree(dirname+'/'+rec.name)
end
else
deletefile(dirname+'/'+rec.name);
until findnext(rec)<>0;
findclose(rec);
end;
rmdir(dirname);
end;
procedure searchcvsdir(const dirname : string);
var
rec : tsearchrec;
begin
writeln('Searching ',dirname);
if findfirst(dirname+'/*.*',faanyfile,rec)=0 then
begin
repeat
if (rec.attr and fadirectory)<>0 then
begin
if rec.name='CVS' then
deltree(dirname+'/CVS')
else
if (rec.name<>'.') and (rec.name<>'..') then
searchcvsdir(dirname+'/'+rec.name)
end;
until findnext(rec)<>0;
findclose(rec);
end;
end;
begin
searchcvsdir('.');
end.