Форум программистов [Powered by Invision Power Board]

Код

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.