//选择文件夹
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 ,'.*');//后面是类型
|
请发表评论