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.');

   DropFiles := GlobalLock(hGlobal);
   DropFiles^.pFiles := SizeOf(TDropFiles);
   Move(FileList[1], (PChar(DropFiles) + SizeOf(TDropFiles))^, iLen);
   GlobalUnlock(hGlobal);
   Clipboard.SetAsHandle(CF_HDROP, hGlobal);
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;

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