18位身份证合法性校验函数

lbpp

1. Function 身份证校验(ByVal sID_Code As String) As Boolean
   
2. 
   
3. ' lit_bear_pp@163.com
   
4. ' 2021-08-10
   
5. 
   
6. ' 本代码可校验身份证的合法性（含校验位）
   
7. ' 参考文档 GB 11643-1999
   
8. ' http://c.gb688.cn/bzgk/gb/showGb?type=online&hcno=080D6FBF2BB468F9007657F26D60013E
   
9. 
   
10.     Dim ci As String        '身份证号中的单个字符
    
11.     Dim ai As Integer
    
12.     Dim Wi As Integer
    
13.     Dim Sum_aiwi As Integer
    
14.     Sum_aiwi = 0
    
15. 
    
16.     Dim bReturn As Boolean
    
17.     bReturn = False
    
18.    
    
19.     Dim i As Integer
    
20.         
    
21.     sID_Code = Trim(sID_Code)
    
22. 
    
23.     Const ID_PATTERN As String = "^\d{17}[0-9Xx]$"  '身份证长度及组成模式校验
    
24. 
    
25.     Dim obj_Regexp As Object
    
26.    
    
27.     Set obj_Regexp = CreateObject("VBScript.RegExp")
    
28.     With obj_Regexp
    
29.         .Global = True
    
30.         .pattern = ID_PATTERN
    
31.     End With
    
32. 
    
33.     If obj_Regexp.test(sID_Code) Then
    
34.    
    
35.         ' 合法性校验
    
36.         For i = 1 To 18
    
37.             ci = Mid(sID_Code, i, 1)
    
38. 
    
39.             If ci = "X" Then
    
40.                 ai = 10
    
41.             Else
    
42.                 ai = val(ci)
    
43.             End If
    
44. 
    
45.             Wi = 2 ^ (19 - i - 1) Mod 11
    
46. 
    
47.             Sum_aiwi = Sum_aiwi + ai * Wi
    
48. 
    
49.         Next
    
50. 
    
51.         If Sum_aiwi Mod 11 = 1 Then
    
52.             bReturn = True
    
53.         End If
    
54. 
    
55.     End If
    
56. 
    
57.     身份证校验 = bReturn
    
58. 
    
59. End Function
    

复制代码

honj

好代码难求。