Das Notes Forum
Domino 9 und frühere Versionen => ND6: Entwicklung => Thema gestartet von: eknori am 11.07.05 - 17:42:03
-
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 ;D )
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
-
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 ;D.
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
-
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
-
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
-
@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
-
@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 :D
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.