vb 利用API 打开文件浏览窗口 选择返回目录

代码

Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260

Private  Declare  Function  SHBrowseForFolder Lib  " shell32 "  (lpbi  As  BrowseInfo)  As   Long

Private  Declare  Function  SHGetPathFromIDList Lib  " shell32 "  (ByVal pidList  As   Long , ByVal lpBuffer  As   String )  As   Long

Private  Declare  Function  lstrcat Lib  " kernel32 "  Alias  " lstrcatA "  (ByVal lpString1  As   String , ByVal lpString2  As   String )  As   Long

Private  Type BrowseInfo
      hWndOwner              As   Long
      pIDLRoot               As   Long
      pszDisplayName         As   Long
      lpszTitle              As   Long
      ulFlags                As   Long
      lpfnCallback           As   Long
      lParam                 As   Long
      iImage                 As   Long
End  Type

Dim  bi  As  BrowseInfo         ' ''创建浏览窗口
     Dim  folderid  As   Long          ' ''返回一个文件夹的 句柄
     Dim  pb  As   String              ' ''返回路径
     With  bi
        .hWndOwner  =  Me.hWnd
        .lpszTitle  =  lstrcat( " 选择安装目录... " ,  "" )
        .ulFlags  =  BIF_RETURNONLYFSDIRS  +  BIF_DONTGOBELOWDOMAIN
     End   With
    folderid  =  SHBrowseForFolder(bi)
        
     If  folderid  =   0   Then   Exit   Sub
    
    pb  =   String $(MAX_PATH,  0 )
    
    SHGetPathFromIDList folderid, pb
    
    pb  =   Left $(pb,  InStr (pb, vbNullChar)  -   1 )
    

    txtInstallDir.Text  =  pb  &   " Web "

 

转载于:https://www.cnblogs.com/lano/archive/2009/12/09/1620089.html