Lister les logiciels installes
Description
Ce code permet de lister les logiciels qui sont installes sur votre ordinateur (enfin ceux qui sont inscrits dans "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall" dans la base de registre). Je l'ai trouve dans le site planet-source-code.com il est tres utile quand on veut comprendre comment utiliser la base de registre.Et vous pouvez l'adapter comme vous voulez; ici il donne le nom des soft et leur version.(Ca marche pour VB6)
Si ca peut aider quelqu'un.
Voila :)
Si ca peut aider quelqu'un.
Voila :)
Source / Exemple :
'a mettre dans la form
Dim Count As Integer
Dim returnName As Collection
Dim returnSubs As Collection
Dim DisplayName As String
Dim UninstallString As String
Dim Version As String
Public Function Programs()
Form1.lsprograms.Clear
Call EnumRegKeys(returnName, returnSubs, "HKEY_LOCAL_MACHINE", "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall")
If returnName.Count > 0 Then
For Count = 1 To returnName.Count
DisplayName = GetSetting("", returnName(Count), "DisplayName", "", HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall")
UninstallString = GetSetting("", returnName(Count), "UninstallString", "", HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall")
Version = GetSetting("", returnName(Count), "Version", "", HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall")
If DisplayName <> "" And (UninstallString <> "" Or Version <> "") Then
Call Invent.lsprograms.AddItem(DisplayName)
End If
Next Count
End If
End Function
'a mettre dans un module
Option Explicit
Public Const REG_NONE = 0 ' No value type
Public Const REG_SZ = 1 ' Unicode nul terminated string
Public Const REG_EXPAND_SZ = 2 ' Unicode nul terminated string
Public Const REG_BINARY = 3 ' Free form binary
Public Const REG_DWORD = 4 ' 32-bit number
Public Const REG_DWORD_LITTLE_ENDIAN = 4 ' 32-bit number (same as REG_DWORD)
Public Const REG_DWORD_BIG_ENDIAN = 5 ' 32-bit number
Public Const REG_LINK = 6 ' Symbolic Link (unicode)
Public Const REG_MULTI_SZ = 7 ' Multiple Unicode strings
Public Const REG_RESOURCE_LIST = 8 ' Resource list in the resource map
Public Const REG_FULL_RESOURCE_DESCRIPTOR = 9 ' Resource list in the hardware description
Public Const REG_RESOURCE_REQUIREMENTS_LIST = 10
Public Enum nKeyTypes
nKeyTypes_STRING = 1
nKeyTypes_DWORD = 4
End Enum
Public Enum hKeyNames
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_USER = &H80000001
HKEY_LOCAL_MACHINE = &H80000002
HKEY_USERS = &H80000003
HKEY_CURRENT_CONFIG = &H80000005
End Enum
Public Const ERROR_SUCCESS = 0&
Public Const ERROR_NONE = 0
Public Const ERROR_BADDB = 1
Public Const ERROR_BADKEY = 2
Public Const ERROR_CANTOPEN = 3
Public Const ERROR_CANTREAD = 4
Public Const ERROR_CANTWRITE = 5
Public Const ERROR_OUTOFMEMORY = 6
Public Const ERROR_ARENA_TRASHED = 7
Public Const ERROR_ACCESS_DENIED = 8
Public Const ERROR_INVALID_PARAMETERS = 87
Public Const ERROR_NO_MORE_ITEMS = 259
Private Const SYNCHRONIZE = &H100000
Private Const STANDARD_RIGHTS_READ = &H20000
Private Const STANDARD_RIGHTS_WRITE = &H20000
Private Const STANDARD_RIGHTS_EXECUTE = &H20000
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Public Const KEY_ALL_ACCESS = &H3F
Public Const REG_OPTION_NON_VOLATILE = 0
'Registry Functions
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) 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
Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
'Registry Functions
Public Sub EnumRegKeys(ByRef returnName As Collection, Optional ByRef returnSubs As Collection, Optional hKeyName As String = "HKEY_LOCAL_MACHINE", Optional keyname As String = "SOFTWARE", Optional ByVal checkForSubs As Boolean = False)
Dim lRetVal As Long 'result of the API functions
Dim lngResult2 As Long 'result of the API functions
Dim hKey2 As Long
Dim hKey As Long 'handle of opened key
Dim vValue As Variant 'setting of queried value
Dim lngKeyHandle As Long
Dim lngResult As Long
Dim lngCurIdx As Long
Dim strValue As String
Dim lngValueLen As Long
Dim lngData As Long
Dim lngDataLen As Long
Dim strResult As String
Dim lKeyName As Long
Dim SubLevel As Boolean
Set returnName = New Collection
Set returnSubs = New Collection
keyname = CompileKeyString(keyname)
lKeyName = HKEY_LOCAL_MACHINE
Do
lRetVal = RegOpenKeyEx(lKeyName, keyname, 0, KEY_READ, hKey)
lngValueLen = 2000
strValue = String(lngValueLen, 0)
lngDataLen = 2000
lngResult = RegEnumKey(hKey, lngCurIdx, ByVal strValue, lngValueLen)
lngCurIdx = lngCurIdx + 1
RegCloseKey (hKey)
If lngResult = ERROR_SUCCESS Then
strResult = Left(strValue, lngValueLen)
If InStr(1, strResult, Chr(0) & Chr(0) & Chr(0) & Chr(0), vbTextCompare) <> 0 Then
strResult = Mid(strResult, 1, InStr(1, strResult, Chr(0) & Chr(0) & Chr(0) & Chr(0), vbTextCompare) - 1)
Else
strResult = strResult
End If
If checkForSubs = True Then
If keyname = "" Then
lngResult2 = RegOpenKeyEx(lKeyName, strResult, 0, KEY_READ, hKey2)
Else
lngResult2 = RegOpenKeyEx(lKeyName, keyname & "\" & strResult, 0, KEY_READ, hKey2)
End If
strValue = String(lngValueLen, 0)
lngResult2 = RegEnumKey(hKey2, 0, ByVal strValue, lngValueLen)
RegCloseKey (hKey2)
If lngResult2 = ERROR_SUCCESS Then
SubLevel = True
Else
SubLevel = False
End If
returnSubs.Add SubLevel
End If
returnName.Add strResult
End If
Loop While lngResult = ERROR_SUCCESS
End Sub
Public Function GetSetting(appname As String, Section As String, Key As String, Optional default As String, Optional hKeyName As hKeyNames = HKEY_LOCAL_MACHINE, Optional AppNameHeader As String = "SOFTWARE", Optional openReadWrite As Boolean = False)
Dim lRetVal As Long 'result of the API functions
Dim hKey As Long 'handle of opened key
Dim vValue As Variant 'setting of queried value
Dim keyString As String
On Error GoTo e_Trap
keyString = CompileKeyString(AppNameHeader, appname, Section)
If openReadWrite = True Then
lRetVal = RegOpenKeyEx(hKeyName, keyString, 0, KEY_ALL_ACCESS, hKey)
Else
lRetVal = RegOpenKeyEx(hKeyName, keyString, 0, KEY_READ, hKey)
End If
lRetVal = QueryValueEx(hKey, Key, vValue)
If IsEmpty(vValue) Or Trim(vValue) = "" Then
vValue = default
End If
GetSetting = vValue
RegCloseKey (hKey)
Exit Function
e_Trap:
vValue = default
Exit Function
End Function
' Private Functions
Private Function CompileKeyString(Optional AppNameHeader As String, Optional appname As String, Optional Section As String) As String
If AppNameHeader <> "" Then
CompileKeyString = AppNameHeader
End If
If appname <> "" Then
If CompileKeyString <> "" Then
CompileKeyString = CompileKeyString & "\"
End If
CompileKeyString = CompileKeyString & appname
End If
If Section <> "" Then
If CompileKeyString <> "" Then
CompileKeyString = CompileKeyString & "\"
End If
CompileKeyString = CompileKeyString & Section
End If
Do While InStr(1, CompileKeyString, "\\", vbTextCompare) <> 0
If InStr(1, CompileKeyString, "\\", vbTextCompare) <> 0 Then
CompileKeyString = Mid(CompileKeyString, 1, InStr(1, CompileKeyString, "\\", vbTextCompare) - 1) & Mid(CompileKeyString, InStr(1, CompileKeyString, "\\", vbTextCompare) + 1)
End If
Loop
Do While InStr(1, CompileKeyString, "/", vbTextCompare) <> 0
If InStr(1, CompileKeyString, "/", vbTextCompare) <> 0 Then
CompileKeyString = Mid(CompileKeyString, 1, InStr(1, CompileKeyString, "/", vbTextCompare) - 1) & "\" & Mid(CompileKeyString, InStr(1, CompileKeyString, "/", vbTextCompare) + 1)
End If
Loop
End Function
Private Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant, Optional dataType As Long) As Long
Dim cch As Long
Dim lrc As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String
Dim Count As Integer
Dim Holder As String
Dim NewVal As String
On Error GoTo QueryValueExError
vValue = ""
' Determine the size and type of data to be read
lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
If lrc <> ERROR_NONE Then Error 5
dataType = lType
Select Case lType
' For strings
Case REG_SZ, REG_EXPAND_SZ:
sValue = String(cch, 0)
lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
If lrc = ERROR_NONE Then
vValue = Left$(sValue, cch - 1)
Else
vValue = Empty
End If
' For DWORDS
Case REG_DWORD, REG_DWORD_BIG_ENDIAN:
lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
If lrc = ERROR_NONE Then vValue = lValue
Case REG_BINARY
sValue = String(cch, 0)
lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
If lrc = ERROR_NONE Then
Holder = Left$(sValue, cch - 1)
vValue = ""
For Count = 1 To Len(Holder)
NewVal = Format(Hex(Asc(Mid(Holder, Count, 1))), "00")
If Len(NewVal) = 1 Then
NewVal = "0" & NewVal
End If
vValue = vValue & NewVal & " "
Next Count
vValue = Trim(vValue)
Else
vValue = Empty
End If
Case Else
'all other data types not supported
lrc = -1
End Select
QueryValueExExit:
QueryValueEx = lrc
Exit Function
QueryValueExError:
Resume QueryValueExExit
End Function
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.