Next: Umgebende Text-Dateien
Up: Visual Basic Skripte
Previous: Visual Basic Skripte
  Contents
Das Skript zur Datenübernahme
' 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"
.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
Marko Damaschke
2006-03-25