VBA 类模块系列之十一——类代码中的警察（二）

在《系列之九——类中的常量》中，我们为类定义了枚举类型的性别常量

Public Enum pGender
    Female = 0
    Male = 1
End Enum

然后在测试代码中为性别属性赋值的时候，IDE的智能提示跑了出来：

我当时拍着胸脯说，这回，类的使用者不会瞎给性别属性赋值了。好吧，我承认当时有点说大话了。因为当时闻到空气中兴奋的气味，所以不想扫大家的兴。

我们弄个极端的例子：某泰国的lady boy在给这个属性赋值的时候，一看提示出来的2个选项，没有一个是他（or 她？）能选的。心想，MD，这不是明摆的歧视我这个第3性嘛，我就给赋个值3，然后编译一下，居然编译通过了！

Sub test()
    Dim objperson As Person
    Set objperson = New Person
    
    objperson.Name = "赵冰冰"
    objperson.Gender = 3
    objperson.Speak
    
    MsgBox "修改前性别:" & objperson.Gender
    objperson.Gender = Male
    MsgBox "修改后性别:" & objperson.Gender
'
'以下代码省略
'
End Sub

为什么能编译通过？还记得我说过，枚举常量用起来是非常简单的，简单到什么程度？不负责任的程度^_^。枚举类型，从本质上讲，是长整形（Long），你拿任何一个长整形的值赋给它，它都无条件接受。至于你在这个枚举类型下面，定义了多少个常量，它一概不管。

好吧，既然你知道了类中枚举常量的底线轻易的就可以被人突破，导致类的属性，被设置了非法的值，你说怎么办？既然是非法，当然得交给警察来管！

我们终于切入正题了。

我们将原来性别赋值属性子程序（Public Property Let Gender）中的代码全部删掉（相信你已经掌握了如何设计只赋值一次的属性），在其中按照上一篇的样式设置警察，警察局如下面代码所示：

Public Property Let Gender(lenumGender As pGender)
    On Error GoTo ErrHandler
    If lenumGender <> Female And lenumGender <> Male Then
        '?
    Else
        menumGender = lenumGender
    End If
ExitProcedure:
    On Error Resume Next
    '退出前的善后工作
Exit Property
ErrHandler:
    '在警察局要做的事
    Resume ExitProcedure
End Property

第2行，第8-14行，就是我们上一篇介绍的内容，不再赘述。
第3行代码，很容易理解，如果属性被赋的值，既不是男，又不是女，那就是非法的值了！
第5-7行，是合法的赋值。

现在问题就来了，第4行我们要写什么代码，才能让警察现身？上一篇是故意用一个0作为除数，本篇还要这么搞一下么？这样固然可以把警察召唤出来，但是有点为了目的，不择手段的感觉，咱们可都是有品味的人^_^。

我们这里的困境是，属性被赋了非法的值以后，怎么才能让警察知道？等等，什么是非法？这个法律是谁说了算？是你规定了性别只能是男和女，当然是你说了算。既然别人给性别赋了一个既不是男，又不是女的值，你就得跳出来说，这是非法的！而不是自己做一件非法的事（比如弄个0做为除数），以便故意把警察引出来。所以现在的问题是：你通过什么指控别人非法？

每当你穷尽脑汁还是一筹莫展的时候，就是学习新东西的时候了。话说，你对 “Err” 这个系统对象，了解么？作为一个有一定经验的VBA开发人员，你使用这个系统对象，多半都是在错误处理程序当中，当发生运行时错误了，你一般会去调用 Err.Description 来看看错误说明。这个对象还能用来指控别人非法！怎么指控？用Err对象的Raise方法（raise可以翻译理解为提起诉讼的意思）。

Err.Raise的第一个参数是错误代码（Number），可以理解为违反的是第几条法律。不要忘记了，性别必须是男或者女，这法律可是你定的，我C，有没有一种很爽的感觉？^_^，虽然这条法律是你说了算，但是你在给它编号的时候，要注意不要使用系统中已经被占用的错误编号。我们修改第4行代码如下：

Public Property Let Gender(lenumGender As pGender)
    On Error GoTo ErrHandler
    If lenumGender <> Female And lenumGender <> Male Then
        Err.Raise Number:=vbObjectError + 513, Source:="Person:Gender", Description:="性别必须为男或女"
    Else
        menumGender = lenumGender
    End If
ExitProcedure:
    On Error Resume Next
    '退出前的善后工作
Exit Property
ErrHandler:
    '在警察局要做的事
    Resume ExitProcedure
End Property

