freepascal.ru

Есть следующая задача: в папке записаны фотографии, необходимо в цикле пройтись по всем файлам и скопировать их в папки по дате создания. Знаю, что задача достаточно простая, но сегодня мозги не соображают как реализовать. Вырисовывается следующий алгоритм: проверить дату создания файла, если папки с таким именем не существует, создать, копировать файл в папку.Как определить дату создания файла?

Win
BOOL GetFileTime(

HANDLE hFile, // identifies the file
LPFILETIME lpCreationTime, // address of creation time
LPFILETIME lpLastAccessTime, // address of last access time
LPFILETIME lpLastWriteTime // address of last write time
);

или кросс Function FileGetDate (Handle : THandle) : Longint;
правда это вернёт дату последней записи в файл, а не дату создания.

или можно:
BOOL GetFileAttributesEx(
LPCTSTR lpFileName, // pointer to string that specifies a file or directory
GET_FILEEX_INFO_LEVELS fInfoLevelId, // value that specifies the type of attribute information to obtain
LPVOID lpFileInformation // pointer to buffer to receive attribute information
);
тогда можно не открывать файл

Код: Выделить всё

var
  sr: TSearchRec;
Begin
    If FindFirst('Ваш_каталог\*.*', faAnyFile, sr) = 0 then
    Repeat
        If not DirectoryExists(DateToStr(FileTimeToDateTime(sr.Time))) then
        Begin
           //Создаём каталог и копируем туды файл
        End;
    Until FindNext(sr) <> 0;
    FindClose(sr);
End;

Что-то примерно такое...

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

Я тоже занимался точно-такой же задачей. вот мой код. Может пригодится.

Код: Выделить всё

if FindFirst(DirIn + '*.JPG', faAnyFile-faDirectory, SearchRec) = 0 then
        repeat
          AhowMessage( 'Обработка файла: ' + DirIn + SearchRec.Name);
          try
            FolderName:=DateToStr(FileDateToDateTime(SearchRec.Time))+'\';     // Получаем дату создания / изменения файла
            if not DirectoryExists(DirOut+FolderName) then                                  // Проверяем на существование файла
              CreateDir(DirOut+FolderName);                                                        // Создаем папку
            FileCopy(DirIn + SearchRec.Name, DirOut+FolderName + SearchRec.Name);    // Копируем файл   
          except
           ShowMessage(DirIn + SearchRec.Name+'... Ошибка');                 
          end;
        until FindNext(SearchRec) <> 0;
      FindClose(SearchRec);

      btNext.Enabled := True;
     ShowMessage('Обработка файлов: Все файлы обработанны.');


Может пригодиться функция копирования файла

Код: Выделить всё

procedure FileCopy(const SourceFileName, TargetFileName: string);
var
  S, T: TFileStream;

begin
  if SourceFileName <> TargetFileName then
  begin
  S := TFileStream.Create(sourcefilename, fmOpenRead);
  try
    T := TFileStream.Create(targetfilename, fmOpenWrite or fmCreate);
    try
      T.CopyFrom(S, S.Size);
      FileSetDate(T.Handle, FileGetDate(S.Handle));
    finally
      T.Free;
    end;
  finally
    S.Free;
  end;
  end;
end;