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

Вниз

Упорядочивание файлов по дате их создания   Найти похожие ветки 

 
Dr. Genius   (2004-12-24 15:56) [0]

В переменной FileList типа TStrings хранятся имена файлов (полные пути к файлам). Необходимо упорядочить эти имена файлов по дате их создания, и уже в упорядоченном виде произвести запись содержимого переменной FileList в текстовый файл методом SaveToFile. Проблема состоит только в том, КАК упорядочить эти файлы. Может, есть какой-то метод, позволяющий записывать имена файлов в TStrings в УЖЕ упорядоченном виде? Если да, то как это сделать?


 
Александр Иванов ©   (2004-12-24 16:05) [1]

Используй TList


 
Dr. Genius   (2004-12-24 16:10) [2]


> Используй TList


Поподробнее, пожалуйста...


 
Александр Иванов ©   (2004-12-24 16:13) [3]

type TListSortCompare = function (Item1, Item2: Pointer): Integer;
procedure Sort(Compare: TListSortCompare);

У него просто организовать сортировку по любым критериям определив собственную ф-ю и передав ее в метод Sort.


 
Digitman ©   (2004-12-24 16:15) [4]


> В переменной FileList типа TStrings хранятся имена файлов


они там откуда взялись ?
ты же, наверно, пользовал FindFirst/FindNext для заполнения списка ? нужно было сразу при нахождении очередного файла запоминать знач-е поля Time структуры SearchRec .. а так тебе придется для каждого файла из полученного списка запрашивать это значение, например, ф-цией FileAge() .. двойная работа, заметно снижающая производительность алгоритма в целом, из-за двойного открытия/закрытия каждого из файлов ..

когда ты получил инф-цию об очередном файле, добавляй ее в StringList методом AddObject("имя_файла", Pointer(время_создания_из_поля_SearchRec.Time))

как только стринг-лист будет заполнен, вызови его метод CustomSort() (см.справку), указав параметром адрес собственной ф-ции с прототипом TStringListSortCompare .. эта ф-ция в ходе сортировки будет вызываться многократно, в ней ты должен сравнить DWord(List.Objects[Index1]) и DWord(List.Objects[Index2]) на предмет больше/меньше/равно, вернув соответственно 1/0/-1


 
Dr. Genius   (2004-12-24 17:07) [5]

Как всё запутано и непонятно. Нельзя ли привести кусок программного кода. Дело в том, что я сейчас собирался написать небольшую программку, позволяющую удобно организовывать галереи графических файлов. Например, у Вас есть папка Gallery, в ней хранится, скажем, 100 графических файлов с разными именами. Так вот: с помощью моей программы пользователь сможет за пару кликов сорганизовать все графические файлы (упорядочить, переименовывать) по дате создания. И после этого у пользователя в папке Gallery будет вот такой список файлов: 001.jpg, 002.jpg, 003.jpg, 004.jpg, … 100.jpg. Или такой: Image_001.jpg, Image_002.jpg, Image_003.jpg, Image_004.jpg, … Image_100.jpg.  Причём эти файлы будут сорганизованы по дате их создания (первым в папке будет самый старый файл, а последним – самый новый).

Привожу кусок моего, пока ещё очень скромного и недоделанного программного кода:

program imgsort;
uses
 SysUtils, Classes, FileCtrl, Windows;
var
 OutDir, TempOut: String;
 FFRec: TSearchRec;
 FileList: TStrings;
 I: Integer;
begin
 if (SelectDirectory ("Выберите папку, содержащую графические файлы:", "", OutDir)) then
   begin
     FileList := TStringList.Create;
     TempOut := OutDir + "\";
     OutDir := OutDir + "\*.*";
     I := FindFirst (OutDir, faAnyFile, FFRec);
     while (True) do
       begin
         if (I <> 0) then Break;
         if (FileExists (TempOut + FFRec.Name)) then FileList.Add (TempOut + FFRec.Name);
         I := FindNext (FFRec);
       end;
     SysUtils.FindClose (FFRec);
     FileList.SaveToFile ("Images.tmp");
     FileList.Free;
     DeleteFile ("Images.tmp");
   end;
