VB6获取系统特殊目录及环境变量的值

模块 m_PathEnviro.bas
上代码，并欢迎补充我没有列出的项目，谢谢！

'获取模块进程的文件位置
Private Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
'获取当前路径
Private Declare Function GetCurrentDirectory Lib "kernel32" Alias "GetCurrentDirectoryA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
'获取特殊目录及环境变量
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal szPath As String) As Long
'获取临时文件
Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long

Private Type SHITEMID
    Cb As Long
    abID As Byte
End Type
Private Type ITEMIDLIST
    mkid As SHITEMID
End Type

Private Const MAX_PATH = 260
Private Const EspIncr As Long = &H80&   '枚举中特殊目录的常量增量值
Private Const ExpIncr As Long = &HFF&   '枚举中环境变量的常量增量值

Public Enum PathEnviroIndex
    'MySelf: GetModuleFileName、GetCurrentDirectory
    AppPathFileExt = &H0    'D:\Program Files (x86)\Microsoft Visual Studio\VB98\VB6.EXE
    AppPath = &H1           'D:\Program Files (x86)\Microsoft Visual Studio\VB98
    TempFile = &H2          'E:\Users\<User Name>\AppData\Local\Temp\LZT89AB.tmp

    'API: SHGetSpecialFolderLocation、SHGetPathFromIDList
    UserMusic = &HD         'E:\Users\<User Name>\Music
    UserVideos = &HE        'E:\Users\<User Name>\Videos
    UserLocal = &H1C        'E:\Users\<User Name>\AppData\Local
    InternetFiles = &H20    'E:\Users\<User Name>\AppData\Local\Microsoft\Windows\Temporary Internet Files
    UserCookies = &H21      'E:\Users\<User Name>\AppData\Roaming\Microsoft\Windows\Cookies
    UserHistory = &H22      'E:\Users\<User Name>\AppData\Local\Microsoft\Windows\History
    ProgramData = &H23      'C:\ProgramData
    WinDir = &H24           'C:\Windows
    System32 = &H25         'C:\Windows\System32
    ProgramFiles = &H26     'C:\Program Files (x86)
    UserPictures = &H27     'E:\Users\<User Name>\Pictures
    UserFolder = &H28       'E:\Users\<User Name>
    SysWOW64 = &H29         'C:\Windows\SysWOW64
    CommonFiles = &H2B      'C:\Program Files (x86)\Common Files
    PublicTemplates = &H2D  'C:\ProgramData\Microsoft\Windows\Templates
    PublicDocuments = &H2E  'C:\Users\Public\Documents
    PublicAdminTools = &H2F 'C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Administrative Tools
    UserAdminTools = &H30   'E:\Users\<User Name>\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Administrative Tools
    PublicMusic = &H35      'C:\Users\Public\Music
    PublicPictures = &H36   'C:\Users\Public\Pictures
    PublicVideos = &H37     'C:\Users\Public\Videos
    Resources = &H38        'C:\Windows\Resources
    UserBurn = &H3B         'E:\Users\<User Name>\AppData\Local\Microsoft\Windows\Burn\Burn

    'WshShell.SpecialFolders
    PublicDesktop = EspIncr + &H0           'C:\Users\Public\Desktop
    PublicStartMenu = EspIncr + &H1         'C:\ProgramData\Microsoft\Windows\Start Menu
    PublicStartMenuPrograms = EspIncr + &H2 'C:\ProgramData\Microsoft\Windows\Start Menu\Programs
    PublicStartMenuStartup = EspIncr + &H3  'C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Startup
    UserDesktop = EspIncr + &H4             'E:\Users\<User Name>\Desktop
    UserAppData = EspIncr + &H5             'E:\Users\<User Name>\AppData\Roaming
    UserPrinterShortcuts = EspIncr + &H6    'E:\Users\<User Name>\AppData\Roaming\Microsoft\Windows\Printer Shortcuts
    UserTemplates = EspIncr + &H7           'E:\Users\<User Name>\AppData\Roaming\Microsoft\Windows\Templates
    Fonts = EspIncr + &H8                   'C:\Windows\Fonts
    UserNetworkShortcuts = EspIncr + &H9    'E:\Users\<User Name>\AppData\Roaming\Microsoft\Windows\Network Shortcuts
    Desktop = EspIncr + &HA                 'E:\Users\<User Name>\Desktop
    UserStartMenu = EspIncr + &HB           'E:\Users\<User Name>\AppData\Roaming\Microsoft\Windows\Start Menu
    UserSendTo = EspIncr + &HC              'E:\Users\<User Name>\AppData\Roaming\Microsoft\Windows\SendTo
    UserRecent = EspIncr + &HD              'E:\Users\<User Name>\AppData\Roaming\Microsoft\Windows\Recent
    UserStartMenuStartup = EspIncr + &HE    'E:\Users\<User Name>\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Startup
    UserFavorites = EspIncr + &HF           'E:\Users\<User Name>\Favorites
    UserDocuments = EspIncr + &H10&         'E:\Users\<User Name>\Documents
    UserStartMenuPrograms = EspIncr + &H11  'E:\Users\<User Name>\AppData\Roaming\Microsoft\Windows\Start Menu\Programs

    'WshShell.ExpandEnvironmentStrings
    CD = ExpIncr + &H0                      '当前目录                   '%CD%
    ClientName = ExpIncr + &H1              '客户端的NETBIOS名          '%CLIENTNAME%
    CmdCmdLine = ExpIncr + &H2              '当前所使用的命令行         '%CMDCMDLINE%
    CmdExtversion = ExpIncr + &H3           '命令处理程序扩展版本号     '%CMDEXTVERSION%
    ComSpec = ExpIncr + &H4                 '可执行命令外壳             'C:\Windows\system32\cmd.exe
    PCDate = ExpIncr + &H5                  '当前日期                   '%Date%
    PCTime = ExpIncr + &H6                  '当前时间                   '%Time%
    ErrorLevel = ExpIncr + &H7              '最近使用的命令的错误代码   '%ErrorLevel%
    HomeDrive = ExpIncr + &H8               '用户主目录所在的驱动器盘符 'E:
    HomePath = ExpIncr + &H9                '用户主目录的完整路径       '\Users\<User Name>
    HomeShare = ExpIncr + &HA               '用户共享主目录的网络路径   '%HOMESHARE%
    LogonSever = ExpIncr + &HB              '当前登录会话的域名控制器名 '%LOGONSEVER%
    Number_Of_Processors = ExpIncr + &HC    '处理器数量                 '8
    OS = ExpIncr + &HD                      '操作系统的名字             'Windows_NT
    ExecPath = ExpIncr + &HE                '可执行文件的搜索路径       'C:\Windows\system32;C:\Windows;C:\Windows\System32\Wbem;C:\Windows\System32\WindowsPowerShell\v1.0\;C:\Windows\System32\WindowsPowerShell\v1.0\;D:\Program Files\Windows Imaging\
    ExecPathExt = ExpIncr + &HF             '可被执行的文件扩展名       '.COM;.EXE;.BAT;.CMD;.VBS;.VBE;.JS;.JSE;.WSF;.WSH;.MSC
    Processor_Architecture = ExpIncr + &H10 '处理器体系结构             'x86 (x64程序返回 AMD64)
    Processor_Identifier = ExpIncr + &H11   '处理器标识                 'Intel64 Family 6 Model 42 Stepping 7, GenuineIntel
    Processor_Level = ExpIncr + &H12        '处理器水平                 '6
    Processor_Revision = ExpIncr + &H13     '修订版本                   '2a07
    Prompt = ExpIncr + &H14                 '命令提示                   '$P$G
    Random = ExpIncr + &H15                 '0-32767之间的随机十进制数  '%RANDOM%
    SessionName = ExpIncr + &H16            '终端服务的会话名           'Console
    SystemDrive = ExpIncr + &H17            'Windows启动目录所在驱动器  'C:
    SystemRoot = ExpIncr + &H18             'Windows启动目录的位置      'C:\Windows
    TEMP = ExpIncr + &H19                   'E:\Users\<User Name>\AppData\Local\Temp
    TMP = ExpIncr + &H1A                    'E:\Users\<User Name>\AppData\Local\Temp
    ComputerName = ExpIncr + &H1B           '计算机名                   '<Computer Name>
    UserDomain = ExpIncr + &H1C             '包含用户帐号的域的名字     'MyPcName
    UserName = ExpIncr + &H1D               '登录的用户名               '<User Name>
    PublicPath = ExpIncr + &H1E             '公用用户文件夹             'E:\Users\Public
    ProgramW6432 = ExpIncr + &H1F           '应用程序默认安装目录 (x86)
    ProgramFilesX86 = ExpIncr + &H20        '应用程序默认安装目录 (x64)
    FP_No_Host_Check = ExpIncr + &H21       '我也不知道

