Delphi

КОМПЬЮТЕРНЫЕ КУРСЫ "ПОИСК"

[Главная страница] [Delphi] [Контакты]

Поиск файлов

При поиске файлов с помощью Delphi используется запись TSearchRec и следующие три функции: FindFirst, FindNext и FindClose. Запись TSearchRec и три функции объявлены в модуле SysUtils.

Чтобы начать поиск каталога, вы должны вызвать функцию FindFirst:

function FindFirst(const Path: string; Attr: Integer; var F: TSearchRec): Integer;

При вызове функции FindFirst для начала поиска файлов вы должны передать в параметре Path как путь к каталогу, так и маску файлов. Следовательно, если необходимо найти все текстовые файлы в корневом каталоге диска С. укажите С:\*.txt в параметре Path.

Параметр Attr позволяет искать дополнительные типы файлов — системные файлы, скрытые файлы и тому подобные. В качестве параметра Attr могут быть переданы следующие константы, которые также объявлены в модуле SysUtils: faReadOnly, faHidden, faSysFile, faDirectory, faArchive и faAnyFile. Существует также константа faVolumelD, но она нигде не является важной и обозначена как неиспользуемая.

При вызове функций FindFirst и FindNext в качестве параметра F необходимо передавать переменную TSearchRec. Обе функции хранят результаты поиска в параметре F, и обе возвращают 0, если файл был найден, или флаг ошибки, не равный 0, если подходящих файлов найдено не было.

Если функция FindFirst возвращает 0, вы можете вызвать функцию FindNext в цикле, чтобы попробовать найти другие файлы, совпадающие с критерием поиска.

В конце следует вызвать функцию FindClose, чтобы освободить память, занимаемую функцией FindFirst:

procedure FindClose (var F: TSearchRec);

В листинге ниже показано, как производится поиск всех файлов в корневом каталоге диска С.

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure ReadDirectory(const APath: string; AList: TStrings);
var
  sRec: TSearchRec;
begin
  AList.Clear;
  AList.BeginUpdate;
  if FindFirst(APath, faAnyFile, sRec) = 0 then
    try
      repeat
        AList.Add(sRec.Name);
      until FindNext(sRec) <> 0;  // Повторять до флага ошибки
    finally
      FindClose(sRec);
    end;  // завершение конструкции FindFirst
  AList.EndUpdate;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ReadDirectory('c:\*.*', ListBox1.Items);
end;

Перечисление доступных устройств

Перечислить доступные устройства можно с помощью API-функции GetLogicalDrives или API-функции GetDriveType (обе функции объявлены в модуле Windows).
Функция GetLogicalDrives является очень простой, поскольку она не принимает никаких параметров;

function GetLogicalDrives: DWORD; stdcall;

Эта функция имеет серьезный недостаток: необходимо знать о том, как проверить, что определенный бит в результирующем значении включен или выключен. Она возвращает битовую маску, в которой бит в позиции 0 представляет устройство А, бит в позиции 1 — устройство В и так далее.

Процедура EnumerateDrives демонстрирует использование функции GetLogicalDrives для перечисления доступных устройств.

procedure EnumerateDrives(AList: TStrings);
var
  Cnd: Integer;
  Disks: set of 0..25;
  Cnt: Integer;
begin
  AList.Clear;
  Integer(Disks) := GetLogicalDrives;
  { Цикл по результату Integer и проверка каждого бита }
  for Cnt := 0 to 25 do
    if Cnt in Disks then
      AList.Add(Chr(Cnt + 65) + ':\');
end;

Код для перечисления доступных устройств будет более понятен, если использовать функцию GetDriveType. Функция GetDriveType служит для определения, является ли устройство фиксированным, съемным или другим, однако ее можно использовать и для перечисления устройств.

Функция GetDriveType принимает указатель на строку с завершающим нулем, содержащую корневой каталог диска, который требуется проверить. Строка, содержащая корневой каталог, должна включать символ обратной косой черты, например, х:\.

function GetDriveType(lpRootPathName: PChar): UINT; stdcall;

В случае успешного выполнения эта функция возвращает одну из констант, перечисленных ниже.

Результаты выполнения функции GetDriveType
Константа Описание
DRIVE_UNKNOWN Неизвестный тип устройства.
DRIVE_NO_ROOT_DIR Корневой каталог не существует.
DRIVE_REMOVAELE Устройство является съемным.
DRIVE_FIXED Устройство является фиксированным.
DRIVE_REMOTE Устройство является сетевым диском.
DRIVE_CDROM Устройство является приводом CD-ROM.
DRIVE_RAMDISK Устройство является виртуальным диском (RAM-диском).

Процедура EnumerateDrives2 в листинге ниже демонстрирует использование функции GetDriveType для перечисления доступных устройств.

procedure EnumrateDrives2(AList: TStrings);
var
  c: Char;
begin
  AList.Clear;
  for c in ['A'..'Z'] do
    if GetDriveType(PChar(c + ':\')) <> DRIVE_NO_ROOT_DIR then
      AList.Add(c + ':\');
end;

В заключение, можно создать простой обозреватель каталогов, добавив в окно Designer Surface (Окно конструктора) компонент TComboBox, и добавив в него доступные устройства в событии OnCreate формы.

Вам придется также присвоить свойству Style компонента TComboBox значение csDropDownList, чтобы пользователь мог выбирать только существующие элементы, и написать обработчик события для его события OnChange, чтобы просматривать корневой каталог выбранного диска:

f1-1

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TMainForm = class(TForm)
    ListBox1: TListBox;
    ComboBox1: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

procedure ReadDirectory(const APath: string; AList: TStrings);
var
  sRec: TSearchRec;
begin
  AList.Clear;
  AList.BeginUpdate;
  if FindFirst(APath, faAnyFile, sRec) = 0 then
  try
    repeat
      AList.Add(sRec.Name);
    until FindNext(sRec) <> 0;  // Повторять до флага ошибки
  finally
    FindClose(sRec);
  end;  // завершение конструкции FindFirst
  AList.EndUpdate;
end;

procedure EnumrateDrives(AList: TStrings);
var
  Cnd: Integer;
  Disks: set of 0..25;
  Cnt: Integer;
begin
  AList.Clear;
  Integer(Disks) := GetLogicalDrives;
  { Цикл по результату Integer и проверка каждого бита }
  for Cnt := 0 to 25 do
    if Cnt in Disks then
      AList.Add(Chr(Cnt + 65) + ':\');
end;

procedure EnumrateDrives2(AList: TStrings);
var
  c: Char;
begin
  AList.Clear;
  for c in ['A'..'Z'] do
    if GetDriveType(PChar(c + ':\')) <> DRIVE_NO_ROOT_DIR then
      AList.Add(c + ':\');
end;

procedure TMainForm.ComboBox1Change(Sender: TObject);
begin
  ReadDirectory(ComboBox1.Text + '*.*', ListBox1.Items);
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  with ComboBox1 do
  begin
    EnumrateDrives2(Items);
    ItemIndex := Items.IndexOf('C:\');
  end;
  ReadDirectory('c:\*.*', ListBox1.Items);
end;

end.

Источник: Иван Хладни - Внутренний мир Borland Delphi 2006.