Jump to content


  • 0
Merlin

Script to allow Helpdesk to deploy SCCM packages

Question

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

1 answer to this question

Recommended Posts

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...


×
×
  • Create New...

Important Information

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.