贴上代码:
Imports System.Text Imports System.Runtime.InteropServices Public Class OpenFolder_OK Private Delegate Function fbCallBack(ByVal hWnd As Integer,ByVal uMsg As Integer,ByVal lParam As Integer,ByVal lpData As Integer) As Integer Private initpath As String = "C:/" Private Structure broWSEINFO Dim hOwner As Integer Dim pidlRoot As Integer Dim pszdisplayName As String Dim lpszTitle As String Dim ulFlags As Integer Dim lpfn As fbCallBack Dim lParam As Integer Dim iImage As Integer End Structure Private Declare Function SHbrowseForFolder Lib "shell32.dll" Alias "SHbrowseForFolderA" (ByVal lpbrowseInfo As IntPtr) As Integer Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pIdl As Integer,ByVal pszPath As StringBuilder) As Integer Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Integer,ByVal wMsg As Integer,ByVal wParam As Integer,ByVal lParam As Integer) As Integer Private Const WM_USER As Integer = &H400 Private Const BFFM_INITIALIZED As Integer = 1 Private Const BFFM_SELCHANGED As Integer = 2 'Private Const BIF_broWSEINCLUDEFILES As Integer = &H4000 Private Const BIF_DONTGOBELOWDOMAIN As Integer = &H2 Private Const BFFM_SETSELECTIONA As Integer = (WM_USER + 102) Private Const BFFM_SETSTATUSTEXT As Integer = &H464 Private Const BIF_RETURNONLYFSDirs As Integer = &H1 Dim pnt As IntPtr Dim BIptr As IntPtr Dim pIdl As Integer Private Sub Button1_Click(ByVal sender As System.Object,ByVal e As System.EventArgs) Handles Button1.Click Try pnt = nothing BIptr = nothing pIdl = nothing If Not My.Computer.FileSystem.DirectoryExists(initpath) Then MsgBox(initpath & " not exist") Exit Try End If Dim BI As broWSEINFO Dim sPath As StringBuilder Dim txtPath As String With BI .hOwner = Me.Handle .pszdisplayName = Space(260) .lpszTitle = "打开文件" .ulFlags = BIF_RETURNONLYFSDirs .lpfn = AddressOf browseCallBackProc .lParam = Marshal.StringToHGlobalAnsi(initpath) End With txtPath = "" BIptr = Marshal.AllocHGlobal(Marshal.SizeOf(BI)) Marshal.StructuretoPtr(BI,BIptr,False) pIdl = SHbrowseForFolder(BIptr) If pIdl = 0 Then Exit Try sPath = New StringBuilder(255) SHGetPathFromIDList(pIdl,sPath) txtPath = sPath.ToString TextBox1.Text = txtPath initpath = txtPath Marshal.FreeHGlobal(pIdl) Catch ex As Exception MsgBox(ex.ToString) Finally Marshal.FreeHGlobal(BIptr) Marshal.FreeHGlobal(pnt) End Try End Sub Public Function browseCallBackProc(ByVal hWnd As Integer,ByVal lpData As Integer) As Integer Try Select Case uMsg Case BFFM_INITIALIZED Call SendMessage(hWnd,BFFM_SETSELECTIONA,&H1,lpData) Case BFFM_SELCHANGED SendMessage(hWnd,BFFM_SETSTATUSTEXT,lpData) End Select Catch Ex As Exception Throw Ex End Try Return 0 End Function End Class
原文地址:https://www.jb51.cc/vb/258728.html
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。