FAQ VCL
Файлы и файловая система

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: 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 TForm1.Button1Click(Sender: TObject);
begin
  Caption := ExtractShortPathName('D:\Program Files\');
end;


Как определить, соответствует ли файл определенной маске?

uses
  Masks;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if MatchesMask('c:\boot.ini', '*t.?ni') then
    ShowMessage('Файл соответствует маске')
  else
    ShowMessage('Файл не соответствует маске');
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;


Как гарантировать наличие символа '\' в конце пути?

var
  Form1: TForm1;
  Path: string = 'C:\Winnt';

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(IncludeTrailingPathDelimiter(Path));
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;


Как изменить текущую директорию?

procedure TForm1.Button1Click(Sender: TObject);
begin
  SetCurrentDir('c:\');
end;


Как узнать текущую директорию?

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(GetCurrentDir);
end;

При использовании материала - ссылка на сайт обязательна