IPB
ЛогинПароль:

> ВНИМАНИЕ!

Прежде чем задать вопрос, смотрите FAQ.
Рекомендуем загрузить DRKB.

Наладить общение поможет, если вы подпишитесь по почте на новые темы в этом форуме.

2 страниц V  1 2 >  
 Ответить  Открыть новую тему 
> работа с TShellListView и TShellTreeView, переход по папкам
сообщение
Сообщение #1


Пионер
**

Группа: Пользователи
Сообщений: 111
Пол: Мужской
Реальное имя: Рома

Репутация: -  0  +


подскажите плз как осуществляется работа с TShellListView и TShellTreeView, конкретнее - необходимо указать директорию, у которой в нутри есть папки, для каждой из них сделать проверку SelectedFolder.SubFolders, если подпапок нет - совершить какое-либо действие, если же есть - то уйти вниз ещё на уровень и снова совершить предыдущее действие. Тоесть например:
Изображение
в папке Black Lagoon ещё 2 папки в каждой из которых уже нет подпапок
а в папке !new1 есть ещё подпапки, в которых тоже могут быть подпапки
Подскажите или киньте ссылку на толковый мануал плиз smile.gif


--------------------
Цитата
          .     .
           \__/
          (**)
(>:=:=:~~ 
  ^ ^ ^ ^ 

Креветка присваивания :DDD
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Пионер
**

Группа: Пользователи
Сообщений: 52
Пол: Мужской
Реальное имя: Александр

Репутация: -  1  +


рекурсия


--------------------
With best regards, Better Kind
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Пионер
**

Группа: Пользователи
Сообщений: 111
Пол: Мужской
Реальное имя: Рома

Репутация: -  0  +


ммм я наверно оч туманно выразился ^__^ проблема в навигации - в TShellListView есть back, она вверх на уровень идёт, а вот как заставить его войти в папку?...


--------------------
Цитата
          .     .
           \__/
          (**)
(>:=:=:~~ 
  ^ ^ ^ ^ 

Креветка присваивания :DDD
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Пионер
**

Группа: Пользователи
Сообщений: 111
Пол: Мужской
Реальное имя: Рома

Репутация: -  0  +


хмм ладно - а если у меня есть такой код
Код
  if (Lw.Selected.SubItems[5] = 'dir') then begin
    Edit.Text := Edit.Text + Lw.Selected.Caption + '\';
    AddFile(Edit.Text + '*.*', faAnyFile);
  end;

AddFile расшаривает все файлы в директории указанной в эдите
Как модифицировать эту процедуру чтобы она делала обход всех папок?
я пробовал делать так
Код
  for i := 0 to Lw.Items.Count do begin
    lw.Selected := lw.Items.Item[i];

но так не хочет...


--------------------
Цитата
          .     .
           \__/
          (**)
(>:=:=:~~ 
  ^ ^ ^ ^ 

Креветка присваивания :DDD
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Гость






Цитата
  if (Lw.Selected.SubItems[5] = 'dir') then begin
Это чего? blink.gif А если будет не пятая колонка, а шестая, будешь переделывать?

Ты об этом, что-ли:
procedure AddFile(path: string);
var SearchRec:TSearchRec;
begin
if path[length(path)] <> '\' then path := path + '\';

if FindFirst(path + '*.*', faAnyFile, SearchRec) = 0 then
repeat
if (SearchRec.Name = '.') or (SearchRec.Name = '..') then continue;
if SearchRec.Attr and faDirectory <> 0 then begin
AddFile(path + SearchRec.name)
end
else begin
Form1.Memo2.Lines.Add(path + SearchRec.name); // Для теста - просто вывел имена файлов ...
end;
until FindNext(SearchRec) <> 0;
end;

procedure TForm1.Button11Click(Sender: TObject);
begin
if ShellListView1.SelectedFolder.IsFolder then begin // Вообще-то этого достаточно
AddFile(ShellListView1.SelectedFolder.PathName);
end;
end;

 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Пионер
**

Группа: Пользователи
Сообщений: 111
Пол: Мужской
Реальное имя: Рома

Репутация: -  0  +


volvo
домо аригато ^__^ опять спас smile.gif

нащёт пяти - это я с книги брал и тупо переписал :[ вернее я не так понял что там написано было - думал чтото типа параметра файла который отвечает за папку, и недоумевал почему его назвали сабитемс smile.gif



--------------------
Цитата
          .     .
           \__/
          (**)
(>:=:=:~~ 
  ^ ^ ^ ^ 

Креветка присваивания :DDD
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Пионер
**

Группа: Пользователи
Сообщений: 111
Пол: Мужской
Реальное имя: Рома

Репутация: -  0  +


а вот такой вопросик - есть вот такая структура папки
ИзображениеИзображение
в папке субтитров файлы на картинке справа
у меня стоит такая проверка для учёта папки
  if (pos('.avi', SearchRec.Name))or(pos('.mkv', SearchRec.Name))or(pos('.VOB', SearchRec.Name))
or(pos('.ogm', SearchRec.Name))or(pos('.mp4', SearchRec.Name)) <> 0 then inc(vcount);


if (pos('.avi', SearchRec.Name) <> 0) and (pos('avi', Form1.Grid.Cells[4,gridcell-1]) = 0) then
begin
if Form1.Grid.Cells[4,gridcell-1] = '' then
begin
Image(path);
PathList.Add(path);
infill(path, AType);
end;
Form1.Grid.Cells[4,gridcell-1] := Form1.Grid.Cells[4,gridcell-1] + 'avi ';
end;

ну есессно так для каждого формата
так вот - почему у меня не считается эта папка? sad.gif у меня тогда в отчёте выводится её картинка, но инфа о ней есессно не пишется и у меня все картинки сдвигаются(((
anime
зы и почему когда считываеш путь папки - если встречается символ # то начиная с него обрубается всё? sad.gif


--------------------
Цитата
          .     .
           \__/
          (**)
(>:=:=:~~ 
  ^ ^ ^ ^ 

Креветка присваивания :DDD
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Гость






Цитата
почему у меня не считается эта папка?
Что имеется в виду "не считается"? Папка появляется в Гриде, проверил. Количество видео-файлов в ней тоже появляется. Все ее подпапки тоже появляются, тоже проверил. Картинок не вижу никаких вообще, что именно у тебя "сдвигается" - непонятно.

Кстати,
1.
if
(pos('.avi', SearchRec.Name))or(pos('.mkv', SearchRec.Name))or(pos('.VOB', SearchRec.Name)) or
(pos('.ogm', SearchRec.Name))or(pos('.mp4', SearchRec.Name)) <> 0 then inc(vcount);

не совсем корректное условие. В данном случае оно, возможно, как раз и делает, что нужно, но вообще подобного следует избегать...

2.
if (pos('.avi', SearchRec.Name) <> 0) ...
все-таки я бы записал:
if UpperCase(ExtractFileExt(SearchRec.Name)) = 'AVI'
, мало ли, будет записано в другом регистре и все, не найдутся файлы...

3. Однотипные действия для разных расширений очень просто выносятся в отдельную процедуру...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Пионер
**

Группа: Пользователи
Сообщений: 111
Пол: Мужской
Реальное имя: Рома

Репутация: -  0  +


Цитата
Что имеется в виду "не считается"? Папка появляется в Гриде, проверил. Количество видео-файлов в ней тоже появляется. Все ее подпапки тоже появляются, тоже проверил. Картинок не вижу никаких вообще, что именно у тебя "сдвигается" - непонятно.

действительно в гриде есть... а в выходном хтмл файле нету... блин sad.gif
нащёт регистра - я тоже думал, изза этого проблема была с vob, просто незнал как сделать smile.gif
а нащёт однотипных действий - я просто ночью делал - лиш бы уж както сделать smile.gif буду потом потихоньку всё оптимизирувать smile.gif

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

ззы как ты и сказал - переделал всю процедуру так
Код

procedure VideoShare(path: string; SearchRec:TSearchRec);
var
  AType: TStringList;
  ext: string;
begin
  AType := TStringList.Create;

  if (UpperCase(ExtractFileExt(SearchRec.Name)) = '.AVI')or(UpperCase(ExtractFileExt(SearchRec.Name)) = '.MKV')
    or(UpperCase(ExtractFileExt(SearchRec.Name)) = '.VOB')or(UpperCase(ExtractFileExt(SearchRec.Name)) ='.OGM')
    or(UpperCase(ExtractFileExt(SearchRec.Name)) = '.MP4') then
    begin
      inc(vcount);
      ext := UpperCase(ExtractFileExt(SearchRec.Name));
      ext := copy(ext, 2, length(ext)-1);
  
      if pos(ext, Form1.Grid.Cells[4,gridcell-1]) = 0 then
      begin
        if Form1.Grid.Cells[4,gridcell-1] = '' then
        begin
          Image(path);
          PathList.Add(path);
          infill(path, AType);
        end;
        Form1.Grid.Cells[4,gridcell-1] := Form1.Grid.Cells[4,gridcell-1] + ext + ' ';
      end;
    end;

  AType.Free;
end;

правда теперь снова в гриде нет папки - а картинка её высвечивается в хтмлке sad.gif

Сообщение отредактировано: kr3v3tkus -


--------------------
Цитата
          .     .
           \__/
          (**)
(>:=:=:~~ 
  ^ ^ ^ ^ 

Креветка присваивания :DDD
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Гость






kr3v3tkus, извини, не мог пройти мимо твоего кода. Там есть небольшая проблема с обходом директорий... Смотри, как можно это сделать чуть-чуть по-другому (постараюсь прокомментировать, если что непонятно - спрашивай...):
type
T = (_avi, _mkv, _vob, _ogm, _mp4); // все доступные типы видео-файлов
setT = set of T; // это - для отображения типов, присутствующих в отдельной папке

TRecs = record // информация о папке - путь к ней, число видео-файлов, и их типы
path: string;
count: integer;
types: setT;
end;

// это - строковое представление типов видеофайлов - их расширения...
const
strT: array[T] of string = (
'.avi', '.mkv', '.vob', '.ogm', '.mp4'
);

// дин. массив для хранения информации о папках
var
arr: array of TRecs;

// А вот тут - самое интересное: добавляем в массив новый фолдер
procedure MyAddFolderToContainer(the_path: string);
begin
SetLength(arr, Length(arr) + 1);
with arr[Length(arr) - 1] do begin
path := the_path;
count := 0;
types := [];
end;
end;

// добавляем новый файл
procedure MyAddFileToContainer(path: string);
var
ext: string;
iT: T;
i: integer;
the_set: setT;
begin

// сначала находим индекс элемента с нужным path-ом к нему
for i := 0 to Pred(Length(arr)) do begin
if LowerCase(ExtractFilePath(path)) = LowerCase(arr[i].path)
then break;
end;

// затем проверяем, к какому типу относится файл
ext := LowerCase(ExtractFileExt(path));
for iT := Low(T) to High(T) do
if strT[iT] = ext then begin
Include(the_set, iT); break;
end;

// и если это видео (если бы было НЕ видео, то the_set был бы пустым),
// то изменяем статистику. Ну, и дополнительные действия тоже можешь
// делать здесь, я только вывожу информацию о папках и количестве файлов в них
if the_set <> [] then begin
inc(arr[i].count);
arr[i].types := arr[i].types + the_set;
end;
end;

// ну, и собственно - рекурсия, которая осуществляет проход по всем директориям...
procedure MyAddFolderToGrid(path: string);
var SearchRec: TSearchRec;
begin
MyAddFolderToContainer(IncludeTrailingPathDelimiter(path + SearchRec.name));

if FindFirst(path + '*.*', faAnyFile, SearchRec) = 0 then
repeat
if (SearchRec.Name = '.') or (SearchRec.Name = '..') then continue;

if (SearchRec.Attr and faDirectory) <> 0 then begin // нашли папку - добавляем ее в контейнер
MyAddFolderToGrid(IncludeTrailingPathDelimiter(path + SearchRec.name));
end
else begin // нашли файл - добавляем файл
MyAddFileToContainer(path + SearchRec.name);
end;

until FindNext(SearchRec) <> 0;
end;

procedure TForm1.StartClick(Sender: TObject);
var
i: integer;
iT: T;
begin
SetLength(arr, 0);

// теперь здесь: по нажатию кнопки заполняем контейнер информацией
MyAddFolderToGrid(IncludeTrailingPathDelimiter(Shell.SelectedFolder.PathName));

// здесь можно отсортировать контейнер по любому полю, сделать все что нужно
// ...

// а потом - выводим информацию в грид
for i := 0 to pred(Length(arr)) do begin
with arr[i] do begin
StringGrid1.Cells[1, StringGrid1.FixedRows + i] := path;
StringGrid1.Cells[2, StringGrid1.FixedRows + i] := IntToStr(count);
for iT := Low(T) to High(T) do begin
if iT in types then begin
StringGrid1.Cells[3, StringGrid1.FixedRows + i] :=
StringGrid1.Cells[3, StringGrid1.FixedRows + i] + strT[iT];
end;
end;
end;
end;
SetLength(arr, 0);
end;

 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Пионер
**

Группа: Пользователи
Сообщений: 111
Пол: Мужской
Реальное имя: Рома

Репутация: -  0  +


Цитата
извини, не мог пройти мимо твоего кода

да я тоже без судорог на него не мог смотреть smile.gif сортировку ваще не прецтавлял как делать - слишком поуродски получилось бы smile.gif
вроде просмотрел, всё более менее понятно кроме
Код
  T = (_avi, _mkv, _vob, _ogm, _mp4);

Код
  strT: array[T] of string = (
    '.avi', '.mkv', '.vob', '.ogm', '.mp4'
  );

вот чегот непонимаю зачем это? что вообще означает нижнее подчёркивание? unsure.gif


--------------------
Цитата
          .     .
           \__/
          (**)
(>:=:=:~~ 
  ^ ^ ^ ^ 

Креветка присваивания :DDD
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


Гость






Просто привычка, можешь без нижнего подчеркивания делать. Главное - чтобы имя не повторяло никаких зарезервированных слов и идентификаторов, а с подчеркиванием вероятность этого значительно уменьшается.

Цитата
чегот непонимаю зачем это?
Затем, что T - это пользовательский тип, переменные этого типа нельзя распечатывать, но можно из них создать множество. А strT - это константа, массив строк, которые можно печатать, но вот, скажем, множество из них (из строк, в смысле) уже сделать не получится. Я остановился на том, что лучше сделать массив, индексируемый моим перечислимым типом, чтобы иметь возможность создавать множество значений (экономия места и времени обработки), и в то же время сохранить возможность как-то визуализировать это множество...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


Пионер
**

Группа: Пользователи
Сообщений: 111
Пол: Мужской
Реальное имя: Рома

Репутация: -  0  +


блиин sad.gif вольв а мыж тут каждый раз обнуляем SetLength(arr, 0); а вдруг нужно посчитать в разных папках? если не обнулять то косяки получаются sad.gif


--------------------
Цитата
          .     .
           \__/
          (**)
(>:=:=:~~ 
  ^ ^ ^ ^ 

Креветка присваивания :DDD
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #14


Гость






Цитата
если не обнулять то косяки получаются
Это какие, например? Если обнулить при FormCreate и при FormDestroy, скажем - не должно быть косяков.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #15


Пионер
**

Группа: Пользователи
Сообщений: 111
Пол: Мужской
Реальное имя: Рома

Репутация: -  0  +


я имею ввиду: выбираем папку. делаем StartClick, вдруг надо на другом диске ещё папку обойти - мы снова делаем StartClick и тут получается что заново заполняются count и types


--------------------
Цитата
          .     .
           \__/
          (**)
(>:=:=:~~ 
  ^ ^ ^ ^ 

Креветка присваивания :DDD
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #16


Гость






Цитата
тут получается что заново заполняются count и types
Сорри, но "другой диск" - это значит "другой path", поэтому (если инициализировать arr не при нажатии "Start", а при старте формы, а удалять - при завершении приложения, или по какой-нибудь особой кнопке "Очистить"), все будет как положено - новые папки будут добавляться в контейнер.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #17


Пионер
**

Группа: Пользователи
Сообщений: 111
Пол: Мужской
Реальное имя: Рома

Репутация: -  0  +


ну вот у меня он на первый взгляд если по папке добавлять то ко всем types нижних элементов ещё свои прикручивает =\ просто тады поставлю обнуление types на новые файлы
зы хмм ток чёт немогу понять где -___-
Изображение
просто вот так получаеца если по папке добавлять

Сообщение отредактировано: kr3v3tkus -


--------------------
Цитата
          .     .
           \__/
          (**)
(>:=:=:~~ 
  ^ ^ ^ ^ 

Креветка присваивания :DDD
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #18


Гость






procedure TForm1.StartClick(Sender: TObject);
var
i: integer;
iT: T;
begin
// SetLength(arr, 0); - перенесено в FormCreate()

MyAddFolderToGrid(IncludeTrailingPathDelimiter(Shell.SelectedFolder.PathName));
for i := 0 to pred(Length(arr)) do begin
with arr[i] do begin
StringGrid1.Cells[1, StringGrid1.FixedRows + i] := path;
StringGrid1.Cells[2, StringGrid1.FixedRows + i] := IntToStr(count);
StringGrid1.Cells[3, StringGrid1.FixedRows + i] := ''; // <--- Вот это добавлено
for iT := Low(T) to High(T) do begin
if iT in types then begin
StringGrid1.Cells[3, StringGrid1.FixedRows + i] :=
StringGrid1.Cells[3, StringGrid1.FixedRows + i] + strT[iT];
end;
end;
end;
end;
// SetLength(arr, 0); - перенесено в FormDestroy()
end;
Ну, и процедуры стали методами класса формы:
    ...
private
{ Private declarations }
arr: array of TRecs;
procedure MyAddFolderToContainer(the_path: string);
procedure MyAddFileToContainer(path: string);
procedure MyAddFolderToGrid(path: string);
...

 К началу страницы 
+ Ответить 
сообщение
Сообщение #19


Пионер
**

Группа: Пользователи
Сообщений: 111
Пол: Мужской
Реальное имя: Рома

Репутация: -  0  +


блин sad.gif сори туплю - перенёс я в Private их и он не хочет( пишет
Цитата

[Error] MainUnit.pas(86): Undeclared identifier: 'arr'
[Error] MainUnit.pas(86): Incompatible types
[Hint] MainUnit.pas(35): Private symbol 'MyAddFolderToContainer' declared but never used

итд(((


--------------------
Цитата
          .     .
           \__/
          (**)
(>:=:=:~~ 
  ^ ^ ^ ^ 

Креветка присваивания :DDD
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #20


Гость






Ну, перенести-то заголовки перенес, а изменить в реализации:
procedure TForm1.MyAddFolderToGrid(path: string); // <---
...

и т.д.?
 К началу страницы 
+ Ответить 

2 страниц V  1 2 >
 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 23.10.2020 7:44
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name