senseless-creature
Sep 15, 2021, updated at 17:38:35 (UTC)
view1896
view12
0
Goto Top

VBS soll Registry-Einträge finden und anpassen

GermansolvedQuestionBasicDevelopment
Hi Leute,
ich habe mal wieder ein kleines Anfänger-Problem in VBS. Ich möchte über VBS den folgenden Schlüssel "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Video\"
nach weiteren Unterschlüsseln überprüfen. Diese finde ich auch recht einfach. Allerdings sind in den Unterschlüsseln weitere Unterschlüssel "0000" "0001" "0002" usw. vorhanden und darin möchte ich falls vorhanden allen Einträgen "EnableULPS" (DWORD) den Wert "0" vergeben. Leider komme ich hier nicht wirklich weiter..

Bisher bin ich hier
Const HKEY_LOCAL_MACHINE = &H80000002
strComputer = "."  
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _   
strComputer & "\root\default:StdRegProv")  
strKeyPath = "SYSTEM\CurrentControlSet\Control\Video"  
oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys 
For Each subkey In arrSubKeys
Wscript.Echo "HKEY_LOCAL_MACHINE\" & strKeyPath & "\" & subkey & "\"   
Next


Ich bin für jeden Rat dankbar.
LG
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 1264897212

Url: https://administrator.de/contentid/1264897212

Printed on: April 28, 2024 at 17:04 o'clock

12 Comments
Latest comment
Goto Top
Member: colinardo
Solution colinardo Sep 15, 2021 updated at 18:07:56 (UTC)
Goto Top
Servus,
wenn das nur in der nächsten Unterebene gesucht werden soll füge einfach eine weitere Vierschachtelung hinzu un enumeriere die Values dieser Ebene.
Const HKEY_LOCAL_MACHINE = &H80000002
Const REG_DWORD = 4
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")  
strKeyPath = "SYSTEM\CurrentControlSet\Control\Video"  
oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys 

