Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2005.11.27;
Скачать: [xml.tar.bz2];

Вниз

Поиск файлов.   Найти похожие ветки 

 
Tek Noise   (2005-11-06 14:32) [0]

Здравствуйте! Нашёл на просторах форума код.
Он не работает, выдвёт ошибку "Runtime error 216 at 00403DF8".
Мне собственно нужно, что бы программа искала заданную дирректорию(можно и фаил), и результат записывала в фаил. с записью проблем нету, а вот с поиском, и записью данных в переменную... Подскажите, что в нижеприведенном коде исправить. Спасибо!

program flist;

{$APPTYPE CONSOLE}

uses
Windows;

procedure Output(const FileName : String);
var
p : PChar;
begin
p := PChar(FileName);
CharToOEM(p, p);
WriteLn(p);
end;

procedure AddTrailingBackslash(var Str : String);
begin
if not (Str[length(Str)] in ["/", "\"]) then Str := Str + "\";
end;

procedure DoSearch(Directory : String; const SearchSubdirectories : Boolean);
var
fd : TWin32FindData;
h : Cardinal;
begin
AddTrailingBackslash(Directory);

Output("Поиск по директории: " + Directory);
h := FindFirstFile(PChar(Directory + "*"), fd);
if (h <> INVALID_HANDLE_VALUE) then begin
 repeat
  if (fd.cFileName[0] <> ".") and (fd.cFileName <> "..") then
   if ((fd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) then begin
    DoSearch(Directory + fd.cFileName, SearchSubdirectories);
   end else
    Output(fd.cFileName);
 until (FindNextFile(h, fd) = FALSE);
end;
end;

begin
DoSearch(ParamStr(1), true);
ReadLn;
end.


 
Набережных С. ©   (2005-11-06 15:14) [1]

procedure Output(const Data: String);
var
 Tmp: string;
begin
 SetLength(Tmp, Length(Data));
 CharToOEM(PChar(Data), PChar(Tmp));
 WriteLn(Tmp);
end;


 
Tek Noise   (2005-11-06 15:34) [2]

Набережных С. ©   (06.11.05 15:14) [1]

Спасибо за ответ, но всё равно программа не запускаеться, вылетает ошибка =/


 
Набережных С. ©   (2005-11-06 16:13) [3]

А, вот еще что:

begin
if ParamCount > 0 then DoSearch(ParamStr(1), true);
ReadLn;
end.


Но без параметра запускать бессмысленно, хотя эта проверка, конечно, должна быть.
Да, и надо бы после
until (FindNextFile(h, fd) = FALSE);
вызывать Windows.FindClose


 
Zeqfreed ©   (2005-11-06 17:46) [4]

Набережных С. ©   (06.11.05 16:13) [3]
Эх, всегда тороплюсь и что-нибудь забываю :(
(код мой :)


 
Tek Noise   (2005-11-06 17:53) [5]

Набережных С. ©   (06.11.05 16:13) [3]
Спасибо, теперь хотя бы невыводит ошибок %)

Zeqfreed ©   (06.11.05 17:46) [4]
Спасибо вам огромное за код! Немогли бы вы рассказать, как он рабатет в 2х словах =/ как параметр задавать?


 
sniknik ©   (2005-11-06 19:56) [6]

> (код мой :)
больше похоже на переделку чужого...
т.к.
параметр SearchSubdirectories в этой реализации смысла не имеет... (в оригинале видать был, но вырезан)
в условии  if (fd.cFileName[0] <> ".") and (fd.cFileName <> "..") then
у двух сравнений совершенна различна логика, т.е. если ты понимал зачем делаеш так как первом то зачем второе? (если переделывалось то понятно, непонял одно добавил другое лишнее, или наоборот понял,  переделал как лучше, но старое убрать забыл)

тоже переделал, надеюсь чуть лучше.
{$APPTYPE CONSOLE}

uses
 Windows;

function ToOem(const Str: String): String;
begin
 SetLength(result, Length(Str));
 CharToOem(PChar(Str), PChar(result));
end;

function AddBackslash(const Str: String): String;
begin
 if not (Str[length(Str)] in ["/", "\"]) then result:= Str + "\"
                                         else result:= Str;
end;

procedure DoSearch(const Directory: String; const SearchSub: Boolean);
var
 fd: TWin32FindData;
 h: THandle;
begin
 Writeln(ToOem("Поиск по директории: " + Directory));

 h:= FindFirstFile(PChar(Directory + "*"), fd);
 if (h <> INVALID_HANDLE_VALUE) then
 begin
   with fd do
     repeat
       if (dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY then
       begin
         if cFileName[0] = "." then Continue;
         if SearchSub then DoSearch(AddBackslash(Directory+cFileName), SearchSub);
       end else
         Writeln(ToOem(cFileName));
     until FindNextFile(h, fd) = FALSE;
   FindClose(h);
 end;
end;

begin
 if ParamCount > 0 then DoSearch(AddBackslash(ParamStr(1)), ParamCount >= 2);
 Readln;
end.


> как он рабатет в 2х словах
уложусь в одно - рекурсия.
хочеш подробностей ищи по этому слову.

> как параметр задавать?
в командной строке
flist.exe параметр параметр
первый параметр это диск/директория второй неважно что, просто по его присутствию сканируются подкаталоги.
т.е. так
flist.exe D:\
только файлы в корне диска D:\
а так
flist.exe D:\ скан
с файлы с вложенными каталогами.


 
Zeqfreed ©   (2005-11-06 20:51) [7]

sniknik ©   (06.11.05 19:56) [6]
Ну что я могу сказать. Имеет ли смысл оправдываться и с пеной у рта доказывать что я сам написано этот код? :) (Особенно если учесть, что он получился не весть какого качества..)

Ну, по крайней мере напишу пару слов:
SubDirectories действительно здесь не используется, просто по началу когда писал код (специально отвечал на вопрос, т.е. код написан практически "на коленке", просто с проверкой работоспособности в "полевых условиях" (читать: с последующей отладкой) при объявлении процедуры ввел этот параметр, но потом никак не отразил его в теле процедуры, т.к. совсем запамятовал.

Насчет строки if (fd.cFileName[0] <> ".") and (fd.cFileName <> "..") then.
. - текущий каталог
.. - каталог уровнем выше
Но разве кто-то запрещает создать файл .blablabla? - Нет, поэтому проверка выглядит именно таким образом, а доступ к символу в строке через индекс осуществел для того, чтобы не приводить "null-terminated" строку к типу String.

Разве я где-то нелогично мыслю?
Единственное где я допустил промах, как я считаю, так это то, что я забыл закрыть дескриптор.

"Отмазка" принимается?


 
Zeqfreed ©   (2005-11-06 20:54) [8]

Прошу прощения за опечатки, руки тряслись ;)


 
sniknik ©   (2005-11-06 21:18) [9]

> Но разве кто-то запрещает создать файл .blablabla?
винда должна запретить.

>  "Отмазка" принимается?
сам так сам. я не настаиваю, да и не говорил, сказал, что похоже изза логических несостыковок.


 
Zeqfreed ©   (2005-11-06 21:21) [10]

sniknik ©   (06.11.05 21:18) [9]
Хорошо, допустим файл винда запретит, а папку? твой код её просто проигнорирует, не так ли?


 
sniknik ©   (2005-11-06 21:47) [11]

> твой код её просто проигнорирует, не так ли?
попробуй.
логика немного другая но результат тотже, и первое сранение делает ненужным второе. вот поэтому и подумал ;) у тебя же и так и по другому сравнивается.

и потом не заметил, я это дело внутрь другого сравнения перенес, т.к. и "." и ".." и так каталоги, а каталоги реже встречаются чем файлы, и проверка на каталог в любом случае делается, т.е. по моему будет код немного быстрее (меньше сравнений, не будет каждый файл дополнительно проверять).
и кстати вот еще одна нестыковка, у тебя в после проверки на директорию одна команда в  begin end заключена, да конечно есть и такой стиль ;) но всетаки логичнее если таким образом несколько команд обьеденяются. поэтому думал так и было но ты оттуда чтото удалил/перенес.


 
Tek Noise   (2005-11-06 22:22) [12]

Непонимаю, по каким параметрам идёт поиск?
Немогу найти, где указать, чтобы поиск к примерё шёл по имени дирректории/файла содержащие к примеру "delphi"?


 
Tek Noise   (2005-11-06 22:30) [13]

Чес слово, де вводить эти параметры? %)
Просто по дефолту прога напоминает простую команду dir %)
Спасибо! =)


 
Zeqfreed ©   (2005-11-06 22:43) [14]

