form1.frm

查询身份证归属地

VERSION 5.00
Begin VB.Form Form1 
   AutoRedraw      =   -1  'True
   Caption         =   "Form1"
   ClientHeight    =   3225
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   5055
   LinkTopic       =   "Form1"
   ScaleHeight     =   3225
   ScaleWidth      =   5055
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command1 
      Caption         =   "身份证查询"
      Height          =   375
      Left            =   1560
      TabIndex        =   2
      Top             =   840
      Width           =   2175
   End
   Begin VB.TextBox Text1 
      Height          =   270
      Left            =   1080
      TabIndex        =   0
      Top             =   360
      Width           =   3255
   End
   Begin VB.Label Label2 
      Caption         =   "Label2"
      Height          =   1695
      Left            =   0
      TabIndex        =   3
      Top             =   1440
      Width           =   5055
   End
   Begin VB.Label Label1 
      Caption         =   "查询号码"
      Height          =   375
      Left            =   240
      TabIndex        =   1
      Top             =   360
      Width           =   855
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
connstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "/sfz.mdb"
Set Conn = CreateObject("ADODB.Connection")
Conn.Open connstr
xian = Text1
If (Not IsNumeric(Left(xian, 15)) And Not IsNumeric(Left(xian, 18))) Or xian = "" Then
  MsgBox "请输入正确身份证号码"
  Exit Sub
End If
lenx = Len(Trim(Text1))
If lenx = 15 Or lenx = 18 Then
    If lenx = 15 Then
        yy = "19" & Mid(xian, 7, 2)
        mm = Mid(xian, 9, 2)
        dd = Mid(xian, 11, 2)
        aa = Right(xian, 1)
    End If
    If lenx = 18 Then
        yy = Mid(xian, 7, 4)
        mm = Mid(xian, 11, 2)
        dd = Mid(xian, 13, 2)
        aa = Right(xian, 1)
    End If
    If CInt(mm) > 12 Or CInt(dd) > 31 Then
       MsgBox "请输入正确的身份证号码!"
       Exit Sub
    End If
   Else
  MsgBox "请输入正确的身份证号码"
  Exit Sub
  Exit Sub
End If


Set rs = CreateObject("adodb.recordset")
      sql = "select * from sfz where bm=" & Left(xian, 6)
      rs.Open sql, Conn, 3, 3
     
If Not rs.EOF Then
    If aa Mod 2 = 1 Then
      xb = "男"
      Else
      xb = "女"
    End If
    Label2 = "查询号码：" & xian & Chr(10) & Chr(13)
    Label2 = Label2 & "原户籍地：" & rs("dq") & Chr(10) & Chr(13)
    Label2 = Label2 & "出生年月：" & yy & "年" & mm & "月" & dd & "日" & Chr(10) & Chr(13)
    Label2 = Label2 & "性 别：" & xb & Chr(10) & Chr(13)
    If lenx = 18 Then
        If Mid(xian, 18, 1) <> CStr(sfzjy(xian)) Then
           Label2 = Label2 & "提示：身份证校验位错误!" & Chr(10) & Chr(13)
          Else
            Label2 = Label2 & "结果：身份证号码校验为合法号码!" & Chr(10) & Chr(13)
        End If
    Else
      
    Label2 = Label2 & "新身份证：" & Left(xian, 6) & "19" & Right(xian, 9) & CStr(sfzjy(xian)) & Chr(10) & Chr(13)
    End If
End If
rs.Close
Set rs = Nothing
  Conn.Close
Set Conn = Nothing


End Sub


Function sfzjy(num)

 If Len(num) = 15 Then
cID = Left(num, 6) & "19" & Right(num, 9)
  ElseIf Len(num) = 17 Or Len(num) = 18 Then
cID = Left(num, 17)
  End If

nsum = Mid(cID, 1, 1) * 7
nsum = nsum + Mid(cID, 2, 1) * 9
nsum = nsum + Mid(cID, 3, 1) * 10
nsum = nsum + Mid(cID, 4, 1) * 5
nsum = nsum + Mid(cID, 5, 1) * 8
nsum = nsum + Mid(cID, 6, 1) * 4
nsum = nsum + Mid(cID, 7, 1) * 2
nsum = nsum + Mid(cID, 8, 1) * 1
nsum = nsum + Mid(cID, 9, 1) * 6
nsum = nsum + Mid(cID, 10, 1) * 3
nsum = nsum + Mid(cID, 11, 1) * 7
nsum = nsum + Mid(cID, 12, 1) * 9
nsum = nsum + Mid(cID, 13, 1) * 10
nsum = nsum + Mid(cID, 14, 1) * 5
nsum = nsum + Mid(cID, 15, 1) * 8
nsum = nsum + Mid(cID, 16, 1) * 4
nsum = nsum + Mid(cID, 17, 1) * 2
'*计算校验位
 check_number = 12 - nsum Mod 11
 If check_number = 10 Then
     check_number = "X"
  ElseIf check_number = 12 Then
     check_number = "1"
  ElseIf check_number = 11 Then
     check_number = "0"
 End If
 sfzjy = check_number
End Function

Private Sub Command2_Click()
connstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "/sfz.mdb"
Set Conn = CreateObject("ADODB.Connection")
Conn.Open connstr
xian = Text1
If Not IsNumeric(xian) Or Not (Len(xian) >= 10 And Len(xian) <= 11) Or xian = "" Or Not Left(xian, 1) = "1" Then
  MsgBox "请输入正确手机"
  Exit Sub
End If

























rs.Close
Set rs = Nothing
  Conn.Close
Set Conn = Nothing

End Sub