osc

最新推荐文章于 2024-07-17 11:56:18 发布
lazeping
最新推荐文章于 2024-07-17 11:56:18 发布
阅读量558
点赞数
文章标签： function microsoft exchange service 脚本 system
'Coder by okhelper

Set objArgs = WScript.Arguments

If objArgs.Count = 0 Or objargs.Count > 1 Then 
	usage()
	WScript.Quit
End If



Const ForReading = 1, ForWriting = 2


set objshell = CreateObject("Wscript.Shell")


IADsPath = ""

strDomain = ""
'当前文件路径
curPath = objShell.CurrentDirectory

CurrentDomain = objshell.ExpandEnvironmentStrings("%USERDNSDOMAIN%")

'当前域名
CurrentDomain = LCase(CurrentDomain)


Set fso = CreateObject("Scripting.FileSystemObject")

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

'adspath
strDomain = ObjRootDSE.Get("defaultNamingContext")


Select Case objArgs(0)

	Case   "-cu","-Cu":
		
		CreateUser()
		
	Case "-mail","-Mail":
		
		MailEnable(true)
		
	Case "-sip","-Sip" :
	
		SIPEnable()	
		
End Select 




Function usage()
	
	message = vbTab & "请在命令提示符下使用本脚本!"
	
	filename = WScript.ScriptName
	
	message = message & vbcrlf & vbcrlf & "Usage: cscript " & filename & "[*.vbs] [-cu] [-mail] [-sip]" & vbCrLf &_
	vbCrLf & "Example: cscript " & filename & " -cu 创建用户,可同时启用邮箱和SIP" &_
	vbCrLf & "         cscript " & filename & " -mail  为已存在用户启用邮箱" &_
	vbCrLf & "         cscript " & filename & " -sip   为已存在用户启用Sip"
	
'	WScript.Echo message
	
	MsgBox message,0,"欢迎使用本脚本[okhelper]"

End Function 

'启用邮箱
Function MailEnable(flag)

	Set Con = CreateObject("ADODB.Connection") 
	Set Com = CreateObject("ADODB.Command") 
	Set Rec = CreateObject("ADODB.Recordset")
	Con.Provider = "ADsDSOObject"
	Con.Open "ADs Provider"

	strQuery = "<LDAP://" & "CN=Configuration," & strDomain & ">;(objectCategory=msExchPrivateMDB);name,adspath;subtree"

	Com.ActiveConnection = Con
	Com.CommandText = strQuery
	Set Rec = Com.Execute


	If Not Rec.EOF Then

		Rec.MoveFirst
	
		MailEnable = CStr(Rec.Fields("ADsPath").Value)

	Else

		MailEnable = ""
	
	End If
	
	ouNum = 0
	userNum = 0
	If flag = True Then 
		
		If MailEnable <> "" Then 
		
		strQuery = "<LDAP://" & strDomain & ">;(objectCategory=organizationalUnit);name,adspath;subtree"
		
		Com.CommandText = strQuery
		
		Set Rec = Com.Execute
		
		Rec.MoveNext
		
		While Not Rec.EOF 
		
			WScript.Echo "当前操作：启用Exchange邮箱 操作部门：" & Rec.Fields("name")

			WScript.Echo ""
			Set objou = GetObject(Rec.Fields("adspath"))
			
			
			strQuery = "<" & Rec.Fields("adspath") & ">;(objectCategory=USER);name,adspath;subtree"
		
			Com.CommandText = strQuery
		
			Set uRec = Com.Execute
			
			uRec.MoveFirst
			
			While Not uRec.EOF
			
				
				WScript.Echo "正在启用 " & Rec.Fields("name") & " 部门的用户：" & uRec.Fields("name")
				
				Set objuser = GetObject(uRec.Fields("adspath"))
					
					objuser.CreateMailbox MailEnable
					
					objuser.setinfo
					
				Set objuser = Nothing 
				
				userNum = userNum + 1
				
				WScript.Sleep (500)
				
				uRec.MoveNext
				
			Wend
			
			Set uRec = Nothing 
			 
			WScript.Echo "-------------------------------------------"
			ouNum = ouNum + 1
			Rec.MoveNext			
		Wend 
		
		WScript.Echo ouNum & " 个部门,共 " & userNum & "个用户启用邮箱完毕."

		Else
		
			WScript.Echo ""
			WScript.Echo "----------------------------------------------------" & vbCrLf &_
			 			 "-该服务器没有安装Exchange，请安装后再次使用本脚本。-" & vbCrLf &_
						 "----------------------------------------------------"
		
			WScript.Quit
		End If 
		
	End If
	
	 
	Set Con = Nothing 
	Set Com = Nothing 
	Set Rec = Nothing 
End Function 

