如何在WinCC中管理Windows账户

虽然WinCC中有用户管理功能，但是在要求满足FDA 21 CFR第11部分的法规时，还需要再安装SIMATIC Logon插件，并在用户管理器中勾选SIMATIC登录。而在这之后，WinCC的用户管理器功能却不再完整了。

原本用于管理用户的控件WinCC UserAdminControl，在使用SIMATIC Logon之后，就只能用于管理用户组，不能再添加或删除用户。这是因为用了SIMATIC Logon之后，WinCC中登录用的是Windows用户，WinCC中的用户不再起作用。WinCC用户管理器保留的功能只能用于建立与Windows中同名的用户组，然后给这些用户组分配权限，Windows中分配到这些用户组的账户就有了对应的权限。

缺少了管理用户如何添加新的账户，只能到Windows的用户管理中添加吗？有些项目要求尽量不要退出软件进入系统，避免增加风险，因为系统中的操作不会生成记录保存到WinCC中的审计追踪。因此以下内容介绍如何利用VB脚本在WinCC中实现管理用户的功能。

注意：要求以Administrator账户登录Windows系统执行代码。

 主画面

打开用户管理界面后，会自动显示拥有登录权限的Windows账户。

在画面对象的“打开画面”事件里写了读取并显示用户列表的代码，当打开这个画面时会自动执行代码查询用户列表，然后将用户列表写入画面中的MSHFlexGrid控件，该控件是微软提供的表格控件，以表格形式显示内容。MSHFlexGrid控件的对象名称为 userTable 。

读取用户列表的代码不止一个地方用，因此写成函数放在了全局声明区，点击下图的红色方框按钮可打开全局声明区。“打开画面”事件中只是调用函数 refresh() 。除了refresh()还有全局变量也写在的全局声明区里。

全局声明区里的代码如下：

'全局变量
Dim userGroups
userGroups = Array("Admins","Supervisors","Operators") '用户组列表，Windows要存在同名的用户组

'---------------------------------------------------------------------
' 读userGroupss数组中的用户组中的用户，
' 将用户列表写入MSHFlexGrid控件中，该控件对象名为"userTable"
'---------------------------------------------------------------------
Sub refresh()
	Dim userTable, row
	Set userTable = ScreenItems("userTable")
	userTable.Clear
	'列标题
	userTable.Cols = 10
	Select Case HMIRuntime.Language
		Case 2052
			userTable.TextMatrix(0,1)="用户名"
			userTable.TextMatrix(0,2)="用户全名"
			userTable.TextMatrix(0,3)="权限组"
			userTable.TextMatrix(0,4)="描述"
			userTable.TextMatrix(0,5)="用户锁定"
			userTable.TextMatrix(0,6)="用户禁用"
			userTable.TextMatrix(0,7)="密码永不过期"
			userTable.TextMatrix(0,8)="密码已过期"
			userTable.TextMatrix(0,9)="密码到期时间"
			userTable.ColWidth(2)=1500
			userTable.ColWidth(4)=6000
			userTable.ColWidth(7)=1200
			userTable.ColWidth(9)=2200
		Case Else
			userTable.TextMatrix(0,1)="User name"
			userTable.TextMatrix(0,2)="Full name"
			userTable.TextMatrix(0,3)="Group"
			userTable.TextMatrix(0,4)="Description"
			userTable.TextMatrix(0,5)="AccountLocked"
			userTable.TextMatrix(0,6)="AccountDisabled"
			userTable.TextMatrix(0,7)="PasswordNeverExpires"
			userTable.TextMatrix(0,8)="PasswordExpired"
			userTable.TextMatrix(0,9)="PasswordExpirationDate"	
			userTable.ColWidth(2)=1500
			userTable.ColWidth(4)=6000
			userTable.ColWidth(5)=1500
			userTable.ColWidth(6)=1500
			userTable.ColWidth(7)=2000
			userTable.ColWidth(8)=1500
			userTable.ColWidth(9)=2200	
	End Select

	Dim sGroup,sDomain
	Dim oGrp, oUser, oDomain
	
	row = 1
	sDomain = HMIRuntime.Tags("@NOP::@ServerName").Read

	Set oDomain = GetObject("WinNT://"&sDomain)
	'遍历用户组列表
	For Each sGroup In userGroups 'userGroups定义在全局变量中
		'获取组中用户列表
		Set oGrp = oDomain.GetObject("group",sGroup)
		For Each oUser In oGrp.Members
			userTable.Rows = row+1
			userTable.TextMatrix(row,0) = row
			userTable.TextMatrix(row,1) = oUser.Name
			userTable.TextMatrix(row,2) = oUser.FullName
			userTable.TextMatrix(row,3) = sGroup
			userTable.TextMatrix(row,4) = oUser.Description
			userTable.TextMatrix(row,5) = oUser.IsAccountLocked
			userTable.TextMatrix(row,6) = oUser.AccountDisabled
			If oUser.UserFlags And &H10000 Then
				userTable.TextMatrix(row,7) = True
			Else
				userTable.TextMatrix(row,7) = False
			End If
			If oUser.PasswordExpired Then
				userTable.TextMatrix(row,8) = True
			Else
				userTable.TextMatrix(row,8) = False
			End If
			userTable.TextMatrix(row,9) = oUser.PasswordExpirationDate
			row = row+1
		Next 
	Next 
