开发工具:
文件大小: 2kb
下载次数: 0
上传时间: 2015-06-16
详细说明: 就是好抽奖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 ...展开收缩
(系统自动生成,下载前可以参看下载内容)
下载文件列表
相关说明
- 本站资源为会员上传分享交流与学习,如有侵犯您的权益,请联系我们删除.
- 本站是交换下载平台,提供交流渠道,下载内容来自于网络,除下载问题外,其它问题请自行百度。
- 本站已设置防盗链,请勿用迅雷、QQ旋风等多线程下载软件下载资源,下载后用WinRAR最新版进行解压.
- 如果您发现内容无法下载,请稍后再次尝试;或者到消费记录里找到下载记录反馈给我们.
- 下载后发现下载的内容跟说明不相乎,请到消费记录里找到下载记录反馈给我们,经确认后退回积分.
- 如下载前有疑问,可以通过点击"提供者"的名字,查看对方的联系方式,联系对方咨询.