zoukankan      html  css  js  c++  java
  • 查找文件夹

    Option Explicit
       
      Private Type BrowseInfo
              lngHwnd                 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
       
      Private Const BIF_RETURNONLYFSDIRS = 1
    ‘Private Const BIF_RETURNONLYFSDIRS = 100-----〉多一个新建文件夹的按钮
      Private 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
       
      Public Function BrowseForFolder(ByVal lngHwnd As Long, ByVal strPrompt As String) As String
       
              On Error GoTo ehBrowseForFolder         'Trap   for   errors
       
              Dim intNull     As Integer
              Dim lngIDList     As Long, lngResult       As Long
              Dim strPath     As String
              Dim udtBI     As BrowseInfo
       
              'Set   API   properties   (housed   in   a   UDT)
              With udtBI
                      .lngHwnd = lngHwnd
                      .lpszTitle = lstrcat(strPrompt, "")
                      .ulFlags = BIF_RETURNONLYFSDIRS
              End With
       
              'Display   the   browse   folder...
              lngIDList = SHBrowseForFolder(udtBI)
       
              If lngIDList <> 0 Then
                      'Create   string   of   nulls   so   it   will   fill   in   with   the   path
                      strPath = String(MAX_PATH, 0)
       
                      'Retrieves   the   path   selected,   places   in   the   null
                        'character   filled   string
                      lngResult = SHGetPathFromIDList(lngIDList, strPath)
       
                      'Frees   memory
                      Call CoTaskMemFree(lngIDList)
       
                      'Find   the   first   instance   of   a   null   character,
                        'so   we   can   get   just   the   path
                      intNull = InStr(strPath, vbNullChar)
                      'Greater   than   0   means   the   path   exists...
                      If intNull > 0 Then
                              'Set   the   value
                              strPath = Left(strPath, intNull - 1)
                      End If
              End If
       
              'Return   the   path   name
              BrowseForFolder = strPath
              Exit Function     'Abort
       
    ehBrowseForFolder:
       
              'Return   no   value
              BrowseForFolder = Empty
       
      End Function
     
       
      Private Sub Command1_Click()
              Debug.Print BrowseForFolder(Me.hWnd, "a")
      End Sub
  • 相关阅读:
    【漏洞挖掘】攻击对外开放的Docker API接口
    使用密钥认证机制远程登录Linux
    极客时间-左耳听风-程序员攻略开篇-零基础启蒙
    WEBSHELL恶意代码批量提取清除工具
    string替换字符串,路径的斜杠替换为下划线
    Linux下文件的三个时间意义及用法
    记录一次lnmp故障报告
    Centos 7.2编译安装MariaDB-10.0.xx
    win 7 浏览器被篡改小插曲
    【 sysbench 性能基准测试 】
  • 原文地址:https://www.cnblogs.com/Charlotte/p/530609.html
Copyright © 2011-2022 走看看