End Enum
'环境变量的字串
Private Const ExpNames = "CD,ClientName,CmdCmdLine,CmdExtversion,ComSpec,Date,Time,ErrorLevel,HomeDrive,HomePath,HomeShare,LogonSever,Number_Of_Processors,OS,Path,PathExt,Processor_Architecture,Processor_Identifier,Processor_Level,Processor_Revision,Prompt,Random,SessionName,SystemDrive,SystemRoot,TEMP,TMP,ComputerName,UserDomain,UserName,Public,ProgramW6432,ProgramFiles(x86),FP_NO_HOST_CHECK"

Public Function GetPathEnviro(ItemIndex As PathEnviroIndex) As String
    Dim ReturnText As String, TextHandle As Long
    Dim IDL As ITEMIDLIST, WshShell As Object
    Dim ExpArray() As String

    If ItemIndex < EspIncr Then         '单独API获取的路径
        ReturnText = String(MAX_PATH, vbNullChar)
        Select Case ItemIndex
        Case AppPathFileExt             '自身路径文件名扩展名
            TextHandle = GetModuleFileName(0, ReturnText, MAX_PATH)
        Case AppPath                    '自身路径
            TextHandle = GetCurrentDirectory(MAX_PATH, ReturnText)
        Case TempFile
            Randomize
            TextHandle = GetTempFileName(GetPathEnviro(TEMP), "LZT", 0, ReturnText)
            Kill ReturnText
        Case Else                       'API 获取特殊目录
            TextHandle = SHGetSpecialFolderLocation(100, CLng(ItemIndex), IDL)
            If TextHandle = 0 Then
                TextHandle = SHGetPathFromIDList(ByVal IDL.mkid.Cb, ByVal ReturnText)
            End If
        End Select
        ReturnText = Left(ReturnText, InStr(ReturnText, vbNullChar) - 1)
    Else
        Set WshShell = CreateObject("Wscript.Shell")
        If ItemIndex < ExpIncr Then     'WshShell.SpecialFolders 获取特殊目录
            ReturnText = WshShell.SpecialFolders(ItemIndex - EspIncr)
        Else                            'WshShell.ExpandEnvironmentStrings 获取环境变量
            ExpArray = Split(ExpNames, ",")
            ReturnText = WshShell.ExpandEnvironmentStrings("%" & ExpArray((ItemIndex - ExpIncr)) & "%")
        End If
        Set WshShell = Nothing
    End If
    GetPathEnviro = ReturnText
End Function

调用：

'获得音乐文件夹路径
ReturnText = GetPathEnviro(UserMusic)
'获取当前登录的用户名
ReturnText = GetPathEnviro(UserName)

是的是的，被你发现了，我系统的安装盘在C盘，应用程序默认安装在D盘，用户及配置都在E盘。