Installierte Software auslesen - local oder remote

[eknori]

um es gleich vorweg zu nehmen; LS Anfänger haben hier keine Chance.

Habe heute noch ein wenig rumgebastelt. Es geht darum, die auf einem Rechner installierte Software auszulesen und z.B. an ein HelpDesk zu übermitteln. Alternativ soll es aber auch möglich sein, von einem Rechner mit Adminrechten die Software remote auszulesen.

Grundüberlegung dabei ist, daß die allermeisten installierten Programme ihre Spuren im Registry Key
Software\\Microsoft\\Windows\\CurrentVersion\\Uninstall\\ hinterlassen.

Also brauchen wir ein Stück Code, welches die in diesem Key enthaltenen SubKeys ausliest.
Hat man den Subkey, kann man über den Wert DisplayName im Klartext auslesen, um welches Programm es sich handelt.

Ich habe da mal flott eine Klasse zusammengebaut, welches die Subkeys eines gegebenen Keys ausliest. Das funktioniert sowohl local als auch remote ( Wert in thisServer kann ein DNS Name oder eine IP Adresse sein ).

Dummerweise liefert mir die Funktion. GetValue immer einen Leerstring zurück, obwohl lpData korrekt die Länge des zu erwartenden Strings ausgibt.

Mit dem dem Notes eigenen Befehl zum Auslesen der Registry funktioniert des Auslesen leider nur local.

RegConnectRegistry(thisServer, eHKEY_LOCAL_MACHINE, lhRemoteRegistry)

liefert in lhRemoteRegistry zwar ein Handle auf den remote host zurück, aber das kann ich leider nicht an

@RegQueryValue

übergeben.

HKEY_LOCAL_MACHINE im macro mit lhRemoteRegistry zu ersetzen bringt irgendwie nix.

Möglicherweise hat ja jemand Lust, sich durch den Code durchzuwuseln. ( ich darf ja das LapTop nicht mit in den Urlaub nehmen  )

Hier der Code für den Test Buhtong

Use "lib.appl.registry"

Sub Click(Source As Button)
   'Dim dummy As variant
   
   Dim Registry As New clsRegistry
   Dim ret As String
   Dim thisKey As String
   Dim thisServer As String
   Dim macro As String
   Dim i As Integer
   
   i = 0
   thisKey = "Software\\Microsoft\\Windows\\CurrentVersion\\Uninstall\\"
   thisServer = "192.168.123.122"
   If Registry.KeyExists (eHKEY_LOCAL_MACHINE, thisKey, thisServer) Then
      Do   
         ret =  Registry.ListSubKey(eHKEY_LOCAL_MACHINE, thisKey, i , thisServer)
         If ret ="" Then Exit Do
         
'         lReturnCode = RegConnectRegistry(thisServer, eHKEY_LOCAL_MACHINE, lhRemoteRegistry)
'         macro = |"HKEY_LOCAL_MACHINE";| & |"| & thisKey & ret & |";| & |"DisplayName"|
'         dummy = Evaluate (|@RegQueryValue(| & macro & |)|)
         
         If ret = "" Then
         Else
            Msgbox ret
         End If
         i = i +1
      Loop Until ret = ""
   End If
   
End Sub


und hier der Code der Klasse

'lib.appl.registry:

Option Public
Option Declare
'Use "lib.appl.functions"


Const ERROR_SUCCESS = 0
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_OPTION_NON_VOLATILE = 0
Const REG_SZ = 1
Const SYNCHRONIZE = &H100000
Const STANDARD_RIGHTS_ALL = &H1F0000
Const KEY_CREATE_LINK = &H20
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))

Type FILETIME
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type

Type SECURITY_ATTRIBUTES
   nLength As Long
   lpSecurityDescriptor As Long
   bInheritHandle As Long
End Type

Const  eHKEY_CLASSES_ROOT = &H80000000
Const  eHKEY_CURRENT_USER = &H80000001
Const  eHKEY_LOCAL_MACHINE = &H80000002
Const  eHKEY_USERS = &H80000003
Const  eHKEY_PERFORMANCE_DATA = &H80000004
Const  eHKEY_CURRENT_CONFIG = &H80000005
Const  eHKEY_DYN_DATA = &H80000006

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 RegConnectRegistry Lib "advapi32.dll" _
Alias "RegConnectRegistryA" _
(Byval lpMachineName As String, _
Byval hKey As Long, _
phkResult As Long) As Long

Declare Function RegCloseKey Lib "advapi32.dll" _
(Byval hKey As Long) As Long

Declare Function RegQueryValueEx Lib "advapi32.dll" _
Alias "RegQueryValueExA" (Byval hKey As Long, _
Byval lpValueName As String, Byval lpReserved As Long, _
lpType As Long, lpData As Any, _
lpcbData 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, lpData As String, _
lpcbData As Long) As Long

Declare Function RegEnumKeyEx Lib "advapi32.dll" _
Alias "RegEnumKeyExA" _
(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 FILETIME) 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

