Const HKEY_LOCAL_MACHINE = &H80000002
Dim arrSoftwareName()
Dim arrUninstallString()
Dim arrSilentString()
Set objShell = CreateObject("WScript.Shell")
i = 1
strPC = objShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
strPC = InputBox("Please enter the Computer Name:", "Software Uninstall Utility", strPC)
If strPC = "" Then WScript.Quit
If Reachable(strPC) = False Then
MsgBox "'" & strPC & "' cannot be reached or the Computer Name has been entered incorrectly." & _
vbCrLf & vbCrLf & "Please make sure you have entered the Computer Name correctly and try again.", _
vbExclamation, "Error"
WScript.Quit
End If
strSoftwareFilter = InputBox("Enter the title of the Software to uninstall or enter * for all:", _
"Software Uninstall Utility", "*")
Select Case strSoftwareFilter
Case "" WScript.Quit
Case "*" strSoftwareFilter = ""
End Select
Set objReg = GetObject("winmgmts:\\" & strPC & "\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
objReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
For Each strSubkey In arrSubKeys
objReg.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath & "\" & strSubkey, "DisplayName", strNameValue
objReg.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath & "\" & strSubkey, "UninstallString", strUninstallValue
objReg.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath & "\" & strSubkey, "QuietUninstallString", strSilentValue
If InStr(LCase(strNameValue), LCase(strSoftwareFilter)) > 0 Then
ReDim Preserve arrSoftwareName(i)
ReDim Preserve arrUninstallString(i)
ReDim Preserve arrSilentString(i)
arrSoftwareName(i) = strNameValue
arrUninstallString(i) = strUninstallValue
arrSilentString(i) = strSilentValue
strMsg = strMsg & i & ": " & strNameValue & vbCrLf
i = i + 1
End If
Next
If i = 1 Then
MsgBox "'" & strSoftwareFilter & "' cannot be found on " & UCase(strPC) & ".", _
vbExclamation, "Error"
WScript.Quit
End If
intInstallOption = InputBox(strMsg & vbCrLf & "Please enter the number of the " & _
"software title you would like to uninstall:", "Software Uninstall Utility")
If intInstallOption = "" Then WScript.Quit
If IsNumeric(intInstallOption) Then
If CInt(intInstallOption) < i AND CInt(intInstallOption) > 0 Then
strUninstallString = arrUninstallString(intInstallOption)
strSilentString = arrSilentString(intInstallOption)
strSWName = arrSoftwareName(intInstallOption)
Else
MsgBox "'" & intInstallOption & "' is not a valid response.", _
vbExclamation, "Error"
WScript.Quit
End If
Else
MsgBox "'" & intInstallOption & "' is not a valid response.", _
vbExclamation, "Error"
WScript.Quit
End If
If strSilentString <> "" Then
strUninstallString = strSilentString
Else
If strUninstallString = "" Then
MsgBox strSWName & " does not have a valid Uninstall string and cannot be uninstalled.", _
vbExclamation, "Error"
WScript.Quit
ElseIf InStr(LCase(strUninstallString), "msiexec.exe") = 0 Then
ContinuePrompt = MsgBox("There is no valid silent uninstall option and " & _
"as such this application will have to be uninstalled interactively." & _
vbCrLf & vbCrLf & "Do you wish to continue?", _
vbQuestion+vbYesNo, "Software Uninstall Utility")
If ContinuePrompt = vbNo Then WScript.Quit
Else
strUninstallString = Replace(strUninstallString, _
"MsiExec.exe /I", "MsiExec.exe /norestart /quiet /X")
End If
End If
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strPC & "\root\cimv2")
Set objProcess = objWMIService.Get("Win32_Process")
Set objProgram = objProcess.Methods_("Create").InParameters.SpawnInstance_
objProgram.CommandLine = strUninstallString
Set strShell = objWMIService.ExecMethod("Win32_Process", "Create", objProgram)
MsgBox strSWName & " is now being uninstalled on " & UCase(strPC) & ".", _
vbInformation, "Software Uninstall Utility"
'#--------------------------------------------------------------------------
'# FUNCTION.......: Reachable(strComp)
'# PURPOSE........: Checks whether the remote PC is online
'# ARGUMENTS......:
'# EXAMPLE........: Reachable(PC1)
'# NOTES..........:
'#--------------------------------------------------------------------------
Function Reachable(strComp)
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colPing = objWMIService.ExecQuery _
("Select * from Win32_PingStatus Where Address = '" & strComp & "'")
For Each objItemR in colPing
If IsNull(objItemR.StatusCode) Or objItemR.StatusCode <> 0 Then
Reachable = False
Else
Reachable = True
End If
Next
End Function
| 
