Форум: "Начинающим";
Текущий архив: 2011.07.24;
Скачать: [xml.tar.bz2];
ВнизОбработка каталога в станд. процедуре findfirst Найти похожие ветки
← →
Xalexo (2011-03-22 06:03) [0]Почти дописал небольшую фоновую утилитку сканирования файлов по выбранным маскам для некоторых последующих действий. Решил додумать список исключений для опред. файлов и папок. Сама задача проблем не составила, но вот как дать понять следующей фукнции, что я хочу проигнорировать в заданном каталоге содержащиеся в ней файлы, но при этом продолжить обработку ее поддиректорий ? Пробовал решать задачу по разному... Несовсем понятно, как себя ведет рекурс. ссылка scanproj(prdr+src.name+"\",workfs,ldr); в найденном подкаталоге. Продолжается ли работа функции после выхода и нового цикла сразу же после точки останова ? Логически, вроде бы представляется, что - да... (**) помечены мои безуспешные модификации Может есть у кого рабочая версия подобной или похожей функции...
procedure scanproj(prdr : string; workfs : boolean = false; ldr : string = ""); {ls: tstringlist}
label 1;
var SRC : TSearchrec;
ff,lv,lc,ids : integer; brk:boolean;
begin
prdr:= includetrailingbackslash(prdr);
with nfor_main do
if directoryexists(prdr) then begin
brk:= false;
lv:= 0;
lc:= 0;
ff:= 0;
try
if findfirst(PrDr+"*.*",faAnyFile,SRC) = 0 then
repeat
inc(LC);
if (SRC.Name <> ".") and (src.Name <> "..") then
if ((SRC.Attr and faDirectory) <> 0) then
begin
(**)
if not workfs then
begin
ldr:= prdr+src.name;
{проверка на вхождение в список исключ.}
workfs:= (ltm.indexof("+"+ldr+"\")<>-1);
end;
(**)
scanproj(prdr+src.name+"\",workfs,ldr); inc(lv); //end else brk:= true;
end
else
if not ((SRC.Attr and faVolumeID) <> 0) then
begin
(**)
if workfs then inc(ff) else
if ltm.indexof("+"+prdr+src.name)=-1 then
if HaveBadExt(SRC.Name)then
begin
case cl.itemindex of
0: deletefilewithundo(prdr+src.name,true);
1: deletefilewithundo(prdr+src.name,false);
2:
if not directoryexists(moved.text) then begin tr2.enabled := false; goto 1 end else
if copyfile(pchar(prdr+src.name),pchar(includetrailingbackslash(moved.text)+src.name),false) then
deletefilewithundo(prdr+src.name);
end;
end;
end;
{здесь должно бы проверяться условие на соотвествие номера последнего обработанного файла отдельной функции возвращающей все найденные в папке ldr файлы (т.е.-количество)}
(**) workfs := not(ff=foundfiles_count(extractfilepath(ldr)+"*",faanyfile));
if not workfs then begin ff:=0; ldr:="" end;
{
1:
if not tr2.enabled then begin showmessage("!process stopped"); proc.caption:= "- остановлено.. ) alt + shift + f12 для отмены из вне("; break; end;
if (LC mod 10) = 0 then
begin
application.ProcessMessages;
end;
}
until findnext(SRC) <> 0;
finally
FindClose(SRC);
end;
end;
end;
← →
Тынц (2011-03-22 07:45) [1]> Xalexo (22.03.11 06:03) но вот как дать понять следующей фукнции, что я хочу проигнорировать в заданном каталоге содержащиеся в ней файлы, но при этом продолжить обработку ее поддиректорий ?
Видимо, следует использовать для поиска файлов и поиска папок разный код? Вначале файлы. Потом - папки. Котлеты, то есть, в одну сторону, а мухи, соответственно, в другую.
← →
Тынц (2011-03-22 07:46) [2]P.S. Трояна пишем-с?
← →
Xalexo (2011-03-22 22:42) [3]
> P.S. Трояна пишем-с?
Не в коей мере ! Обычный анализ папок на предмет наличия в ней tmp файлов с некоторой маской (к примеру: *.~*) - c целью их дальнейшего перемещения & уничтожения.
Мне представляется, хотя я могу и ошибиться - что разделение на 2 функции не столь координально изменит ситуацию. Конечно если только эта не под/функция(foundfiles_count), нужная для простого подсчета количества файлов в исключ. директории на для возможности определения завершения текущего режима и дальнейшей работы в обычном.
(**) workfs := not(ff=foundfiles_count(extractfilepath(ldr)+"*",faanyfile));
if not workfs then begin ff:=0; ldr:="" end;
Если кому то хватит терпения до конца разобраться в моих небольших доработочках этой в остальном - стандартной функции - они помечены (**) , и предложить простое - или не очень - решение моих бесплодных блужданий, буду бесконечно признателен !!!
Прощу заранее прощение за некоторую избыточность и возможную где-то нелогичность данного кода.
P.S. И как все же ведет себя рекурсия - продолжается ли функция при след. цикле с той самой точки выхода - scanproj(prdr+src.name+"\",workfs,ldr).
Ответьте, пожалуйста, начинающему, но упрямому в поисках ИСТИНЫ - программисту !
← →
RWolf © (2011-03-23 00:23) [4]
> И как все же ведет себя рекурсия
как любой другой вызов функции.
то, что имя вызываемой функции совпадает с именем вызывающей, ничего не меняет.
← →
Xalexo (2011-04-22 07:30) [5]:) Путем проб и ошибок наконец получил, что-то вразумительное...
Функция проходит по дереву папок исходного драйва и копирует файлы по заданной маске, вместе с предшествующими поддиректориями, т.е - по полному пути, в новое место, тем самым добиваясь перезаписи уже присутствующих файлов при следующим цикле.
procedure scanproj(prdr,copytodir:string);
var src : tsearchrec;
i,lc : integer; s:string;
begin
prdr:= includetrailingbackslash(prdr);
copytodir:= includetrailingbackslash(copytodir);
try
with form1 do
if directoryexists(prdr) then begin
lc := 0;
if findfirst(PrDr+"*.*",faAnyFile,SRC) = 0 then
repeat
inc(LC);
if (src.name <> ".") and (src.name <> "..") then
if ((SRC.Attr and faDirectory) <> 0) then
begin
scanproj(prdr+src.name+"\",copytodir);
end
else
if not ((SRC.Attr and faVolumeID) <> 0) then
begin
(*функция на проверку файла по предопред. маске*)
if HaveBadExt(SRC.Name)then
begin
(*т.к в данном случае копируется весь диск, для создания подпапки с тем же именем удаляется двоеточие*)
s:= prdr; delete(s,pos(":",s),1);
(*если новый путь не сущ. - форсим его*)
if not directoryexists(copytodir + s) then forcedirectories(copytodir + s);
(*и наконец копируем сам файл*)
copyfile(pchar(prdr+src.name),pchar(copytodir+s+src.name),false);
end;
end;
(*для обратной связи с приложением*)
if (LC mod 100) = 0 then application.ProcessMessages;
until
findnext(SRC) <> 0;
end;
finally
FindClose(SRC);
end;
end;
Страницы: 1 вся ветка
Форум: "Начинающим";
Текущий архив: 2011.07.24;
Скачать: [xml.tar.bz2];
Память: 0.48 MB
Время: 0.002 c