19 окт. 2009 г.

Установка даты/времени для папок

В Delphi есть замечательные функции для установки аттрибутов и даты/времени файлов:

function FileSetAttr(const FileName: string
  Attr: Integer): Integer;
function FileSetDate(const FileName: string
  Age: Integer): Integer;

И хотя функция для установки аттрибутов работает прекрасно, функция для установки даты работает корректно только с файлами.

Что-ж, это не впервой. Вооружаемся кнопкой F7 и начинаем трассировку с глубоким проникновением в дебри VCL.

Оказывается, функция FileSetDate выглядит примерно так:

function FileSetDate(const FileName: string
  Age: Integer): Integer;
var
  f: THandle;
begin
  f := FileOpen(FileName, fmOpenWrite);
  if f = THandle(-1) then
    Result := GetLastError
  else
  begin
    Result := FileSetDate(f, Age);
    FileClose(f);
  end;
end;

После вызова FileOpen срабатывает условие f = THandle(-1). Это говорит нам о том, что использовать данную функцию для получения хэндла папки нельзя.

Проникнем в функцию FileOpen. Она представляет собой вызов API-шной функции CreateFile с определенным набором параметров. Сама функция имеет такой набор параметров:

function CreateFile(lpFileName: PWideChar; 
  dwDesiredAccess, dwShareMode: DWORD; 
  lpSecurityAttributes: PSecurityAttributes;
  dwCreationDisposition, dwFlagsAndAttributes: DWORD;
  hTemplateFile: THandle): THandle; stdcall;

MSDN не скрывает от нас того факта, что для получения хэндла папки нобходимо присутствие флага FILE_FLAG_BACKUP_SEMANTICS в параметре dwFlagsAndAttributes. Попробуем это на практике. Напишем свою функцию:

function FileSetDate2(const FileName: string
  Age: Integer): Integer;
var
  F: THandle;
begin
  F := CreateFile(PChar(FileName),
    GENERIC_READ or GENERIC_WRITE, 0, nil,
    OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
  if F = THandle(-1) then
    Result := GetLastError
  else
  begin
    Result := FileSetDate(F, Age);
    FileClose(F);
  end;
end;

По-сути мы скопировали функцию из VCL и только заменили способ создания хэндла. Теперь должно работать и с папками.

Но, увы, не работает.

Теперь хэндл создается корректно. Дальше тоже все работает корректно. И все-таки дата у папки остается прежней. В чем же дело? Лезем еще глубже — в ту версию функции FileSetDate, которая принимает хэндл в качестве параметра.

function FileSetDate(Handle: Integer; 
  Age: Integer): Integer;
var
  LocalFileTime, FileTime: TFileTime;
begin
  Result := 0;
  if DosDateTimeToFileTime(LongRec(Age).Hi, 
    LongRec(Age).Lo, LocalFileTime) and
    LocalFileTimeToFileTime(LocalFileTime, 
    FileTime) and SetFileTime(Handle, nil, nil
    @FileTime) then Exit;
  Result := GetLastError;
end;

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

В конце концов, наша собственная функция начинает работать корректно и для файлов и для папок:

function FileSetDate2(const FileName: string;
  Age: Integer): Integer;
var
  LocalFileTime, FileTime: TFileTime;
  F: THandle;
begin
  F := CreateFile(PChar(FileName),
    GENERIC_READ or GENERIC_WRITE, 0, nil,
    OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
  if F = THandle(-1) then
    Result := GetLastError
  else
  begin
    try
      if DosDateTimeToFileTime(LongRec(Age).Hi,
        LongRec(Age).Lo, LocalFileTime) and
        LocalFileTimeToFileTime(LocalFileTime,
        FileTime) and SetFileTime(F, @FileTime,
        nil, @FileTime) then Exit;
      Result := GetLastError;
    finally
      FileClose(F);
    end;
  end;
end;

Если для файла нужно устанавливать только дату последнего изменения, можно изменить функцию, добавив соответствующую проверку.

2 комментария:

  1. Откуда взялась переменная LocalFileTime?

    ОтветитьУдалить
    Ответы
    1. Эту переменную нужно просто добавить в объявление аналогично предыдущей функции. Я исправил код. Спасибо за наблюдательность.

      Удалить