Edi Pfisterer – Schulnetz.info

Es ist durchaus üblich, dass das Home Directory und der Username in einer Windows Active Directory Domäne ident sind.

Dies kann man dazu nützen, dass man die Berechtigungen automatisiert für diese Ordner neu setzt.

[Das Script hab ich schnell zusammengebastelt/googelt, weil ich bei einem Kunden eine Struktur vorgefunden habe, die dadurch zu einer Katastrophe wurde, dass einerseits Berechtigungen vererbt wurden, andererseits JEDER Vollzugriff hatte und dergleichen mehr...]

Verwendung:
als ChangeBerechtigungen.vbs speichern und dann aus einer command-shell heraus wie folgt starten:

cscript ChangeBerechtigungen.vbs /scharf:[no/yes] /Userordner:\\server\share\home$

Der Flag /scharf lässt einen das Script ohne echte Aktivität einmal ausprobieren…

Was passiert während der Abarbeitung:
es wird für jeden Ordner im angegebenen Userordner geprüft, ob es einen User im AD gibt, der den selben Namen trägt.
Wenn ein User existiert,
- übernimmt die Gruppe der Administratoren den Besitz
- erhält die Gruppe der Administratoren Vollzugriff, der betreffende User darf Ändern
- der betreffende User wird neuer Besitzer des Ordners
Dies alles wird nach unten hin vererbt, sodass danach die Rechte auf den entsprechenden Ordner und alle Unterordner wieder passen sollten.

Ich habe das Script soeben mit 800 Usern getestet und bin ziemlich happy

WICHTIG: Das Script wurde nur unter Windows 7 getestet!!! Ich kann nicht versprechen, ob es auf einem anderen OS läuft!

warntext = warntext & "Dieses Tool verändert den Besitzer von Ordnern und Dateien!" & vbcrlf
warntext = warntext & "Funktionsweise: Es wird für jeden Ordner und Unterordner im Active Directory ""nachgesehen"", ob es einen User" & vbcrlf
warntext = warntext & "mit dem selben Namen gibt!" & vbcrlf
warntext = warntext & "Wenn es eine Übereinstimmung gibt, so wird bei alle Dateien sowie Ordnern in diesem Verzeichnis der Besitzer geändert" & vbcrlf
warntext = warntext & "" & vbcrlf
warntext = warntext & "ACHTUNG! Es werden aktuell hier nur die Ordner aufgelistet." & vbcrlf
warntext = warntext & "Um in den Ordnern die Besitzer tatsächlich zu ändern (nachdem alles kontrolliert wurde), MUSS dieses Script " & vbcrlf
warntext = warntext & "aus einer Commandshell heraus mit wie folgt gestartet werden:" & vbcrlf & vbcrlf  & vbcrlf
warntext = warntext & "BerechtigungenReparieren.exe /scharf:YES /Userordner:H:\meineHomeverzeichnisse\Schueler" & vbcrlf & vbcrlf  & vbcrlf
warntext = warntext & "[wobei H:\meineHomeverzeichnisse\Schueler natürlich für den zu verändernden Ordner steht!!!]" & vbcrlf  
warntext = warntext & "[Tipp: wenn Ordner Leerzeichen haben, dann den Ordnername zwischen zwei "" sezten]" & vbcrlf 
warntext = warntext & "[Tipp2: das Tool funktioniert auch mit Freigaben, also zB \\meinServer\home$\schueler]" & vbcrlf & vbcrlf & vbcrlf
warntext = warntext & "Chefmodus: (Experts only)" & vbcrlf
warntext = warntext & "unten abgebildeten Quellcode mit dem Notepad als BerechtigungenReparieren.vbs speichern und folgendes ändern:" &vbcrlf
warntext = warntext & "in der Zeile mit dem Quelltext //   ' Modus = ""yes""  // muss lediglich das Hochkomma am Beginn gelöscht werden" & vbcrlf
warntext = warntext & "dann kann das Script auch per Doppelklick SCHARF gestartet werden!" & vbcrlf
warntext = warntext & "jetzt wird durch jeden DOPPELKLICK auf diese Datei BerechtigungenReparieren.vbs im jeweiligen Ordner und Unterordner die Berechtigungen geändert!" & vbcrlf & vbcrlf
warntext = warntext & "ACHTUNG: Es wird keine Haftung für etwaige Schäden übernommen!!! Also VORSICHT bei der Verwendung" & vbcrlf & vbcrlf
warntext = warntext & "[Feedback an Edi Pfisterer --> edi@schulnetz.info --> www.schulnetz.info]" & vbcrlf & vbCrLf  & vbcrlf & vbCrLf

