VBS Skript zum Ändern mehrwertiger Active Directory Anzeige Specifier

Question

Nach dem Howto Extending the Active Directory Schema To Track Custom Info Ich bin in der Lage, ein Single-Value-Schema-Attribut, das leicht über ein Kontextmenü in ADUC änderbar ist. Mehrwertige Schemaattribute werden erheblich komplizierter. Sagen Sie (um des Arguments willen) ist mein Wert "Projekte" und jeder Benutzer kann eine Liste so vieler Projekte wie nötig sein.

folgt ein trauriges kleines Skript, das Projekt auf einen einzigen Wert gesetzt wird:

Dim oproject 
Dim oUser1 
Dim temp1 
Set oproject = Wscript.Arguments 
Set oUser1 = GetObject(oproject(0)) 
temp1 = InputBox("Project: " & oUser1.project & vbCRLF & vbCRLF & "Project") 
if temp1 <> "" then oUser1.Put "project",temp1 
oUser1.SetInfo 
Set oUser1 = Nothing 
Set oproject = Nothing 
Set temp1 = Nothing 
WScript.Quit 

Wie kann ich ändern, um dies zu ermöglichen, zuweisen und mehrere Werte ändern?

Answer 1

Ich gab eine elegante Benutzeroberfläche auf und ging einfach mit der Semikolon-Liste. Hier ist der Code, wenn jemand interessiert:

Dim objProject 
Dim objUser 
Dim temp1, title, message, default 
Dim projects 
title = "Projects" 

Set objProject = Wscript.Arguments 
Set objUser = GetObject(objProject(0)) 

'Find our current projects 
projects = objUser.projects 
If Not isArray(projects) Then 
    projects = Array(projects) 
End If 

'Setup our message box 
message = "Semicolon-delimited list of Projects" 
default = arrayToStr(projects) 
temp1 = InputBox(message, title, default) 

'catch cancels 
if IsEmpty(temp1) Then 
    WScript.Quit 
End If 

' update our data 
projects = strToArray(temp1) 
objUser.Put "projects",projects 
objUser.SetInfo 

'Clean up and quit 
Set projects = Nothing 
Set objUser = Nothing 
Set objProject = Nothing 
Set temp1 = Nothing 
Set title = Nothing 
Set message = Nothing 
Set default = Nothing 
WScript.Quit 

'Functions 
Function strToArray(s) 
    Dim a 
    Dim token 

    ' discard blank entries 
    For Each token in split(s, ";") 
     token = trim(token) 
     If token <> "" Then 
      If isEmpty(a) Then 
       a = token 
      Else 
       a = a & ";" & token 
      End If 
     End If 
    Next 

    ' return array 
    strToArray = split(a, ";") 
End Function 
Function arrayToStr(a) 
    Dim s 
    Dim token 

    For Each token in a 
     If isEmpty(s) Then 
      s = token 
     Else 
      s = s & ";" & token 
     End If 
    Next 

    ' return string 
    arrayToStr = s 
End Function