<output id="os3gq"><ruby id="os3gq"></ruby></output>

    1. <mark id="os3gq"></mark>
    2. 5個免費課程
      網站公告
      ·Access快速平臺QQ群號:156702533    ·Access快速開發平臺下載地址及教程    ·歡迎添加微信交流賬號:AccessoftChu    ·如何快速搜索本站文章|示例|資料    
      您的位置: 首頁 > 技術文章 > 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交流群 (群號:32587638)       access源碼網店


      最新評論 查看更多評論(1)

      2011/3/7 20:01:18胡永熾
      用表達式也可以做:
      性別: IIf(Mid([身份證號碼],17,1)="1" Or Mid([身份證號碼],17,1)="3" Or Mid([身份證號碼],17,1)="5" Or Mid([身份證號碼],17,1)="7" Or Mid([身份證號碼],17,1)="9","男","女")

      出生日期: DateSerial(Mid([身份證號碼],7,4),Mid([身份證號碼],11,2),Mid([身份證號碼],13,2))


      發表評論您的評論將提升作者分享的動力!快來評論一下吧!

      用戶名:
      密 碼:
      內 容:
       

      常見問答

      技術分類

      相關資源

      關于我們 | 服務條款 | 在線投稿 | 友情鏈接 | 網站統計 | 網站幫助