mSelectFolder.bas
上传用户:davilee3
上传日期:2015-04-22
资源大小:986k
文件大小:4k
源码类别:

浏览器

开发平台:

Visual Basic

  1. Attribute VB_Name = "mSelectFolder"
  2. Option Explicit
  3. Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
  4. '  很明显它需要一个 BROWSEINFO 结构的指针,如下:
  5. Public Type BROWSEINFO
  6.     hOwner As Long                 '父窗口的句柄
  7.     pidlRoot As Long               '指向希望浏览的最上层的文件夹的标识符列表,可设为0
  8.     pszDisplayName As String       '返回你所选择的文件夹(带一个NULL字符)
  9.     lpszTitle As String            '对话框标题(要以vbNullChar结尾)
  10.     ulFlags As Long                '浏览标志(见下面)
  11.     lpfn As Long                   '回调函数的地址,可设为NULL
  12.     lParam As Long                 '若有回调函数,此项设置它的值
  13.     iImage As Long                 '保存所选文件夹映像索引的缓冲区
  14. End Type
  15. '  其中,ulFlags 可设置为以下几种值:
  16. 'Public Const BIF_BROWSEFORCOMPUTER = &H1000             '允许浏览计算机
  17. 'Public Const BIF_BROWSEFORPRINTER = &H2000              '允许浏览打印机文件夹
  18. 'Public Const BIF_BROWSEINCLUDEFILES = &H4000            '允许同时浏览文件(需IE4)
  19. 'Public Const BIF_DONTGOBELOWDOMAIN = &H2                '强制用户停留在网上邻居中
  20. 'Public Const BIF_EDITBOX = &H10                         '可在输入框中直接输入文件夹名(需IE4)
  21. 'Public Const BIF_RETURNFSANCESTORS = &H8                '返回文件系统祖先?
  22. 'Public Const BIF_RETURNONLYFSDIRS = &H1                 '仅允许浏览文件系统
  23. 'Public Const BIF_STATUSTEXT = &H4                       '显示状态栏
  24. 'Public Const BIF_USENEWUI = &H40                        '使用新界面(仅支持Win2000、WinME)
  25. 'Public Const BIF_VALIDATE = &H20                        '若输入一个非法文件夹名,就返回
  26.                                                         'BFFM_VALIDATEFAILED 给回调函数
  27.                                                         
  28. Public Const BIF_BROWSEFORCOMPUTER = &H1000
  29. Public Const BIF_BROWSEFORPRINTER = &H2000
  30. Public Const BIF_BROWSEINCLUDEFILES = &H4000
  31. Public Const BIF_BROWSEINCLUDEURLS = &H80
  32. Public Const BIF_DONTGOBELOWDOMAIN = &H2
  33. Public Const BIF_EDITBOX = &H10
  34. Public Const BIF_NEWDIALOGSTYLE = &H40
  35. Public Const BIF_RETURNFSANCESTORS = &H8
  36. Public Const BIF_RETURNONLYFSDIRS = &H1
  37. Public Const BIF_SHAREABLE = &H8000
  38. Public Const BIF_STATUSTEXT = &H4
  39. Public Const BIF_USENEWUI = &H50
  40. Public Const BIF_VALIDATE = &H20
  41.                                                         
  42. '  有了这些还不够,因为 SHBrowseForFolder 返回的是文件夹的标识符列表(pidl),还需要用另一个函数将标识符列表转换成系统文件夹,这就是 SHGetPathFromIDList:
  43. Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
  44. Public Function BrowseForFolder(nFolder As String, Optional Title As String, Optional hWnd As Long = 0) As Boolean
  45.     Dim bi As BROWSEINFO
  46.     Dim pidl As Long
  47.     Dim folder As String
  48.     
  49.     Dim func  As Boolean
  50.     
  51.     folder = String(255, vbNullChar)
  52.   
  53.     With bi
  54.         .hOwner = hWnd
  55.         .ulFlags = BIF_RETURNONLYFSDIRS Or BIF_DONTGOBELOWDOMAIN
  56.         .pidlRoot = 0
  57.         .lpszTitle = IIf(Title <> "", Title & vbNullChar, "Select a folder:" & vbNullChar)
  58.     End With
  59.        
  60.     pidl = SHBrowseForFolder(bi)
  61.     
  62.     If pidl <> 0 Then
  63.         If SHGetPathFromIDList(ByVal pidl, ByVal folder) Then
  64.             nFolder = Left(folder, InStr(folder, vbNullChar) - 1)
  65.             func = True
  66.         Else
  67.             nFolder = ""
  68.             func = False
  69.         End If
  70.     Else
  71.         nFolder = ""
  72.         func = False
  73.     End If
  74.     
  75.     BrowseForFolder = func
  76. End Function