В общем мой код тоже неверно построен был относительно папок и файлов вида .* . Немного переделал, теперь вроде все работает как надо: опциональный поиск по подкаталогам, освобождение дескриптора и обработка папок/файлов вида .* . Прошу любить и жаловать :)

procedure DoSearch(Directory : String; const SearchSubdirectories : Boolean);
var
 fd : TWin32FindData;
 h : Cardinal;
begin
 AddTrailingBackslash(Directory);

 h := FindFirstFile(PChar(Directory + "*"), fd);
 if (h <> INVALID_HANDLE_VALUE) then begin
  repeat
    if ((fd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) then begin
     if (String(fd.cFileName) <> ".") and (fd.cFileName <> "..") and (SearchSubdirectories) then
      DoSearch(Directory + fd.cFileName, SearchSubdirectories);
    end else
     Output(Directory + fd.cFileName);
  until (FindNextFile(h, fd) = FALSE);

 end;
 
 FindClose(h);
end;


sniknik ©   (06.11.05 21:47) [11]
ИМХО, все-таки стоит учитывать ситуацию, что имена папок (и, насколько я знаю, файлов тоже) теоретически могут начинаться с точки.

Tek Noise   (06.11.05 22:22) [12]
Параметры задаются при запуске приложения, например в св-вах ярлыка пропиши в поле Target дополнительно папку в которой тебе нужно искать.
А вообще тебе же нужно скорее всего изменять эти параметры во время выполнения? Тогда тебе достаточно взять эти процедуры и передавать им необходимые параметры в программе.


 
Tek Noise   (2005-11-06 23:03) [15]

Zeqfreed ©   (06.11.05 22:43) [14]
Да, я уже почти разобрался =)
Вот что получилось:
Нормально? =)
Вот только осталось 1.
Нужно сделать так, что бы программа перед выводом имени файла сверяла, если в fd.cFileName имееться ".jpg", то, выводить, если нету - игнорировать.
Подскажи, как сделать проверку? Спасибо =)

