Да, это работает. Буфер я делать большой не стал (странно, что не знал такую штуку, как absolute. Это получается что-то типа C-шного UNION что ли? )
А добавил 4 байта в структуру
FILE_BASIC_INFORMATION = packed record
CreationTime:FileTime;
LastAccessTime:FileTime;
LastWriteTime:FileTime;
ChangeTime:FileTime;
FileAttributes:ULong;
Reserve:ULong; //Без этого ругается на маленький буфер. Странно, по описанию бы не должен.
end;
Такое ощущение, что ему надо 8 байт под эти атрибуты, а не 4. Ну, в общем, так работает.
Ну и пришлось ещё сделать забытое в тот раз
FileInformation.FileAttributes:=sr.Attr;
FileInformation.Reserve:=0; //От греха подальше...
иначе атрибуты получались случайными, и иногда такими, что была ошибка.
А можно было бы просто 0 написать, т.к. "Setting any member of the structure to zero tells ZwSetInformationFile to leave the current information about the file for that member unchanged"
Осталось только вместо тестовой процедуры написать нормальную - понимающую TDateTime вместо FileTime и т.д. Ну, это уже орешки.
Спасибо.
И про RtlNtStatusToDosError тоже бы я сам не сразу догадался.
Ну, что ж - причешу эту функцию, возьмусь за NtQueryInformationFile. С первого раза тоже не пошла. Если не получится - уж не обессудьте, снова к Вам
Добавлено спустя 2 часа 9 минут 27 секунд:Вот, что-то наваял относительно законченное. Кому надо - пользуйтесь, кто найдёт ошибки - ткните меня в них.
- Код: Выделить всё
function FileTimeToDateTime(FileTime: TFileTime): TDateTime;
var
ModifiedTime: TFileTime;
SystemTime: TSystemTime;
begin
Result := 0;
if (FileTime.dwLowDateTime = 0) and (FileTime.dwHighDateTime = 0) then
Exit;
try
FileTimeToLocalFileTime(FileTime, ModifiedTime);
FileTimeToSystemTime(ModifiedTime, SystemTime);
Result := SystemTimeToDateTime(SystemTime);
except
Result := Now; // Хоть что-нибудь вернуть, если ошибка
end;
end;
function DateTimeToFileTime(FileTime: TDateTime): TFileTime;
var
LocalFileTime, Ft: TFileTime;
SystemTime: TSystemTime;
begin
Result.dwLowDateTime := 0;
Result.dwHighDateTime := 0;
DateTimeToSystemTime(FileTime, SystemTime);
SystemTimeToFileTime(SystemTime, LocalFileTime);
LocalFileTimeToFileTime(LocalFileTime, Ft);
Result := Ft;
end;
//Описалово тут:
//http://msdn.microsoft.com/en-us/library/windows/hardware/ff557671%28v=vs.85%29.aspx
type
NT_STATUS = Cardinal;
IO_STATUS_BLOCK = packed record
NTSTATUS:Pointer;
Information: DWORD;
end;
PIO_STATUS_BLOCK = ^IO_STATUS_BLOCK;
FILE_BASIC_INFORMATION = packed record
CreationTime:FileTime;
LastAccessTime:FileTime;
LastWriteTime:FileTime;
ChangeTime:FileTime;
FileAttributes:ULong;
Reserve:ULong; //Без этого ругается на маленький буфер. Странно...
end;
PFILE_BASIC_INFORMATION = ^FILE_BASIC_INFORMATION;
const FileBasicInformation = 4;
STATUS_SUCCESS = 0;
function RtlNtStatusToDosError(Status:NT_STATUS):ULONG;stdcall;external 'ntdll' name 'RtlNtStatusToDosError';
function NtSetInformationFile(hFile: THandle;IoStatusBlock:PIO_STATUS_BLOCK;
FileInformation:PFILE_BASIC_INFORMATION;Length:ULong;FileInformationClass:ULong):
NT_STATUS;stdcall;external 'ntdll' name 'NtSetInformationFile';
function NtQueryInformationFile(hFile:THandle;IoStatusBlock:PIO_STATUS_BLOCK;
FileInformation:PFILE_BASIC_INFORMATION;Length:ULong;FileInformationClass:ULong):
ULong;stdcall;external 'ntdll' name 'ZwQueryInformationFile';
//Чтение времён и атрибутов файла (или каталога, который с т.з. ОС тоже файл)
// FileName - имя файла или каталога
// ErrMessage - буфер для дополнительного текста ошибки
// CreationTime,LastWriteTime,LastAccessTime,ChangeTime - 4 возвращаемые даты
// FileAttributes - набор атрибутов (битовая маска)
//Выход: true/false
//Если result = False, проверять GetLastError или вызывать RaiseLastOSError(),чтобы понять причину
function GetFileDatesAndAttr(const FileName:String;out ErrMessage:String;
out CreationTime,LastWriteTime,LastAccessTime,ChangeTime:TDateTime;
out FileAttributes:Integer):Boolean;
var
fd:THandle;
StatusBlock:IO_STATUS_BLOCK;
FileInformation:FILE_BASIC_INFORMATION;
r:ULong;
begin
Result := False;SetLastError(0);ErrMessage:='';
fd:=CreateFile(Pchar(FileName),GENERIC_READ,FILE_SHARE_READ,Nil,OPEN_EXISTING,FILE_FLAG_BACKUP_SEMANTICS,0);
if fd = INVALID_HANDLE_VALUE then begin
ErrMessage := 'Ошибка при открытии файла "'+FileName+'"';
end
else begin
try
r:=NtQueryInformationFile(fd,@StatusBlock,@FileInformation,sizeof(FileInformation),FileBasicInformation);
if r = STATUS_SUCCESS then begin
CreationTime:=FileTimeToDateTime(FileInformation.CreationTime);
LastAccessTime:=FileTimeToDateTime(FileInformation.LastAccessTime);
LastWriteTime:=FileTimeToDateTime(FileInformation.LastWriteTime);
ChangeTime:=FileTimeToDateTime(FileInformation.ChangeTime);
Result:=True;
end
else begin
ErrMessage := 'Ошибка при вызове NtQueryInformationFile()';
SetLastError(RtlNtStatusToDosError(r));
end;
finally
CloseHandle(fd);
end;
end;
end;
//Запись времён и атрибутов файла (или каталога, который с т.з. ОС тоже файл)
// FileName - имя файла или каталога
// ErrMessage - буфер для дополнительного текста ошибки
// CreationTime,LastWriteTime,LastAccessTime,ChangeTime - 4 устанавливаемые даты
// FileAttributes - набор устанавливаемых атрибутов (битовая маска)
//Если какие-то параметры менять не нужно, передать значение 0.
//Выход: true/false
//Если result = False, проверять GetLastError или вызывать RaiseLastOSError(),чтобы понять причину
function SetFileDatesAndAttr(const FileName:String;out ErrMessage:String;
CreationTime:TDateTime=0;LastWriteTime:TDateTime=0;LastAccessTime:TDateTime=0;
ChangeTime:TDateTime=0;FileAttributes:Integer=0):Boolean;
var
fd:THandle;
StatusBlock:IO_STATUS_BLOCK;
FileInformation:FILE_BASIC_INFORMATION;
r:ULong;
procedure SetFITime(DTTime:TDateTime;out Ft:TFileTime);
begin
if DTTime = 0 then begin
ft.dwHighDateTime:=0;
ft.dwLowDateTime:=0;
end
else begin
ft:=DateTimeToFileTime(DTTime);
end;
end;
begin
Result := False;SetLastError(0);ErrMessage:='';
fd:=CreateFile(Pchar(FileName),GENERIC_WRITE,FILE_SHARE_WRITE,Nil,OPEN_EXISTING,FILE_FLAG_BACKUP_SEMANTICS,0);
if fd = INVALID_HANDLE_VALUE then begin
ErrMessage := 'Ошибка при открытии файла "'+FileName+'"';
end
else begin
try
SetFITime(CreationTime,FileInformation.CreationTime);
SetFITime(LastWriteTime,FileInformation.LastWriteTime);
SetFITime(LastAccessTime,FileInformation.LastAccessTime);
SetFITime(ChangeTime,FileInformation.ChangeTime);
FileInformation.FileAttributes:=FileAttributes;
FileInformation.Reserve:=0; //От греха подальше...
r:=NtSetInformationFile(fd,@StatusBlock,@FileInformation,sizeof(FileInformation),FileBasicInformation);
if r = STATUS_SUCCESS then begin
Result:=True;
end
else begin
ErrMessage := 'Ошибка при вызове NtQueryInformationFile()';
SetLastError(RtlNtStatusToDosError(r));
end;
finally
CloseHandle(fd);
end;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
var AddErr:String;
dtCreate,dtModify,dtAcc,dtChg:TDateTime;
Attr:Integer;
s:String;
begin
s:='c:\98';AddErr:='Возникло исключение: ';
try
if not SetFileDatesAndAttr(s,AddErr,StrToDateTime('01.01.2011'),
StrToDateTime('01.02.2011'),StrToDateTime('01.03.2011'),
StrToDateTime('01.04.2011'),0) then
RaiseLastOSError();
if not GetFileDatesAndAttr(s,AddErr,dtCreate,dtModify,dtAcc,dtChg,Attr) then
RaiseLastOSError();
showmessage('Установленные даты для "'+s+'"'#13#10+
DateTimeToStr(dtCreate)+' '+DateTimeToStr(dtModify)+' '+
DateTimeToStr(dtAcc)+' '+DateTimeToStr(dtChg));
except
on e:Exception do
ShowMessage(AddErr+': '#13#10+e.Message);
end;
end;
---------------------------
Project1
---------------------------
Установленные даты для "c:\98"
01.01.2011 01.02.2011 01.03.2011 01.04.2011
---------------------------
OK
---------------------------
