Skriptgesteuert unberechtigte Benutzer aus lokaler Admingruppe entfernen

On Error Resume Next

Const ExclusionListINI = "exclusions.ini"  '!!!!EXCLUSION LIST  Path and Filename 

Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const TristateTrue = -1
Const TristateFalse = 0 
Const EVENT_SUCCESS = 0
Const EVENT_ERROR   = 1
Const EVENT_WARNING = 2

Set objArgs = WScript.Arguments
strArgument = LCase(objArgs(0))

If objArgs.count > 1 Then
 wsh.echo "Main: Wrong number of command line parameters provided. Exiting Script..."
 WScript.Quit        
End If

Select Case UCase(strArgument)
 Case "FORCE"
  If (FileExists(ExclusionListINI)=0) Then
   DeleteUnauthorizedAdminMembers(ExclusionListINI)
  Else
   CreateEventLog "RemoveUnauthorizedMembers: missing exclusion file: "&ExclusionListINI&"! No members were removed", EVENT_ERROR
   wsh.echo "Exclusionfile not found. Aborting script ..."
  End If
  WScript.Quit
 Case Else
  wsh.echo "Main: Unknown or no action provided "
  wsh.echo "type ""RemoveUnauthorizedMembers force"" to start script"
  WScript.Quit        
End Select

Sub DeleteUnauthorizedAdminMembers(ByRef ExclusionFile)
'/////////////////////////////////////////////////
'// Removes all members in local admin group with
'// no definition in Exclusion List

 Dim objINIDict,arrKeys,strSection
 Set objINIDict = INItoDict (ExclusionFile, "INI")
 arrExclusionList = objINIDict.Keys
 For y = 0 To Ubound(arrExclusionList)
  strSection=arrExclusionList(y)
  if (UCase(strSection) = UCase(GetComputerName)) Then
   strExclusions = objINIDict.Item(strSection).Item("EXCLUDE").Value
   Exit For
  End If
 Next
 
 arrExclusions = Split(strExclusions, ";")
 sAdmGrpName = GetAdminGroupName
 arrLocalAdmGroup = ListLocalGroupMembers(sAdmGrpName)
 arrGlobal = Split(objINIDict.Item("GLOBAL").Item("EXCLUDE").Value,";")
 
 arrA = SortArray(arrLocalAdmGroup)
 arrB = SortArray(arrExclusions) 
 arrC = SortArray(arrGlobal) 

 For i = 0 to UBound(arrA) 
  For x = 0 to UBound(arrC)
   For j = 0 to UBound(arrB)
     hExists = False
    if (UCase(arrA(i)) = UCase(arrB(j))) Then
       hExists = True
       Exit For
    End If     
   Next  
    hExists = False
   If (UCase(arrA(i)) = UCase(arrC(x))) Then
    
    hExists = True
    Exit For
   End If
  Next  
    
   If not hExists Then   
    If arrA(i) <> "" Then       
       DeleteGroupMember sAdmGrpName,arrA(i)
    End If
   End If  
 Next
End Sub

Sub CreateEventLog(ByRef Message,ByRef ErrCode)
'/////////////////////////////////////////
'// Creates an EventLog entry 

 Set objShell = Wscript.CreateObject("Wscript.Shell")
 objShell.LogEvent ErrCode, Message
End Sub

Function FileExists(Fname)
'/////////////////////////////////////
'// check if file really exists

 Set fs = CreateObject("Scripting.FileSystemObject")

 if fs.FileExists(Fname) = False then
   FileExists = -1
 else
   FileExists = 0
 end if

 Set fs = Nothing
end Function

Function GetComputerName
'////////////////////////////////////////
'// Returns current computername

 Set objWSHNetwork = CreateObject("WScript.Network")
 GetComputerName = objWSHNetwork.ComputerName
End Function

Function GetAdminGroupName
'//////////////////////////////////////////////////////////
'// Returns name of local administrators group

 Set computer = GetObject("WinNT://.")
 computer.Filter = Array("group")

 For Each group in computer
  if (UCase(group.name)="ADMINISTRATOREN") Then GetAdminGroupName = "Administratoren"  
  if (UCase(group.name)="ADMINISTRATORS") Then GetAdminGroupName = "Administrators" End If
 Next
End Function

Function ListLocalGroupMembers(ByRef GroupName)
'///////////////////////////////////////////////////
'// Returns all members in GroupName

 Set computer = GetObject("WinNT://.")
 Set group = computer.GetObject("group",GroupName)
 
 For Each user in group.Members
  arrList = arrList&UCase(user.Name)&";"
 Next 
 arrList = Split(arrList, ";")
 ListLocalGroupMembers = arrList
End Function

Sub DeleteGroupMember(ByRef GroupName, ByRef ObjToDel)
'///////////////////////////////////////////////////////
'// removes an object in Groupname and creates 
'// Eventlog entry
 On Error Resume Next

 set oGroupAdm = GetObject("WinNT://./"&GroupName)

 For Each oAdmGrpUser In oGroupAdm.Members
  sAdmGrpUser = lCase(oAdmGrpUser.Name)
  if (sAdmGrpUser = lCase(ObjToDel)) Then
   oGroupAdm.Remove oAdmGrpUser.ADsPath 
   If (Err.Number<>0) Then
    CreateEventLog "RemoveUnauthorizedMembers("&Err.Number&"): Could not remove "&objToDel&" from group "&GroupName,EVENT_WARNING
    wsh.echo Err.Number&" Could not remove "&objToDel&" from group "&GroupName
   Else
    CreateEventLog "RemoveUnauthorizedMembers: "&objToDel&" succesfully removed from "&GroupName&" group.",EVENT_SUCCESS
    wsh.echo objToDel&" succesfully removed from "&GroupName&" group."
   End If
  Err.Clear
  End If
 Next
