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

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Для новичков > помогите с openddialog

Автор: Departed 18.3.2008, 16:46

как сделать чтобы, тыкаешь на папку в опендиалоге и выдается список хранящихся в ней файлов. Т.е. не открывать по 1 или нескольким файлам, а тупо все файлы хранящиеся в папке

Автор: Rennigth 18.3.2008, 16:56

С OpenDialog-ом не получиться. Используй сначала диалог выбора диолога. Для версий делфей
>bds2005 можешь использовать такую функцию(вроде из дркб):

Код


function GetSelectDirectory(AHandle: Cardinal = 0): string;
var
  TitleName : string;
  lpItemID : PItemIDList;
  BrowseInfo : TBrowseInfo;
  DisplayName : array[0..MAX_PATH] of char;
  TempPath : array[0..MAX_PATH] of char;
begin
  Result := '';
  FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
  
  if AHandle = 0 then
  begin
    if Assigned(Application.MainForm) then
      BrowseInfo.hwndOwner := Application.MainForm.Handle;
  end else
    BrowseInfo.hwndOwner := AHandle;

  BrowseInfo.pszDisplayName := @DisplayName;
  TitleName := 'Âûáåðèòå äèðåêòîðèþ';
  BrowseInfo.lpszTitle := PChar(TitleName);
  BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;
  lpItemID := SHBrowseForFolder(BrowseInfo);
  if Assigned(lpItemId) then
  begin
    SHGetPathFromIDList(lpItemID, TempPath);
    GlobalFreePtr(lpItemID);
    Result := TempPath;
  end;
end;

Для делфей выше вроде есть уже стандартные диалоги.

Далее при получении директории проходимся по ней FindFirst/FindNext/FindClose.

Автор: THandle 18.3.2008, 17:36

Вот примерчик, думаю как раз то что и требуется. Выводит по нажатию кнопки имена всех файлов в Memo из выбранного каталога, не заходя в поддиректории.

Код


procedure ListFiles(Dir: string; Strings: TStrings);
var
  rSearchRec: TSearchRec;
begin
  if not Assigned(Strings) then
    Exit;
  Dir := IncludeTrailingBackslash(Dir);
  if FindFirst(Dir + '*.*', faAnyFile, rSearchRec) = 0 then
    repeat
      if ((rSearchRec.Name <> '.') and (rSearchRec.Name <> '..')) then
        if rSearchRec.Attr <> faDirectory  then
          Strings.Add(rSearchRec.Name);
    until FindNext(rSearchRec) <> 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Dir : string;
begin
  SelectDirectory('Вывести имена файлов из каталога:', '', Dir);
  if Dir <> '' then
     ListFiles(Dir, Memo1.Lines);
end;

Добавлено через 24 секунды
ЗЫ: еще в Uses надо добавить FileCTRL.

Автор: Rennigth 18.3.2008, 18:19

THandle, где FindClose? smile

Автор: lukas 18.3.2008, 18:21

без FindClose не удалишь папку пока не закроешь программу )) smile

Автор: VICTAR 18.3.2008, 18:43

Цитата

if rSearchRec.Attr <> faDirectory then

опять двадцать пять smile

Автор: Rennigth 18.3.2008, 19:01

VICTAR, ты про то что надо так:

Код


(rSearchRec.Attr and faDirectory) = 0

?
Просто сам тонкостей не помню, кроме этой smile

Автор: VICTAR 18.3.2008, 19:24

Rennigth, именно.
За последнюю неделю-две уже раз третий обсуждаем этот момент.
И как видно все бесполезно...

Автор: THandle 18.3.2008, 19:49

VICTAR, да, сорь. У меня просто в папочке на омпе старый вариант лежит, поэтому он тут и есть. Сча исправлю. smile

Исправил

Код


procedure ListFiles(Dir: string; Strings: TStrings);
var
  rSearchRec: TSearchRec;
begin
  if not Assigned(Strings) then
    Exit;
  Dir := IncludeTrailingBackslash(Dir);
  if FindFirst(Dir + '*.*', faAnyFile, rSearchRec) = 0 then
    repeat
      if ((rSearchRec.Name <> '.') and (rSearchRec.Name <> '..')) then
        if (rSearchRec.Attr and faDirectory) = 0  then
          Strings.Add(rSearchRec.Name);
    until FindNext(rSearchRec) <> 0;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
  Dir : string;
begin
  SelectDirectory('Вывести имена файлов из каталога:', '', Dir);
  if Dir <> '' then
     ListFiles(Dir, Memo1.Lines);
end;

Автор: VICTAR 18.3.2008, 20:03

Цитата(THandle @ 18.3.2008, 19:49

)

У меня просто в папочке на омпе старый вариант лежит,

Автор: THandle 18.3.2008, 20:22

VICTAR, изменил, изменил, не беспокойся smile

Кстати, вот сейчас эту нашу частообсуждаемую тему в ФАке нашел:
http://forum.vingrad.ru/faq/topic-156479.html

Правда там неплохо было бы подредактировать:

Вместо

Код


if Dir<>'' then if Dir[length(Dir)]<>'\' then Dir:=Dir+'\';

сделать

Код


Dir := IncludeTrailingBackslash(Dir);

Поднимать такую старую тему из подобного пустяка нет смысла, но может быть кто-нибудь из модераторов подредактирует?
А потом на этот вопрос смело всех посылать в ту тему?

Автор: Rennigth 19.3.2008, 10:55

Цитата(Rennigth @ 18.3.2008, 18:19

)

THandle, где FindClose?

Цитата(THandle @ 18.3.2008, 19:49

)

Исправил

???

порчу нашлю!!! smile

шутка...

Автор: THandle 19.3.2008, 14:52

Rennigth,

Ладно, пусть будет и FindClose, только порчи не надо smile

Боюсь как бы нас тут не забанили за разведение флуда.

Код


procedure ListFiles(Dir: string; Strings: TStrings);
var
  rSearchRec: TSearchRec;
begin
  if not Assigned(Strings) then
    Exit;
  Dir := IncludeTrailingBackslash(Dir);
  if FindFirst(Dir + '*.*', faAnyFile, rSearchRec) = 0 then
    repeat
      if ((rSearchRec.Name <> '.') and (rSearchRec.Name <> '..')) then
        if (rSearchRec.Attr and faDirectory) = 0  then
          Strings.Add(rSearchRec.Name);
    until FindNext(rSearchRec) <> 0;
  FindClose(rSearchRec); 
end;

Код


procedure TForm1.Button1Click(Sender: TObject);
var
  Dir : string;
begin
  SelectDirectory('Вывести имена файлов из каталога:', '', Dir);
  if Dir <> '' then
     ListFiles(Dir, Memo1.Lines);
end;

Хотя если FindFirst ничего не найдет, не понятно зачем вызывать повторно FindClose.

Автор: Rennigth 19.3.2008, 15:15

Цитата(THandle @ 19.3.2008, 14:52

)

Хотя если FindFirst ничего не найдет, не понятно зачем вызывать повторно FindClose.

А это добрые ребята из борландов о нас так заботяться smile

Тогда бы в FindNext бы по окончанию поика FindClose сделала... так нееет. Вообщем приходиться FindClose делать всегда, надо это или нет.

Автор: Departed 24.3.2008, 14:23

Всем спасио за советы)