end.


На строчке программного кода, помеченной жирным шрифтом, я столкнулся с ещё одной проблемой: "\*.*" – это критерий поиска файлов. Может, это будет смешно, но у меня не получается сделать так, чтобы вёлся поиск только файлов графического типа: *.jpg, *.gif, *.bmp, *.tif, *.pcx и т. д.


 
Digitman ©   (2004-12-24 17:18) [6]


> Как всё запутано и непонятно


что "запутано" и что конкретно непонятно ?


> столкнулся с ещё одной проблемой


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

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


 
Dr. Genius   (2004-12-25 08:53) [7]

Привожу уже немного доработанный код программы. Теперь программа переименовывает файлы, только не графические, а все подряд; и переименовывает не по дате создания. Я всё сделал, как мне сказал Digitman, но на CustomSort я застрял. Может, кто поможет?

program imgsort;
uses
 SysUtils, Classes, FileCtrl, Windows;
var
 OutDir, TempOut, S, T: String;
 Rec: TSearchRec;
 FileList: TStringList;
 I: Integer;
 F: TextFile;
begin
 if (SelectDirectory ("Выберите папку, содержащую графические файлы:", "", OutDir)) then
   begin
     FileList := TStringList.Create;
     TempOut := OutDir + "\";
     OutDir := OutDir + "\*.*";
     I := FindFirst (OutDir, faAnyFile, Rec);
     while (True) do
       begin
         if (I <> 0) then Break;
         if (FileExists (TempOut + Rec.Name)) then FileList.AddObject (TempOut + Rec.Name, Pointer (Rec.Time));
         I := FindNext (Rec);
       end;
     //FileList.CustomSort();      SysUtils.FindClose (Rec);
     FileList.SaveToFile ("Images.tmp");
     AssignFile (F, "Images.tmp");
     Reset (F);
     for I := 1 to FileList.Count do
       begin
         Readln (F, OutDir);
         S := OutDir;
         Delete (S, 1, Length (OutDir) - 4);
         T := IntToStr (I);
         while (Length (T) < Length (IntToStr (FileList.Count))) do T := "0" + T;
         RenameFile (OutDir, TempOut + T + S);
       end;
     CloseFile (F);
     Erase (F);
     FileList.Free;
   end;
end.


 
begin...end ©   (2004-12-25 11:35) [8]

> [7] Dr. Genius   (25.12.04 08:53)

Писал я огромный пост, но по глупости потерял его перед самой отправкой. Так что - короткий вариант. Вот код, который переименовывает файлы на основании даты их последнего изменения. Разберитесь вначале сами. Если что-то будет совсем непонятно, задавайте вопросы.

program Sort;

uses
 SysUtils, Classes, FileCtrl, Math;

function MyCompareFunction(List: TStringList; Index1, Index2: Integer): Integer;
begin
 Result := CompareValue(Integer(List.Objects[Index1]), Integer(List.Objects[Index2]))
end;

var
 I: Integer;
 OutDir: String;
 Rec: TSearchRec;
 FileList: TStringList;
begin
 if (SelectDirectory("Выберите папку, содержащую файлы:", "", OutDir)) then
 begin
   FileList := TStringList.Create;
   try
     OutDir := IncludeTrailingPathDelimiter(OutDir);
     if FindFirst(OutDir + "*.*", faAnyFile, Rec) = 0 then
       repeat
         if (Rec.Attr and faDirectory) <> faDirectory then
           FileList.AddObject(OutDir + Rec.Name, Pointer(Rec.Time))
       until FindNext(Rec) <> 0;
     FindClose(Rec);
     FileList.CustomSort(MyCompareFunction);
     for I := 0 to FileList.Count - 1 do
       RenameFile(FileList[I], ExtractFilePath(FileList[I]) + IntToStr(I) + ExtractFileExt(FileList[I]));
   finally
     FileList.Free
   end
 end
end.


 
Dr. Genius   (2004-12-25 14:14) [9]

begin...end, спасибо за код. Сейчас буду его изучать.


 
Dr. Genius   (2004-12-26 11:15) [10]

