1

Тема: VBS,HTA: Запрос в Active Directory

Здравствуйте уважаемые форумчане, есть следующий скрипт для поиска пользователей (по фамилии) и компьютеров в AD. Работает хорошо, находит все что нужно, но думает очень очень медленно (секунд 10).

	<html>
<head>
<link rel="stylesheet" type="text/css" href="1.css">
<HTA:APPLICATION
  ID="objPCManage"
  CONTEXTMENU="no"/>
  
</head>
<body>
<input type='text' value='int.mechel.corp' id='DomainNameAD' name='DomainNameAD'>
		<input type='text' value='' id='VvodData' name='VvodData'>
	<input type='button' value='Поиск Пользователь&PC' onclick='SearchAD()' id='SearchADScript' name='SearchADScript'>
<div>
<span id="vuvod">

</span>

</div>
<script language="vbscript">
	'---------------------------------------------------
	' Конвертирование имени домена в нужный формат в АД
	'---------------------------------------------------
	'Convert domain name to ADsPath
	Function ConvertDomainNametoADsPath()
		Dim strDomainName,arrDomLevels
			strDomainName = DomainNameAD.value
			arrDomLevels = Split(strDomainName, ".")
		ConvertDomainNametoADsPath = "dc=" & Join(arrDomLevels, ",dc=")
	End Function
	
	
	'---------------------------------------------
	' Форма таблицы Верх
	'---------------------------------------------
	Function trGenTop(NameValue, value)
		Dim style
		style = "style='vertical-align:top; border:1px solid #000'"
		trGenTop=Trim("<tr><th>" & NameValue & "</th><th>" & value & "</th></tr>") 
	End Function
	
	'---------------------------------------------
	' Форма таблицы
	'---------------------------------------------
	Function trGenTable(parametr, value())
		Dim style
		style = "style='vertical-align:top; border:2px solid #000' cellpadding='10px'"
		trGenTable=Trim("<tr "& style &"><th>"& parametr &"</th><td "& style &">"& value &"</td></tr>") 
	End Function
	
			'---------------------------------------------
	' Форма таблицы Строка
	'---------------------------------------------
	Function trGenStroka(parametr)
		Dim style
		style = "style='vertical-align:top; border:1px solid #000'"
		trGenStroka=Trim("<tr><th>"& parametr &"</th></tr>") 
	End Function
	'---------------------------------------------------
	' Конвертирование времени
	'---------------------------------------------------
	Function ConvertTime(objDate)
		Dim Key,TempKey,Temp,lngHigh,lngLow,dtmDate
		Set objShell = CreateObject("Wscript.Shell")
		Key="HKLM\System\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias"
		TempKey = objShell.RegRead(Key)
		If (VarType(TempKey) = 3) Then
			Temp = TempKey
		ElseIf (VarType(TempKey)=12) Then
			Temp = 0
				   For k = 0 To UBound(TempKey)
				   Temp = Temp + (TempKey(k) * 256^k)
				   Next
		End If
		lngHigh = objDate.HighPart
		lngLow = objDate.LowPart
		If (lngLow < 0) Then
			lngHigh = lngHigh + 1
		End If
		If (lngHigh = 0) And (lngLow = 0 ) Then
			dtmDate = #1/1/1601#
		Else
			dtmDate = #1/1/1601# + (((lngHigh * (2 ^ 32))+ lngLow)/6/10^8 - Temp)/1440
		End If
		ConvertTime=dtmDate
	End Function
	'---------------------------------------------
	' Поиск в АД - Учеток и ПК
	'---------------------------------------------
	Sub SearchAD
		'On Error Resume Next
		Dim strADsPath,ADSRoot,objConnection,objCommand,srchTrm,objRecordSet,strADPath,objUser,strMsg
		Dim strlockOutDuration,intLockoutDurationMinutes,i
		Dim strDisplayName,strTelephoneNumber
		Dim strTitle,strDepartment
		Dim strSamAccountName,strAccountDisabled,strCn'account
		Dim strPasswordLastChanged,strWhenCreated,strWhenChanged,strLastLogonTimestamp,strPwdLastSet
		Dim strStroka,strStroka1,strStroka2,strDistinguishedName,strCanonicalName,strIsAccountLocked
		Dim oDomain, oUser,maxPwdAge,numDays,warningDays,objNetwork,strUserDays,strUserDaysLeft
		Dim LoginInfo,strDomainDN,strUserDN,whenPasswordExpires,fromDate,daysLeft
		Dim strmemberOf,objmemberOf,objGroup,strList,strUserlogonname,arrGroup
		dim strNamePC,strOperatingSystem,strdnsHostName,stroperatingSystemServicePack,strWhenCreatedPC,strWhenChangedPC
		ADSRoot = ConvertDomainNametoADsPath()
		Const ADS_SCOPE_SUBTREE = 2	 
		Set objConnection = CreateObject("ADODB.Connection")
		Set objCommand = CreateObject("ADODB.Command")
		objConnection.Provider = "ADsDSOObject"
		objConnection.Open "Active Directory Provider"
		Set objCommand.ActiveConnection = objConnection
			objCommand.Properties("Page Size") = 1000
			objCommand.Properties("Timeout") = 30
			objCommand.Properties("Cache Results") = False ' экспериментально
			objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
			objCommand.CommandText = "SELECT * FROM 'LDAP://" & ADSRoot & "' WHERE objectCategory='user' OR objectCategory='computer'"
		
			srchTrm = LCase(VvodData.value)
			i = 0
			If Len(srchTrm)<4 or Instr(srchTrm, "=") Then
				strHtml = "Please enter a search term in excess of 3 characters. Don't use ""="""
				vuvod.innerHTML = strHtml
				Exit Sub
			End If
			Set objRecordSet = objCommand.Execute
			objRecordSet.MoveFirst
			Do Until objRecordSet.EOF
				strADPath = LCase(objRecordSet.Fields("adsPath").Value)
			If InStr(strADPath, srchTrm) Then
				Set objUser = GetObject(objRecordSet.Fields("adsPath").Value)
				Select Case objUser.Class
			Case "user"
					If objUser.AccountDisabled = FALSE Then
					strAccountDisabled = strAccountDisabled & "Аккаунт включён" & "<td>" & VbCrLf
					Else
						strAccountDisabled = strAccountDisabled & "Аккаунт выключен" & "<td>" & VbCrLf
					End If
	
					If objUser.IsAccountLocked = FALSE Then
					strIsAccountLocked = strIsAccountLocked & "Аккаунт разблокирован" & "<td>" & VbCrLf
					Else
						strIsAccountLocked = strIsAccountLocked & "Аккаунт заблокирован" & "<td>" & VbCrLf
					End If
					
					objmemberOf  = objUser.GetEx("memberOf")
					For Each objGroup in objmemberOf 
					    objGroup = Mid(objGroup, 4, 330) 
					   arrGroup = Split(objGroup, ",")
					   strList = strList & arrGroup(0) & "<br>"
					Next
					
					' Additional section to find the primary group.
					If objUser.primaryGroupID = 513 Then
					   strList = strList & "<br>"
					Else If objUser.primaryGroupID = 515 Then
					   strList = strList & "Domain Computers" & "<br>"
					Else strList = strList & "Maybe a Domain Controller"
					End If
					End If 
			'GENERAL
				strDisplayName = strDisplayName & objUser.DisplayName & "<th>" & VbCrLf
				strTelephoneNumber = strTelephoneNumber & objUser.telephoneNumber & "<td>" & VbCrLf
			'ACCOUNT
				strSamAccountName = strSamAccountName & objUser.samAccountName & "<td>" & VbCrLf
			'Company Info
				strTitle = strTitle & objUser.title & "<td>" & VbCrLf
				strDepartment = strDepartment & objUser.department & "<td>" & VbCrLf
			'Info
				strPasswordLastChanged = strPasswordLastChanged & objUser.PasswordLastChanged & "<td>" & VbCrLf
				strWhenCreated = strWhenCreated & objUser.whenCreated & "<td>" & VbCrLf
				strWhenChanged = strWhenChanged & objUser.WhenChanged & "<td>" & VbCrLf
				strLastLogonTimestamp = strLastLogonTimestamp & ConvertTime(objUser.Get("lastLogonTimestamp")) & "<td>" & VbCrLf
			'Stroka
				strStroka =  "<td colspan='3' align='center' bgcolor='#CBD8EB'><b>Должность и место работы</b></td>"
				strStroka1 = "<td colspan='2' align='center' bgcolor='#CBD8EB'><b>Изменение учетки</b></td>" & "<td>" & VbCrLf
				strStroka2 = "<td colspan='3' align='center' bgcolor='#CBD8EB'><b>Остальное</b></td>"
			'Other
				strDistinguishedName = strDistinguishedName & objUser.distinguishedName & "<td>" & VbCrLf 			
				strCanonicalName = strCanonicalName & objUser.canonicalName & "<td>" & VbCrLf	
				strmemberOf = strmemberOf & strList & "<td>" & VbCrLf
				warningDays = 115 ' порог срабатывания уведомления
				Set LoginInfo = CreateObject("ADSystemInfo") 
				Set objNetwork = CreateObject("WScript.Network")
				strDomainDN = DomainNameAD.value ' int.mechel.corp
				strUserDN = objUser.distinguishedName
				Set oDomain = GetObject("LDAP://" & ADSRoot)
				Set maxPwdAge = oDomain.Get("maxPwdAge")
				numDays = CCur((maxPwdAge.HighPart * 2 ^ 32) + maxPwdAge.LowPart) / CCur(-864000000000)
				Set oUser = GetObject("LDAP://" & strUserDN)
				whenPasswordExpires = DateAdd("d", numDays, oUser.PasswordLastChanged)
				fromDate = Date
				daysLeft = DateDiff("d",fromDate,whenPasswordExpires)
				'msgbox "Password Last Changed: " & oUser.PasswordLastChanged
				if (daysLeft < warningDays) and (daysLeft > -1) then
				'msgbox "Количество дней до истечения пароля: " & daysLeft & "." & chr(13) & "Пароль действителен до " & whenPasswordExpires
				strUserDays = strUserDays & whenPasswordExpires & "<td>" & VbCrLf	
				strUserDaysLeft = strUserDaysLeft & daysLeft & " дней" & "<td>" & VbCrLf
				End if
				Set oUser = Nothing
				Set maxPwdAge = Nothing
				Set oDomain = Nothing


				strMsg = "<table style='border-collapse: collapse' bgcolor=#F5F5F5 border='3'  width='100%'>" &_
					trgenTop  ("Имя",strDisplayName) &_
				trgenTable("1",strCanonicalName) &_
				trgenTable("Телефон",strTelephoneNumber) &_
					trgenTable("Количество дней до истечения пароля:",strUserDaysLeft) &_
					trgenTable("Пароль действителен до",strUserDays) &_
					trgenTable("WinLogon",strSamAccountName) &_
					trgenTable("Выкл/Вкл акк?",strAccountDisabled) &_
					trgenTable("Заблокирована учетка",strIsAccountLocked) &_
				trGenStroka(strStroka)&_
					trgenTable("Должность",strTitle) &_
					trgenTable("Цех",strDepartment) &_
				trGenStroka(strStroka1) &_
					trgenTable("Когда сменил пароль",strPasswordLastChanged) &_
					trgenTable("Когда создана учетка",strWhenCreated) &_
					trgenTable("Когда изменена учетка",strWhenChanged) &_
					trgenTable("Когда был залогинен",strLastLogonTimestamp) &_
				trGenStroka(strStroka2) &_
					trgenTable("Полный путь в формате в АД",strDistinguishedName) &_
				"</table>"
			Case "computer"
				strNamePC = strNamePC & objUser.name & "<th>" & VbCrLf
				stroperatingSystemServicePack = stroperatingSystemServicePack & objUser.operatingSystemServicePack & VbCrLf
				strOperatingSystem = strOperatingSystem & objUser.operatingSystem & " " & stroperatingSystemServicePack & "<td>" & VbCrLf
				strdnsHostName = strdnsHostName & objUser.dnsHostName & "<td>" & VbCrLf
				strWhenCreatedPC = strWhenCreatedPC & objUser.whenCreated & "<td>" & VbCrLf
				strWhenChangedPC = strWhenChangedPC & objUser.WhenChanged & "<td>" & VbCrLf
				strMsg = "<table style='border-collapse: collapse' bgcolor=#F5F5F5 border='3'  width='100%'>" &_
					trgenTop("NamePC",strNamePC) &_
					trgenTable("OS",strOperatingSystem) &_
					trgenTable("Dns Host Name",strdnsHostName) &_
					trgenTable("Изменено",strWhenCreatedPC) &_
					trgenTable("Создано",strWhenChangedPC) &_	
				"</table>"
				Case Else
					strMsg = "Unidentified" & VbCrLf
				End Select
				strHtml = strMsg & VbCrLf
				i = i + 1
			  End If
			objRecordSet.MoveNext
			Loop
			If Not i > 0 Then
			 strHtml = "No results found."
			End If
		vuvod.innerHTML = strHtml
	End sub
	</script>