Class clsRegistry
   
   Public Sub new()
   'constructor      
   End Sub
   
   Public Function ListSubKey(Byval PredefinedKey As Long, Byval KeyName As String, Byval Index As Long,  ComputerName As String) As String
      
      Dim GetHandle As Long
      Dim hKey As Long
      Dim dwIndex As Long
      Dim lpName As String
      Dim lpcbName As Long
      Dim lpReserved As Long
      Dim lpftLastWriteTime As FILETIME
      Dim i As Integer
      Dim lReturnCode As Long
      Dim lhRemoteRegistry As Long
      If Left$(KeyName, 1) = "\" Then
         KeyName = Right$(KeyName, Len(KeyName) - 1)
      End If
      
      If ComputerName = "" Then
         GetHandle = RegOpenKeyEx(PredefinedKey, KeyName, 0, KEY_ALL_ACCESS, hKey)
      Else
         lReturnCode = RegConnectRegistry(ComputerName, PredefinedKey, lhRemoteRegistry)
         GetHandle = RegOpenKeyEx(lhRemoteRegistry, KeyName, 0, KEY_ALL_ACCESS, hKey)
      End If
      
      If GetHandle = ERROR_SUCCESS Then
         lpcbName = 255
         lpName = String$(lpcbName, Chr(0))
         
         GetHandle = RegEnumKeyEx(hKey, Index, lpName, lpcbName, lpReserved, Null, 0, lpftLastWriteTime)
         
         If GetHandle = 234 Then
            ListSubKey = Left$(lpName, lpcbName)
         Else
            ListSubKey = ""
         End If
         
         RegCloseKey hKey
      End If
      
   End Function
   
   
   Public Function KeyExists(Byval PredefinedKey As Long, Byval KeyName As String,  ComputerName As String) As Boolean
      
      
      Dim hKey As Long
      Dim GetHandle As Long
      Dim lhRemoteRegistry As Long
      Dim lReturnCode As Long
      
      If Left$(KeyName, 1) = "\" Then
         KeyName = Right$(KeyName, Len(KeyName) - 1)
      End If
      
      If ComputerName = "" Then
         GetHandle = RegOpenKeyEx(PredefinedKey, KeyName, 0, KEY_ALL_ACCESS, hKey)
      Else
         lReturnCode = RegConnectRegistry(ComputerName, PredefinedKey, lhRemoteRegistry)
         GetHandle = RegOpenKeyEx(lhRemoteRegistry, KeyName, 0, KEY_ALL_ACCESS, hKey)
      End If
      
      If GetHandle = ERROR_SUCCESS Then
         KeyExists = True
      Else
         KeyExists = False
      End If
      
      
   End Function
   
   Function GetValue(Byval PredefinedKey As Long, Byval KeyName As String, Byval ValueName As String, ComputerName As String) As Variant
      
      
      Dim GetHandle As Long
      Dim hKey As Long
      Dim lpData As String
      Dim lpDataDWORD As Long
      Dim lpcbData As Long
      Dim lpType As Long
      Dim lReturnCode As Long
      Dim lhRemoteRegistry As Long
      
      If Left$(KeyName, 1) = "\" Then
         KeyName = Right$(KeyName, Len(KeyName) - 1)
      End If
      
      If ComputerName = "" Then
         GetHandle = RegOpenKeyEx(PredefinedKey, KeyName, 0, KEY_ALL_ACCESS, hKey)
      Else
         lReturnCode = RegConnectRegistry(ComputerName, PredefinedKey, lhRemoteRegistry)
         GetHandle = RegOpenKeyEx(lhRemoteRegistry, KeyName, 0, KEY_ALL_ACCESS, hKey)
      End If
      
      If GetHandle = ERROR_SUCCESS Then
         lpcbData = 255
         lpData = String(lpcbData, Chr(0))
         
         GetHandle = RegQueryValueEx(hKey, ValueName, 0, lpType, Byval lpData, lpcbData)
         
         If GetHandle = ERROR_SUCCESS Then
            Select Case lpType
            Case REG_SZ
               GetHandle = RegQueryValueExString(hKey, ValueName, 0, lpType, Byval lpData, lpcbData)
               
               If GetHandle = 0 Then
                  GetValue = Left$(lpData, lpcbData - 1)
               Else
                  GetValue = ""
               End If
               
            Case REG_DWORD
               GetHandle = RegQueryValueEx(hKey, ValueName, 0, lpType, lpDataDWORD, lpcbData)
               
               If GetHandle = 0 Then
                  GetValue = Clng(lpDataDWORD)
               Else
                  GetValue = 0
               End If
            Case REG_BINARY
               GetHandle = RegQueryValueEx(hKey, ValueName, 0, lpType, lpDataDWORD, lpcbData)
               
               If GetHandle = 0 Then
                  GetValue = Cbyte(lpDataDWORD)
               Else
                  GetValue = 0
               End If
            End Select
         End If
         
         RegCloseKey hKey
      End If
      
      
   End Function
   
End Class

[ascom40]

Hallo Ulrich,

das hassu aber fein gemacht, wie immer. Danke dir für die Mühe. 

Ich (linksguck-rechtsguck) hab den Notebook im Urlaub dabei, wenn mich niemand erwischt  .

