Question

vb 如何获取其他程序的安装路径

比如我要获取qq 或者 酷狗的安装路径，要怎么做。
应该要查询注册表里的信息吧。
给个示例代码，谢谢

Answer 1

　　我的软件是用InstallShield做的安装程序，安装完以后，在“添加或删除程序”中能找到软件名称，那么对应的在注册表的“HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall”下就能找到该子键，只是子键名称是InstallShield产生的一串随机号，在该子键中的DisplayName是软件名称，InstallLocation则是安装路径。故可通过遍历“HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall”下所有子键，根据DisplayName是否为指定名称，来判断某子键是否为所需子键，并取得InstallLocation的值。不过有个前提条件，就是不能有两个同名的软件，不然就只能取第一个了。
　　以下是我写的模块：

'==================================================================================================
'模块说明：
' 如果在“添加或删除程序”中有某个软件的名称，则可查找该软件在系统中的安装路径，
' 该软件必须是用InstallShield制作的安装程序进行安装的。
'
'算法：
' 用InstallShield制作的安装程序将软件安装完毕后，在注册表的
' HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall
' 下，会添加一个子键（子键名称非软件名称），在该子键下有一个串为DisplayName，
' 串值是该软件名称，故可通过遍历Uninstall下所有子键，并读取DisplayName串是否
' 为软件名称，来判断该子键即为所需子键，并取得其下的InstallLocation串值，
' 即为该软件的安装路径。
'
'用法：
' str1 = getMySoftwarePath("我的软件")
'
'备注：
' 如果在“添加或删除程序”中有两个以上该软件的名称，则只能取得第一个的安装路径
'
'作者：
' Stanley http://stanleyzcm.spaces.live.com
'
'日期：
' 2007-07-06
'==================================================================================================
Option Explicit
'根键
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006
'串值类型
Public Const REG_NONE = 0
Public Const REG_SZ = 1
Public Const REG_EXPAND_SZ = 2
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4
Public Const REG_DWORD_BIG_ENDIAN = 5
Public Const REG_MULTI_SZ = 7
'注册表错误描述
Const ERROR_SUCCESS = 0&
Const ERROR_BADDB = 1009&
Const ERROR_BADKEY = 1010&
Const ERROR_CANTOPEN = 1011&
Const ERROR_CANTREAD = 1012&
Const ERROR_CANTWRITE = 1013&
Const ERROR_REGISTRY_RECOVERED = 1014&
Const ERROR_REGISTRY_CORRUPT = 1015&
Const ERROR_REGISTRY_IO_FAILED = 1016&
Const ERROR_NOT_REGISTRY_FILE = 1017&
Const ERROR_KEY_DELETED = 1018&
Const ERROR_NO_LOG_SPACE = 1019&
Const ERROR_KEY_HAS_CHILDREN = 1020&
Const ERROR_CHILD_MUST_BE_VOLATILE = 1021&
Const ERROR_RXACT_INVALID_STATE = 1369&
'自定义注册表错误
Const REGAGENT_NOKEY = -1002
Const REGAGENT_NOSUBKEY = -1003
'API函数定义
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long
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 Long
Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
Declare Function RegEnumValueAsAny Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Declare Function RegEnumValueAsAny2 Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, lpValueName As Any, lpcbValueName As Long, lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Declare Function ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, ByVal lpDst As String, ByVal nSize As Long) As Long
Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
'==================================================================================================
'函数说明：
' 从注册表中取得字符串值
'参数说明：
' plKey 根键名
' psKey 主键名
' psValue 串名
'例：
' str1 = gfsGetKeyStringValue(HKEY_LOCAL_MACHINE, "SOFTWARE\InstallShield\10.50", "CurrentVersion")
'==================================================================================================
Function gfsGetKeyStringValue(ByVal plKey As Long, ByVal psKey As String, ByVal psValue As String) As String
Dim llKeyID As Long '打开键的ID
Dim llBufferSize As Long '需读取串的串值长度
Dim lsKeyValue As String '存放读取的串值
Dim glStatus As Long

'预先置为空
gfsGetKeyStringValue = Empty
'假设成功
glStatus = ERROR_SUCCESS

