身份证验证函数

Question

身份证验证函数

Answer 1

Dim Wi(1 To 18) As Integer  '校验码
Private Function SetWi()
Wi(1) = 7
Wi(2) = 9
Wi(3) = 10
Wi(4) = 5
Wi(5) = 8
Wi(6) = 4
Wi(7) = 2
Wi(8) = 1
Wi(9) = 6
Wi(10) = 3
Wi(11) = 7
Wi(12) = 9
Wi(13) = 10
Wi(14) = 5
Wi(15) = 8
Wi(16) = 4
Wi(17) = 2
Wi(18) = 1
End Function
Public Function CheckCIDC15(ByVal StrID15 As String) As String
If Not IsNumeric(StrID15) Then
    CheckCIDC15 = "身份证号码输入有误！有非数字出现！"
    Exit Function
End If
If Val(Mid(StrID15, 9, 2)) < 1 Or Val(Mid(StrID15, 9, 2)) > 12 Then
    CheckCIDC15 = "身份证号码输入有误！月份不正确！"
    Exit Function
End If
If Val(Mid(StrID15, 11, 2)) < 1 Or Val(Mid(StrID15, 11, 2)) > 31 Then
    CheckCIDC15 = "身份证号码输入有误！日期不正确！"
    Exit Function
Else
    If (Val(Mid(StrID15, 9, 2)) = 4 Or Val(Mid(StrID15, 9, 2)) = 6 Or Val(Mid(StrID15, 9, 2)) = 9 Or Val(Mid(StrID15, 9, 2)) = 11) And Val(Mid(StrID15, 11, 2)) = 31 Then
        CheckCIDC15 = "身份证号码输入有误！月份和日期不匹配"
        Exit Function
    ElseIf Val(Mid(StrID15, 9, 2)) = 2 And (Val(Mid(StrID15, 11, 2)) = 30 Or Val(Mid(StrID15, 11, 2)) = 31) Then
        CheckCIDC15 = "身份证号码输入有误！2月份没有" & Val(Mid(StrID15, 11, 2)) & "天"
        Exit Function
    End If
End If
End FunctionPublic Function CheckCIDC18(ByVal StrID18 As String) As String
Dim StrID17 As String, AiWi As Integer, num As Integer, A18 As String
SetWi
If Not IsNumeric(Left(StrID18, 17)) Then
    CheckCIDC18 = "身份证号码输入有误！"
    Exit Function
End If
If Val(Mid(StrID18, 11, 2)) < 1 Or Val(Mid(StrID18, 11, 2)) > 12 Then
    CheckCIDC18 = "身份证号码输入有误！月份不正确！"
    Exit Function
End If
If Val(Mid(StrID18, 13, 2)) < 1 Or Val(Mid(StrID18, 13, 2)) > 31 Then
    CheckCIDC18 = "身份证号码输入有误！" & vbCrLf & "日期不正确！"
    Exit Function
Else
    If (Val(Mid(StrID18, 11, 2)) = 4 Or Val(Mid(StrID18, 11, 2)) = 6 Or Val(Mid(StrID18, 11, 2)) = 9 Or Val(Mid(StrID18, 11, 2)) = 11) And Val(Mid(StrID18, 13, 2)) = 31 Then
        CheckCIDC18 = "身份证号码输入有误！月份和日期不匹配"
        Exit Function
    ElseIf Val(Mid(StrID18, 11, 2)) = 2 And (Val(Mid(StrID18, 13, 2)) = 30 Or Val(Mid(StrID18, 13, 2)) = 31) Then
        CheckCIDC18 = "身份证号码输入有误！2月份没有" & Val(Mid(StrID18, 13, 2)) & "天"
        Exit Function
    End If
End If
StrID17 = Left(StrID18, 17)
AiWi = 0
For num = 1 To 17
    AiWi = AiWi + Val(Mid(StrID17, num, 1)) * Wi(num)
Next num
Select Case AiWi Mod 11
    Case 0
        A18 = "1"
    Case 1
        A18 = "0"
    Case 2
        A18 = "X"
    Case 3
        A18 = "9"
    Case 4
        A18 = "8"
    Case 5
        A18 = "7"
    Case 6
        A18 = "6"
    Case 7
        A18 = "5"
    Case 8
        A18 = "4"
    Case 9
        A18 = "3"
    Case 10
        A18 = "2"
End Select
If A18 <> Right(StrID18, 1) Then
    CheckCIDC18 = "身份证号码输入有误！" '尾数校验码不正确"
    Exit Function
End If
End FunctionPublic Function CIDC15To18(ByVal StrID15 As String) As String
SetWi
Dim StrID17 As String, StrID18 As String, num As Integer, AiWi As Integer
If Not IsNumeric(StrID15) Then
    CIDC15To18 = "15位身份证号码输入有误！" & vbCrLf & "有非数字出现！"
    Exit Function
End If
If Val(Mid(StrID15, 9, 2)) < 1 Or Val(Mid(StrID15, 9, 2)) > 12 Then
    CIDC15To18 = "身份证号码输入有误！" & vbCrLf & "月份不正确！"
    Exit Function
End If
If Val(Mid(StrID15, 11, 2)) < 1 Or Val(Mid(StrID15, 11, 2)) > 31 Then
    CIDC15To18 = "身份证号码输入有误！" & vbCrLf & "日期不正确！"
    Exit Function
Else
    If (Val(Mid(StrID15, 9, 2)) = 4 Or Val(Mid(StrID15, 9, 2)) = 6 Or Val(Mid(StrID15, 9, 2)) = 9 Or Val(Mid(StrID15, 9, 2)) = 11) And Val(Mid(StrID15, 11, 2)) = 31 Then
        CIDC15To18 = "身份证号码输入有误！" & vbCrLf & "月份和日期不匹配"
        Exit Function
    ElseIf Val(Mid(StrID15, 9, 2)) = 2 And (Val(Mid(StrID15, 11, 2)) = 30 Or Val(Mid(StrID15, 11, 2)) = 31) Then
        CIDC15To18 = "身份证号码输入有误！" & vbCrLf & "2月份没有" & Val(Mid(StrID15, 11, 2)) & "天"
        Exit Function
    End If
End If
StrID17 = Left(StrID15, 6) & "19" & Right(StrID15, 9)
AiWi = 0
For num = 1 To 17
    AiWi = AiWi + Val(Mid(StrID17, num, 1)) * Wi(num)
Next num
Select Case AiWi Mod 11
    Case 0
        StrID18 = StrID17 & "1"
    Case 1
        StrID18 = StrID17 & "0"
    Case 2
        StrID18 = StrID17 & "X"
    Case 3
        StrID18 = StrID17 & "9"
    Case 4
        StrID18 = StrID17 & "8"
    Case 5
        StrID18 = StrID17 & "7"
    Case 6
        StrID18 = StrID17 & "6"
    Case 7
        StrID18 = StrID17 & "5"
    Case 8
        StrID18 = StrID17 & "4"
    Case 9
        StrID18 = StrID17 & "3"
    Case 10
        StrID18 = StrID17 & "2"
End Select
CIDC15To18 = StrID18
End Function'身份证检验函数,如果有错误,反悔的是错误的字符信息,正确,则返回空
’调用Function CIDCheck(strId As String) As String
If Len(strId) = 15 Then
  CIDCheck = CheckCIDC15(strId)
ElseIf Len(strId) = 18 Then
  CIDCheck = CheckCIDC18(strId)
Else
  CIDCheck = "身份证位数不对"
End If
End Function