?? 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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -