I run a large SMS 2003 environment we currently in the process of moving to SCCM 2007. We have a tool that allows help desk personnel to push SMS packages to individual computers via a small .Hta script that has just a two line interface COMPUTER NAME and PACKAGE. We would like to continue using this tool in SCCM but I would like to know if there is a better tool out there that would give Help desk personnel better functionality.
Below is the .hta Script we currently use.
</head>
<script language="VBScript.Encode">
'**Start Encode**
Option Explicit
'Initialize:
Dim strCollectionList : strCollectionList = ""
Dim strVerifiedColl : strVerifiedColl = ""
Dim strVerifiedCollId : strVerifiedCollId = ""
Dim strComputerList : strComputerList = ""
Dim strVerifiedComp : strVerifiedComp = ""
Dim strVerifiedCompId : strVerifiedCompId = ""
Dim strUserName : strUserName = ""
Dim objShell
Dim objSWbemLocator
Dim objSWbemServices
'********************
Sub subEndToolSession
If Not fncIsNothing(objShell) Then Set objShell = Nothing
If Not fncIsNothing(objSWbemLocator) Then Set objSWbemLocator = Nothing
If Not fncIsNothing(objSWbemServices) Then Set objSWbemServices = Nothing
' Window.close()
subExitHta
End Sub 'subEndToolSession
'-------------
Sub subWindow_Onload
Window.moveTo 300,100 'x by y
Window.resizeto 250,510 'width by height
End Sub 'subWindow_Onload
</script>
<body onload=subWindow_Onload>
<script language="VBScript.Encode">
'**Start Encode**
Option Explicit
'********************
On Error Resume Next
Set objShell = CreateObject("Wscript.Shell")
Set objSWbemLocator = CreateObject("WbemScripting.SWbemLocator")
Set objSWbemServices = objSWbemLocator.ConnectServer("Server name","root\SMS\site_123")
For intIndexForGoingThroughstrArrayNameay = intStartingValueForstrArrayNameayIndex To UBound(strValue)
If Not fncIsNothing(strValue(intIndexForGoingThroughstrArrayNameay)) Then
'Has something in it
blnFlagSetTrueIfValueHasContent = True
Exit For
End If
Next
fncIsNothing = Not blnFlagSetTrueIfValueHasContent
Exit Function 'fncIsNothing(strValue)
ElseIf intNumberOfDimensions = 2 Then
intNumberOfRows = Ubound(strValue, 2)+1
intNumberOfColumns = Ubound(strValue, 1)+1
For x = 0 To intNumberOfRows - 1
For y = 0 To intNumberOfColumns - 1
If Not fncIsNothing(strValue(y,x)) Then
blnFlagSetTrueIfValueHasContent = True
Exit For
End If
Next
If (blnFlagSetTrueIfValueHasContent) Then
Exit For
End If
Next
fncIsNothing = Not blnFlagSetTrueIfValueHasContent
Exit Function 'fncIsNothing(strValue)
End If
End If
fncIsNothing = False
End Function 'fncIsNothing(strValue)
'------------- The following two functions are used by fncIsNothing
Function fncIif(strConditionToTest,strTestOutputValue1,strTestOutputValue2) 'Used by the fncIsNothing function. Provides alternative strValues based on test.
If strConditionToTest Then
fncIif = strTestOutputValue1
Else
fncIif = strTestOutputValue2
End If
End Function 'fncIif(strConditionToTest,strTestOutputValue1,strTestOutputValue2)
'-------------
Function fncNumberOfDimensions(strArrayName) 'Used by the fncIsNothing function. Returns the number of dimensions of an strArrayNameay.
Dim intNumberOfDimensionsInArray, strTemporaryArrayForArrayDimensionalDetermination
We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.
I run a large SMS 2003 environment we currently in the process of moving to SCCM 2007. We have a tool that allows help desk personnel to push SMS packages to individual computers via a small .Hta script that has just a two line interface COMPUTER NAME and PACKAGE. We would like to continue using this tool in SCCM but I would like to know if there is a better tool out there that would give Help desk personnel better functionality.
Below is the .hta Script we currently use.
</head>
<script language="VBScript.Encode">
'**Start Encode**
Option Explicit
'Initialize:
Dim strCollectionList : strCollectionList = ""
Dim strVerifiedColl : strVerifiedColl = ""
Dim strVerifiedCollId : strVerifiedCollId = ""
Dim strComputerList : strComputerList = ""
Dim strVerifiedComp : strVerifiedComp = ""
Dim strVerifiedCompId : strVerifiedCompId = ""
Dim strUserName : strUserName = ""
Dim objShell
Dim objSWbemLocator
Dim objSWbemServices
'********************
Sub subEndToolSession
If Not fncIsNothing(objShell) Then Set objShell = Nothing
If Not fncIsNothing(objSWbemLocator) Then Set objSWbemLocator = Nothing
If Not fncIsNothing(objSWbemServices) Then Set objSWbemServices = Nothing
' Window.close()
subExitHta
End Sub 'subEndToolSession
'-------------
Sub subWindow_Onload
Window.moveTo 300,100 'x by y
Window.resizeto 250,510 'width by height
End Sub 'subWindow_Onload
</script>
<body onload=subWindow_Onload>
<script language="VBScript.Encode">
'**Start Encode**
Option Explicit
'********************
On Error Resume Next
Set objShell = CreateObject("Wscript.Shell")
Set objSWbemLocator = CreateObject("WbemScripting.SWbemLocator")
Set objSWbemServices = objSWbemLocator.ConnectServer("Server name","root\SMS\site_123")
If Err.Number Then
window.moveTo 250,240 'x by y
window.resizeto 530,290 'width by height
strUserName = objShell.ExpandEnvironmentStrings("%USERDOMAIN%\%USERNAME%")
Msgbox "This tool, SendSmsPackageToComputer.hta, is currently unable to connect to the SMS server," & _
Chr(13) & _
". As a result, this tool session will end automatically when you click the 'OK' button, below." & _
Chr(13) & Chr(13) & _
"The following user account currently appears to be running this tool: " & strUsername & "." & _
Chr(13) & _
"Please make sure that this account has the permissions needed to access the SMS server successfully " & _
Chr(13) & _
"or use another user account that has the permissions needed to run the tool." & Chr(13) & Chr(13) & _
"It's also possible that a temporary network or server problem is currently preventing a successful" & _
Chr(13) & _
"connection. If so, please try again later, or contact an SMS administrator for assistance " & Chr(13) & _
"after first saving a copy of this 'Severe Error' notification." _
,0,"Severe Error"
Err.Clear
subEndToolSession()
End If
'********************
Sub subSearchForCollection()
Dim strFindCollOldValue : strFindCollOldValue = ""
Dim strQuery : strQuery = ""
Dim objCollections : objCollections = ""
Dim objCollection : objCollection = ""
If inpFindColl.value <> "" Then
strFindCollOldValue = inpFindColl.value
strQuery = "SELECT * FROM SMS_Collection WHERE Name LIKE '%" & inpFindColl.value & "% - tickets'"
Set objCollections = objSWbemServices.ExecQuery(strQuery)
If Err.Number = 0 And (objCollections.count<>0) Then
If objCollections.count > 1 Then
strCollectionList = ""
For each objCollection in objCollections
strCollectionList = strCollectionList & " " & Replace(objCollection.name," - Tickets","") & Chr(13)
Next
Msgbox objCollections.count & " SMS packages were found." & Chr(13) & "Please pick just one:" & _
Chr(13) & Chr(13) & strCollectionList,0,"Please Try Again"
strVerifiedColl = ""
strVerifiedCollId = ""
strCollectionList = ""
Else
For each objCollection in objCollections
strVerifiedColl = objCollection.name
strVerifiedCollId = objCollection.collectionid
strCollectionList = Replace(objCollection.name," - Tickets","")
Next
inpFindColl.value = strCollectionList
Msgbox "The SMS package, " & strFindCollOldValue & ", was found in the SMS database as '" & _
strCollectionList & "'.",0,"Successful SMS Package Selection"
End If
Else
strVerifiedColl = ""
strVerifiedCollId = ""
strCollectionList = ""
Msgbox "The SMS package name, " & inpFindColl.value & ", was NOT found in the SMS database. " _
& Chr(13) & _
"Please re-enter the SMS package name." & Chr(13) & Chr(13) & _
"Note: You may enter a percent sign (%) as a wildcard to see a list" & Chr(13) & _
"of all SMS packages currently available to this tool.",0,"Please Try Again"
inpFindColl.value = ""
strVerifiedColl = ""
strVerifiedCollId = ""
strCollectionList = ""
Err.Clear
Exit Sub 'subSearchForCollection
End If
End If
If Not fncIsNothing(objCollection) Then Set objCollection = Nothing
If Not fncIsNothing(objCollections) Then Set objCollections = Nothing
End Sub 'subSearchForCollection
'-------------
Sub subSearchForComputer()
Dim strMsgbox : strMsgbox = ""
Dim intMsgbox : intMsgbox = 0
Dim strFindCompOldValue : strFindCompOldValue = ""
Dim strQuery : strQuery = ""
Dim objComputers : objComputers = ""
Dim objComputer : objComputer = ""
If inpFindComp.value <> "" Then
If (Instr(inpFindComp.value,"%")>0) Then
strUserName = objShell.ExpandEnvironmentStrings("%USERDOMAIN%\%USERNAME%")
strMsgbox = "Thank you, " & strUserName & "." & Chr(13) & Chr(13) & _
"Note: You have included the wildcard character, '%', in the name of the computer" & Chr(13) & _
"you are verifying. This is allowed — but may require substantial processing time, if" & Chr(13) & _
"there are many matched computers in the SMS database. Please be patient." & Chr(13) & Chr(13) & _
"Please click 'OK' to proceed or 'Cancel' to cancel."
intMsgbox = Msgbox (strMsgbox,1,_
"Please Confirm Sending " & strCollectionList & " to " & strComputerList & ".")
If intMsgbox=1 Then
strFindCompOldValue = inpFindComp.value
strQuery = "SELECT * FROM SMS_CM_RES_COLL_SMS00001 WHERE NAME LIKE '%"& inpFindComp.value &"%'"
Set objComputers= objSWbemServices.ExecQuery(strQuery)
If Err.Number = 0 And (objComputers.count<>0) Then
If objComputers.count > 1 Then
strComputerList = ""
For each objComputer in objComputers
strComputerList = strComputerList & " " & objComputer.name & Chr(13)
Next
Msgbox objComputers.count & " computers were found." & Chr(13) & "Please pick just one:" & _
Chr(13) & Chr(13) & strComputerList,0,"Please Try Again"
strVerifiedComp = ""
strVerifiedCompId = ""
strComputerList = ""
Else
For each objComputer in objComputers
strVerifiedComp = objComputer.name
strVerifiedCompId = objComputer.resourceid
strComputerList = objComputer.name
Next
inpFindComp.value = strComputerList
Msgbox "The computer, " & strFindCompOldValue & ", was found in the SMS database as '" & _
strComputerList & "'.",0,"Successful Computer Selection"
End If
Else
strVerifiedComp = ""
strVerifiedCompId = ""
strComputerList = ""
Msgbox "The computer name, " & inpFindComp.value & ", was NOT found in the SMS database. " & Chr(13) & _
"Please re-enter the computer name." & Chr(13) & Chr(13) & _
"Note: You may enter just part of a computer name to see a list" & Chr(13) & _
"of all computer names known to SMS that contain this fragment.",0,"Please Try Again"
inpFindComp.value = ""
Err.Clear
' Exit Sub 'subSearchForComputer
End If
Else
strVerifiedComp = ""
strVerifiedCompId = ""
strComputerList = ""
End If
Else
strFindCompOldValue = inpFindComp.value
strQuery = "SELECT * FROM SMS_CM_RES_COLL_SMS00001 WHERE NAME LIKE '%"& inpFindComp.value &"%'"
Set objComputers= objSWbemServices.ExecQuery(strQuery)
If Err.Number = 0 And (objComputers.count<>0) Then
If objComputers.count > 1 Then
strComputerList = ""
For each objComputer in objComputers
strComputerList = strComputerList & " " & objComputer.name & Chr(13)
Next
Msgbox objComputers.count & " computers were found." & Chr(13) & "Please pick just one:" & _
Chr(13) & Chr(13) & strComputerList,0,"Please Try Again"
strVerifiedComp = ""
strVerifiedCompId = ""
strComputerList = ""
Else
For each objComputer in objComputers
strVerifiedComp = objComputer.name
strVerifiedCompId = objComputer.resourceid
strComputerList = objComputer.name
Next
inpFindComp.value = strComputerList
Msgbox "The computer, " & strFindCompOldValue & ", was found in the SMS database as '" & _
strComputerList & "'.",0,"Successful Computer Selection"
End If
Else
strVerifiedComp = ""
strVerifiedCompId = ""
strComputerList = ""
Msgbox "The computer name, " & inpFindComp.value & ", was NOT found in the SMS database. " & Chr(13) & _
"Please re-enter the computer name." & Chr(13) & Chr(13) & _
"Note: You may enter just part of a computer name to see a list" & Chr(13) & _
"of all computer names known to SMS that contain this fragment.",0,"Please Try Again"
inpFindComp.value = ""
strVerifiedComp = ""
strVerifiedCompId = ""
strComputerList = ""
Err.Clear
End If
End If
End If
If Not fncIsNothing(objComputer) Then Set objComputer = Nothing
If Not fncIsNothing(objComputers) Then Set objComputers = Nothing
End Sub 'subSearchForComputer
'-------------
Sub subAddComputerToCollection
Dim strQuery : strQuery = ""
Dim strMsgbox : strMsgbox = ""
Dim strCollectionQuery : strCollectionQuery = ""
Dim objCollections : objCollections = ""
Dim objCollection : objCollection = ""
Dim objNewDirectRule : objNewDirectRule = ""
Dim objCollectionRule : objCollectionRule = ""
Dim intMsgbox : intMsgbox = 0
If strVerifiedColl<>"" And strVerifiedComp<>"" Then
strQuery = "SELECT * FROM SMS_CM_RES_COLL_" & strVerifiedCollId & " WHERE ResourceId = '" & _
strVerifiedCompId & "'"
Set objCollections= objSWbemServices.ExecQuery(strQuery)
If Err.Number = 0 And (objCollections.count<>0) Then
strMsgbox = "The action just proposed" & Chr(13) & _
" — to send " & strCollectionList & " to " & strComputerList & _
" — " & Chr(13) & _
"has already been scheduled using this tool." & Chr(13) & Chr(13) & _
"Note: This event should occur within two hours of the computer" & Chr(13) & _
"being connected to the network. If this event has not occurred" & Chr(13) & _
"as expected, please contact an SMS administrator for assistance."
Msgbox strMsgbox,0,"No Action Taken"
Exit Sub
Else
strUserName = objShell.ExpandEnvironmentStrings("%USERDOMAIN%\%USERNAME%")
strMsgbox = "Thank you, " & strUserName & "." & Chr(13) & Chr(13) & _
"Note: If you have made a mistake, please click the 'Cancel' button now," & Chr(13) & _
"instead of clicking the 'OK' button displayed with this message." & Chr(13) & Chr(13) & _
"If you decide to click 'OK' and later change your mind, please contact an SMS" & Chr(13) & _
"administrator for assistance. Do not attempt to undo this action by yourself."
intMsgbox = Msgbox (strMsgbox,1,_
"Please Confirm Sending " & strCollectionList & " to " & strComputerList & ".")
If intMsgbox=1 Then
strCollectionQuery = "SMS_Collection.CollectionID='" & strVerifiedCollId & "'"
Set objCollection = objSWbemServices.Get(strCollectionQuery)
Set objNewDirectRule = objSWbemServices.Get("SMS_CollectionRuleDirect").SpawnInstance_
objNewDirectRule.ResourceClassName = "SMS_R_System"
objNewDirectRule.ResourceID = strVerifiedCompId
Set objCollectionRule = objNewDirectRule : subCheckError
On Error Resume Next
objCollection.AddMembershipRule objCollectionRule
'If Err.Number Then
If Err <> 0 Then
window.moveTo 250,240 'x by y
window.resizeto 530,290 'width by height
strUserName = objShell.ExpandEnvironmentStrings("%USERDOMAIN%\%USERNAME%")
Msgbox "This tool, SendSmsPackageToComputer.hta, is currently unable to perform the action just proposed" & _
Chr(13) & _
" — to send " & strCollectionList & " to " & strComputerList & _
"." & Chr(13) & _
"As a result, this tool session will end automatically when you click the 'OK' button, below." & _
Chr(13) & Chr(13) & _
"The following user account currently appears to be running this tool: " & strUsername & "." & _
Chr(13) & _
"Please make sure that this account has the permissions needed to perform this action successfully " & _
Chr(13) & _
"or use another user account that has the permissions needed to run the tool." & Chr(13) & Chr(13) & _
"It's also possible that a temporary network or server problem is currently preventing a successful" & _
Chr(13) & _
"connection to the SMS server, " & _
"Server name. If so, please try again later, or contact an " & Chr(13) & _
"SMS administrator for assistance after first saving a copy of this 'Severe Error' notification." _
,0,"Severe Error"
Err.Clear
subEndToolSession()
End If
objCollection.RequestRefresh True
Msgbox "The action just proposed" & Chr(13) & _
" — to send " & strCollectionList & " to " & strComputerList & _
" — " & Chr(13) & _
"has been successfully completed." & Chr(13) & Chr(13) & _
"If you later change your mind, please contact an SMS administrator for assistance." & Chr(13) & _
"Do not attempt to undo this action by yourself.",0,"Successful Action Completion"
strCollectionList = ""
strVerifiedColl = ""
strVerifiedCollId = ""
strComputerList = ""
strVerifiedComp = ""
strVerifiedCompId = ""
strUserName = ""
Else
Msgbox "The action just proposed" & Chr(13) & _
" — to send " & strCollectionList & " to " & strComputerList & _
" — " & Chr(13) & _
"has been successfully cancelled. Please continue, as appropriate.", _
0,"Successful Action Cancellation"
End If
End If
Else
If strVerifiedColl = "" Then
Msgbox "Please enter and verify (or re-verify) the name of a SMS package before proceeding.",_
0,"Please Try Again"
Else
Msgbox "Please enter and verify (or re-verify) the name of a computer before proceeding.",_
0,"Please Try Again"
End If
End If
If Not fncIsNothing(objCollections) Then Set objCollections = Nothing
If Not fncIsNothing(objCollection) Then Set objCollection = Nothing
If Not fncIsNothing(objNewDirectRule) Then Set objNewDirectRule = Nothing
If Not fncIsNothing(objCollectionRule) Then Set objCollectionRule = Nothing
End Sub 'subAddComputerToCollection
'-------------
Function fncIsNothing(strValue)
Dim strVariableToTestIfSingleDimension
Dim intStartingValueForstrArrayNameayIndex
Dim intIndexForGoingThroughstrArrayNameay, intNumberOfDimensions, intNumberOfRows, intNumberOfColumns, x, y
Dim blnFlagSetTrueIfValueHasContent : blnFlagSetTrueIfValueHasContent = False
If IsEmpty(strValue) Then
fncIsNothing = True
Exit Function 'fncIsNothing(strValue)
End If
If IsNull(strValue) Then
fncIsNothing = True
Exit Function 'fncIsNothing(strValue)
End If
If VarType(strValue) = vbString Then
If strValue = "" Then
fncIsNothing = True
Exit Function 'fncIsNothing(strValue)
End If
End If
If IsNumeric(strValue) Then
If strValue = 0 Then
fncIsNothing = True
Exit Function 'fncIsNothing(strValue)
End If
End If
If IsObject(strValue) Then
If strValue Is Nothing Then
fncIsNothing = True
Exit Function 'fncIsNothing(strValue)
End If
End If
'Check for strArrayNameays
If IsArray(strValue) Then
intNumberOfDimensions = fncNumberOfDimensions(strValue)
'Handle multi-dimensional strArrayNameays
If intNumberOfDimensions = 0 Then
fncIsNothing = True
Exit Function 'fncIsNothing(strValue)
ElseIf intNumberOfDimensions = 1 Then
'Check for single-dimensional strArrayNameay
On Error Resume Next
'Handle single-dimensional strArrayNameays
strVariableToTestIfSingleDimension = strValue(0)
intStartingValueForstrArrayNameayIndex = fncIif(Err.Number = 0, 0, 1)
Err.Clear
On Error GoTo 0
For intIndexForGoingThroughstrArrayNameay = intStartingValueForstrArrayNameayIndex To UBound(strValue)
If Not fncIsNothing(strValue(intIndexForGoingThroughstrArrayNameay)) Then
'Has something in it
blnFlagSetTrueIfValueHasContent = True
Exit For
End If
Next
fncIsNothing = Not blnFlagSetTrueIfValueHasContent
Exit Function 'fncIsNothing(strValue)
ElseIf intNumberOfDimensions = 2 Then
intNumberOfRows = Ubound(strValue, 2)+1
intNumberOfColumns = Ubound(strValue, 1)+1
For x = 0 To intNumberOfRows - 1
For y = 0 To intNumberOfColumns - 1
If Not fncIsNothing(strValue(y,x)) Then
blnFlagSetTrueIfValueHasContent = True
Exit For
End If
Next
If (blnFlagSetTrueIfValueHasContent) Then
Exit For
End If
Next
fncIsNothing = Not blnFlagSetTrueIfValueHasContent
Exit Function 'fncIsNothing(strValue)
End If
End If
fncIsNothing = False
End Function 'fncIsNothing(strValue)
'------------- The following two functions are used by fncIsNothing
Function fncIif(strConditionToTest,strTestOutputValue1,strTestOutputValue2) 'Used by the fncIsNothing function. Provides alternative strValues based on test.
If strConditionToTest Then
fncIif = strTestOutputValue1
Else
fncIif = strTestOutputValue2
End If
End Function 'fncIif(strConditionToTest,strTestOutputValue1,strTestOutputValue2)
'-------------
Function fncNumberOfDimensions(strArrayName) 'Used by the fncIsNothing function. Returns the number of dimensions of an strArrayNameay.
Dim intNumberOfDimensionsInArray, strTemporaryArrayForArrayDimensionalDetermination
On Error Resume Next
For intNumberOfDimensionsInArray = 1 To 60
strTemporaryArrayForArrayDimensionalDetermination = UBound(strArrayName, intNumberOfDimensionsInArray)
If err.number > 0 Then
intNumberOfDimensionsInArray = intNumberOfDimensionsInArray - 1
Exit For
End If
Next
On Error Goto 0
fncNumberOfDimensions = intNumberOfDimensionsInArray
End Function 'fncNumberOfDimensions(strArrayName)
'------------
Sub subCheckError
Dim strMessage
If Err = 0 Then Exit Sub
Msgbox "Line 533: " & Err.Source & " " & Hex(err) & ": " & Err.Description
strMessage = Err.Source & " " & Hex(err) & ": " & Err.Description
'WScript.echo strMessage
'objScriptOutputFile.Write "'Note: " & strMessage & vbCrlf
Err.Clear
'WScript.Quit 1
End Sub 'subCheckError
'----------
Sub subExitHta
Dim strComputer
Dim objWmiService
Dim colProcessList
Dim objProcess
strComputer = "."
Set objWmiService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\cimv2")
Set colProcessList = objWmiService.ExecQuery _
("Select * from Win32_Process Where Name = 'mshta.exe'")
For Each objProcess in colProcessList
objProcess.Terminate()
Next
End Sub 'subExitHta
'********************
</script>
Share this post
Link to post
Share on other sites