技术宅的结界

 找回密码
 立即注册→加入我们

QQ登录

只需一步,快速开始

搜索
热搜: 下载 VB C 实现 编写
查看: 2928|回复: 3
收起左侧

【VB】列出当前安装的程序(不全)

[复制链接]

1090

主题

2609

帖子

7万

积分

用户组: 管理员

一只技术宅

UID
1
精华
237
威望
495 点
宅币
21506 个
贡献
45959 次
宅之契约
0 份
在线时间
2070 小时
注册时间
2014-1-26
发表于 2014-12-26 23:43:26 | 显示全部楼层 |阅读模式

欢迎访问技术宅的结界,请注册或者登录吧。

您需要 登录 才可以下载或查看,没有帐号?立即注册→加入我们

x
20141226234011.png
原理是读取注册表的HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall里面的子项。
这个并不能显示出和【控制面板->添加与删除程序】一样的结果,只是把有Windows卸载器的程序都显示出来了。
核心代码:
[Visual Basic] 纯文本查看 复制代码
Dim ErrNo As Long

Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const ERROR_SUCCESS = 0&
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyW" (ByVal hKey As Long, lpSubKey As Any, phkResult As Long) As Long
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
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
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
Private Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueW" (ByVal hKey As Long, lpSubKey As Any, lpValue As Any, lpcbValue As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Sub GetSoftwareInfo(ByVal RegSubKey As String)
On Error Resume Next
Dim WScrShl As Object
Set WScrShl = CreateObject("WScript.Shell")

Dim RegVal As String
RegVal = WScrShl.RegRead("HKLM\" & RegSubKey & "\DisplayName")
If Len(RegVal) Then lstSoftwares.AddItem RegVal

End Sub

Sub EnumAllSoftwares()
Dim RegKey As Long
ErrNo = RegOpenKey(HKEY_LOCAL_MACHINE, ByVal StrPtr("SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"), RegKey)
If ErrNo Then GoTo Cleanup

Dim NbSubKeys As Long, NbValues As Long, MaxSubKeyLen As Long
ErrNo = RegQueryInfoKey(RegKey, ByVal 0, ByVal 0, 0, NbSubKeys, MaxSubKeyLen, ByVal 0, NbValues, ByVal 0, ByVal 0, ByVal 0, ByVal 0)
If ErrNo Then GoTo Cleanup

Dim I&
For I = 0 To NbSubKeys - 1
    Dim SubKeyName As String
    SubKeyName = String(MaxSubKeyLen, 0)
    ErrNo = RegEnumKey(RegKey, I, ByVal StrPtr(SubKeyName), MaxSubKeyLen)
    If ErrNo Then GoTo Cleanup
    SubKeyName = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\" & Replace(SubKeyName, vbNullChar, "")
    GetSoftwareInfo SubKeyName
    If ErrNo Then GoTo Cleanup
Next

RegCloseKey RegKey
Exit Sub
Cleanup:
If RegKey Then RegCloseKey RegKey
MsgBox ErrNo
End Sub

Private Sub Form_Load()
Show
EnumAllSoftwares
End Sub

Private Sub Form_Resize()
lstSoftwares.Move 0, 0, ScaleWidth, ScaleHeight
End Sub
BIN: 列出程序.exe (20 KB, 下载次数: 4)
SRC:回帖后可见。
游客,如果您要查看本帖隐藏内容请回复

本帖被以下淘专辑推荐:

回复

使用道具 举报

0

主题

53

帖子

103

积分

用户组: 小·技术宅

UID
5780
精华
0
威望
2 点
宅币
46 个
贡献
0 次
宅之契约
0 份
在线时间
0 小时
注册时间
2020-4-3
发表于 2020-4-3 21:44:34 | 显示全部楼层
看看学习下

1

主题

47

帖子

198

积分

用户组: 小·技术宅

UID
6035
精华
0
威望
2 点
宅币
147 个
贡献
0 次
宅之契约
0 份
在线时间
17 小时
注册时间
2020-7-7
发表于 2020-7-8 14:31:15 | 显示全部楼层
本帖最后由 china_shy_wzb 于 2020-7-20 14:07 编辑

系统安装的所有程序

0

主题

24

帖子

0

积分

用户组: 初·技术宅

UID
5412
精华
0
威望
-2 点
宅币
-20 个
贡献
0 次
宅之契约
0 份
在线时间
7 小时
注册时间
2019-10-31
发表于 2021-11-12 22:07:30 | 显示全部楼层
gggggggggggggggggggggggggggggggggggg

评分

参与人数 1宅币 -6 收起 理由
0xAA55 -6 灌水惩罚

查看全部评分

本版积分规则

QQ|申请友链||Archiver|手机版|小黑屋|技术宅的结界 ( 滇ICP备16008837号 )|网站地图

GMT+8, 2021-12-9 05:13 , Processed in 0.041920 second(s), 39 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表