Code;
Private Declare Function RegQueryValueExA Lib "advapi32" (ByVal HKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegOpenKeyExA Lib "advapi32" (ByVal HKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal HKey As Long) As Long
Private Declare Function RegEnumKeyExA Lib "advapi32" (ByVal HKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As Any) As Long
Public Function GetInstalledApps() As String
Dim hParentKey As Long
Dim HSubKey As Long
Dim lIndex As Long
Dim sAppID As String
Dim lAppID As Long
Dim sAppName As String
Dim sAppVer As String
Dim sAppPub As String
Dim sAppUns As String
Dim lAppName As Long
Dim lAppVer As Long
Dim lAppPub As Long
Dim lAppUns As Long
Dim ValueType As Long
UbRetArray = -1
If RegOpenKeyExA(&H80000002, "Software\Microsoft\Windows\CurrentVersion\Uninstall", 0, &H8, hParentKey) = 0 Then
sAppID = Space(64)
lAppID = 64
Do While RegEnumKeyExA(hParentKey, lIndex, sAppID, lAppID, 0, vbNullString, 0, vbNull) = 0
sAppID = Left(sAppID, lAppID)
If RegOpenKeyExA(hParentKey, sAppID, 0, &H1, HSubKey) = 0 Then
lAppName = 0
If RegQueryValueExA(HSubKey, "DisplayName", 0, ValueType, ByVal 0, lAppName) = 0 Then
If ValueType = 1 Then
RegQueryValueExA HSubKey, "DisplayVersion", 0, 0, ByVal 0, lAppVer
RegQueryValueExA HSubKey, "Publisher", 0, 0, ByVal 0, lAppPub
RegQueryValueExA HSubKey, "UninstallString", 0, 0, ByVal 0, lAppUns
sAppName = Space(lAppName)
sAppVer = Space(lAppVer)
sAppPub = Space(lAppPub)
sAppUns = Space(lAppUns)
RegQueryValueExA HSubKey, "DisplayName", 0, 0, ByVal sAppName, lAppName
RegQueryValueExA HSubKey, "DisplayVersion", 0, 0, ByVal sAppVer, lAppVer
RegQueryValueExA HSubKey, "Publisher", 0, 0, ByVal sAppPub, lAppPub
RegQueryValueExA HSubKey, "UninstallString", 0, 0, ByVal sAppUns, lAppUns
GetInstalledApps = GetInstalledApps & _
LPSTRToVBString(sAppName) & Chr(0) & _
LPSTRToVBString(sAppVer) & Chr(0) & _
LPSTRToVBString(sAppPub) & Chr(0) & _
LPSTRToVBString(sAppUns) & Chr(255)
End If
End If
RegCloseKey HSubKey
HSubKey = 0
End If
lIndex = lIndex + 1
sAppID = Space(64)
lAppID = 64
Loop
RegCloseKey hParentKey
End If
End Function
Public Function LPSTRToVBString(ByVal sText As String)
Dim nullpos&
nullpos& = InStr(sText, Chr$(0))
If nullpos > 0 Then
LPSTRToVBString = Left$(sText, nullpos - 1)
Else
LPSTRToVBString = ""
End If
End Function
Apply:
Sub getEnumProg(ProgList As String)
On Error Resume Next
Dim sMParam() As String
Dim sDParam() As String
sMParam = Split(ProgList, Chr(255))
For i = 0 To UBound(sMParam)
sDParam = Split(sMParam(i), Chr(0))
Set oItem = ListView1.ListItems.Add(, , sDParam(0), , 1)
oItem.SubItems(1) = sDParam(1)
oItem.SubItems(2) = sDParam(2)
oItem.SubItems(3) = sDParam(3)
Next
End Sub
0 comments:
Post a Comment