End Sub

　

新建账户

点击新建账户按钮后弹出如下对话框，可以设置用户全名、权限组、描述、密码，还可以设置用户下次登录是否需要修改密码，密码是否会过期。

打开窗口时，需要把全局变量 userGroups的用户组写入到画面的“权限组”控件中。这里采用代码填写控件内容，而不是组态时就在控件中写入内容，如果需要修改用户组名称，只需要修改全局变量一个地方就可以了。在创建账户的按钮中写有以下代码：

ub OnClick(ByVal Item)           
	Dim objScreen, objGroup
	ScreenItems("CreateUserWin").Visible = True
	Set objScreen = ScreenItems("CreateUserWin").screen
	Set objGroup = objScreen.ScreenItems("Group")
	'给下拉框控件填写用户组名称
	objGroup.NumberLines = UBound(userGroups)+1
	Dim sGroupTemp,i
	i = 1
	For Each sGroupTemp In userGroups 'userGroups变量定义在全局声明区中
		objGroup.Index = i
		objGroup.Text = sGroupTemp
		i = i+1
	Next 
End Sub

　　

确定按钮的单击鼠标事件中代码如下。该代码中包含电子签名和审计追踪的代码，关于电子签名和审计追踪请查看《WinCC的电子签名与审计追踪 2.0》。