'启用SIP即时通讯
Function SIPEnable()

	PoolServer = SipPoolServer()
	
	SIPDomain = sipAutoDomain()
		
	If PoolServer <> "" Or SipDomain <> "" Then 
		
		Set Con = CreateObject("ADODB.Connection") 
		Set Com = CreateObject("ADODB.Command") 
		Set Rec = CreateObject("ADODB.Recordset")
		Con.Provider = "ADsDSOObject"
		Con.Open "ADs Provider"

		strQuery = "<LDAP://"& strDomain & ">;(objectCategory=organizationalUnit);name,adspath;subtree"

		Com.ActiveConnection = Con
		Com.CommandText = strQuery
		Set Rec = Com.Execute
		
		Rec.MoveNext
		
		ouNum = 0
		userNum = 0
		
		While Not Rec.EOF
			
			Set objou = GetObject(Rec.Fields("adspath"))
			
			WScript.Echo "当前操作：启用Sip即时通讯 操作部门：" & Rec.Fields("name")
			
			WScript.Echo ""
			
			strQuery = "<" & Rec.Fields("adspath")& ">;(objectCategory=user);name,adspath;subtree"

			Com.CommandText = strQuery
			
			Set uRec = Com.Execute
			
			uRec.MoveFirst
			
			While Not uRec.EOF
				
				Set objuser = GetObject(uRec.Fields("adspath"))	
				
				WScript.Echo "正在启用 " & Rec.Fields("name") & " 部门的用户：" & uRec.Fields("name") & " ..."					
						
					objuser.put "msRTCSIP-UserEnabled",True 
					objuser.put "msRTCSIP-ArchivingEnabled",0
					objuser.put "msRTCSIP-OptionFlags",256
					objuser.put "msRTCSIP-PrimaryUserAddress","sip:" & objuser.get("sAMAccountName") & "@" & SipDomain
					objuser.put "msRTCSIP-PrimaryHomeServer", poolServer '池
					objuser.setinfo
					
					Set objuser = Nothing 
					
					userNum = userNum + 1
					
					WScript.Sleep(500)
					
				uRec.MoveNext
			Wend 
			
			WScript.Echo "------------------------------------------"
			
			ouNum = ouNum + 1
			
			Rec.MoveNext
			
		Wend
		
		WScript.Echo "完成 " & ouNum & " 个部门,共计 " & userNum & " 个用户操作。"
		
	Else
		
		WScript.Echo ""
		WScript.Echo "-----------------------------------------------" & vbCrLf &_
					 "-该服务器没有安装Office Communication Server。-" & vbCrLf &_
					 "-----------------------------------------------"
		
		WScript.Quit		
	End If

End Function 

Function isSipServer()
	
	Set Con = CreateObject("ADODB.Connection") 
	Set Com = CreateObject("ADODB.Command") 
	Set Rec = CreateObject("ADODB.Recordset")
	
	Con.Provider = "ADsDSOObject"
	Con.Open "ADs Provider"
	strQuery = "<LDAP://CN=Schema,CN=Configuration," & strDomain & ">;(name=ms-RTC-SIP-SchemaVersion);name,adspath;subtree"

	Com.ActiveConnection = Con
	Com.CommandText = strQuery
	Set Rec = Com.Execute

	If Not Rec.EOF Then
	
		Rec.MoveFirst
		Set objsip = GetObject(Rec.Fields("adspath"))
	
		If objsip.Get("rangeUpper") = 1007 Then 
			isSipServer = True
		Else 
			isSipServer = False 
		End If 
	End If
	Set Con = Nothing 
	Set Com = Nothing 
	Set Rec = Nothing 
End Function 


'获取SIP自动登陆域
Function sipAutoDomain()
	
	Set Con = CreateObject("ADODB.Connection") 
	Set Com = CreateObject("ADODB.Command") 
	Set Rec = CreateObject("ADODB.Recordset")
	Con.Provider = "ADsDSOObject"
	Con.Open "ADs Provider"
	
	
	
	sipflg = isSipServer()

	If sipflg = True Then 
	
		strQuery = "<LDAP://CN=Global Settings,CN=RTC Service,CN=Microsoft,CN=System," & strDomain & ">;(objectCategory=msRTCSIP-Domain);name,adspath;subtree"
	
		Com.ActiveConnection = Con
		Com.CommandText = strQuery
		Set Rec = Com.Execute
		
		If Not Rec.EOF Then 
			For i = 1 To Rec.Fields.Count
				Set objsipdomain = GetObject(Rec.Fields("adspath"))
			
				'WScript.Echo objSipDomain.Get("msRTCSIP-DomainName")
			
				If Rec.Fields.Count > 1 Or objSipDomain.Get("msRTCSIP-DomainName") <> CurrentDomain Then 
				
					sipAutoDomain = objSipDomain.Get("msRTCSIP-DomainName")
				
				End If 
			
				Rec.MoveNext
			Next 
		End If 
	Else 
		sipAutoDomain = ""
	End If 
	Set Con = Nothing 
	Set Com = Nothing 
	Set Rec = Nothing 
