Código:
procedure TForm1.BorrarDirectorios(Sender: TObject);
var ListDirCol,ListDirCur:TstringList;
ErrorBuscando, n, e:integer;
NomDir, DirCol, DirCurs, Path, Path2: string;
AtributArchiv: TSearchRec;
begin
path:= StrSourceDir ;
ListDirCol := TStringList.Create;
ErrorBuscando:= findFirst(Path + 'coleg*',faDirectory,AtributArchiv);
while ErrorBuscando = 0 do
begin
NomDir:= extractFileName(AtributArchiv.name);
ListDirCol.add(NomDir);
ErrorBuscando:= findnext(AtributArchiv);
end;
ListDirCur := TStringList.Create;
for n:= 0 to ListDirCol.count - 1 do
begin
DirCol:= ListDirCol.strings[n]; //se saca el directorio del cole
// y se busca el dir del curso academico
ErrorBuscando:= findFirst(Path + DirCol + '\C*',faDirectory,AtributArchiv);
while ErrorBuscando = 0 do // ej.: C004/005
begin
NomDir:= extractFileName(AtributArchiv.name);
ListDirCur.add(NomDir);
ErrorBuscando:= findnext(AtributArchiv);
end;
for e:= 0 to ListDirCur.count - 1 do
begin
DirCurs:= ListDirCur.strings[e]; // se saca del dir del curso academico
path2:= Path + DirCol + '\' + DirCurs + '\'; // ej.: C004005
if DirExist(path2 + 'Cast') then
BorraDir(path2 + 'Cast');
if DirExist(path2 + 'Val') then
BorraDir(Path2 + 'Val');
ChDir(path);
path2:= path + DirCol + '\' + DirCurs;
BorraDir(Path2);
end;
end;
FindClose(AtributArchiv);
ListDirCol.free; // se libera la mem utilizada x ListDirCol, ListDirCur
ListDirCur.free;
end;
Previamente se han borrado todos los archivos del programa.
Después intenta borrar los directorios vacíos, comenzando por los de nivel más bajo.
No se produce ningún error porque los deshabilito con {$I-} pero no se borran los subdirectorios.
Los niveles de directorios son:
-Directorio del programa (en él está el desinstalador. Es el único que no se debe borrar)
-COLEG1 (Directorio hijo)
-C004005 (Dir hijo de coleg1)
-CAST, VAL (dir hijos de C004005)
Un saludo