![]() |
|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
![]() |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
![]() Здравствуйте, по работе столкнулся с такой проблемой: нужно из 10 папок в которых 100000 файлов отобрать определенные файлы по назвах. В некоторых папках есть одиннаковые файлы, тоесть файлы, которые изменяльсь. В список мемо я вывел все файлы, теперь нужно отобрать одинаковые имена, сравнить по дате создания и скопировать самые последние.
|
#2
|
|||
|
|||
![]() Тут посмотри www.delphisources.ru/forum/forumdisplay.php?f=53
|
#3
|
||||
|
||||
![]() Цитата:
1) сортируешь список по имени файла (без пути, но путь не теряешь), 2) проходишься в цикле по списку и если встречаются подряд 2 одинаковых имени сравниваешь их даты и более старый удаляешь из списка, 3) и наконец опять проходишься в цикле по списку и копируешь все файлы из него в папку назначения. В принципе пункты 2 и 3 можно объединить в один цикл вместо двух. |
#4
|
||||
|
||||
![]() Актуально или нет - не знаю то тем не менее
функции для получения дат создания файла, и дат изменения файла Код:
Function GetDateCreate(SR:TSearchRec):String; Var DT: TFileTime; ST: TSystemTime; DD,MM,YY,H,M,S:string; Begin Result:=''; FileTimeToLocalFileTime( SR.FindData.ftCreationTime, DT ); FileTimeToSystemTime( DT, ST ); If st.wDay<10 then DD:='0'+inttostr(st.wDay) else DD:=inttostr(st.wDay); If st.wMonth<10 then MM:='0'+inttostr(st.wMonth) else MM:=inttostr(st.wMonth); YY:=inttostr(st.wYear); H:=inttostr(st.wHour); If st.wMinute<10 then M:='0'+inttostr(st.wMinute) else M:=inttostr(st.wMinute); If st.wSecond<10 then S:='0'+inttostr(st.wSecond) else S:=inttostr(st.wSecond); Result := DD+'.'+MM+'.'+YY+' '+H+':'+M+':'+S; end; ... Дата создания := GetDateCreate(SR); Дата изменения := DateTimetostr(FileDateToDateTime(SR.Time)); использовать в цикле поиска фалов Код:
Var SR:TSearchRec; FindRes,exten,Name,Dir{путь где ищем все что есть}:string; k:Integer; begin FindRes:=FindFirst(Dir+'*.*',faAnyFile,SR); While FindRes=0 do begin Name:=Dir; if ((SR.Attr and faDirectory)=faDirectory) and ((SR.Name='.')or(SR.Name='..')) then begin FindRes:=FindNext(SR); Continue; end; if ((SR.Attr and faDirectory)=faDirectory) then /// если найден каталог, то begin FindFile(Dir+SR.Name+'\'); // входим в процедуру поиска с параметрами текущего каталога + каталог, что мы нашли FindRes:=FindNext(SR); // после осмотра вложенного каталога мы продолжаем поиск в этом каталоге Continue; // продолжить цикл end; Name:=Name+SR.Name; k:=length(SR.Name); exten:=copy(SR.Name,k-2,3); //if exten='txt' then try end; ... и т.д Програмистами не рождаются, ими становятся! |
#5
|
||||
|
||||
![]() Цитата:
Код:
function GetDateCreate(SR: TSearchRec): String; var FT: TFileTime; ST: TSystemTime; DT: TDateTime; begin FileTimeToLocalFileTime(SR.FindData.ftCreationTime, FT); FileTimeToSystemTime(FT, ST); DT := SystemTimeToDateTime(ST); Result := DateTimeToStr(DT); // Или так: Result := FormatDateTime('dd.mm.yyyy hh:nn:ss,zzz', DT); end; Цитата:
Код:
procedure FindFile(Path: String); var SR: TSearchRec; ext: String; begin // Path := IncludeTrailingPathDelimiter(Path); if FindFirst(Path + '*.*', faAnyFile, SR) = NO_ERROR then try repeat if (SR.Attr and faDirectory) = faDirectory then // Это каталог begin if (SR.Name <> '.') and (SR.Name <> '..') then // Если это не системные каталоги FindFile(Path + sr.Name + '\'); // то обрабатываем рекурсивно и подкаталоги end else // Это файл begin ext := AnsiLowerCase(ExtractFileExt(SR.Name)); if ext = '.txt' then begin // ... end; end; until FindNext(SR) <> NO_ERROR; finally FindClose(sr); // И не забывать освобождать ресурсы - они не безграничные end; end; Последний раз редактировалось poli-smen, 06.10.2012 в 13:44. |
#6
|
||||
|
||||
![]() сложно, потому что это отдельные части кода, моей одной программки, ... в 1 части, да,.. возможно и можно проще, но не во второй
Програмистами не рождаются, ими становятся! |
#7
|
||||
|
||||
![]() Цитата:
Цитата:
Если дописать твою версию до рабочего варианта, получим следующее: Код:
procedure FindFile(Dir: string); var SR: TSearchRec; exten, Name: string; FindRes, k: Integer; begin FindRes := FindFirst(Dir + '*.*', faAnyFile, SR); if FindRes = 0 then try while FindRes = 0 do begin Name := Dir; if ((SR.Attr and faDirectory) = faDirectory) and ((SR.Name = '.') or (SR.Name = '..')) then begin FindRes := FindNext(SR); Continue; end; if ((SR.Attr and faDirectory) = faDirectory) then /// если найден каталог, то begin FindFile(Dir + SR.Name + '\'); FindRes := FindNext(SR); Continue; end; Name := Name + SR.Name; k := length(SR.Name); exten := copy(SR.Name, k - 2, 3); if exten = 'txt' then begin end; FindRes := FindNext(SR); end; finally FindClose(SR); end; end; Код:
procedure FindFile(Path: string); var SR: TSearchRec; FullFileName, FileExt: string; begin if FindFirst(Path + '*.*', faAnyFile, SR) = NO_ERROR then try repeat FullFileName := Path + sr.Name; if (SR.Attr and faDirectory) = faDirectory then // Это каталог begin if (SR.Name <> '.') and (SR.Name <> '..') then FindFile(FullFileName + '\'); end else // Это файл begin FileExt := AnsiLowerCase(ExtractFileExt(FullFileName)); if FileExt = '.txt' then begin end; end; until FindNext(SR) <> NO_ERROR; finally FindClose(sr); end; end; |