Форум: "Начинающим";
Текущий архив: 2009.09.27;
Скачать: [xml.tar.bz2];

Вниз

Помогите сделать поиск всех папок в папке   Найти похожие ветки 

← →
Bruth   (2009-07-22 13:45) [0]

именно папок а не файлов.

Файлов я нашел пример как делать:

SendMessage(ListBox1.Handle,LB_DIR,DDL_READWRITE,LongInt(PChar("content/*.*")));

это заносит в листбокс все файлы в папке контент а как найти каталоги в этой папке?

---

← →
Anatoly Podgoretsky ©   (2009-07-22 13:48) [1]

> Bruth  (22.07.2009 13:45:00)  [0]

FindFirst/Next

---

← →
Palladin ©   (2009-07-22 13:54) [2]

http://www.delphimaster.ru/cgi-bin/faq.pl?look=1&id=1015254946&n=19

---

← →
{RASkov} ©   (2009-07-22 20:15) [3]

> [0] Bruth   (22.07.09 13:45)

DDL_DIRECTORY

---

← →
Kolan ©   (2009-07-23 16:52) [4]

unit KScanDirectory;

interface
uses
 SysUtils, Classes, ShellAPI;

 procedure ScanDirectory(Directory: string; ScanSubFolders: Boolean;
   Strings: TStrings; Extension: string; FileName: string;
   RecursionCount: Integer; SeachOnlyDirectorys: Boolean = False);

 procedure CopyDirectoryTree(AHandle: THandle;
   AFromDir, AToDir: string);

 procedure CopyFile(AHandle: THandle;
   AFromFileName, AToFileName: string);
implementation

procedure ScanDirectory(Directory: string; ScanSubFolders: Boolean;
   Strings: TStrings; Extension: string; FileName: string;
   RecursionCount: Integer; SeachOnlyDirectorys: Boolean = False);
var
 CurrentFile: TSearchRec;
begin
 Directory := IncludeTrailingPathDelimiter(Directory);
 if Assigned(Strings) and DirectoryExists(Directory) then
 begin
   try
     if FindFirst(Directory + "*.*", faAnyFile, CurrentFile) = 0 then
     begin
       repeat
         if (CurrentFile.Name <> ".") and (CurrentFile.Name <> "..") then
         begin
           if ((CurrentFile.Attr and faDirectory) <> 0) and ScanSubFolders then
             ScanDirectory(Directory+CurrentFile.Name, ScanSubFolders, Strings,
               Extension, FileName, RecursionCount + 1, SeachOnlyDirectorys);
            if (Extension = "") or (ExtractFileExt(CurrentFile.Name) = Extension) then
              if (FileName = "") or (FileName = CurrentFile.Name) then
                if (not SeachOnlyDirectorys) or ((CurrentFile.Attr and faDirectory) <> 0) then
                  Strings.Add(Directory+CurrentFile.Name)
         end;
       until FindNext(CurrentFile) <> 0;
     end;
   finally
     FindClose(CurrentFile);
   end;
 end;
end;

procedure CopyDirectoryTree(AHandle: THandle; AFromDir,
 AToDir: string);
var
 SHFileOpStruct: TSHFileOpStruct;
begin
 with SHFileOpStruct do
 begin
   Wnd := AHandle;
   wFunc := FO_COPY;
   {Про #0 не надо забывать.}
   pFrom := PChar(AFromDir+ #0);
   pTo := PChar(AToDir+ #0);
   fFlags := FOF_NOCONFIRMATION;
   fAnyOperationsAborted := False;
   hNameMappings := nil;
   lpszProgressTitle := nil;
 end;
 SHFileOperation(SHFileOpStruct);
end;

procedure CopyFile(AHandle: THandle;
 AFromFileName, AToFileName: string);
begin
 CopyDirectoryTree(AHandle, AFromFileName,
   AToFileName);
end;

end.


---

Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2009.09.27;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.46 MB
Время: 0.004 c