如何得到Windows系统的Program Files的完整路径?

Question

如何得到Windows系统的Program Files的完整路径?

Answer 1

方案一：读注册表
Private Const HKEY_LOCAL_MACHINE = &H80000002Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As LongPrivate Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String) As String
    Dim lResult As Long, lValueType As Long, strBuf As String, lDataBufSize As Long
    'retrieve nformation about the key
    lResult = RegQueryValueEx(hKey, strValueName, 0, lValueType, ByVal 0, lDataBufSize)
    If lResult = 0 Then
        If lValueType = 1 Then
            'Create a buffer
            strBuf = String(lDataBufSize, Chr$(0))
            'retrieve the key's content
            lResult = RegQueryValueEx(hKey, strValueName, 0, 0, ByVal strBuf, lDataBufSize)
            If lResult = 0 Then
                'Remove the unnecessary chr$(0)'s
                RegQueryStringValue = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
            End If
        End If
    End If
End Function
Public Function GetRegString(hKey As Long, strPath As String, strValue As String) As String
    Dim ret
    'Open the key
    RegOpenKey hKey, strPath, ret
    'Get the key's content
    GetRegString = RegQueryStringValue(ret, strValue)
    'Close the key
    RegCloseKey ret
End Function
Private Sub Form_Load()
    MsgBox GetRegString(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion", "ProgramFilesDir")
End Sub
方案二：使用API
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As Long) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Sub Command1_Click()
    Dim r     As Long
    Dim pidl  As Long
    Dim sPath As String
    
    r = SHGetSpecialFolderLocation(hwnd, &H26, pidl)    If r = 0 Then
        sPath = Space$(260)
        r = SHGetPathFromIDList(ByVal pidl, ByVal sPath)
        If r Then
            MsgBox Left$(sPath, InStr(sPath, Chr$(0)) - 1)
        End If
    End If
End Sub