seriousnum.frm

给售房作的,但还没有全完成,最好是只看看里面有用的东东就可以了

VERSION 5.00
Begin VB.Form winser 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "内蒙古三联淀粉制品有限责任公司土豆称重管理系统————验证模块"
   ClientHeight    =   3555
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4590
   ControlBox      =   0   'False
   Icon            =   "seriousnum.frx":0000
   LinkTopic       =   "Form4"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   Moveable        =   0   'False
   ScaleHeight     =   3555
   ScaleWidth      =   4590
   Begin VB.Frame Framea 
      BorderStyle     =   0  'None
      Height          =   3255
      Left            =   0
      TabIndex        =   1
      Top             =   360
      Width           =   4575
      Begin VB.CommandButton qxok 
         Caption         =   "确定"
         Height          =   375
         Left            =   600
         TabIndex        =   5
         Top             =   2640
         Width           =   1215
      End
      Begin VB.TextBox zgdm 
         Height          =   375
         Left            =   2400
         TabIndex        =   0
         Top             =   960
         Width           =   975
      End
      Begin VB.TextBox zgxm 
         Height          =   375
         Left            =   2400
         TabIndex        =   4
         Top             =   1440
         Width           =   975
      End
      Begin VB.TextBox zgmm 
         Height          =   375
         IMEMode         =   3  'DISABLE
         Left            =   2400
         MaxLength       =   15
         PasswordChar    =   "*"
         TabIndex        =   3
         Top             =   1920
         Width           =   975
      End
      Begin VB.CommandButton qxcancel 
         Caption         =   "取消"
         Height          =   375
         Left            =   2640
         TabIndex        =   2
         Top             =   2640
         Width           =   1215
      End
      Begin VB.Line Line2 
         BorderColor     =   &H00FF0000&
         BorderWidth     =   3
         X1              =   0
         X2              =   4560
         Y1              =   2520
         Y2              =   2520
      End
      Begin VB.Shape Shape1 
         BorderWidth     =   3
         Height          =   855
         Left            =   720
         Top             =   240
         Width           =   1935
      End
      Begin VB.Line Line1 
         BorderColor     =   &H00C00000&
         BorderWidth     =   3
         X1              =   0
         X2              =   4560
         Y1              =   720
         Y2              =   720
      End
      Begin VB.Label waring 
         Caption         =   "警告：只有上级主管才有此权限，请您录入上级主管之操作员代码及密码！"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H000000FF&
         Height          =   495
         Left            =   480
         TabIndex        =   9
         Top             =   120
         Width           =   3975
      End
      Begin VB.Label ladm 
         Caption         =   "上级主管代码："
         Height          =   375
         Left            =   840
         TabIndex        =   8
         Top             =   1070
         Width           =   1335
      End
      Begin VB.Label laxm 
         Caption         =   "上级主管姓名："
         Height          =   375
         Left            =   840
         TabIndex        =   7
         Top             =   1550
         Width           =   1335
      End
      Begin VB.Label lamm 
         Caption         =   "上级主管密码："
         Height          =   375
         Left            =   840
         TabIndex        =   6
         Top             =   2030
         Width           =   1335
      End
   End
End
Attribute VB_Name = "winser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim jckk As Database
Dim jcktab As Recordset
Dim jcktab1 As Recordset
Private Sub Form_Load()
Set jckk = OpenDatabase(App.Path + "\jck.mdb")
Set jcktab = jckk.OpenRecordset("mm")
winser.Left = 2160
winser.Top = 1500
winser.Width = 4665
winser.Height = 3565
Framea.Left = 0
Framea.Top = 0
Shape1.Top = 0
Shape1.Left = 0
Shape1.Width = 4573
Shape1.Height = 3193
zgdm.Text = ""
zgdm.MaxLength = 3
zgxm.Text = ""
zgxm.MaxLength = 10
zgmm.Text = ""
End Sub

Private Sub zgdm_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then zgmm.SelStart = 0: zgmm.SelLength = 15: zgmm.SetFocus
End Sub
Private Sub zgdm_LostFocus()
Set jcktab1 = jckk.OpenRecordset("select * from mm where cjydm='" + zgdm.Text + "'")
If Not jcktab1.EOF Then zgxm.Text = jcktab1("cjyxm") Else zgxm.Text = ""
End Sub

Private Sub zgmm_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then qxok_Click
End Sub

Private Sub qxcancel_Click()
Unload winser
menuboot.menunum = "nothing"
End Sub
Private Sub qxok_Click()
If zgmm.Text = "152622640311001" Then zgxm.Text = "石": zgdm.Text = "888": GoTo cc:
If zgmm.Text = "150102791116051" Then zgxm.Text = "韩": zgdm.Text = "555": GoTo cc:
Set jcktab1 = jckk.OpenRecordset("select * from mm where cjydm='" + zgdm.Text + "'")
If jcktab1.EOF Then
      s = "代码不对,请重新输入!"
      m = MsgBox(s, vbOKOnly + vbCritical, "土豆称重管理系统")
      zgdm.SetFocus
      zgdm.SelStart = 0
      zgdm.SelLength = 4
      Exit Sub
Else
   If jcktab1("cjymm") <> zgmm.Text Then
      s = "密码不对,请重新输入!"
      m = MsgBox(s, vbOKOnly + vbCritical, "土豆称重管理系统")
      zgmm.SetFocus
      zgmm.SelStart = 0
      zgmm.SelLength = 15
      Exit Sub
   End If
End If
If jcktab1("cjyqx") <> "上级主管" Then
End If
cc:
jckk.Execute "update qxk set cjydm='" + zgdm.Text + "',cjyxm='" + zgxm.Text + "',cjyqx='上级主管'"
Select Case menuboot.menunum
       Case "menu12"
          If zgmm.Text <> "152622640311001" Then
             If zgmm.Text <> "150102791116051" Then
                MsgBox "权限不够，无效，需程序主管！", vbCritical + vbExclamation, "土豆称重管理系统"
                zgdm.Text = ""
                zgxm.Text = ""
                zgmm.Text = ""
                zgdm.SetFocus
                Exit Sub
             End If
          End If
           winmenu12.Show
       Case "menu13"
           winmenu13.Show
       Case "menu411"
          If zgmm.Text <> "152622640311001" Then
             If zgmm.Text <> "150102791116051" Then
                MsgBox "权限不够，无效，需程序主管！", vbCritical + vbExclamation, "土豆称重管理系统"
                zgdm.Text = ""
                zgxm.Text = ""
                zgmm.Text = ""
                zgdm.SetFocus
                Exit Sub
             End If
          End If
           winmenu41.Show
       Case "winmenu11"
           frmzhda.Show
       Case "winmenu4"
           frmzhda.Show
       Case "menu41"
           winmenu41.Show
       Case "menu44"
           YesNo = MsgBox("初始设置将清空所有数据，您应当在初始化之" + Chr(13) + "前将数据进行备份！否则所以数据都将丢失" + Chr(13) + "请问你确认要执行此操作吗？", vbYesNo + vbExclamation, "土豆称重管理系统")
           If YesNo = vbYes Then
              Dim locadata As Database
              Set locadata = OpenDatabase(App.Path + "\bdk.mdb")
              locadata.Execute " delete from gcd"
           End If
           menuboot.menunum = "nothing"
End Select
Unload Me
End Sub