Sub OnClick(Byval Item)                                                       
	Dim sDomain, sUserName, sFullName, sDescription, sGroup, sPassword, sRepassword, bRequiredChange, bNeverExpires
	Dim oDomain, oUser, oGrp
	sUserName = Trim(ScreenItems("userName").OutputValue)
	sFullName = Trim(ScreenItems("fullName").OutputValue)
	sGroup = Trim(ScreenItems("Group").SelText)
	sDescription = Trim(ScreenItems("description").OutputValue)
	sPassword = Trim(ScreenItems("password").OutputValue)
	sRepassword = Trim(ScreenItems("repassword").OutputValue)
	bRequiredChange = ScreenItems("requiredChange").Process
	bNeverExpires = ScreenItems("neverExpires").Process
	
	If sUserName = "" Then
		Select Case HMIRuntime.Language
			Case 2052
				Msgbox "用户名不能为空！"
			Case Else
				Msgbox "User name cannot be empty！"
		End Select
		Exit Sub
	End If
	
	If sPassword<>sRepassword Then
		Select Case HMIRuntime.Language
			Case 2052
				Msgbox "两次输入密码不相同！"
			Case Else
				Msgbox "The two passwords are different！"
		End Select
		Exit Sub		
	End If
	If sPassword = "" Then
		Select Case HMIRuntime.Language
			Case 2052
				Msgbox "密码不能为空！"
			Case Else
				Msgbox "Password cannot be empty！"
		End Select
		Exit Sub
	End If
	sDomain = HMIRuntime.Tags("@NOP::@ServerName").Read
	Set oDomain = GetObject("WinNT://"&sDomain)
	
	Dim sComment
	If EsigDialog(sComment, False, "") = 1 Then
		On Error Resume Next
		Set oUser = oDomain.Create("user",sUserName)
		oUser.FullName = sFullName
		oUser.Description = sDescription
		oUser.SetPassword sPassword
		If bRequiredChange Then
			oUser.PasswordExpired = 1
		Else
			oUser.PasswordExpired = 0
		End If
		If bNeverExpires Then
			oUser.UserFlags = oUser.UserFlags Or &H10000
		Else
			oUser.UserFlags = oUser.UserFlags And Not &H10000
		End If
		oUser.SetInfo
		
		If Err.Number<>0 Then
			Msgbox ("An error has occurred！" &Err.Number &vbNewline& Err.Description)
			Exit Sub
		Else
			Select Case HMIRuntime.Language
				Case 2052
					Call CreateOpMsg("", "创建用户："&sUserName&" , 全名："&sFullName,"",sUserName, sComment)
				Case Else
					Call CreateOpMsg("", "Create user："&sUserName&" , Full name："&sFullName,"",sUserName, sComment)
			End Select
		End If
		
		Set oGrp = oDomain.GetObject("group",sGroup)
		oGrp.Add (oUser.AdsPath)
		
		If Err.Number<>0 Then
			Msgbox ("An error has occurred: " &Err.Number &vbNewline& Err.Description)
			Exit Sub
		Else
			Parent.Parent.ScreenItems("refresh").Process = Not Parent.Parent.ScreenItems("refresh").Process
			Select Case HMIRuntime.Language
				Case 2052
					Call CreateOpMsg("", "将用户 "&sUserName&" 添加到权限组 "&sGroup,"",sGroup ,sComment)
					Msgbox "创建成功"
				Case Else
					Call CreateOpMsg("", "Add user "&sUserName&" to the group"&sGroup,"",sGroup ,sComment)
					Msgbox "Create success"
			End Select
			Parent.Visible = False
		End If
	End If
End Sub

　　　　

完成新建账户后需要刷新用户列表，新建账户的窗口是通过画面窗口调用的，也就是在另一个画面中，没法调用到主画面的 refresh() 函数。为了尽可能减少重复的代码，保持代码一致性，在主画面中放置了一个对象名为"refresh"的复选框控件，在所选框更改事件中调用 refresh() 函数，然后将该控件设置为不可见。其他画面中的代码通过更改复选框控件的值来触发 refresh() 函数。相应代码如下，该代码在前面的代码中也有体现：

Parent.Parent.ScreenItems("refresh").Process = Not Parent.Parent.ScreenItems("refresh").Process

　　

删除账户

点击删除账户按钮后会弹出对话框确认要删除的账户，并且要进行电子签名。执行该操作后将把账户从Windows中删除。

 按钮代码如下：

