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;
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;
Age: Integer): Integer;
var
LocalFileTime, FileTime: TFileTime;
F: THandle;
F: THandle;
begin
F := CreateFile(PChar(FileName),
GENERIC_READ or GENERIC_WRITE, 0, nil,
OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
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
LongRec(Age).Lo, LocalFileTime) and
LocalFileTimeToFileTime(LocalFileTime,
FileTime) and SetFileTime(F, @FileTime,
nil, @FileTime) then Exit;
FileTime) and SetFileTime(F, @FileTime,
nil, @FileTime) then Exit;
Result := GetLastError;
finally
FileClose(F);
end;
end;
end;
Если для файла нужно устанавливать только дату последнего изменения, можно изменить функцию, добавив соответствующую проверку.
Откуда взялась переменная LocalFileTime?
ОтветитьУдалитьЭту переменную нужно просто добавить в объявление аналогично предыдущей функции. Я исправил код. Спасибо за наблюдательность.
Удалить