检查AD中账户的密码情况，结果保存为Excel格式，可以显示当前用户的密码是否过期，是否设置为密码永不过期，以及上一次密码修改的时间。

大家将下面的脚本保存成文本文件，扩展名改成.hta就可以了。
从最简单的两个脚本变成一个脚本，再变成现在的hta，充分说明了一件事情：只要不断努力就可以不断进步^_^

＝＝＝＝＝＝＝＝＝＝＝以下为脚本部分，本行不包含在内＝＝＝＝＝＝＝＝＝＝＝＝＝＝



      ApplicationName = "AD账户密码状态检查"
      SingleInstance  = "yes"
      ShowInTaskbar   = "yes"
      WindowState     = "normal"

      Caption         = "yes"
      Sysmenu         = "yes"
      MaximizeButton  = "no"
      Border          = "dialog"
      BorderStyle     = "normal"
      InnerBorder     = "yes"
      Scroll          = "no"
      ContextMenu     = "no"
      Selection       = "no" />
     

Const strAbout  = "3.0 (2007年8月8日)"
Const strCopyr  = "上海赛卫思 许震 / xz1215@263.net"
Const strHelp  = "在域控上以管理员身份运行本脚本，在文本框中输入正确的域名后缀再点击按钮。"

Window.resizeTo 400, 230
   
Sub RunScript
 
 On Error Resume Next
 Const ADS_SCOPE_SUBTREE = 2
 Const SEC_IN_DAY = 86400
 Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
 Const ForWriting = 2
 Const E_ADS_Property_Not_Found = &h8000500D
 Const E_Table_Not_Found = &h80040E37
 
 If BasicTextBox.value="" Then
  InfoArea.InnerHTML="请在文本框中输入本域的域名后缀，再点击按钮！"
  Exit Sub
 Else
  document.body.style.cursor = "wait"
  InfoArea.InnerHTML="正在运行,请稍候..."
  DomainName=BasicTextBox.value
  intDotPlace=Instr(1,DomainName,".",1)
  If intDotPlace=0 Then
   LDAPDomain="=" +DomainName
   BiosDomain=DomainName
  Else
   LDAPDomain="=" +Replace(DomainName, ".", ",DC=")
   BiosDomain=Left(DomainName,intDotPlace-1)
  End If
 End If
  
 Set fso = CreateObject("Scripting.FileSystemObject")
   
 Set bjConnection = CreateObject("ADODB.Connection")
 Set bjCommand =   CreateObject("ADODB.Command")
 objConnection.Provider = "ADsDSOObject"
 objConnection.Open "Active Directory Provider"

 Set objCommand.ActiveConnection = objConnection
 objCommand.CommandText = _
    "Select distinguishedName from '" & LDAPDomain & _
        "' where bjectClass ='user' and objectClass <>'computer'"
 objCommand.Properties("Page Size") = 1000
 objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
 Set bjRecordSet = objCommand.Execute
 IF err.number = E_Table_Not_Found Then
  InfoArea.InnerHTML="域名输入错误，请重新输入！"
  document.body.style.cursor = "default"
  Exit Sub
 End If
 objRecordSet.MoveFirst

'设置输出结果，用户可以自行修改文件名称和路径
 OutFile = "passstate.csv"
 Set txtStreamOut = fso.OpenTextFile(OutFile,ForWriting,true)
'结果集的表头信息
 txtStreamOut.WriteLine "帐户名称,账户状态,上次修改时间,上次修改时间距今几天,下一次修改时间,密码有效时间"

 Do Until objRecordSet.EOF       
  LDAPUser="LDAP://" +objRecordSet.Fields("distinguishedName").Value

'获得用户帐号信息
 Set bjUserLDAP = GetObject(LDAPUser)
 intCurrentValue = objUserLDAP.Get("userAccountControl")
'根据控制位最后两位判断，如果最后两位是二进制10，说明账户被禁用
 If (intCurrentValue and 3)=2 Then
     AccountControl = "账户被禁用"
 Else 
     AccountControl = "账户已启用"
 End If

'判断用户密码是否设置为永不过期
 If intCurrentValue And ADS_UF_DONT_EXPIRE_PASSWD Then
    OutText=objUserLDAP.Get("sAMAccountName") & "," & AccountControl &",密码永不过期,,,"
    txtStreamOut.WriteLine OutText
 Else
'如果用户密码没有设置为永不过期，
'获得最后一次修改密码的时间，并计算最后一次修改密码距今的时间
    dtmValue = objUserLDAP.Passwordlastchanged
    If err.number = E_ADS_Property_Not_Found Then
      intTimeInterval = -1
    Else
      intTimeInterval = int(now - dtmValue)
     End If
    Err.number = 0
 

'获得密码最长时间
    Set bjDomainNT = GetObject("WinNT://" & BiosDomain)
    intMaxPwdAge = objDomainNT.Get("MaxPasswordAge")

'如果密码最长时间没有设置，提示用户并退出脚本运行
    If intMaxPwdAge < 0 Then
      InfoArea.InnerHTML "该域密码最长有效期设置为0，因此用户账户密码永不过期，程序结束！"
      Exit Sub
    Else
'否则，如果用户账户最后一次修改密码距今时间超过密码最长期限，
'显示上次密码已过期 
      intMaxPwdAge = (intMaxPwdAge/SEC_IN_DAY)
      If intTimeInterval >= intMaxPwdAge Then
          OutText=objUserLDAP.Get("sAMAccountName") & "," & AccountControl & "," & DateValue(dtmValue) & " " & _
       TimeValue(dtmValue) & "," & int(now - dtmValue) & ",密码过期!,"
    txtStreamOut.WriteLine OutText
      Else
        If intTimeInterval = -1 Then
           OutText=objUserLDAP.Get("sAMAccountName") & "," & AccountControl & ",下次登陆修改密码,,,"
           txtStreamOut.WriteLine OutText
        Else
'否则，显示密码有效时间
           OutText=objUserLDAP.Get("sAMAccountName") & "," & AccountControl & "," & DateValue(dtmValue) & " " & _
           TimeValue(dtmValue) & "," & int(now - dtmValue) & "," & _
           DateValue(dtmValue + intMaxPwdAge) & "," & int((dtmValue + intMaxPwdAge) - now)
           txtStreamOut.WriteLine OutText
        End If
       End If
    End If
 End If
objRecordSet.MoveNext
Loop
InfoArea.InnerHTML= "请打开" & OutFile & "检查帐号密码状态. 按F5重新运行！"
document.body.style.cursor = "default"
End Sub
 
Sub setx(t)
 Dim obj : Set bj = window.event.srcElement
 If t = "" Then
     obj.style.color  = "gray"
        obj.style.cursor = "default"
    Else
        obj.style.color  = "darkblue"
        obj.style.cursor = "hand"
    End If
    footer.innerHTML = t
End Sub

AD账户密码状态检查