windows-xp/Source/XPSP1/NT/net/dhcp/dhcpprov/scripts/vbscript/subnet.vbs

'********************************************************************
'*
'* 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
'*
'********************************************************************