usuwanie katalogow - sprawdzcie co jest nie tak

0

Witam, napisalem procedurke ktora powinna usuwac katalogi. Fakt jest taki ze katalogi mozna usuwac tylko gdy sa puste w srodku ( trzeba wczesniej usunac wszystko co sie w nich znajduje) komenda rmdir (sciezka). Bez rekurencji sie tu nie obedzie i wiem ze na niej sie wlasnie wylozylem :]. Ok zamieszczam kodzik, jesli mozecie to napiszcie mi co w nim jest zle, tzn wiem ze cos skrzaczylem z ta rekurencja, ale jesli ktos wie co to niech napisze :).

procedure UsunKatalog (zrodlo : string);
var
 SR: TSearchRec;
 Fik : integer;
begin
 zrodlo := zrodlo + '\';
 Fik := FindFirst( zrodlo + '*.*', faArchive + faVolumeID	+ faSysFile + faHidden, SR);
  while (Fik = 0) do                   // usun pliki
   begin
    DeleteFile (zrodlo + sr.Name);
    Fik := FindNext(SR);
   end;
 Fik := FindFirst( zrodlo + '*.*', faReadOnly , SR);
  while (Fik = 0) do
   begin                                 // usun pliki ktore sa tylko do odczytu  i nie da sie 
    SetFileAttributes(PChar(zrodlo + sr.Name), $00000020	); // usunac ich 
    DeleteFile (zrodlo + sr.Name);                                           // powyzsza metoda
    Fik := FindNext(SR);
   end;
 Fik := FindFirst( zrodlo + '*.', faDirectory, SR);
 Fik := FindNext(SR);  // pomin dwa pierwsze katalogi : ".\" i "..\"
 Fik := FindNext(SR);
  while (Fik = 0) do
   begin                             // jesli istnieja to wejdz do podkatalogow i usun pliki
    UsunKatalog (zrodlo + sr.Name); // no i rekurencja :D
    Fik := FindNext(SR);
   end;
 FindClose(SR);
 rmdir(zrodlo);   // po kompilacji blad zawsze wskazuje mi na ta linijkie
end;

Ok jesli wiecie co tu jest nie tak to piszcie.

0

nie wiem ale tu masz źródło z mojego starego programu:

procedure skasujFolder(dir:string);
var files:TSearchRec;
begin
 {$I-}
 if FindFirst(dir+'\*.*',39,files)=0 then repeat
  if (files.Attr and 16)=0 then begin
   FileSetAttr(dir+'\'+files.Name,32);
   DeleteFile(dir+'\'+files.Name);
  end;
 until FindNext(files)<>0;
 FindClose(files);
 if FindFirst(dir+'\*.*',55,files)=0 then repeat
  if (files.Attr and 16)<>0 then begin
   if (files.Name<>'.') and (files.Name<>'..') then begin
   skasujFolder(dir+'\'+files.Name);
   end;
  end;
 until FindNext(files)<>0;
 FindClose(files);
 FileSetAttr(dir,16);
 RmDir(dir);
 IOResult;
 {$I+}
end;

// aha no to nie tak jest to że masz backslasha w zmiennej którą dajesz do procki RmDir a nie może tak być

0

korzystając z funkcji API można chyba prościej, ale nie sprawdzałem czy działa :] :

uses ShellApi;


function Kasuj(folder: string):boolean;
var
  R : TSHFileOpStruct;
begin
 with R do
 begin
  Wnd:=Handle;
  wFunc:=FO_DELETE;
  pFrom:=Pchar(Folder+#0+#0) ;
 end;
 result := SHFileOperation(R)=0;
end;

1 użytkowników online, w tym zalogowanych: 0, gości: 1