'//該源碼下載自www.aspx1.com(ａｓｐｘ１．ｃｏｍ)

Attribute VB_Name = "modBrowse"
'****************************************************************************
'人人為我，我為人人
'枕善居收藏整理
'發(fā)布日期：2007/03/15
'描    述：網(wǎng)頁搜索音樂播放器  Ver 1.1.0
'網(wǎng)    站：http://www.Mndsoft.com/  (VB6源碼博客)
'網(wǎng)    站：http://www.VbDnet.com/   (VB.NET源碼博客,主要基于.NET2005)
'e-mail  ：Mndsoft@163.com
'e-mail  ：Mndsoft@126.com
'OICQ    ：88382850
'          如果您有新的好的代碼別忘記給枕善居哦!
'****************************************************************************
Option Explicit
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long 'ITEMIDLIST
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Private Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

Private Type SHITEMID
    cb As Long
    abID As Byte
End Type

Private Type ITEMIDLIST  'idl
    mkid As SHITEMID
End Type

'========================================================
'使用此函數(shù)可以出現(xiàn)一個對話框，
'并返回所選擇的路徑，若沒有選擇返回("")。
Function FPath$(nhWnd&, title$)
    Dim bi As BROWSEINFO
    Dim idl As ITEMIDLIST
    Dim rtn&, pidl&, path$, pos%
  
    bi.hOwner = nhWnd&
  
    bi.pidlRoot = idl.mkid.cb
 
    bi.lpszTitle = title$
  
    bi.ulFlags = &H1
  
    pidl& = SHBrowseForFolder(bi)
  
    path$ = Space$(512)
    rtn& = SHGetPathFromIDList(ByVal pidl&, ByVal path$)
      
    pos% = InStr(path$, Chr$(0))
    ''
    FPath$ = Left(path$, pos - 1)
End Function
'========================================================