用VB实现目录选择+浏览
2008-05-01 05:11
106 查看
'下面用API实现目录浏览,选择目录,如果有高手能够在选择目录时新建一个,请续,谢谢!
'Common.bas*************************************************************
Option Explicit
Public 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 Const BIF_RETURNONLYFSDIRS = 1
Public Const MAX_PATH = 260
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Public Function BrowseForFolder(hwndOwner As Long, sPrompt As String) As String
'定义变量
Dim iNull As Integer
Dim lpIDList As Long
Dim lResult As Long
Dim sPath As String
Dim udtBI As BrowseInfo
'初始化.....
With udtBI
.hwndOwner = hwndOwner
.lpszTitle = lstrcat(sPrompt, "")
.ulFlags = BIF_RETURNONLYFSDIRS
End With
'调用API
lpIDList = SHBrowseForFolder(udtBI)
'得到返回结果
If lpIDList Then
sPath = String$(MAX_PATH, 0)
lResult = SHGetPathFromIDList(lpIDList, sPath)
Call CoTaskMemFree(lpIDList)
iNull = InStr(sPath, VBNullChar)
If iNull Then sPath = Left$(sPath, iNull - 1)
End If
BrowseForFolder = sPath
End Function
'**************************************************************************
下面在窗体中的按钮中调用
Private Sub cmdBrowse_Click()
Dim strResFolder As String
strResFolder = BrowseForFolder(hWnd, "请选择一个目录.")
If strResFolder = "" Then
Call MsgBox("你取消了选择目录..", VBExclamation)
Else
Call MsgBox("目录" & strResFolder & "被选择!", VBExclamation)
End If
End Sub
'Common.bas*************************************************************
Option Explicit
Public 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 Const BIF_RETURNONLYFSDIRS = 1
Public Const MAX_PATH = 260
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Public Function BrowseForFolder(hwndOwner As Long, sPrompt As String) As String
'定义变量
Dim iNull As Integer
Dim lpIDList As Long
Dim lResult As Long
Dim sPath As String
Dim udtBI As BrowseInfo
'初始化.....
With udtBI
.hwndOwner = hwndOwner
.lpszTitle = lstrcat(sPrompt, "")
.ulFlags = BIF_RETURNONLYFSDIRS
End With
'调用API
lpIDList = SHBrowseForFolder(udtBI)
'得到返回结果
If lpIDList Then
sPath = String$(MAX_PATH, 0)
lResult = SHGetPathFromIDList(lpIDList, sPath)
Call CoTaskMemFree(lpIDList)
iNull = InStr(sPath, VBNullChar)
If iNull Then sPath = Left$(sPath, iNull - 1)
End If
BrowseForFolder = sPath
End Function
'**************************************************************************
下面在窗体中的按钮中调用
Private Sub cmdBrowse_Click()
Dim strResFolder As String
strResFolder = BrowseForFolder(hWnd, "请选择一个目录.")
If strResFolder = "" Then
Call MsgBox("你取消了选择目录..", VBExclamation)
Else
Call MsgBox("目录" & strResFolder & "被选择!", VBExclamation)
End If
End Sub
相关文章推荐
- VC实现在浏览目录对话框中选择目录
- VB 选择目录对话框实现(API)
- vb 利用API 打开文件浏览窗口 选择返回目录
- 通过目录处理函数实现文件浏览功能
- VB用API实现FTP上传文件,创建远程目录(类模块)
- 如何在vba中实现目录浏览对话框
- VB 中遍历目录,遍历目录查找文件的2个实现方法(挺好)
- Apache下实现禁止目录浏览
- 启用Nginx目录浏览功能如何实现
- [ASP.NET] 实现客户端浏览服务端目录的页面
- IOS浏览带目录pdf,缩放实现
- vb实现目录下所有文件名/目录名称的获取
- 浏览文件夹中的图片(用VB实现)
- VB 中遍历目录,遍历目录查找文件的2个实现方法
- C++如何实现驱动目录浏览呢
- 一个可以记住上一次的选择的选择目录的对话框的实现代码段
- NSIS实现自定义选择数据保存目录窗口
- MFC总结(10) ---- MFC中CFileDialog 实现浏览文件和浏览目录功能
- [VB]用API打开浏览文件夹对话框,选择文件夹
- 在水晶报表中实现任意选择指定字段显示 (vb.net vs2003)