'#################################################################################################################
'### Script, um die Anzahl von N Usern per Skript im AD mit 10-stelligen, komplexem Passwort anlegen           ###
'### getestet auf Windows Server 2003 SP2, Server2003 R2 u 2008 R2 (jeweils Deutsch)                           ###
'### Ver 10/3/2010_23:53                                                                                        ###
'#################################################################################################################


'Set objComputer = CreateObject("Shell.LocalMachine")         ' nicht verändern!
Set objComputer = CreateObject("Wscript.Network")



'### folgende Variablen können (müssen abern nicht) verändert werden: ##

  ServerName = objComputer.Computername                          'Server, auf dem die Shares erstellt wurden; falls nicht anders
                                                                'angegeben, der DC auf dem das Script gestartet wird

  LoesungsPfad = "C:\TestAbgabe"                                         'In diesem Pfad des Servers werden die Freigaben erstellt
  AngabePfad = "C:\TestAngaben"                                          'In diesem Pfad des Servers werden die Freigaben erstellt

  LoesungsShare = "TestAbgaben"                                   'Name der Freigabe, auf der die Lösungen gespeichert werden.
  LoesungsDrive = "v:"
  AngabeShare = "TestAngabe"                                        'Name der Freigabe für Angaben!
  AngabeDrive = "u:"
  PruefungsOU = "TestsMeinerDomaene"                                     'Organisationseinheit, die im AD per Skript angelegt wird
  GroupString = "TestGruppe"                                'Sicherheitsgruppe, in der die User automatisch Mitglieder werden
  Lehrer = "lehrer"                                             'Sicherheitsgruppe, in der die Lehrer Mitglieder sind

'### hier beginnt der Teil, der eher nur noch von Auskennern angefasst werden sollte ;-)  ##


Anzahl = InputBox("Wie viele User?")
Bezeichnung = InputBox("Wie sollen die Benutzer heissen?")
ZielOU = InputBox("In welcher OU sollen die User angelegt werden?")

Set objFS = CreateObject("scripting.filesystemobject")
Set WshShell = WScript.CreateObject("WScript.Shell")
Set rootDSE = GetObject("LDAP://RootDSE")
DomainName = rootDSE.Get("defaultnamingcontext")

' aus DC=hak-neusiedl,DC=local wird hak-neusiedl.local
DomainString = Replace(DomainName, "DC=", "")
DomainString = Replace(DomainString, ",", ".")

'erstellt eine neue OU für die Prüfungen
If Not OUExists(PruefungsOU, "LDAP://" & DomainName) Then
    Set PrfOU = GetObject("LDAP://" & DomainName).Create("organizationalUnit", "ou=" & PruefungsOU)
    PrfOU.SetInfo
Else
    Set PrfOU = GetObject("LDAP://" & "ou=" & PruefungsOU& "," & DomainName)
End If

' erstellt, falls noch nicht vorhanden, eine neue Gruppe, in der die User Mitglied werden
If Not ObjectExists(GroupString, "group", "WinNT://" & DomainString) Then
    Set objGroup = PrfOU.Create("Group", "CN=" & GroupString)
    objGroup.Put "sAMAccountName", GroupString
    objGroup.SetInfo
End If
' Die Gruppe wird gesucht und als Ziel definiert.
Set GroupObj = GetObject("WinNT://" & DomainString & "/" & GroupString)

' ZielOU nach Prüfung auf Vorhandensein erstellen
Abbruch = False
Do While OUExists(ZielOU, PrfOU.ADSPath) And Not Abbruch
    Do
        ZielOU = InputBox(_
            "Die OU " & ZielOU & " wurde bereits verwendet!" & vbCrLf & _
            "Bitte geben Sie eine andere OU oder ""exit"" für Abbruch ein!")
    Loop Until ZielOU <> ""
    If LCase(ZielOU) = "exit" Then Abbruch = True
Loop
If Abbruch Then WScript.Quit

' Prüfung, ob Benutzer angelegt
Do While ObjectExists(Bezeichnung & "01", "user", "WinNT://" & DomainString) And Not Abbruch
    Do
        Bezeichnung = InputBox(_
            "Die Bezeichnung " & Bezeichnung & " wurde bereits verwendet!" & vbCrLf & _
            "Bitte geben Sie eine andere Bezeichnung oder ""exit"" für Abbruch ein!")
    Loop Until Bezeichnung <> ""
    If LCase(Bezeichnung) = "exit" Then Abbruch = True