Sub OnClick(Byval Item)                     
	Dim userTable
	Set userTable = ScreenItems("userTable") 
	
	Dim Row, userName, response
	row = userTable.Row
	If row <= 0 Or userTable.TextMatrix(row,1)="" Then
		Select Case HMIRuntime.Language
			Case 2052
				Msgbox "请选择一个账户！"
			Case Else
				Msgbox "Please select an account!"
		End Select
		Exit Sub
	End If
	userName = userTable.TextMatrix(row,1)
	
	Dim sDomain
	Dim oDomain
	sDomain = HMIRuntime.Tags("@NOP::@ServerName").Read
	Set oDomain = GetObject("WinNT://"&sDomain)
	
	Select Case HMIRuntime.Language
		Case 2052
			response = Msgbox( "确定删除账户 "&userName&" 吗？",vbOKCancel+vbQuestion)
		Case Else
			response = Msgbox( "Are you sure to delete user "&userName&" ?",vbOKCancel+vbQuestion)
	End Select
	
	If response = vbOK Then
		Dim sComment
		If EsigDialog(sComment, False, "") = 1 Then
			On Error Resume Next
			oDomain.Delete "user",userName
			If Err.Number=0 Then
				refresh()
				Select Case HMIRuntime.Language
					Case 2052
						Call CreateOpMsg("", "删除账户 "&userName,"","", sComment)
						Msgbox "账户 "&userName&" 已删除"
					Case Else
						Call CreateOpMsg("", "Delete user "&userName,"","", sComment)
						Msgbox "user "&userName&" deleted"
				End Select
			Else 
				Msgbox ("An error has occurred: " &Err.Number&vbNewline& Err.Description)
				Exit Sub
			End If
		End If
	End If
End Sub

　　

重置密码

如果用户忘记了自己的密码，就需要管理员将密码重置。点击重置密码按钮后弹出如下对话框。

 打开上面窗口前，需要判断是否选择了一个账户，并将账户名和权限组写入窗口的内容中，重置密码按钮中有相关脚本，代码如下：

Sub OnClick(Byval Item)                                    
	Dim userTable
	Set userTable = ScreenItems("userTable") 
	
	Dim Row, userName, Group
	row = userTable.Row
	If row <= 0 Or userTable.TextMatrix(row,1)="" Then
		Select Case HMIRuntime.Language
			Case 2052
				Msgbox "请选择一个账户！"
			Case Else
				Msgbox "Please select an account!"
		End Select	
		Exit Sub
	End If
	userName = userTable.TextMatrix(row,1)
	Group = userTable.TextMatrix(row,3)
	
	Dim objScreen
	ScreenItems("ResetPasswrodWin").Visible = True
	Set objScreen = ScreenItems("ResetPasswrodWin").screen
	objScreen.ScreenItems("userName").OutputValue = userName
	objScreen.ScreenItems("Group").OutputValue = Group
End Sub

　　　　

重置密码的确认按钮中代码如下：

Sub OnClick(Byval Item)                       
	Dim userName, Group, password, repassword
	userName = Trim(ScreenItems("userName").OutputValue)
	Group = Trim(ScreenItems("Group").OutputValue)
	password = Trim(ScreenItems("password").OutputValue)
	repassword = Trim(ScreenItems("repassword").OutputValue)
	
	If password="" Then
		Select Case HMIRuntime.Language
			Case 2052
				Msgbox "密码不能为空！"
			Case Else
				Msgbox "Password cannot be empty！"
		End Select
		Exit Sub		
	End If
	
	If password<>repassword Then
		Select Case HMIRuntime.Language
			Case 2052
				Msgbox "两次输入密码不相同！"
			Case Else
				Msgbox "The two passwords are different！"
		End Select
		Exit Sub		
	End If
	
	Dim sDomain
	Dim oDomain, oUser
	sDomain = HMIRuntime.Tags("@NOP::@ServerName").Read
	Set oDomain = GetObject("WinNT://"&sDomain)
	Set oUser = oDomain.GetObject("user",userName)
	Dim sComment
	If EsigDialog(sComment, False, "") = 1 Then
		oUser.SetPassword password
		oUser.PasswordExpired = 1 '下次登录需修改密码
        oUser.SetInfo
        
		If Err.Number=0 Then
			Parent.Parent.ScreenItems("refresh").Process = Not Parent.Parent.ScreenItems("refresh").Process
			Select Case HMIRuntime.Language
				Case 2052
					Call CreateOpMsg("", "重置账户 "&userName&" 的密码","","", sComment)
					Msgbox "账户 "&userName&" 的密码已重置"
				Case Else
					Call CreateOpMsg("", "Reset password of account "&userName,"","", sComment)
					Msgbox "Password of account "&userName&" has been reset"
			End Select		
			Parent.Visible = False
		Else 
			Msgbox ("An error has occurred: " &Err.Number&vbNewline& Err.Description)
			Exit Sub
		End If
	End If
