📄 folderbrowsesrc.html
字号:
<HTML><TITLE>Source Code</TITLE><BODY><FONT COLOR="#00007F">Option</FONT> <FONT COLOR="#00007F">Explicit</FONT><br><br><br><FONT COLOR="#007F00">' Maximum long filename path length</FONT><br><FONT COLOR="#00007F">Private</FONT> <FONT COLOR="#00007F">Const</FONT> MAX_PATH = 1024<br><br><FONT COLOR="#007F00">'SendMessage Constants</FONT><br><FONT COLOR="#00007F">Private</FONT> <FONT COLOR="#00007F">Const</FONT> BFFM_INITIALIZED = 1<br><FONT COLOR="#00007F">Private</FONT> <FONT COLOR="#00007F">Const</FONT> WM_USER = &H400<br><FONT COLOR="#00007F">Private</FONT> <FONT COLOR="#00007F">Const</FONT> BFFM_SETSELECTIONA = (WM_USER + 102)<br><br><FONT COLOR="#007F00">'The Following Constants may be passed to BrowseForFolder</FONT><br><FONT COLOR="#007F00">'as vTopFolder or vSelPath</FONT><br><FONT COLOR="#00007F">Public</FONT> <FONT COLOR="#00007F">Const</FONT> CSIDL_DESKTOP = &H0 <FONT COLOR="#007F00">'DeskTop</FONT><br><FONT COLOR="#00007F">Public</FONT> <FONT COLOR="#00007F">Const</FONT> CSIDL_PROGRAMS = &H2 <FONT COLOR="#007F00">'Program Groups Folder</FONT><br><FONT COLOR="#00007F">Public</FONT> <FONT COLOR="#00007F">Const</FONT> CSIDL_CONTROLS = &H3 <FONT COLOR="#007F00">'Control Panel Icons Folder</FONT><br><FONT COLOR="#00007F">Public</FONT> <FONT COLOR="#00007F">Const</FONT> CSIDL_PRINTERS = &H4 <FONT COLOR="#007F00">'Printers Folder</FONT><br><FONT COLOR="#00007F">Public</FONT> <FONT COLOR="#00007F">Const</FONT> CSIDL_PERSONAL = &H5 <FONT COLOR="#007F00">'Documents Folder</FONT><br><FONT COLOR="#00007F">Public</FONT> <FONT COLOR="#00007F">Const</FONT> CSIDL_FAVORITES = &H6 <FONT COLOR="#007F00">'Favorites Folder</FONT><br><FONT COLOR="#00007F">Public</FONT> <FONT COLOR="#00007F">Const</FONT> CSIDL_STARTUP = &H7 <FONT COLOR="#007F00">'Startup Folder</FONT><br><FONT COLOR="#00007F">Public</FONT> <FONT COLOR="#00007F">Const</FONT> CSIDL_RECENT = &H8 <FONT COLOR="#007F00">'Recent folder</FONT><br><FONT COLOR="#00007F">Public</FONT> <FONT COLOR="#00007F">Const</FONT> CSIDL_SENDTO = &H9 <FONT COLOR="#007F00">'SendTo Folder</FONT><br><FONT COLOR="#00007F">Public</FONT> <FONT COLOR="#00007F">Const</FONT> CSIDL_BITBUCKET = &HA <FONT COLOR="#007F00">'Recycle Bin Folder</FONT><br><FONT COLOR="#00007F">Public</FONT> <FONT COLOR="#00007F">Const</FONT> CSIDL_STARTMENU = &HB <FONT COLOR="#007F00">'Start Menu Folder</FONT><br><FONT COLOR="#00007F">Public</FONT> <FONT COLOR="#00007F">Const</FONT> CSIDL_DESKTOPDIRECTORY = &H10 <FONT COLOR="#007F00">'Windows\Desktop Folder</FONT><br><FONT COLOR="#00007F">Public</FONT> <FONT COLOR="#00007F">Const</FONT> CSIDL_DRIVES = &H11 <FONT COLOR="#007F00">'Devices Virtual Folder (My Computer)</FONT><br><FONT COLOR="#00007F">Public</FONT> <FONT COLOR="#00007F">Const</FONT> CSIDL_NETWORK = &H12 <FONT COLOR="#007F00">'Network Neighborhood Virtual Folder</FONT><br><FONT COLOR="#00007F">Public</FONT> <FONT COLOR="#00007F">Const</FONT> CSIDL_NETHOOD = &H13 <FONT COLOR="#007F00">'Network Neighborhood Folder</FONT><br><FONT COLOR="#00007F">Public</FONT> <FONT COLOR="#00007F">Const</FONT> CSIDL_FONTS = &H14 <FONT COLOR="#007F00">'Fonts Folder</FONT><br><FONT COLOR="#00007F">Public</FONT> <FONT COLOR="#00007F">Const</FONT> CSIDL_TEMPLATES = &H15 <FONT COLOR="#007F00">'ShellNew folder</FONT><br><br><FONT COLOR="#00007F">Private</FONT> <FONT COLOR="#00007F">Type</FONT> SHItemID<br> cb <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT> <FONT COLOR="#007F00">'Size of the ID (including cb itself)</FONT><br> abID <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Byte</FONT> <FONT COLOR="#007F00">'The item ID (variable length)</FONT><br><FONT COLOR="#00007F">End</FONT> <FONT COLOR="#00007F">Type</FONT><br><br><FONT COLOR="#00007F">Private</FONT> <FONT COLOR="#00007F">Type</FONT> ItemIDList<br> mkid <FONT COLOR="#00007F">As</FONT> SHItemID<br><FONT COLOR="#00007F">End</FONT> <FONT COLOR="#00007F">Type</FONT><br><br><FONT COLOR="#00007F">Private</FONT> <FONT COLOR="#00007F">Type</FONT> BROWSEINFO<br> hOwner <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT><br> pidlRoot <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT><br> pszDisplayName <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT><br> lpszTitle <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT><br> ulFlags <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT><br> lpCallbackProc <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT><br> lParam <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT><br> iImage <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT><br><FONT COLOR="#00007F">End</FONT> <FONT COLOR="#00007F">Type</FONT><br><br><FONT COLOR="#00007F">Private</FONT> <FONT COLOR="#00007F">Declare</FONT> <FONT COLOR="#00007F">Function</FONT> SHBrowseForFolder <FONT COLOR="#00007F">Lib</FONT> "shell32.dll" <FONT COLOR="#00007F">Alias</FONT> "SHBrowseForFolderA" (lpBrowseInfo <FONT COLOR="#00007F">As</FONT> BROWSEINFO) <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT><br><FONT COLOR="#00007F">Private</FONT> <FONT COLOR="#00007F">Declare</FONT> <FONT COLOR="#00007F">Function</FONT> SHGetPathFromIDList <FONT COLOR="#00007F">Lib</FONT> "shell32.dll" <FONT COLOR="#00007F">Alias</FONT> "SHGetPathFromIDListA" (<FONT COLOR="#00007F">ByVal</FONT> pidl <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT>, <FONT COLOR="#00007F">ByVal</FONT> pszPath <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT>) <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT><br><FONT COLOR="#007F00">'Retrieves the location of a special (system) folder.</FONT><br><FONT COLOR="#00007F">Private</FONT> <FONT COLOR="#00007F">Declare</FONT> <FONT COLOR="#00007F">Function</FONT> SHGetSpecialFolderLocation <FONT COLOR="#00007F">Lib</FONT> "shell32.dll" (<FONT COLOR="#00007F">ByVal</FONT> hwndOwner <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT>, <FONT COLOR="#00007F">ByVal</FONT> nFolder <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT>, pidl <FONT COLOR="#00007F">As</FONT> ItemIDList) <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT><br><FONT COLOR="#007F00">'ParseDisplayName function should be used instead of this undocumented function.</FONT><br><FONT COLOR="#00007F">Private</FONT> <FONT COLOR="#00007F">Declare</FONT> <FONT COLOR="#00007F">Function</FONT> SHSimpleIDListFromPath <FONT COLOR="#00007F">Lib</FONT> "shell32" <FONT COLOR="#00007F">Alias</FONT> "#162" (<FONT COLOR="#00007F">ByVal</FONT> szPath <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT>) <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT><br><FONT COLOR="#00007F">Private</FONT> <FONT COLOR="#00007F">Declare</FONT> <FONT COLOR="#00007F">Sub</FONT> CoTaskMemFree <FONT COLOR="#00007F">Lib</FONT> "ole32.dll" (<FONT COLOR="#00007F">ByVal</FONT> PV <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT>)<br><FONT COLOR="#00007F">Private</FONT> <FONT COLOR="#00007F">Declare</FONT> <FONT COLOR="#00007F">Function</FONT> SendMessage <FONT COLOR="#00007F">Lib</FONT> "user32" <FONT COLOR="#00007F">Alias</FONT> "SendMessageA" (<FONT COLOR="#00007F">ByVal</FONT> hWnd <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT>, <FONT COLOR="#00007F">ByVal</FONT> wMsg <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT>, <FONT COLOR="#00007F">ByVal</FONT> wParam <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT>, lParam <FONT COLOR="#00007F">As</FONT> Any) <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT><br><FONT COLOR="#00007F">Private</FONT> <FONT COLOR="#00007F">Declare</FONT> <FONT COLOR="#00007F">Function</FONT> GetPrivateProfileString <FONT COLOR="#00007F">Lib</FONT> "kernel32" <FONT COLOR="#00007F">Alias</FONT> "GetPrivateProfileStringA" (<FONT COLOR="#00007F">ByVal</FONT> lpApplicationName <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT>, <FONT COLOR="#00007F">ByVal</FONT> lpKeyName <FONT COLOR="#00007F">As</FONT> Any, <FONT COLOR="#00007F">ByVal</FONT> lpDefault <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT>, <FONT COLOR="#00007F">ByVal</FONT> lpReturnedString <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT>, <FONT COLOR="#00007F">ByVal</FONT> nSize <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT>, <FONT COLOR="#00007F">ByVal</FONT> lpFileName <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT>) <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT><br><FONT COLOR="#00007F">Private</FONT> <FONT COLOR="#00007F">Declare</FONT> <FONT COLOR="#00007F">Function</FONT> WritePrivateProfileString <FONT COLOR="#00007F">Lib</FONT> "kernel32" <FONT COLOR="#00007F">Alias</FONT> "WritePrivateProfileStringA" (<FONT COLOR="#00007F">ByVal</FONT> lpApplicationName <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT>, <FONT COLOR="#00007F">ByVal</FONT> lpKeyName <FONT COLOR="#00007F">As</FONT> Any, <FONT COLOR="#00007F">ByVal</FONT> lpString <FONT COLOR="#00007F">As</FONT> Any, <FONT COLOR="#00007F">ByVal</FONT> lpFileName <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT>) <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT><br><br><FONT COLOR="#00007F">Public</FONT> <FONT COLOR="#00007F">Function</FONT> BrowseCallbackProc(<FONT COLOR="#00007F">ByVal</FONT> hWnd <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT>, <FONT COLOR="#00007F">ByVal</FONT> uMsg <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT>, <FONT COLOR="#00007F">ByVal</FONT> lParam <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT>, <FONT COLOR="#00007F">ByVal</FONT> lpData <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT>) <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT><br> <br> <FONT COLOR="#00007F">Select</FONT> <FONT COLOR="#00007F">Case</FONT> uMsg<br> <FONT COLOR="#00007F">Case</FONT> BFFM_INITIALIZED<br> <FONT COLOR="#007F00">' Set the dialog's pre-selected folder using the pidl</FONT><br> <FONT COLOR="#007F00">' set in bi.lParam and passed in the lpData param.</FONT><br> <FONT COLOR="#00007F">Call</FONT> SendMessage(hWnd, BFFM_SETSELECTIONA, <FONT COLOR="#00007F">False</FONT>, <FONT COLOR="#00007F">ByVal</FONT> lpData)<br> <br> <FONT COLOR="#00007F">End</FONT> <FONT COLOR="#00007F">Select</FONT><br><br><FONT COLOR="#00007F">End</FONT> <FONT COLOR="#00007F">Function</FONT><br><br><FONT COLOR="#00007F">Public</FONT> <FONT COLOR="#00007F">Function</FONT> BrowseForFolder(hOwnerWnd <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT>, Optional <FONT COLOR="#00007F">ByVal</FONT> sInstruct <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT>, Optional vSelPath <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Variant</FONT>, Optional vTopFolder <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Variant</FONT>) <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT><br><br><FONT COLOR="#007F00">' Shows the Browse For Folder dialog</FONT><br><FONT COLOR="#007F00">'</FONT><br><FONT COLOR="#007F00">' hOwnerWnd (Long) OwnerWindow.hWnd.</FONT><br><FONT COLOR="#007F00">' sInstruct (String) Instructions for user.</FONT><br><FONT COLOR="#007F00">' vSelPath (String or CSIDL Constant) Pre-select this Folder.</FONT><br><FONT COLOR="#007F00">' vTopFolder (String or CSIDL Constant) Set the Top folder.</FONT><br><FONT COLOR="#007F00">'</FONT><br><FONT COLOR="#007F00">' If successful, returns the selected folder's full path,</FONT><br><FONT COLOR="#007F00">' returns an empty string otherwise.</FONT><br><FONT COLOR="#007F00">'</FONT><br><br><FONT COLOR="#00007F">Dim</FONT> lRet <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT><br><FONT COLOR="#00007F">Dim</FONT> pidlRet <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT><br><FONT COLOR="#00007F">Dim</FONT> sPath <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT> * MAX_PATH<br><FONT COLOR="#00007F">Dim</FONT> lItemIDList <FONT COLOR="#00007F">As</FONT> ItemIDList<br><FONT COLOR="#00007F">Dim</FONT> uBrowseInfo <FONT COLOR="#00007F">As</FONT> BROWSEINFO<br> <br> <FONT COLOR="#00007F">With</FONT> uBrowseInfo<br> <FONT COLOR="#007F00">' The desktop will own the dialog</FONT><br> .hOwner = hOwnerWnd<br> <FONT COLOR="#007F00">' This will be the dialog's root folder.</FONT><br> <FONT COLOR="#00007F">If</FONT> IsMissing(vTopFolder) <FONT COLOR="#00007F">Then</FONT><br> vTopFolder = CSIDL_DESKTOP<br> <FONT COLOR="#00007F">End</FONT> <FONT COLOR="#00007F">If</FONT><br> <FONT COLOR="#00007F">If</FONT> Len(vTopFolder) > 0 <FONT COLOR="#00007F">And</FONT> <FONT COLOR="#00007F">Not</FONT> IsNumeric(vTopFolder) <FONT COLOR="#00007F">Then</FONT><br> <FONT COLOR="#007F00">'String Path passed in</FONT><br> .pidlRoot = SHSimpleIDListFromPath(<FONT COLOR="#00007F">CStr</FONT>(vTopFolder))<br> <FONT COLOR="#00007F">Else</FONT><br> <FONT COLOR="#007F00">'Long CSIDL Special Folder Constant or Nothing passed in.</FONT><br> lRet = SHGetSpecialFolderLocation(<FONT COLOR="#00007F">ByVal</FONT> hOwnerWnd, <FONT COLOR="#00007F">ByVal</FONT> <FONT COLOR="#00007F">CLng</FONT>(vTopFolder), lItemIDList)<br> .pidlRoot = lItemIDList.mkid.cb<br> <FONT COLOR="#00007F">End</FONT> <FONT COLOR="#00007F">If</FONT><br> <FONT COLOR="#007F00">' Set the dialog's prompt string</FONT><br> .lpszTitle = sInstruct<br> <FONT COLOR="#007F00">' Obtain and set the address of the callback function</FONT><br> .lpCallbackProc = FarProc(AddressOf BrowseCallbackProc)<br> <FONT COLOR="#007F00">' Obtain and set the pidl of the pre-selected folder</FONT><br> <FONT COLOR="#00007F">If</FONT> IsMissing(vSelPath) <FONT COLOR="#00007F">Then</FONT><br> <FONT COLOR="#007F00">'Nothing passed in</FONT><br> .lParam = .pidlRoot<br> <FONT COLOR="#00007F">ElseIf</FONT> Len(vSelPath) > 0 <FONT COLOR="#00007F">And</FONT> <FONT COLOR="#00007F">Not</FONT> IsNumeric(vSelPath) <FONT COLOR="#00007F">Then</FONT><br> <FONT COLOR="#007F00">'String Path passed in</FONT><br> .lParam = SHSimpleIDListFromPath(<FONT COLOR="#00007F">CStr</FONT>(vSelPath))<br> <FONT COLOR="#00007F">Else</FONT><br> <FONT COLOR="#007F00">'Long CSIDL Special Folder Constant passed in</FONT><br> lRet = SHGetSpecialFolderLocation(<FONT COLOR="#00007F">ByVal</FONT> hOwnerWnd, <FONT COLOR="#00007F">ByVal</FONT> <FONT COLOR="#00007F">CLng</FONT>(vSelPath), lItemIDList)<br> .lParam = lItemIDList.mkid.cb<br> <FONT COLOR="#00007F">End</FONT> <FONT COLOR="#00007F">If</FONT><br> <FONT COLOR="#00007F">End</FONT> <FONT COLOR="#00007F">With</FONT><br> <br> <FONT COLOR="#007F00">' Shows the browse dialog and doesn't return until the dialog is</FONT><br> <FONT COLOR="#007F00">' closed. The BrowseCallbackProc will receive all browse</FONT><br> <FONT COLOR="#007F00">' dialog specific messages while the dialog is open. pidlRet will</FONT><br> <FONT COLOR="#007F00">' contain the pidl of the selected folder if the dialog is not cancelled.</FONT><br> pidlRet = SHBrowseForFolder(uBrowseInfo)<br> <br> <FONT COLOR="#00007F">If</FONT> pidlRet > 0 <FONT COLOR="#00007F">Then</FONT><br> <FONT COLOR="#007F00">' Get the path from the selected folder's pidl returned</FONT><br> <FONT COLOR="#007F00">' from the SHBrowseForFolder call (rtns True on success,</FONT><br> <FONT COLOR="#007F00">' sPath must be pre-allocated!)</FONT><br> <FONT COLOR="#00007F">If</FONT> SHGetPathFromIDList(pidlRet, sPath) <FONT COLOR="#00007F">Then</FONT><br> <FONT COLOR="#007F00">' Return the path</FONT><br> BrowseForFolder = Left$(sPath, InStr(sPath, vbNullChar) - 1)<br> <FONT COLOR="#00007F">End</FONT> <FONT COLOR="#00007F">If</FONT><br> <FONT COLOR="#007F00">' Free the memory the shell allocated for the pidl.</FONT><br> <FONT COLOR="#00007F">Call</FONT> CoTaskMemFree(pidlRet)<br> <FONT COLOR="#00007F">End</FONT> <FONT COLOR="#00007F">If</FONT><br> <br> <FONT COLOR="#007F00">' Free the memory the shell allocated for the pre-selected folder.</FONT><br> <FONT COLOR="#00007F">Call</FONT> CoTaskMemFree(uBrowseInfo.lParam)<br> <br><FONT COLOR="#00007F">End</FONT> <FONT COLOR="#00007F">Function</FONT><br><br><FONT COLOR="#00007F">Public</FONT> <FONT COLOR="#00007F">Function</FONT> FarProc(lpProcName <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT>) <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Long</FONT><br><br><FONT COLOR="#007F00">'Returns the value of the AddressOf operator</FONT><br> <br> FarProc = lpProcName<br><br><FONT COLOR="#00007F">End</FONT> <FONT COLOR="#00007F">Function</FONT><br><br><br></BODY></HTML>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -