就是好抽奖vbrivate Sub Command1_Click()
On Error GoTo md
Dim code, tmp, tmp2, tmp3 As String
filename = App.Path & "\data.txt"
code = Text1.Text
tmp = Left(code, 2)
tmp = tmp + "0000"
tmp2 = ""
Open filename For Input As #1
While Not (EOF(1))
Line Input #1, tmp3
If Left(tmp3, 6) = tmp Then tmp2 = tmp2 + Trim(Mid(tmp3, 7, Len(tmp3) - 6))
Wend
tmp2 = tmp2 + " "
Close #1
tmp = Left(code, 4)
tmp = tmp + "00"
Open filename For Input As #1
While Not (EOF(1))
Line Input #1, tmp3
If Left(tmp3, 6) = tmp Then tmp2 = tmp2 + Trim(Mid(tmp3, 7, Len(tmp3) - 6))
Wend
tmp2 = tmp2 + " "
Close #1
tmp = Left(code, 6)
Open filename For Input As #1
While Not (EOF(1))
Line Input #1, tmp3
If Left(tmp3, 6) = tmp Then tmp2 = tmp2 + Trim(Mid(tmp3, 7, Len(tmp3) - 6))
Wend
Close #1
Text2.Text = tmp2
Text3.Text = Mid(code, 7, 4) + "年" + Mid(code, 11, 2) + "月" + Mid(code, 13, 2) + "日"
tmp = Mid(code, 17, 1)
a = Val(tmp)
If a Mod 2 = 1 Then Text4.Text = "男" Else Text4.Text = "女"
Text6.Text = Mid(code, 15, 3)
'JIAOYAN
Dim co(1 To 17) As String
For a = 1 To 17
co(a) = Mid(code, a, 1)
Next
co(1) = co(1) * 7
co(2) = co(2) * 9
co(3) = co(3) * 10
co(4) = co(4) * 5
co(5) = co(5) * 8
co(6) = co(6) * 4
co(7) = co(7) * 2
co(8) = co(8) * 1
co(9) = co(9) * 6
co(10) = co(10) * 3
co(11) = co(11) * 7
co(12) = co(12) * 9
co(13) = co(13) * 10
co(14) = co(14) * 5
co(15) = co(15) * 8
co(16) = co(16) * 4
co(17) = co(17) * 2
Sum = 0
For a = 1 To 17
Sum = Sum + co(a)
Next
y = Sum Mod 11
www = Right(code, 1)
Select Case y
Case Is = "0"
If www = "1" Then Text5.Text = "成功" Else Text5.Text = "失败"
Case Is = "1"
If www = "0" Then Text5.Text = "成功" Else Text5.Text = "失败"
Case Is = "2"
If www = "X" Then Text5.Text = "成功" Else Text5.Text = "失败"
Case Is = "3"
If www = "9" Then Text5.Text = "成功" Else Text5.Text = "失败"
Case Is = "4"
If www = "8" Then Text5.Text = "成功" Else Text5.Text = "失败"
Case Is = "5"
If www = "7" Then Text5.Text = "成功" Else Text5.Text = "失败"
Case Is = "6"
If www = "6" Then Text5.Text = "成功" Else Text5.Text = "失败"
Case Is = "7"
If www = "5" Then Text5.Text = "成功" Else Text5.Text = "失败"
Case Is = "8"
If www = "4" Then Text5.Text = "成功" Else Text5.Text = "失败"
Case Is = "9"
If www = "3" Then Text5.Text = "成功" Else Text5.Text = "失败"
Case Is = "10"
If www = "2" Then Text5.Text = "成功" Else Text5.Text = "失败"
Case Else
Text5.Text = "失败"
End Select
ok:
Exit Sub
md: MsgBox "出错！请检查输入是否正确或程序是否完整！请重新启动本程序！": tmp = "": tmp2 = "": tmp3 = "": code = "": www = "": a = 0: Resume ok
End Sub
Private Sub Command2_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
End Sub
Private Sub Command3_Click()
MsgBox "Koc 2010" + Chr(13) + "数据来源于国家统计局" + Chr(13) + "说明：(*)表示2008年根据国标修改的县及县以上行政区划代码和名称。" + Chr(13) + "结果仅供参考"
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Command1_Click
End Sub