'确定参数有效
If Len(psKey) = 0 Then '主键未设置（子键未设置则读预设值）
glStatus = REGAGENT_NOKEY
Exit Function
End If

'首先打开主键
glStatus = RegOpenKey(plKey, psKey, llKeyID)

If glStatus = ERROR_SUCCESS Then '成功则取需读取字串的串值大小
glStatus = RegQueryValueEx(llKeyID, psValue, 0&, REG_SZ, 0&, llBufferSize)
If llBufferSize < 2 Then '空值
glStatus = RegCloseKey(llKeyID)
Else '有值，正式读取串值
lsKeyValue = String(llBufferSize + 1, " ")
glStatus = RegQueryValueEx(llKeyID, psValue, 0&, REG_SZ, ByVal lsKeyValue, llBufferSize)
If glStatus = ERROR_SUCCESS Then
gfsGetKeyStringValue = Left$(lsKeyValue, llBufferSize - 1)
'去除末尾的空格
gfsGetKeyStringValue = RTrim(gfsGetKeyStringValue)
If Asc(Right(gfsGetKeyStringValue, 1)) = 0 Then
'如果取得的串值为中文字符，末尾会多个ASCII码为0的字符，需要去掉
gfsGetKeyStringValue = Left(gfsGetKeyStringValue, Len(gfsGetKeyStringValue) - 1)
End If
End If
glStatus = RegCloseKey(llKeyID)
End If
End If
End Function
'==================================================================================================
'函数说明：
' 遍历注册表某主键下的所有子键，根据该子键下的某串值是否符合条件，来判断该子键为所要查找的子键
'参数说明：
' plKey 根键名
' psKey 主键名
' psValue 串名
' psValueData 串值（字符串值，如需用到其他类型，需要修改该函数的参数类型）
'例：
' str1 = FindRegistyKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall", "DisplayName", "我的软件")
'==================================================================================================
Function FindRegistyKey(ByVal plKey As Long, ByVal psKey As String, ByVal psValue As String, _
ByVal psValueData As String) As String
Dim llKeyID As Long '打开键的ID
Dim glStatus As Long
Dim ret As Long
Dim Name As String
Dim Idx As Long
Dim getValueData As String
'预先置为空
FindRegistyKey = Empty
'假设成功
glStatus = ERROR_SUCCESS

'确定参数有效
If Len(psKey) = 0 Then '主键未设置（子键未设置则读预设值）
glStatus = REGAGENT_NOKEY
Exit Function
End If

'首先打开主键
glStatus = RegOpenKey(plKey, psKey, llKeyID)

If glStatus = ERROR_SUCCESS Then '打开成功
Idx = 0

'遍历主键下的所有子键
Do
Name = String(256, Chr(0))
'依次读取子键
ret = RegEnumKey(llKeyID, Idx, Name, Len(Name))
If ret = 0 Then '读取成功
Name = Left(Name, InStr(Name, Chr(0)) - 1)
getValueData = gfsGetKeyStringValue(plKey, psKey & "" & Name, psValue)
If getValueData <> "" Then
If getValueData = psValueData Then
FindRegistyKey = Name
Exit Function
End If
End If
Idx = Idx + 1
End If
Loop Until ret <> 0
End If
End Function
'==================================================================================================
'函数说明：
' 取得“添加或删除安装程序”中某个软件的安装路径，该软件必须是用InstallShield制作的安装程序来
' 安装的，其安装路径字串为InstallLocation。
'参数说明：
' MySoftwareName 软件名称
'例：
' str1 = getMySoftwarePath("我的软件")
'==================================================================================================
Function getMySoftwarePath(ByVal MySoftwareName As String) As String

Dim plKey As Long
Dim psKey As String
Dim MySoftwareKey As String

plKey = HKEY_LOCAL_MACHINE
psKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
MySoftwareKey = FindRegistyKey(plKey, psKey, "DisplayName", MySoftwareName)
getMySoftwarePath = gfsGetKeyStringValue(plKey, psKey & "" & MySoftwareKey, "InstallLocation")

End Function