如何在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