Jump to content


Merlin

Established Members
 View Profile  See their activity

  • Posts

    9

  • Joined

  • Last visited

 Content Type 

Everything posted by Merlin

  1. Merlin
    Yea never got this resolved still have issues been to every forum and can't get solved.
  2. Merlin
    No site code if I click discover it says "Automatic site code discovery was unsuccessful" If I type in the site codeand hit apply it says " Failed to update site assignment"
  3. Merlin
    Hello, I am having issues with some SCCM clients on some 32 machines. I can't get them to accept the site code. I have tried everything I know of it seems to point to a boundry issue but I have other machines in the same IP range reporting fine. I have tried the following - Setting up the boundry's for IP ranges these include the range that the machines are in. - Checked the System Managment folder to make sure the MP name is in the security tab and checked other permissions. - Reset the Certs on the client machines. - Checked the communications with the server using this command and got the correct response , - I have tried to chage the OU of the machine in AD and GPUPDATE nothing. - I have disabled the firewall and nothing. Errors include: CCMexec.log Error initializing client registration (0x80040222). RegTask: Failed to refresh site code. Error: 0x8000ffff Location Services.log Failed to resolve 'SMS_SLP' to IP address from WINS LSGetSLP : Failed to resolve SLP from WINS, is it published LSGetAssignedSiteFromSLP : Unable to get the list of SLPs Thanks for any help in advance LocationServices.log CcmExec.log
  4. Merlin
    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 ' ( 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>
  5. Merlin
  6. Merlin
    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>
  7. Merlin
    I was mainly hoping there would be a tool that did that function and some more but we are just now starting the migration and will have to wait till it is done to test the tool.
  8. Merlin
    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
  9. Merlin
    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>
×
×
  • 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.