' Im Endausbau soll das Skript eine Liste von zu pflegenden NKZ aus
' einer Datei "lokaleNutzer.txt" lesen, dann aus einer Datei
' "Nutzer.txt" die Einträge der entsprechenden NKZ zu suchen und mit
' dem aktuellen Bestand vergleichen. Bei bereits vorhandenen ggf. ein
' Update vornehmen, bei neuen diese Nutzer anlegen.
' Zur Findung bereits vorhandener NKZ wird die Funktion "FindAccount"
' genutzt.
' Die Prozedur zum Anlegen heisst "BenutzerAnlegen", welche den Nutzer
' mit den Attributen aus der Nutzer-Datei anlegt.
' Die Prozedur zum Updaten "BenutzerAktualisieren" vergleicht erst den
' aktuellen ObjektDN mit dem vorgegebenen und verschiebt ggf. das
' Objekt mittels "MoveObject". Danach werden die gegebenen Attribute
' verglichen und ebenfalls ggf. aktualisiert.


Const ADS_UF_PASSWD_CANT_CHANGE = &H40
Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
Const ADS_UF_USE_DES_KEY_ONLY = &H200000

Const DOMAIN = "DC=ad,DC=spielwiese,DC=netz"
Const NUTZER = "Nutzer.txt"
Const LOKNUTZER = "lokaleNutzer.txt"

Dim fso1, fso2, f1, f2, Zeile, Feld, User, objSuch
Set fso1 = CreateObject("Scripting.FileSystemObject")
Set f1 = fso1.OpenTextFile (NUTZER,1,0)
Set fso2 = CreateObject("Scripting.FileSystemObject")
Set f2 = fso2.OpenTextFile (LOKNUTZER,1,0)

Do while not f2.AtEndOfLine
	User = f2.readLine
Loop
f2.Close


Do while not f1.AtEndOfLine
Zeile = f1.readLine
Feld = split(Zeile,":")
NKZ = Feld(0)
If (InStr(User,NKZ) Or User = "all") Then
	Nachname = Feld(1)
	Vorname = Feld(2)
	Titel = Feld(3)
	Struktur = Feld(4)
	Mail = Feld(5)
	Telefon = Feld(6)
	Fax = Feld(7)
	Raum = Feld(8)
	Gruppe = Feld(9)
	Set objSuch = FindAccount(NKZ)
	If TypeName(objSuch) = "Object" Then
		wscript.echo NKZ + " -- gefunden"
		Call BenutzerAktualisieren(NKZ,Nachname,Vorname,Titel,Struktur,Mail,Telefon,Fax,Raum,Gruppe,objSuch)
	Else
		wscript.echo NKZ + " -- nicht gefunden"
		Call BenutzerAnlegen(NKZ,Nachname,Vorname,Titel,Struktur,Mail,Telefon,Fax,Raum,Gruppe)
	End If
End If
Loop
f1.Close
Wscript.Quit(0)

Sub BenutzerAktualisieren(NKZ,Nachname,Vorname,Titel,Struktur,Mail,Telefon,Fax,Raum,Gruppe,aktObject)
Dim ouo, objKonto

ArrGroup = split(Gruppe,"_")
Anzahl = UBound(ArrGroup) - LBound(ArrGroup)
sOU=""
For i = Anzahl to 0 step -1
	sOU=sOU + "OU=" + ArrGroup(i) + ","
Next
sOU = sOU + DOMAIN
fdn = "CN=" + NKZ + "," + sOU
If fdn <> aktObject.distinguishedname Then
	call MoveObject(aktObject.distinguishedname, sOU)
	Set aktObject = GetObject("LDAP://" & fdn)
End If
if aktObject.givenName <> Vorname Then
	aktObject.Put "givenName", Vorname
	aktObject.Put "displayName", Vorname & " " & Nachname
	aktObject.Put "description", Vorname & " " & Nachname
End If
if aktObject.sn <> Nachname Then
	aktObject.Put "sn", Nachname
	aktObject.Put "displayName", Vorname & " " & Nachname
	aktObject.Put "description", Vorname & " " & Nachname
End If
if aktObject.title <> Titel Then
	if len(Titel) <> 0 Then
		aktObject.Put "title", Titel
	Else
		aktObject.Put "title", CStr(" ")
	End If
End If
if aktObject.department <> Struktur Then
	if len(Struktur) <> 0 Then
		aktObject.Put "department", Struktur
	Else
		aktObject.Put "department", CStr(" ")
	End If
End If
if aktObject.mail <> Mail Then
	if len(Mail) <> 0 Then
		aktObject.Put "mail", Mail
	Else
		aktObject.Put "mail", CStr(" ")
	End If