Set objFSO = CreateObject("Scripting.FileSystemObject")

dateiname = "Berechtigungsänderungen.txt"

ueberordner = WScript.Arguments.Named.Item("Userordner")
         if len(ueberordner)= 0 then
                  scriptname = Wscript.ScriptFullName
                  ueberordner = objFSO.getparentfoldername(scriptname)
         end if
warntext = warntext & "Aktuelles Verzeichnis: " & ueberordner & vbcrlf & vbcrlf
Modus = WScript.Arguments.Named.Item("scharf")

' Modus = "yes"

 call InDateiSchreiben(warntext)

                        Set objShell = CreateObject("WScript.Shell")
					    objShell.Popup "Es werden nun alle eventuell zu verändernden Ordner einzeln aufpoppen! " & vbcrlf & "Lesen Sie in der Datei Benutzerberechtigungen.txt, die soeben angelegt wurde nach, wie Sie dieses Tool ""scharfstellen""!" & vbcrlf & "Um diese Tool zu stoppen, müssen Sie im Taskmanager die Datei wscript.exe beenden!", 20, "Info"
					    Set objShell = Nothing

call Ordnerliste(ueberordner)

function Ordnerliste(pfad)

        Set objFolder = objFSO.GetFolder(pfad)
        Set colSubfolders = objFolder.Subfolders

        For Each objSubfolder in colSubfolders
      ' msgbox objSubfolder
              on Error resume next

                 vollername = objFSO.GetAbsolutePathName(objSubfolder)

                NT_Benutzer = UserNameIsolieren(vollername)
                if Benutzerabfrage(NT_Benutzer) = 1 THEN
                   if instr(1,modus,"yes",1) = 0 Then  'es wird lediglich eine txt erzeugt, Dateien bleiben unverändert
                        call InDateiSchreiben(vollername)
                        call InDateiSchreiben("USER GIBTS")
                      befehl1 = "icacls " & vollername & " /setowner Administratoren /t /c /l /q "
                      befehl2 = "cacls " & vollername & " /T /G Administratoren:F " & NT_Benutzer & ":C"
                      befehl3 = "icacls " & vollername & " /setowner " & NT_Benutzer & " /t /c /l /q "
                     InDateiSchreiben befehl1
					 InDateiSchreiben befehl2 
					 InDateiSchreiben befehl3

                   Else 

                      befehl1 = "icacls " & vollername & " /setowner Administratoren /t /c /l /q "
                      befehl2 = "cacls " & vollername & " /T /G Administratoren:F " & NT_Benutzer & ":C"
                      befehl3 = "icacls " & vollername & " /setowner " & NT_Benutzer & " /t /c /l /q "

' InDateiSchreiben befehl1
' InDateiSchreiben befehl2 
' InDateiSchreiben befehl3

                      Set objShell = CreateObject("WScript.Shell")
                      objShell.Run "%comspec% /c echo j|" & befehl1, 0, 1
wscript.sleep 10
                      objShell.Run "%comspec% /c echo j|" & befehl2, 0, 1
wscript.sleep 10
                      objShell.Run "%comspec% /c echo j|" & befehl3, 0, 1
wscript.sleep 10

                      call InDateiSchreiben(vollername & " wurde auf den neuen Besitzer " & NT_Benutzer & " geändert!" & vbcrlf)

					   ' Set objShell = CreateObject("WScript.Shell")
					   ' objShell.Popup vollername & " wurde auf den neuen Besitzer " & NT_Benutzer & " geändert!", 5, "Info"
					   ' Set objShell = Nothing

						objFSO.DeleteFile(vollername & "\desktop.ini")

					end If

                end if

         call Ordnerliste(vollername)
        Next

end function

