vb.net2005 用API打开文件夹对话框和设定默认路径。

新建一个窗体,添加一个textbox 和一个button,拷贝下面的代码。

 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 = "Test"
                .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

    End Function

End Class

  • 0
    点赞
  • 1
    收藏
    觉得还不错? 一键收藏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值