'******************************************************************** '* '* File: SUBNET.VBS '* Created: July 1998 '* Version: 1.0 '* '* Main Function: Controls DHCP subnets on a machine. '* Usage: Subnet.VBS [/LIST /CREATE | /DELETE] /N:subnet [/S:server] '* [/O:outputfile] [/U:username] [/W:password] [/Q] '* '* Copyright (C) 1998 Microsoft Corporation '* '******************************************************************** OPTION EXPLICIT ON ERROR RESUME NEXT 'Define constants CONST CONST_ERROR = 0 CONST CONST_SHOW_USAGE = 1 CONST CONST_PROCEED = 2 'Declare variables Dim strOutputFile, intOpMode, blnQuiet, i Dim strServer, strUserName, strPassword Dim strSubnetCommand, strSubnetName ReDim strArgumentArray(0) 'Initialize variables strArgumentArray(0) = "" blnQuiet = False strServer = "" strUserName = "" strPassword = "" strOutputFile = "" 'Get the command line arguments For i = 0 to Wscript.arguments.count - 1 ReDim Preserve strArgumentArray(i) strArgumentArray(i) = Wscript.arguments.Item(i) Next 'Parse the command line intOpMode = intParseCmdLine(strArgumentArray, strSubnetCommand, strSubnetName, strServer, _ strOutputFile, strUserName, strPassword, blnQuiet) If Err.Number then Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in parsing the command line." Print "Error description: " & Err.Description & "." Print "Quit now." WScript.Quit End If Select Case intOpMode Case CONST_SHOW_USAGE Call ShowUsage() Case CONST_PROCEED Print "Working ... " Call Subnet(strSubnetCommand, strSubnetName, strServer, _ strOutputFile, strUserName, strPassword) Case CONST_ERROR 'Do nothing Case Else 'Default -- should never happen Print "Error occurred in passing parameters." End Select '******************************************************************** '* '* Function intParseCmdLine() '* Purpose: Parses the command line. '* Input: strArgumentArray an array containing input from the command line '* Output: strSubnetCommand one of /list, /start, /stop '* subnetname name of the service to be started or stopped '* strServer a machine name '* strOutputFile an output file name '* strUserName name of the current user '* strPassword password of the current user '* blnQuiet specifies whether to suppress messages or not '* intParseCmdLine is set to CONST_SHOW_USAGE if there is an error '* in input and CONST_PROCEED otherwise. '* '******************************************************************** Private Function intParseCmdLine(strArgumentArray, strSubnetCommand, strSubnetName, _ strServer, strOutputFile, strUserName, strPassword, blnQuiet) ON ERROR RESUME NEXT Dim strFlag, i, intState strFlag = strArgumentArray(0) If strFlag = "" then 'No arguments have been received Print "Arguments are required." Print "Please check the input and try again." intParseCmdLine = CONST_ERROR Exit Function End If If (strFlag="help") OR (strFlag="/h") OR (strFlag="\h") OR (strFlag="-h") _ OR (strFlag = "\?") OR (strFlag = "/?") OR (strFlag = "?") OR (strFlag="h") Then intParseCmdLine = CONST_SHOW_USAGE Exit Function End If For i = 0 to UBound(strArgumentArray) strFlag = LCase(Left(strArgumentArray(i), InStr(1, strArgumentArray(i), ":")-1)) If Err.Number Then 'An error occurs if there is no : in the string Err.Clear Select Case LCase(strArgumentArray(i)) Case "/q" blnQuiet = True Case "/list" strSubnetCommand = "list" Case "/create" strSubnetCommand = "create" Case "/delete" strSubnetCommand = "delete" Case Else Print strArgumentArray(i) & " is not a valid input." Print "Please check the input and try again." intParseCmdLine = CONST_ERROR Exit Function End Select Else Select Case strFlag Case "/n" strSubnetName = Right(strArgumentArray(i), Len(strArgumentArray(i))-3) Case "/s" strServer = Right(strArgumentArray(i), Len(strArgumentArray(i))-3) Case "/u" strUserName = Right(strArgumentArray(i), Len(strArgumentArray(i))-3) Case "/w" strPassword = Right(strArgumentArray(i), Len(strArgumentArray(i))-3) Case else Print "Invalid flag " & """" & strFlag & ":""" & "." Print "Please check the input and try again." intParseCmdLine = CONST_ERROR Exit Function End Select End If Next intParseCmdLine = CONST_PROCEED If strSubnetName = "" And (strSubnetCommand="start" or strSubnetCommand="stop") Then Print "Missing service name." Print "Please enter the name of the service to be started or stopped." intParseCmdLine = CONST_ERROR Exit Function End If End Function '******************************************************************** '* '* Sub ShowUsage() '* Purpose: Shows the correct usage to the user. '* Input: None '* Output: Help messages are displayed on screen. '* '******************************************************************** Private Sub ShowUsage() Wscript.echo "" Wscript.echo "Controls services on a machine." & vbLF Wscript.echo "SUBNET.VBS [/LIST | /START | /STOP] /N:subnetname [/S:server]" Wscript.echo "[/O:outputfile] [/U:username] [/W:password] [/Q] " Wscript.Echo " /N, /S, /O, /U, /W" Wscript.Echo " Parameter specifiers." Wscript.Echo " /LIST List all subnets on a machine." Wscript.Echo " /CREATE Create a subnet." Wscript.Echo " /DELETE Delete a subnet." Wscript.Echo " subnetname Name of the service to be started or stopped." Wscript.Echo " server A machine name." Wscript.Echo " outputfile The output file name." Wscript.Echo " username Username of the current user." Wscript.Echo " password Password of the current user." Wscript.Echo " /Q Suppresses all output messages." & vbLF Wscript.Echo "EXAMPLE:" Wscript.echo "SUBNET.VBS /S:MyMachine2 /LIST " Wscript.echo " Lists all DHCP subnets on MyMachine2." End Sub '******************************************************************** '* '* Sub Subnet() '* Purpose: Controls subnets on a machine. '* Input: strSubnetCommand one of /list, /start, /stop '* subnetname name of the Subnet to be created/deleted '* strServer a machine name '* strOutputFile an output file name '* strUserName name of the current user '* strPassword password of the current user '* Output: Results are either printed on screen or saved in strOutputFile. '* '******************************************************************** Private Sub Subnet(strSubnetCommand, strSubnetName, strServer, _ strOutputFile, strUserName, strPassword) ON ERROR RESUME NEXT Dim objFileSystem, objOutputFile, objService, strQuery If strOutputFile = "" Then objOutputFile = "" Else 'Create a file object. set objFileSystem = CreateObject("Scripting.FileSystemObject") If Err.Number then Print "Error 0x" & CStr(Hex(Err.Number)) & " opening a filesystem object." Print "Error description: " & Err.Description & "." Exit Sub End If 'Open the file for output set objOutputFile = objFileSystem.OpenTextFile(strOutputFile, 8, True) If Err.Number then Print "Error 0x" & CStr(Hex(Err.Number)) & " opening file " & strOutputFile Print "Error description: " & Err.Description & "." Exit Sub End If End If 'Establish a connection with the server. If blnConnect(objService, strServer, strUserName, strPassword) Then Exit Sub End If 'Now execute the method. Call ExecuteMethod(objService, objOutputFile, strSubnetCommand, strSubnetName) If strOutputFile <> "" Then objOutputFile.Close If intResult > 0 Then Wscript.echo "Results are saved in file " & strOutputFile & "." End If End If End Sub '******************************************************************** '* '* Function blnConnect() '* Purpose: Connects to machine strServer. '* Input: strServer a machine name '* strUserName name of the current user '* strPassword password of the current user '* Output: objService is returned as a service object. '* '******************************************************************** Private Function blnConnect(objService, strServer, strUserName, strPassword) ON ERROR RESUME NEXT Dim objLocator blnConnect = False 'There is no error. ' Create Locator object to connect to remote CIM object manager Set objLocator = CreateObject("WbemScripting.SWbemLocator") If Err.Number then Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in creating a locator object." Print "Error description: " & Err.Description & "." Err.Clear blnConnect = True 'An error occurred Exit Function End If ' Connect to the namespace which is either local or remote Set objService = objLocator.ConnectServer (strServer, "ROOT\DHCP", strUserName, strPassword) If Err.Number then Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in connecting to server " & strServer & "." Print "Error description: " & Err.Description & "." Err.Clear blnConnect = True 'An error occurred Exit Function Else ObjService.Security_.impersonationlevel = 3 End If End Function '******************************************************************** '* '* Sub ExecMethod() '* Purpose: Executes a method. '* Input: objService a service object '* objOutputFile an output file object '* strSubnetCommand one of /list, /start, /stop '* servicename name of the service to be started or stopped '* Output: Results are either printed on screen or saved in objOutputFile. '* '******************************************************************** Private Sub ExecuteMethod(objService, objOutputFile, strSubnetCommand, strSubnetName) ON ERROR RESUME NEXT Dim objEnumerator, objInstance, strMessage, intStatus ReDim strName(0), strDisplayName(0),strState(0), intOrder(0) strMessage = "" strName(0) = "" strDisplayName(0) = "" strState(0) = "" intOrder(0) = 0 Select Case strSubnetCommand Case "delete" objService.Delete("DHCP_SUBNET='" & strSubnetName & "'") If Err.Number Then Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in deleting " & _ "subnet " & strSubnetName & "." Print "Error description: " & Err.Description & "." Err.Clear Exit Sub End If Case "create" Set objInstance = objService.Get("DHCP_SUBNET").SpawnInstance_ If Err.Number Then Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in getting " & _ "DHCP_Subnet" Err.Clear Exit Sub End If objInstance.Name = "SteveMenzies" objInstance.Comment = "Notepad" objInstance.Address = "200.0.0.0" objInstance.Mask = "255.255.255.0" objInstance.Put_ If Err.Number Then Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in creating " & _ "DHCP_Subnet" Err.Clear Exit Sub End If Case "list" Set objEnumerator = objService.ExecQuery ( _ "Select Name,Address,Comment From DHCP_SUBNET") If Err.Number Then Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred during the query." Print "Error description: " & Err.Description & "." Err.Clear Exit Sub End If i = 0 For Each objInstance in objEnumerator If objInstance is nothing Then Exit Sub Else ReDim Preserve strName(i), strAddress(i), strComment(i), intOrder(i) strName(i) = objInstance.Name strAddress(i) = objInstance.Address strComment(i) = objInstance.Comment intOrder(i) = i i = i + 1 End If If Err.Number Then Err.Clear End If Next If i > 0 Then 'Display the header strMessage = Space(2) & strPackString("NAME", 15, 1, 0) strMessage = strMessage & strPackString("ADDRESS", 15, 1, 0) strMessage = strMessage & strPackString("COMMENT", 15, 1, 0) & vbLF WriteLine strMessage, objOutputFile Call SortArray(strName, True, intOrder) Call ReArrangeArray(strAddress, intOrder) Call ReArrangeArray(strComment, intOrder) For i = 0 To UBound(strName) strMessage = Space(2) & strPackString(strName(i), 15, 1, 0) strMessage = strMessage & strPackString(strAddress(i), 15, 1, 0) strMessage = strMessage & strPackString(strComment(i), 15, 1, 0) WriteLine strMessage, objOutputFile Next Else Wscript.Echo "No Subnets found!" End If End Select End Sub '******************************************************************** '* '* Sub SortArray() '* Purpose: Sorts an array and arrange another array accordingly. '* Input: strArray the array to be sorted '* blnOrder True for ascending or False for descending '* strArray2 an array that has exactly the same number of elements as strArray '* and will be reordered together with strArray '* Output: The sorted arrays are returned in the original arrays. '* Note: Repeating elements are not deleted. '* '******************************************************************** Private Sub SortArray(strArray, blnOrder, strArray2) ON ERROR RESUME NEXT Dim i, j, intUbound If IsArray(strArray) Then intUbound = UBound(strArray) Else Print "Argument is not an array!" Exit Sub End If blnOrder = CBool(blnOrder) If Err.Number Then Print "Argument is not a boolean!" Exit Sub End If i = 0 Do Until i > intUbound-1 j = i + 1 Do Until j > intUbound If (strArray(i) > strArray(j)) and blnOrder Then Swap strArray(i), strArray(j) 'swaps element i and j Swap strArray2(i), strArray2(j) ElseIf (strArray(i) < strArray(j)) and Not blnOrder Then Swap strArray(i), strArray(j) 'swaps element i and j Swap strArray2(i), strArray2(j) ElseIf strArray(i) = strArray(j) Then 'Move element j to next to i If j > i + 1 Then Swap strArray(i+1), strArray(j) Swap strArray2(i+1), strArray2(j) End If End If j = j + 1 Loop i = i + 1 Loop End Sub '******************************************************************** '* '* Sub Swap() '* Purpose: Exchanges values of two strings. '* Input: strA a string '* strB another string '* Output: Values of strA and strB are exchanged. '* '******************************************************************** Private Sub Swap(ByRef strA, ByRef strB) Dim strTemp strTemp = strA strA = strB strB = strTemp End Sub '******************************************************************** '* '* Sub ReArrangeArray() '* Purpose: Rearranges one array according to order specified in another array. '* Input: strArray the array to be rearranged '* intOrder an integer array that specifies the order '* Output: strArray is returned as rearranged '* '******************************************************************** Private Sub ReArrangeArray(strArray, intOrder) ON ERROR RESUME NEXT Dim intUBound, i, strTempArray() If Not (IsArray(strArray) and IsArray(intOrder)) Then Print "At least one of the arguments is not an array" Exit Sub End If intUBound = UBound(strArray) If intUBound <> UBound(intOrder) Then Print "The upper bound of these two arrays do not match!" Exit Sub End If ReDim strTempArray(intUBound) For i = 0 To intUBound strTempArray(i) = strArray(intOrder(i)) If Err.Number Then Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred in rearranging an array." Print "Error description: " & Err.Description & "." Err.Clear Exit Sub End If Next For i = 0 To intUBound strArray(i) = strTempArray(i) Next End Sub '******************************************************************** '* '* Function strPackString() '* Purpose: Attaches spaces to a string to increase the length to intLength. '* Input: strString a string '* intLength the intended length of the string '* blnAfter specifies whether to add spaces after or before the string '* blnTruncate specifies whether to truncate the string or not if '* the string length is longer than intLength '* Output: strPackString is returned as the packed string. '* '******************************************************************** Private Function strPackString(strString, ByVal intLength, blnAfter, blnTruncate) ON ERROR RESUME NEXT intLength = CInt(intLength) blnAfter = CBool(blnAfter) blnTruncate = CBool(blnTruncate) If Err.Number Then Print "Argument type is incorrect!" Err.Clear Wscript.Quit End If If intLength > Len(strString) Then If blnAfter Then strPackString = strString & Space(intLength-Len(strString)) Else strPackString = Space(intLength-Len(strString)) & strString & " " End If Else If blnTruncate Then strPackString = Left(strString, intLength-1) & " " Else strPackString = strString & " " End If End If End Function '******************************************************************** '* '* Sub WriteLine() '* Purpose: Writes a text line either to a file or on screen. '* Input: strMessage the string to print '* objFile an output file object '* Output: strMessage is either displayed on screen or written to a file. '* '******************************************************************** Sub WriteLine(ByRef strMessage, ByRef objFile) If IsObject(objFile) then 'objFile should be a file object objFile.WriteLine strMessage Else Wscript.Echo strMessage End If End Sub '******************************************************************** '* '* Sub Print() '* Purpose: Prints a message on screen if blnQuiet = False. '* Input: strMessage the string to print '* Output: strMessage is printed on screen if blnQuiet = False. '* '******************************************************************** Sub Print(ByRef strMessage) If Not blnQuiet then Wscript.Echo strMessage End If End Sub '******************************************************************** '* * '* End of File * '* * '******************************************************************** '******************************************************************** '* '* Procedures calling sequence: SERVICE.VBS '* '* intParseCmdLine '* ShowUsage '* ListJobs '* blnConnect '* ExecuteQuery '* strPackString '* SortArray '* Swap '* WriteLine '* '********************************************************************