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

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

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

:: MVP ::

:: RSS ::

Яндекс.Метрика

Как получить список файлов в каталоге?

// Способ первый
procedure TForm1.Button1Click(Sender: TObject);
var
  isFound: Boolean;
  sRec: TSearchRec;
begin
   isFound := FindFirst('c:\*.*', faAnyFile, sRec) = 0;
   while isFound do
   begin
      if (sRec.Name <> '.') and
         (sRec.Name <> '..') and
         ((sRec.Attr and faDirectory) <> faDirectory) then
         ShowMessage(sRec.Name);
      isFound := FindNext(sRec) = 0;
   end;
end;

// Способ второй
uses
  System.IOUtils;

procedure TForm1.Button1Click(Sender: TObject);
var
  FileName: string;
begin
   for FileName in TDirectory.GetFiles('c:\') do
      ShowMessage(ExtractFileName(FileName));
end;


Как прочитать владельца файла (NTFS)?

function GetFileOwner( FileName: string; var Domain, Username: string ): boolean;
var
  SecDescr: PSecurityDescriptor;
  SizeNeeded, SizeNeeded2: DWORD;
  OwnerSID: PSID;
  OwnerDefault: BOOL;
  OwnerName, DomainName: PChar;
  OwnerType: SID_NAME_USE;
begin
   Result := false;
   GetMem( SecDescr, 1024 );
   GetMem( OwnerSID, SizeOf( PSID ) );
   GetMem( OwnerName, 1024 );
   GetMem( DomainName, 1024 );
   try
      if not GetFileSecurity( PChar( FileName ),
      OWNER_SECURITY_INFORMATION,
      SecDescr, 1024, SizeNeeded ) then
         Exit;
      if not GetSecurityDescriptorOwner( SecDescr, OwnerSID, OwnerDefault) then
         Exit;
      SizeNeeded := 1024;
      SizeNeeded2 := 1024;
      if not LookupAccountSID( nil, OwnerSID, OwnerName,
      SizeNeeded, DomainName, SizeNeeded2, OwnerType ) then
         Exit;
      Domain := DomainName;
      Username := OwnerName;
   finally
      FreeMem( SecDescr );
      FreeMem( OwnerName );
      FreeMem( DomainName );
   end;
   Result := true;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Domain, Username: string;
begin
   GetFileOwner( 'C:\имя.файла', Domain, Username );
   ShowMessage( Username + '@' + Domain );
end;


Как определить, является ли диск NTFS?

uses
  {...,} ComObj;

function IsNTFS( AFileName: string ): boolean;
var
  fso, drv: OleVariant;
begin
   IsNTFS := False;
   fso := CreateOleObject( 'Scripting.FileSystemObject' );
   drv := fso.GetDrive( fso.GetDriveName( AFileName ) );
   IsNTFS := drv.FileSystem = 'NTFS'
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if IsNTFS( 'C:\' ) then
      ShowMessage( 'Диск с файловой системой NTFS' )
   else
      ShowMessage( 'Диск не с файловой системой NTFS' );
end;


Как узнать количество иконок в файле (*.exe, *.dll)?

procedure TForm1.FormCreate(Sender: TObject);
const
  //path = 'calc.exe';
  //path = 'notepad.exe';
  //path = 'mspaint.exe';
  path = 'shell32.dll';
var
  hi: HICON;
  i: integer;
begin
   i := 0;
   hi := ExtractIcon( HInstance, path, 0 );
   while ( hi > 0 ) do
   begin
      Inc( i );
      hi := ExtractIcon( HInstance, path, i );
   end;
   Caption := IntToStr( i );
end;


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

function DirectoryIsEmpty( Directory: string ): boolean;
var
  sr: TSearchRec;
  i: Integer;
begin
   Result := false;
   FindFirst( IncludeTrailingPathDelimiter( Directory ) + '*', faAnyFile, sr );
   for i := 1 to 2 do
      if ( sr.Name = '.' ) or ( sr.Name = '..' ) then
         Result := FindNext( sr ) <> 0;
   FindClose( sr );
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if DirectoryIsEmpty( 'C:\test' ) then
      Caption := 'Пустая директория'
   else
      Caption := 'В директории есть файлы';
end;


Как определить тип файла (как в диалоге "Свойства файла")?

uses
  {...,} ShellAPI;

function MrsGetFileType( const strFilename: string ): string;
var
  FileInfo: TSHFileInfo;
begin
   FillChar( FileInfo, SizeOf( FileInfo), #0 );
   SHGetFileInfo( PChar( strFilename), 0, FileInfo, SizeOf( FileInfo ), SHGFI_TYPENAME );
   Result := FileInfo.szTypeName;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   Caption := MrsGetFileType( 'c:\autoexec.bat' );
end;


Как заменить текст в текстовом файле?

procedure FileReplaceString( const FileName, SearchString, ReplaceString: string );
var
  fs: TFileStream;
  s: string;
begin
   fs := TFileStream.Create( FileName, fmOpenread or fmShareDenyNone );
   try
      SetLength( s, fs.Size );
      fs.ReadBuffer( s[1], fs.Size );
   finally
      fs.Free;
   end;
   s := StringReplace( s, SearchString, replaceString, [rfReplaceAll, rfIgnoreCase] );
   fs := TFileStream.Create( FileName, fmCreate );
   try
      fs.WriteBuffer( s[1], Length( S ) );
   finally
      fs.Free;
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   FileReplaceString( 'c:\test.txt', 'OldText', 'NewText' );
end;


Как удалить символ '\' из конца пути?

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

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


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

uses
  {...,} ShlObj, ClipBrd;

procedure CopyFilesToClipboard( FileList: string );
var
  DropFiles: PDropFiles;
  hGlobal: THandle;
  iLen: Integer;
begin
   iLen := Length( FileList ) + 2;
   FileList := FileList + #0#0;
   hGlobal := GlobalAlloc( GMEM_SHARE or GMEM_MOVEABLE or GMEM_ZEROINIT, SizeOf( TDropFiles ) + iLen );
   if ( hGlobal = 0 ) then raise Exception.Create( 'Could not allocate memory.' );
   begin
      DropFiles := GlobalLock( hGlobal );
      DropFiles^.pFiles := SizeOf( TDropFiles );
      Move( FileList[1], ( PChar( DropFiles ) + SizeOf( TDropFiles ) )^, iLen );
      GlobalUnlock( hGlobal);
      Clipboard.SetAsHandle( CF_HDROP, hGlobal );
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   CopyFilesToClipboard( 'C:\boot.ini'#0'C:\autoexec.bat' );
end;

// Файлы должны разделяться про помощи #0


Как определить время последнего изменения файла?

// Способ первый
function GetFileModifyDate( FileName: string ): TDateTime;
var
  h: THandle;
  Struct: TOFSTRUCT;
  LastWrite: Integer;
begin
   // h := OpenFile( PChar( FileName ), Struct, OF_SHARE_DENY_NONE );
   h := CreateFile( PChar( FileName ), GENERIC_READ, FILE_SHARE_READ, nil,
                    OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0 );
   try
      if h <> HFILE_ERROR then
      begin
         LastWrite := FileGetDate( h );
         Result := FileDateToDateTime( lastwrite );
      end;
   finally
      CloseHandle( h );
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   Caption := FormatDateTime( 'dddd, d. mmmm yyyy hh:mm:ss',
      GetFileModifyDate( 'c:\Dir1\1.txt' ) );
end;

// Способ второй
procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage(DateToStr(FileDateToDateTime(FileAge('c:\pagefile.sys'))));
end;

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