身份证号真实性效验VB源代码

'VB软件源代码，身份证效验VB代码 把此代码直接复制到工程里运行即可。
Option Explicit
Dim W(16) As Integer '7 9 10 5 8 4 2 1 6 3 7 9 10 5 8 4 2
Dim I As Integer, J As Integer
Private Sub Command1_Click()
Cls
Dim a As Integer, sfz As String
a = Val(InputBox("输入要判断的身份证的数量(小于1000)："))
If a > 0 And a < 1000 Then
Print a
For J = 1 To a
sfz = UCase(InputBox("输入身份证号：")) '输入身份证号,转换为大写
Print sfz
Print IIf(SFZyz(sfz), "Y", "N")
Next
Else
MsgBox "输入错误！"
End If
End Sub

Private Sub Form_Load()
W(0) = 7 '把加权因子放入W()数组
W(1) = 9:W(2) = 10:W(3) = 5:W(4) = 8:W(5) = 4:W(6) = 2:W(7) = 1:W(8) = 6:W(9) = 3
W(10) = 7:W(11) = 9:W(12) = 10:W(13) = 5:W(14) = 8:W(15) = 4:W(16) = 2
'For I = 0 To 16 '加权因子可以这样求
'W(I) = 2 ^ (17 - I) Mod 11
'Next
End Sub

Function SFZyz(ID As String) '验证身份证号的函数，参数ID是身份证号
Dim Y As Integer, S As Long, Y1 As String
For I = 0 To 16 '对前17位数字的权求和
S = S + Val(Mid(ID, I + 1, 1)) * W(I)
Next

Y = S Mod 11 '对S取模
'Y 0 1 2 3 4 5 6 7 8 9 10
'校验码： 1 0 X(大写) 9 8 7 6 5 4 3 2
Select Case Y '得到校验码
Case 0
Y1 = "1"
Case 1
Y1 = "0"
Case 2
Y1 = "X"
Case 3
Y1 = "9"
Case 4
Y1 = "8"
Case 5
Y1 = "7"
Case 6
Y1 = "6"
Case 7
Y1 = "5"
Case 8
Y1 = "4"
Case 9
Y1 = "3"
Case 10
Y1 = "2"
End Select

SFZyz = (Right(ID, 1) = Y1) '如果身份证号最后一位和校验码相同，函数就返回TRUE，否则返回FALSE
End Function