QB64.org Forum

Active Forums => Programs => Topic started by: SpriggsySpriggs on June 17, 2021, 11:05:26 pm

Title: Check if a program is installed using the registry (WinAPI)
Post by: SpriggsySpriggs on June 17, 2021, 11:05:26 pm

Below is code to determine if a program is installed in Windows. If IsInstalled fails then it checks IsInstalled64 to see if it is under the other installation key.

Code: QB64: [Select]

1. Option _Explicit
2.  
3. If IsInstalled("EaseUS Partition Master 15.0") Then
4.     Print "Installed"
5. End If
6.  
7. If IsInstalled("PowerShell") Then
8.     Print "Installed"
9. End If
10.  
11. Declare CustomType Library
12.     Function RegOpenKey& Alias "RegOpenKeyExA" (ByVal hKey As _Offset, Byval lpSubKey As _Offset, Byval ulOptions As _Unsigned Long, Byval samDesired As _Unsigned Long, Byval phkResult As _Offset)
13.     Function RegEnumKey& Alias "RegEnumKeyExA" (ByVal hKey As _Offset, Byval dwIndex As _Unsigned Long, Byval lpName As _Offset, Byval lpcchName As _Offset, Byval lpReserved As _Offset, Byval lpClass As _Offset, Byval lpcchClass As _Offset, Byval lpftLastWriteTime As _Offset)
14.     Function RegQueryValue& Alias "RegQueryValueExA" (ByVal hKey As _Offset, lpValueName As String, Byval lpReserved As _Offset, Byval lpType As _Offset, Byval lpData As _Offset, Byval lpcbData As _Offset)
15.     Sub RegCloseKey (ByVal hKey As _Offset)
16. End Declare
17.  
18. Function IsInstalled%% (software As String)
19.     Const HKEY_LOCAL_MACHINE = &H80000002~&
20.     Const KEY_ALL_ACCESS = &HF003F&
21.     Const KEY_READ = &H20019&
22.     Const ERROR_SUCCESS = 0
23.  
24.     Dim As _Offset hUninstKey, hAppKey
25.     Dim As String sAppKeyName, sSubKey, sDisplayName
26.     sAppKeyName = Space$(1024): sSubKey = Space$(1024): sDisplayName = Space$(1024)
27.     Dim As String sRoot
28.     sRoot = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall" + Chr$(0)
29.     Dim As Long lResult: lResult = ERROR_SUCCESS
30.     Dim As Long dwType: dwType = KEY_ALL_ACCESS
31.     Dim As Long dwBufferSize
32.  
33.     If RegOpenKey(HKEY_LOCAL_MACHINE, _Offset(sRoot), 0, KEY_READ, _Offset(hUninstKey)) <> ERROR_SUCCESS Then
34.         IsInstalled = 0
35.         Exit Function
36.     End If
37.     Dim As Long dwindex
38.     Do
39.         sAppKeyName = Space$(1024)
40.         dwBufferSize = Len(sAppKeyName)
41.         lResult = RegEnumKey(hUninstKey, dwindex, _Offset(sAppKeyName), _Offset(dwBufferSize), 0, 0, 0, 0)
42.         If lResult = ERROR_SUCCESS Then
43.             sSubKey = Mid$(sRoot, 1, InStr(sRoot, Chr$(0)) - 1) + "\" + Mid$(sAppKeyName, 1, InStr(sAppKeyName, Chr$(0)) - 1) + Chr$(0)
44.             If RegOpenKey(HKEY_LOCAL_MACHINE, _Offset(sSubKey), 0, KEY_READ, _Offset(hAppKey)) <> ERROR_SUCCESS Then
45.                 RegCloseKey hAppKey
46.                 RegCloseKey hUninstKey
47.                 IsInstalled = 0
48.                 Exit Function
49.             End If
50.             dwBufferSize = Len(sDisplayName)
51.             If RegQueryValue(hAppKey, "DisplayName" + Chr$(0), 0, _Offset(dwType), _Offset(sDisplayName), _Offset(dwBufferSize)) = ERROR_SUCCESS Then
52.                 'Print Mid$(sDisplayName, 1, dwBufferSize)
53.                 If InStr(Mid$(sDisplayName, 1, dwBufferSize), software) Then
54.                     RegCloseKey hAppKey
55.                     RegCloseKey hUninstKey
56.                     IsInstalled = -1
57.                     Exit Function
58.                 End If
59.             End If
60.             RegCloseKey hAppKey
61.         End If
62.         dwindex = dwindex + 1
63.     Loop While lResult = ERROR_SUCCESS
64.     RegCloseKey hUninstKey
65.     IsInstalled = IsInstalled64(software)
66. End Function
67.  
68. Function IsInstalled64%% (software As String)
69.     Const HKEY_LOCAL_MACHINE = &H80000002~&
70.     Const KEY_ALL_ACCESS = &HF003F&
71.     Const KEY_READ = &H20019&
72.     Const ERROR_SUCCESS = 0
73.  
74.     Dim As _Offset hUninstKey, hAppKey
75.     Dim As String sAppKeyName, sSubKey, sDisplayName
76.     sAppKeyName = Space$(1024): sSubKey = Space$(1024): sDisplayName = Space$(1024)
77.     Dim As String sRoot
78.     sRoot = "SOFTWARE\WOW6432Node\Microsoft\Windows\CurrentVersion\Uninstall" + Chr$(0)
79.     Dim As Long lResult: lResult = ERROR_SUCCESS
80.     Dim As Long dwType: dwType = KEY_ALL_ACCESS
81.     Dim As Long dwBufferSize
82.  
83.     If RegOpenKey(HKEY_LOCAL_MACHINE, _Offset(sRoot), 0, KEY_READ, _Offset(hUninstKey)) <> ERROR_SUCCESS Then
84.         IsInstalled64 = 0
85.         Exit Function
86.     End If
87.     Dim As Long dwindex
88.     Do
89.         sAppKeyName = Space$(1024)
90.         dwBufferSize = Len(sAppKeyName)
91.         lResult = RegEnumKey(hUninstKey, dwindex, _Offset(sAppKeyName), _Offset(dwBufferSize), 0, 0, 0, 0)
92.         If lResult = ERROR_SUCCESS Then
93.             sSubKey = Mid$(sRoot, 1, InStr(sRoot, Chr$(0)) - 1) + "\" + Mid$(sAppKeyName, 1, InStr(sAppKeyName, Chr$(0)) - 1) + Chr$(0)
94.             If RegOpenKey(HKEY_LOCAL_MACHINE, _Offset(sSubKey), 0, KEY_READ, _Offset(hAppKey)) <> ERROR_SUCCESS Then
95.                 RegCloseKey hAppKey
96.                 RegCloseKey hUninstKey
97.                 IsInstalled64 = 0
98.                 Exit Function
99.             End If
100.             dwBufferSize = Len(sDisplayName)
101.             If RegQueryValue(hAppKey, "DisplayName" + Chr$(0), 0, _Offset(dwType), _Offset(sDisplayName), _Offset(dwBufferSize)) = ERROR_SUCCESS Then
102.                 'Print Mid$(sDisplayName, 1, dwBufferSize)
103.                 If InStr(Mid$(sDisplayName, 1, dwBufferSize), software) Then
104.                     RegCloseKey hAppKey
105.                     RegCloseKey hUninstKey
106.                     IsInstalled64 = -1
107.                     Exit Function
108.                 End If
109.             End If
110.             RegCloseKey hAppKey
111.         End If
112.         dwindex = dwindex + 1
113.     Loop While lResult = ERROR_SUCCESS
114.     RegCloseKey hUninstKey
115.     IsInstalled64 = 0
116. End Function