bin in Hamburg, schau mir das dann mal an.

btw: wo ist METTMANN ?!  Du machst ne Party ?! Habe erst gestern erfahren, dass ich mit Thomas D verwandt bin, den scheinst du wohl zu kennen... Ich arbeite weiter an der Ahnentafel.

Danke für die Veröffentlichung.

Jo

[eknori]

Thomas D

Nein, ich kenne nur Andreas F. ( Campino )

und wg. "geekmeting"; die Anreise aus Hamburch nach Mettmann ( ca. 400 km ) dürfte sich wohl für einen Nachmittag/Abend nicht gerade lohnen, oder ?

Diskussionen dazu bitte unter http://www.atnotes.de/index.php?topic=24099.0

[mibo11]

Hallo Ulrich,

ich weiß nicht ob das Problem immer noch akut ist. Ich bin am Wochenende über diesen Thread gestolpert und da ich ähnliches mache und dazu ebenfalls die Registry auslese hänge ich dir hier ein Script an mit dem auch Textwerte ausgelesen werden können. Ich hoffe es hilft dir.

Gruß Sascha

[TMC]

@Sascha: Ulrich ist glaub ich noch im Urlaub...

@Ulrich:
Hmm, Registry gut und schön, aber was ist wenn der User Software laufen hat, die nicht in der Registry eingetragen ist? Apps solcher Art gibt es ja viele. Evtl. sicherer das System-Dir auszulesen. Wobei das natürlich sehr an der Performance leiden kann, um rekursiv in jedes Verzeichnis zu wandern. Das ganze dann aufzubereiten auch nicht so toll. Na gut, könnte man auf *.exe, *.com und *.bat begrenzen. Hmm, evtl. nur eine Liste dieser Dateien, neben den bekannten (Winword.exe, notes.exe etc.) schreibt man dann den Namen der App. Liste über Konfigurationsfile pflegen.
Nur so eine Idee.

Matthias

[eknori]

@Sascha: Danke für den Code. Ähnliche Routinen habe ich schon. Problem dabei ist aber, daß immer nur der lokale Rechner ausgelesen werden kann.

Ich suche aber nach einer Möglichkeit, remote einen Rechner im Netzwerk auszulesen. Und ich habe eine Möglichkeit gefunden ... WMI !
Mit den Methoden der WMI Klassen kann man praktisch alles an einem Rechner auslesen 
Genau das, was ich für die Erweiterung von !!HELP!! brauche.

Ich habe dann heute ein wenig mit den Klassen rumgespielt und folgendes Ergebnis für die Problemstellung gefunden.

Function InstalledSoftware ( strComputer As String ) As Variant
   On Error Goto EXITPOINT
   
   Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
   Dim strKey As String
   Dim intRet As Integer
   Dim arrSubkeys As Variant
   Dim ApplList As New ArraySets
   
   Call ApplList.Init
   
   strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
   
   If strComputer = "" Or Ucase(strComputer) = "LOCALHOST" Then
      strComputer = "."
   End If
   
   Set objReg = GetObject("winmgmts://" & strComputer &    "/root/default:StdRegProv")
   objReg.EnumKey HKLM, strKey, arrSubkeys
   
   Forall S In arrSubkeys
      
      intRet = objReg.GetStringValue(HKLM, strKey & S, "DisplayName", strValue)
      If intRet <> 0 Then
         objReg.GetStringValue HKLM, strKey & S ,"QuietDisplayName", strValue
      End If
      ApplList.AddElement ( strValue)
      
   End Forall
   
   InstalledSoftware = ApplList.Value
   
   Exit Function
EXITPOINT:
   Resume Next
End Function

Die Funktion benötigt noch eine Klasse:

'==========================================================================================
' C L A S S "ArraySets"
'==========================================================================================
Class ArraySets
   Public Value() As String
   Public TotalElements As Integer
   
   Sub Init
      TotalElements = 0
      Redim Value(1 To 1) As String
   End Sub
   
   Sub AddElement(NewValue As String)
      TotalElements = TotalElements + 1
      Redim Preserve Value(1 To TotalElements) As String
      Value(TotalElements) = NewValue
   End Sub
   
   Function Search(SearchFor As String) As Integer
      
      Dim CurrentLabelEntry As Integer
      CurrentLabelEntry = 0
      Forall c In Value
         If Ucase(c) = Ucase(SearchFor) Then
            CurrentLabelEntry = CurrentLabelEntry + 1
         End If
      End Forall
      Search = CurrentLabelEntry
   End Function
End Class

Aufgerufen wird die Funktion wie folgt:

Sub Click(Source As Button)
   
   Dim retval As Variant
   retval = InstalledSoftware ("")
   
End Sub

retVal enthält dann ein Array der installierten SOftware. So wie die Funktion jetzt aufgerufen wird, liest er die lokal installierte Software aus. Man kann der Funktion aber auch einen Rechnernamen oder eine IP übergeben.

Perfektionisten werden das obligatorische OPTION EXPLICIT vermissen. Wenn ich die Option setze und alle Variablen dimme, schmiert mir der Client regelmässig ab.