troubleshooting Question

Problems running a vb script with SMS

Avatar of Lorrec
Lorrec asked on
VB ScriptWeb Services
8 Comments1 Solution1580 ViewsLast Modified:
Hello. A couple of months ago, a co-worker gave me a script that I can use to install an .msi with a vb script using SMS. The script has been modified to check for laptop model and add registry keys.

If I run the script manually, it works fine. Everything installs and there are no issues. When I create an SMS package and use the script as my command line, it fails to install. I receive a FailureNonRetry error message.

I have setup the package to run from local cache and from the SMS distribution point. Both failed. When it fails, there is no error message displayed. It simply stops running. I can see wscript running as a process but it stops after 20 or so seconds.

Any ideas on what could be the cause? Thank you for any assistance.
'==========================================================================
'
' NAME: Bluetooth_E6400_P1.vbs
'
' DATE  : 12/12/2008
'
' COMMENT: Installs Bluetooth software on a Dell E6400 and E4200
'==========================================================================
 
'//----------------------------------------------------------------------------
'//
'//  Check for laptop model. Script will only run on a E4200 or E6400.
'//
'//----------------------------------------------------------------------------
 
Option Explicit
 
Dim objToFind
Dim colsettings
 
Set objToFind = CreateObject("Scripting.Dictionary")
objToFind.Add "Latitude E4200", ""
objToFind.Add "Latitude E6400", ""
 
Dim objWMI : Set objWMI = GetObject("winmgmts:")
Dim colSettingsComp : Set colSettings = objWMI.ExecQuery("Select * from Win32_ComputerSystem")
Dim colSettingsBios : Set colSettingsBios = objWMI.ExecQuery("Select * from Win32_BIOS")
Dim objComputer, strModel, strSerial
 
For Each objComputer in colSettings
    strModel = Trim(objComputer.Model)
Next
 
If objToFind.Exists(strModel) Then
	Else
	WScript.Quit
End If
 
'//----------------------------------------------------------------------------
'//
'//  Global constant and variable declarations
'//
'//----------------------------------------------------------------------------
 
Public Const ForReading = 1
Public Const ForWriting = 2
Public Const ForAppending = 8
Public Const Success = 0
Public Const Failure = 1
 
Public Const LogTypeInfo = 1
Public Const LogTypeWarning = 2
Public Const LogTypeError = 3
 
Dim fso, iRetVal, sThisScriptName, sThisScriptDir, sLogFile, sCmd
Dim strARPName 
 
strARPName = "WIDCOMM Bluetooth Software" 
 
set fso = CreateObject("Scripting.FileSystemObject")
sThisScriptDir = fso.GetParentFolderName(WScript.ScriptFullName)
sThisScriptName = Wscript.ScriptName
 
sCmd = Array("msiexec /i BTW.msi /log C:\windows\logs\Bluetooth_ESeries_P1.log /QB!")
 
'//---------------------------------------------------------------------------
'//
'//  Function:	Write registry keys
'//
'//  Purpose:	Add registry keys 
'//		
'//---------------------------------------------------------------------------
 
Dim strcomputer, oReg, strKeyPath, strKeyPath2, strApp, strAppValue, strDate, strValueName
Dim strDateValue, strInstalled, strInstalledValue, strVersion, strVersionValue, dwValue
 
const HKEY_LOCAL_MACHINE = &H80000002
strComputer = "."
 
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &_ 
strComputer & "\root\default:StdRegProv")
 
strKeyPath = "SOFTWARE\Software\Bluetooth_ESeries_P1"
oReg.CreateKey HKEY_LOCAL_MACHINE,strKeyPath
 
strKeyPath = "SSOFTWARE\Software\Bluetooth_ESeries_P1"
strApp = "AppName"
strAppValue = "Bluetooth_ESeries"
oReg.SetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strApp,strAppValue
 
strKeyPath = "SOFTWARE\Software\Bluetooth_ESeries_P1"
strDate = "InstallDate"
strDateValue = Date & " - " & Time
oReg.SetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strDate,strDateValue
 
strKeyPath = "SOFTWARE\Software\Bluetooth_ESeries_P1"
strInstalled = "InstallBy"
strInstalledValue = "SMS"
oReg.SetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strInstalled,strInstalledValue
 
strKeyPath = "SOFTWARE\Software\Bluetooth_ESeries_P1"
strVersion = "Version"
strVersionValue = "A04"
oReg.SetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strVersion,strVersionValue
 