第4行代码，给错误编号为vbObjectError+513，为什么弄这么一个奇怪的编号？因为vbObjectError+512之前的号码都被占用了。vbObjectError是一个系统常量。另外，我们设置了错误的来源（Source）和错误的描述（Description）。

代码运行到第4行，被宣布违反了你制定的法律以后，警察就把你拷起来带到了警察局，第13行。

问题又来了，在警察局你要做什么事？上一篇是用MsgBox检讨了错误，就给放了。这里你要做同样的事情吗？当然，这个决定权在你。你可以MsgBox弹出来告诉用户，它违反了你的什么法律，你还能在这里将这件事记下来，写入数据库中，留下永久的案底。你想怎样都可以，因为在编程的世界里，你是上帝。^_^

对于现在的情况，我的建议是，将错误上报给上级机关，然后，然后就没有然后了。这样有什么好处吗？呃，省事，我只负责立法和司法，确保我设计的类中没有违法乱纪的行为。行政处罚就交给使用我的类对象的上级主管单位吧，是做检讨撤案，还是写入档案，由类的使用者来决定。

我们修改第13行代码如下：

Public Property Let Gender(lenumGender As pGender)
    On Error GoTo ErrHandler
    If lenumGender <> Female And lenumGender <> Male Then
        Err.Raise Number:=vbObjectError + 513, Source:="Person:Gender", Description:="性别必须为男或女"
    Else
        menumGender = lenumGender
    End If
ExitProcedure:
    On Error Resume Next
    '退出前的善后工作
Exit Property
ErrHandler:
    Err.Raise Err.Number, Err.Source, Err.Description
    Resume ExitProcedure
End Property

第13行我们还是用的Err.Raise来向调用这个子程序的程序提起违法诉讼。

现在我们整体梳理一遍这个警察故事二：首先我们设了一个警察和警察局，然后当性别被赋予违法的值的时候，我们提起了指控，代码被带到警察局，警察局直接将指控上报给了上级机关。

发现问题没有？如果警察只是把罪犯抓起来送给上级，和没有警察是一样的。因为上一篇讲过，如果你在县里不设置警察，代码在县里发生的运行时错误，会自动上报至市里的警察。所以我们可以把县里的所有警察和警察局都撤掉，代码如下：

Public Property Let Gender(lenumGender As pGender)
    If lenumGender <> Female And lenumGender <> Male Then
        Err.Raise Number:=vbObjectError + 513, Source:="Person:Gender", Description:="性别必须为男或女"
    Else
        menumGender = lenumGender
    End If
End Property

世界一下子清净了不少^_^

我们修改一下类的测试代码如下：

Sub Test()
On Error GoTo ErrHandler
    Dim objperson As Person
    Set objperson = New Person
    
    objperson.Name = "赵冰冰"
    objperson.Gender = 3
    objperson.Speak
 
    MsgBox "修改前性别:" & objperson.Gender
    objperson.Gender = Male
    MsgBox "修改后性别:" & objperson.Gender
    
'    objperson.DOB = #2/3/1995#
'    Debug.Print objperson.DOBtoString       '立即窗口值：1995年02月03日
'    Debug.Print objperson.Age               '立即窗口值：23
'    objperson.DOB = #6/10/1995#
'    Debug.Print objperson.DOBtoString       '立即窗口值：1995年02月03日
ExitProcedure:
    On Error Resume Next
Exit Sub
ErrHandler:
    MsgBox "错误代码：" & Err.Number & VBA.vbCrLf & _
           "错误描述：" & Err.Description & VBA.vbCrLf & _
           "错误来源: " & Err.Source, _
           vbCritical, _
           "Test 报错"
    Resume ExitProcedure
End Sub

F8逐步执行一下就会知道，虽然你将性别赋值为3，编译器没有检测出非法代码，运行的时候还是没逃出法律的制裁。

最后，按惯例，将最终全部代码贴给大家。

'模块1 测试代码
Option Compare Database
Option Explicit
 
Sub Test()
On Error GoTo ErrHandler
    Dim objperson As Person
    Set objperson = New Person
    
    objperson.Name = "赵冰冰"
    objperson.Gender = 3
    objperson.Speak
 
    MsgBox "修改前性别:" & objperson.Gender
    objperson.Gender = Male
    MsgBox "修改后性别:" & objperson.Gender
    
'    objperson.DOB = #2/3/1995#
'    Debug.Print objperson.DOBtoString       '立即窗口值：1995年02月03日
'    Debug.Print objperson.Age               '立即窗口值：23
'    objperson.DOB = #6/10/1995#
'    Debug.Print objperson.DOBtoString       '立即窗口值：1995年02月03日
ExitProcedure:
    On Error Resume Next
