We help IT Professionals succeed at work.

Return error : 0x80041002 (automated error)

I get an error while executing a vbs script that retreived registry info.
Error Result: (null): 0x80041002
Const HKEY_LOCAL_MACHINE = &H80000002
strComputer = "."
 
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")

Open in new window

Comment
Watch Question

Meir RivkinFull stack Software Engineer

Commented:
the code u've posted has no error, can u post the rest of the code or just the line which throws the error?
Meir RivkinFull stack Software Engineer

Commented:
for instance, the following script uninstalls applications (listed in variable called "programs" in line 16) by searching the UninstallString entry in the registry (under SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall):
Const ForWriting = 2
const HKEY_LOCAL_MACHINE = &H80000002


Set WshShell = WScript.CreateObject("Wscript.Shell") 
Set WshNetwork = WScript.CreateObject("WScript.Network")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile ("c:\report.txt", ForWriting, True)

const X64_UNINSTALL_REGISTRY = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
const X32_UNINSTALL_REGISTRY = "SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall"

machines = "."

'*************** List of programs to remove seperated by coma ********************
programs = "Safari,Windows Live Essentials,MultiRes (remove only)"
'*********************************************************************************
For Each strComputer in Split(machines, ",")
	if strComputer = "." then
		Wscript.Echo "localhost"
	else
		Wscript.Echo strComputer
	End if
	
	Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

	objTextFile.WriteLine(WshNetwork.ComputerName)
	For Each program in Split(programs, ",")
		On error resume next
		Set colSoftware = objWMIService.ExecQuery ("Select * from Win32_Product Where Name = '" & Trim(program) & "'")
		if colSoftware.Count > 0 then
			For Each objSoftware in colSoftware
				objTextFile.WriteLine objSoftware.Name
				objTextFile.WriteLine objSoftware.InstallDate
				objTextFile.WriteLine objSoftware.InstallLocation
				objSoftware.Uninstall()
			Next
		end if
		
		Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv") 

		TryUninstall oReg, X64_UNINSTALL_REGISTRY
		TryUninstall oReg, X32_UNINSTALL_REGISTRY
	Next 
Next 

Sub TryUninstall (oReg, RegistryUninstallKey)

	Wscript.Echo RegistryUninstallKey
	oReg.EnumKey HKEY_LOCAL_MACHINE, RegistryUninstallKey, arrSubKeys

	For Each subkey In arrSubKeys
		
		oReg.GetStringValue HKEY_LOCAL_MACHINE, subkey, "DisplayName", displayName
		
		if displayName = program then
			oReg.GetStringValue HKEY_LOCAL_MACHINE, subkey, "UninstallString", strUninstall
			
			if (strUninstall <> "") then
				if LCase(Left(strUninstall,6))="msiexec" then
					uninstallCmd = Replace(strUninstall, "/I{", "/X{") & " /q REMOVE=ALL" ' MSI installer
				else
					uninstallCmd = strUninstall & " /S /NCRC" 'assume NSIS installer
				end if
					
				Wscript.Echo uninstallCmd
				
				WshShell.Run(uninstallCmd)
			end if
			
			objTextFile.WriteLine(Trim(program) & " uninstalled.")
		end if
	Next
End Sub

Open in new window

Author

Commented:
This is the script which runs during install of PHP with fastCGI. It's stucks on IIS4Config which read the registry.

I
Const ForReading = 1
Const ForWriting = 2