For Each subkey In arrSubKeys
	oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath & "\" & subkey , arrSubKeys2  
	For Each subkey2 In arrSubKeys2
		oReg.EnumValues HKEY_LOCAL_MACHINE, strKeyPath & "\" & subkey & "\" & subkey2 , values, types  
		If Not IsNull(values) Then
			For i = 0 To UBound(values)
				If LCase(values(i)) = "enableulps" And types(i) = REG_DWORD Then  
					If oReg.SetDWORDValue(HKEY_LOCAL_MACHINE, strKeyPath & "\" & subkey & "\" & subkey2 , "EnableUlps", 0) = 0 Then  
						MsgBox "Changed 'EnableUlps' in '" & strKeyPath & "\" & subkey & "\" & subkey2 & "' to 0"  
					End If
					Exit For
				End If
			Next
		End If
	Next
Next
Soll es noch tiefer gesucht werden lässt sich das mit einer rekursiven Funktion abfackeln.

Grüße Uwe
heart1
Member: Senseless-Creature
Senseless-Creature Sep 15, 2021 at 18:25:45 (UTC)
Goto Top
Wow Dankeschön - bis auf die MSGBox funktioniert das perfekt face-smile
Member: colinardo
colinardo Sep 15, 2021 updated at 18:28:02 (UTC)
Goto Top
Zitat von @Senseless-Creature:

Wow Dankeschön - bis auf die MSGBox funktioniert das perfekt face-smile
Die hatte ich natürlich nur für deine Debug-Zwecke eingefügt face-wink.
heart1
Member: Senseless-Creature
Senseless-Creature Sep 15, 2021 at 18:28:33 (UTC)
Goto Top
Mein Fehler - die MSGBox funktioniert auch face-smile
Member: Senseless-Creature
Senseless-Creature Sep 15, 2021 at 18:36:07 (UTC)
Goto Top
Ich versuche die MSGBox gerade zu entfernen - jetzt bekomme ich ständig Fehler - kannst Du mir vielleicht nochmal unter die Arme greifen?
Member: colinardo
colinardo Sep 15, 2021 updated at 18:41:39 (UTC)
Goto Top
Zitat von @Senseless-Creature:

Ich versuche die MSGBox gerade zu entfernen - jetzt bekomme ich ständig Fehler - kannst Du mir vielleicht nochmal unter die Arme greifen?

Mein lieber Herr Gesangsverein ... da braucht wohl jemand einen starken Kaffee oder eine gehörige tracht mit CAT9 ;-/.

Const HKEY_LOCAL_MACHINE = &H80000002
Const REG_DWORD = 4
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")  
strKeyPath = "SYSTEM\CurrentControlSet\Control\Video"  
oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys 

For Each subkey In arrSubKeys
	oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath & "\" & subkey , arrSubKeys2  
	For Each subkey2 In arrSubKeys2
		oReg.EnumValues HKEY_LOCAL_MACHINE, strKeyPath & "\" & subkey & "\" & subkey2 , values, types  
		If Not IsNull(values) Then
			For i = 0 To UBound(values)
				If LCase(values(i)) = "enableulps" And types(i) = REG_DWORD Then  
					oReg.SetDWORDValue HKEY_LOCAL_MACHINE, strKeyPath & "\" & subkey & "\" & subkey2 , "EnableUlps", 0  
					Exit For
				End If
			Next
		End If
	Next
Next
heart1
Member: Senseless-Creature
Senseless-Creature Sep 15, 2021 at 18:48:44 (UTC)
Goto Top
Hab´s gerade selbst hinbekommen, aber trotzdem vielen Dank face-smile
Kann man das mit der Enumerierung von Values unbegrenzt machen? Das ist ja total genial face-smile
LG
Member: colinardo
colinardo Sep 15, 2021 updated at 19:30:48 (UTC)
Goto Top
Zitat von @Senseless-Creature:
Kann man das mit der Enumerierung von Values unbegrenzt machen?
Klar, einfach eine rekursive Funktion draus machen.
https://stackoverflow.com/questions/10259170/vbscript-recursion-programm ...

z.B. so
Const HKEY_LOCAL_MACHINE = &H80000002
const REG_SZ = 1
const REG_EXPAND_SZ = 2
const REG_BINARY = 3
const REG_DWORD = 4
const REG_MULTI_SZ = 7
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")  
strKeyPath = "SYSTEM\CurrentControlSet\Control\Video"  

pathes = FindRegValue(HKEY_LOCAL_MACHINE,strKeyPath,"EnableUlps",REG_DWORD)  
If UBound(pathes) > 0 Then
	For Each path In pathes
		MsgBox "Changing value EnableUlps in '" & path & "'"  
		oReg.SetDWORDValue HKEY_LOCAL_MACHINE, path , "EnableUlps", 0  
	Next
Else
	MsgBox "No matching values found.", vbExclamation  
End If
Function FindRegValue(hive,path,value,valuetype)
	Dim arr
	arr = Array()
	oReg.EnumValues hive, path, values, types
	If Not IsNull(values) Then
		For i = 0 To UBound(values)
			If LCase(values(i)) = LCase(value) And types(i) = valuetype Then
				ReDim Preserve arr(UBound(arr)+1)
				arr(UBound(arr)) = path
				Exit For
			End If
		Next
	End If
	
	oReg.EnumKey hive, path , arrSubKeys
	If Not IsNull(arrSubKeys) Then
		For Each subkey In arrSubKeys
			result = FindRegValue(hive,path & "\" & subkey, value, valuetype)  
			If UBound(result) >= 0 Then
				For Each itm In result
					ReDim Preserve arr(UBound(arr)+1)
					arr(UBound(arr)) = itm
				Next
			End If
		Next
	End If
	FindRegValue = arr
End Function

Das ist ja total genial face-smile
Nö, einfachster Standard.

An deiner Stelle würde ich gleich auf die Powershell wechseln... weniger Tipparbeit für son' einfachen Stuss, da reicht ein Einzeiler:
ls HKLM:\SYSTEM\CurrentControlSet\Control\Video -Recurse | Get-ItemProperty -name EnableUlps -EA 0 | %{Set-ItemProperty $_.PSPath -Name EnableUlps -Value 0}
heart1
Member: Senseless-Creature
Senseless-Creature Sep 15, 2021 at 18:54:09 (UTC)
Goto Top
Wieder was gelernt - Vielen Dank für deine Hilfe face-smile
LG
Member: Senseless-Creature
Senseless-Creature Sep 16, 2021 at 08:47:34 (UTC)
Goto Top
Das Script funtioniert echt perfekt - wie könnte ich den DWORD denn anlegen, ohne diesen vorher abzufragen?
Unter HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Class\{4d36e968-e325-11ce-bfc1-08002be10318}\ gibt es auch wieder Unterschlüssel "0000" "0001" "0002" usw und dort möchte ich den DWORD "EnableULPS" auch anlegen, selbst wenn dieser einen anderen Wert hat oder nicht existiert, was aber mit

If LCase(values(i)) = "enableulps" And types(i) = REG_DWORD Then  
oReg.SetDWORDValue HKEY_LOCAL_MACHINE, strKeyPath & "\" & subkey & "\" & subkey2 , "EnableUlps", 0

So leider nicht funtioniert.

Kannst Du mir hier freundlicher Weise nochmal kurz unter die Arme greifen?
LG
Member: colinardo
colinardo Sep 16, 2021 updated at 09:04:24 (UTC)
Goto Top
Zitat von @Senseless-Creature:

Das Script funtioniert echt perfekt - wie könnte ich den DWORD denn anlegen, ohne diesen vorher abzufragen?
Unter HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Class\{4d36e968-e325-11ce-bfc1-08002be10318}\ gibt es auch wieder Unterschlüssel "0000" "0001" "0002" usw und dort möchte ich den DWORD "EnableULPS" auch anlegen, selbst wenn dieser einen anderen Wert hat oder nicht existiert, was aber mit

If LCase(values(i)) = "enableulps" And types(i) = REG_DWORD Then  
> oReg.SetDWORDValue HKEY_LOCAL_MACHINE, strKeyPath & "\" & subkey & "\" & subkey2 , "EnableUlps", 0

So leider nicht funtioniert.
Den überflüssigen Schmuh halt einfach weg lassen und den Subkey nur auf Mustervergleich prüfen.
Const HKEY_LOCAL_MACHINE = &H80000002
Const REG_DWORD = 4
Set regex = CreateObject("vbscript.regexp")  
regex.IgnoreCase = True
regex.Pattern = "^\d+$"  
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")  
strKeyPath = "SYSTEM\CurrentControlSet\Control\Video"  
oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys 

For Each subkey In arrSubKeys
	oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath & "\" & subkey , arrSubKeys2  
	For Each subkey2 In arrSubKeys2
		If regex.Test(subkey2) Then
			oReg.SetDWORDValue HKEY_LOCAL_MACHINE, strKeyPath & "\" & subkey & "\" & subkey2 , "EnableUlps", 0  
		End If
	Next
Next
Ob das Vorhaben so sinnvoll ist, dazu sag ich hier mal jetzt nichts weiter das liegt in der Eigenverantwortung bei Registry-Manipulationen ...
heart1
Member: Senseless-Creature
Senseless-Creature Sep 16, 2021 at 10:07:53 (UTC)
Goto Top
Perfekt Dankeschön für deine Hilfe face-smile
LG
GermansolvedQuestionBasicDevelopment
Hotly discussed
DaniEnd of availability for classic Teams clientDani - 1 CommentadmtechDeveloper diary: Release 6.1admtech