VB Script anpassen - AD Adressbearbeitung

  • VBScript

    VB Script anpassen - AD Adressbearbeitung

    Guten Tag zusammen,

    ich habe an diesen Post einmal das Script angehangen um welches es geht.

    Ich wollte gerne das die Zeile Position eine Mehrspaltige Zeile ist. Die Zeile wird sich auf das AD-Feld Beschreibung beziehen.

    Habt ihr vllt eine Idee wie man das umsetzen kann?

    Vielen Dank im voraus.

    Marco Werkmeister

    Quellcode

    1. <HTML>
    2. <HEAD>
    3. <LINK REL="stylesheet" type="text/css" href="styles.css">
    4. <TITLE></TITLE>
    5. <META NAME="author" CONTENT="Marco Werkmeister">
    6. <META HTTP-EQUIV="MSThemeCompatible" CONTENT="Yes">
    7. <HTA:APPLICATION ID="oHTA"
    8. APPLICATIONNAME="Adressbearbeitung"
    9. CAPTION="yes"
    10. ICON="rgb.jpg"
    11. >
    13. </HEAD>
    14. <BODY onload="beschriften();" application="yes">
    15. <img src="rgb.jpg">
    16. <H2 id="head"></H2>
    18. <FORM name = "SearchForm" onsubmit="suche();">
    19. <table>
    20. <TR>
    21. <TD width="150px" id="lQuelle">[B]enutzer:</TD>
    22. <TD id="lUser"><INPUT type="text" name="fuser" size="70" accesskey="b">
    23. <BUTTON onclick="suche()" accesskey="f"><SPAN class="symb">$</SPAN> Benutzer [f]inden</BUTTON>
    24. </TD>
    25. </TR>
    26. <tr>
    27. <td colspan="2"><P id="ergebnis"></P>
    28. <hr />
    29. </td>
    30. </tr>
    31. </TABLE>
    32. </FORM>
    33. <form name="AddressForm">
    34. <div id="formUserData">
    35. </div>
    36. <div id="saveButton"></div>
    37. <button onclick="location.reload();"><SPAN class="symb">û</SPAN> Abbrechen</button>
    38. </form>
    39. <BR clear="all">
    40. <HR>
    42. <SCRIPT language="VBScript">
    44. '''''''''''''''''''''''''''''''''''''''''''''
    45. ' KUKA-Adressbearbeitung: Applikation zum Bearbeiten von Adressdaten in AD
    46. ' Version 1.0 vom 04.03.2015
    47. ' Änderung:
    48. '
    49. ' Von Marco Werkmeister
    50. '
    51. ' Keine Gewähr! Nutzung auf eigene Gefahr!
    52. '
    53. '''''''''''''''''''''''''''''''''''''''''''''
    55. titel = "Adressbearbeitung 1.0"
    57. ' ***** Feldnamen für die Oberfläche
    59. ' Anzahl der Felder (minus 1) in der ersten Dimension angeben
    60. Dim arrFeld(6,1)
    62. ' Feldnamen definieren
    63. ' Format:
    64. ' x, 0: LDAP-Feldname in AD
    65. ' x, 1: Anzeigename für den Benutzer
    66. arrFeld(0, 0) = "initials"
    67. arrFeld(0, 1) = "Vollmachtszusatz"
    69. arrFeld(1, 0) = "description"
    70. arrFeld(1, 1) = "Position"
    72. arrFeld(2, 0) = "physicalDeliveryOfficeName"
    73. arrFeld(2, 1) = "Gebäude/Stockwerk"
    75. arrFeld(3, 0) = "department"
    76. arrFeld(3, 1) = "Abteilung"
    78. arrFeld(4, 0) = "telephoneNumber"
    79. arrFeld(4, 1) = "Rufnummer"
    81. arrFeld(5, 0) = "facsimileTelephoneNumber"
    82. arrFeld(5, 1) = "Fax"
    84. arrFeld(6, 0) = "mobile"
    85. arrFeld(6, 1) = "Mobilnummer"
    87. ' **** Ende Feldnamen
    89. Const ADS_PROPERTY_CLEAR = 1
    90. Const ADS_PROPERTY_APPEND = 3
    92. ' Globale Variablen und Objekte
    93. Dim objRS
    94. Dim objConn
    95. Dim dictChanges
    97. ' Dictionary-Objekt, das die geänderten Daten hält
    98. Set dictChanges = CreateObject("Scripting.Dictionary")
    100. Sub suche()
    101. strANRString = document.SearchForm.fuser.value
    102. document.all.ergebnis.innerHTML = ""
    103. If strANRString = "" Then
    104. showItems "Kein Suchtext angegeben!"
    105. Exit Sub
    106. End If
    108. ' Domäne ansprechen
    109. On Error Resume Next
    110. Set objRoot = GetObject("LDAP://rootDSE")
    111. strDomainName = objRoot.Get("DefaultNamingContext")
    112. ' Set objDomain = GetObject("LDAP://" & strDomainName)
    113. If checkit("Keine Domäne ansprechbar!") Then
    114. Exit Sub
    115. End If
    117. On Error Goto 0
    119. strSQL = "SELECT AdsPath, displayName, sAMAccountName, mail FROM 'LDAP://" _
    120. & strDomainName & "' WHERE anr='" _
    121. & strANRString & "' AND objectClass='user' AND objectCategory='person'"
    123. 'Create ADO connection object for Active Directory
    124. Set Con = CreateObject("ADODB.Connection")
    125. Con.Provider = "ADsDSOObject"
    126. Con.Open "Active Directory Provider"
    127. If checkit("Fehler bei ADO-Connection!") Then
    128. Exit Sub
    129. End If
    131. 'Create ADO command object for the connection.
    132. Set ocommand = CreateObject("ADODB.Command")
    133. ocommand.ActiveConnection = Con
    134. If checkit("Fehler bei ADO-Command!") Then
    135. Exit Sub
    136. End If
    138. 'Assemble the commandtext.
    139. ocommand.CommandText = strSQL
    141. 'Execute the query.
    142. Set objRS = ocommand.Execute
    143. If checkit("Fehler bei SQL-Kommando!") Then
    144. Exit Sub
    145. End If
    146. On Error Goto 0
    148. intNumDisplay = 0
    149. intCount = 0
    150. displayResult objRS, 100, 100
    152. End Sub
    154. Sub displayResult(rs, intMaxLines, intMaxChars)
    155. ' Funktion:
    156. ' Eingabeparameter:
    157. ' Kommentar:
    159. document.all.ergebnis.innerHTML = ""
    160. intCount = rs.RecordCount
    161. Select Case intCount
    162. Case 0 showItems "Kein Eintrag entspricht dem Suchbegriff."
    163. Case 1 showItems "1 Eintrag entspricht dem Suchbegriff."
    164. Case Else showItems intCount & " Einträge entsprechen dem Suchbegriff."
    165. End Select
    167. On Error Resume Next
    169. intCount = 0
    171. ' Navigate the record set
    172. strText = strText & "<TABLE border=""0""><TR>"
    173. For Each feld In rs.fields
    174. If feld.Name <> "AdsPath" Then
    175. strText = strText & "<TD valign=""top""><B>" & feld.name & "</B></TD>"
    176. End If
    177. Next
    178. strText = strText & "<TD>&nbsp;</TD>"
    180. If rs.EOF Then
    181. strText = strText & "</TR><TR><TD colspan=""" & rs.fields.count+1 & """><I>Keine Benutzer gefunden.</I>"
    182. End If
    184. While (Not rs.EOF) And (intCount < intMaxLines)
    185. intCount = intCount + 1
    186. strText = strText & "</TR><TR class=""row" & intCount Mod 2 & """>"
    187. For i = 0 To rs.Fields.Count - 1
    188. If rs.Fields(i).Name <> "AdsPath" Then
    189. strText = strText & "<TD valign=""top"">"
    190. If (IsNull(rs.Fields(i).Value)) Then
    191. strValue = "<I>(leer)</I>"
    192. ElseIf rs.Fields(i).type = 128 Or rs.Fields(i).type = 204 Or rs.Fields(i).type = 205 Then
    193. strValue = "<I>binär</I>"
    194. Else
    195. wert = rs.Fields(i).Value
    196. strValue = CStr(wert)
    197. if len(strValue) > intMaxChars then strValue = Left(strValue, intMaxChars) & "<I>(...)</I>"
    198. End If
    199. strText = strText & Trim(strValue)
    200. strText = strText & "</TD>"
    201. End If
    202. Next
    203. ' adsPath maskieren, um JavaScript-Übergabe zu ermöglichen
    204. strAdsPath = Replace(objRS.Fields("AdsPath").Value, "\", "\\")
    205. strText = strText & "<TD><BUTTON onclick=""selectUser('" & strAdsPath _
    206. & "');"">Benutzer auswählen</BUTTON></TD>"
    207. rs.MoveNext
    209. If checkit("Fehler bei Verarbeitung des Recordsets, Zeile: " & intCount) Then
    210. Exit Sub
    211. End If
    213. Wend
    215. strText = strText & "</TR></TABLE>"
    217. showItems strText
    219. if not(intCount < intMaxLines) then showItems "<I>Ausgabe bei " & intMaxLines & " Zeilen abgebrochen.</I><BR>"
    221. On Error Goto 0
    223. End Sub
    225. Sub showItems(strText)
    226. ' Funktion: Ausgabe der Ergebnisse
    227. ' Eingabeparameter:
    228. ' Kommentar:
    230. document.all.ergebnis.innerHTML = document.all.ergebnis.innerHTML & strText
    232. End Sub
    234. Sub selectUser(strUserDN)
    235. Set objUser = GetObject(strUserDN)
    236. objUser.GetInfo
    237. strDisplayname = objUser.displayName
    238. strgivenName = objUser.givenName
    239. strsn = objUser.sn
    240. strmail = objUser.mail
    241. strcompany = objUser.company
    242. strstreetAddress = objUser.streetAddress
    243. strpostalCode = objUser.postalCode
    244. strl = objUser.l
    245. strwwwHomePage = objUser.wwwHomePage
    247. document.all.ergebnis.innerHTML = ""
    248. document.SearchForm.fuser.value = ""
    249. showItems "<br>"
    250. showItems "<B>Gewählter Benutzer: </B><br>"
    251. showItems "" & strsn & "<br>"
    252. showItems "" & strgivenName & "<br>"
    253. showItems "" & strmail & "<br>"
    254. showItems "" & strcompany & "<br>"
    255. showItems "" & strstreetAddress & "<br>"
    256. showItems "" & strpostalCode & "<br>"
    257. showItems "" & strl & "<br>"
    258. showItems "" & strwwwHomePage & "<br>"
    259. ErzeugeFelder(objUser)
    261. End Sub
    263. Sub ErzeugeFelder(objUser)
    264. strFelderCode = "<TABLE>"
    265. For i = 0 To UBound(arrFeld)
    266. ' Felder können leer sein, daher Fehler abfangen
    267. On Error Resume Next
    268. strData = ""
    269. strData = objUser.get(arrFeld(i, 0))
    270. strAdsPath = Replace(objUser.AdsPath, "\", "\\")
    271. On Error Goto 0
    273. strFelderCode = strFelderCode & "<TR><TD width=""150px"">" _
    274. & arrFeld(i, 1) & ":</TD><TD>"
    276. strFelderCode = strFelderCode & "<INPUT type=""text"" id=""f" _
    277. & arrFeld(i, 0) & """ size=""70"" value=""" & strData _
    278. & """ onchange=""changeValue('f" &arrFeld(i, 0) & "');"">"
    280. strFelderCode = strFelderCode & "</TD></TR>"
    281. Next
    282. strFelderCode = strFelderCode & "</TABLE>"
    283. document.all.formUserData.innerHTML = strFelderCode
    284. document.all.saveButton.innerHTML = "<button onclick=""speichereDaten('" _
    285. & strAdsPath & "');"" accesskey=""s""><SPAN class=""symb"">ü</SPAN> Änderungen [s]peichern!</button>"
    286. End Sub
    288. Sub changeValue(strFeldID)
    289. document.getElementById(strFeldID).className = "changed"
    290. strNewData = document.getElementById(strFeldID).value
    291. strFeldName = Mid(strFeldID, 2)
    293. ' Änderungen in Dictionary aufzeichnen
    294. If dictChanges.Exists(strFeldName) Then
    295. dictChanges.Remove strFeldName
    296. End If
    297. dictChanges.Add strFeldName, strNewData
    299. End Sub
    301. Sub speichereDaten(strDN)
    302. If dictChanges.Count = 0 Then
    303. MsgBox "Keine Änderungen vorhanden, die gespeichert werden können.", vbOKOnly + vbCritical, titel
    304. Exit Sub
    305. End If
    307. Set objUser = GetObject(strDN)
    308. strSAMName = objUser.sAMAccountName
    310. ' Änderungen durchführen
    311. On Error Resume Next
    312. For Each key In dictChanges.Keys
    313. If dictChanges.Item(key) <> "" Then
    314. objUser.Put key, dictChanges.Item(key)
    315. Else
    316. objUser.PutEx ADS_PROPERTY_CLEAR, key, vbNullString
    317. End If
    318. checkit "Fehler bei " & key & "!"
    319. Next
    320. objUser.SetInfo
    321. If checkit("Fehler beim Schreiben der Eigenschaften!") Then
    322. Exit Sub
    323. Else
    324. strMsg = "Änderungen erfolgreich geschrieben." & VbCrLf
    325. End If
    326. On Error Goto 0
    328. ' Oberfläche zurücksetzen
    329. For Each key In dictChanges.Keys
    330. document.getElementById("f" & key).className = ""
    331. Next
    333. ' Änderungs-Collection löschen
    334. For Each key In dictChanges.Keys
    335. dictChanges.Remove(key)
    336. Next
    337. MsgBox strMsg, vbOKOnly + vbInformation, titel
    339. End Sub
    341. Sub beschriften()
    342. parent.document.title = titel
    343. document.all.head.innerText = titel
    344. End Sub
    346. ' Fehlerprüfung
    347. Function checkit(Nachricht)
    348. checkit = False
    349. If Err.number <>0 Then
    350. Nachricht = Nachricht & " [" & Err.description & " (" & Err.number & ")]"
    351. MsgBox Nachricht, vbOKOnly+vbCritical, titel & ": Fehler!"
    352. Err.clear
    353. checkit=True
    354. End If
    356. End Function
    358. </SCRIPT>
    360. </BODY>
    361. </HTML>
    Bilder

    • Adressbuch.PNG

      53,62 kB, 1.189×709, 145 mal angesehen
    Dateien