Как в CommonDialog открыть папку? - VB
Формулировка задачи:
Хочу узнать как можно в CommonDialog открыть папку (Указать её путь).
Я оттолкнулся от CommonDialog.FileName программно отбросил имя открывамого файла и таким образом получил путь к папке.
Но это всё реальный геморрой. Подскажите как сократить код. Или какую-то функцию.
А может заменить CommonDialog чем либо другим.
p.s.Воспользовался CommonDialog потому что есть доступ к сети. А к примеру DriveListBox видит только ситевые диски, а не рабочую группу.
Решение задачи: «Как в CommonDialog открыть папку?»
textual
Листинг программы
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 Public Enum BrowseType BrowseForFolders = &H1 BrowseForComputers = &H1000 BrowseForPrinters = &H2000 BrowseForEverything = &H4000 End Enum Public Enum FolderType CSIDL_BITBUCKET = 10 CSIDL_CONTROLS = 3 CSIDL_DESKTOP = 0 CSIDL_DRIVES = 17 CSIDL_FONTS = 20 CSIDL_NETHOOD = 18 CSIDL_NETWORK = 19 CSIDL_PERSONAL = 5 CSIDL_PRINTERS = 4 CSIDL_PROGRAMS = 2 CSIDL_RECENT = 8 CSIDL_SENDTO = 9 CSIDL_STARTMENU = 11 End Enum Private Const MAX_PATH = 260 Private Declare Sub CoTaskMemFree Lib 'ole32.dll' (ByVal hMem As Long) Private Declare Function lstrcat Lib 'kernel32.dll' Alias 'lstrcatA' (ByVal lpString1 As String, ByVal lpString2 As String) As Long Private Declare Function SHBrowseForFolder Lib 'shell32.dll' (lpbi As BrowseInfo) As Long Private Declare Function SHGetPathFromIDList Lib 'shell32.dll' (ByVal pidList As Long, ByVal lpBuffer As String) As Long Private Declare Function SHGetSpecialFolderLocation Lib 'shell32.dll' (ByVal hWndOwner As Long, ByVal nFolder As Long, ListId As Long) As Long Public Function BrowseFolders(hWndOwner As Long, sMessage As String, Browse As BrowseType, ByVal RootFolder As FolderType) As String Dim Nullpos As Integer Dim lpIDList As Long Dim res As Long Dim sPath As String Dim BInfo As BrowseInfo Dim RootID As Long SHGetSpecialFolderLocation hWndOwner, RootFolder, RootID BInfo.hWndOwner = hWndOwner BInfo.lpszTitle = lstrcat(sMessage, '') BInfo.ulFlags = Browse If RootID <> 0 Then BInfo.pIDLRoot = RootID lpIDList = SHBrowseForFolder(BInfo) If lpIDList <> 0 Then sPath = String(MAX_PATH, 0) res = SHGetPathFromIDList(lpIDList, sPath) Call CoTaskMemFree(lpIDList) Nullpos = InStr(sPath, vbNullChar) If Nullpos <> 0 Then sPath = Left(sPath, Nullpos - 1) End If End If BrowseFolders = sPath End Function Private Sub Command1_Click() 'следующие вызовы функции сработали нормально MsgBox BrowseFolders(hWnd, 'Select a Folder', BrowseForFolders, CSIDL_DESKTOP) '+весь компьютер 'MsgBox BrowseFolders(hWnd, 'Select a Folder', BrowseForFolders, CSIDL_DRIVES) '+только устройства 'MsgBox BrowseFolders(hWnd, 'Select a Folder', BrowseForFolders, CSIDL_NETHOOD) '+только сеть 'MsgBox BrowseFolders(hWnd, 'Select a Folder', BrowseForFolders, CSIDL_PROGRAMS) '+папка Программы 'MsgBox BrowseFolders(hWnd, 'Select a Folder', BrowseForFolders, CSIDL_STARTMENU) '+Главное меню 'результат действия следующих кодов вызвал недоумение... 'MsgBox BrowseFolders(hWnd, 'Select a Folder', BrowseForFolders, CSIDL_BITBUCKET) '-корзина 'MsgBox BrowseFolders(hWnd, 'Select a Folder', BrowseForFolders, CSIDL_CONTROLS) '-панель управления 'MsgBox BrowseFolders(hWnd, 'Select a Folder', BrowseForFolders, CSIDL_FONTS) '-папка со шрифтами 'MsgBox BrowseFolders(hWnd, 'Select a Folder', BrowseForFolders, CSIDL_NETWORK) '-NetHood
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д