'################################################################################################################# '### Script, um User aus einer .csv 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/11/2012_01:03 ### '################################################################################################################# '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 HomePfad = "C:\Homedrives" 'In diesem Pfad des Servers werden die Freigaben für das HomeVerzeichnis erstellt LesePfad = "C:\AllgemeinerLeseZugriff" 'In diesem Pfad des Servers werden die Freigaben mit allgemeinen Leserechten erstellt HomeShare = "homeshare" 'Name der Freigabe, auf der die Homeverzeichnisse gespeichert werden. HomeDriveBuchstabe = "h:" LeseShare = "AllgemeinShare" 'Name der Freigabe mit Leserechten für alle! LeseDriveBuchstabe = "u:" Lehrer = "lehrer" 'Sicherheitsgruppe, in der die Lehrer Mitglieder sind -> diese erhalten erhöhte Rechte in den Shares DateiMitUserdaten = "meineUser.csv" 'in dieser Datei sind die anzulegenden User erfasst; 'diese Datei muss nach folgendem Schema aufgebaut sein: '[Anmerkung: als OU empfiehlt sich die in Schulen die Klassenbezeichnung oder der Jahrgang] 'username;OU 'Beispiel: 'Max.Mustermann;2012_13_1AK 'Maxima.Musterfrau;2012_13_2AK '... '### hier beginnt der Teil, der eher nur noch von Auskennern angefasst werden sollte ;-) ## 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, ",", ".") Informationen = "Benutzername;Klasse;Passwort" & vbCrLf Randomize Set myFile = objfs.OpenTextFile(DateiMitUserdaten, 1, true) Do While not myfile.AtEndOfStream zeile = (myfile.ReadLine) tempArr = split(zeile,";") MUsername = tempArr(0) strOU = tempArr(1) GroupString = tempArr(1) 'erstellt eine neue OU If Not OUExists(strOU, "LDAP://" & DomainName) Then Set PrfOU = GetObject("LDAP://" & DomainName).Create("organizationalUnit", "ou=" & strOU) PrfOU.SetInfo Else Set PrfOU = GetObject("LDAP://" & "ou=" & strOU& "," & 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) ' Prüfung, ob Benutzer angelegt Do While ObjectExists(MUsername, "user", "WinNT://" & DomainString) And Not Abbruch Do MUsername = InputBox(_ "Die Bezeichnung " & tempArr(0) & " ist bereits vorhanden!" & vbCrLf & _ "Bitte geben Sie eine andere Bezeichnung oder ""exit"" für Abbruch ein!") Loop Until MUsername <> "" If LCase(MUsername) = "exit" Then Abbruch = True Loop If NOT Abbruch Then ' erstellt den Pfad für die Freigaben CreatePath HomePfad CreatePath LesePfad & "\" & strOU ' es werden die Freigaben erzeugt CreateShare HomeShare, HomePfad CreateShare LeseShare, LesePfad ' Grundlegende Rechte für Angabe- und Pruefungsordner setzen WshShell.Run "cmd /c echo j|cacls " & HomePfad & " /G Administratoren:F " & Lehrer & ":C " & GroupString & ":R", 0, 1 WshShell.Run "cmd /c echo j|cacls " & HomePfad & " /E /G " & GroupString & ":W", 0, 1 WshShell.Run "cmd /c echo j|cacls " & LesePfad & " /G Administratoren:F " & Lehrer & ":C " & GroupString & ":R", 0, 1 WshShell.Run "cmd /c echo j|cacls " & LesePfad & "\" & StrOU & " /G Administratoren:F " & Lehrer & ":C ", 0, 1 ' loginscript schreiben LoginScriptName = StrOU & ".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 " & LeseDriveBuchstabe & " \\" & ServerName & "\" & LeseShare & "\" & strOU objTextStream.Close ' die Verzeichnisse für die SchülerInnen werden erstellt; CreatePath "\\" & ServerName & "\" & HomeShare & "\" & StrlOU & "\" & MUsername ' die User werden nun im AD angelegt 'Passwort = "Passwort" & i & "-" & Int(10000 * rnd + 1) Passwort = Kennwort(10) Set usr = PrfOU.Create("user", "CN=" & MUsername) usr.Put "samAccountName", MUsername usr.Put "userPrincipalName", MUsername & "@" & DomainString usr.Put "homeDirectory", "\\" & ServerName & "\" & HomeShare & "\" & StrOU & "\" & MUsername usr.Put "homeDrive", HomeDriveBuchstabe usr.Put "scriptPath", LoginScript usr.SetInfo usr.SetPassword Passwort usr.AccountDisabled = False usr.SetInfo WScript.Sleep (1000) Informationen = Informationen & vbCrLf & MUsername & ";" & strOU & ";" & 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 & "\" & HomeShare & "\" & strOU & "\" & MUsername & " /G " & PermL1 , 0, 1 WshShell.Run "cmd /c echo j|cacls \\" & ServerName & "\" & HomeShare & "\" & strOU & "\" & MUsername & " /E /G " & PermL2 , 0, 1 WshShell.Run "cmd /c echo j|cacls \\" & ServerName & "\" & LeseShare & "\" & strOU & " /E /G " & PermA , 0, 1 WScript.Sleep (1000) end if Loop ' die csv mit den Usern und Passwörtern wird erstellt strDateiname = "Usernames_und_passwoerter.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