不看会后悔的Windows XP之经验谈	简单快捷DIY实用家庭影院

如何进行目录选择

楼主talentboy（网行者）2001-11-13 10:17:40 在 VB / 基础类提问

就像CommonDialog选择文件一样。问题点数：20、回复次数：15Top

1 楼baoxiang（包香）回复于 2001-11-13 10:19:30 得分 0

你说的太不详细了。
能不能说的明白些。Top

2 楼uguess（天地间，有我在行走！）回复于 2001-11-13 10:30:32 得分 20

Option Explicit

'**********获得系统特殊目录**********************
Private Type SHITEMID
cb As Long
abID As Byte
End Type

Private Type ITEMIDLIST 'idl
mkid As SHITEMID
End Type

#If UNICODE Then
Private Declare Function SHGetPathFromIDList Lib "Shell32" Alias "SHGetPathFromIDListW" (ByVal pidl As Long, ByVal szPath As Long) As Long
#Else
Private Declare Function SHGetPathFromIDList Lib "Shell32" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal szPath As String) As Long
#End If

Private Declare Function SHGetSpecialFolderLocation Lib "SHELL32.DLL" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long

Private Const MAX_PATH = 255
'Public Const MAX_NAME = 40
Private Const NOERROR = 0

'*******************************
Private Enum SHELLFOLDERS ' Shell Folder Path Constants...
CSIDL_DESKTOP = &H0& ' ..\WinNT\profiles\username\Desktop
CSIDL_PROGRAMS = &H2& ' ..\WinNT\profiles\username\Start Menu\Programs
CSIDL_STARTMENU = &HB& ' ..\WinNT\profiles\username\Start Menu
CSIDL_CONTROLS = &H3
CSIDL_PRINTERS = &H4
CSIDL_PERSONAL = &H5
CSIDL_FAVORITES = &H6
CSIDL_STARTUP = &H7
CSIDL_RECENT = &H8
CSIDL_SENDTO = &H9
CSIDL_BITBUCKET = &HA
CSIDL_DESKTOPDIRECTORY = &H10
CSIDL_DRIVES = &H11
CSIDL_NETWORK = &H12
CSIDL_NETHOOD = &H13
CSIDL_FONTS = &H14
CSIDL_TEMPLATES = &H15
End Enum

Private Declare Function GetSystemDirectory Lib "Kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

'******* API声明：使用系统文件存取对话框 *********
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long

Private Type OPENFILENAME
lStructSize As Long
hwnd As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_EXPLORER = &H80000
Private Const OFN_LONGNAMES = &H200000
Private Const OFN_NODEREFERENCELINKS As Long = &H100000
Private Const OFN_ENABLEHOOK As Long = &H20
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFS_FILE_OPEN_FLAGS = OFN_EXPLORER Or OFN_LONGNAMES Or OFN_NODEREFERENCELINKS

'****************************************

'******* API声明：使用系统目录浏览对话框 *********
Private Declare Function SHBrowseForFolder Lib "SHELL32.DLL" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long 'ITEMIDLIST
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 Const BIF_VALIDATE = &H20
Private Const BIF_USENEWUI = &H40
Private Const BIF_STATUSTEXT = &H4
Private Const BIF_RETURNONLYFSDIRS = &H1
Private Const BIF_RETURNFSANCESTORS = &H8
Private Const BIF_EDITBOX = &H10
Private Const BIF_DONTGOBELOWDOMAIN = &H2
Private Const BIF_BROWSEINCLUDEFILES = &H4000
Private Const BIF_BROWSEFORPRINTER = &H2000
Private Const BIF_BROWSEFORCOMPUTER = &H1000
Public Function BrowseFolder(ByVal st As String, lHwnd As Long, Optional ByVal iStyle As Long = CSIDL_DESKTOP) As String
Dim BI As BROWSEINFO
Dim idl As ITEMIDLIST
Dim rtn&, pidl&, sPath$

BI.hOwner = lHwnd
rtn& = SHGetSpecialFolderLocation(ByVal lHwnd, iStyle, idl)
BI.pidlRoot = idl.mkid.cb
BI.lpszTitle = st
BI.ulFlags = BIF_RETURNONLYFSDIRS
pidl& = SHBrowseForFolder(BI)
sPath$ = Space$(512)
rtn& = SHGetPathFromIDList(ByVal pidl&, ByVal sPath$)
If rtn& Then
BrowseFolder = StripTerminator(sPath$)
Else
BrowseFolder = ""
End If
End Function

Private Function StripTerminator(ByVal sInput As String) As String

Dim ZeroPos As Integer
ZeroPos = InStr(1, sInput, vbNullChar)
If ZeroPos > 0 Then
StripTerminator = Left$(sInput, ZeroPos - 1)
Else
StripTerminator = sInput
End If

End Function

Top

3 楼00000000000（00000000000）回复于 2001-11-13 10:30:50 得分 0

vb有一些函数的吗!

DIR
ChDir
CurDir
ChDrive
等.....Top

4 楼Amoon（阿木(0_o 治安是我扰乱的 o_0)）回复于 2001-11-13 10:34:08 得分 0

to uguess(uguess):你是不是随时抱着 MSDN 啊？：）Top

5 楼00000000000（00000000000）回复于 2001-11-13 10:35:36 得分 0

老子vb函数倒背如流.Top

6 楼foolishtiger（冬蛩）回复于 2001-11-13 10:40:00 得分 0

呵呵Top

7 楼uguess（天地间，有我在行走！）回复于 2001-11-13 10:42:41 得分 0

to Amoon(阿木)
我倒没有 “随时抱着 MSDN ”，只不过干这行时间长了，都有些现成的模块拉。

Top

8 楼00000000000（00000000000）回复于 2001-11-13 10:47:02 得分 0

uguess代码复用!!!!!!!!Top

9 楼00000000000（00000000000）回复于 2001-11-13 10:47:55 得分 0

uguess你在那里?Top

10 楼uguess（天地间，有我在行走！）回复于 2001-11-13 10:58:58 得分 0

我在西安，有何指教？
Top

11 楼00000000000（00000000000）回复于 2001-11-13 11:21:51 得分 0

QQ?Top

12 楼uguess（天地间，有我在行走！）回复于 2001-11-13 11:30:56 得分 0

我基本不用那玩意，我还是喜欢在这灌水！
Top

13 楼uguess（天地间，有我在行走！）回复于 2001-11-17 12:26:05 得分 0

老哥，你的分还在路上么？

Top

14 楼tidewave（浪潮一号）回复于 2001-11-17 15:14:36 得分 0

添加drive,dir,file 控件不就行了Top

15 楼uguess（天地间，有我在行走！）回复于 2001-11-20 17:57:38 得分 0

完啦，又一个“格朗台”！
Top