Jump to content


  • 0
Merlin

Hta to allow Helpdesk techs to deploy applications vis SCCM

Asked by Merlin

Question

Merlin Newbie

Merlin

Posted
Posted

I am looking for a HTA script that we can use so that our help desk personnel can deploy approved applications to user computers VIA SCCM. Attached is an example picture of the interface that was used with SMS 2003 looking for something similar to use with SCCM 2007.

 

Thanks for any help you can provide.

New Bitmap Image.bmp

Share this post

Link to post
Share on other sites

14 answers to this question

Recommended Posts

  • 0
Merlin Newbie

Merlin

Posted
Posted

post the code of the old tool here and we'll update it for you if we can :)

Thank you I tried to attach a txt file but it failed so I will have to paste it.

 

Have a great holiday weekend.

 

BEGIN SCRIPT

 

</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("SERVERNAME","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) & _

"ZAU1FR-0301. 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, " & _

"ZAU1FR-0301. 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
  • 0
Merlin Newbie

Merlin

Posted
Posted

Hello all I have to thank you for the help but we got it working with our SCCM server. I was not given the whole script the first time by the admmin that is the reason I could not get it working.

 

Anyway here is the full working script. feel free to use it.

 

 

**BEGIN SCRIPT**

 

<html>

<head>

<title>Send an SCCM Package to a Computer</title>

<style>Body {Background-Color: SteelBlue}</style>

<HTA:APPLICATION

ContextMenu="True"

Icon="Wizard.ico"

Selection="no"

InnerBorder="no"

Caption = Yes

Border = Thick

ShowInTaskBar = No

MaximizeButton = Yes

MinimizeButton = Yes

Id="SendSmsPackageToComputer"

ApplicationName="SendSCCMPackageToComputer"

Scroll="no"

SingleInstance="yes"

WindowsState="normal"

SysMenu="no"

>

</head>

'Title: SendComputerSCCMPackage.hta

'Author: XXXXXX

'Created: 1/3/2007

'Last Revised: 6/3/2011

'Version: 1.0.0.3

'

'Purpose: To provide a simple tool for admin, helpdesk, and MRT staff

' to send an SCCM package (already created for this purpose)

' to a computer (already known to SCCM)

' in response to an approved, ticketed special request.

' This tool should not be used as part of the ordinary

' SCCM deployment process.

'

'Usage: Do not attempt to use this process unless you are sure:

' (a) you have the necessary permissions and access to an

' SCCM admin console, and

' (B) the SCCM package to be deployed has previously been setup,

' tested, and approved by SCCM administrators for use in

' this manner.

'To Test:

' None. Submitted for engineering staff review.

'To Do:

' None. Submitted for engineering staff review.

'Revision History:

' 12/23/2008 Completed initial code.

' 12/24/2008 Improved popups and encoded VBscript.

' 12/29/2008 Made sure temp variables are erased as soon as used.

' 12/29/2008 Added code to ensure any objects created

' by the script are deleted by the script.

' 01/09/2009 Stress tested the code, making revisions as appropriate.

' 01/23/2009 Added code to provide graceful handling of an error

' caused by a tool user having some but not all of the

' permissions needed to run the tool sucessfully.

' 06/03/2011 Modifided script to work With SCCM server.

'******************************************************************************

</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("INSERT SERVER NAME","root\SMS\site_???")

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, SendSCCMPackageToComputer.hta, is currently unable to connect to the SCCM server," & _

Chr(13) & _

"Servername. 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 SCCM 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 SCCM 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 SCCM package, " & strFindCollOldValue & ", was found in the SCCM database as '" & _

strCollectionList & "'.",0,"Successful SCCM Package Selection"

End If

Else

strVerifiedColl = ""

strVerifiedCollId = ""

strCollectionList = ""

Msgbox "The SCCM package name, " & inpFindColl.value & ", was NOT found in the SCCM database. " _

& Chr(13) & _

"Please re-enter the SCCM package name." & Chr(13) & Chr(13) & _

"Note: You may enter a percent sign (%) as a wildcard to see a list" & Chr(13) & _

"of all SCCM 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 SCCM 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 SCCM database as '" & _

strComputerList & "'.",0,"Successful Computer Selection"

End If

Else

strVerifiedComp = ""

strVerifiedCompId = ""

strComputerList = ""

Msgbox "The computer name, " & inpFindComp.value & ", was NOT found in the SCCM 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 SCCM 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 SCCM database as '" & _

strComputerList & "'.",0,"Successful Computer Selection"

End If

Else

strVerifiedComp = ""

strVerifiedCompId = ""

strComputerList = ""

Msgbox "The computer name, " & inpFindComp.value & ", was NOT found in the SCCM 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 SCCM 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 SCCM" & 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, SendSCCMPackageToComputer.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 SCCM server, " & _

"INSERT SERVERNAME. If so, please try again later, or contact an " & Chr(13) & _

"SCCM 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 SCCM 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 SCCM 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>

<H4><font style="font:10 pt arial narrow; font-weight:bold">Please enter the name of a SCCM package to send to a computer</font></H4>

<H4><font style="font: 8pt Arial"> (For example: MS Project 2003 SP3, Project, or, % — for a list of all SCCM packages currently available to this tool):</font></H4>

<input type="value" style=

"background-color:#98AFC7;filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=1, StartColorStr='#98AFC7', EndColorStr='#FFFFFF')"

name="inpFindColl" size="20" >

<input type="button" value="Verify" name="acceptcoll" onClick="subSearchForCollection" style="background:#FBB117; ">

<BR>

<hr>

<H4><font style="font:10 pt arial narrow; font-weight:bold">Please enter the name of a computer to receive the SCCM package</font></H4>

<H4><font style="font: 8pt Arial">(For example: COMPUTERNAME or just part of the name — for a list of all computer names known to SCCM that contain this fragment):</font></H4>

<input type="value" style="background-color:#98AFC7;filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=1, StartColorStr='#98AFC7', EndColorStr='#FFFFFF')"

name="inpFindComp" size="20"

>

<input type="button" value="Verify" name="acceptcomp" onClick="subSearchForComputer" style="background:#FBB117; ">

<BR>

<hr>

<span id="Output"></span>

<BR>

<input type="button" value="Send SCCM Package" name="AddComputer" onClick="subAddComputerToCollection" style="font:11 pt arial narrow; font-weight:bold; background:green; color:white">

<HR>

<BR>

<input type="button" value="End Tool Session" name="Closeout" onClick="subEndToolSession"

style="font:11 pt arial narrow; font-weight:bold; background:red; color:white">

</body>

Share this post

Link to post
Share on other sites
  • 0
binarymime Newbie

binarymime

Posted
Posted

Im no coder, but the remark (') is not working when describing the tools function, it is still showing all of the tool description text when the tool is run, also using % as the tool states, does not provide a list of available packages to be run...any insight?

Share this post

Link to post
Share on other sites

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...
×
Go to question listing
×
×
  • 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.