Access开发培训
网站公告
·Access专家课堂QQ群号:151711184    ·Access快速开发平台下载地址及教程    ·欢迎加入Access专家课堂微信群!    ·如何快速搜索本站文章|示例|资料    
您的位置: 首页 > 技术文章 > Access数据库-宏

通过身份号码查询出生日期、性别的设计

时 间:2007-10-21 10:47:29
作 者:贺德才   ID:140  城市:襄樊
摘 要:身份证查询出生日期
正 文:

        利用身份证号码查看其人的出生年月及性别等情况,这在excel是可以实现的。这里介绍用access实现的代码,供access爱好者参考,同时提供本人设计的一个身份证号码查询的程序供大家下载使用。想来肯定有用得上的时候。时常有报道说某犯罪嫌疑人用假身份证犯罪,我想相关机关或单位如果有我这样一个身份证查询程序,查一下身份证,问几个问题,犯罪分子应该立马露馅。程序原码如下--

 


 

Private Sub txtStatusCode_AfterUpdate()
Dim AreaCode, Area, BirthDay, NewCode As String
Dim Calendar As Date

On Error Resume Next

Me.cmdToEdit.SetFocus

Me.txtBirthDay = Null
Me.txtGivePassArea = Null
Me.txtSex = Null
Me.txtStatusCodeNew = Null
Me.txtAge = Null

'检查身份证号码位数
If CheckLength(Me.txtStatusCode) = False Then
    MsgBox ("身份证号码的位数出现错误.")
    Me.txtStatusCode.SetFocus
    Exit Sub
End If

'检查身份证号码中有无非法字符
If CheckChar(Me.txtStatusCode) = False Then
    MsgBox ("身份证号码中含有非法字符.")
    Me.txtStatusCode.SetFocus
    Exit Sub
End If

'检查地区代码
If CheckArea(Mid(Me.txtStatusCode, 1, 6)) = False Then
    Exit Sub
End If

Area = ""
AreaCode = Mid(Me.txtStatusCode, 1, 6)    '取得地区代码

'取得发证地区名称
Area = Area & DLookup("[名称]", "地区代码", "[代码]='" & Mid(AreaCode, 1, 2) & "0000'")
Area = Area & DLookup("[名称]", "地区代码", "[代码]='" & Mid(AreaCode, 1, 4) & "00'")
Area = Area & DLookup("[名称]", "地区代码", "[代码]='" & AreaCode & "'")
   
'如果身份证号码位数是十五位则增至十七位
If Len(Me.txtStatusCode) = 15 Then
    NewCode = Mid(Me.txtStatusCode, 1, 6) & "19" & Right(Me.txtStatusCode, 9)
Else
    NewCode = Me.txtStatusCode
End If

'校验出生日期
BirthDay = Mid(NewCode, 7, 4) & "-" & _
    Mid(NewCode, 11, 2) & "-" & Mid(NewCode, 13, 2)
Calendar = DateValue(BirthDay)
If Err() = 13 Then
    MsgBox ("身份证号码中的出生日期部分错误.")
    Me.txtStatusCode.SetFocus
    Exit Sub
End If

Err() = 0

'可以根据情况设置年龄的上下限,这里是:年龄[0,100]
If Year(Date) - Year(BirthDay) > 100 or _
    Year(Date) - Year(BirthDay) < 0 or _
    Year(BirthDay) > Year(Date) Then
    MsgBox ("身份证号码中的出生日期部分错误.")
    Me.txtStatusCode.SetFocus
    Exit Sub
End If

'校验身份证号码并生成有效的身份证号码
NewCode = ""
NewCode = MakeNewCode(Me.txtStatusCode)

'显示结果
Me.txtStatusCodeNew = NewCode
Me.txtBirthDay = BirthDay
Me.txtGivePassArea = Area
Me.txtSex = IIf(InStr(1, "13579", Right(Me.txtStatusCode, 1)) <> 0, "男", "女")
Me.txtAge = Year(Date) - Year(BirthDay)

Me.txtStatusCode.SetFocus

End Sub

Public Function CheckChar(strCode As String) As Boolean
Dim I As Integer
Dim J As Integer

If Len(strCode) = 18 Then
    J = 17
Else
    J = Len(strCode)
End If

For I = 1 To J
    If Asc(Mid(Me.txtStatusCode, I, 1)) > 57 or _
        Asc(Mid(Me.txtStatusCode, I, 1)) < 48 Then
        CheckChar = False
        Exit Function
    End If
Next I

If Len(strCode) = 18 Then
    If Asc(UCase(Right(strCode, 1))) > 57 or

Access软件网QQ交流群 (群号:54525238)       Access源码网店


常见问答:

技术分类:

相关资源:

专栏作家

关于我们 | 服务条款 | 在线投稿 | 友情链接 | 网站统计 | 网站帮助