[603vvn]

Есть код который удаляет всё содержимое из указанной папки и саму папку, а мне нужно что бы саму папку он не удалял а только содержимое, помогите пожалуйста.

Заранее благодарен!!!.

Код:

function MyRemoveDir(sDir : string) : Boolean;
var
  iIndex: Integer;
  SearchRec: TSearchRec;
  sFileName: string;
begin
  Result := False;
  sDir := sDir + '\*.*';
  iIndex := FindFirst(sDir, faAnyFile, SearchRec);

  while iIndex = 0 do
  begin
    sFileName := ExtractFileDir(sDir)+'\'+SearchRec.name;
    if SearchRec.Attr = faDirectory then
    begin
      if (SearchRec.name <> '' ) and (SearchRec.name <> '.') and
      (SearchRec.name <> '..') then
        MyRemoveDir(sFileName);
    end
    else
    begin
      if SearchRec.Attr <> faArchive then
        FileSetAttr(sFileName, faArchive);
      if not DeleteFile(sFileName) then
        ShowMessage('Could NOT delete ' + sFileName);
    end;
    iIndex := FindNext(SearchRec);
  end;

  FindClose(SearchRec);
  RemoveDir(ExtractFileDir(sDir));
  Result := True;
end;

[Rjkzy]

убери RemoveDir(ExtractFileDir(sDir));

[603vvn]

Сообщение от Rjkzy

убери RemoveDir(ExtractFileDir(sDir));

Уже побывал, но тогда удаляются только файлы, а папки остаются

[Black Raider]

железобетонный вариант:
после очистки создай заного каталог и все.

либо передавай в функцию еще один параметр, имя главной директории которую удалять не нужно и
проверяй если sDir<>MainsDir то RemoveDir(ExtractFileDir(sDir));

[Rjkzy]

Сообщение от Black Raider

железобетонный вариант:
после очистки создай заного каталог и все.

либо передавай в функцию еще один параметр, имя главной директории которую удалять не нужно и
проверяй если sDir<>MainsDir то RemoveDir(ExtractFileDir(sDir));

+1 к логике

[603vvn]

Сообщение от Black Raider

железобетонный вариант:
после очистки создай заного каталог и все.

либо передавай в функцию еще один параметр, имя главной директории которую удалять не нужно и
проверяй если sDir<>MainsDir то RemoveDir(ExtractFileDir(sDir));

Заново каталог, я уже думал, но на папку стоят определённые права и это не подходит.

А вот по подробней про функцию которую передать необходимо не могли бы рассказать?

[Black Raider]

теперь при первом вызове функции передавай 2-а параметра.
должно сработать.
только один минус у этого варианта, если имя подпапки будет такое же он ее оставит.

Код:

function MyRemoveDir(sDir,noDelDir : string) : Boolean;
var
  iIndex: Integer;
  SearchRec: TSearchRec;
  sFileName: string;
begin
  Result := False;
  sDir := sDir + '\*.*';
  iIndex := FindFirst(sDir, faAnyFile, SearchRec);

  while iIndex = 0 do
  begin
    sFileName := ExtractFileDir(sDir)+'\'+SearchRec.name;
    if SearchRec.Attr = faDirectory then
    begin
      if (SearchRec.name <> '' ) and (SearchRec.name <> '.') and
      (SearchRec.name <> '..') then
        MyRemoveDir(sFileName,noDelDir);
    end
    else
    begin
      if SearchRec.Attr <> faArchive then
        FileSetAttr(sFileName, faArchive);
      if not DeleteFile(sFileName) then
        ShowMessage('Could NOT delete ' + sFileName);
    end;
    iIndex := FindNext(SearchRec);
  end;

  FindClose(SearchRec);
  if sDir<>noDelDir then 
  RemoveDir(ExtractFileDir(sDir));
  Result := True;
end;

[603vvn]

Всем спасибо за попытку помочь!!! Уже разобрался Вот выложу код может кому нибудь пригодится: необходимо было добавить строку, за что огромное спасибо Black Raider.

Код:

function MyRemoveDir(sDir : string) : Boolean;
var
  iIndex: Integer;
  SearchRec: TSearchRec;
  sFileName: string;
begin
  Result := False;
  sDir := sDir + '\*.*';
  iIndex := FindFirst(sDir, faAnyFile, SearchRec);

  while iIndex = 0 do
  begin
    sFileName := ExtractFileDir(sDir)+'\'+SearchRec.name;
    if SearchRec.Attr = faDirectory then
    begin
      if (SearchRec.name <> '' ) and (SearchRec.name <> '.') and
      (SearchRec.name <> '..') then
        MyRemoveDir(sFileName);
    end
    else
    begin
      if SearchRec.Attr <> faArchive then
        FileSetAttr(sFileName, faArchive);
      if not DeleteFile(sFileName) then
        ShowMessage('Could NOT delete ' + sFileName);
    end;
    iIndex := FindNext(SearchRec);
  end;

  FindClose(SearchRec);
  
  If sDir <> MainsDir then

  RemoveDir(ExtractFileDir(sDir));
  Result := True;
end;

[Black Raider]

да не за что.
только если подпапка будет с именем главной папки она не удалится.
поэтому лучше все таки создавать снова