Loop

WScript.Echo "Die Verarbeitung kann einige Zeit dauern. Bitte um Geduld..."

If Abbruch Then WScript.Quit

' erstellt in der Prüfungs-OU nun eine neue OU lt Eingabe
Set ThisOU = GetObject(PrfOU.ADSPath).Create("organizationalUnit", "ou=" & ZielOU)
ThisOU.SetInfo

' erstellt den Pfad für die Freigaben
CreatePath LoesungsPfad
CreatePath AngabePfad & "\" & ZielOU

' es werden die Freigaben erzeugt
CreateShare LoesungsShare, LoesungsPfad
CreateShare AngabeShare, AngabePfad

' Grundlegende Rechte für Angabe- und Pruefungsordner setzen
WshShell.Run "cmd /c echo j|cacls " & LoesungsPfad & " /G Administratoren:F " & Lehrer & ":C " & GroupString & ":R", 0, 1
WshShell.Run "cmd /c echo j|cacls " & LoesungsPfad & " /E /G " & GroupString & ":W", 0, 1
WshShell.Run "cmd /c echo j|cacls " & AngabePfad & " /G Administratoren:F " & Lehrer & ":C " & GroupString & ":R", 0, 1
WshShell.Run "cmd /c echo j|cacls " & AngabePfad & "\" & ZielOU & " /G Administratoren:F " & Lehrer & ":C ", 0, 1


' loginscript schreiben
LoginScriptName = ZielOU & ".bat"
LoginScriptPfad = "sysvol\" & DomainString & "\Scripts\Abschluss\Login"
LoginScript = "\\" & DomainString & "\" & LoginScriptPfad & "\" & LoginScriptName
LoginScriptPfadLokal = "C:\WINDOWS\SYSVOL" & "\" & LoginScriptPfad
LoginScriptDatei = LoginScriptPfadLokal & "\" & LoginScriptName
CreatePath LoginScriptPfadLokal

Set objTextStream = objFS.CreateTextfile(LoginScriptDatei)
objTextStream.write "net use " & AngabeDrive & " \\" & ServerName & "\" & AngabeShare & "\" & ZielOU
objTextStream.Close

Informationen = "Benutzername;Passwort" & vbCrLf
Randomize

For g = 1 To Anzahl
    ' die Verzeichnisse für die Lösungen werden erstellt;
    ' alle User haben eine zweistellige Bezeichnung, dh 01 bis 09, 10 usw
    Zahl = Right("0" & g, 2)
    MUsername = Bezeichnung & Zahl

    CreatePath "\\" & ServerName & "\" & LoesungsShare & "\" & ZielOU & "\" & MUsername

    ' die User werden nun im AD angelegt

    'Passwort = "Passwort" & i & "-" & Int(10000 * rnd + 1)
    Passwort = Kennwort(10)

    Set usr = ThisOU.Create("user", "CN=" & MUsername)
    usr.Put "samAccountName", MUsername
    usr.Put "userPrincipalName", MUsername & "@" & DomainString
    usr.Put "homeDirectory", "\\" & ServerName & "\" & LoesungsShare & "\" & ZielOU & "\" & MUsername
    usr.Put "homeDrive", LoesungsDrive
    usr.Put "scriptPath", LoginScript
    usr.SetInfo
    usr.SetPassword Passwort
    usr.AccountDisabled = False
    usr.SetInfo
    WScript.Sleep (1000)

    Informationen = Informationen & vbCrLf & MUsername & ";" & Passwort
    i = i + 1

    GroupObj.Add ("WinNT://"& DomainString & "/" & MUsername)
    WScript.Sleep (1000)

    ' die Berechtigungen werden in den Verzeichnissen der User gesetzt
    PermL1 = "Administratoren:F " & Lehrer & ":C " & MUsername & ":R "
    PermL2 = MUsername & ":W "
    PermA = "Administratoren:F " & Lehrer & ":C " & MUsername & ":R "