End Sub

　　

解锁账户

 在Windows中设置安全策略后，如果用户多次输错密码，该账户就会被锁定，必须等待一段时间之后才能登录，或者让管理员手动解锁该账户。

解锁按钮脚本如下：

Sub OnClick(Byval Item)                              
	Dim userTable
	Set userTable = ScreenItems("userTable") 
	
	Dim Row, userName, response, locked
	row = userTable.Row
	If row <= 0 Or userTable.TextMatrix(row,1)="" Then
		Select Case HMIRuntime.Language
			Case 2052
				Msgbox "请选择一个账户！"
			Case Else
				Msgbox "Please select an account!"
		End Select
		Exit Sub
	End If
	userName = userTable.TextMatrix(row,1)
	locked = userTable.TextMatrix(row,5)
	If locked="False" Then
		Select Case HMIRuntime.Language
			Case 2052
				Msgbox "账户 "&userName&" 未被锁定"
			Case Else
				Msgbox "Account "&userName&" is not locked"
		End Select
		Exit sub
	End If
	
	Dim sDomain
	Dim oDomain, oUser
	sDomain = HMIRuntime.Tags("@NOP::@ServerName").Read
	Set oDomain = GetObject("WinNT://"&sDomain)
	Set oUser = oDomain.GetObject("user",userName)
	Select Case HMIRuntime.Language
		Case 2052
			response = Msgbox( "确定解锁账户 "&userName&" 吗？",vbOKCancel+vbQuestion)
		Case Else
			response = Msgbox( "Are you sure to unlock account "&userName&" ?",vbOKCancel+vbQuestion)
	End Select
	
	If response = vbOK Then
		Dim sComment
		If EsigDialog(sComment, False, "") = 1 Then
			On Error Resume Next 
			oUser.IsAccountLocked = False
			oUser.SetInfo
			If Err.Number=0 Then
				refresh()
				Select Case HMIRuntime.Language
					Case 2052
						Call CreateOpMsg("", "解锁账户 "&userName,"","", sComment)
						Msgbox "账户 "&userName&" 已解锁"
					Case Else
						Call CreateOpMsg("", "Unlock account "&userName,"","", sComment)
						Msgbox "Account "&userName&" unlocked"
				End Select
			Else 
				Msgbox ("An error has occurred: " &Err.Number&vbNewline& Err.Description)
				Exit Sub
			End If
		End If
	End If
End Sub

　　

更改权限组

该按钮用于变更账户所属的权限组。虽然Windows中一个账户可以隶属于多个用户组，但在WinCC中为了保持权限清晰明确，在此设计为将账户添加到新权限组后，就会从老权限组删除。

点击更改权限组按钮后，会弹出一个对话框，该按钮中也有一些脚本用于向对话框写入内容。

更改权限组按钮脚本如下：

Sub OnClick(Byval Item)             
	Dim userTable
	Set userTable = ScreenItems("userTable") 
	
	Dim Row, userName, Group
	row = userTable.Row
	If row <= 0 Or userTable.TextMatrix(row,1)="" Then
		Select Case HMIRuntime.Language
			Case 2052
				Msgbox "请选择一个账户！"
			Case Else
				Msgbox "Please select an account!"
		End Select		
		Exit Sub
	End If
	userName = userTable.TextMatrix(row,1)
	Group = userTable.TextMatrix(row,3)
	
	Dim objScreen
	ScreenItems("ChangeUserGroupWin").Visible = True
	Set objScreen = ScreenItems("ChangeUserGroupWin").screen
	objScreen.ScreenItems("userName").OutputValue = userName
	objScreen.ScreenItems("oldGroup").OutputValue = Group
	'给下拉框控件填写用户组名称
	Dim objGroup
	Set objGroup = objScreen.ScreenItems("NewGroup")
	objGroup.NumberLines = UBound(userGroups)+1
	Dim sGroupTemp,i
	i = 1
	For Each sGroupTemp In userGroups 'userGroups变量定义在全局声明区中
		objGroup.Index = i
		objGroup.Text = sGroupTemp
		i = i+1
	Next 
