下面是通过Web方式修改域用户密码的核心代码:

<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>  
<%  
On Error resume next  
const df_domain_name="test.com" 
dim domain, acct, posbs, posat, username, pUser, root  
dim upn_name  
 
acct=Request("acct")  
 
upn_name = "" 
domain = df_domain_name  
 
'检查账号名的格式是否为xx@test.com、test.com\xx  
'尝试从账号里面提取域名  
posbs = Instr(1,acct,"\" )  
posat = Instr(1,acct,"@" )  
if posbs > 0 then  
    domain = Left(acct,posbs-1)  
    username = Right(acct,len(acct) - posbs)  
elseif posat > 0 then  
    upn_name = acct  
    domain = Right(upn_name, len(upn_name) - posat)  
    username = Left(upn_name, posat-1)  
else      
    username = acct  
    set nw = Server.CreateObject("WScript.Network")  
    domain = nw.Computername  
end if   
 
'检查账户名是否包含无效字符  
if IsInvalidUsername(username) = true then  
    Response.Write("域账号无效!")  
    Response.End 
end if  
 
'检查域名是否包含无效字  
if IsInvalidDomainname(domain) = true then  
    Response.Write("域名无效!")  
    Response.End 
end if    
 
if upn_name = "" then  
    set pUser = GetObject("WinNT://" & domain & "/" & username & ",user")  
    if Not IsObject(pUser) then  
        set root = GetObject("WinNT:")  
        set pUser = root.OpenDSObject("WinNT://" & domain & "/" & username & ",user", username, Request("old"),1)  
        Response.Write "<!--OpenDSObject call-->" 
    end if  
 
    if Not IsObject(pUser) then  
        set pUser = Server.CreateObject("IIS.PwdChg")  
        pUser.Domain = domain  
        pUser.User = username  
    end if  
else  
    set pUser = Server.CreateObject("IIS.PwdChg")  
    if Not IsObject(pUser) then  
        set pUser = GetObject("WinNT://" & domain & "/" & username & ",user")  
        if Not IsObject(pUser) then  
            set root = GetObject("WinNT:")  
            set pUser = root.OpenDSObject("WinNT://" & domain & "/" & username & ",user", username, Request("old"),1)  
            Response.Write "<!--OpenDSObject call-->" 
        end if  
    else  
        pUser.Domain = domain  
        pUser.User = username  
        pUser.UPN = upn_name  
    end if  
end if  
 
if Not IsObject(pUser) then  
    if err.number = -2147024843 then  
        Response.Write("指定的域或帐户不存")  
    else   
        if err.description <> "" then  
            Response.Write("出错了:"& err.description)  
        else  
            Response.Write("错误号码:"& err.number)  
        end if  
    end if  
    Response.End 
end if  
 
err.Clear  
pUser.ChangePassword Request("old"), Request("new")  
 
if err.number <> 0 then  
    if err.number = -2147024810 then  
        Response.Write("您输入的用户名或密码无效,请重新输入!")   
    elseif err.number = -2147022651 then  
        Response.Write("密码太短,或不满足密码唯一性限制,不能使用以前的12次历史密码。")  
    else  
        Response.Write("错误号码:" & err.number)  
    end if  
    Response.End 
else  
    Response.Write("密码修改成功!")  
end if   
 
function IsInvalidUsername(username)  
    dim re  
    set re = new RegExp  
    re.Pattern = "[/\\""\[\]:<>\+=;,@]"  
    IsInvalidUsername =  re.Test(username)  
end function  
 
function IsInvalidDomainname(domainname)  
    dim re  
    set re = new RegExp  
    re.Pattern = "[/\\""\[\]:<>\+=;,@!#$%^&\(\)\{\}\|~]"  
    IsInvalidDomainName =  re.Test(domainname)  
end function  
%>