End If
if aktObject.telephoneNumber <> Telefon Then
	if len(Telefon) <> 0 Then
		aktObject.Put "telephoneNumber", Telefon
	Else
		aktObject.Put "telephoneNumber", CStr(" ")
	End If
End If
if aktObject.facsimileTelephoneNumber <> Fax Then
	if len(Fax) <> 0 Then
		aktObject.Put "facsimileTelephoneNumber", Fax
	Else
		aktObject.Put "facsimileTelephoneNumber", CStr(" ")
	End If
End If
if aktObject.physicalDeliveryOfficeName <> Raum Then
	if len(Raum) <> 0 Then
		aktObject.Put "physicalDeliveryOfficeName", Raum
	Else
		aktObject.Put "physicalDeliveryOfficeName", CStr(" ")
	End If
End If
aktObject.SetInfo

End Sub


Sub BenutzerAnlegen(NKZ,Nachname,Vorname,Titel,Struktur,Mail,Telefon,Fax,Raum,Gruppe)
Dim ouo, objKonto 

ArrGroup = split(Gruppe,"_")
Anzahl = UBound(ArrGroup) - LBound(ArrGroup)
sOU=""
For i = Anzahl to 0 step -1
	sOU=sOU + "OU=" + ArrGroup(i) + ","
Next
sOU="LDAP://" + sOU + DOMAIN
wscript.echo sOU
Set ouo = GetObject(sOU)
Set objKonto = ouo.Create("user", "CN="+NKZ)
With objKonto
	.Put "sAMAccountName", NKZ
	.Put "name", NKZ
	.Put "displayName", Vorname & " " & Nachname
	.Put "description", Vorname & " " & Nachname
	.Put "givenName", Vorname
	.Put "sn", Nachname
	If len(Titel) <> 0 then
		.Put "title", Titel
	End If
	If len(Struktur) <> 0 then
		.Put "department", Struktur
	End If
	If len(Mail) <> 0 then
		.Put "mail", Mail
	End If
	If len(Telefon) <> 0 then
		.Put "telephoneNumber", Telefon
	End If
	If len(Fax) <> 0 then
		.Put "facsimileTelephoneNumber", Fax
	End If
	If len(Raum) <> 0 then
		.Put "physicalDeliveryOfficeName", Raum
	End If
	.Put "altSecurityIdentities", "KERBEROS:" & NKZ & "@SPIELWIESE.NETZ"
	.Put "userPrincipalName", NKZ & "@ad.spielwiese.netz"
	.Put "profilePath", "\\Server\daten\profile\" & NKZ
	.Put "homeDirectory", "\\Server\daten\home\" & NKZ
	.Put "homeDrive", "H:"
'	.Put "streetAddress", "Straße der Nationen 62"
'	.Put "postalCode", "09107"
'	.Put "l", "Chemnitz"
'	.Put "c", "DE"
'	.Put "co", "Deutschland"
'	.Put "st", "Sachsen"
'	.Put "company", "TU Chemnitz"
'	.Put "userAccountControl", 66082
	.SetInfo
End With

With objKonto
	.SetPassword "EggatPwd_123." 'Hier sollte noch ein Passwortgenerator rein!
	.AccountDisabled = False
	.SetInfo
End With

With objKonto
	flag = .Get("userAccountControl")
	setflag = ADS_UF_PASSWD_CANT_CHANGE + ADS_UF_DONT_EXPIRE_PASSWD + ADS_UF_USE_DES_KEY_ONLY
	If (flag AND setflag) = 0 Then
		.Put "userAccountControl", flag OR setflag
		.SetInfo
	End If
End With
End Sub

Function FindAccount(ByVal strName)
	path = "LDAP://" + DOMAIN
	sql = "SELECT ADsPath FROM '" & path & "'WHERE objectClass='User' and name ='" & strName & "'"

	Set objconn = CreateObject("ADODB.Connection")
	Set objcomm = CreateObject("ADODB.Command")
	objconn.Provider = "ADsDSOObject"
	objconn.open = "Active Directory Provider"

	Set objcomm.ActiveConnection = objconn

	objcomm.CommandText = sql
	'objcomm.Properties("PageSize") = 50
	objcomm.Properties("Searchscope") = 2

	Set rs = objcomm.Execute

	If rs.eof Then
		Set FindAccount = Nothing
	Else
		Set FindAccount = GetObject(rs("ADsPath"))
	End If
End Function

Sub MoveObject(DNToMove, DNDestination)
	Dim oContainer
	Set oContainer = GetObject("LDAP://" & DNDestination)
	oContainer.MoveHere "LDAP://" & DNToMove, vbNullString
End Sub