VB 调用系统API 选择文件夹 代码
来源:互联网 发布:文档版本控制软件 编辑:程序博客网 时间:2024/05/17 07:10
Option Explicit
'Powered by barenx
Private Declare Function SHBrowseForFolder()Function SHBrowseForFolder Lib "shell32.dll" Alias _
"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetSpecialFolderLocation()Function SHGetSpecialFolderLocation Lib _
"shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder _
As Long, pIdl As ITEMIDLIST) As Long
Private Declare Function SHGetFileInfo()Function SHGetFileInfo Lib "Shell32" Alias _
"SHGetFileInfoA" (ByVal pszPath As Any, ByVal _
dwFileAttributes As Long, psfi As SHFILEINFO, ByVal _
cbFileInfo As Long, ByVal UFlags As Long) As Long
Private Declare Function ShellAbout()Function ShellAbout Lib "shell32.dll" Alias _
"ShellAboutA" (ByVal HWnd As Long, ByVal szApp As _
String, ByVal szOtherStuff As String, ByVal HIcon As Long) _
As Long
Private Declare Function SHGetPathFromIDList()Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pIdl As Long, ByVal _
pszPath As String) As Long
Private Declare Sub CoTaskMemFree()Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Private Type SHITEMID
cb As Long
abID() As Byte
End Type
Private Type ITEMIDLIST
mkid As SHITEMID
End Type
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 MAX_PATH = 260
Private Type SHFILEINFO
HIcon As Long
iIcon As Long
dwAttributes As Long
szDisplayName As String * MAX_PATH
szTypeName As String * 80
End Type
Private Const ERROR_SUCCESS = 0&
'Private Const SHGNLI_PIDL = &H1
'Private Const SHGFI_ICON = &H100
'Private Const SHGFI_SMALLICON = &H1
Private Function GetFolderValue()Function GetFolderValue(wIdx As Integer) As Long
If wIdx < 2 Then
GetFolderValue = 0
ElseIf wIdx < 12 Then
GetFolderValue = wIdx
Else
GetFolderValue = wIdx + 4
End If
End Function
Private Sub Label3_Click()Sub Label3_Click()
Dim BI As BROWSEINFO
Dim nFolder As Long
Dim IDL As ITEMIDLIST
Dim pIdl As Long
Dim sPath As String
Dim SHFI As SHFILEINFO
Dim m_wCurOptIdx As Integer
Dim txtPath As String
Dim txtDisplayName As String
With BI
.hOwner = Me.HWnd
nFolder = GetFolderValue(m_wCurOptIdx)
If SHGetSpecialFolderLocation(ByVal Me.HWnd, ByVal nFolder, IDL) = ERROR_SUCCESS Then
.pidlRoot = IDL.mkid.cb
End If
.pszDisplayName = String$(MAX_PATH, 0)
.lpszTitle = "Browsing is limited to: "
.ulFlags = 0
End With
txtPath = ""
txtDisplayName = ""
pIdl = SHBrowseForFolder(BI)
If pIdl = 0 Then Exit Sub
sPath = String$(MAX_PATH, 0)
SHGetPathFromIDList ByVal pIdl, ByVal sPath
txtPath = Left(sPath, InStr(sPath, vbNullChar) - 1)
txtDisplayName = Left$(BI.pszDisplayName, _
InStr(BI.pszDisplayName, vbNullChar) - 1)
' SHGetFileInfo ByVal pIdl, 0&, SHFI, Len(SHFI), _
' SHGFI_PIDL Or SHGFI_ICON Or SHGFI_SMALLICON
'
' SHGetFileInfo ByVal pIdl, 0&, SHFI, Len(SHFI), _
' SHGFI_PIDL Or SHGFI_ICON
CoTaskMemFree pIdl
TxtSet(0).Text = txtPath
End Sub
Private Declare Function SHBrowseForFolder()Function SHBrowseForFolder Lib "shell32.dll" Alias _
"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetSpecialFolderLocation()Function SHGetSpecialFolderLocation Lib _
"shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder _
As Long, pIdl As ITEMIDLIST) As Long
Private Declare Function SHGetFileInfo()Function SHGetFileInfo Lib "Shell32" Alias _
"SHGetFileInfoA" (ByVal pszPath As Any, ByVal _
dwFileAttributes As Long, psfi As SHFILEINFO, ByVal _
cbFileInfo As Long, ByVal UFlags As Long) As Long
Private Declare Function ShellAbout()Function ShellAbout Lib "shell32.dll" Alias _
"ShellAboutA" (ByVal HWnd As Long, ByVal szApp As _
String, ByVal szOtherStuff As String, ByVal HIcon As Long) _
As Long
Private Declare Function SHGetPathFromIDList()Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pIdl As Long, ByVal _
pszPath As String) As Long
Private Declare Sub CoTaskMemFree()Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Private Type SHITEMID
cb As Long
abID() As Byte
End Type
Private Type ITEMIDLIST
mkid As SHITEMID
End Type
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 MAX_PATH = 260
Private Type SHFILEINFO
HIcon As Long
iIcon As Long
dwAttributes As Long
szDisplayName As String * MAX_PATH
szTypeName As String * 80
End Type
Private Const ERROR_SUCCESS = 0&
'Private Const SHGNLI_PIDL = &H1
'Private Const SHGFI_ICON = &H100
'Private Const SHGFI_SMALLICON = &H1
Private Function GetFolderValue()Function GetFolderValue(wIdx As Integer) As Long
If wIdx < 2 Then
GetFolderValue = 0
ElseIf wIdx < 12 Then
GetFolderValue = wIdx
Else
GetFolderValue = wIdx + 4
End If
End Function
Private Sub Label3_Click()Sub Label3_Click()
Dim BI As BROWSEINFO
Dim nFolder As Long
Dim IDL As ITEMIDLIST
Dim pIdl As Long
Dim sPath As String
Dim SHFI As SHFILEINFO
Dim m_wCurOptIdx As Integer
Dim txtPath As String
Dim txtDisplayName As String
With BI
.hOwner = Me.HWnd
nFolder = GetFolderValue(m_wCurOptIdx)
If SHGetSpecialFolderLocation(ByVal Me.HWnd, ByVal nFolder, IDL) = ERROR_SUCCESS Then
.pidlRoot = IDL.mkid.cb
End If
.pszDisplayName = String$(MAX_PATH, 0)
.lpszTitle = "Browsing is limited to: "
.ulFlags = 0
End With
txtPath = ""
txtDisplayName = ""
pIdl = SHBrowseForFolder(BI)
If pIdl = 0 Then Exit Sub
sPath = String$(MAX_PATH, 0)
SHGetPathFromIDList ByVal pIdl, ByVal sPath
txtPath = Left(sPath, InStr(sPath, vbNullChar) - 1)
txtDisplayName = Left$(BI.pszDisplayName, _
InStr(BI.pszDisplayName, vbNullChar) - 1)
' SHGetFileInfo ByVal pIdl, 0&, SHFI, Len(SHFI), _
' SHGFI_PIDL Or SHGFI_ICON Or SHGFI_SMALLICON
'
' SHGetFileInfo ByVal pIdl, 0&, SHFI, Len(SHFI), _
' SHGFI_PIDL Or SHGFI_ICON
CoTaskMemFree pIdl
TxtSet(0).Text = txtPath
End Sub
- VB 调用系统API 选择文件夹 代码
- VB选择文件夹代码
- VB调用系统API的声明
- VBA调用系统文件夹选择的窗口
- 调用系统对话框,选择指定文件夹路径
- VB选择文件夹
- vb API的调用
- VB调用API
- VB调用API函数
- VB调用API函数
- unity3d调用windows系统dialog选择文件夹的方法
- 选择文件夹对话框代码
- 选择文件夹对话框代码
- VB调用API的学习
- VB调用API的学习
- VB调用API post数据
- VB调用API的学习
- vb.net 如何选择文件夹 不是文件
- 项目开发中常用JS表单取值方法
- Vega Prime 桌面教程(四)
- VB WMI 对象的示例代码
- 有限域运算
- html代码大全
- VB 调用系统API 选择文件夹 代码
- 我的CSDN成长历程
- vivi 2 mem
- 世界编程语言排行榜08年03月
- Windows下的C++编程——你过时了么?
- 我的广告服务器罢工了?
- 一段弃暗投明的代码
- 在eclipse中, 如何快速输入(快捷键)System.out.println();
- 解决运行eclipse内存不足的问题