form.pas

Delphi高级程序开发配书源代码,可以循序渐进的学习Delphi.

unit form;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, FileCtrl, Grids, Outline, DirOutln;

type
  TMainForm = class(TForm)
    dcbDrives: TDriveComboBox;
    edtFileMask: TEdit;
    lblFileMask: TLabel;
    btnSearchForFiles: TButton;
    lbFiles: TListBox;
    dolDirectories: TDirectoryOutline;
    Label1: TLabel;
    btnClose: TButton;
    procedure btnSearchForFilesClick(Sender: TObject);
    procedure dcbDrivesChange(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
  private
    FFileName: String;
    function GetDirectoryName(Dir: String): String;
    procedure FindFiles(APath: String);
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

function TMainForm.GetDirectoryName(Dir: String): String;
begin
  if Dir[Length(Dir)]<> '\' then
    Result := Dir+'\'
  else
    Result := Dir;
end;

procedure TMainForm.FindFiles(APath: String);
var
  FSearchRec,
  DSearchRec: TSearchRec;
  FindResult: integer;

  function IsDirNotation(ADirName: String): Boolean;
  begin
    Result := (ADirName = '.') or (ADirName = '..');
  end;

begin
  APath := GetDirectoryName(APath);
  FindResult := FindFirst(APath+FFileName,faAnyFile+faHidden+
                          faSysFile+faReadOnly,FSearchRec);
  try
    while FindResult = 0 do
    begin
      lbFiles.Items.Add(LowerCase(APath+FSearchRec.Name));
      FindResult := FindNext(FSearchRec);
    end;

    FindResult := FindFirst(APath+'*.*', faDirectory, DSearchRec);

    while FindResult = 0 do
    begin
      if ((DSearchRec.Attr and faDirectory) = faDirectory) and not
        IsDirNotation(DSearchRec.Name) then
        FindFiles(APath+DSearchRec.Name);
      FindResult := FindNext(DSearchRec);
    end;
  finally
    FindClose(FSearchRec);
  end;
end;

procedure TMainForm.btnSearchForFilesClick(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;
  try
    lbFiles.Items.Clear;
    FFileName := edtFileMask.Text;
    FindFiles(dolDirectories.Directory);
  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure TMainForm.dcbDrivesChange(Sender: TObject);
begin
  dolDirectories.Drive := dcbDrives.Drive;
end;

procedure TMainForm.btnCloseClick(Sender: TObject);
begin
    MainForm.Close;
end;
end.