procedure DoSearch(Directory : String{; const SearchSubdirectories : Boolean});
var
fd    :TWin32FindData;
h     :Cardinal;
begin
AddTrailingBackslash(Directory);
Output("Search in dir: " + Directory);
h := FindFirstFile(PChar(Directory + "*"), fd);
if (h <> INVALID_HANDLE_VALUE) then begin
 repeat
  if (fd.cFileName[0] <> ".") and (fd.cFileName <> "") then
   if ((fd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) then
   begin
    DoSearch(Directory + fd.cFileName{, true SearchSubdirectories});
   end else
//     if fd.cFileName = "*.jpg" then
    Output(fd.cFileName);

 until (FindNextFile(h, fd) = FALSE);
end;
end;

begin
DoSearch("G:"{,true});
writeln("Search complite...");
ReadLn;
end.


 
Tek Noise   (2005-11-06 23:16) [16]

Zeqfreed,
В тоём коде попытался поставить в

h := FindFirstFile(PChar(Directory + "*.jpg"), fd);

Он искал только в корневой дирректории %)
Спасибо кстатьи что подредактировал ;)


 
sniknik ©   (2005-11-06 23:41) [17]

Tek Noise   (06.11.05 22:22) [12]
> Непонимаю, по каким параметрам идёт поиск?
> Немогу найти, где указать, чтобы поиск к примерё шёл по имени дирректории/файла содержащие к примеру "delphi"?
для этого тебе надо взять этот пример за основу и написать свою программу поиска, где это условие (имя содержит к примеру "delphi"/маску) было бы реализовано. (немного осталось. практически одно условие (в паре мест) добавить ;), ну и параметр в процедуре)

> Он искал только в корневой дирректории %)
правильно. директории под эту маску не подошли... ни одна. искать всетаки надо по "*". и после сравнивать. либо разбивать процедуру поиска на 2 блока, директории и файлы отдельно.  

Zeqfreed ©   (06.11.05 22:43) [14]
> ИМХО, все-таки стоит учитывать ситуацию, что имена папок (и, насколько я знаю, файлов тоже) теоретически могут
> начинаться с точки.
кроме этих системных каталогов (текущий и выше) не могут. тоже имхо, но не совсем, также смутно помню гдето читал про это. ;) искать не буду, но у себя всегда на это закладываюсь (себе доверяю ;), и пока коллизий не было.

> Немного переделал, теперь вроде все работает как надо: ...
;о))) ну хотя бы в едином стиле. ;) и эта... не считай придирками...
но пара замечаний (только в качестве образования)
1 если FindFirstFile не вернул хендла то и закрывать нечего. так?
2 опять begin end для одной команды, ну тут хотябы оправдано, с условием внутри, да, но глаз режет. я обычно избавляюсь от такого. т.е. если бы я писал этот код
 if ((fd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) then begin
    if (String(fd.cFileName) <> ".") and (fd.cFileName <> "..") and (SearchSubdirectories) then
     DoSearch(Directory + fd.cFileName, SearchSubdirectories);
   end else
    Output(Directory + fd.cFileName);

то написал бы так
 if ((fd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY)
 then Output(Directory + fd.cFileName)
 else  if (String(fd.cFileName) <> ".") and (fd.cFileName <> "..") and (SearchSubdirectories)
         then DoSearch(Directory + fd.cFileName, SearchSubdirectories);

не форматирование, смысл. ну чего стоит условие на обратное заменить если этим убирается "лишний" (в этом случае) блок begin end?

хотя, я так не пишу, с Continue гораздо проще и читабельнее код получается.


 
Zeqfreed ©   (2005-11-06 23:51) [18]

sniknik ©   (06.11.05 23:41) [17]

> хотя, я так не пишу, с Continue гораздо проще и
> читабельнее код получается.

Дело привычки и "воспитания" :)


> убирается "лишний" (в этом случае) блок begin end?

Убирается он оптимизатором, а я просто написал так, как глазу приятней и привычней :)


