<%
Option Explicit
sub createUser(username,upassword)   '创建一个用户，并设置相关属性

 dim WshShell ,computerName
 set WshShell=server.CreateObject("WScript.Shell")
 computerName=WshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
 set WshShell=nothing
 
 dim oDomain,oGroup,oUser,objUser,UserPath 
 Set oDomain = GetObject("WinNT://" & computerName)
 Set oGroup = oDomain.GetObject("Group", "Users") 
 Set oUser = oDomain.Create ("user", username)
 If (err.number = 0) Then
  oUser.SetInfo
  oUser.SetPassword upassword
  oUser.FullName = username   '帐号全名
  oUser.Description = "bloguser"   '帐号说明
  oUser.UserFlags = &H10000 xor &H0040  '&H20000(使用者下次登入时须变更密码) &H0040(使用者不得变更密码) &H10000(密码永久正确) &H0002(帐户暂时停用)
  oUser.SetInfo        
  Set objUser = GetObject("WinNT://" & computerName & "/" & username)
  UserPath = objUser.ADsPath  
  oGroup.Add (UserPath)
  set objUser=nothing  
 End If 
 Set oUser=Nothing
 set oGroup=nothing
 Set oDomain=Nothing
end sub

sub listadmin  '列出一个组的全部用户，本函数指定为users组
  Dim oGroup
  Dim oMember
  dim strdomain
  dim cls,op
  dim UserObj
 
  strDomain = Request.ServerVariables("SERVER_NAME") 
  Set oGroup = GetObject("WinNT://"&strDomain&"/Users")
 
  For Each oMember in oGroup.Members 
  Response.Write oMember.Name & "<BR>"
  Response.Write oMember.ADsPath & "<BR>" 
  Response.Write oMember.Class & "<BR>"  
  
  ' Get more data about the object schema.
  Set cls = GetObject(oMember.Schema)
  Response.Write "Class Name is: " & cls.Name & "<br>"
  For Each op In cls.OptionalProperties
      Response.Write "Optional Property: " & op & "<br>"
  Next
  set cls=nothing 
  
  if oMember.Class="User" then
   Set UserObj = GetObject(oMember.ADsPath)
   Response.Write UserObj.Description&"<BR>"  
   set UserObj=nothing
  end if
  Response.Write "<p></p>" 
  Next 
  set oGroup=nothing   
end sub

Function DelUser(UserName)   '删除一个用户
 
 dim WshShell ,computerName
 set WshShell=server.CreateObject("WScript.Shell")
 computerName=WshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
 set WshShell=nothing 
 dim DelUserObj,DelObj 
 
 on error resume next
 Set DelUserObj = GetObject("WinNT://"&computerName&"/"&UserName)
 'Err.Raise   可以抛出一个具体的错误，调用该句，Err.Description才有值。
 'Response.Write Err.number &"<BR>"
 'Response.Write Err.Description&"<BR>"
 
 If Err.number<>"" Then
  Response.Write "用户"&UserName&"不存在"
  Response.End
 End If

 if DelUserObj.Description="bloguser" then
  Set DelObj = GetObject(DelUserObj.Parent)
  DelObj.Delete "User", DelUserObj.Name  
  Set DelObj = Nothing
 end if
 
 Set DelUserObj = Nothing
End Function

Function DelGroupUser(GroupName)   '删除一个组下面的用户
 
 Dim oGroup
 Dim oMember
 dim strdomain
 dim UserObj,DelObj
   
 dim WshShell
 set WshShell=server.CreateObject("WScript.Shell")
 strdomain=WshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
 set WshShell=nothing    
 Set oGroup = GetObject("WinNT://"&strDomain&"/"&GroupName) 
  For Each oMember in oGroup.Members 
   if oMember.Class="User" then
   Set UserObj = GetObject(oMember.ADsPath)
   if UserObj.Description="bloguser" then  '描述为blogUser的用户
    'Response.Write "删除！<BR>"
    Set DelObj = GetObject(oMember.Parent)
    DelObj.Delete "User", oMember.Name  
    Set DelObj = Nothing
   end if
   set UserObj=nothing
   end if   
  Next 
  set oGroup=nothing
End Function

Function EditUser(UserName,OldPassWord,PassWord,FullName,Info)  '编辑一个用户的属性
 dim WshShell ,computerName
 set WshShell=server.CreateObject("WScript.Shell")
 computerName=WshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
 set WshShell=nothing
 
 '读取用户信息
 Set ChangeUserObj = GetObject("WinNT://"&computerName&"/"&UserName&",User")
 '修改帐号密码
 if PassWord<>"" then
 ChangeUserObj.SetPassword PassWord
 response.write "帐号密码修改成功！<br>"
 end if
 '修改帐号全名
 if FullName<>"" then
 UserFullName = ChangeUserObj.get("FullName")
 ChangeUserObj.FullName = FullName
 ChangeUserObj.SetInfo
 response.write "帐号全名修改成功！<br>"
 end if
 '修改帐号说明
 if Info<>"" then
 UserFullName = ChangeUserObj.get("Description")
 ChangeUserObj.Description = Info
 ChangeUserObj.SetInfo
 response.write "帐号说明修改成功！<br>"
 end if
 Set ChangeUserObj=nothing
End Function

sub updatePass(username,password)   '修改用户的密码
 dim WshShell ,computerName
 set WshShell=server.CreateObject("WScript.Shell")
 computerName=WshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
 set WshShell=nothing
 
 dim ChangeUserObj 
 Set ChangeUserObj = GetObject("WinNT://"&computerName&"/"&UserName&",User")
 '修改帐号密码
 if PassWord<>"" then
  ChangeUserObj.SetPassword PassWord
  'response.write "帐号密码修改成功！<br>"
 end if
 set ChangeUserObj=nothing
end sub

sub listUserInfo(username)

end sub

'createUser "test","test"   '创建一个用户
'DelUser "test"  '删除一个用户

'listadmin    '列出USERS组的所有用户
'DelGroupUser "Users"  删除users组下的所有用户
updatePass "test","123"  修改用户test的密码

%>

更多信息请请参考：http://www.microsoft.com/windows2000/techinfo/howitworks/activedirectory/adsilinks.asp