使用SHGetFolderPath 获取系统文件夹路径

灰太狼 2022-12-27 11:26 313阅读 0赞

Const CSIDL\_ADMINTOOLS As Long = &H30 '（用户）\\开始菜单\\程序\\系统管理工具  
Const CSIDL\_ALTSTARTUP As Long = &H1D '未本地化的启动  
Const CSIDL\_APPDATA As Long = &H1A '（用户）\\应用程序的数据  
Const CSIDL\_BITBUCKET As Long = &HA '（桌面）\\回收站  
Const CSIDL\_CONTROLS As Long = &H3 '我的电脑\\控制面板  
Const CSIDL\_COOKIES As Long = &H21  
Const CSIDL\_DESKTOP As Long = &H0 '桌面  
Const CSIDL\_DESKTOPDIRECTORY As Long = &H10 '（用户）\\桌面  
Const CSIDL\_FAVORITES As Long = &H6 '（用户）\\个性化设置  
Const CSIDL\_FONTS As Long = &H14 'windows\\字体  
Const CSIDL\_HISTORY As Long = &H22  
Const CSIDL\_INTERNET As Long = &H1 'IE（桌面上的图标  
Const CSIDL\_INTERNET\_CACHE As Long = &H20 '因特网缓存文件夹  
Const CSIDL\_LOCAL\_APPDATA As Long = &H1C '（用户）\\本地设置\\应用程序数据  
Const CSIDL\_DRIVES As Long = &H11 '我的电脑  
Const CSIDL\_MYPICTURES As Long = &H27 'C:\\Program Files\\My Pictures  
Const CSIDL\_NETHOOD As Long = &H13 '（用户）\\网上邻居中的元素  
Const CSIDL\_NETWORK As Long = &H12 '网上邻居  
Const CSIDL\_PRINTERS As Long = &H4 '我的电脑\\打印机  
Const CSIDL\_PRINTHOOD As Long = &H1B '（用户）\\打印机连接  
Const CSIDL\_PERSONAL As Long = &H5 '我的文档  
Const CSIDL\_PROGRAM\_FILES As Long = &H26 'C:\\Program Files  
Const CSIDL\_PROGRAM\_FILESX86 As Long = &H2A 'x86 apps (Alpha)的程序文件目录  
Const CSIDL\_PROGRAMS As Long = &H2 '开始菜单\\程序  
Const CSIDL\_PROGRAM\_FILES\_COMMON As Long = &H2B 'Program Files\\Common  
Const CSIDL\_PROGRAM\_FILES\_COMMONX86 As Long = &H2C 'RISC上的x86 \\Program Files\\Common  
Const CSIDL\_RECENT As Long = &H8 '(用户)\\最近记录目录  
Const CSIDL\_SENDTO As Long = &H9 '(用户)\\发送到目录  
Const CSIDL\_STARTMENU As Long = &HB '(用户)\\开始菜单  
Const CSIDL\_STARTUP As Long = &H7 '开始菜单\\程序\\启动  
Const CSIDL\_SYSTEM As Long = &H25 'system文件夹  
Const CSIDL\_SYSTEMX86 As Long = &H29 'x86 apps (Alpha)的system文件夹  
Const CSIDL\_TEMPLATES As Long = &H15  
Const CSIDL\_PROFILE As Long = &H28 '用户概貌文件夹  
Const CSIDL\_WINDOWS As Long = &H24 'Windows目录或SYSROOT()  
Const CSIDL\_COMMON\_ADMINTOOLS As Long = &H2F '（所有用户）\\开始菜单\\程序\\系统管理工具  
Const CSIDL\_COMMON\_ALTSTARTUP As Long = &H1E '未本地化的通用启动  
Const CSIDL\_COMMON\_APPDATA As Long = &H23 '（所有用户）\\应用程序数据  
Const CSIDL\_COMMON\_DESKTOPDIRECTORY As Long = &H19 '（所有用户）\\桌面  
Const CSIDL\_COMMON\_DOCUMENTS As Long = &H2E '（所有用户）\\文档  
Const CSIDL\_COMMON\_FAVORITES As Long = &H1F '(所有用户)\\设置  
Const CSIDL\_COMMON\_PROGRAMS As Long = &H17 '(所有用户)\\程序  
Const CSIDL\_COMMON\_STARTMENU As Long = &H16 '(所有用户)\\开始菜单  
Const CSIDL\_COMMON\_STARTUP As Long = &H18 '(所有用户)\\启动  
Const CSIDL\_COMMON\_TEMPLATES As Long = &H2D '(所有用户)\\临时

'Api函数  
Private Declare Function SHGetFolderPath Lib "shfolder.dll" Alias "SHGetFolderPathA" \_  
(ByVal hWndOwner As Long, ByVal nFolder As Long, \_  
ByVal hToken As Long, ByVal dwReserved As Long, \_  
ByVal lpszPath As String) As Long  
'其他常量  
Const CSIDL\_FLAG\_Create = &H8000&  
Const CSIDL\_FLAG\_DONT\_VERIFY = &H4000  
Const CSIDL\_FLAG\_MASK = &HFF00  
Const SHGFP\_TYPE\_CURRENT = &H0  
Const SHGFP\_TYPE\_DEFAULT = &H1

'自写调用函数  
Function GetFolderPath(CSIDL As Long) As String  
Dim sPath As String  
Dim RetVal As Long  
sPath = String(256, Chr(0))  
RetVal = SHGetFolderPath(0, CSIDL, 0, SHGFP\_TYPE\_CURRENT, sPath)  
Select Case RetVal  
Case S\_OK  
GetFolderPath = Left(sPath, InStr(1, sPath, Chr(0)) - 1)  
Case Else  
GetFolderPath = "False"  
End Select  
End Function

Private Sub Command1\_Click()  
MsgBox GetFolderPath(CSIDL\_SYSTEM)  
  
End Sub

'部分常量在XP下无效!!!