</body>
</html>

Особенно на фоне скрипта для поиска пользователей по учетке и фамилии, можете подсказать как их скомпоновать?, вся загвоздка в самом обращении к АД, т.е. в 1 случае я через селект выбираю в двух категориях, а в 2 скрипте, оно сначало "кешируется", а потом выдается пользователю, подскажите пожалуйста.

	<html>
<head>
<link rel="stylesheet" type="text/css" href="1.css">
<HTA:APPLICATION
  ID="objPCManage"
  CONTEXTMENU="no"/>
  <script language="vbscript">
'---------------------------------------------------
	' Конвертирование имени домена в нужный формат в АД
	'---------------------------------------------------
	Function ConvertDomainNametoADsPath2()
		Dim strDomainName,arrDomLevels
			strDomainName = DomainNameAD2.value
			arrDomLevels = Split(strDomainName, ".")
		ConvertDomainNametoADsPath2 = "dc=" & Join(arrDomLevels, ",dc=")
	End Function
	
	
	Sub useridsearch
		'sNTDomain = "mechel" 'введите домен для WinNT
		sNTDomain = DomainNameWinNt.value
		if len(trim(struserid.value)) = 0 or struserid.value = "*" then 
		  Msgbox "Please enter a valid username.",48,"Invalid entry"
		  exit sub
		End If
		BaseUserInfo.style.height = "80px"
		sUserIDValue = replace(strUserId.value,"&apos;","'")
		'Define Constant and declare variables
		Const ADS_UF_ACCOUNTDISABLE = &H02
		Const ADS_UF_PASSWD_CANT_CHANGE = &H40
		Const ADS_UF_LOCKOUT = &H10
		Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
		Const SEC_IN_DAY = 86400
		acctdisable = "Enabled"
		acctlocked = "Not Locked"
		strPasswordSet = ""
		' Use ADO to search Active Directory.
		Set objConnection = CreateObject("ADODB.Connection")
		Set objCommand = CreateObject("ADODB.Command")
		objConnection.Provider = "ADsDSOOBject"
		objConnection.Open "Active Directory Provider"
		Set objCommand.ActiveConnection = objConnection
		strDNSDomain = ConvertDomainNametoADsPath2()
		strFilter = "(&(objectCategory=person)(objectClass=user)(sAMAccountName=" & sUserIDValue & "))"
		strQuery = "<LDAP://" & strDNSDomain & ">;" & strFilter _
		  & ";sAMAccountName, distinguishedName, DisplayName, givenName, sn, UserAccountControl, CN, l, mail, Department, telephoneNumber, Title, employeeid;subtree"
		objCommand.CommandText = strQuery
		objCommand.Properties("Page Size") = 750
		objCommand.Properties("Timeout") = 60
		objCommand.Properties("Cache Results") = False
		' Enumerate all users. Check if accounts disabled.
		Set objRecordset = objCommand.execute
		x = 0
		Do Until objRecordset.EOF
			'if user is found, set strusrpath to full DN name
			intFlag = objRecordSet.Fields("userAccountControl")
			lngFlag = objRecordSet.Fields("userAccountControl")
			strusrpath = objrecordset.fields("distinguishedName")
			Txt_userdn = strusrpath
			Txt_userid = objRecordSet.Fields("SamAccountName")
			Txt_userempid = objRecordSet.fields("employeeid")
			Txt_userDisplay = objRecordSet.fields("DisplayName")
		'	Txt_usercn = objRecordSet.fields("cn")
		'	Txt_userfn = objRecordSet.fields("givenName")
		'	Txt_userln = objRecordSet.fields("sn")
			Txt_userAC = objRecordSet.fields("UserAccountControl")
			Txt_userDept = objRecordSet.fields("Department")
			Txt_userTitle = objRecordSet.fields("Title")
			Txt_userPhone = objRecordSet.fields("telephoneNumber")
			strPasswordset = "<br><table style=""width:100%""><tr><td>Reset User Password:</td><td><input style=""border-width:1px"" type=""password"" name=""password""></td><td><input id=""passreset"" class=""button"" type=""button"" value=""Perform action"" name=""changepass"" onClick=""ChangePassword""></td></tr><tr><td>Force user to change password?&nbsp;<input type=""checkbox"" name=""cbxForceChange""></td><td>Unlock account?&nbsp;<input type=""checkbox"" name=""cbxUnlock""></td><td><span id=""spnenabledisable"">Enable</span> account?&nbsp;<input type=""checkbox"" name=""cbxEnable""></td></tr></table>"
			If (intFlag And ADS_UF_ACCOUNTDISABLE) <> 0 Then
				acctdisable = "Disabled"
			End If
			Set objUser = GetObject("LDAP://" & strusrpath & "")
			intUAC = objUser.Get("UserAccountControl")
			If objUser.IsAccountLocked = True Then
				strPasswordset = strPasswordset & " <input id=unlock class=""button"" type=""button"" value=""Unlock Account"" name=""accunlock"" onclick=""UnlockAccount"">"
				acctlocked = "Locked"
			End If
			If intFlag And ADS_UF_DONT_EXPIRE_PASSWD Then
				Txt_pwdexpire = "The password <font color=""red""><b>does not</b></font> expire<br>"
			Else
				on error resume next
			dtmValue = objUser.PasswordLastChanged
				intTimeInterval = int(Now - dtmValue)
				'modify domain name in next line
				Set objDomainNT = GetObject("WinNT://" & sNTDomain)
				ntMaxPwdAge = objDomainNT.Get("MaxPasswordAge")
				intMaxPwdAge = (ntMaxPwdAge/SEC_IN_DAY)
				If intTimeInterval >= intMaxPwdAge and acctDisable <> "Disabled" Then
					Txt_pwdexpire = "Password <font color=""red""><b>has expired</b></font><br>"
				Else
					If acctDisable <> "Disabled" then Txt_pwdexpire = "Password will expire in <font color=""red"">" & int((dtmValue + intMaxPwdAge) - now) & "</font> days<br>"
				End If
			End If             
			strBaseUserInfo = "<table class=""pretty-table"" border=1 cellspacing=""0"" width=""100%"">" & _
				"<tr><th scope=""col"">Username</th><th scope=""col"">Full Name</th></tr>" & _
				"<tr><td>" & Txt_userid & "</td><td>" & Txt_userDisplay & "</td></tr></table>"
		'	  	"<tr><td>" & Txt_userid & "</td><td>" & txt_userln & ", " & txt_userfn & "</td></tr></table>"
			strAddUserInfo = "<table class='pretty-table' rule='rows' border=1 cellspacing=""0"" width=""100%"">" & _
				"<tr><th scope=""row"" colspan='2' scope=""col""><b><center>Additional Information</center></b></th></tr>" & _
				"<tr><th scope=""row"" >Title:</th><td>" & Txt_userTitle & "</td></tr>" & _
			  "<tr><th scope=""row"" >Department:</th><td>" & Txt_userDept & "</td></tr>" & _
				"<tr><th scope=""row"" >Telephone:</th><td>" & Txt_userPhone & "</td></tr>" & _
				"</table>"			
			strAccUserStatus = "<table class='pretty-table' rule='rows' border=1 cellspacing=""0"" width=""100%"">" & _
				"<tr><th colspan='2' scope=""col""><center>Account Status</center></th></tr>" & _
				"<tr><td scope=""row"" >This account is:</td><td>" & acctdisable & "</td></tr>" & _
				"<tr><td scope=""row"" >This account is:</td><td>" & acctlocked & "</td></tr>" & _
				"<tr><td colspan='2'>" & Txt_pwdexpire & "</td></tr>" & _
				"</table>" 
			x=x+1
			objRecordset.MoveNext
		Loop
		If x = 0 Then
			BaseUserInfo.style.height = "300px"
			strBaseUserInfo = "<br><center><font size=5>The requested username<br><font size=7>" & sUserIDValue & "</font><br>is not found in Active Directory</font></center>"
		Else
		End If
		BaseUserInfo.innerhtml = strBaseUserInfo
		AddUserInfo.innerhtml = strAddUserInfo
		AccUserStatus.innerhtml = strAccUserStatus
		AdditionalOptions.innerhtml = strpasswordset
		spnScanTime.innerhtml = "Scanned: <span style='color:red;'>" & now & "</span>"
		'msgbox cbxUnlock.disabled
		on error resume next
		If acctLocked = "Not Locked" then 
		  cbxUnlock.disabled = true
		Else
		  cbxUnlock.disabled = false
		End if
		If acctdisable = "Disabled" then
		  spnenabledisable.innerhtml = "Enable"
		Else
		  spnenabledisable.innerhtml = "Disable"
		End If
		password.focus()
		on error goto 0 
	End Sub
	
	Sub LastSearch
		if len(trim(struserid.value)) = 0 then exit sub
		AddUserInfo.innerhtml = ""
		AccUserStatus.innerhtml = ""
		AdditionalOptions.innerhtml = ""
		acctdisable = "Enabled"
		acctlocked = "Not Locked"
		' Use ADO to search Active Directory.
		Set objConnection = CreateObject("ADODB.Connection")
		Set objCommand = CreateObject("ADODB.Command")
		objConnection.Provider = "ADsDSOOBject"
		objConnection.Open "Active Directory Provider"
		Set objCommand.ActiveConnection = objConnection
		' Determine the DNS domain from the RootDSE object.
		'Set objRootDSE = GetObject("LDAP://RootDSE")
		'strDNSDomain = objRootDSE.Get("DefaultNamingContext")
		strDNSDomain = ConvertDomainNametoADsPath2()
		strFilter = "(&(objectCategory=person)(objectClass=user)(sn=" & struserid.value & "))"
		strQuery = "<LDAP://" & strDNSDomain & ">;" & strFilter _
		  & ";sAMAccountName,sn,givenName,distinguishedname,userAccountControl,cn,DisplayName"
		objCommand.CommandText = strQuery
		objCommand.Properties("Page Size") = 750
		objCommand.Properties("Timeout") = 60
		objCommand.Properties("Cache Results") = False
		' Enumerate all users. Check if account's disabled.
		Set objRecordset = objCommand.execute
		x = 0
		strBaseUserInfo = "<table class='pretty-table' rule='rows' border=1 cellspacing=""0"" width=""100%"">" & _
				"<tr><th scope=""col"">Username</th><th scope=""col"">Full Name</th></tr>"
		Do Until objRecordset.EOF
			Txt_userid = objRecordSet.Fields("SamAccountName")
			Txt_fullname = objRecordset.Fields("cn")
		'	strBaseUserInfo = strBaseUserInfo & "<tr><td><span style=""cursor:pointer"" onClick= ""GetUser('" & replace(Txt_userid,"'","&apos;") & "')"">" & Txt_userid & "</span></td><td><span style=""cursor:pointer"" onClick=""GetUser('" & replace(Txt_userid,"'","&apos;") & "')"">" & objRecordSet.Fields("sn") & ", " & objRecordSet.Fields("givenName") & "</span></td></tr>"
			strBaseUserInfo = strBaseUserInfo & "<tr><td><span style=""cursor:pointer"" onClick= ""GetUser('" & replace(Txt_userid,"'","&apos;") & "')"">" & Txt_userid & "</span></td><td><span style=""cursor:pointer"" onClick=""GetUser('" & replace(Txt_userid,"'","&apos;") & "')"">" & objRecordSet.fields("DisplayName") & "</span></td></tr>"
		
		

			BaseUserInfo.style.height = "365px"
		  x=x+1
			objRecordset.MoveNext
		Loop
		If x = 0 Then
			strBaseUserinfo = "<center>The last name entered, '" & struserid.value & "' is not found in Active Directory.</center>"
		End If
		strBaseUserInfo = strBaseUserInfo & "</table>"
		BaseUserInfo.innerhtml = strBaseUserInfo
	End Sub

	Function GetUser(strID)
		if len(trim(strId)) = 0 then exit function
		  Struserid.Value = replace(strID,"&apos;","'")
		  Call useridsearch
	End Function
	
	Sub UnlockAccount
		'Connect to Active directory And check user to be cloned exists
		'must enter strUserid = username
		Set objConnection = CreateObject("ADODB.Connection")
		objConnection.Open "Provider=ADsDSOObject;"
		Set objCommand = CreateObject("ADODB.Command")
		objCommand.ActiveConnection = objConnection
		objcommand.commandtext = _
		 "<LDAP://" & sRootUserOU & ">;" & _
		  "(&(objectCategory=person)(objectClass=user)" & _
					"(sAMAccountName=" & struserid.value &"));" & _
						"sAMAccountName, distinguishedName;subtree"
		Set objRecordSet = objCommand.Execute
		If objRecordSet.RecordCount = 0 Then
			strHTML = "The username " & struserid.value &" is not found in Active Directory.  Press OK to exit"
			'WScript.quit
		Else
			While Not objRecordset.EOF
				userdn = objRecordSet.fields("distinguishedname")
				Set objUser = GetObject("LDAP://" & userdn & "")
				objUser.IsAccountLocked = False
				objUser.SetInfo
				On Error Resume Next
				If Err.Number <> 0 Then
					MsgBox(Err.Number & " " & Err.Description)
				Else
					MsgBox("Account Unlocked")
				End If        
				objRecordset.MoveNext
			Wend
		End If
	End Sub
</script>
</head>
<body>
	DomainName WinNt<input type="text"  id="DomainNameWinNt" name="DomainNameWinNt" class="txtSearchText" value="mechel" size="20"> 
<div id="divbody">
						<table>
							<tr>
								<td align="center" valign="top">
									Enter the <u>username</u> or <u>last name</u> below and click appropriate search.<br><br>
									<input type="text"  id="DomainNameAD2" name="txtDomainName" class="txtSearchText" value="int.mechel.corp" size="20">
									<input type="text" name="StrUserid" size="20">
									<input id="idsearchbutton"  class="button" type="button" value="Search Username" name="userid"  onClick="useridsearch">
									<input id="lastsearchbutton"  class="button" type="button" value="Search Last Name" name="lastname"  onClick="LastSearch">
								</td>
							</tr>
						</table>
						<br>
						<table>
							<tr>
								<td>
									<Div id="BaseUserInfo" style="height:300px;overflow:auto">
									</Div>
								</td>
							</tr>
						</table>
						<table>
							  <tr>
								<td valign="top">
									<Div id="AddUserInfo">
									</Div>
								</td>
								<td valign="top">
									<Div id="AccUserStatus">
									</Div>
								</td>
							</tr>
						</table>
						<div id="AdditionalOptions">
						</div>
					</div>
					<span style='color:darkblue'>Domain: </span>
					<div id="status_bar" style="padding-top:5px;">
						<span id="spnStatusOU">
						</span>
						<span id="spnStatusDomain">
						</span>
						<span id="spnScanTime">
						</span>
					</div>

</body>
</html>

2 (изменено: mozers, 2016-02-06 20:27:10)

Re: VBS,HTA: Запрос в Active Directory

shade45
Разбейте весь свой код на отдельные vbs скрипты и замеряйте скорость их выполнения.
Если окажется что одна из процедур выполняется чересчур долго, то публикуйте ее в форуме - попробуем её ускорить.
ИМХО проще переписать весь этот код с нуля, чем пытаться отлаживать целиком.

3

Re: VBS,HTA: Запрос в Active Directory

Вышел из ситуации разделением на 3 кнопки, т.е. для поиска по фамилии, логону и имени ПК. Работает быстро, но появилось лишних 3 кнопки, что печально. Можно как нибудь все таки сжать в 1?, нужен обработчик, который определит что введено или оставить как есть?

Сам код:

<html>
<head>
<link rel="stylesheet" type="text/css" href="1.css">
<HTA:APPLICATION
  ID="objPCManage"
  CONTEXTMENU="no"/>
  <script language="vbscript">
'---------------------------------------------------
	' Конвертирование имени домена в нужный формат в АД
	'---------------------------------------------------
	Function ConvertDomainNametoADsPath2()
		Dim strDomainName,arrDomLevels
			strDomainName = DomainNameAD2.value
			arrDomLevels = Split(strDomainName, ".")
		ConvertDomainNametoADsPath2 = "dc=" & Join(arrDomLevels, ",dc=")
	End Function
	
	
	Sub useridsearch
		'sNTDomain = "mechel" 'введите домен для WinNT
		sNTDomain = DomainNameWinNt.value
		if len(trim(struserid.value)) = 0 or struserid.value = "*" then 
		  Msgbox "Please enter a valid username.",48,"Invalid entry"
		  exit sub
		End If
		BaseUserInfo.style.height = "80px"
		sUserIDValue = replace(strUserId.value,"&apos;","'")
		'Define Constant and declare variables
		Const ADS_UF_ACCOUNTDISABLE = &H02
		Const ADS_UF_PASSWD_CANT_CHANGE = &H40
		Const ADS_UF_LOCKOUT = &H10
		Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
		Const SEC_IN_DAY = 86400
		acctdisable = "Enabled"
		acctlocked = "Not Locked"
		strPasswordSet = ""
		' Use ADO to search Active Directory.
		Set objConnection = CreateObject("ADODB.Connection")
		Set objCommand = CreateObject("ADODB.Command")
		objConnection.Provider = "ADsDSOOBject"
		objConnection.Open "Active Directory Provider"
		Set objCommand.ActiveConnection = objConnection
		strDNSDomain = ConvertDomainNametoADsPath2()
		strFilter = "(&(objectCategory=person)(objectClass=user)(sAMAccountName=" & sUserIDValue & "))"
		strQuery = "<LDAP://" & strDNSDomain & ">;" & strFilter _
		  & ";sAMAccountName, distinguishedName, DisplayName, givenName, sn, UserAccountControl, CN, l, mail, Department, telephoneNumber, Title, employeeid;subtree"
		objCommand.CommandText = strQuery
		objCommand.Properties("Page Size") = 750
		objCommand.Properties("Timeout") = 60
		objCommand.Properties("Cache Results") = False
		' Enumerate all users. Check if accounts disabled.
		Set objRecordset = objCommand.execute
		x = 0
		Do Until objRecordset.EOF
			'if user is found, set strusrpath to full DN name
			intFlag = objRecordSet.Fields("userAccountControl")
			lngFlag = objRecordSet.Fields("userAccountControl")
			strusrpath = objrecordset.fields("distinguishedName")
			Txt_userdn = strusrpath
			Txt_userid = objRecordSet.Fields("SamAccountName")
			Txt_userempid = objRecordSet.fields("employeeid")
			Txt_userDisplay = objRecordSet.fields("DisplayName")
		'	Txt_usercn = objRecordSet.fields("cn")
		'	Txt_userfn = objRecordSet.fields("givenName")
		'	Txt_userln = objRecordSet.fields("sn")
			Txt_userAC = objRecordSet.fields("UserAccountControl")
			Txt_userDept = objRecordSet.fields("Department")
			Txt_userTitle = objRecordSet.fields("Title")
			Txt_userPhone = objRecordSet.fields("telephoneNumber")
			strPasswordset = "<br><table width:100%""><tr><td>Reset User Password:</td><td><input border-width:1px"" type=""password"" name=""password""></td><td><input id=""passreset"" button"" type=""button"" value=""Perform action"" name=""changepass"" onClick=""ChangePassword""></td></tr><tr><td>Force user to change password?&nbsp;<input type=""checkbox"" name=""cbxForceChange""></td><td>Unlock account?&nbsp;<input type=""checkbox"" name=""cbxUnlock""></td><td><span id=""spnenabledisable"">Enable</span> account?&nbsp;<input type=""checkbox"" name=""cbxEnable""></td></tr></table>"
			If (intFlag And ADS_UF_ACCOUNTDISABLE) <> 0 Then
				acctdisable = "Disabled"
			End If
			Set objUser = GetObject("LDAP://" & strusrpath & "")
			intUAC = objUser.Get("UserAccountControl")
			If objUser.IsAccountLocked = True Then
				strPasswordset = strPasswordset & " <input id=unlock button"" type=""button"" value=""Unlock Account"" name=""accunlock"" onclick=""UnlockAccount"">"
				acctlocked = "Locked"
			End If
			If intFlag And ADS_UF_DONT_EXPIRE_PASSWD Then
				Txt_pwdexpire = "The password <font color=""red""><b>does not</b></font> expire<br>"
			Else
				on error resume next
			dtmValue = objUser.PasswordLastChanged
				intTimeInterval = int(Now - dtmValue)
				'modify domain name in next line
				Set objDomainNT = GetObject("WinNT://" & sNTDomain)
				ntMaxPwdAge = objDomainNT.Get("MaxPasswordAge")
				intMaxPwdAge = (ntMaxPwdAge/SEC_IN_DAY)
				If intTimeInterval >= intMaxPwdAge and acctDisable <> "Disabled" Then
					Txt_pwdexpire = "Password <font color=""red""><b>has expired</b></font><br>"
				Else
					If acctDisable <> "Disabled" then Txt_pwdexpire = "Password will expire in <font color=""red"">" & int((dtmValue + intMaxPwdAge) - now) & "</font> days<br>"
				End If
			End If             
			strBaseUserInfo = "<table pretty-table"" border=1 cellspacing=""0"" width=""100%"">" & _
				"<tr><th scope=""col"">Username</th><th scope=""col"">Full Name</th></tr>" & _
				"<tr><td>" & Txt_userid & "</td><td>" & Txt_userDisplay & "</td></tr></table>"
		'	  	"<tr><td>" & Txt_userid & "</td><td>" & txt_userln & ", " & txt_userfn & "</td></tr></table>"
			strAddUserInfo = "<table class='pretty-table' rule='rows' border=1 cellspacing=""0"" width=""100%"">" & _
				"<tr><th scope=""row"" colspan='2' scope=""col""><b><center>Additional Information</center></b></th></tr>" & _
				"<tr><th scope=""row"" >Title:</th><td>" & Txt_userTitle & "</td></tr>" & _
			  "<tr><th scope=""row"" >Department:</th><td>" & Txt_userDept & "</td></tr>" & _
				"<tr><th scope=""row"" >Telephone:</th><td>" & Txt_userPhone & "</td></tr>" & _
				"</table>"			
			strAccUserStatus = "<table class='pretty-table' rule='rows' border=1 cellspacing=""0"" width=""100%"">" & _
				"<tr><th colspan='2' scope=""col""><center>Account Status</center></th></tr>" & _
				"<tr><td scope=""row"" >This account is:</td><td>" & acctdisable & "</td></tr>" & _
				"<tr><td scope=""row"" >This account is:</td><td>" & acctlocked & "</td></tr>" & _
				"<tr><td colspan='2'>" & Txt_pwdexpire & "</td></tr>" & _
				"</table>" 
			x=x+1
			objRecordset.MoveNext
		Loop
		If x = 0 Then
			BaseUserInfo.style.height = "300px"
			strBaseUserInfo = "<br><center><font size=5>The requested username<br><font size=7>" & sUserIDValue & "</font><br>is not found in Active Directory</font></center>"
		Else
		End If
		BaseUserInfo.innerhtml = strBaseUserInfo
		AddUserInfo.innerhtml = strAddUserInfo
		AccUserStatus.innerhtml = strAccUserStatus
		AdditionalOptions.innerhtml = strpasswordset
		spnScanTime.innerhtml = "Scanned: <span style='color:red;'>" & now & "</span>"
		'msgbox cbxUnlock.disabled
		on error resume next
		If acctLocked = "Not Locked" then 
		  cbxUnlock.disabled = true
		Else
		  cbxUnlock.disabled = false
		End if
		If acctdisable = "Disabled" then
		  spnenabledisable.innerhtml = "Enable"
		Else
		  spnenabledisable.innerhtml = "Disable"
		End If
		password.focus()
		on error goto 0 
	End Sub
	
	Sub LastSearch
		if len(trim(struserid.value)) = 0 then exit sub
		AddUserInfo.innerhtml = ""
		AccUserStatus.innerhtml = ""
		AdditionalOptions.innerhtml = ""
		acctdisable = "Enabled"
		acctlocked = "Not Locked"
		' Use ADO to search Active Directory.
		Set objConnection = CreateObject("ADODB.Connection")
		Set objCommand = CreateObject("ADODB.Command")
		objConnection.Provider = "ADsDSOOBject"
		objConnection.Open "Active Directory Provider"
		Set objCommand.ActiveConnection = objConnection
		' Determine the DNS domain from the RootDSE object.
		'Set objRootDSE = GetObject("LDAP://RootDSE")
		'strDNSDomain = objRootDSE.Get("DefaultNamingContext")
		strDNSDomain = ConvertDomainNametoADsPath2()
		strFilter = "(&(objectCategory=person)(objectClass=user)(sn=" & struserid.value & "))"
		strQuery = "<LDAP://" & strDNSDomain & ">;" & strFilter _
		  & ";sAMAccountName,sn,givenName,distinguishedname,userAccountControl,cn,DisplayName"
		objCommand.CommandText = strQuery
		objCommand.Properties("Page Size") = 750
		objCommand.Properties("Timeout") = 60
		objCommand.Properties("Cache Results") = False
		' Enumerate all users. Check if account's disabled.
		Set objRecordset = objCommand.execute
		x = 0
		strBaseUserInfo = "<table class='pretty-table' rule='rows' border=1 cellspacing=""0"" width=""100%"">" & _
				"<tr><th scope=""col"">Username</th><th scope=""col"">Full Name</th></tr>"
		Do Until objRecordset.EOF
			Txt_userid = objRecordSet.Fields("SamAccountName")
			Txt_fullname = objRecordset.Fields("cn")
		'	strBaseUserInfo = strBaseUserInfo & "<tr><td><span cursor:pointer"" onClick= ""GetUser('" & replace(Txt_userid,"'","&apos;") & "')"">" & Txt_userid & "</span></td><td><span cursor:pointer"" onClick=""GetUser('" & replace(Txt_userid,"'","&apos;") & "')"">" & objRecordSet.Fields("sn") & ", " & objRecordSet.Fields("givenName") & "</span></td></tr>"
			strBaseUserInfo = strBaseUserInfo & "<tr><td><span cursor:pointer"" onClick= ""GetUser('" & replace(Txt_userid,"'","&apos;") & "')"">" & Txt_userid & "</span></td><td><span cursor:pointer"" onClick=""GetUser('" & replace(Txt_userid,"'","&apos;") & "')"">" & objRecordSet.fields("DisplayName") & "</span></td></tr>"
		
		

			BaseUserInfo.style.height = "365px"
		  x=x+1
			objRecordset.MoveNext
		Loop
		If x = 0 Then
			strBaseUserinfo = "<center>The last name entered, '" & struserid.value & "' is not found in Active Directory.</center>"
		End If
		strBaseUserInfo = strBaseUserInfo & "</table>"
		BaseUserInfo.innerhtml = strBaseUserInfo
	End Sub

	Function GetUser(strID)
		if len(trim(strId)) = 0 then exit function
		  Struserid.Value = replace(strID,"&apos;","'")
		  Call useridsearch
	End Function
	
	Sub UnlockAccount
		'Connect to Active directory And check user to be cloned exists
		'must enter strUserid = username
		Set objConnection = CreateObject("ADODB.Connection")
		objConnection.Open "Provider=ADsDSOObject;"
		Set objCommand = CreateObject("ADODB.Command")
		objCommand.ActiveConnection = objConnection
		objcommand.commandtext = _
		 "<LDAP://" & sRootUserOU & ">;" & _
		  "(&(objectCategory=person)(objectClass=user)" & _
					"(sAMAccountName=" & struserid.value &"));" & _
						"sAMAccountName, distinguishedName;subtree"
		Set objRecordSet = objCommand.Execute
		If objRecordSet.RecordCount = 0 Then
			strHTML = "The username " & struserid.value &" is not found in Active Directory.  Press OK to exit"
			'WScript.quit
		Else
			While Not objRecordset.EOF
				userdn = objRecordSet.fields("distinguishedname")
				Set objUser = GetObject("LDAP://" & userdn & "")
				objUser.IsAccountLocked = False
				objUser.SetInfo
				On Error Resume Next
				If Err.Number <> 0 Then
					MsgBox(Err.Number & " " & Err.Description)
				Else
					MsgBox("Account Unlocked")
				End If        
				objRecordset.MoveNext
			Wend
		End If
	End Sub
	
	Sub CompSearch
        if len(trim(struserid.value)) = 0 then exit sub
        AddUserInfo.innerhtml = ""
        AccUserStatus.innerhtml = ""
        AdditionalOptions.innerhtml = ""
        ' Use ADO to search Active Directory.
        Set objConnection = CreateObject("ADODB.Connection")
        Set objCommand = CreateObject("ADODB.Command")
        objConnection.Provider = "ADsDSOOBject"
        objConnection.Open "Active Directory Provider"
        Set objCommand.ActiveConnection = objConnection
        strDNSDomain = ConvertDomainNametoADsPath2()
        strFilter = "(&(objectCategory=computer)(objectClass=computer)(name=" & struserid.value & "))"
        strQuery = "<LDAP://" & strDNSDomain & ">;" & strFilter _
          & ";name,operatingSystem,operatingSystemServicePack,whenCreated,WhenChanged"
        objCommand.CommandText = strQuery
        objCommand.Properties("Page Size") = 750
        objCommand.Properties("Timeout") = 60
        objCommand.Properties("Cache Results") = False 
        ' Enumerate all computers. 
        Set objRecordset = objCommand.execute
        x = 0   
        strBaseUserInfo = "<table class='pretty-table' rule='rows' border=1 cellspacing=""0"" width=""100%"">" & _
                        "<tr><th scope=""col"">Имя ПК</th><th scope=""col"">operatingSystem</th><th scope=""col"">ServicePack</th><th scope=""col"">whenCreated</th><th scope=""col"">WhenChanged</th></tr>"
        Do Until objRecordset.EOF
                Txt_computername = objRecordSet.Fields("name")
                strBaseUserInfo = strBaseUserInfo & "<tr><td>" & Txt_computername & "</td><td>" & objRecordSet.fields("operatingSystem") & "</td><td>" & objRecordSet.fields("operatingSystemServicePack") & "</td><td>" & objRecordSet.fields("whenCreated") & "</td><td>" & objRecordSet.fields("WhenChanged") & "</td></tr>"
                BaseUserInfo.style.height = "365px" 
                x=x+1
                objRecordset.MoveNext
        Loop    
        If x = 0 Then
                strBaseUserinfo = "<center>The computer name entered, '" & struserid.value & "' is not found in Active Directory.</center>"
        End If  
        strBaseUserInfo = strBaseUserInfo & "</table>"
        BaseUserInfo.innerhtml = strBaseUserInfo
End Sub 
</script>
</head>
<body>

	DomainName WinNt<input type="text"  id="DomainNameWinNt" name="DomainNameWinNt" class="txtSearchText" value="mechel" size="20"> 
<div id="divbody">
						<table>
							<tr>
								<td align="center" valign="top">
									Enter the <u>username</u> or <u>last name</u> below and click appropriate search.<br><br>
									<input type="text"  id="DomainNameAD2" name="txtDomainName" class="txtSearchText" value="int.mechel.corp" size="20">
									<input type="text" id="StrUserid" name="StrUserid" size="20">
									<input id="idsearchbutton"  class="button" type="button" value="Search Username" name="userid"  onClick="useridsearch">
									<input id="lastsearchbutton"  class="button" type="button" value="Search Last Name" name="lastname"  onClick="LastSearch">
									<input id="compsearchbutton"  class="button" type="button" value="Search Computer Name" name="compname"  onClick="CompSearch">
								</td>
							</tr>
						</table>
						<br>
						<table>
							<tr>
								<td>
									<Div id="BaseUserInfo" style="height:300px;overflow:auto">
									</Div>
								</td>
							</tr>
						</table>
						<table>
							  <tr>
								<td valign="top">
									<Div id="AddUserInfo">
									</Div>
								</td>
								<td valign="top">
									<Div id="AccUserStatus">
									</Div>
								</td>
							</tr>
						</table>
						<div id="AdditionalOptions">
						</div>
					</div>
					<span style='color:darkblue'>Domain: </span>
					<div id="status_bar" style="padding-top:5px;">
						<span id="spnStatusOU">
						</span>
						<span id="spnStatusDomain">
						</span>
						<span id="spnScanTime">
						</span>
					</div>

</body>
</html>