function InDateiSchreiben(inhalt)
  set logbuch1 =objFSO.opentextfile(dateiname, 8, true,0)  ' 8 zum anfügen
                logbuch1.write inhalt & vbcrlf
                logbuch1.close
end function

function UserNameIsolieren(strUsername)
  letzterBackslash = instrRev(strUsername,"\")
  laenge = len(strUsername)
  eigentlicherUsername = right(strUsername, laenge-letzterBackslash)
  'call InDateiSchreiben(eigentlicherUsername)
  UserNameIsolieren = eigentlicherUsername
end function

function benutzerabfrage(strUserName)

		 Set rootDSE = GetObject("LDAP://RootDSE")
		DomainName = rootDSE.Get("defaultnamingcontext")   

		strObjectName = strUserName
		strObjectType = "user"  
		strRootSearch = DomainName    

		Set objConnection = CreateObject("ADODB.Connection")  
		objConnection.Open "Provider=ADsDSOObject;"    
		Set objCommand = CreateObject("ADODB.Command")  
		objCommand.ActiveConnection = objConnection    

		objCommand.CommandText = _      
		"<LDAP://" & strRootSearch & ">;(&(objectCategory=" & strObjectType & ")" & _      
		"(samAccountName=" & strObjectName & "));samAccountName,distinguishedName;subtree"    

		Set objRecordSet = objCommand.Execute    

		If objRecordset.RecordCount = 0 Then      

		benutzerabfrage = 0
		else
		benutzerabfrage = 1
		end if 

objConnection.Close 

end function

msgBox "Ich bin fertig!"

Script zur Automatisierung des Eintrags von Homedrives bei Active Directory Usern

1. Share auf neuen Ordner einrichten
2. Kopie der Daten mit
   (das Folgende ist als Vorschlag zu betrachten – bitte selbst die Flags prüfen…)
   xcopy quelle ziel /Y /O /H /F /I /C /S
3. oder
   Ordner mit Total-Commander auf den neuen Server kopieren (ACHTUNG: muss mit einem Benutzer [Domänen-Admin?] gemacht werden, der auch Leserechte auf den Ordnern besitzt
   (Kontrolle: Sicherheitseinstellungen auf den Homeshares der Benutzer…) 
   WICHTIG WICHTIG WICHTIG:
   Das Hakerl muss bei “NTFS-Berechtigungen kopieren” gesetzt sein!!!!!
4. Folgendes Script “HomeDirecotryChanger.vbs” über die Einträge im Active Directory laufen lassen, damit die User beim nächsten Login auch die richtigen Ordner gemappt bekommen…
   [ Script ist ein Sammelsurium aus Eigenem und Fremdem  - die "Ablage" hier dient lediglich dazu, dass ich es nicht selbst immer suchen muss, wenn ichs wieder brauche...]
   btw: man könnte das auch mit der Powershell erledigen…
5. Es gibt im Ordner ein schönes Logfile, mit dessen Hilfe man überprüfen kann, ob es bei manchen Usern Troubles gab (weil er zB bisher gar kein Homedrive eingetragen hatte oder ähnliches!)

'###########################################################################
'# Usage:
'#  als    homedirectorychanger.vbs      an beliebiger Stelle auf einem Client speichern
'#
'# Variablen, die geändert werden MÜSSEN
'# ACHTUNG: strOU ist in 'verkehrter' Reihenfolge, dh:
'# strOU = "OU=1A,OU=Schueler,OU=benutzer," steht für alle User,
'# die in der OU=TEST sind, die wiederum in der OU= Benutzer liegt
'# Hier findest Du zusätzliche Infos zu LDAP-Attributen:
'# http://www.computerperformance.co.uk/Logon/LDAP_attributes_active_directory.htm

strOU = "OU=benutzer,"   'ACHTUNG auf den Beistrich!!
OldServer = "hp-y"
MyNewServer = "idefix"
HomeDriveKey = "H:"

'# Ab hier nur mehr für Auskenner veränderbar...
'############################################################################
on error resume next
Dim rootDSE, domainObject
Set rootDSE = GetObject("LDAP://RootDSE")
domainContainer = rootDSE.Get("defaultNamingContext")
Set domainObject = GetObject("LDAP://" & strOU & domainContainer)

Set fs = CreateObject ("Scripting.FileSystemObject")
Set outFile = fs.CreateTextFile (".\logfile_ADKonten.txt")

exportUsers(domainObject)

Set oDomain = Nothing

Sub ExportUsers(oObject)
on error resume next
   Dim oUser
   For Each oUser in oObject
      Select Case oUser.Class
         Case "user"

			call changeHomeDirectory(oUser.distinguishedName, oUser.homeDirectory)

         Case "organizationalUnit" , "container"

			ExportUsers(oUser)
      End select
   Next
End Sub

sub changeHomeDirectory(myUser, myHomeDirectory)

On Error Resume Next
Err.Clear

	Set objUser = GetObject("LDAP://"& myUser)
	myNEWHomeDirectory = replace(myHomeDirectory, OldServer, MyNewServer, 1, -1, 1)
	wscript.sleep 10
	objUser.Put "homeDirectory", myNEWHomeDirectory
	wscript.sleep 10
	objUser.Put "homeDrive", HomeDriveKey
	wscript.sleep 10
	objUser.SetInfo
	wscript.sleep 20

	outfile.WriteLine  "Set objUser = GetObject(""LDAP://"& myUser &"," & strOU & domainContainer & CHR(34) & ")"
	outfile.WriteLine  "objUser.Put ""homeDirectory"", " & CHR(34) & myNEWHomeDirectory & CHR(34)
	outfile.WriteLine  "objUser.Put ""homeDrive"", " & CHR(34) & HomeDriveKey & CHR(34)
	if  Err.Number <> 0  then
       outfile.WriteLine   "Fehler: Error number: " & Err.Number & "    Error description: " & Err.Description
	end if

	outfile.WriteLine "_____"

end Sub
WScript.Quit
wscript.echo "Done"

• Die Benutzernamen werden aus einer .csv ausgelesen
• Falls ein Benutzer im AD bereits vorhanden ist, wird man zur Änderung des Namens aufgefordert
• Es wird am Domänencontroller bzw. im AD folgendes erstellt:
   
  • 2 Shares – eines als Homedrive, das zweite mit Leserechten für alle
  • für jede Abteilung / Schulklasse eine eigene OU (Organizational Unit)
  • eine Sicherheitsgruppe für jede Abteilung bzw. Schulklasse
  • ein 10stelliges, hochkomplexes Passwort wird generiert
  • ein Loginscript.bat im SYSVOL, welches die User zugewiesen bekommen
     
• jeder Benutzer wird im Active Directory in der entsprechenden OU angelegt
• Es werden die entsprechenden Sicherheitsberechtigungen auf den Ordnern erstellt
• Zusätzlich zu den Admins erhält eine weitere Gruppe (Chefabteilung,  Lehrer) erhöhten Zugriff auf die Ordner
• Es wird eine Datei mit allen Usernamen und Passwörtern generiert

• Das Skript in einen Ordner auf einem Domänencontroller speichern
• im selben Ordner eine Datei namens meineUser.csv anlegen
• die gewünschten User in die Datei meineUser.csv wie folgt schreiben:

• Anmerkung: während der Laufzeit erscheint keinerlei Meldung!
  Dies kann und wird – abhängig von der Useranzahl mehrere Minuten dauern!!!
  Ein Hinweis über die erfolgreiche Abarbeitung inkl. Anzahl der Benutzer erfolgt nach beendeter Arbeit!!!
   

• rechtlicher Hinweis: Die Verwendung des Tools erfolgt auf eigene Gefahr, ich übernehme KEINE HAFTUNG für Schäden jedweder Art!!!
   

[Save the user_via_csv_anlegen.vbs whereever you want on one of your Domain Controllers. Put a meineUser.csv in the same Directory, which has all your Users in it. They must be written in the following way:
username;OrganizationalUnit
Run the Script by dobbleclicking, wait some Minutes (there will be NO messages during the work, except, a Username is allready existing. After the Script has run through, you will see a Message on your screen, telling you the number of created Users - and you will find a file named password.csv in the Directory, where you saved the script. ]
Keep in mind: You run this Script on your own risk! I do NOT assume any liability!

Download:

• user_via_csv_anlegen.vbs [6234 x heruntergeladen]

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