VB.NET中用API实现打开文件夹

贴上代码：

Imports System.TextImports System.Runtime.InteropServicesPublic 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 uMsg As Integer, ByVal lParam 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, 0, lpData)            End Select        Catch Ex As Exception            Throw Ex        End Try        Return 0    End FunctionEnd Class