Question

vb程序中,输入身份证号码判断身份证号正确的程序

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 StrID15 = "111111111111111" 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 Function
Public 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 Function
Public 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

Answer 2

dim
s
as
string,y
as
string
i
as
long
s=xxxxxx19920315xxxx
y=mid(s,7,4)
从身份证的第七位取4个
i=year(now())-val(y)+1
now()函数是获得现在的电脑的时间，year是把now的年份取出，val是把字符串转换成数字，因为刚生下来就是1岁所以要加1
msgbox
i