'Setup Registry Keys with Bluetooth Restrictions
strKeyPath2 = "SOFTWARE\Policies\Broadcom\Bluetooth\Settings"
oReg.CreateKey HKEY_LOCAL_MACHINE,strKeyPath2
 
strValueName = "DisableDiscovery"
dwValue = 0000001
oReg.SetDWORDValue HKEY_LOCAL_MACHINE,strKeyPath2,strValueName,dwValue
 
strValueName = "EnableNetwork"
dwValue = 0000000
oReg.SetDWORDValue HKEY_LOCAL_MACHINE,strKeyPath2,strValueName,dwValue
 
CreateLogfile 
 
iRetVal = InstallApp(sCmd) 
 
if iRetVal <> Success then
 
    LogInfo sLogFile, "ERROR - One or more of the executed application installs failed.  Please check each application's install logfiles for further details", LogTypeError
 
    Wscript.Quit(1) 
    
Else
 
    LogInfo sLogfile, "All application installs were completed successfully.  See each application's install logfile for futher details", LogTypeInfo
 
    Wscript.Quit(0) 
    
end If
 
 
'//---------------------------------------------------------------------------
'//
'//  Sub:	CreateLogFile()
'//
'//  Input:	none
'//  Output: C:\Temp\Bluetooth_E6400_P1.log 
'//
'//  Purpose: Creates the logfile used by script
'//		
'//---------------------------------------------------------------------------
Sub CreateLogfile()
 
	Dim fptr, tmpScriptName
 
    tmpScriptName = Split(sThisScriptName,".")
    
    sLogFile = "C:\Temp\" & tmpScriptName(0) & ".log"
 
	Set fptr = fso.OpenTextFile(sLogFile, ForAppending, True)
 
End Sub
 
'//---------------------------------------------------------------------------
'//
'//  Function:	InstallApp()
'//
'//  Input:	sCmd - variable with array of command-lines to run
'//	 Output: none
'// 
'//  Return:	Success - 0
'//		Failure - 1
'//
'//  Purpose:	Executes command-line to install applications
'//		
'//---------------------------------------------------------------------------
Function InstallApp(ByRef sCmd)
    
	Dim intAppnum, intExitCode, iRetVal, cmd, colSoftware, objWMIService, strComputer
 
	iRetVal = Success
 
	On Error Resume Next
	
	strComputer = "." 
	
    Set objWMIService = GetObject("winmgmts:" & _
                                  "{impersonationLevel=impersonate}!\\" & _
                                  strComputer & _
                                  "\root\cimv2") 
 
    Set colSoftware = objWMIService.ExecQuery _
        ("SELECT * FROM Win32_Product WHERE Caption = '" & strARPName & "'") 
 
    LogInfo sLogFile, "Checking Add/Remove Programs to see if a previous install of " & strARPName & _
                                            " is listed, before executing the current install.", LogTypeInfo
    
    If colSoftware.Count > 0 Then 
 
        LogInfo sLogFile, "WARNING - Found " & strARPName & " listed in Add/Remove Programs...a previous install of this application already exists", LogTypeWarning
        LogInfo sLogFile, "WARNING - The existing install of " & strARPName & " will now be reinstalled.", LogTypeWarning
    Else
        LogInfo sLogFile, "No previous install of " & strARPName & " exists on this computer...continuing with current installation", LogTypeInfo
    End If
    
    Set colSoftware = Nothing 
 
    intAppnum=1
    
    For Each cmd In sCmd
    
        LogInfo sLogfile, "Command-line for Install #" & intAppnum & " : " & cmd, LogTypeInfo
 
        intExitCode = RunWithHeartbeat(cmd)
 
	    if intExitCode <> 0 then
		    LogInfo sLogfile, "ERROR executing command-line for Install #" & intAppnum & " : " & Chr(34) & cmd & Chr(34), LogTypeError
		    iRetVal = Failure
		Else
            LogInfo sLogfile, "Install #" & intAppnum & " completed successfully", LogTypeInfo
	    end if
 
	    intAppnum = intAppnum + 1
 
	Next
 
    Set colSoftware = objWMIService.ExecQuery _
        ("SELECT * FROM Win32_Product WHERE Caption = '" & strARPName & "'") 
 
    If colSoftware.Count > 0 AND iRetVal = Failure Then 
 
        LogInfo sLogFile, "WARNING - Although " & strARPName & " was installed and is listed in Add/Remove Programs, apparently an error occurred during the installation.  " & _
                            "However, " & strARPName & " was truly installed or it would not be listed in Add/Remove Programs.  None the less, an error did " & _
                                "occur, so check the application logs for further details.  The logs should be located at C:\ .", LogTypeWarning
    End If
 
 
	InstallApp = iRetVal
	
	Set colSoftware = Nothing
	Set objWMIService = Nothing
	
	End Function
 