WshShell.Run "cmd /c echo j|cacls \\" & ServerName & "\" & LoesungsShare & "\" & ZielOU & "\" & MUsername & " /G " & PermL1 , 0, 1
WshShell.Run "cmd /c echo j|cacls \\" & ServerName & "\" & LoesungsShare & "\" & ZielOU & "\" & MUsername & " /E /G " & PermL2 , 0, 1
WshShell.Run "cmd /c echo j|cacls \\" & ServerName & "\" & AngabeShare & "\" & ZielOU & " /E /G " & PermA , 0, 1


    WScript.Sleep (1000)

Next

' die csv mit den Usern und Passwörtern wird erstellt
strDateiname = ZielOU & ".csv"
Set objTextStream = objFS.CreateTextFile(strDateiname, True)
objTextStream.write Informationen
objTextStream.Close

If i > 0 Then
    Erfolg = "Fertig: " & i & " Benutzer angelegt"
Else
    Erfolg = "Keine User angelegt."
End If

WScript.Echo Erfolg


Function Zeichen(Anfang, Ende)
    Zufall = Int((Ende - Anfang + 1) * Rnd + Anfang)
    Zeichen = Chr(Zufall)
End Function

Function Verschiebe(VWort)
    WLaenge = Len(VWort)
    NeuWort = ""
    ReDim WFeld(WLaenge)
    For t = 1 To WLaenge
        WFeld(t) = Mid(VWort, t, 1)
    Next
    Zahl = 0
    Do Until Len(NeuWort) = WLaenge
        j = Int((WLaenge) * Rnd + 1)
        If WFeld(j) <> "" Then
            NeuWort = NeuWort & WFeld(j)
            WFeld(j) = ""
        End If
        Zahl = Zahl + 1
        If Zahl > 1000 Then Exit Do ' Zur Sicherheit
    Loop
    Verschiebe = NeuWort
End Function

Function Kennwort(KennwortLaenge)
If KennwortLaenge > 128 Then KennwortLaenge = 128
Wort = ""
Wort = Zeichen(48, 57) ' Ziffern
Wort = Wort & Zeichen(65, 90) ' Großbuchstaben
Wort = Wort & Zeichen(97, 122) ' Kleinbuchstaben
Wort = Wort & Zeichen(33, 47) ' Satzzeichen
If KennwortLaenge > 4 Then
    For t = 5 To KennwortLaenge
        Wort = Wort & Zeichen(33, 122)  'sonstige Zeichen
    Next
End If
Wort = Verschiebe(Wort) ' Zeichenfolge zufällig ändern
Kennwort = Wort
Kennwort = Replace(Kennwort, " ", "_")
Kennwort = Replace(Kennwort, ";", "_")
Kennwort = Replace(Kennwort, """", "_")
End Function

Sub CreatePath(FullPath) 'Rekursive Erstellung eines Pfades
If Not objFS.FolderExists(FullPath) Then
    Folder = objfs.GetFileName(FullPath)
    ParentPath = objfs.GetParentFolderName(FullPath)
    If Right(ParentPath, 1) <> "\" Then ParentPath = ParentPath & "\"
    CreatePath(ParentPath)
    objFS.CreateFolder(ParentPath & Folder)
End If
End Sub

Sub CreateShare(ShareName, SharePath)
Set Freigaben = GetObject("WinNT://" & ServerName & "/LanmanServer,FileService")
Angelegt = False
For Each Freigabe In Freigaben
    If LCase(Freigabe.Name) = LCase(ShareName) Then
        Angelegt = True
        Exit For
    End If
Next
If Not Angelegt Then
    Set fs = Freigaben.Create("FileShare", ShareName)
    fs.Path = SharePath
    fs.MaxUserCount = -1
    fs.SetInfo
End If
Set Freigaben = Nothing
Set fs = Nothing
End Sub

Function OUExists(OUName, ParentOU)
Set Container = GetObject(ParentOU)
Container.Filter = Array("organizationalUnit")
OUExists = False
For Each OU In Container
    If LCase(OU.ou) = LCase(OUName) Then
        OUExists = True
        Exit For
    End If
Next
End Function

Function ObjectExists(ObjectName, ObjectType, DomainRoot)
Set Dom = GetObject(DomainRoot)
Dom.Filter = Array(ObjectType)
ObjectExists = False
For Each Obj In Dom
    If LCase(Obj.Name) = LCase(ObjectName) Then
        ObjectExists = True
        Exit For
    End If
Next
End Function