VB/VBA 车架号、身份证、统一社会信用码校验函数(有待优化)

Function isVIN(VIN As String) As Boolean
    ' 检查车架号VIN是否符合标准
    ' 参数:
    '   VIN:需要检查的车架号字符串
    ' 返回值:
    ' Boolean: 正确返回True,错误返回False
    If TypeName(VIN) <> "String" Then ' 如果不是文本,退出检查
        isVIN = False
        Exit Function
    End If
    
    If Len(Trim(VIN)) <> 17 Then ' 如果没有17位,退出检查
        isVIN = False
        Exit Function
    End If

    VIN = UCase(VIN)
    Dim RE As Object
    Set RE = CreateObject("VBScript.RegExp")
    RE.Pattern = "^[A-HJ-NPR-Z\d]{8}[X\d][A-HJ-NPR-Z\d]{3}\d{5}$"

    If Not RE.Test(VIN) Then ' 如果不符合正则要求,退出检查
        isVIN = False
        Exit Function
    End If

    Dim cOT As Object
    Set cOT = CreateObject("Scripting.Dictionary")
    cOT.Add "0", 0
    cOT.Add "1", 1
    cOT.Add "2", 2
    cOT.Add "3", 3
    cOT.Add "4", 4
    cOT.Add "5", 5
    cOT.Add "6", 6
    cOT.Add "7", 7
    cOT.Add "8", 8
    cOT.Add "9", 9
    cOT.Add "A", 1
    cOT.Add "B", 2
    cOT.Add "C", 3
    cOT.Add "D", 4
    cOT.Add "E", 5
    cOT.Add "F", 6
    cOT.Add "G", 7
    cOT.Add "H", 8
    cOT.Add "J", 1
    cOT.Add "K", 2
    cOT.Add "L", 3
    cOT.Add "M", 4
    cOT.Add "N", 5
    cOT.Add "P", 7
    cOT.Add "R", 9
    cOT.Add "S", 2
    cOT.Add "T", 3
    cOT.Add "U", 4
    cOT.Add "V", 5
    cOT.Add "W", 6
    cOT.Add "X", 7
    cOT.Add "Y", 8
    cOT.Add "Z", 9

    Dim xWT As Variant
    xWT = Array(8, 7, 6, 5, 4, 3, 2, 10, 0, 9, 8, 7, 6, 5, 4, 3, 2)

    Dim sum As Long
    For i = 1 To 17
        sum = sum + cOT(Mid(VIN, i, 1)) * xWT(i - 1)
    Next i

    Dim cT As Variant
    cT = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "X")

    isVIN = (cT(sum Mod 11) = Mid(VIN, 9, 1))

End Function
<< 1 >>

Powered By Z-BlogPHP 1.7.0

@2021 yunfeng.net.cn 版权所有
浙ICP备16007973号-1