Код работает, я его просмотрел. Функция MyCompareFunction выполняет сортировку по возрастанию даты изменения. В принципе, всё понятно и вопросов у меня не возникло. Выходит, что в Rec.Time хранится не дата создания файла, а дата его изменения. Получается, что через Rec нельзя организовать сортировку по дате создания (зато можно ещё по размеру файла, через Rec.Size). Ладно, значит, буду искать другой способ. Наверное, придётся прибегнуть к FileAge… Выкладываю код своей программы на всякий случай (может, кто-то захочет помочь):

program organize;
uses
 SysUtils, Classes, FileCtrl, Windows, Controls, Math;
 //----------------------------------------
 function MyCompareFunction (List: TStringList; Index1, Index2: Integer): Integer;
 begin
   Result := CompareValue (Integer (List.Objects [Index1]), Integer (List.Objects [Index2]));
 end;
 //----------------------------------------
var
 OutDir, Dir, FileName: String;
 Rec: TSearchRec;
 FileList: TStringList;
 I: Integer;
 F: TextFile;
label
 Point;
begin
 Point: if (SelectDirectory ("Выберите папку, содержащую графические файлы:", "", OutDir)) then
   begin
     FileList := TStringList.Create;
     OutDir := IncludeTrailingPathDelimiter (OutDir);
     Dir := OutDir;
     OutDir := OutDir + "*.*";
     I := FindFirst (OutDir, faAnyFile, Rec);
     while (True) do
       begin
         if (I <> 0) then Break;
         if (FileExists (Dir + Rec.Name))
           and ((ExtractFileExt (Dir + Rec.Name) = ".jpg")
           or (ExtractFileExt (Dir + Rec.Name) = ".jpe")
           or (ExtractFileExt (Dir + Rec.Name) = ".jpeg")
           or (ExtractFileExt (Dir + Rec.Name) = ".png")
           or (ExtractFileExt (Dir + Rec.Name) = ".gif")
           or (ExtractFileExt (Dir + Rec.Name) = ".bmp")
           or (ExtractFileExt (Dir + Rec.Name) = ".pcx")
           or (ExtractFileExt (Dir + Rec.Name) = ".dcx")
           or (ExtractFileExt (Dir + Rec.Name) = ".dcx")
           or (ExtractFileExt (Dir + Rec.Name) = ".tif")
           or (ExtractFileExt (Dir + Rec.Name) = ".tiff"))
         then FileList.AddObject (Dir + Rec.Name, Pointer (Rec.Time));
         I := FindNext (Rec);
       end;
     SysUtils.FindClose (Rec);
     if (FileList.Capacity = 0) then
       begin
         MessageBox (0, "В выбранной папке не найдено ни одного графического файла.", "Gallery Organizer 1.0", MB_OK or MB_ICONWARNING);
         goto Point;
       end;
     if (MessageBox (0, "Вы действительно хотите сорганизовать графические файлы выбранной папки?", "Gallery Organizer 1.0", MB_YESNO or MB_ICONQUESTION) = mrNo) then goto Point;
     FileList.CustomSort (MyCompareFunction);
     FileList.SaveToFile ("Files.tmp");
     AssignFile (F, "Files.tmp");
     Reset (F);
     for I := 1 to FileList.Count do
       begin
         Readln (F, OutDir);
         FileName := IntToStr (I);
         while (Length (FileName) < Length (IntToStr (FileList.Count))) do FileName := "0" + FileName;
         RenameFile (OutDir, Dir + FileName + ExtractFileExt (OutDir));
       end;
     CloseFile (F);
     Erase (F);
     MessageBox (0, PChar ("Организация файлов завершена. Сорганизовано файлов: " + IntToStr (FileList.Count) + "."), "Gallery Organizer 1.0", MB_OK or MB_ICONINFORMATION);
     FileList.Free;
   end;
end.


 
begin...end ©   (2004-12-26 11:29) [11]

> [10] Dr. Genius   (26.12.04 11:15)

> for I := 1 to FileList.Count do        

for I := 0 to FileList.Count - 1 do