End Sub
  
Function SortArray(arrSort)
'///////////////////////////////////
'// sorts an array

 For i = 0 to Ubound(arrSort) 
  arrSort(i)= StringToBin(arrSort(i))
 Next
 arrSorted = bubblesort(arrSort)
 For j = 0 to UBound(arrSorted)
  arrSort(j)=BinToString(arrSorted(j))
 Next
 SortArray=arrSort
End Function

function bubblesort(arrSortieren)
'//////////////////////////////////////////
'// bubble sort algorithm

 for i = 0 to ubound(arrSortieren)
  for j = i + 1 to ubound(arrSortieren)
   if arrSortieren(i) > arrSortieren(j) then
    arrTemp = arrSortieren(i)
    arrSortieren(i) = arrSortieren(j)
    arrSortieren(j) = arrTemp
   end if
  next
 next
 bubblesort = arrSortieren
end function

Function StringToBin(str)
'////////////////////////////////////
'// Converts a string to bin

        Dim result, x
        StringToBin = ""
        If Len(str)=0 Then Exit Function
        If Len(str)=1 Then
                result = Asc(Mid(str, 1, 1))
                StringToBin = Left("000", 3-Len(CStr(result))) & CStr(result)
                Exit Function
        End If
        result = ""
        For x=1 To Len(str)
                result = result & StringToBin(Mid(str, x, 1))
        Next
        StringToBin = result
End Function

Function BinToString(str)
'//////////////////////////////////
'// Converts bin code to string

        Dim result, x
        BinToString = ""
        If Len(str)<3 Then Exit Function
        If Len(str)=3 Then
                BinToString = Chr(CInt(str))
                Exit Function
        End If
        result = ""
        For x=1 To Len(str) Step 3
                result = result & BinToString(Mid(str, x, 3))
        Next
        BinToString = result
End Function

'///////////////////////////////////////////////////////////////////////////////
'/ "ParseINItoDict" reads a complete INI file and adds content to a dictionary object
'/ ----------------------------------------------
Function INItoDict(ByVal strIniFilePath,ByVal strIdent)

        Dim ParseAINI, blnFoundSection, strSection, objFSO
        Dim intEquals, sKey, sVal, i, sLine, tsIni, tsTest, objINIEntry
        
        'On Error Resume Next

        Set objFSO = CreateObject("Scripting.FileSystemObject")
        
        blnFoundSection = False
        
        If IsEmpty(strIdent) Then
                strIdent = ""
        End If

        Err.Clear
        
        If objFSO.FileExists(strIniFilePath) Then
                
                Set tsTest = objFSO.OpenTextFile(strIniFilePath)
                
                Set INItoDict = CreateObject("Scripting.Dictionary")
                
                If Not tsTest.AtEndOfStream Then
                        sLine = tsTest.ReadLine
                        tsTest.Close
                        If IsUnicode(sLine) = vbTrue Then
                                Set tsIni = objFSO.OpenTextFile(strIniFilePath,ForReading,vbFalse,TristateTrue)
                        Else
                                Set tsIni = objFSO.OpenTextFile(strIniFilePath,ForReading,vbFalse,TristateFalse)
                        End If                        
                Else
                        Exit Function                
                End If
                                        
                Do While Not tsIni.AtEndOfStream
                        sLine = ""
                        sLine = Trim(tsIni.ReadLine)
                        If sLine <> "" Then
                                If Left(sLine,1) <> ";" Then
                                        If Left(sLine,1) = "[" Then
                                                blnFoundSection = True                    
                                                strSection = Left(sLine, Len(sLine) - 1)
                                                strSection = Right(strSection, Len(strSection) - 1)
                                                Set ParseAINI = CreateObject("Scripting.Dictionary")
                                                INItoDict.Add UCase(strSection), ParseAINI
                                        Else
                                                'key and value logic
                                                intEquals = InStr(1, sLine, "=")
                                                If (intEquals <= 1) Then
                                                        'line is invalid => skip
                                                Else
                                                        'line is invalid
                                                        sKey = Replace(Left(sLine, intEquals - 1),vbTab,"")
                                                        sVal = Replace(Right(sLine, Len(sLine) - intEquals),vbTab,"")
                                                        Set objINIEntry = New INIEntry
                                                        objINIEntry.Name = LCase(sKey)
                                objINIEntry.Value =  Trim(sVal)
                                                        objINIEntry.OU =  strIdent
                                                        objINIEntry.SourcePath = strIniFilePath                        
                                                        Err.Clear
                                                        ParseAINI.Add Trim(UCase(sKey)), objINIEntry
                                                        If Err.Number <> 0 Then                                                                
                                                        End If                                                                                                
                                                End If
                                        End If
                                End If
                        End If
                Loop
                
 
                tsIni.Close
                Set tsIni = Nothing
                
                If blnFoundSection = False Then
                        Set INItoDict = CreateObject("Scripting.Dictionary")
                End If
        
        Else
                Set INItoDict = CreateObject("Scripting.Dictionary")
        End If

End Function 

Function IsUnicode(stringValue)
   IsUnicode = False
   If Left(stringValue,2)="ÿþ" Then
      IsUnicode = True
   End If
End Function

Class INIEntry

        Public Name
        Public Value
        Public OU
        Public SourcePath

End Class