frmquryid.frm

我做的可以查询身份证的源码

      Begin VB.Label Label5 
         BackStyle       =   0  'Transparent
         Caption         =   "月"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   2880
         TabIndex        =   15
         Top             =   1200
         Width           =   255
      End
      Begin VB.Label Label4 
         BackStyle       =   0  'Transparent
         Caption         =   "年"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   2160
         TabIndex        =   14
         Top             =   1200
         Width           =   255
      End
      Begin VB.Label Label3 
         BackStyle       =   0  'Transparent
         Caption         =   "性    别:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00000000&
         Height          =   255
         Left            =   240
         TabIndex        =   13
         Top             =   1680
         Width           =   1095
      End
      Begin VB.Label Label2 
         BackStyle       =   0  'Transparent
         Caption         =   "出生日期:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00000000&
         Height          =   255
         Left            =   240
         TabIndex        =   12
         Top             =   1200
         Width           =   1095
      End
   End
   Begin VB.TextBox txtId 
      Appearance      =   0  'Flat
      BackColor       =   &H00FFFFFF&
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   1920
      TabIndex        =   0
      Top             =   3795
      Width           =   2775
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "请输入身份证号:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   240
      TabIndex        =   10
      Top             =   3840
      Width           =   1815
   End
End
Attribute VB_Name = "frmQuryId"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public id, idLen, orSex, yearStr, address As String
Public yzEnd, inAddrId, inAddr As String

Public Sub quryAddress()
Dim sql1 As String
  Dim rs1 As ADODB.Recordset
  Set rs1 = New ADODB.Recordset
  sql1 = "select * from sfz where BM='" & Mid$(id, 1, 6) & "' "
  Set rs1 = TransactSQL(sql1)
  
  If rs1.EOF Then
   txtAddr.Text = "无该身份证号所在地的记录！"
  Else
   txtAddr.Text = rs1.Fields(1)
  End If
  
  Set rs1 = Nothing
End Sub
 
'函数 yanZheng18 中的参数来自网上，如有不明白者，可在百度中查找
Public Sub yanZheng18()
 Dim i, yzId, sumMod As Integer
 Dim s, sumTal As Long
 Dim arr(1 To 17) As Integer
 arr(1) = 7
 arr(2) = 9
 arr(3) = 10
 arr(4) = 5
 arr(5) = 8
 arr(6) = 4
 arr(7) = 2
 arr(8) = 1
 arr(9) = 6
 arr(10) = 3
 arr(11) = 7
 arr(12) = 9
 arr(13) = 10
 arr(14) = 5
 arr(15) = 8
 arr(16) = 4
 arr(17) = 2
 
 sumTal = 0
 yzId = txtId.Text
 
 Dim arr2(1 To 17) As Integer
 
 For i = 1 To 17
     arr2(i) = Mid$(yzId, i, 1)
  Next
 
 For i = 1 To 17
    s = arr2(i) * arr(i)
    sumTal = sumTal + s
 Next
    sumMod = sumTal Mod 11
 
  '     Y值： 0 1 2 3 4 5 6 7 8 9 10
  '　校验码： 1 0 X 9 8 7 6 5 4 3 2
 Select Case sumMod
  Case 0
    yzEnd = "1"
  Case 1
    yzEnd = "0"
  Case 2
    yzEnd = "X"
  Case 3
    yzEnd = "9"
  Case 4
    yzEnd = "8"
  Case 5
    yzEnd = "7"
  Case 6
    yzEnd = "6"
  Case 7
    yzEnd = "5"
  Case 8
    yzEnd = "4"
  Case 9
    yzEnd = "3"
  Case 10
    yzEnd = "2"
 End Select
 End Sub

Public Sub chooseSex()
  If (orSex And 1) = 0 Then
       txtSex.Text = "女"
    Else
       txtSex.Text = "男"
  End If
End Sub

Private Sub cmdClear_Click()
 txtAddr.Text = ""
 txtYear.Text = ""
 txtMonth.Text = ""
 txtDay.Text = ""
 txtSex.Text = ""
 txtId.Text = ""
 txtId.SetFocus
End Sub

Private Sub cmdOut_Click()
  Unload Me
End Sub

Private Sub cmdTrans_Click()
  Dim sql2 As String
  Dim rs2 As ADODB.Recordset
  Set rs2 = New ADODB.Recordset
 txtAddr.Text = ""
 txtYear.Text = ""
 txtMonth.Text = ""
 txtDay.Text = ""
 txtSex.Text = ""
id = Trim(txtId.Text)
idLen = Len(id)
If idLen <> 15 And idLen <> 18 Then
   MsgBox "您输入的身份证号码为 " & idLen & " 位，请检查！", vbOKOnly + vbExclamation, "警告"
   txtId.SetFocus
 Else
   If idLen = 18 Then
      Call yanZheng18
      If yzEnd <> UCase(Mid$(id, 18, 1)) Then
         MsgBox "无效证件，请检查！", vbOKOnly + vbExclamation, "警告"
         txtId.SetFocus
         Exit Sub
      Else
        Call quryAddress
        txtYear.Text = Mid$(id, 7, 4)
        txtMonth.Text = Mid$(id, 11, 2)
        txtDay.Text = Mid$(id, 13, 2)
        orSex = Mid$(id, 17, 1)
        Call chooseSex
      End If
    Else
      Call quryAddress
      yearStr = Mid$(id, 7, 2)
      txtYear.Text = "19" & yearStr
      txtMonth.Text = Mid$(id, 9, 2)
      txtDay.Text = Mid$(id, 11, 2)
      orSex = Mid$(id, 15, 1)
      Call chooseSex
   End If
End If

If txtAddr.Text = "无该身份证号所在地的记录！" Then
   inAddrId = Trim(id)
   inAddr = InputBox("请输入身份证号 " & inAddrId & " 所在的省市县： ", "省市县地址编码维护", "")
 If inAddr <> "" Then
  If MsgBox("您确定身份证号　" & inAddrId & "　所在的省市县为  " & inAddr & "  吗？", vbOKCancel) = vbOK Then
   sql2 = "select * from sfz where BM = ''"
   Set rs2 = TransactSQL(sql2)
    rs2.AddNew
    rs2.Fields(0) = Mid$(inAddrId, 1, 6)
    rs2.Fields(1) = Trim(inAddr)
    rs2.Update
    Set rs2 = Nothing
    MsgBox "数据添加成功，谢谢您的支持！", vbOKOnly + vbExclamation, "恭 喜"
    txtAddr.Text = Trim(inAddr)
   Else
  End If
 End If
End If
End Sub

Private Sub Form_Load()
labTime.Caption = Format(Now, "yyyy-mm-dd hh:mm:ss")
End Sub


Private Sub Timer1_Timer()
labTime.Caption = Format(Now, "yyyy-mm-dd hh:mm:ss")
End Sub