Project Structure

• FindFolders.dpr
• FFoldersForm.pas
• FFoldersForm.dfm

program FindFolders;

uses
  Forms,
  FFoldersForm in 'FFoldersForm.pas' {Form1};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

unit FFoldersForm;

interface

{$WARN UNIT_PLATFORM OFF}

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Label1: TLabel;
    TestButton: TButton;
    CreateButton: TButton;
    SelectButton: TButton;
    btnBrowse: TButton;
    procedure TestButtonClick(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure CreateButtonClick(Sender: TObject);
    procedure SelectButtonClick(Sender: TObject);
    procedure btnBrowseClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.TestButtonClick(Sender: TObject);
begin
  if DirectoryExists (Edit1.Text) then
    MessageDlg ('OK, the directory ' +
      Edit1.Text + ' exists', mtInformation, [mbOk], 0)
  else
    MessageDlg ('Sorry, the directory ' + Edit1.Text +
      ' doesn''t exist', mtError, [mbOk], 0);
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
  if Edit1.TExt <> '' then
  begin
    TestButton.Enabled := True;
    CreateButton.Enabled := True;
  end
  else
  begin
    TestButton.Enabled := False;
    CreateButton.Enabled := False;
  end;
end;

procedure TForm1.CreateButtonClick(Sender: TObject);
begin
  if MessageDlg ('Are you sure you want to create the ' +
      Edit1.Text + ' directory', mtConfirmation,
      [mbYes, mbNo], 0) = mrYes then
    ForceDirectories (Edit1.Text);
end;

procedure TForm1.SelectButtonClick(Sender: TObject);
var
  Text: string;
begin
  Text := Edit1.Text;
  if SelectDirectory (Text, [sdAllowCreate,
      sdPerformCreate, sdPrompt], 0) then
    Edit1.Text := Text;
end;

procedure TForm1.btnBrowseClick(Sender: TObject);
var
  bi: TBrowseInfo;
  pidl: pItemIdList;
  strpath, displayname: string;
begin
  SetLength (displayname, 100);

  bi.hwndOwner := Handle;
  bi.pidlRoot := nil;
  bi.pszDisplayName := pChar (displayname);
  bi.lpszTitle := 'Select a folder';
  bi.ulFlags := bif_StatusText;
  bi.lpfn := nil;
  bi.lParam := 0;

  pidl := ShBrowseForFolder (bi);

  SetLength (strPath, 100);
  ShGetPathFromIdList (pidl, PChar(strPath));
  Edit1.Text := strPath;
end;

end.

object Form1: TForm1
  Left = 162
  Top = 173
  Width = 460
  Height = 198
  Caption = 'FindFolders'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clBlack
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 16
    Top = 35
    Width = 16
    Height = 13
    Caption = '&Dir:'
    FocusControl = Edit1
  end
  object Edit1: TEdit
    Left = 48
    Top = 32
    Width = 377
    Height = 21
    TabOrder = 0
    OnChange = Edit1Change
  end
  object TestButton: TButton
    Left = 72
    Top = 72
    Width = 89
    Height = 25
    Caption = 'Test'
    Enabled = False
    TabOrder = 1
    OnClick = TestButtonClick
  end
  object CreateButton: TButton
    Left = 196
    Top = 72
    Width = 85
    Height = 25
    Caption = 'Create'
    Enabled = False
    TabOrder = 2
    OnClick = CreateButtonClick
  end
  object SelectButton: TButton
    Left = 320
    Top = 72
    Width = 81
    Height = 25
    Caption = 'Select'
    TabOrder = 3
    OnClick = SelectButtonClick
  end
  object btnBrowse: TButton
    Left = 72
    Top = 112
    Width = 329
    Height = 25
    Caption = 'Browse for Folder (Windows Shell)'
    TabOrder = 4
    OnClick = btnBrowseClick
  end
end