Exit Sub
ErrHandler:
    MsgBox "错误代码：" & Err.Number & VBA.vbCrLf & _
           "错误描述：" & Err.Description & VBA.vbCrLf & _
           "错误来源: " & Err.Source, _
           vbCritical, _
           "Test 报错"
    Resume ExitProcedure
End Sub
 
Sub test2()
    Dim a As Integer
    a = 100
    Debug.Print a
End Sub
 
Sub test3()
    Dim objperson As Person
    Set objperson = New Person
    
    objperson.Name = "赵冰冰"
    objperson.Gender = Female
    objperson.Speak
End Sub
 
Sub Test4()
    Dim objPerson1 As Person
    Dim objPerson2 As Person
    
    Set objPerson1 = New Person
    Set objPerson2 = objPerson1
    Debug.Print objPerson1 Is objPerson2
    Set objPerson1 = Nothing
    Stop
    Set objPerson2 = Nothing
End Sub

'Person 类代码
Option Compare Database
Option Explicit
 
Private mstrName As String
Private menumGender As pGender
Private mstrSituation As String
Private mdatDOB As Date
 
Public Enum pGender
    Female = 0
    Male = 1
End Enum
 
Public Sub Speak()
    Select Case Situation
        Case "一般"
            MsgBox Left(Name, 1) & "小姐"
        Case "正式"
            MsgBox Left(Name, 1) & "女士"
        Case "撩"
            MsgBox "小姐姐"
        Case Else
            MsgBox Name
    End Select
End Sub
 
Private Sub Class_Initialize()
    Debug.Print "我出生了！"
    Situation = "一般"
End Sub
 
Private Sub Class_Terminate()
    Debug.Print "我挂了！"
End Sub
 
Public Property Get Name() As String
    Name = mstrName
End Property
Public Property Let Name(lstrName As String)
    If Len(lstrName) <= 4 Then
        mstrName = lstrName
    Else
        MsgBox "姓名不能超过4个字符"
    End If
End Property
 
Public Property Get Gender() As pGender
    Gender = menumGender
End Property

'版本1
'Public Property Let Gender(lenumGender As pGender)
'    Static blnFlag As Boolean
'    If blnFlag = False Then
'        blnFlag = True
'        menumGender = lenumGender
'    Else
'        MsgBox "性别一旦设定，就无法修改"
'    End If
'End Property

'版本2
'Public Property Let Gender(lenumGender As pGender)
'    On Error GoTo ErrHandler
'    If lenumGender <> Female And lenumGender <> Male Then
'        Err.Raise Number:=vbObjectError + 513, Source:="Person:Gender", Description:="性别必须为男或女"
'    Else
'        menumGender = lenumGender
'    End If
'ExitProcedure:
'    On Error Resume Next
'    '退出前的善后工作
'Exit Property
'ErrHandler:
'    Err.Raise Err.Number, Err.Source, Err.Description
'    Resume ExitProcedure
'End Property

'版本3
Public Property Let Gender(lenumGender As pGender)
    If lenumGender <> Female And lenumGender <> Male Then
        Err.Raise Number:=vbObjectError + 513, Source:="Person:Gender", Description:="性别必须为男或女"
    Else
        menumGender = lenumGender
    End If
End Property

Public Property Get Situation() As String
    Situation = mstrSituation
End Property
Public Property Let Situation(lstrSituation As String)
    mstrSituation = lstrSituation
End Property
 
Public Property Let DOB(ldatDOB As Date)
    Static blnFlag As Boolean
    If blnFlag = False Then
        blnFlag = True
        mdatDOB = ldatDOB
    End If
End Property
Public Property Get DOBtoString() As String
    DOBtoString = Format(mdatDOB, "YYYY年mm月dd日")
End Property
 
Public Property Get Age() As Integer
    Age = DateDiff("yyyy", mdatDOB, Date)
End Property

发表回复取消回复

杰森虎发表在 Access 用户界面 v1.0（公开源代码）2024-04-16
去年更新了一个版本，做了一点调整，还没有…
xiaowuo 发表在 Access 用户界面 v1.0（公开源代码）2021-08-12
@杰森虎，您好，请问现在有Jasofti…
呵呵发表在 Access 与 Excel 之对比（翻译）2021-03-07
说这种话的，基本就是那种初中毕业的垃圾了
xuexi 发表在 VBA 类模块系列之十二——揭开事件的真相以及使用WithEvents2021-02-15
博主加油非常感谢.
杰森虎发表在 Access 用户界面 v1.0（公开源代码）2020-12-06
已经修复，感谢提醒。

发表回复 取消回复

发表回复取消回复