选择目录对话框

unit ShlObjEx;

interface
uses 
  Windows,ShlObj,ShellAPI;

const
  SHCNE_RENAMEITEM=          $00000001;
  SHCNE_CREATE=              $00000002;
  SHCNE_DELETE=              $00000004;
  SHCNE_MKDIR=               $00000008;
  SHCNE_RMDIR=               $00000010;
  SHCNE_MEDIAINSERTED=       $00000020;
  SHCNE_MEDIAREMOVED=        $00000040;
  SHCNE_DRIVEREMOVED=        $00000080;
  SHCNE_DRIVEADD=            $00000100;
  SHCNE_NETSHARE=            $00000200;
  SHCNE_NETUNSHARE=          $00000400;
  SHCNE_ATTRIBUTES=          $00000800;
  SHCNE_UPDATEDIR=           $00001000;
  SHCNE_UPDATEITEM=          $00002000;
  SHCNE_SERVERDISCONNECT=    $00004000;
  SHCNE_UPDATEIMAGE=         $00008000;
  SHCNE_DRIVEADDGUI=         $00010000;
  SHCNE_RENAMEFOLDER=        $00020000;
  SHCNE_FREESPACE=           $00040000;

//#if (_WIN32_IE >= $0400)
{
SHCNE_EXTENDED_EVENT: the extended event is identified in dwItem1,
packed in LPITEMIDLIST format (same as SHCNF_DWORD packing).
Additional information can be passed in the dwItem2 parameter
of SHChangeNotify (called "pidl2" below), which if present, must also
be in LPITEMIDLIST format.
Unlike the standard events, the extended events are ORDINALs, so we
don't run out of bits.  Extended events follow the SHCNEE_* naming
convention.
The dwItem2 parameter varies according to the extended event.
}

  SHCNE_EXTENDED_EVENT=      $04000000;
  //#endif      (_WIN32_IE >= $0400)

  SHCNE_ASSOCCHANGED=        $08000000;

  SHCNE_DISKEVENTS=          $0002381F;
  SHCNE_GLOBALEVENTS=        $0C0581E0; //Events that dont match pidls first
  SHCNE_ALLEVENTS=           $7FFFFFFF;
  SHCNE_INTERRUPT=           $80000000;
{The presence of this flag indicates
                                            that the event was generated by an
                                            interrupt.  It is stripped out before
                                            the clients of SHCNNotify_ see it.
}

//#if (_WIN32_IE >= $0400)
{
SHCNE_EXTENDED_EVENT extended events.  These events are ordinals.
This is not a bitfield.
}

  SHCNEE_ORDERCHANGED         =2;  //pidl2 is the changed folder
  SHCNEE_MSI_CHANGE           =4;  //pidl2 is a SHChangeProductKeyAsIDList
  SHCNEE_MSI_UNINSTALL        =5;  //pidl2 is a SHChangeProductKeyAsIDList
//#endif


  SHCNRF_InterruptLevel=       $0001; //Interrupt level notifications from the file system.
  SHCNRF_ShellLevel=           $0002; //Shell-level notifications from the shell.
  SHCNRF_RecursiveInterrupt=   $1000;
{
Interrupt events on the whole subtree. This flag must be combined with the SHCNRF_InterruptLevel flag. 
When using this flag, notifications must also be made recursive by setting the fRecursive member of the 
corresponding SHChangeNotifyEntry structure referenced by pfsne to TRUE.
}
  SHCNRF_NewDelivery=   $8000;
{
Messages received use shared memory. Call SHChangeNotification_Lock to access the actual data. Call
SHChangeNotification_Unlock to release the memory when done.
}

//uFlags & SHCNF_TYPE is an ID which indicates what dwItem1 and dwItem2 mean
  SHCNF_IDLIST =    $0000;        //LPITEMIDLIST
  SHCNF_PATHA =     $0001;      //path name
  SHCNF_PRINTERA=    $0002;        //printer friendly name
  SHCNF_DWORD=       $0003;        //DWORD
  SHCNF_PATHW=       $0005;        //path name
  SHCNF_PRINTERW=    $0006;        //printer friendly name
  SHCNF_TYPE=       $00FF;
  SHCNF_FLUSH=       $1000;
  SHCNF_FLUSHNOWAIT= $2000;

{$ifdef UNICODE}
  SHCNF_PATH=      SHCNF_PATHW;
  SHCNF_PRINTER=   SHCNF_PRINTERW;
{$else}
  SHCNF_PATH=      SHCNF_PATHA;
  SHCNF_PRINTER=   SHCNF_PRINTERA;
{$endif}

type
  PSHChangeNotifyEntry=^TSHChangeNotifyEntry;
  TSHChangeNotifyEntry=packed record
    pdil:PITEMIDLIST;
    fRecursive:BOOL;
  end;
  PSHChangeNotifyStruct = ^TSHChangeNotifyStruct;
  TSHChangeNotifyStruct = record
    pidlArr:array [0..1] of PItemIDList;
  end;

function SHChangeNotifyRegister(
  hwnd:HWND;
  fSources:Integer;
  fEvents:LongInt;
  wMsg:UINT;
  cEntries:Integer;
  pfsne:PSHChangeNotifyEntry
  ):Cardinal;stdcall;
function SHChangeNotifyDeregister(
  ulID:Cardinal):BOOL;stdcall;
function SHILCreateFromPath(
  pszPath:PWideChar;
  var ppidl:PITEMIDLIST;
  rgflnOut:PDWORD):HRESULT;stdcall;

function SelectDirectory(sCaption:string='';sRootDir:string=''):string;

implementation

function SHChangeNotifyRegister; external Shell32 index 2;
function SHChangeNotifyDeregister; external Shell32 index 4;
function SHILCreateFromPath; external Shell32 index 28;

function SelectDirectory(sCaption:string;sRootDir:string):string;
var
  bi:TBrowseInfo;
begin
  if sCaption='' then sCaption:='选择目录';
  ZeroMemory(@bi,SizeOf(bi));
  if DirectoryExists(sRootDir) then
    SHILCreateFromPath(PWideChar(WideString(sRootDir)),bi.pidlRoot,nil)
  else
    SHGetSpecialFolderLocation(0,CSIDL_DESKTOP,bi.pidlRoot);
  bi.hwndOwner:=0;
  bi.lpszTitle:=PAnsiChar(sCaption);
  SetLength(Result,MAX_PATH+1);
  if not SHGetPathFromIDList(SHBrowseForFolder(bi),PAnsiChar(Result)) then
    SetLength(Result,0);
end;

end.