'*** v8.3 *** www.dieseyer.de ******************************* 

' 

' Datei:  kontext-erweiterungenanzeigen.vbs 

' Autor:  dieseyer@gmx.de 

' Auf:    www.dieseyer.de 

' 

' listet die RegKeys, die für die zusätzlichen Optionen  

' des Kontextmenüs für Ordner (Klick mit der rechten  

' Maus-Taste auf einen Ordner) zuständig sind. 

' 

'************************************************************ 

 

Option Explicit ' Siehe http://dieseyer.de/dse-wsh-lernen.html#OptionExpl 

 

MsgBox Kontext( "." ), , WScript.ScriptName 

 

LogEintrag Kontext( "." ) 

 

WScript.Quit 

 

 

 

'*** v8.3 *** www.dieseyer.de ******************************* 

Function Kontext( PC ) 

'************************************************************ 

 

  Const HKEY_LOCAL_MACHINE	= &H80000002 

  Const HKLM			= &H80000002 

 

  Dim arrSubKeys, subkey, strValue, Tst 

  Dim oReg			: Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & PC & "\root\default:StdRegProv") 

 

	Kontext = Kontext & "WindowsExplorer-Kontextmenü-Erweiterungen für Dateien:" & vbCRLF 

  oReg.EnumKey HKLM, "SOFTWARE\Classes\*\shell", arrSubKeys 

  For Each subkey In arrSubKeys 

	Kontext = Kontext & "   " & subkey & vbTab 

	oReg.GetStringValue HKLM, "SOFTWARE\Classes\*\shell\" & subkey, ,strValue 

	Tst = strValue : If InStr( Tst, "&" ) > 0 Then Tst = Replace( Tst, "&", "" ) 

	Kontext = Kontext & Tst & vbCRLF 

  Next 

 

	Kontext = Kontext & vbCRLF 

	Kontext = Kontext & "WindowsExplorer-Kontextmenü-Erweiterungen für Verzeichnisse:" & vbCRLF 

  oReg.EnumKey HKLM, "SOFTWARE\Classes\Folder\shell", arrSubKeys 

  For Each subkey In arrSubKeys 

	Kontext = Kontext & "   " & subkey & vbTab 

	oReg.GetStringValue HKLM, "SOFTWARE\Classes\*\shell\" & subkey, ,strValue 

	Tst = strValue : If InStr( Tst, "&" ) > 0 Then Tst = Replace( Tst, "&", "" ) 

	Kontext = Kontext & Tst & vbCRLF 

  Next 

 

End Function ' Kontext() 

 

 

'*** v8.3 *** www.dieseyer.de ******************************* 

Sub LogEintrag( LogTxt ) 

'************************************************************ 

  Dim fso         : Set fso       = WScript.CreateObject("Scripting.FileSystemObject") 

  Dim FileOut 

  Dim LogDateiX 

 

  On Error Resume Next 

	LogDateiX = LogDatei	' wurde die Variable LogDatei nicht außerhalb der Prozedur definiert 

	If Err.Number <> 0 Then LogDateiX = WScript.ScriptFullName & ".log" 

  On Error Goto 0 

 

  If LogTxt = "" Then   ' eine neue .LOG-Datei wird erstellt, eine vorhandene überschrieben 

	Set FileOut = fso.OpenTextFile( LogDateiX, 2, true) 

        FileOut.Close 

	Set FileOut = Nothing 

	Set fso     = Nothing 

	Exit Sub 

  End If 

 

  Set FileOut = fso.OpenTextFile( LogDateiX, 8, true) 

  If     LogTxt = vbCRLF Then FileOut.WriteLine (                 LogTxt ) 

' If not LogTxt = vbCRLF Then FileOut.WriteLine ( Now() & vbTab & LogTxt ) 

' If not LogTxt = vbCRLF Then FileOut.WriteLine ( Timer() & "   " & LogTxt ) 

  If not LogTxt = vbCRLF Then FileOut.WriteLine ( Now() & "   " & LogTxt ) 

  FileOut.Close 

  Set FileOut = Nothing 

  Set fso     = Nothing 

 

End Sub ' LogEintrag( LogTxt )