Модераторы: Poseidon, Snowy, bems, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Удаление папок с сервера средствами Delphi 
V
    Опции темы
GrafCharodey
Дата 14.12.2006, 16:03 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 28
Регистрация: 14.12.2006

Репутация: нет
Всего: нет
Здравствуйте!

Хочу попросить о помощи. Я пишу программу для очистки фаилообменника на сервере. Программе даётся путь корня фаилообменика, она получает список папок первого уровня в нём, затем удаляет папки и всё их содержимое. После чего пользуясь списком создает папки заново уже пустыми. В принципе реализовать оказалось довольно легко, очищает прототип фаилообменика находящемся на моём диске, но когда решил протестировать на сервере, то он не смог удалить большинство папок. Если есть мысли на этот счёт, буду очень рад услышать. Приведу код функции удаления папок и их содержимого
Код

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 and faDirectory) = 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);
      DeleteFile(sFileName);
    end;
    iIndex := FindNext(SearchRec);
  end;
:

Заранее благодарен...
PM MAIL ICQ   Вверх
Matematik
Дата 14.12.2006, 16:19 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1027
Регистрация: 11.3.2006

Репутация: 17
Всего: 50
Замечания по коду.
1. SearchRec.name<>''  - это зачем?
2. Проверять надо, что возвращает DeleteFile()
И вообще я не вижу чтобы удалялись папки.
PM MAIL WWW ICQ   Вверх
Romikgy
Дата 14.12.2006, 16:20 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Любитель-программер
****


Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 26
Всего: 146
сними атрибуты скрытый и системный , и будут имхо все файлы удалятся


--------------------
Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности. 
smile
PM   Вверх
GrafCharodey
Дата 14.12.2006, 16:30 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 28
Регистрация: 14.12.2006

Репутация: нет
Всего: нет
Matematik, 
Цитата

1. SearchRec.name<>''  - это зачем?


Обеспечение поиска файлов в папке...

Цитата

Проверять надо, что возвращает DeleteFile()


Проверяю, возращает false, не может удалить...

Цитата

И вообще я не вижу чтобы удалялись папки. 



Поверь мне, они удаляются)) (по крайней мере с моего харда)



Romikgy, 

Цитата

сними атрибуты скрытый и системный , и будут имхо все файлы удалятся 


Да вроде бы не работает, всё убрано и общий доступ открыт...
PM MAIL ICQ   Вверх
Matematik
Дата 14.12.2006, 16:43 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1027
Регистрация: 11.3.2006

Репутация: 17
Всего: 50
GrafCharodey
Имя файла\директории не может ровнятся пустой строке.
В написанном коде проверок нет и папки не удаляются. Пиши весь код.
И атрибуты не надо снимать. Все нормально удаляется с ними, проверено на горьком опыте - удалил все файлы корня диска "c:"
PM MAIL WWW ICQ   Вверх
GrafCharodey
Дата 14.12.2006, 16:50 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 28
Регистрация: 14.12.2006

Репутация: нет
Всего: нет
Matematik, пишу весь код...

Код

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  FileCtrl,
  Classes;

procedure GetTreeDirs(Root: string; OutPaper: TStringList);
var
  i: Integer;
  s: string;

  procedure InsDirs(s: string; ind: Integer; Path: string; OPaper: TStringList);
  var
    sr: TSearchRec;
    attr: Integer;
  begin
    attr := 0;
    attr := faAnyFile;
    if DirectoryExists(Path) then
      if FindFirst(IncludeTrailingBackslash(Path) + '*.*', attr, SR) = 0 then
      begin
        repeat
          if ((sr.Attr and faDirectory) = faDirectory) and (sr.Name[Length(sr.Name)] <> '.') then
            OPaper.Insert(ind, s + sr.Name);
        until (FindNext(sr) <> 0);
        FindClose(SR);
      end
  end;

begin
  {Проверяем существуетли начальный каталог}
  if not DirectoryExists(Root) then
    exit;
  {Создаем список каталогов первой вложенности}
  if root[Length(Root)] <> '\' then
    InsDirs(root + '\', OutPaper.Count, Root, OutPaper)
  else
    InsDirs(root, OutPaper.Count, Root, OutPaper);
  i := 0;
end;

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 and faDirectory) = 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);
      DeleteFile(sFileName);
    end;
    iIndex := FindNext(SearchRec);
  end;

  FindClose(SearchRec);

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


var
  Strs: TStringList;
  i: integer;
  S: Tstrings;

begin
  { TODO -oUser -cConsole Main : Insert code here }

  Strs := TStringList.Create;
  try
    GetTreeDirs('I:\!TEST', Strs);
    for i := 0 to Strs.Count - 1 do
    begin
      MyRemoveDir(Strs.Strings[i]);
      CreateDir(Strs.Strings[i]);
    end;
  finally
    Strs.Free;
  end;
end.
 
PM MAIL ICQ   Вверх
GrafCharodey
Дата 15.12.2006, 09:07 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 28
Регистрация: 14.12.2006

Репутация: нет
Всего: нет
Matematik, скорее всего ты прав... Мне сделали тест на котором программа запарывается... Причём на обычных папках, используя систему многоуровневой вложености пустых папок... Если есть идеи по улучшению алгоритма, буду очень благодарен...
PM MAIL ICQ   Вверх
GrafCharodey
Дата 15.12.2006, 11:08 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 28
Регистрация: 14.12.2006

Репутация: нет
Всего: нет
Всем спасибо!!!
Проблему решил сам, использовал удаление директорий посредством API.
PM MAIL ICQ   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0473 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.