End Sub

　　

 更改权限组确定按钮中的脚本如下：

Sub OnClick(Byval Item)                            
	Dim userName, oldGroup, newGroup
	userName = Trim(ScreenItems("userName").OutputValue)
	oldGroup = Trim(ScreenItems("oldGroup").OutputValue)
	newGroup = Trim(ScreenItems("newGroup").SelText)
	
	If oldGroup=newGroup Then
		Select Case HMIRuntime.Language
			Case 2052
				Msgbox "请选择不同的权限组！"
			Case Else
				Msgbox "Please select a different group!"
		End Select

		Exit Sub		
	End If
	
	Dim sDomain
	Dim oDomain, oUser, oNewGrp, oOldGrp
	sDomain = HMIRuntime.Tags("@NOP::@ServerName").Read
	Set oDomain = GetObject("WinNT://"&sDomain)
	Set oOldGrp = oDomain.GetObject("group",oldGroup)
	Set oNewGrp = oDomain.GetObject("group",newGroup)
	Set oUser = oDomain.GetObject("user",userName)
	
	Dim sComment
	If EsigDialog(sComment, False, "") = 1 Then
		On Error Resume Next
		oOldGrp.Remove (oUser.AdsPath)
		oNewGrp.Add (oUser.AdsPath)
		
		If Err.Number=0 Then
			Parent.Parent.ScreenItems("refresh").Process = Not Parent.Parent.ScreenItems("refresh").Process
			Select Case HMIRuntime.Language
				Case 2052
					Call CreateOpMsg("", "更改账户 "&userName&" 的权限组", oldGroup, newGroup, sComment)
					Msgbox "账户 "&userName&" 已从权限组 "&oldGroup&" 移动到 "&newGroup
				Case Else
					Call CreateOpMsg("", "Change the group of account "&userName, oldGroup, newGroup, sComment)
					Msgbox "Account "&userName&" moved from group "&oldGroup&" to group "&newGroup
			End Select
			Parent.Visible = False
		Else 
			Msgbox ("An error has occurred: " &Err.Number&vbNewline& Err.Description)
			Exit Sub
		End If
	End If
End Sub

　　

修改账户

不常用的账户修改选项都放在了修改账户对话框中。点击修改账户按钮会弹出如下对话框。

修改账户按钮中的脚本如下：

