虽然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用户管理