И зачем сохранять FileList в файл? Разве нельзя работать с элементами списка напрямую - так, как я это показал в [8]? Впрочем, воля Ваша...


 
Dr. Genius   (2004-12-27 10:20) [12]


> И зачем сохранять FileList в файл? Разве нельзя работать
> с элементами списка напрямую

При работе напрямую с лементами как показано в [8] Delphi выводит ошибку.


 
Digitman ©   (2004-12-27 11:33) [13]


> Delphi выводит ошибку


Рождество ? Волшебство ?
Его Сиятельство таки сподобится по случаю Рождества описать проблему кратко, внятно, наглядно ?


 
Arm79   (2004-12-27 16:55) [14]

У меня процедурка собирает список файлов, правда по времени модификации, а не создания, но это несложно исправить. Нужно посмотеть в хелп по TSearchRec

procedure ReturnSnapList(var SL : TStringList);
var
 sTemp1    : string;
 FileAttrs : Integer;
 SR        : TSearchRec;
begin
 SetCurrentDir(ExtractFilePath(Application.ExeName));
 sTemp1 := GetCurrentDir + "\SnapShots\";
 FileAttrs := faAnyFile;
 if FindFirst(sTemp1 + "SnapShot*.snp", FileAttrs, sr) = 0
   then begin
SL.AddObject(IntToStr(sr.FindData.ftLastWriteTime.dwLowDateTime), TObject(StringToPChar(sr.Name)));
     while findNext(sr) = 0
       do SL.AddObject(IntToStr(sr.FindData.ftLastWriteTime.dwLowDateTime), TObject(StringToPChar(sr.Name)));
     FindClose(sr);
   end;
 SetCurrentDir(ExtractFilePath(Application.ExeName));
end;


 
Arm79   (2004-12-27 16:58) [15]

Забыл добавить, список отсортированный. Поэтому я с сортировкой не мучаюсь, само вставляется куда нужно


 
Dr. Genius   (2004-12-28 10:19) [16]


> Его Сиятельство таки сподобится по случаю Рождества описать
> проблему кратко, внятно, наглядно ?


Да, но не сейчас. Попозже...


 
Dr. Genius   (2004-12-30 09:21) [17]


> Его Сиятельство таки сподобится по случаю Рождества описать
> проблему кратко, внятно, наглядно ?


Ты, наверное, разозлился из-за того, что я сказал про ошибку, но не сказал в чём она заключается. Просто я забыл текст ошибки. Я запустил Delphi и посмотрел...
Ошибка: “List index out of bounds (n)”, где n – это количество найденных графических файлов в указанной папке.
______________________________

Спасибо за код, Arm79. Теперь я понял, как отсортировывать по дате создания. Вот как я это сделал:

FileList.AddObject (Dir + Rec.Name, Pointer (Rec.FindData.ftCreationTime.dwLowDateTime));


 
begin...end ©   (2004-12-30 12:26) [18]

> [12] Dr. Genius   (27.12.04 10:20)

> При работе напрямую с лементами как показано в [8] Delphi
> выводит ошибку.


> [17] Dr. Genius   (30.12.04 09:21)

> Ошибка: “List index out of bounds (n)”

Т.е. Вы со всей ответственностью заявляете, что код [8] вызывает эту ошибку?


 
Dr. Genius   (2004-12-31 09:21) [19]

Я проверял не весь код, а взял оттуда кусок и втавил в программу...


 
Anatoly Podgoretsky ©   (2004-12-31 10:17) [20]

И вставил конечно с ошибками, а конкретную ошибку тебе уже указали, ты исправил уже?
Ты чего такой неправильный ник выбрал.



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

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

Наверх




Память: 0.52 MB
Время: 0.04 c
14-1103808425
Koala
2004-12-23 16:27
2005.01.16
Срочно!!! посоветуйте аппарат....


1-1103885197
ivc_andr
2004-12-24 13:46
2005.01.16
Check в DBGrid


1-1104171259
AndreyK_
2004-12-27 21:14
2005.01.16
Создание пароля


11-1085550975
Ricko
2004-05-26 09:56
2005.01.16
Вопрос по koledb


1-1104150683
lm2
2004-12-27 15:31
2005.01.16
TService + запуск программы





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский