【VB】列出当前安装的程序（不全）

0xAA55

原理是读取注册表的HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall里面的子项。
这个并不能显示出和【控制面板->添加与删除程序】一样的结果，只是把有Windows卸载器的程序都显示出来了。
核心代码：

1. Dim ErrNo As Long
   
2. 
   
3. Private Const HKEY_LOCAL_MACHINE = &H80000002
   
4. Private Const ERROR_SUCCESS = 0&
   
5. Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyW" (ByVal hKey As Long, lpSubKey As Any, phkResult As Long) As Long
   
6. Private Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyW" (ByVal hKey As Long, lpClass As Any, lpcbClass As Long, ByVal lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, lpftLastWriteTime As Any) As Long
   
7. Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyW" (ByVal hKey As Long, ByVal dwIndex As Long, lpName As Any, ByVal cbName As Long) As Long
   
8. Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueW" (ByVal hKey As Long, ByVal dwIndex As Long, lpValueName As Any, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
   
9. Private Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueW" (ByVal hKey As Long, lpSubKey As Any, lpValue As Any, lpcbValue As Long) As Long
   
10. Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
    
11. 
    
12. Sub GetSoftwareInfo(ByVal RegSubKey As String)
    
13. On Error Resume Next
    
14. Dim WScrShl As Object
    
15. Set WScrShl = CreateObject("WScript.Shell")
    
16. 
    
17. Dim RegVal As String
    
18. RegVal = WScrShl.RegRead("HKLM" & RegSubKey & "\DisplayName")
    
19. If Len(RegVal) Then lstSoftwares.AddItem RegVal
    
20. 
    
21. End Sub
    
22. 
    
23. Sub EnumAllSoftwares()
    
24. Dim RegKey As Long
    
25. ErrNo = RegOpenKey(HKEY_LOCAL_MACHINE, ByVal StrPtr("SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"), RegKey)
    
26. If ErrNo Then GoTo Cleanup
    
27. 
    
28. Dim NbSubKeys As Long, NbValues As Long, MaxSubKeyLen As Long
    
29. ErrNo = RegQueryInfoKey(RegKey, ByVal 0, ByVal 0, 0, NbSubKeys, MaxSubKeyLen, ByVal 0, NbValues, ByVal 0, ByVal 0, ByVal 0, ByVal 0)
    
30. If ErrNo Then GoTo Cleanup
    
31. 
    
32. Dim I&
    
33. For I = 0 To NbSubKeys - 1
    
34.     Dim SubKeyName As String
    
35.     SubKeyName = String(MaxSubKeyLen, 0)
    
36.     ErrNo = RegEnumKey(RegKey, I, ByVal StrPtr(SubKeyName), MaxSubKeyLen)
    
37.     If ErrNo Then GoTo Cleanup
    
38.     SubKeyName = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall" & Replace(SubKeyName, vbNullChar, "")
    
39.     GetSoftwareInfo SubKeyName
    
40.     If ErrNo Then GoTo Cleanup
    
41. Next
    
42. 
    
43. RegCloseKey RegKey
    
44. Exit Sub
    
45. Cleanup:
    
46. If RegKey Then RegCloseKey RegKey
    
47. MsgBox ErrNo
    
48. End Sub
    
49. 
    
50. Private Sub Form_Load()
    
51. Show
    
52. EnumAllSoftwares
    
53. End Sub
    
54. 
    
55. Private Sub Form_Resize()
    
56. lstSoftwares.Move 0, 0, ScaleWidth, ScaleHeight
    
57. End Sub

复制代码

BIN: 列出程序.exe (20 KB, 下载次数: 4)

2014-12-26 23:42 上传

点击文件名下载附件

SRC:回帖后可见。

游客，如果您要查看本帖隐藏内容请回复

hxin123456

看看学习下

大宝

系统安装的所有程序

xiongsx

gggggggggggggggggggggggggggggggggggg

完玩

64位系统下还得读一个wow目录，不然可能会有遗漏，只要能读到和控制面板-程序里面的条目一样就行了