Форум: "Основная";
Текущий архив: 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.037 c