Title: Check program installation, version, and uninstall using the registry (WinAPI)
Post by: SpriggsySpriggs on June 18, 2021, 03:06:35 pm

I've added some more features. Now you can not only check if something is installed, you can also check which version is installed. Also, you can get the "UninstallString" key which can be used with SHELL to uninstall the programs.

Code: QB64: [Select]

1. Option _Explicit
2.  
3. If IsInstalled("teamviewer") Then
4.     Print "Installed"
5.     Print CheckVersion("teamviewer")
6.     Print GetUninstallString("teamviewer")
7. Else Print "Not installed"
8. End If
9.  
10. If IsInstalled("powershell 7-x64") Then
11.     Print "Installed"
12.     Print CheckVersion("powershell 7-x64")
13.     Print GetUninstallString("powershell 7-x64")
14. Else Print "Not installed"
15. End If
16.  
17. If IsInstalled("Google Chrome") Then
18.     Print "Installed"
19.     Print CheckVersion("Google Chrome")
20.     Print GetUninstallString("Google Chrome")
21.     'Shell GetUninstallString("Google Chrome")
22. Else Print "Not installed"
23. End If
24.  
25. Declare CustomType Library
26.     Function RegOpenKey& Alias "RegOpenKeyExA" (ByVal hKey As _Offset, Byval lpSubKey As _Offset, Byval ulOptions As _Unsigned Long, Byval samDesired As _Unsigned Long, Byval phkResult As _Offset)
27.     Function RegEnumKey& Alias "RegEnumKeyExA" (ByVal hKey As _Offset, Byval dwIndex As _Unsigned Long, Byval lpName As _Offset, Byval lpcchName As _Offset, Byval lpReserved As _Offset, Byval lpClass As _Offset, Byval lpcchClass As _Offset, Byval lpftLastWriteTime As _Offset)
28.     Function RegQueryValue& Alias "RegQueryValueExA" (ByVal hKey As _Offset, lpValueName As String, Byval lpReserved As _Offset, Byval lpType As _Offset, Byval lpData As _Offset, Byval lpcbData As _Offset)
29.     Sub RegCloseKey (ByVal hKey As _Offset)
30. End Declare
31.  
32. Function IsInstalled%% (software As String)
33.     Const HKEY_LOCAL_MACHINE = &H80000002~&
34.     Const KEY_ALL_ACCESS = &HF003F&
35.     Const KEY_READ = &H20019&
36.     Const ERROR_SUCCESS = 0
37.  
38.     Dim As _Offset hUninstKey, hAppKey
39.     Dim As String sAppKeyName, sSubKey, sDisplayName
40.     sAppKeyName = Space$(1024): sSubKey = Space$(1024): sDisplayName = Space$(1024)
41.     Dim As String sRoot
42.     sRoot = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall" + Chr$(0)
43.     Dim As Long lResult: lResult = ERROR_SUCCESS
44.     Dim As Long dwType: dwType = KEY_ALL_ACCESS
45.     Dim As Long dwBufferSize
46.  
47.     If RegOpenKey(HKEY_LOCAL_MACHINE, _Offset(sRoot), 0, KEY_READ, _Offset(hUninstKey)) <> ERROR_SUCCESS Then
48.         IsInstalled = 0
49.         Exit Function
50.     End If
51.     Dim As Long dwindex
52.     Do
53.         sAppKeyName = Space$(1024)
54.         dwBufferSize = Len(sAppKeyName)
55.         lResult = RegEnumKey(hUninstKey, dwindex, _Offset(sAppKeyName), _Offset(dwBufferSize), 0, 0, 0, 0)
56.         If lResult = ERROR_SUCCESS Then
57.             sSubKey = Mid$(sRoot, 1, InStr(sRoot, Chr$(0)) - 1) + "\" + Mid$(sAppKeyName, 1, InStr(sAppKeyName, Chr$(0)) - 1) + Chr$(0)
58.             If RegOpenKey(HKEY_LOCAL_MACHINE, _Offset(sSubKey), 0, KEY_READ, _Offset(hAppKey)) <> ERROR_SUCCESS Then
59.                 RegCloseKey hAppKey
60.                 RegCloseKey hUninstKey
61.                 IsInstalled = 0
62.                 Exit Function
63.             End If
64.             dwBufferSize = Len(sDisplayName)
65.             If RegQueryValue(hAppKey, "DisplayName" + Chr$(0), 0, _Offset(dwType), _Offset(sDisplayName), _Offset(dwBufferSize)) = ERROR_SUCCESS Then
66.                 If _StriCmp(Mid$(sDisplayName, 1, dwBufferSize - 1), software) = 0 Then
67.                     RegCloseKey hAppKey
68.                     RegCloseKey hUninstKey
69.                     IsInstalled = -1
70.                     Exit Function
71.                 End If
72.             End If
73.             RegCloseKey hAppKey
74.         End If
75.         dwindex = dwindex + 1
76.     Loop While lResult = ERROR_SUCCESS
77.     RegCloseKey hUninstKey
78.     IsInstalled = IsInstalled64(software)
79. End Function
80.  
81. Function IsInstalled64%% (software As String)
82.     Const HKEY_LOCAL_MACHINE = &H80000002~&
83.     Const KEY_ALL_ACCESS = &HF003F&
84.     Const KEY_READ = &H20019&
85.     Const ERROR_SUCCESS = 0
86.  
87.     Dim As _Offset hUninstKey, hAppKey
88.     Dim As String sAppKeyName, sSubKey, sDisplayName
89.     sAppKeyName = Space$(1024): sSubKey = Space$(1024): sDisplayName = Space$(1024)
90.     Dim As String sRoot
91.     sRoot = "SOFTWARE\WOW6432Node\Microsoft\Windows\CurrentVersion\Uninstall" + Chr$(0)
92.     Dim As Long lResult: lResult = ERROR_SUCCESS
93.     Dim As Long dwType: dwType = KEY_ALL_ACCESS
94.     Dim As Long dwBufferSize
95.  
96.     If RegOpenKey(HKEY_LOCAL_MACHINE, _Offset(sRoot), 0, KEY_READ, _Offset(hUninstKey)) <> ERROR_SUCCESS Then
97.         IsInstalled64 = 0
98.         Exit Function
99.     End If
100.     Dim As Long dwindex
101.     Do
102.         sAppKeyName = Space$(1024)
103.         dwBufferSize = Len(sAppKeyName)
104.         lResult = RegEnumKey(hUninstKey, dwindex, _Offset(sAppKeyName), _Offset(dwBufferSize), 0, 0, 0, 0)
105.         If lResult = ERROR_SUCCESS Then
106.             sSubKey = Mid$(sRoot, 1, InStr(sRoot, Chr$(0)) - 1) + "\" + Mid$(sAppKeyName, 1, InStr(sAppKeyName, Chr$(0)) - 1) + Chr$(0)
107.             If RegOpenKey(HKEY_LOCAL_MACHINE, _Offset(sSubKey), 0, KEY_READ, _Offset(hAppKey)) <> ERROR_SUCCESS Then
108.                 RegCloseKey hAppKey
109.                 RegCloseKey hUninstKey
110.                 IsInstalled64 = 0
111.                 Exit Function
112.             End If
113.             dwBufferSize = Len(sDisplayName)
114.             If RegQueryValue(hAppKey, "DisplayName" + Chr$(0), 0, _Offset(dwType), _Offset(sDisplayName), _Offset(dwBufferSize)) = ERROR_SUCCESS Then
115.                 If _StriCmp(Mid$(sDisplayName, 1, dwBufferSize - 1), software) = 0 Then
116.                     RegCloseKey hAppKey
117.                     RegCloseKey hUninstKey
118.                     IsInstalled64 = -1
119.                     Exit Function
120.                 End If
121.             End If
122.             RegCloseKey hAppKey
123.         End If
124.         dwindex = dwindex + 1
125.     Loop While lResult = ERROR_SUCCESS
126.     RegCloseKey hUninstKey
127.     IsInstalled64 = 0
128. End Function
129.  
130. Function CheckVersion$ (software As String)
131.     Const HKEY_LOCAL_MACHINE = &H80000002~&
132.     Const KEY_ALL_ACCESS = &HF003F&
133.     Const KEY_READ = &H20019&
134.     Const ERROR_SUCCESS = 0
135.  
136.     Dim As _Offset hUninstKey, hAppKey
137.     Dim As String sAppKeyName, sSubKey, sDisplayName
138.     sAppKeyName = Space$(1024): sSubKey = Space$(1024): sDisplayName = Space$(1024)
139.     Dim As String sRoot
140.     sRoot = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall" + Chr$(0)
141.     Dim As Long lResult: lResult = ERROR_SUCCESS
142.     Dim As Long dwType: dwType = KEY_ALL_ACCESS
143.     Dim As Long dwBufferSize
144.  
145.     If RegOpenKey(HKEY_LOCAL_MACHINE, _Offset(sRoot), 0, KEY_READ, _Offset(hUninstKey)) <> ERROR_SUCCESS Then
146.         CheckVersion = ""
147.         Exit Function
148.     End If
149.     Dim As Long dwindex
150.     Do
151.         sAppKeyName = Space$(1024)
152.         dwBufferSize = Len(sAppKeyName)
153.         lResult = RegEnumKey(hUninstKey, dwindex, _Offset(sAppKeyName), _Offset(dwBufferSize), 0, 0, 0, 0)
154.         If lResult = ERROR_SUCCESS Then
155.             sSubKey = Mid$(sRoot, 1, InStr(sRoot, Chr$(0)) - 1) + "\" + Mid$(sAppKeyName, 1, InStr(sAppKeyName, Chr$(0)) - 1) + Chr$(0)
156.             If RegOpenKey(HKEY_LOCAL_MACHINE, _Offset(sSubKey), 0, KEY_READ, _Offset(hAppKey)) <> ERROR_SUCCESS Then
157.                 RegCloseKey hAppKey
158.                 RegCloseKey hUninstKey
159.                 CheckVersion = ""
160.                 Exit Function
161.             End If
162.             dwBufferSize = Len(sDisplayName)
163.             If RegQueryValue(hAppKey, "DisplayName" + Chr$(0), 0, _Offset(dwType), _Offset(sDisplayName), _Offset(dwBufferSize)) = ERROR_SUCCESS Then
164.                 If _StriCmp(Mid$(sDisplayName, 1, dwBufferSize - 1), software) = 0 Then
165.                     Dim As String version: version = Space$(1024)
166.                     Dim As Long verlen: verlen = Len(version)
167.                     If RegQueryValue(hAppKey, "DisplayVersion" + Chr$(0), 0, _Offset(dwType), _Offset(version), _Offset(verlen)) = ERROR_SUCCESS Then
168.                         CheckVersion = Mid$(version, 1, verlen - 1)
169.                     Else
170.                         CheckVersion = ""
171.                     End If
172.                     RegCloseKey hAppKey
173.                     RegCloseKey hUninstKey
174.                     Exit Function
175.                 End If
176.             End If
177.             RegCloseKey hAppKey
178.         End If
179.         dwindex = dwindex + 1
180.     Loop While lResult = ERROR_SUCCESS
181.     RegCloseKey hUninstKey
182.     CheckVersion = CheckVersion64(software)
183. End Function
184.  
185. Function CheckVersion64$ (software As String)
186.     Const HKEY_LOCAL_MACHINE = &H80000002~&
187.     Const KEY_ALL_ACCESS = &HF003F&
188.     Const KEY_READ = &H20019&
189.     Const ERROR_SUCCESS = 0
190.  
191.     Dim As _Offset hUninstKey, hAppKey
192.     Dim As String sAppKeyName, sSubKey, sDisplayName
193.     sAppKeyName = Space$(1024): sSubKey = Space$(1024): sDisplayName = Space$(1024)
194.     Dim As String sRoot
195.     sRoot = "SOFTWARE\WOW6432Node\Microsoft\Windows\CurrentVersion\Uninstall" + Chr$(0)
196.     Dim As Long lResult: lResult = ERROR_SUCCESS
197.     Dim As Long dwType: dwType = KEY_ALL_ACCESS
198.     Dim As Long dwBufferSize
199.  
200.     If RegOpenKey(HKEY_LOCAL_MACHINE, _Offset(sRoot), 0, KEY_READ, _Offset(hUninstKey)) <> ERROR_SUCCESS Then
201.         CheckVersion64 = ""
202.         Exit Function
203.     End If
204.     Dim As Long dwindex
205.     Do
206.         sAppKeyName = Space$(1024)
207.         dwBufferSize = Len(sAppKeyName)
208.         lResult = RegEnumKey(hUninstKey, dwindex, _Offset(sAppKeyName), _Offset(dwBufferSize), 0, 0, 0, 0)
209.         If lResult = ERROR_SUCCESS Then
210.             sSubKey = Mid$(sRoot, 1, InStr(sRoot, Chr$(0)) - 1) + "\" + Mid$(sAppKeyName, 1, InStr(sAppKeyName, Chr$(0)) - 1) + Chr$(0)
211.             If RegOpenKey(HKEY_LOCAL_MACHINE, _Offset(sSubKey), 0, KEY_READ, _Offset(hAppKey)) <> ERROR_SUCCESS Then
212.                 RegCloseKey hAppKey
213.                 RegCloseKey hUninstKey
214.                 CheckVersion64 = ""
215.                 Exit Function
216.             End If
217.             dwBufferSize = Len(sDisplayName)
218.             If RegQueryValue(hAppKey, "DisplayName" + Chr$(0), 0, _Offset(dwType), _Offset(sDisplayName), _Offset(dwBufferSize)) = ERROR_SUCCESS Then
219.                 If _StriCmp(Mid$(sDisplayName, 1, dwBufferSize - 1), software) = 0 Then
220.                     Dim As String version: version = Space$(1024)
221.                     Dim As Long verlen: verlen = Len(version)
222.                     If RegQueryValue(hAppKey, "DisplayVersion" + Chr$(0), 0, _Offset(dwType), _Offset(version), _Offset(verlen)) = ERROR_SUCCESS Then
223.                         CheckVersion64 = Mid$(version, 1, verlen - 1)
224.                     Else
225.                         CheckVersion64 = ""
226.                     End If
227.                     RegCloseKey hAppKey
228.                     RegCloseKey hUninstKey
229.                     Exit Function
230.                 End If
231.             End If
232.             RegCloseKey hAppKey
233.         End If
234.         dwindex = dwindex + 1
235.     Loop While lResult = ERROR_SUCCESS
236.     RegCloseKey hUninstKey
237.     CheckVersion64 = ""
238. End Function
239.  
240. Function GetUninstallString$ (software As String)
241.     Const HKEY_LOCAL_MACHINE = &H80000002~&
242.     Const KEY_ALL_ACCESS = &HF003F&
243.     Const KEY_READ = &H20019&
244.     Const ERROR_SUCCESS = 0
245.  
246.     Dim As _Offset hUninstKey, hAppKey
247.     Dim As String sAppKeyName, sSubKey, sDisplayName
248.     sAppKeyName = Space$(1024): sSubKey = Space$(1024): sDisplayName = Space$(1024)
249.     Dim As String sRoot
250.     sRoot = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall" + Chr$(0)
251.     Dim As Long lResult: lResult = ERROR_SUCCESS
252.     Dim As Long dwType: dwType = KEY_ALL_ACCESS
253.     Dim As Long dwBufferSize
254.  
255.     If RegOpenKey(HKEY_LOCAL_MACHINE, _Offset(sRoot), 0, KEY_READ, _Offset(hUninstKey)) <> ERROR_SUCCESS Then
256.         GetUninstallString = ""
257.         Exit Function
258.     End If
259.     Dim As Long dwindex
260.     Do
261.         sAppKeyName = Space$(1024)
262.         dwBufferSize = Len(sAppKeyName)
263.         lResult = RegEnumKey(hUninstKey, dwindex, _Offset(sAppKeyName), _Offset(dwBufferSize), 0, 0, 0, 0)
264.         If lResult = ERROR_SUCCESS Then
265.             sSubKey = Mid$(sRoot, 1, InStr(sRoot, Chr$(0)) - 1) + "\" + Mid$(sAppKeyName, 1, InStr(sAppKeyName, Chr$(0)) - 1) + Chr$(0)
266.             If RegOpenKey(HKEY_LOCAL_MACHINE, _Offset(sSubKey), 0, KEY_READ, _Offset(hAppKey)) <> ERROR_SUCCESS Then
267.                 RegCloseKey hAppKey
268.                 RegCloseKey hUninstKey
269.                 GetUninstallString = ""
270.                 Exit Function
271.             End If
272.             dwBufferSize = Len(sDisplayName)
273.             If RegQueryValue(hAppKey, "DisplayName" + Chr$(0), 0, _Offset(dwType), _Offset(sDisplayName), _Offset(dwBufferSize)) = ERROR_SUCCESS Then
274.                 If _StriCmp(Mid$(sDisplayName, 1, dwBufferSize - 1), software) = 0 Then
275.                     Dim As String uninstall: uninstall = Space$(1024)
276.                     Dim As Long Lenuninstall: Lenuninstall = Len(uninstall)
277.                     If RegQueryValue(hAppKey, "UninstallString" + Chr$(0), 0, _Offset(dwType), _Offset(uninstall), _Offset(Lenuninstall)) = ERROR_SUCCESS Then
278.                         GetUninstallString = Mid$(uninstall, 1, Lenuninstall - 1)
279.                     Else
280.                         GetUninstallString = ""
281.                     End If
282.                     RegCloseKey hAppKey
283.                     RegCloseKey hUninstKey
284.                     Exit Function
285.                 End If
286.             End If
287.             RegCloseKey hAppKey
288.         End If
289.         dwindex = dwindex + 1
290.     Loop While lResult = ERROR_SUCCESS
291.     RegCloseKey hUninstKey
292.     GetUninstallString = GetUninstallString64(software)
293. End Function
294.  
295. Function GetUninstallString64$ (software As String)
296.     Const HKEY_LOCAL_MACHINE = &H80000002~&
297.     Const KEY_ALL_ACCESS = &HF003F&
298.     Const KEY_READ = &H20019&
299.     Const ERROR_SUCCESS = 0
300.  
301.     Dim As _Offset hUninstKey, hAppKey
302.     Dim As String sAppKeyName, sSubKey, sDisplayName
303.     sAppKeyName = Space$(1024): sSubKey = Space$(1024): sDisplayName = Space$(1024)
304.     Dim As String sRoot
305.     sRoot = "SOFTWARE\WOW6432Node\Microsoft\Windows\CurrentVersion\Uninstall" + Chr$(0)
306.     Dim As Long lResult: lResult = ERROR_SUCCESS
307.     Dim As Long dwType: dwType = KEY_ALL_ACCESS
308.     Dim As Long dwBufferSize
309.  
310.     If RegOpenKey(HKEY_LOCAL_MACHINE, _Offset(sRoot), 0, KEY_READ, _Offset(hUninstKey)) <> ERROR_SUCCESS Then
311.         GetUninstallString64 = ""
312.         Exit Function
313.     End If
314.     Dim As Long dwindex
315.     Do
316.         sAppKeyName = Space$(1024)
317.         dwBufferSize = Len(sAppKeyName)
318.         lResult = RegEnumKey(hUninstKey, dwindex, _Offset(sAppKeyName), _Offset(dwBufferSize), 0, 0, 0, 0)
319.         If lResult = ERROR_SUCCESS Then
320.             sSubKey = Mid$(sRoot, 1, InStr(sRoot, Chr$(0)) - 1) + "\" + Mid$(sAppKeyName, 1, InStr(sAppKeyName, Chr$(0)) - 1) + Chr$(0)
321.             If RegOpenKey(HKEY_LOCAL_MACHINE, _Offset(sSubKey), 0, KEY_READ, _Offset(hAppKey)) <> ERROR_SUCCESS Then
322.                 RegCloseKey hAppKey
323.                 RegCloseKey hUninstKey
324.                 GetUninstallString64 = ""
325.                 Exit Function
326.             End If
327.             dwBufferSize = Len(sDisplayName)
328.             If RegQueryValue(hAppKey, "DisplayName" + Chr$(0), 0, _Offset(dwType), _Offset(sDisplayName), _Offset(dwBufferSize)) = ERROR_SUCCESS Then
329.                 If _StriCmp(Mid$(sDisplayName, 1, dwBufferSize - 1), software) = 0 Then
330.                     Dim As String uninstall: uninstall = Space$(1024)
331.                     Dim As Long Lenuninstall: Lenuninstall = Len(uninstall)
332.                     If RegQueryValue(hAppKey, "UninstallString" + Chr$(0), 0, _Offset(dwType), _Offset(uninstall), _Offset(Lenuninstall)) = ERROR_SUCCESS Then
333.                         GetUninstallString64 = Mid$(uninstall, 1, Lenuninstall - 1)
334.                     Else
335.                         GetUninstallString64 = ""
336.                     End If
337.                     RegCloseKey hAppKey
338.                     RegCloseKey hUninstKey
339.                     Exit Function
340.                 End If
341.             End If
342.             RegCloseKey hAppKey
343.         End If
344.         dwindex = dwindex + 1
345.     Loop While lResult = ERROR_SUCCESS
346.     RegCloseKey hUninstKey
347.     GetUninstallString64 = ""
348. End Function
349.  
350. Sub EnumInstalledPrograms
351.     Const HKEY_LOCAL_MACHINE = &H80000002~&
352.     Const KEY_ALL_ACCESS = &HF003F&
353.     Const KEY_READ = &H20019&
354.     Const ERROR_SUCCESS = 0
355.  
356.     Dim As _Offset hUninstKey, hAppKey
357.     Dim As String sAppKeyName, sSubKey, sDisplayName
358.     sAppKeyName = Space$(1024): sSubKey = Space$(1024): sDisplayName = Space$(1024)
359.     Dim As String sRoot
360.     sRoot = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall" + Chr$(0)
361.     Dim As Long lResult: lResult = ERROR_SUCCESS
362.     Dim As Long dwType: dwType = KEY_ALL_ACCESS
363.     Dim As Long dwBufferSize
364.  
365.     If RegOpenKey(HKEY_LOCAL_MACHINE, _Offset(sRoot), 0, KEY_READ, _Offset(hUninstKey)) <> ERROR_SUCCESS Then
366.         Exit Sub
367.     End If
368.     Dim As Long dwindex
369.     Do
370.         sAppKeyName = Space$(1024)
371.         dwBufferSize = Len(sAppKeyName)
372.         lResult = RegEnumKey(hUninstKey, dwindex, _Offset(sAppKeyName), _Offset(dwBufferSize), 0, 0, 0, 0)
373.         If lResult = ERROR_SUCCESS Then
374.             sSubKey = Mid$(sRoot, 1, InStr(sRoot, Chr$(0)) - 1) + "\" + Mid$(sAppKeyName, 1, InStr(sAppKeyName, Chr$(0)) - 1) + Chr$(0)
375.             If RegOpenKey(HKEY_LOCAL_MACHINE, _Offset(sSubKey), 0, KEY_READ, _Offset(hAppKey)) <> ERROR_SUCCESS Then
376.                 RegCloseKey hAppKey
377.                 RegCloseKey hUninstKey
378.             End If
379.             dwBufferSize = Len(sDisplayName)
380.             If RegQueryValue(hAppKey, "DisplayName" + Chr$(0), 0, _Offset(dwType), _Offset(sDisplayName), _Offset(dwBufferSize)) = ERROR_SUCCESS Then
381.                 Print Mid$(sDisplayName, 1, dwBufferSize)
382.             End If
383.             RegCloseKey hAppKey
384.         End If
385.         dwindex = dwindex + 1
386.     Loop While lResult = ERROR_SUCCESS
387.     RegCloseKey hUninstKey
388.     EnumInstalledPrograms64
389. End Sub
390.  
391. Sub EnumInstalledPrograms64
392.     Const HKEY_LOCAL_MACHINE = &H80000002~&
393.     Const KEY_ALL_ACCESS = &HF003F&
394.     Const KEY_READ = &H20019&
395.     Const ERROR_SUCCESS = 0
396.  
397.     Dim As _Offset hUninstKey, hAppKey
398.     Dim As String sAppKeyName, sSubKey, sDisplayName
399.     sAppKeyName = Space$(1024): sSubKey = Space$(1024): sDisplayName = Space$(1024)
400.     Dim As String sRoot
401.     sRoot = "SOFTWARE\WOW6432Node\Microsoft\Windows\CurrentVersion\Uninstall" + Chr$(0)
402.     Dim As Long lResult: lResult = ERROR_SUCCESS
403.     Dim As Long dwType: dwType = KEY_ALL_ACCESS
404.     Dim As Long dwBufferSize
405.  
406.     If RegOpenKey(HKEY_LOCAL_MACHINE, _Offset(sRoot), 0, KEY_READ, _Offset(hUninstKey)) <> ERROR_SUCCESS Then
407.         Exit Sub
408.     End If
409.     Dim As Long dwindex
410.     Do
411.         sAppKeyName = Space$(1024)
412.         dwBufferSize = Len(sAppKeyName)
413.         lResult = RegEnumKey(hUninstKey, dwindex, _Offset(sAppKeyName), _Offset(dwBufferSize), 0, 0, 0, 0)
414.         If lResult = ERROR_SUCCESS Then
415.             sSubKey = Mid$(sRoot, 1, InStr(sRoot, Chr$(0)) - 1) + "\" + Mid$(sAppKeyName, 1, InStr(sAppKeyName, Chr$(0)) - 1) + Chr$(0)
416.             If RegOpenKey(HKEY_LOCAL_MACHINE, _Offset(sSubKey), 0, KEY_READ, _Offset(hAppKey)) <> ERROR_SUCCESS Then
417.                 RegCloseKey hAppKey
418.                 RegCloseKey hUninstKey
419.             End If
420.             dwBufferSize = Len(sDisplayName)
421.             If RegQueryValue(hAppKey, "DisplayName" + Chr$(0), 0, _Offset(dwType), _Offset(sDisplayName), _Offset(dwBufferSize)) = ERROR_SUCCESS Then
422.                 Print Mid$(sDisplayName, 1, dwBufferSize)
423.             End If
424.             RegCloseKey hAppKey
425.         End If
426.         dwindex = dwindex + 1
427.     Loop While lResult = ERROR_SUCCESS
428.     RegCloseKey hUninstKey
429. End Sub

 

Text Only | Text with Attachments