zoukankan      html  css  js  c++  java
  • VB6 选择文件夹路径

    '---------------------------------------------------------------------------------------
    ' Module    : ModuleFile
    ' Author    : ROVAST
    ' Date      : 2014-4-22
    ' Purpose   : 文件相关操作模块
    ' Function  : 1、选取文件夹
    '---------------------------------------------------------------------------------------
     
    Option Explicit
     
    Private 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
    Const BIF_RETURNONLYFSDIRS = 1
    Const BIF_NEWDIALOGSTYLE = &H40
    Const BIF_EDITBOX = &H10
    Const BIF_USENEWUI = BIF_NEWDIALOGSTYLE Or BIF_EDITBOX
    Const MAX_PATH = 260
    Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
    Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
    Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
    Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
     
     
    '---------------------------------------------------------------------------------------
    ' Procedure : BrowseForFolder
    ' Author    : ROVAST
    ' Date      : 2014-4-22
    ' Purpose   : 选取文件夹(不含新建文件夹指令) 返回BrowseForFolder
    '---------------------------------------------------------------------------------------
    '
    Public Function BrowseForFolder(Optional sTitle As String = "请选择文件夹") As String
        Dim iNull As Integer, lpIDList As Long, lResult As Long
        Dim sPath As String, udtBI As BrowseInfo
     
        With udtBI
            .hWndOwner = 0 ' Me.hWnd
            .lpszTitle = lstrcat(sTitle, "")
            .ulFlags = BIF_RETURNONLYFSDIRS Or BIF_USENEWUI
        End With
        lpIDList = SHBrowseForFolder(udtBI)
        If lpIDList Then
           sPath = String$(MAX_PATH, 0)
            SHGetPathFromIDList lpIDList, sPath
            CoTaskMemFree lpIDList
           iNull = InStr(sPath, vbNullChar)
            If iNull Then
              sPath = Left$(sPath, iNull - 1)
            End If
        End If
     
        BrowseForFolder = sPath
    End Function
     
     
    '---------------------------------------------------------------------------------------
    ' Procedure : BrowseForFolder1
    ' Author    : ROVAST
    ' Date      : 2014-4-22
    ' Purpose   : 选取文件夹路径(含新建文件夹) 返回BrowseForFolder1 字符串
    '---------------------------------------------------------------------------------------
    '
    Public Function BrowseForFolder1(Optional sTitle As String = "请选择文件夹") As String
        Dim iNull As Integer, lpIDList As Long, lResult As Long
        Dim sPath As String, udtBI As BrowseInfo
     
        With udtBI
            .hWndOwner = 0 ' Me.hWnd
            .lpszTitle = lstrcat(sTitle, "")
            .ulFlags = BIF_RETURNONLYFSDIRS
        End With
        lpIDList = SHBrowseForFolder(udtBI)
        If lpIDList Then
           sPath = String$(MAX_PATH, 0)
            SHGetPathFromIDList lpIDList, sPath
            CoTaskMemFree lpIDList
           iNull = InStr(sPath, vbNullChar)
            If iNull Then
              sPath = Left$(sPath, iNull - 1)
            End If
        End If
     
        BrowseForFolder1 = sPath
    End Function
    

      

    在主窗体中可以插入按钮。添加下述代码,其中前一个没有新建文件夹功能,后一个有新建文件夹功能

    Option Explicit
    
    Private Sub Command1_Click()
    Dim path1 As String
    path1 = BrowseForFolder
    MsgBox path1
    End Sub
    
    Private Sub Command2_Click()
    Dim path As String
    path = BrowseForFolder1
    MsgBox path
    End Sub
    

      

  • 相关阅读:
    tarjan algorithm
    最小生成树
    Manacher's Algorithm (马拉车算法)
    KMP
    Trie(字典树)
    Hash
    GDB调试
    图论
    扫描线
    STL
  • 原文地址:https://www.cnblogs.com/wgscd/p/9323334.html
Copyright © 2011-2022 走看看