vbs生成域账号

新建一个 jsp  import.jsp

 

<div id="autoImport">
<table cellpadding="0" cellspacing="0" border="0" width="80%" align="center" >
<tr><td>组织结构:</td><td align="center"><input id="orgInfo" type="text"/><font color="red">&nbsp;[格式:虹安;研发部]</font></td></tr>
<tr>
<td colspan='2' align="center">
<br/>
<INPUT type="button" value="<s:text name='dlp.userManage.userSearch.save'/>" class="buttonStyle" style="width:63px" onclick="toAutoImport()">


&nbsp;&nbsp;
<INPUT TYPE="button" value="<s:text name='dlp.userManage.userCheck.quit'/>" onclick="javaScript:ShowNo('div_OperFieldUser');" class="buttonStyle" style="width:63px">
&nbsp;&nbsp;
</td>
</tr>
</table>
</div>

 

js中添加

 

<script>

function toAutoImport(){
var orgInfo=document.getElementById("orgInfo").value;
if(orgInfo==null || ""==orgInfo){
alert(getText("userManage.js.b2"));
return;
}
var array=orgInfo.splt(";");
var xmlStr="";
for(var i=array.length-1;i>=0;i--){
xmlStr="OU="array[i]+",";
}
if(xmlStr!="")
xmlStr=xmlStr.substr(0,xmlStr.length-1);
try{
var xmlString=tst(xmlStr);
var vh = new HashTable();
vh.put('xmlStr',xmlString);
jsonBind('../userReg/importFieldAccount.do','',vh,'callBackAutoImport');
}catch(e){
alert("请在域服务器上执行");
}

}
 </script>

 

<script language="vbscript">

dim strXml
Function enumou(obj)

closetag = ""

If LCase(obj.class) = "organizationalunit" Then

Set ou = obj
If Left(ou.Name, 3) = "OU=" Then
data = Right(ou.Name, Len(ou.Name) - 3)
strXml = strXml & "<Group name=""" & data & """>" & vbCrLf
closetag = "</Group>"
End If

ElseIf LCase(obj.class) = "user" Then

Set usr = obj
If Left(usr.Name, 3) = "CN=" Then

name = """" & Right(usr.Name, Len(usr.Name) - 3) & """"

on error resume next
tel = """" & usr.TelephoneNumber & """"
email = """" & usr.EmailAddress & """"
on error goto 0

if len(email) < 2 then tel = """"""
if len(email) < 2 then email = """"""

strXml = strXml & "<User name=" & name & " tel=" & tel & " email=" & email & ">" & vbCrLf
closetag = "</User>"
End If

End If

For Each aa In obj
enumou aa
Next

If Len(closetag) <> 0 Then
strXml = strXml & closetag & vbCrLf
End If

End Function


Sub tst(rootou)

strXml = "<?xml version=""1.0"" encoding=""gbk"" ?>" & vbCrLf

Set objRootDSE = GetObject("LDAP://rootDSE")

Set con = GetObject("LDAP://" & rootou & "," & objRootDSE.Get("defaultNamingContext"))
con.Filter = Array("organizationalUnit")
enumou con
msgbox "已成功将帐户同步到 "
tst=strXml
End Sub
</script>

 传入后台 xml