'//---------------------------------------------------------------------------
'//
'//  Function:	RunWithHeartbeat()
'//
'//  Input:	sCmd - command line to execute
'//
'//  Return:	Exit code of the process
'//
'//  Purpose:	Run the specified command generating heartbeats every
'//		        thirty (30) seconds.
'//
'//---------------------------------------------------------------------------
 
Function RunWithHeartbeat(sCmd)
 
	Dim iRetVal
	Dim oExec
	Dim lastHeartbeat
	Dim lastStart
	Dim iHeartbeat
	Dim iSeconds
	Dim wshShell
 
 
    Set wshShell = CreateObject("WScript.Shell")
 
 
	lastHeartbeat = Now
	iHeartbeat = 30 
 
	LogInfo sLogFile, "About to run command: " & sCmd, LogTypeInfo
	
	lastStart = Now
	Set oExec = wshShell.Exec(sCmd)
	
	LogInfo sLogFile, "Command is now running: " & sCmd, LogTypeInfo
	
	Do While oExec.Status = 0
 
		
 
		WScript.Sleep 1000 
 
		If iHeartbeat > 0 and DateDiff("s", lastHeartbeat, Now) >= iHeartbeat then
			iSeconds = DateDiff("s", lastStart, Now)
            LogInfo sLogFile,"Heartbeat: install has been running for " & CStr(iSeconds) & " seconds (process ID " & oExec.ProcessID & ")",LogTypeInfo
			lastHeartbeat = Now
		End if
	
		If oExec.Status <> 0 Then
			iSeconds = DateDiff("s", lastStart, Now)
            LogInfo sLogFile,"Heartbeat: install is complete and took " & CStr(iSeconds) & " seconds to run (process ID " & oExec.ProcessID & ")",LogTypeInfo
		    Exit Do
		End If
 
	Loop
 
	LogInfo sLogFile, "Return code from command = " & oExec.ExitCode, LogTypeInfo
	
    If oExec.ExitCode <> 0 Then 
		If oExec.ExitCode = 3010 Then 
			LogInfo sLogFile, "Application install was successful, but a reboot is required before using the application", LogTypeInfo
		Else
			iRetVal = Failure
		End If
    End If
	
	RunWithHeartbeat = iRetVal
	
	Set oExec = Nothing
	Set wshShell = Nothing
 
 
End Function
 
'//---------------------------------------------------------------------------
'//
'//  Function:	LogFileAppend()
'//
'//  Input:	sLogFile - name of logfile
'//		sLogMsg - message to append to Logfile
'// 
'//  Return:	Success - 0
'//		Failure - 1
'//
'//  Purpose:	Add a string to the Log File
'//		
'//---------------------------------------------------------------------------
Function LogfileAppend(sLogFile, sLogMsg)
 
	Dim iRetVal, fptr
 
	On Error Resume Next
 
	Set fptr = fso.OpenTextFile(sLogFile, ForAppending, True)
	if Err then
		LogFileAppend = Failure
		Err.Clear
		EXIT FUNCTION
	end if
 
	fptr.writeline(sLogMsg)
	fptr.close
 
	LogfileAppend = iRetVal	
 
End Function
 
'//---------------------------------------------------------------------------
'//
'//  Function:	LogInfo()
'//
'//  Input:	sLogFile - name of logfile
'//		sLogMsg - message to append to Logfile
'//		iType - type of message to log (info, warning, error, flag)
'// 
'//  Return:	None
'//
'//  Purpose:	Write the message to the logfile and the script
'//		
'//---------------------------------------------------------------------------
Function LogInfo(sLogFile, sLogMsg, iType)
 
	Dim sTime, sDate
 
	sTime = Right("0" & Hour(Now), 2) & ":" & Right("0" & Minute(Now), 2) & ":" & Right("0" & Second(Now), 2) & ".000+000"
	sDate = Right("0"& Month(Now), 2) & "-" & Right("0" & Day(Now), 2) & "-" & Year(Now)
 
	LogfileAppend sLogfile, "<![LOG[" & sLogMsg & "]LOG]!><time=""" & sTime & """ date=""" & sDate & """ component=""" & sThisScriptName & """ context="""" type=""" & iType & """ thread="""" file=""" & sThisScriptName & """>"
 
End Function
Join the community to see this answer!
Join our exclusive community to see this answer & millions of others.
Unlock 1 Answer and 8 Comments.
Join the Community
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 8 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros