Скрипт, автоматически формирующий HTML-страницу телефонного справочника.
Данный скрипт автоматически строит HTML-страницу телефонного справочника из контактов AD. После отработки скрипта на выходе будет готовая HTML-страница в виде таблицы, которая имеет функцию поиска и сортировки по любому столбцу таблицы. Для этих 2х плюшек подключаются java, jquery и css. CSS удалось зашить в тело HTML, а вот java, jquery не удалось зашить, так как при исполнении vb-скрипта windows пытается исполнить эти скрипты.
Сама таблица имеет 9 столбцов наиболее информативных в территориально распределённых организациях. Вы, при желании можете изменить данный скрипт под любое другое количество информационных колонок.
Также скрипт производит небольшие манипуляции в данных, которые Вы сами можете проследить по коду программы.
Скрипт HTML_from_AD.vbs:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Создаем HTML-страницу телефонного справочника из контактов Active directory '
' Скрипт написал Анчуров Олег Владимирович в 2013 году. Версия 3. '
' Скрипт взят с сайта: http://ithelp.moy.su '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Option Explicit
on error resume next
Dim HTML, HHead, HCss, HJava, HFuter, strI, SE
HTML = ""
HHead = ""
HScc = ""
HJava = ""
HFuter = ""
strI = 1
SE = chr(13) + chr(10)
HHead = "<html>" + SE
HHead = HHead + "<head>" + SE
HHead = HHead + "<TITLE>Телефонный справочник сотрудников.</TITLE>" + SE
HHead = HHead + "<style> * { font-family:tahoma; font-size:11px;}</style>" + SE
HHead = HHead + "<p align=" + chr(34) + "center" + chr(34) +">" + SE
HHead = HHead + "<IMG src=" + chr(34)+"i/logo.gif" + chr(34) + "/IMG>" + SE
HHead = HHead + "</p>" + SE
HHead = HHead + "<p align=" + chr(34) + "center" + chr(34) +">" + SE
HHead = HHead + "Уважаемые сотрудники, данный телефонный справочник автоматический. Обновляется 1 раз в сутки. Поэтому, если Вы увидите какие-либо ошибки в контактных данных, то просто сообщите нам о них." + SE
HHead = HHead + "<BR>" + SE
HHead = HHead + "Внимание! Если вверху страницы повилась надпись, говорящая о том, что в целях безопасности InternetExplorer заблокировал некоторое активное содержимое, то просто нажмите на эту надпись и разрешите активное содержимое, тогда будет работать полнофункциональная сортировка в таблице." + SE
HHead = HHead + "<BR>" + SE
HHead = HHead + "Полезный совет: с помощью ролика мыши можно прокручивать содержимое страницы, а, если при этом удерживать клавишу Ctrl, то будет изменяться масштаб страницы!" + SE
HHead = HHead + "</p>" + SE
HCss = HCss + "<style type=" + chr(34) + "text/css" + chr(34) + ">" + SE
HCss = HCss + "table.sort{" + SE
HCss = HCss + "border-spacing:0.1em;" + SE
HCss = HCss + "margin-bottom:1em;" + SE
HCss = HCss + "margin-top:1em" + SE
HCss = HCss + "}" + SE
HCss = HCss + "table.sort td{" + SE
HCss = HCss + "border:0 solid #CCCCCC;" + SE
HCss = HCss + "padding:0.3em 1em" + SE
HCss = HCss + "}" + SE
HCss = HCss + "table.sort thead td{" + SE
HCss = HCss + "cursor:pointer;" + SE
HCss = HCss + "cursor:hand;" + SE
HCss = HCss + "font-weight:bold;" + SE
HCss = HCss + "text-align:center;" + SE
HCss = HCss + "vertical-align:middle" + SE
HCss = HCss + "}" + SE
HCss = HCss + "table.sort thead td.curcol{" + SE
HCss = HCss + "background-color:#999999;" + SE
HCss = HCss + "color:#FFFFFF" + SE
HCss = HCss + "}" + SE
HCss = HCss + "</style>" + SE
HJava = HJava + "<script type=" + chr(34) + "text/javascript" + chr(34) + " src=" + chr(34) + "Sort.js" + chr(34) + "></script>" + SE
HJava = HJava + "<script src=" + chr(34) + "jquery.min.js" + chr(34) + " type=" + chr(34) + "text/javascript" + chr(34) + "></script>" + SE
HJava = HJava + "<script src=" + chr(34) + "jquery.liveFilter.js" + chr(34) + " type=" + chr(34) + "text/javascript" + chr(34) + "></script>" + SE
HJava = HJava + "<script type=" + chr(34) + "text/javascript" + chr(34) + ">" + SE
HJava = HJava + " $(document).ready(function() {" + SE
HJava = HJava + " $('table.live_filter').liveFilter('fade');" + SE
HJava = HJava + " });" + SE
HJava = HJava + " $(document).ready(function() {" + SE
HJava = HJava + " $('ul.list_filter').liveFilter('slide');" + SE
HJava = HJava + " });" + SE
HJava = HJava + "</script>" + SE
Hhml = Html + "</Head>" + SE
html = html + "<body>" + SE
html = html + "<p>Фильтр поиска:" + SE
html = html + "<input class=" + chr(34) + "filter" + chr(34) + " type=" + chr(34) + "text" + chr(34) + " value=" + chr(34) + chr(34) + " name=" + chr(34) + "livefilter" + chr(34) + "></input></p>" + SE
html = html + "<p>Фильтр работает по всем столбцам таблицы! Внимание - в строке поиска не используйте пробелы!</p>" + SE
html = html + "<table border=" + chr(34) + "0" + chr(34) + "width=" + chr(34) + "100%" + chr(34) + " cellpadding=" + chr(34) + "11" + chr(34) + " class=" + chr(34) + "sort live_filter" + chr(34) + " align=" + chr(34) + "center" + chr(34)+">" + SE
html = html + "<CAPTION><H1>Телефонный справочник сотрудников.</H1></CAPTION>" + SE
html = html + "<thead>" + SE
html = html + "<tr BGCOLOR=#999900>" + SE
html = html + "<td>Имя сотрудника:</td>" + SE
html = html + "<td>Электронная почта:</td>" + SE
html = html + "<td>Телефон:</td>" + SE
html = html + "<td>Мобильный:</td>" + SE
html = html + "<td>Страна:</td>" + SE
html = html + "<td>Город:</td>" + SE
html = html + "<td>Организация:</td>" + SE
html = html + "<td>Отдел:</td>" + SE
html = html + "<td>Должность:</td>" + SE
html = html + "</tr>" + SE
html = html + "</thead>" + SE
html = html + "<tbody>" + SE
Dim objRootDSE, strDNSDomain, strBase
Dim adoCommand, adoConnection, objRS, strFilter, strAttributes, strQuery
Dim objExcel, strName, strPhone, strMail, strOtherphone, arrOtherPhone, strMobile, strCountry, strCity, strCompany, strDepartment, strTitle
Dim strGivenName, strSN, strDisplayName, strItem
Dim objRoot, objOU, objDomain, objContact, strYourDescription
Dim strDNS, strContainer, strContactName, strEmail
Dim strCon
Dim ext
ext = chr(160) & "ext" & chr(160)
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
strBase = "<LDAP://" & strDNSDomain & ">"
'strFilter = "(&(objectCategory=person)(objectClass=user)(|(useraccountControl=66048)(useraccountcontrol=512)))" 'Просмотр по пользователям
strFilter = "(&(objectCategory=person)(objectClass=contact))" 'Просмотр по контактам
strAttributes = "name,mail,telephoneNumber,otherTelephone,mobile,c,L,company,department,title,givenname,sn,displayname"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 500
adoCommand.Properties("Timeout") = 307
adoCommand.Properties("Cache Results") = False
Set objRS = adoCommand.Execute
While not objRS.EOF
strName = ext
strMail = ext
strPhone = ext
arrOtherPhone = ext
strMobile = ext
strCountry = ext
strCity = ext
strCompany = ext
strDepartment = ext
strTitle = ext
strGivenName = ext
strSN = ext
strDisplayName = ext
strName = objRS.Fields("name").Value
strName = Replace(strName," ",chr(160)) 'Заменяем обычный пробел на неразрывный
strMail = objRS.Fields("mail").value
strPhone = objRS.Fields("telephoneNumber").Value
strPhone = Replace(strPhone,"-","") 'Откидываем тире из телефона
strPhone = Replace(strPhone," ","") 'Откидываем пробелы из телефона
a = Left(strPhone,1)
if a = "8" then strPhone = "+7" + Mid(strPhone,2)
if a = "(" then strPhone = "+7" + strPhone
arrOtherPhone = objRS.Fields("otherTelephone").Value
strMobile = objRS.Fields("mobile").Value
strMobile = Replace(strMobile,"-","") 'Откидываем тире из телефона
strMobile = Replace(strMobile," ","") 'Откидываем пробелы из телефона
a = Left(strMobile,1)
if a = "8" then strMobile = "+7" + Mid(strMobile,2)
if a = "(" then strMobile = "+7" + strMobile
strCountry = objRS.Fields("c").Value
strCity = objRS.Fields("L").Value
strCompany = objRS.Fields("company").Value
strDepartment = objRS.Fields("department").Value
strDepartment = Replace(strDepartment,"Отдел","") 'Откидываем из названия отдела слово отдел,
strDepartment = Replace(strDepartment,"отдел","") 'так как оно присутствует в шапке таблицы!
strDepartment = Trim(strDepartment) 'Убираем пробелы вначале и вконце названия отдела.
strDepartment = uCase(Left(strDepartment,1)) + Mid(strDepartment,2) 'Делаем первую букву в названии заглавной, остальные оставляем без изменения.
strTitle = objRS.Fields("title").Value
strGivenName = objRS.Fields("givenname").Value
strGivenName = Replace(strName," ",chr(160)) 'Заменяем обычный пробел на неразрывный
strSN = objRS.Fields("sn").Value
strDisplayName = objRS.Fields("displayname").Value
a = Instr(strDisplayName,"-")
if a=0 then strDisplayName = Replace(strDisplayName," ",chr(160)) 'Заменяем обычный пробел на неразрывный, если в ФИО нет двойной фамилии
If IsNull(arrOtherPhone) Then
strOtherPhone = ""
Else
strOtherPhone = ""
For Each strItem In arrOtherPhone
If (strOtherPhone = "") Then
strItem = Replace(strItem,"-","") 'Откидываем тире из телефона
strItem = Replace(strItem," ","") 'Откидываем пробелы из телефона
a = Left(strItem,1)
if a = "8" then strItem = "+7" + Mid(strItem,2)
if a = "(" then strItem = "+7" + strItem
strOtherPhone = strItem
Else
strItem = Replace(strItem,"-","") 'Откидываем тире из телефона
strItem = Replace(strItem," ","") 'Откидываем пробелы из телефона
a = Left(strItem,1)
if a = "8" then strItem = "+7" + Mid(strItem,2)
if a = "(" then strItem = "+7" + strItem
strOtherPhone = strOtherPhone & "<br>" & strItem
End If
Next
End If
If strOtherPhone <> "" then strPhone = strPhone & "<br>" & strOtherPhone
'if strMail<>"" then 'Если смотреть по пользователям, то условие нужно, чтобы не прописывались системные учётки
html = html + "<tr BGCOLOR=#CCCCCC>" + SE
html = html + "<td>" & strDisplayName & "</td>" + SE
html = html + "<td><a class=" & chr(34) & "link" & chr(34) & " href=" & chr(34) & "mailto:" & strMail & chr(34) & ">" & strMail & "</a></td>" + SE
html = html + "<td>" & strPhone & "</td>" + SE
'html = html + "<td>" & strOtherPhone & "</td>" + SE
html = html + "<td>" & strMobile & "</td>" + SE
if strCountry = "RU" then strCountry = "Россия"
if strCountry = "UA" then strCountry = "Украина"
if strCountry = "BY" then strCountry = "Беларусь"
if strCountry = "KZ" then strCountry = "Казахстан"
if strCountry = "GB" then strCountry = "Великобритания"
if strCountry = "DE" then strCountry = "Германия"
if strCountry = "IT" then strCountry = "Италия"
if strCountry = "FR" then strCountry = "Франция"
if strCountry = "BE" then strCountry = "Бельгия"
if strCountry = "US" then strCountry = "США"
html = html + "<td>" & strCountry & "</td>" + SE
html = html + "<td>" & strCity & "</td>" + SE
html = html + "<td>" & strCompany & "</td>" + SE
html = html + "<td>" & strDepartment & "</td>" + SE
html = html + "<td>" & strTitle & "</td>" + SE
html = html + "</tr>" + SE
strI = strI + 1
'end if 'Если смотреть по пользователям, то условие нужно, чтобы не прописывались системные учётки
objRS.MoveNext
Wend
Set objRS = Nothing
Set adoCommand = Nothing
Set adoConnection = Nothing
Dim a, b
html = html + "</tbody>" + SE
html = html + "</table>" + SE
html = html + "<p align=" + chr(34) + "center" + chr(34) +">" + SE
strI = strI - 1
a = cstr(strI)
b = right(a,1)
html = html + "Всего в телефонном справочнике обнаружено " + a + " запис"
select case b
case "0", "5", "6", "7", "8", "9"
html = html + "ей." + SE
case "1"
html = html + "ь." + SE
case "2", "3", "4"
html = html + "и." + SE
end select
html = html + "<BR>" + SE
html = html + "</p>" + SE
html = html + "</BODY>" + SE
html = html + "</HTML>" + SE
HFuter = HFuter + "<div class=" + chr(34) + "footer" + chr(34) + ">" + SE
HFuter = HFuter + "<p align=" + chr(34) + "center" + chr(34) +">" + SE
HFuter = HFuter + "Программа телефонного справочника была разработана сотрудниками отдела ИТ. С уважением, ИТ-отдел." + SE
HFuter = HFuter + "</p>" + SE
HFuter = HFuter + "</div>" + SE
Dim fso, tf
Set fso = CreateObject("Scripting.FileSystemObject")
Set tf = fso.CreateTextFile("\\FileServer\Contacts\Телефонный справочник сотрудников.htm", True) ' Правим адрес сохранения html-страницы телефонного справочника по своим параметрам!
tf.WriteLine(HHead)
tf.WriteLine(HCss)
tf.WriteLine(HJava)
tf.WriteLine(HTML)
tf.WriteLine(HFuter)
tf.Close
Set fso = Nothing
Ещё один интересный вопрос мне задал Александр (в продолжение 19 отзыва) через обратную связь: --------------------------------------------------------------------------------- ------------------------------------------ Олег, добрый день столкнулся с ситуацией, что через оснастку заполнять данные не очень удобно навоял небольшой скриптик внесения данных нужных мне в vbs
Скрипт запускается на машине в домене, пользователь принадлежит домену скрипт смотрит текущего залогиненого в системе пользователя, находит информацию по нему в АД и пытается внести данные которые пользователь вносит
Dim oADSys Set oADSys = CreateObject("ADSystemInfo") strADsPath = oADSys.UserName Set objUser= GetObject("LDAP://" & strADsPath) strtitle = InputBox("Введите свою должность") strTelephoneNumber = InputBox("Введите свой номер внутреннего телефона") strmobNumber = InputBox("Введите свой номер мобильного телефона",,"+7") strtitle = UCase(strtitle) objUser.Put "telephoneNumber", strTelephoneNumber objUser.Put "mobile", strmobNumber objUser.Put "Title", strtitle objUser.SetInfo
Но столкнулся с проблемой, если пользователь не админ домена, то он не может поменять свои данные. давать пусть и на врема права всем юзерам - не очень хочется
есть ли возможность изменить данный скрипт так, что запускал бы его пользователь, но внутри него как нить зашить исполнение задач от пользователя, который имеет права на изменения, или добавить возможность в AD, что пользователь мог бы поменять только свои данные.
Ответ:
Полностью согласен с Александром, что нельзя давать пользователям полные права доступа на AD, но выход всё же есть. Во-первых, если внимательно посмотреть на мою статью, то можно увидеть, что не просто так она состоит из нескольких и у меня используется 2 скрипта (Скрипт автоматического создания контактов из пользователей в AD). Зачем же я использую прокладку в виде контактов? Да всё очень просто - открою небольшой занавес страшной тайны! Дело в том, что если дать полные права пользователям всего на один контейнер, где хранятся только контакты, а не учётные записи пользователи, то пусть эти пользователи громят и что хотят творят с содержимым этого контейнера, всё равно всё автоматически у меня подправится и на работу AD это никак не скажется. Во-вторых, я и сам долго думал, как поступить с внесением данных о сотрудниках в контакты пользователей и также по началу пытался всякие скрипты делать, но а потом просто маленько почитал маны и выяснил, что наш великий OUTглюк замечательно умеет работать с LDAP-адресной книгой и самое интересное то, что если у пользователя есть права доступа на контейнер с контактами, то всё что он изменит у себя в OUTLOOK-е, изменится и в AD. Вот готовый пример: Outlook - адресная книга Active Directory. Где-то так. А ещё страшнее новость заключается в том, что если маленько подвинтить схему AD, то можно будет ещё и картинки загонять в AD через OUTLOOK (это информация для размышления на досуге).
Через раздел Обратная связь мне вчера пришло сообщение с просьбой помочь. Решил выложить сюда этот вопрос, дабы и другие специалисты нашей области смогли увидеть мой ответ. Текст вопроса: ---------------------------------------- Имя отправителя: Александр
Текст сообщения: ----------------- Добрый день, очень благодарен вам за проделанный труд по созданию этого чудо скрипта формирующего контакты и страницу Столкнулся со следующей проблемой
у меня в компании иерархия AD структурирована блоками cn Users - это сотрудники офиса с OU по отделам
и отдельно ou point - это удаленные объекты, данный юнит находится вне USERS находится в корне домена
Как можно ограничить скрипт поиска учеток только в пределах cn или конкретного ou Планирую разделить справочники, отдельно Офис, отдельно регионы. -----------------
Ответ: Здесь придётся сделать 2 вещи: 1. В данном случае нужно будет иметь 2 скрипта (например, script1.vbs и script2.vbs). Смысл этого действия в том, что каждый из них будет смотреть на свою ветку в AD и соответственно в каждом из этих скриптов должны быть указаны разные имена файлов для сохранения в формате HTML (это уже на усмотрение админа). 2. Что касается LDAP-запроса, то в каждом из скриптов он будет разный. Смотрим на код: strBase = "<LDAP://" & strDNSDomain & ">". Так вот, переменная strDNSDomain будет содеражать строку вида "dc=имя домена(первая часть),dc=имя домена(вторая часть)" (например, "dc=superpuperfirma,dc=ru"). В данном случае это корень самого домена, поэтому, исходя из правил LDAP-запросов, нам необходимо изменить этот запрос. В итоге у нас вместо выше указанного куска кода нам нужно прописать такие строки: strContainer = "cn=Users" - для первого скрипта (strContainer = "ou=point" - для второго) strBase = "<LDAP://" & strContainer & "," & strDNSDomain & ">" Вот и всё!
А Вы меняли исходники? Если да, то что именно? Код в студию... Чуть не забыл 1. во всех браузерах не работает java с сортировкой? 2. проверяли только на одной рабочей станции?
Ничего не менял, хотел сначала из учеток брать, потом сделал из контактов, то есть максимум, что менял - раскомментировал строки. Во всех не работает, проверял на 5 станциях
Если политика Вашей компании позволяет отправить мне данные (или можно их изменить), то вышлите мне сообщение через обратную связь со строчкой "Автономный телефонный справочник", я на него отвечу и после этого вы мне сможете прислать архив с Html-ем вашего справочника (даные в справочнике можно подменить или затереть) Мне и самому интересно, почему у Вас java не работает.... могу проверить у себя.
подскажи, куда копать, если в случае одного скрипта по пользователям он отображает всего 8 пользователей, причем не могу найти параметр, по какому он отбирает, в случае 2-х скриптов, то почему-то первый скрипт не делает контакты
Упустили один момент: Скрипт, который формирует html-страницу, он видит только учётные записи (контакты пользователей или если подправите, то будет видеть учётки пользователей), находящиеся в контейнере Users (на другие он не смотрит). А вот скрипт, который следит за всеми учетками и рулит контактами, он смотрит на все контейнеры!
Вопрос такой, если ставить генерировать справочник по пользователям, то генерируется только 8 пользователей из разных папок домена, может я что-то упустил в скрипте?
просто удобно пользоваться только одним скриптом, не создавая дополнительно контакты в АД. И если это реализуете буду благодарен.
Мне так и не удается запустить первый скрипт. Он отрабатывает, а контакты так и не появляются в АД. Если комментирую то что вы мне сказали скрипт сервак вывешивает. Видно в цикл входит какой-то. Завтра еще поэксперементирую. Сейчас уже уходить с работы надо.
Сейчас воспользовался только вторым скриптом. И получил файл даже с заблокированными контактами. Искал по пользователям. Насколько я понял, чтобы заблокированные пользователи не отображались - необходимо выполнять сначала все-таки первый скрипт, и второй с условием по контактам?
именно так я у себя и организовал, хотя можно попробовать сделать дополнительную проверку пользователя на заблокированность. кстати хорошая идея - надо будет её попробовать реализовать в моей второй версии скрипта для автономного телефонного справочника... спасибо за идею!
Да и надо обратить внимание на 2 интересных момента: 1. Смотреть по контактам или по пользователям (нужное раскоментировать): 'strFilter = "(&(objectCategory=person)(objectClass=user)(|(useraccountControl=66048)(useraccountcontrol=512)))" 'Просмотр по пользователям strFilter = "(&(objectCategory=person)(objectClass=contact))" 'Просмотр по контактам 2. 'if strMail<>"" then 'Если смотреть по пользователям, то условие нужно, чтобы не прописывались системные учётки html = html + "<tr BGCOLOR=#CCCCCC>" + SE .......... strI = strI + 1 'end if 'Если смотреть по пользователям, то условие нужно, чтобы не прописывались системные учётки objRS.MoveNext Во втором пункте, если Вы будете по пользователям строить html-страницу, то можно раскоментировать строки, дабы была отсечка системных учёток, у которых нету электронной почты! Для того, чтобы было понятнее откуда скрипт берёт параметр "электронная почта", откройте свойства любого объекта (контакта или пользователя) и на вкладке "Общие" можно найти параметр "Электронная почта"... Вы по каким именно объектам собираетесь заставить скрипт смотреть?
