delphi选择文件夹
//选择文件夹
function SelectFolderDialog(const Handle: integer;
const Caption: string;
const InitFolder: WideString;
var SelectedFolder: string): boolean;
var
BInfo: _browseinfo;
Buffer: array[0..MAX_PATH] of
Char;
ID: IShellFolder;
Eaten, Attribute: Cardinal;
ItemID:
PItemidlist;
begin
Result := False;
BInfo.HwndOwner := Handle;
BInfo.lpfn := nil;
BInfo.lpszTitle := Pchar(Caption);
BInfo.ulFlags := BIF_RETURNONLYFSDIRS + BIF_NEWDIALOGSTYLE;
SHGetDesktopFolder(ID);
ID.ParseDisplayName(0, nil,
PWideChar(InitFolder), Eaten, ItemID, Attribute);
BInfo.pidlRoot := ItemID;
GetMem(BInfo.pszDisplayName, MAX_PATH);
try
if SHGetPathFromIDList(SHBrowseForFolder(BInfo), Buffer) then
begin
SelectedFolder := Buffer;
if Length(SelectedFolder) <> 3 then SelectedFolder := SelectedFolder + '\';
result := True;
end
else
begin
SelectedFolder := '';
Result := False;
end;
finally
FreeMem(BInfo.pszDisplayName);
end;
end;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
NewDir: string;
begin
if SelectFolderDialog(Handle, '选择', '', NewDir)
then
label1.Caption:=NewDir;
end;
end.
//搜索目录下所有文件
function MakeFileList(Path,FileExt:string):TStringList
;
var
sch:TSearchrec;
begin
Result:=TStringlist.Create;
if rightStr(trim(Path), 1) <> '\' then
Path := trim(Path) +
'\'
else
Path := trim(Path);
if not DirectoryExists(Path) then
begin
Result.Clear;
exit;
end;
if FindFirst(Path + '*', faAnyfile, sch) = 0 then
begin
repeat
Application.ProcessMessages;
if ((sch.Name = '.') or
(sch.Name = '..')) then Continue;
if DirectoryExists(Path+sch.Name)
then // 这个地方加上一个判断，可以区别子文件夹河当前文件夹的操作
begin
Result.AddStrings(MakeFileList(Path+sch.Name,FileExt));
end
else
begin
if (UpperCase(extractfileext(Path+sch.Name)) =
UpperCase(FileExt)) or (FileExt='.*') then
Result.Add(Path+sch.Name);
end;
until FindNext(sch) <>
0;
SysUtils.FindClose(sch);
end;
end;
//
ListBox1.Items:= MakeFileList(Label1.Caption ,'.*');//后面是类型