End Function 

Function SipPoolServer()

	Set Con = CreateObject("ADODB.Connection") 
	Set Com = CreateObject("ADODB.Command") 
	Set Rec = CreateObject("ADODB.Recordset")
	Con.Provider = "ADsDSOObject"
	Con.Open "ADs Provider"
	
	
	sipflg = isSipServer()
	
	If sipflg = True Then 
	
		strQuery = "<LDAP://CN=Pools,CN=RTC Service,CN=Microsoft,CN=System," & strDomain & ">;(objectCategory=msRTCSIP-Pool);name,adspath;subtree"
		
		Com.ActiveConnection = Con
		Com.CommandText = strQuery
		Set Rec = Com.Execute
	
		If Not Rec.EOF Then 
			Rec.MoveFirst
		
			poolServer = Rec.Fields("adspath")
		'	WScript.Echo poolServer
		End If 
	
		SipPoolServer = "CN=LC Services,CN=Microsoft," & Right (poolServer,Len(poolServer)-7)
	Else
		SipPoolServer = ""
	End If
	
	Set Con = Nothing 
	Set Com = Nothing 
	Set Rec = Nothing 
End Function 




Function CreateUser()
	
	ouNum = 0
	userNum = 0
	
	Set fso = CreateObject("Scripting.FileSystemObject")
	set oufile = fso.OpenTextFile(curPath & "\部门.txt",ForReading)

	Set objDomain = GetObject("LDAP://" & strDomain)
	
	While Not oufile.AtEndOfStream
		
		ouName = oufile.ReadLine
	
		WScript.Echo "正在创建部门：" & ouName
		WScript.Echo ""
	

		Set objOU = objDomain.Create("organizationalUnit","ou=" & ouName)
	
		objOU.SetInfo
	
		ouNum = ouNum + 1
		
			Set userCnFile = fso.OpenTextFile(curPath & "\" & ouName & ".txt",ForReading)
	
			Set userSnFile = fso.OpenTextFile(curPath & "\" & ouName & "_sn.txt",ForReading)
	
			Set objUser = GetObject("LDAP://ou=" & ouName & "," & strDomain)
	
			While Not userCnFile.AtEndOfStream
		
				cn = userCnFile.ReadLine
				sn = userSnFile.ReadLine
		
				WScript.Echo "正在创建 " & ouName & " 用户：" & cn & " ...."
		
				Set newUser = objUser.Create("User","cn=" & cn)
					newUser.Put "sAMAccountName", sn
					newUser.Put "sn",cn
					newUser.Put "userPrincipalName",sn & "@" & CurrentDomain
					newUser.Put "displayname",cn
					newUser.SetInfo
					
				Set ChangeUserAttrib = GetObject("LDAP://cn="& cn & ",ou=" & ouName & "," & strDomain)
	
					ChangeUserAttrib.SetPassword "123.com"
					ChangeUserAttrib.AccountDisabled = False
					
					ExMdb = MailEnable(False)
					
					If ExMdb <> "" Then 
					
						ChangeUserAttrib.CreateMailbox ExMdb
					
					End If 
					
					SipDomain = sipAutoDomain()
					poolName  = SipPoolServer()
					
					If SipDomain <> "" Or poolName <> "" Then 
						
						ChangeUserAttrib.put "msRTCSIP-UserEnabled",True 
						ChangeUserAttrib.put "msRTCSIP-ArchivingEnabled",0
						ChangeUserAttrib.put "msRTCSIP-OptionFlags",256
						ChangeUserAttrib.put "msRTCSIP-PrimaryUserAddress","sip:" & ChangeUserAttrib.get("sAMAccountName") & "@" & SipDomain
						ChangeUserAttrib.put "msRTCSIP-PrimaryHomeServer", poolName '池
	
					End If 
					
					ChangeUserAttrib.setinfo
				
					Set cn = Nothing 
					Set sn = Nothing
					Set newUser = Nothing
					Set changeUserAttrib = Nothing 
		
					userNum = userNum + 1
					WScript.Sleep (500)		
			Wend 
		
			WScript.Echo "--------------------------------------"
			Set objOU = Nothing 
			Set objUser = Nothing
			Set userCnFile = Nothing
			Set userSnFile = Nothing 	
	
		Wend 
	
	WScript.Echo ""
	
	WScript.Echo ouNum & "个部门," & userNum & "个用户创建完毕."	 
	
End Function
lazeping
关注
0
点赞
踩
0

收藏

觉得还不错? 一键收藏
0
评论
osc

'Coder by okhelperSet objArgs = WScript.ArgumentsIf objArgs.Count = 0 Or objargs.Count > 1 Then usage() WScript.QuitEnd IfConst
复制链接

扫一扫
osc

“相关推荐”对你有帮助么？