> если FindFirstFile не вернул хендла то и закрывать
> нечего. так?

Сначала написал FindClose до end; но потом переместил ниже, не знаю каким инстинктам следовал :) "Виноват, исправлюсь" (С) :)


> кроме этих системных каталогов (текущий и выше) не
> могут. тоже имхо, но не совсем, также смутно помню
> гдето читал про это. ;) искать не буду, но у себя
> всегда на это закладываюсь (себе доверяю ;), и пока
> коллизий не было.

Специально проверял - FAR"ом спокойно создаются каталоги .* ;)

Ну а вообще уже пошёл треп по пустякам, думаю консенсус достигнут :)


 
Tek Noise   (2005-11-06 23:52) [19]

sniknik ©   (06.11.05 23:41) [17]
Ок, подскажи, как сделать проверку, имееться ли в fd.cFileName например ".jpg"?
Ну незнаю я как =(


 
sniknik ©   (2005-11-07 00:11) [20]

Tek Noise   (06.11.05 23:52) [19]
например
if Pos(".jpg", cFileName) > 0 then...
это если "имееться ли в", т.е. подстрока в строке.
если это проверка расширения, то надо с ним и сравнивать (см. ExtractFileExt функцию).
еще тебе скорее всего понадобится AnsiUpperCase т.к. поиск обычно делают без учета регистра букв.

Zeqfreed ©   (06.11.05 23:51) [18]
> Специально проверял - FAR"ом спокойно создаются каталоги .* ;)
серьезно? если так и есть то надо будет мне поменять подход в сравнении каталогов, на всякий случай. (far у меня только на работе. кстати у тебя версия какая? может глюк версии)


 
Zeqfreed ©   (2005-11-07 00:23) [21]

sniknik ©   (07.11.05 0:11) [20]
На полном серьезе :)
Версия 1.5 beta build 1634

Думаю, что FAR не единственная "шаманская" программа, которая так умеет ;)


 
sniknik ©   (2005-11-07 01:07) [22]

Zeqfreed ©   (07.11.05 00:23) [21]
круто! действительно так и есть.
скачал не утерпел ;)
http://farmanager.com/download.php?l=ru
кстати там 1705 уже (1.7) есть.

получается только точные сравнения на = "." или = ".." правильные, больше ничем не отличаются, подумал может чтото дополнительное в параметрах есть. нифига, и в остальной структуре (там зарезервированные переменные есть) смотрел, никакой закономерности не увидел. в общем то как у меня сравнение делается, на первую точку, неправильное. нужно теперь переделывать, искать где оно есть и переделывать... ;(.
а я все в проводнике да в проводнике. думал он актуально ошибки выдает.


 
Джо ©   (2005-11-07 01:13) [23]

Версия 1.70 beta 5 (build 1634) не создает такого безобразия.


 
Джо ©   (2005-11-07 01:15) [24]


> [23] Джо ©   (07.11.05 01:13)

Прошу извинить за дезинформацию. Создает-таки.


 
Zeqfreed ©   (2005-11-07 01:15) [25]

sniknik ©   (07.11.05 1:07) [22]

> кстати там 1705 уже (1.7) есть.

Да я перепутал, у меня 1.7 beta 5 :)
Вроде все устраивает, да и использую я его только для серфинга локальных фтп-серверов.


> получается только точные сравнения на = "." или = ".."
> правильные

По-моему в самой первой книжке по Delphi, что я читал был пример и там это говорилось, поэтому я хорошо запомнил :)


> нужно теперь переделывать, искать где оно есть и
> переделывать... ;(.

Нда, не очень это наверно веселое занятие. Но лучше поздно :)

Джо ©   (07.11.05 01:13) [23]
У меня она, создает, могу записать на видео и прислать ))


 
Tek Noise   (2005-11-07 01:25) [26]

Всё, дальше наверное сам спарвлюсь.
Всем огромное спасибо за помошь! =)



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

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

Наверх





Память: 0.54 MB
Время: 0.012 c
2-1131455124
Asail
2005-11-08 16:05
2005.11.27
Простой и убийство приложения ...


14-1130612804
tesseract
2005-10-29 23:06
2005.11.27
Выбор клавы


5-1103495421
k@rt
2004-12-20 01:30
2005.11.27
Перерисовка TPageControl


4-1127564222
jksgfv
2005-09-24 16:17
2005.11.27
Размотка стека при исключении


14-1131195081
Axis_of_Evil
2005-11-05 15:51
2005.11.27
Wi-Fi





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский