API - abrir dialogo para localizar arquivos do windows

Top  Previous  Next

uses ShlObj, ActiveX, ShellAPI;

 

type

  TSpecialFolder = (sfRecycleBin, sfControlPanel, sfDesktop, sfDesktopDirectory,

                    sfMyComputer, sfFonts, sfNetHood, sfNetwork, sfPersonal, sfPrinters,

                    sfPrograms, sfRecent, sfSendTo, sfStartMenu, stStartUp, sfTemplates);

 

const

  FFolder: array[TSpecialFolder] of integer = (

    CSIDL_BITBUCKET, CSIDL_CONTROLS, CSIDL_DESKTOP, CSIDL_DESKTOPDIRECTORY,

    CSIDL_DRIVES, CSIDL_FONTS, CSIDL_NETHOOD, CSIDL_NETWORK, CSIDL_PERSONAL,

    CSIDL_PRINTERS, CSIDL_PROGRAMS, CSIDL_RECENT, CSIDL_SENDTO, CSIDL_STARTMENU,

    CSIDL_STARTUP, CSIDL_TEMPLATES);

 

function FindFilesDlg(StartIn: string; SpecialFolder: TSpecialFolder; UseFolder: boolean): boolean;

var

  pidl   : PITEMIDLIST;

  PMalloc: IMalloc;

  sei    : TShellExecuteInfo;

begin

  try

    SHGetMalloc(PMalloc);

    FillChar(sei, sizeof(TShellExecuteInfo), 0);

    sei.lpVerb := 'find';

    sei.cbSize := SizeOf(sei);

    if UseFolder then

    begin

      SHGetSpecialFolderLocation(0, FFolder[SpecialFolder], pidl);

      with sei do

      begin

        fMask := SEE_MASK_INVOKEIDLIST;

        lpIDList := pidl;

      end;

    end

    else

      sei.lpFile := PChar(StartIn);

    Result := ShellExecuteEx(@sei);

  finally

    pMalloc._Release;

    pMalloc := nil;

  end;

end;

 

procedure TForm1.Button1Click(Sender: TObject);

begin

  FindFilesDlg('C:\temp', sfDesktop, False);

end;