Sub OnClick(Byval Item)                                                        
	Dim userTable
	Set userTable = ScreenItems("userTable") 
	
	Dim Row
	row = userTable.Row
	If row <= 0 Or userTable.TextMatrix(row,1)="" Then
		Select Case HMIRuntime.Language
			Case 2052
				Msgbox "请选择一个账户！"
			Case Else
				Msgbox "Please select an account!"
		End Select		
		Exit Sub
	End If
	Dim sUserName, sGroup, sFullName, sDescription, bRequiredChange, bNeverExpires, bAccountDisabled
	sUserName = userTable.TextMatrix(row,1)
	sFullName = userTable.TextMatrix(row,2)
	sGroup = userTable.TextMatrix(row,3)
	sDescription = userTable.TextMatrix(row,4)
	bAccountDisabled = userTable.TextMatrix(row,6)
	bNeverExpires = userTable.TextMatrix(row,7)
	bRequiredChange = userTable.TextMatrix(row,8)

	Dim objScreen
	ScreenItems("modifyUserWin").Visible = True
	Set objScreen = ScreenItems("modifyUserWin").screen
	objScreen.ScreenItems("userName").OutputValue = sUserName
	objScreen.ScreenItems("fullName").OutputValue = sFullName
	objScreen.ScreenItems("description").OutputValue = sDescription
	'给下拉框控件填写用户组名称
	Dim oGroup
	Set oGroup = objScreen.ScreenItems("Group")
	oGroup.NumberLines = UBound(userGroups)+1
	Dim sGroupTemp,i
	i = 1
	For Each sGroupTemp In userGroups 'userGroups变量定义在全局声明区中
		oGroup.Index = i
		oGroup.Text = sGroupTemp
		i = i+1
	Next 	
	Do While True
		If oGroup.SelText = sGroup Then
			Exit Do
		End If
		If oGroup.SelIndex = oGroup.NumberLines Then
			Exit Do
		Else
			oGroup.SelIndex = oGroup.SelIndex + 1
		End If
	Loop
		
	If bRequiredChange Then
		objScreen.ScreenItems("requiredChange").Process = 1
	Else
		objScreen.ScreenItems("requiredChange").Process = 0
	End If 
	If bNeverExpires Then
		objScreen.ScreenItems("neverExpires").Process = 1
	Else
		objScreen.ScreenItems("neverExpires").Process = 0
	End If
	If bAccountDisabled Then
		objScreen.ScreenItems("AccountDisabled").Process = 1
	Else
		objScreen.ScreenItems("AccountDisabled").Process = 0
	End If
	
	objScreen.ScreenItems("done").Process = 1

End Sub

　　

“修改账户”画面中有个命名为"done"的复选框控件，被设成了不可见状态。前面的代码中最后一条指令就是给这个控件赋值。这个控件的事件中有一段代码用于保存账户当前的属性，属性值被保存的全局变量中，当控件被赋值之后就会触发该代码。之后修改了账户的属性，可以跟之前的保存的值对比，以判断哪些属性被修改了。

 

全局声明区代码：

Dim sOldFullName, sOldDescription, sOldGroup, bOldRequiredChange, bOldNeverExpires, bOldAccountDisabled

　

控件的“所选项”事件代码：

Sub Process_OnPropertyChanged(ByVal Item, ByVal value)  
	sOldFullName = Trim(ScreenItems("fullName").OutputValue)
	sOldGroup = Trim(ScreenItems("Group").SelText)
	sOldDescription = Trim(ScreenItems("description").OutputValue)
	bOldAccountDisabled = ScreenItems("AccountDisabled").Process
	bOldRequiredChange = ScreenItems("requiredChange").Process
	bOldNeverExpires = ScreenItems("neverExpires").Process
End Sub

　　

确定按钮中的代码如下。事实上重置密码、解锁账户、更改权限组的功能都能做到以下代码中，但是考虑到重要的操作应该单独执行，所以把重置密码、解锁账户、修改权限组分别单独做了一个按钮。

Sub OnClick(Byval Item)                                                          
	Dim sDomain, sUserName, sFullName, sDescription, sGroup, sPassword, sRepassword, bRequiredChange, bNeverExpires, bAccountDisabled
	sUserName = Trim(ScreenItems("userName").OutputValue)
	sFullName = Trim(ScreenItems("fullName").OutputValue)
	sGroup = Trim(ScreenItems("Group").SelText)
	sDescription = Trim(ScreenItems("description").OutputValue)
	'sPassword = Trim(ScreenItems("password").OutputValue)
	'sRepassword = Trim(ScreenItems("repassword").OutputValue)
	bAccountDisabled = ScreenItems("AccountDisabled").Process
	bRequiredChange = ScreenItems("requiredChange").Process
	bNeverExpires = ScreenItems("neverExpires").Process
	
