]]>... как получить количество отпечатанных страниц?..
Читайте журнал событий "System" на предмет поиска в нём уведомлений (тип события - 3) от источника с именем "Print". Для XP/2003 код события - 10, для других версий ОС - посмотрите в журнале.
После нахождения соответствующей записи анализируйте текст уведомления, т.к. в нём содержится информация и о количестве напечатанных страниц.
По умолчанию у серверных версий ОС журналирование событий успешной обработки заданий печати включено, у клиентских - выключено, следовательно потребуется предварительно включить функцию "Вести журнал сообщений очереди печати".
как получить количество отпечатанных страниц?
Определенный принтер(независимо как подключен), кол-во распечатанного.
вкратце.
Я задачу опроса спулера удаленной системы на предмет количества заданий (jobs) по всем принтерам машины - количество заданий "в работе" и общее количество заданий отправленных на принтера после включения машины (или перезапуска спулера) реализовывал в упоминаемом в этой теме своём скрипте PrinterListPC.hta
Правда, "задания", отправленые на принтер с конкретной машины - это далеко не "страницы" принтера, если быть точным.
Описание программы с кодом и картинками - https://sites.google.com/site/scripttoo … listpc-hta
]]>]]>Радоватся или грустить по этому поводу я не знаю.
Смириться и принять.
]]>Shwan пишет:... 30% принтеров не подключены серверу но подключены к сети...
Это принтеры с собственными сетевыми картами? Где установлены драйверы для этих принтеров?
Shwan пишет:... определяются сетевые принтеры не подключенные к серверу...
Каким признаком предполагаете пользоваться для того, чтобы отличать их от рабочих станций?
Считаю, что именно с предположения, что на сетевой принтер по идее на какой-то - хотя бы одной) рабочей станции уже стоят драйвера с прописанным портом, и стоит начать собирать сбор данных о таких принтерах. Т.е. сканируя включенные рабочие машины собирать массив имеющихся на них портов, и потом уже его анализировать - то ли это расшаренный у кого-то принтер, то ли это принтер заданный именем хоста, то ли - заданный айпи.
А уже от рабочих станций, где задействован интересующий порт - получать данные о принтере.
ps. хотя может имеет смысл поискать утилиту как у HP, но от остальных производителей имеющихся принтеров?...
]]>... 30% принтеров не подключены серверу но подключены к сети...
Это принтеры с собственными сетевыми картами? Где установлены драйверы для этих принтеров?
... определяются сетевые принтеры не подключенные к серверу...
Каким признаком предполагаете пользоваться для того, чтобы отличать их от рабочих станций?
... как подправить скрипт для сохранения результатов в файл...
Пример:
'предыдущий код
strLog = "Printers.txt"
Set objFS = CreateObject("Scripting.FileSystemObject")
strLog = objFS.BuildPath(objFS.GetParentFolderName(WScript.ScriptFullName), strLog)
Set objFile = objFS.CreateTextFile(strLog, True)
For Each objItem In colItems
objFile.WriteLine "Printers on " & objItem.name & ", Printer Number: " & _
intPrinters & VbCr & "===================================="
objFile.WriteLine "Availability: " & objItem.Availability
'и далее подобным же образом
objFile.WriteLine "Vertical Res: " & objItem.VerticalResolution & VbCr
intPrinters = intPrinters + 1
Next
objFile.Close
Set objFile = Nothing
Set objFS = Nothing
'последующий код... Как (где? ) посмотреть пользователей подключенных к принтеру...
Если речь обо всех пользователях, в профилях которых настроены соответствующие подключения, то в этих профилях и смотреть.
Если речь о пользователях, задания печати которых выполняются в текущий момент (или выполнялись в течение активного сеанса работы), то, вероятнее всего, надо периодически смотреть список сеансов, открытых для спулера.
Применение - до подключения Ремоут.Ассистентом к юзеру выполняю предварительный контроль имещихся принтеров на его машине, поиски расшареного принтера на других "соседних" машинах, тест доступности принтера по значению TCPIPPrinterPort.
Помимо этого, т.к. приложение было на коленке переделано из другой моей программки, то выполняется еще и: определение времени включения машины, ее дескрипшн, логин пользователя и доменные данные - по машине, юзеру и менеджеру машины. Код определения времени логона юзера, увы, несовершенен (т.е. время однозначно определяется далеко не всегда) - был бы рад, если бы подсказали по этому моменту (т.к. это у меня небольшой камень преткновения в приложении, мониторящем перелогон пользователя).
И был бы рад, если бы коллеги подсказали скриптовый способ определения принтера по умолчанию у залогиненого на удаленнй пользователя (может как-то из ветки реестра пользователя?).
<!-- === PrinterListPC.hta ====================================================
Может получать в качестве параметра - Имя компьютера / ip-адрес
Предоставляет интерфейс для опроса установленых в удаленной системе принтеров.
Roman, rgv15@list.ru
=========================================================================== -->
<HTML>
<HEAD>
<TITLE>PrinterListPC</TITLE>
<meta http-equiv="Content-Type" content="text/html; charset=windows-1251">
<HTA:APPLICATION ID="oHTA_PrinterListPC"
APPLICATIONNAME="PrinterListPC"
VERSION="1.1 27.07.2011"
SCROLL="yes"
SELECTION="yes"
/>
<SCRIPT LANGUAGE="JScript">
self.resizeTo(900,560); // To make the window XXXX pixels wide and YYYYY pixels tall
</SCRIPT>
<SCRIPT Language="VBScript">
' ----- константы глобальные для всего приложения
Const ADS_SERVER_BIND = &h200
Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20
' ----- объекты глобальные для всего приложения ---------------------------------------
Dim fso, oShell
Set fso = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("WScript.Shell")
' глоб.переменные для последних данных пингования машины'
Dim gsPing_IP : gsPing_IP = ""
Dim giLastLog_OS : giLastLog_OS = 0 'номер версии OS'
Dim gsLastLog_BOOT : gsLastLog_BOOT = ""
Dim gsLastLog_namePC : gsLastLog_namePC = ""
Dim gsLastLog_timeLogon : gsLastLog_timeLogon = ""
Dim gsLastLog_WMIdescription : gsLastLog_WMIdescription = ""
Dim gsLastLog_PC_OU
Dim gsLastLog_PC_description : gsLastLog_PC_description = "" 'AD'
Dim gsLastLog_PC_mgr_name_OU
Dim gsLastLog_PC_mgr_phone
Dim gsLastLog_user_login : gsLastLog_user_login = ""
Dim gsWhoami : gsWhoami = ""
'---'
Dim gsEmptyLog : gsEmptyLog = ""
Sub Window_OnLoad '-----------------------------------------------------------------'
gsEmptyLog = div_Log.innerHTML
ue_whoami 'определяем учетку, под которой стартовало приложение'
ue_defaultNameApp ' устанавливаем имя окна приложения'
idNamePC.focus()
' в качестве имени сканируемой машины берем последний параметр из командной строки запуска и выполняем сканирование
arrCmd = Split( oHTA_PrinterListPC.commandLine, chr(32) )
If (Ubound( arrCmd ) >= 1) Then 'имеются переданные параметры
sLastParam = arrCmd( Ubound(arrCmd) )
If sLastParam <> "" Then
idNamePC.Value = sLastParam 'берем последний
id_btScan.onClick()
End IF
End IF
End Sub
Sub ue_defaultNameApp ' устанавливаем имя окна приложения'
document.title = oHTA_PrinterListPC.APPLICATIONNAME & " v." & _
oHTA_PrinterListPC.version & " ("&gsWhoami&")"
End Sub
Function ue_whoami()
Dim sUSERNAME
sUSERNAME = ""
sUSERNAME = oShell.ExpandEnvironmentStrings("%USERNAME%")
gsWhoami = sUSERNAME
End Function
'--- uf_pingWIN32( host ) --------------------------------------
' Проверяем через WMI доступность компьютера %host%
'---------------------------------------------------------------
' Возврат строковый: либо "off", либо IP-адрес'
'---------------------------------------------------------------
Function uf_pingWIN32(sHostName)
uf_pingWIN32 = "" ' "off line"
Dim objPing
Set objPing = _
GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & sHostName & "'")
For Each objStatus in objPing
If IsNull(objStatus.StatusCode) or objStatus.StatusCode <> 0 Then
uf_pingWIN32 = "off"
Else
uf_pingWIN32 = objStatus.ProtocolAddress ' "on"
End If
Next
Set objPing = Nothing
End Function
Sub uf_getDataPing ' --- начальное сканирование (до начала цикличнх проверок)
div_Log.innerHTML = gsEmptyLog
document.title = "prn:" & LCase(idNamePC.Value)
tdTimeScan.innerHTML = Now()
tm = time()
tdTimeBoot.innerHTML = "Н/Д"
tdIP.innerHTML = "Н/Д"
tdTimeLogon.innerHTML = "Н/Д"
tdWMI_NamePC.innerHTML = "Н/Д"
tdAD_OUPC.innerHTML = "Н/Д"
tdWMI_DescPC.innerHTML = "Н/Д"
tdAD_DescPC.innerHTML = "Н/Д"
tdWMI_user.innerHTML = "Н/Д"
tdAD_manager.innerHTML = "Н/Д"
gsPing_IP = uf_pingWIN32( idNamePC.Value )
If gsPing_IP <> "off" Then
tdIP.innerHTML = "<font color=Blue>" & gsPing_IP & "</font>"
gsLastLog_ipPC = gsPing_IP
If uf_scanHost() Then '--- скан, результат - успешность получения WMI '
tdWMI_NamePC.innerHTML = gsLastLog_namePC
tdWMI_DescPC.innerHTML = gsLastLog_WMIdescription
tdTimeLogon.innerHTML = gsLastLog_timeLogon
tdWMI_user.innerHTML = "<font color=Blue>" & gsLastLog_user_login & "</font>"
If Len(gsLastLog_user_login)>0 Then document.title = document.title & "\" & gsLastLog_user_login
uf_getPrnList()
End IF
If Len(gsLastLog_BOOT)>0 Then tdTimeBoot.innerHTML = "<font color=Blue>" & gsLastLog_BOOT & "</font>"
else
tdIP.innerHTML = "<font color=Red>no ping</font>"
gsLastLog_ipPC = ""
End IF
uf_AD_select( LCase(idNamePC.Value) )
If Len(gsLastLog_PC_OU)>0 Then tdAD_OUPC.innerHTML = gsLastLog_PC_OU
If Len(gsLastLog_PC_description)>0 Then tdAD_DescPC.innerHTML = gsLastLog_PC_description
If Len(gsLastLog_PC_mgr_name_OU)>0 Then tdAD_manager.innerHTML = gsLastLog_PC_mgr_name_OU
If Len(gsLastLog_PC_mgr_phone)>0 Then tdAD_manager.innerHTML = _
"<b>" & gsLastLog_PC_mgr_phone & "</b>, " & tdAD_manager.innerHTML
End Sub
Sub uf_getPrnList()
Set objDictionary = CreateObject("Scripting.Dictionary")
Set objWMIService = GetObject("winmgmts:\\" & gsPing_IP & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Printer", "WQL", wbemFlagReturnImmediately + wbemFlagForwardOnly)
s = "<table width='100%' cellpadding=0 cellspacing=0 border=1 style='font-family: Arial; font-size: 12;'><tr>" &_
"<th>Default</th><th>Caption</th><th>DriverName</th><th>PortName</th><th>Shared</th><th>ShareName</th><th>PrinterStatus</th></tr>"
For Each objItem In colItems
objDictionary.Add objItem.PortName,objItem.PortName
strPrinterStatus = "(?)"
Select Case objItem.PrinterStatus
Case 1
strPrinterStatus = "Other (not responding)"
Case 2
strPrinterStatus = "Unknown (not responding)"
Case 3
strPrinterStatus = "Idle"
Case 4
strPrinterStatus = "Printing"
Case 5
strPrinterStatus = "Warmup"
End Select
s = s & "<tr>"
If objItem.Default Then sTmp = "+" Else sTmp = "--"
s = s & "<td align=center>" & sTmp & "</td>"
s = s & "<td>" & objItem.Caption & "</td>"
s = s & "<td>" & objItem.DriverName & "</td>"
s = s & "<td>" & objItem.PortName & "</td>"
If objItem.Shared Then sTmp = "+" Else sTmp = "--"
s = s & "<td align=center>" & sTmp & "</td>"
If Len(objItem.ShareName)>0 Then strPrinterShareName = objItem.ShareName Else strPrinterShareName = " "
s = s & "<td>" & strPrinterShareName & "</td>"
s = s & "<td>" & strPrinterStatus & "</td>"
s = s & "</tr>" & vbCR
Next
div_Log.innerHTML = s & "</table>"
Set colPorts = objWMIService.ExecQuery ("Select * from Win32_TCPIPPrinterPort")
For Each objPort in colPorts
If objDictionary.Exists(objPort.Name) Then
strUsedPorts = strUsedPorts & "<LI>" & objDictionary.Item(objPort.Name) & "</LI>"
Else
strFreePorts = strFreePorts & "<LI>" & objPort.Name & "</LI>"
End If
Next
div_Log.innerHTML = div_Log.innerHTML & _
"<div style='background-color: azure;'><hr>"&_
"<strong>List TCPIPPrinterPort</strong><hr>" &_
"<u>The following ports are in use:</u> " & "<OL>" & strUsedPorts & "</OL>" &_
"<u>The following ports are available:</u> " & "<OL>" & strFreePorts & "</OL><hr></div>"
End Sub
Function uf_scanHost ' проверка хоста по его IP (gsPing_IP) и занесение результата в глоб.переменные'
gsLastLog_user_login = ""
gsLastLog_namePC = ""
gsLastLog_BOOT = ""
gsLastLog_WMIdescription = ""
gsLastLog_timeLogon = ""
giLastLog_accessWMI = 1
giLastLog_OS = 0
spnStatus.innerTEXT = now()
Dim objWMIService, colItems
On Error Resume Next
Set objWMIService = GetObject("winmgmts:\\" & gsPing_IP & "\root\CIMV2")
If Err.Number <> 0 Then
' MsgBox "Ошибка получения данных от компьютера `" & idNamePC.Value & "`!" & vbCR & vbCR &_
' "Ошибка: [ " & Err.Description & " ]" & vbCR & vbCR, vbCritical, "Подключение к WMI-сервису"
spnStatus.innerTEXT = now() & ". Ошибка получения WMI-данных : [ " & Err.Description & " ]"
On Error GoTo 0
giLastLog_accessWMI = 0
''''--- Пробуем поискать файл c:\pagefile.sys для определения времени включения машины'
sPath = ""
If Len(gsLastLog_namePC)>0 _
Then sPath = "\\" & gsLastLog_namePC _
else sPath = "\\" & idNamePC.Value
sPathPagefile = sPath & "\C$\pagefile.sys"
If FSO.FileExists(sPathPagefile) Then
Set oFile = FSO.GetFile( sPathPagefile )
gsLastLog_BOOT = oFile.DateLastModified
Set oFile = Nothing
else
spnStatus.innerTEXT = spnStatus.innerTEXT & " | NotExist " & sPathPagefile
End IF
'''-----'
else
On Error GoTo 0
Dim sUsrLogin : sUsrLogin = ""
Set colItems = objWMIService.ExecQuery ("SELECT * FROM Win32_ComputerSystem", "WQL", _
wbemFlagReturnImmediately + wbemFlagForwardOnly)
For Each objItem In colItems
gsLastLog_namePC = objItem.Caption
spnStatus.innerTEXT = spnStatus.innerTEXT & " | " & gsLastLog_namePC
If IsNull(objItem.UserName) Then
sUsrLogin=""
spnStatus.innerTEXT = spnStatus.innerTEXT & " | IsNull(objItem.UserName)!"
End IF
If Len(objItem.UserName) Then
sUsrLogin = objItem.UserName
spnStatus.innerTEXT = spnStatus.innerTEXT & " | " & sUsrLogin
Dim iPos
iPos = InStr(1,sUsrLogin,"\")
If iPos>0 Then
sUsrLogin = Right(sUsrLogin, Len(sUsrLogin) - iPos)
End IF
gsLastLog_user_login = sUsrLogin
End IF
Next
'Версия и билд системы удаленной машины, дескрипшн'
Set colItems = objWMIService.ExecQuery( _
"SELECT * FROM Win32_OperatingSystem", "WQL", wbemFlagReturnImmediately + wbemFlagForwardOnly)
For Each objItem In colItems
'--- определение версии OS'
giLastLog_OS = CInt(Trim(Left(objItem.Version,1)))
sOperSyst = objItem.Version & ", " & objItem.Caption
If Len(objItem.CSDVersion)>0 Then sOperSyst = sOperSyst & ", " & objItem.CSDVersion
sOperSyst = sOperSyst & ", " & objItem.WindowsDirectory
spnStatus.innerTEXT = spnStatus.innerTEXT & " | " & sOperSyst
'--- дескрипшн компьютера'
gsLastLog_WMIdescription = objItem.Description
Next
Set colItems = Nothing
'--- время логона'
If Len(gsLastLog_user_login)>0 Then
Set colItems = objWMIService.ExecQuery( _
"SELECT * FROM Win32_LogonSession", "WQL", wbemFlagReturnImmediately + wbemFlagForwardOnly)
For Each objItem In colItems
if objItem.LogonType=11 then
gsLastLog_timeLogon = WMIDateStringToDate(objItem.StartTime)
end if
Next
Set colItems = Nothing
'---'
End IF
'--- время включения'
Set colItems = objWMIService.ExecQuery( _
"SELECT * FROM Win32_LogonSession", "WQL", wbemFlagReturnImmediately + wbemFlagForwardOnly)
For Each objItem In colItems
if objItem.LogonType=0 then
gsLastLog_BOOT = WMIDateStringToDate(objItem.StartTime)
end if
Next
' spnStatus.innerTEXT = spnStatus.innerTEXT & " | Win32_LogonSession:" & UBound(colItems)
Set colItems = Nothing
'---'
Set objWMIService = Nothing
End IF
uf_scanHost = giLastLog_accessWMI
END FUNCTION
Function WMIDateStringToDate(dtmDate)
WMIDateStringToDate = CDate(Mid(dtmDate, 5, 2) & "/" & _
Mid(dtmDate, 7, 2) & "/" & Left(dtmDate, 4) _
& " " & Mid (dtmDate, 9, 2) & ":" & Mid(dtmDate, 11, 2) & ":" & Mid(dtmDate,13, 2))
End Function
'*********************************************************************************************'
Function uf_AD_select(pNamePC)
Dim sDC
sDC = "nameMyDC"
gsLastLog_PC_OU = ""
gsLastLog_PC_description = ""
gsLastLog_PC_mgr_name_OU = ""
gsLastLog_PC_mgr_phone = ""
Dim StrCN, strManagedBy, StrlastLogon, StrDescription
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Properties("ADSI Flag") = ADS_SERVER_BIND
objConnection.Open "Active Directory Provider"
Set objCommand = CreateObject("ADODB.Command")
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 30
strAttributesPC = "cn,managedby,distinguishedName,Description"
objCommand.CommandText = "<LDAP://" & sDC & ">;" &_
"(&(objectCategory=Computer)" &_
"(name=" & pNamePC & "));" & strAttributesPC & ";Subtree" ' ???'
On Error Resume Next
Err.Clear
Set objRSet = objCommand.Execute
If Err.Number <> 0 Then 'Обработка ошибки, прерываем выполнение'
s = _
"Ошибка при поиске учетки компьютера на доменном контролере: " & tCurrentDC.value &vbCr&vbCr &_
"Запрос к AD:" &vbCr & objCommand.CommandText &vbCr&vbCr &_
"Описание ошибки:" &vbCr & Err.Description &vbCr &vbCr&vbCr &_
"Поиск прерывается, возможно надо сменить контролер."
spnStatus.innerTEXT = spnStatus.innerTEXT & " | AD ERROR: " & s
On Error GoTo 0
else
On Error GoTo 0
Dim sMgr
sMgrCN = ""
If objRSet.RecordCount > 0 Then
objRSet.MoveFirst
Do Until objRSet.EOF
StrCN = objRSet.Fields("cn").Value
strManagedBy = ufGetCN( objRSet.Fields("managedby").Value )
sMgrCN = strManagedBy 'objRSet.Fields("managedby").Value
gsLastLog_PC_mgr_name_OU = sMgrCN
strDN = objRSet.Fields("distinguishedName")
StrDescription = FuncGetDescriptionComputerFromAdByDistinguishedName( sDC & "/" & strDN )
s_OU = uf_getOutlet_fromDN( strDN ) 'получаем имя отделения или брэнча'
s_infoPCOU = uf_strOUfromDN( strDN ) 'сокращение юнита для отображения в таблице'
' s_DNOU = uf_strOUfromDN_fullOU( strDN ) 'полный юнит - будет использовано при запросах к AD'
gsLastLog_PC_description = StrDescription 'for_PINGfileLog'
If Len(s_OU)>0 Then
s_infoPCOU = Replace(s_infoPCOU,s_OU,"<b><u>"&s_OU&"</u></b>")
End IF
gsLastLog_PC_OU = s_infoPCOU 'for_PINGfileLog'
spnStatus.innerTEXT = spnStatus.innerTEXT & " | AD: " & s_infoPCOU
objRSet.MoveNext
Loop
End If ' (objRSet.RecordCount > 0)
Set objRSet = Nothing
strAttributesUsr = "cn,telephoneNumber,distinguishedName"
objCommand.CommandText = "<LDAP://"&sDC&">;"&_
"(&(objectCategory=person)(objectClass=user)(name=" & sMgrCN & "));" & strAttributesUsr & ";Subtree"
Set objRSet = objCommand.Execute
Dim sPhone
sPhone = ""
If objRSet.RecordCount > 0 Then
objRSet.MoveFirst
Do Until objRSet.EOF
StrCN = objRSet.Fields("cn").Value
sPhone = objRSet.Fields("telephoneNumber").Value
If Len(sPhone)>0 Then
gsLastLog_PC_mgr_phone = sPhone
sPhone = sPhone & ", "
End IF
strDN = objRSet.Fields("distinguishedName")
sDN_small = uf_strDN_small( strDN )
gsLastLog_PC_mgr_name_OU = sDN_small 'for_PINGfileLog'
objRSet.MoveNext
Loop
End If ' (objRSet.RecordCount > 0)
Set objRSet = Nothing
End IF
End FUNCTION
' ---- uf_strDN_small() ---------------------------------------'
' возвращаем в более читабельном виде distinguishedName
Function uf_strDN_small( pStrDN)
uf_strDN_small = pStrDN
uf_strDN_small = Replace( uf_strDN_small, "CN=", "")
uf_strDN_small = Replace( uf_strDN_small, ",OU=", "/")
' оставляем только первый DC='
Dim iPos
iPos = InStr(uf_strDN_small, ",DC=" )
If iPos>0 Then uf_strDN_small = Left( uf_strDN_small, iPos - 1)
End Function
' --- ufGetCN() -----------------------------------------------
' получение из строки первого до запятой параметра (т.е. "CN=")
Function ufGetCN (sParam)
If Left(sParam,3) = "CN=" Then
Dim iPos
iPos = InStr(1,sParam,",")
If iPos>0 Then
ufGetCN = Left(sParam, iPos-1)
ufGetCN = Right(ufGetCN, iPos-4)
End IF
else
ufGetCN = sParam
End IF
End Function
'--------------------------------------------------------------
Function FuncGetDescriptionComputerFromAdByDistinguishedName( DN )
Dim LDAPQuery
LDAPQuery = "LDAP://" & DN
Dim objComputer
Dim StrobjPropertyDescription
On Error Resume Next
Set objComputer = GetObject( LDAPQuery )
'--------------Description
FuncGetDescriptionComputerFromAdByDistinguishedName = objComputer.Get("Description")
On Error GoTo 0
If IsNull(FuncGetDescriptionComputerFromAdByDistinguishedName) Then
FuncGetDescriptionComputerFromAdByDistinguishedName = "-"
Else
End If
StrobjPropertyDescription = Null
End Function
' --- uf_getOutlet_fromDN() -----------------------------------
' получение из строки distinguishedName имени отделения/брэнча
' или возвращаем "HO" для юнитов самого ГО,
' или возвращаем имя региона, если учетка не в бренче/отделении
Function uf_getOutlet_fromDN( sParam )
'разбираем строку на массив и выбираем в новую строку только элементы OU
arr = Split(sParam,",")
s2 = ""
If IsArray(arr) Then
iMax = UBound(arr)
s1 = "Line: [" & sParam &"]"& vbCr
For i=iMax to 0 Step -1
If InStr(arr(i),"OU=")>0 Then 'оставляем в новой строке только элементы OU, причем в обратноц последовательности'
If Len(s2)>0 Then s2 = s2 & "\"
s2 = s2 & Right( arr(i), Len(arr(i)) - 3 )
End IF
NEXT
'-------- работаем с отраженной строкой элементов OU
arr = Split(s2, "\")
If IsArray(arr) Then
iMax = UBound(arr)
s1 = "Line: [" & s2 &"]"& vbCr
s2 = ""
'[..... далее выполнялись некоторые замены в возвращаемом перечне юнитов организации ..... удалено перед отправкой в форум]'
If arr(0)="[.....]" Then 'Sorry, '
s2 = "...."
End IF
If arr(0)="[.... Outlets]" Then
s2 = arr(1)
End IF
If arr(0)="[..... Regions]" Then
If iMax>1 Then
s2 = arr(2) 'Branch / Outlet'
else
s2 = "_" & Replace(arr(1)," Region","") 'only name Region'
End IF
End IF
End IF
End IF
uf_getOutlet_fromDN = s2
End Function
' ---- uf_strOUfromDN() ---------------------------------------'
' возвращаем в более читабельном виде юниты из distinguishedName
Function uf_strOUfromDN( pStrDN)
uf_strOUfromDN = pStrDN
Dim iPos
iPos = InStr(uf_strOUfromDN, ",OU=" )
If iPos>0 Then uf_strOUfromDN = Right( uf_strOUfromDN, Len(uf_strOUfromDN) - iPos - 3)
uf_strOUfromDN = Replace( uf_strOUfromDN, ",OU=", "/")
' --- ,DC убираем '
iPos = InStr(uf_strOUfromDN, ",DC=" )
If iPos>0 Then uf_strOUfromDN = Left( uf_strOUfromDN, iPos - 1)
End Function
'*****************************************************************************************'
' --- uf_pingRunTimeOut( sNamePC ) ------------------------------------
' Запукаем внешнюю команду PING -t на укзанный параметром комп.
'---------------------------------------------------------------
' (!) Объект "oShell" должен быть опеределен глобально:
' Set oShell = CreateObject("WScript.Shell") '
'---------------------------------------------------------------
Function uf_pingRunTimeOut(sParam, pTimeout)
If not IsNull(sParam) Then
If Len(sParam) > 0 Then
sCmd = "ping.exe -w " & pTimeout & " -t " & sParam
If NOT IsEmpty (gsFileLogPing) Then
uf_wrLogPing ( sParam & vbTab & Now() & " (ping) --} " & sCmd)
End IF
uf_pingRunTimeOut = 0
oShell.Run( sCmd )
else
uf_pingRunTimeOut = 1
MsgBox "Не задано имя пингуемого компьютера!" ,vbCritical, "Ping -t <sNamePC>"
End IF
else
uf_pingRunTimeOut = 2
End IF
End Function
' Запукаем внешнюю программу iexplore на укзанный в поле idHost адрес.
Sub ue_btHostIE
s = Trim(idHost.value)
If Len(s)=0 Then
MsgBox "Пусто в адресе хоста!", vbCritical, "Запуск IE"
else
sCmd = "iexplore http://" & s & "/"
oShell.Run( sCmd )
End IF
End SUB
</SCRIPT>
<!-- ****************** Стили *************** -->
<style type="text/css">
<!--
/* окно прокрутки слоя с протоколом*/
.frameLog {
width: 860px;
height: 340px;
border: 1px solid #000;
overflow: auto;
}
-->
</style>
<style type="text/css">
<!-- /*** стиль для строк окна редактирования настроек, небольших инф.сообщений */ -->
.cssBtn {font-family: Arial; font-size: 12; cursor: hand}
<!-- заголовочные ячейки таблицы -->
.cssTD_hd {font-family: Arial; font-size: 12; background-color:whitesmoke; }
<!-- остальные ячейки таблицы -->
.cssTD {font-family: Arial; font-size: 11; color: darkblue;}
</style>
</HEAD>
<BODY bgcolor="#FFFFFF" text="#000000" leftmargin="5" rightmargin="5" topmargin="5" bottommargin="5"
style="font-family: Arial; font-size: 12;">
<div align="Right">
<span id="spnTm" style="background:lightblue"></span>
</div>
<LABEL for=idNamePC title='Имя проверяемого компьютера. Клавиша <Enter> - запуск команды "Получение списка принтеров"'>
Компьютер
<input type="text" name="textBox" size="18" id="idNamePC"
onKeyPress="if (window.event.keyCode==13) document.getElementById('id_btScan').onclick();"></LABEL>
<input type=button name="btScan" id="id_btScan" value="Получить список принтеров" class="cssBtn"
onClick="uf_getDataPing();"
title="Запуск получения данных по компьютеру">
<LABEL for=idHost title='Имя/адрес проверяемого хоста. Клавиша <Enter> - запуск команды "ping Host"'>
Host
<input type="text" name="textBox" size="18" id="idHost"
onKeyPress="if (window.event.keyCode==13) document.getElementById('id_btHostPing').onclick();"></LABEL>
<input type=button name="btHostPing" id="id_btHostPing" value="ping Host" class="cssBtn"
onClick="var oNmPC; oNmPC=document.getElementById('idHost'); uf_pingRunTimeOut(oNmPC.value,8000);"
title="Запуск проверки доступности хоста бесконечным пингом">
<input type=button name="btHostIE" id="id_btHostIE" value="Host in IE" class="cssBtn"
onClick="ue_btHostIE();"
title="Запуск http:\\'host_address'">
<table width="100%" cellpadding="0" cellspacing="0" border="1" style="font-family: Arial; font-size: 12;">
<tr>
<label title="Время заполнения таблицы первоначальных данных">
<td width="15%" class="cssTD_hd">Время теста</td> <td width="25%" id="tdTimeScan"> </td></label>
<label title="Время загрузки: результат WMI-запроса по IP-адресу либо время изменения файла: \\_компьютер_\c$\pagefile.sys при недоступности WMI">
<td width="15%" class="cssTD_hd">Время загрузки</td><td width="45%" id="tdTimeBoot"> </td></label>
</tr>
<tr>
<label title="IP-адрес, определившийся через WMI-запрос">
<td class="cssTD_hd">WMI IP</td> <td id="tdIP"> </td></label>
<label title="Время последнего логона, определившееся через WMI-запрос по IP-адресу">
<td class="cssTD_hd">Время логона</td> <td id="tdTimeLogon"> </td></label>
</tr>
<tr>
<label title="Имя машины, определившееся через WMI-запрос по IP-адресу">
<td class="cssTD_hd">WMI Name</td> <td id="tdWMI_NamePC"> </td></label>
<label title="AD: юнит машины.">
<td class="cssTD_hd">AD OU</td><td id="tdAD_OUPC" class="cssTD"> </td></label>
</tr>
<tr>
<label title="Описание машины, определившееся через WMI-запрос по IP-адресу">
<td class="cssTD_hd">WMI Description</td> <td id="tdWMI_DescPC"> </td></label>
<label title="AD: описание машины.">
<td class="cssTD_hd">AD Description</td><td id="tdAD_DescPC" class="cssTD"> </td></label>
</tr>
<tr>
<label title="Залогиненный пользователь машины, определившийся через WMI-запрос по IP-адресу">
<td class="cssTD_hd">WMI LogonUser</td> <td id="tdWMI_user"> </td></label>
<label title="AD: телефон и учетка менеджера машины.">
<td class="cssTD_hd">AD Manager</td><td id="tdAD_manager" class="cssTD"> </td></label>
</tr>
</table>
<br>
<!-- ----- Слой page_PINGfileLog со стилем прокрутки протокола скана машины---- -->
<div id=div_Log style="background:beige" class="frameLog">
<table width="100%" cellpadding="0" cellspacing="0" border="1" style='font-family: Arial; font-size: 12;'>
<tr>
<th>Default</th>
<th>Caption</th>
<th>DriverName</th>
<th>PortName</th>
<th>Shared</th>
<th>ShareName</th>
<th>PrinterStatus</th>
</tr>
<span id="spnRowTbl"></span>
</table>
</div>
<span id="spnStatus" style="background:whitesmoke" title="Доп.данные по последнему сканированию"></span>
</BODY>
</HTML>В коде заменено имя контроллера для выборки AD-данных, см.функцию uf_AD_select(), строка: sDC = "nameMyDC".
И еще несколько строк, зависящих от структуры юнитов моего домена - убрано/заменено.
Приложение запускается от имени админской доменной учетки, может параметром принимать имя сканируемой машины либо ввод имени на форме.
]]>С Уважением Дмитрий.
]]>