www.pudn.com > VBP-HKWS.zip > Module1.bas, change:2013-09-08,size:1663b


Attribute VB_Name = "Module1" 
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 
'Download by http://www.codefans.net 
Public 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 
 
Public Const BIF_RETURNONLYFSDIRS = 1 
Public Const MAX_PATH = 260 
Public Photo_Path As String 
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long) 
Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long 
Public Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long 
Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long 
Public Function BrowseForFolder(hwndOwner As Long, sPrompt As String) As String 
      
    '定义变量 
     Dim iNull As Integer 
     Dim lpIDList As Long 
     Dim lResult As Long 
     Dim sPath As String 
     Dim udtBI As BrowseInfo 
 
    '初始化..... 
     With udtBI 
        .hwndOwner = hwndOwner 
        .lpszTitle = lstrcat(sPrompt, "") 
        .ulFlags = BIF_RETURNONLYFSDIRS 
     End With 
 
    '调用API 
     lpIDList = SHBrowseForFolder(udtBI) 
    '得到返回结果 
    If lpIDList Then 
        sPath = String$(MAX_PATH, 0) 
        lResult = SHGetPathFromIDList(lpIDList, sPath) 
        Call CoTaskMemFree(lpIDList) 
        iNull = InStr(sPath, vbNullChar) 
        If iNull Then sPath = Left$(sPath, iNull - 1) 
     End If 
     BrowseForFolder = sPath 
 
End Function