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;

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