:: MVP ::
|
|
:: RSS ::
|
|
|
Как изменить атрибуты файла?
// r - ReadOnly
// h - Hidden
// s - SysFile
// a - Archive
// Способ первый
procedure SetAttribut(Path: string; r, h, s, a: Char);
var
At: Integer;
begin
At := FileGetAttr(Path);
case r of
'-': if (At and faReadOnly) = faReadOnly then
FileSetAttr(Path, At - faReadOnly);
'+': if (At and faReadOnly) = 0 then
FileSetAttr(Path, At + faReadOnly);
end;
At := FileGetAttr(Path);
case h of
'-': if (At and faHidden) = faHidden then
FileSetAttr(Path, At - faHidden);
'+': if (At and faHidden) = 0 then
FileSetAttr(Path, At + faHidden);
end;
At := FileGetAttr(Path);
case s of
'-': if (At and faSysFile) = faSysFile then
FileSetAttr(Path, At - faSysFile);
'+': if (At and faSysFile) = 0 then
FileSetAttr(Path, At + faSysFile);
end;
At := FileGetAttr(Path);
case a of
'-': if (At and faArchive) = faArchive then
FileSetAttr(Path, At - faArchive);
'+': if (At and faArchive) = 0 then
FileSetAttr(Path, At + faArchive);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SetAttribut('c:\test.txt', '+', '-', ' ', ' ');
end;
// Способ второй
procedure SetAttribut(Path: string; r, h, s, a: Char);
var
At: Integer;
begin
At := FileGetAttr(Path);
if r = '+' then At := At or faReadOnly;
if r = '-' then At := At and not faReadOnly;
if h = '+' then At := At or faHidden;
if h = '-' then At := At and not faHidden;
if s = '+' then At := At or faSysFile;
if s = '-' then At := At and not faSysFile;
if a = '+' then At := At or faArchive;
if a = '-' then At := At and not faArchive;
FileSetAttr(Path, At);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SetAttribut('c:\test.txt', '+', '-', ' ', ' ');
end;
// '+' - установить атрибут
// '-' - снять атрибут
// ' ' - оставить без изменения
|
Как определить время создания файла?
function GetFileDate( FileName: string ): string;
var
sr: TSearchRec;
DT: TFileTime;
ST: TSystemTime;
begin
FindFirst(FileName, faAnyFile, sr);
FileTimeToLocalFileTime(sr.FindData.ftCreationTime, DT);
FileTimeToSystemTime(DT, ST);
Result := Format('%.2d.%.2d.%.4d %d:%.2d:%.2d',
[st.wDay, st.wMonth, st.wYear, st.wHour, st.wMinute, st.wSecond]);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(GetFileDate('C:\autoexec.bat'));
end;
|
Как создать несколько каталогов, вложенных друг в друга?
// Способ первый
procedure CreateDirEx(Path: string);
var
Temp: string;
begin
if Path[Length(Path)] <> '\' then
Path := Path + '\';
Temp := Copy(Path, 1, Pos('\', Path));
Delete(Path, 1, Pos('\', Path));
while Length(Path) > 0 do
begin
Temp := Temp + Copy(Path, 1, Pos('\', Path));
Delete(Path, 1, Pos('\', Path));
if not DirectoryExists(Temp) then
CreateDir(Temp);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
CreateDirEx('c:\Dir1\Dir2\Dir3');
end;
// Способ второй
procedure TForm1.Button1Click(Sender: TObject);
begin
ForceDirectories('c:\Dir1\Dir2\Dir3');
end;
|
Как изменить дату создания файла?
function SetFileDateTime(const FileName: string; NewDateTime: TDateTime): Boolean;
var
FileHandle: Integer;
FileTime: TFileTime;
LFT: TFileTime;
LST: TSystemTime;
begin
Result := False;
try
DecodeDate(NewDateTime, LST.wYear, LST.wMonth, LST.wDay);
DecodeTime(NewDateTime, LST.wHour, LST.wMinute, LST.wSecond, LST.wMilliSeconds);
if SystemTimeToFileTime(LST, LFT) then
begin
if LocalFileTimeToFileTime(LFT, FileTime) then
begin
FileHandle := FileOpen(FileName, fmOpenReadWrite or fmShareExclusive);
if SetFileTime(FileHandle, nil, nil, @FileTime) then
Result := True;
end;
end;
finally
FileClose(FileHandle);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SetFileDateTime('C:\Test.txt', StrToDateTime('01.01.2004 15:00'));
end;
|
Как изменить дату создания каталога?
// Способ первый
function SetDirTime(const Dir: string;
Year, Month, Day, Hour, Minute, Second: Word): Boolean;
var
h: Integer;
f: TFileTime;
s: TSystemTime;
begin
h := CreateFile(PChar(Dir), $0100, 0, nil, OPEN_EXISTING,
FILE_FLAG_BACKUP_SEMANTICS, 0);
if h <> -1 then
begin
s.wYear := Year;
s.wMonth := Month;
s.wDay := Day;
s.wHour := Hour;
s.wMinute := Minute;
s.wSecond := Second;
SystemTimeToFileTime(s, f);
LocalFileTimeToFileTime(f, f);
Result := Boolean(SetFileTime(h, @f, @f, @f));
CloseHandle(h);
end
else
Result := False;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if not SetDirTime('c:\Test', 2004, 1, 1, 12, 0, 0) then
ShowMessage('Произошла ошибка');
end;
// Способ второй
function SetDirTime(const Dir: string; DateTime: TDateTime): Boolean;
var
h: Integer;
f: TFileTime;
s: TSystemTime;
begin
h := CreateFile(PChar(Dir), $0100, 0, nil, OPEN_EXISTING,
FILE_FLAG_BACKUP_SEMANTICS, 0);
if h <> -1 then
begin
DateTimeToSystemTime(DateTime, s);
SystemTimeToFileTime(s, f);
LocalFileTimeToFileTime(f, f);
Result := Boolean(SetFileTime(h, @f, @f, @f));
CloseHandle(h);
end
else
Result := False;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if not SetDirTime('c:\Test', StrToDateTime('01.01.2004 15:00')) then
ShowMessage('Произошла ошибка');
end;
|
При использовании материала - ссылка на сайт обязательна
|
|