'	If sPassword<>sRepassword Then
'		Msgbox "两次输入密码不相同！"
'		Exit Sub		
'	End If
'	If sPassword = "" Then
'		Msgbox "密码不能为空！"
'		Exit Sub
'	End If
	Dim oDomain, oUser, oGrp
	sDomain = HMIRuntime.Tags("@NOP::@ServerName").Read
	Set oDomain = GetObject("WinNT://"&sDomain)
	Set oUser = oDomain.GetObject("user",sUserName)
	
	Dim sComment
	If EsigDialog(sComment, False, "") = 1 Then
		On Error Resume Next
		oUser.FullName = sFullName
		oUser.Description = sDescription
		'oUser.SetPassword sPassword
		If bAccountDisabled Then
			oUser.AccountDisabled = True
		Else
			oUser.AccountDisabled = False
		End If
		If bRequiredChange Then
			oUser.PasswordExpired = 1
		Else
			oUser.PasswordExpired = 0
		End If
		If bNeverExpires Then
			oUser.UserFlags = oUser.UserFlags Or &H10000
		Else
			oUser.UserFlags = oUser.UserFlags And Not &H10000
		End If
		oUser.SetInfo
	
	'	If Err.Number<>0 Then
	'		Msgbox ("An error has occurred！" &vbNewline& Err.Description)
	'		Exit Sub
	'	End If
		
	'	Set oGrp = oDomain.GetObject("group",sGroup)
	'	oGrp.Add (oUser.AdsPath)
	
		If Err.Number=0 Then
			Parent.Parent.ScreenItems("refresh").Process = Not Parent.Parent.ScreenItems("refresh").Process
			Select Case HMIRuntime.Language
				Case 2052
					If sFullName <> sOldFullName Then
						Call CreateOpMsg("", "修改账户 "&sUserName&" 的全名" , sOldFullName, sFullName, sComment)
					End If
					If sDescription <> sOldDescription Then
						Call CreateOpMsg("", "修改账户 "&sUserName&" 的描述" , sOldDescription, sDescription, sComment)
					End If
					If bAccountDisabled <> bOldAccountDisabled Then
						Call CreateOpMsg("", "设定账户 "&sUserName&" 被禁用" , bOldAccountDisabled, bAccountDisabled, sComment)
					End If
					If bRequiredChange <> bOldRequiredChange Then
						Call CreateOpMsg("", "设定账户 "&sUserName&" 下次登录需要修改密码" , bOldRequiredChange, bRequiredChange, sComment)
					End If
					If bNeverExpires <> bOldNeverExpires Then
						Call CreateOpMsg("", "设定账户 "&sUserName&" 密码永不过期" , bOldNeverExpires, bNeverExpires, sComment)
					End If
					Msgbox "修改成功"
				Case Else
					If sFullName <> sOldFullName Then
						Call CreateOpMsg("", "Modify the full name of user "&sUserName , sOldFullName, sFullName, sComment)
					End If
					If sDescription <> sOldDescription Then
						Call CreateOpMsg("", "Modify the description of user "&sUserName , sOldDescription, sDescription, sComment)
					End If
					If bAccountDisabled <> bOldAccountDisabled Then
						Call CreateOpMsg("", "Disable account "&sUserName , bOldAccountDisabled, bAccountDisabled, sComment)
					End If
					If bRequiredChange <> bOldRequiredChange Then
						Call CreateOpMsg("", "User "&sUserName&" must change password at next logon" , bOldRequiredChange, bRequiredChange, sComment)
					End If
					If bNeverExpires <> bOldNeverExpires Then
						Call CreateOpMsg("", "Pasword of user "&sUserName&" never expires" , bOldNeverExpires, bNeverExpires, sComment)
					End If
					Msgbox "Modified success"
			End Select
			Parent.Visible = False
		Else 
			Msgbox ("An error has occurred: " &Err.Number&vbNewline& Err.Description)
			Exit Sub
		End If
	End If
End Sub

　　

 以上代码中用于管理Windows账户的代码详见说明：https://www.cnblogs.com/yada/p/11799174.html

源程序下载：WinCC用户管理