Sub configApache

    Dim objFSO
    Dim objFile

    Args = Split( Session.Property("CustomActionData"), "," )
    strApacheDir = Args(0)
    strInstallDir = Args(1)
    
    If ( right(strApacheDir,1) <> "\" ) then 
        strApacheDir = strApacheDir & "\"
    End If
    strWebServerType = GetRegistryValue("Software\PHP","WebServerType")
    strPHPPath = Replace(strInstallDir,"\","/")
    
    strDirective = vbCrLf & vbCrLf & "#BEGIN PHP INSTALLER EDITS - REMOVE ONLY ON UNINSTALL" & vbCrLf
    If ( strWebServerType = "apacheCGI" ) Then
        strDirective = strDirective & "ScriptAlias /php/ """ & strPHPPath & """" & vbCrLf
        strDirective = strDirective & "Action application/x-httpd-php """ & strPHPPath & "php-cgi.exe""" & vbCrLf
    End If
    
    If ( strWebServerType = "apache22" ) Then
        strDirective = strDirective & "PHPIniDir """ & strPHPPath & """" & vbCrLf
        strDirective = strDirective & "LoadModule php5_module """ & strPHPPath & "php5apache2_2.dll""" & vbCrLf
    End If
    
    If ( strWebServerType = "apache20" ) Then
        strDirective = strDirective & "PHPIniDir """ & strPHPPath & """" & vbCrLf
        strDirective = strDirective & "LoadModule php5_module """ & strPHPPath & "php5apache2.dll""" & vbCrLf
    End If
    
    If ( strWebServerType = "apache13" ) Then
        strDirective = strDirective & "PHPIniDir """ & strPHPPath & """" & vbCrLf
        strDirective = strDirective & "LoadModule php5_module """ & strPHPPath & "php5apache.dll""" & vbCrLf
    End If
    
    strDirective = strDirective &  "#END PHP INSTALLER EDITS - REMOVE ONLY ON UNINSTALL" & vbCrLf
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    strFileName = strApacheDir & "httpd.conf"
    If objFSO.FileExists(strFileName) Then
        Set objFile = objFSO.OpenTextFile( strFileName, ForReading)
    Else
        strFileName = strApacheDir & "conf\httpd.conf"
        If objFSO.FileExists(strFileName) Then
            Set objFile = objFSO.OpenTextFile( strFileName, ForReading)
        Else
            FatalError ("Error trying access httpd.conf file.")
            Exit Sub
        End If    
    End If        
    strText = objFile.ReadAll
    objFile.Close
    
    ' try and comment out old directives if they exist
    strText = Replace(strText,"ScriptAlias /php/","#ScriptAlias /php/")
    strText = Replace(strText,"Action application/x-httpd-php","#Action application/x-httpd-php")
    strText = Replace(strText,"PHPIniDir","#PHPIniDir")
    strText = Replace(strText,"LoadModule php5_module","#LoadModule php5_module")
    strText  = strText & strDirective
    
    ' backup old file
    strBackupFileName = strFileName & ".bak"
    objFSO.CopyFile strFileName, strBackupFileName 
    
    Set objFile = objFSO.OpenTextFile( strFileName, ForWriting)
    objFile.WriteLine strText
    objFile.Close
    
    strFileName = strApacheDir & "mime.types"
    If objFSO.FileExists(strFileName) Then
        Set objFile = objFSO.OpenTextFile( strFileName, ForReading)
    Else
        strFileName = strApacheDir & "conf\mime.types"
        If objFSO.FileExists(strFileName) Then
            Set objFile = objFSO.OpenTextFile( strFileName, ForReading)
        Else
            FatalError ("Error trying access mime.types file.")
            Exit Sub
        End If    
    End If
    
    strText = objFile.ReadAll
    objFile.Close
    
    If ( InStr(strText,"application/x-httpd-php") = 0 ) Then
        strText = strText & "application/x-httpd-php" & vbTab & "php" & vbCrLf
    End If
    
    If ( InStr(strText,"application/x-httpd-php-source") = 0 ) Then
        strText = strText & "application/x-httpd-php-source" & vbTab & "phps" & vbCrLf
    End If
    
    ' backup old file
    strBackupFileName = strFileName & ".bak"
    objFSO.CopyFile strFileName, strBackupFileName
    
    Set objFile = objFSO.OpenTextFile( strFileName, ForWriting)
    objFile.WriteLine strText
    objFile.Close
    
End Sub

Sub unconfigApache

    Dim objFSO
    Dim objFile

    strApacheDir = GetRegistryValue("Software\PHP","ApacheDir")
    If ( right(strApacheDir,1) <> "\" ) then 
        strApacheDir = strApacheDir & "\"
    End If

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    strFileName = strApacheDir & "httpd.conf"
    If objFSO.FileExists(strFileName) Then
        Set objFile = objFSO.OpenTextFile( strFileName, ForReading)
    Else
        strFileName = strApacheDir & "conf\httpd.conf"
        If objFSO.FileExists(strFileName) Then
            Set objFile = objFSO.OpenTextFile( strFileName, ForReading)
        Else
            FatalError ("Error trying access httpd.conf file.")
            Exit Sub
        End If    
    End If
    
    do while objFile.AtEndOfStream = false
        strText = objFile.ReadLine
        
        If ( strText = "#BEGIN PHP INSTALLER EDITS - REMOVE ONLY ON UNINSTALL" ) Then
            strEndText = objFile.ReadLine
            do while strEndText <> "#END PHP INSTALLER EDITS - REMOVE ONLY ON UNINSTALL"
                strEndText = objFile.ReadLine
            loop    
        Else
            strNewText = strNewText & vbCrLf & strText
        End If
    loop
    
    objFile.Close
    
    Set objFile = objFSO.OpenTextFile(strFileName, ForWriting)
    objFile.WriteLine strNewText
    objFile.Close

End Sub

Sub configIIS4

    Dim WebService
    Dim WebService1
    Dim Paths
    Dim Nodes()
    Dim NumExtensions
    Dim PHPExecutable
    Dim NodeCount
    Dim FullPath
    Dim Args, Arg, ArgCount
    Dim I
    Dim J
    Dim K
    Dim MapNode, ScriptMaps, OutMaps(), Map, MapBits
    Dim fAddScriptMap
    Dim DefaultDocuments

    fAddScriptMap = TRUE
    strWebServerType = GetRegistryValue("Software\PHP","WebServerType")
    strPHPPath = Session.Property("CustomActionData")
    If ( right(strPHPPath,1) <> "\" ) then 
        strPHPPath = strPHPPath & "\"
    End If
    If ( strWebServerType = "iis4CGI" ) Then
        PHPExecutable = strPHPPath & "php-cgi.exe"
    End If
    If ( strWebServerType = "iis4ISAPI" ) Then
        PHPExecutable = strPHPPath & "php5isapi.dll"
    End If
    If ( strWebServerType = "iis4FastCGI" ) Then
        fAddScriptMap = FALSE
    End If
    
    'it could all go dreadfully wrong - so set error handler for graceful exits
    On Error Resume Next
 
    Set WebService = GetObject("IIS://LocalHost/W3SVC")
    If (Err.Number <> 0) Then
        FatalError ("Error trying access the local web service: GetObject Failed.")
        Exit Sub
    End If

    ' Add index.php to default documents list at server level
    DefaultDocuments = WebService.DefaultDoc
    If ( InStr(DefaultDocuments,"index.php") = 0 ) Then
        DefaultDocuments = DefaultDocuments & ",index.php"
        WebService.DefaultDoc = DefaultDocuments
        WebService.SetInfo
    End If

    ' Add index.php to default documents list of SiteId 1
    Set WebService1 = GetObject("IIS://LocalHost/W3SVC/1")
    If (Err.Number = 0) Then
        DefaultDocuments = WebService1.DefaultDoc
        If ( InStr(DefaultDocuments,"index.php") = 0 ) Then
            DefaultDocuments = DefaultDocuments & ",index.php"
            WebService1.DefaultDoc = DefaultDocuments
            WebService1.SetInfo
        End If
    End If

    If ( fAddScriptMap = TRUE ) Then
        If ( FormatNumber(GetWindowsVersion) < FormatNumber("5.2") ) Then
            'use short path syntax here
            Set objFSO = CreateObject("Scripting.FileSystemObject")
            Set objFile = objFSO.GetFile(PHPExecutable)
            PHPExecutable = objFile.ShortPath
        Else
            'use quotes and long name syntax
            PHPExecutable = """" & PHPExecutable & """"
        End If
    
        'I may be doing the wrong thing with inheritance here - it seems to work, however!
        Paths = WebService.GetDataPaths("scriptmaps", IIS_DATA_INHERIT)
        If Err.Number <> 0 Then Paths = WebService.GetDataPaths("scriptmaps", IIS_DATA_NO_INHERIT)
        If (Err.Number <> 0) Then
            FatalError ("Error trying to find the nodes containing scriptmaps :GetDataPaths Failed.")
            Exit Sub
        End If
        For Each FullPath In Paths
            Set MapNode = GetObject(FullPath)
            ReDim OutMaps(0)
            J = 0
            For Each Map In MapNode.ScriptMaps
                'split the extension from the scriptmap entry
                MapBits = Split(Map, ",")
                If MapBits(0) <> ".php" Then
                    'if the extension doesn't match any of our php ones, preserve it
                    ReDim Preserve OutMaps(J)
                    OutMaps(J) = Map
                    J = J + 1
                End If
            Next

            ReDim Preserve OutMaps(J + 1 - 1)

            'add our php extensions to OutMaps
            OutMaps(J) = ".php" & "," & PHPExecutable & ",1"
   
            'write the Outmap to the current node
            MapNode.Put "ScriptMaps", (OutMaps)
            'setinfo to make it so
            MapNode.SetInfo
        Next
    End If
    
End Sub

Sub unconfigIIS4

    Dim WebService
    Dim Paths
    Dim Nodes()
    Dim NumExtensions
    Dim PHPExecutable
    Dim NodeCount
    Dim FullPath
    Dim Args, Arg, ArgCount
    Dim I
    Dim J
    Dim K
    Dim MapNode, ScriptMaps, OutMaps(), Map, MapBits
    Dim fRemoveScriptMap
 
    fRemoveScriptMap = TRUE

    'it could all go dreadfully wrong - so set error handler for graceful exits
    On Error Resume Next

    strWebServerType = GetRegistryValue("Software\PHP","WebServerType")
    If ( strWebServerType = "iis4FastCGI" ) Then
        fRemoveScriptMap = FALSE
    End If
 
    Set WebService = GetObject("IIS://LocalHost/W3SVC")
    If (Err.Number <> 0) Then
        FatalError ("Error trying access the local web service: GetObject Failed.")
        Exit Sub
    End If

    If ( fRemoveScriptMap = TRUE ) Then
        'I may be doing the wrong thing with inheritance here - it seems to work, however!
        Paths = WebService.GetDataPaths("scriptmaps", IIS_DATA_INHERIT)
        If Err.Number <> 0 Then Paths = WebService.GetDataPaths("scriptmaps", IIS_DATA_NO_INHERIT)
        If (Err.Number <> 0) Then
            FatalError ("Error trying to find the nodes containing scriptmaps :GetDataPaths Failed.")
            Exit Sub
        End If
        For Each FullPath In Paths
            Set MapNode = GetObject(FullPath)
            ReDim OutMaps(0)
            J = 0
            For Each Map In MapNode.ScriptMaps
                'split the extension from the scriptmap entry
                MapBits = Split(Map, ",")
                If MapBits(0) <> ".php" Then
                    'if the extension doesn't match any of our php ones, preserve it
                    ReDim Preserve OutMaps(J)
                    OutMaps(J) = Map
                    J = J + 1
                End If
            Next

            'write the Outmap to the current node
            MapNode.Put "ScriptMaps", (OutMaps)
            'setinfo to make it so
            MapNode.SetInfo
        Next
    End If

End Sub

Sub FatalError(Message)
    MsgBox Message & " You will need to manually configure the web server.", vbExclamation, "Error"
End Sub

Function GetWindowsVersion
    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
    Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem",,48)
    For Each objItem in colItems
        ver=objItem.Version
    Next
    GetWindowsVersion = Left(ver,3)
End Function

Function GetRegistryValue(strKeyPath,strValueName)
    const HKEY_LOCAL_MACHINE = &H80000002
    strComputer = "."
    
    Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &_
        strComputer & "\root\default:StdRegProv")

    oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
    
    GetRegistryValue = strValue
End Function

Open in new window

Author

Commented:
The error will be raised because of the command:

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

WMI is running.

How can this be fixed?
Meir RivkinFull stack Software Engineer

Commented:
is strComputer value is valid?
Meir RivkinFull stack Software Engineer

Commented:
try isolate the problem, create vb script with just the GetRegistryValue function and call it with the same parameters as the original script.
see if it returns the registry value u r expecting.

Author

Commented:
the value of strComputer is correct and is "."


I tried this code in VbsEdit also, and the script is halting on :
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")

Due to a failure.
Meir RivkinFull stack Software Engineer

Commented:
what the failure say?
Full stack Software Engineer
Commented:
i tested it on different machines and no error was triggered.
try the following:
open command console and run:
rundll32 wbemupgd, UpgradeRepository

test your script once again.

Author

Commented:
Also used wmidiag.vbs to correc the other problems.

Author

Commented:
I also executed the command below which installed the missing entries in the WMI.

rundll32.exe setupapi,InstallHinfSection WBEM 132 %windir%\inf\wbemoc.inf