📄 frmdl.frm
字号:
VERSION 5.00
Begin VB.Form frmdl
Caption = "登陆"
ClientHeight = 2655
ClientLeft = 60
ClientTop = 345
ClientWidth = 3495
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2655
ScaleWidth = 3495
StartUpPosition = 2 '屏幕中心
Begin VB.CheckBox Check1
Caption = "值班注册"
ForeColor = &H00800000&
Height = 495
Left = 0
TabIndex = 10
Top = 1560
Width = 735
End
Begin VB.OptionButton Option2
Caption = "系统管理员"
BeginProperty Font
Name = "楷体_GB2312"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 255
Left = 1920
TabIndex = 9
Top = 1800
Width = 1575
End
Begin VB.OptionButton Option1
Caption = "值班员"
BeginProperty Font
Name = "楷体_GB2312"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 255
Left = 840
TabIndex = 8
Top = 1800
Value = -1 'True
Width = 1095
End
Begin VB.CommandButton Command2
Caption = "取消"
Height = 375
Left = 1920
TabIndex = 4
Top = 2160
Width = 1095
End
Begin VB.CommandButton Command1
Caption = "确认"
Height = 375
Left = 360
TabIndex = 3
Top = 2160
Width = 1095
End
Begin VB.ComboBox Combo2
BackColor = &H00FFC0C0&
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 330
Left = 1440
TabIndex = 2
Top = 600
Width = 1575
End
Begin VB.TextBox Text1
BackColor = &H00FFC0C0&
ForeColor = &H00800000&
Height = 375
IMEMode = 3 'DISABLE
Left = 1440
PasswordChar = "*"
TabIndex = 0
Top = 1080
Width = 1575
End
Begin VB.ComboBox Combo1
BackColor = &H00FFC0C0&
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 330
Left = 1440
TabIndex = 1
Top = 120
Width = 1575
End
Begin VB.Label Label3
Caption = "密 码"
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 255
Index = 2
Left = 240
TabIndex = 7
Top = 1200
Width = 1095
End
Begin VB.Label Label2
Caption = "值班员"
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 255
Index = 1
Left = 240
TabIndex = 6
Top = 600
Width = 1095
End
Begin VB.Label Label1
Caption = "班 次"
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 255
Index = 0
Left = 240
TabIndex = 5
Top = 120
Width = 975
End
End
Attribute VB_Name = "frmdl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim sql1 As String
Dim sql2 As String
Dim sql3 As String
Dim password As String
Dim RS As ADODB.Recordset
Dim i As Integer
Private Sub Check2_Click()
End Sub
Private Sub command1_Click()
Call Open_link
'sql3 = "update xdgl_user set password='" & Trim(Text3.Text) & "' where cname='" & Trim(Combo1.Text) & "'"
sql3 = "select password from xdgl_user where cname='" & Trim(Combo2.Text) & "'"
Set RS = ZHCX.Execute(sql3, 0)
If Not IsNull(RS(0)) Then
password = Trim(RS(0))
Else
password = ""
End If
If Trim(Text1.Text) <> password Then
A = MsgBox("密码不对请重新输入", vbDefaultButton2)
Exit Sub
End If
Call Close_link
cname = Trim(Combo2.Text)
If Option1.Value Then
yhlx = "值班员"
End If
If Option2.Value Then
yhlx = "系统管理员"
End If
' If Option3.Value Then
' yhlx = "其它"
' End If
If Trim(Combo1.Text) = "" Then
A = MsgBox("值班班次不能为空", vbDefaultButton2)
Exit Sub
Else
ZBBC = Trim(Combo1.Text)
End If
If Check1.Value Then
If yhlx = "值班员" Then
Call Open_link
sql3 = "select * from xdgl_zbb where rq='" & Format(Now, "yyyy-mm-dd") & "' and bc='" & Trim(Combo1.Text) & "' and zby like '" & Trim(Combo2.Text) & "'"
Set RS = ZHCX.Execute(sql3, 0)
If RS.EOF Then
sql3 = "select count(zby) from xdgl_zbb where rq='" & Format(Now, "yyyy-mm-dd") & "' and bc='" & Trim(Combo1.Text) & "' "
Set RS1 = ZHCX.Execute(sql3, 0)
If RS1(0) = 3 Then
Call MsgBox("注册人员已超过3人了！")
Exit Sub
Else
sql3 = "insert xdgl_zbb (rq,bc,zby,dq) values ('" & Format(Now, "yyyy-mm-dd") & "','" & Trim(Combo1.Text) & "','" & Trim(Combo2.Text) & "','是')"
Set RS2 = ZHCX.Execute(sql3, 0)
End If
Else
If Trim(RS("dq")) = "是" Then
Call MsgBox("该人员正在上班！")
Exit Sub
Else
If RS2.State Then
RS2.Close
End If
sql3 = "update xdgl_zbb set dq='是' where rq='" & Format(Now, "yyyy-mm-dd") & "' and bc='" & Trim(Combo1.Text) & "' and zby='" & Trim(Combo2.Text) & "'"
Set RS2 = ZHCX.Execute(sql3, 1)
End If
End If
If Err Then Debug.Print Err.Description
Debug.Print sql3
If RS.State Then
RS.Close
End If
If RS1.State Then
RS1.Close
End If
If RS2.State Then
RS2.Close
End If
Call Close_link
End If
End If
frmMAIN.Show
'frmdl.Visible = False
Unload frmdl
End Sub
Private Sub Command2_Click()
Call Open_link
sql3 = "update xdgl_zbb set dq='否' where rq='" & Format(Now, "yyyy-mm-dd") & "' and bc='" & Trim(Combo1.Text) & "' and zby='" & Trim(Combo2.Text) & "'"
Set RS2 = ZHCX.Execute(sql3, 0)
Call Close_link
Unload frmdl
End Sub
Private Sub Form_Load()
Option1.Value = True
Combo1.AddItem "早班"
Combo1.AddItem "中班"
Combo1.AddItem "晚班"
Combo1.ListIndex = 0
A = Format(Now, "hh")
'If Now < CDate(Format(Now, "yyyy-mm-dd") + " 08:00") Then
If Int(A) < 8 Then
Combo1.Text = "早班"
ElseIf Int(A) < 15 Then
Combo1.Text = "中班"
Else
Combo1.Text = "晚班"
End If
Call Option1_Click
End Sub
Private Sub Form_Unload(Cancel As Integer)
' Call Open_link
' sql3 = "update xdgl_zbb set dq='否' where rq='" & Format(Now, "yyyy-mm-dd") & "' and bc='" & Trim(Combo1.Text) & "' and zby='" & Trim(Combo2.Text) & "'"
' Set RS2 = ZHCX.Execute(sql3, 0)
' Call Close_link
End Sub
Private Sub Option1_Click()
sql1 = "select cname from xdgl_user where yhlx='值班员'"
'Combo1.Clear
Combo2.Clear
Call Open_link
Set RS = ZHCX.Execute(sql1, 0)
Do While Not RS.EOF
If Not IsNull(RS(0)) Then
Combo2.AddItem Trim(RS(0))
End If
RS.MoveNext
Loop
If RS.State Then
RS.Close
End If
'Call sx
Call Close_link
If Combo2.ListCount > 0 Then
Combo2.ListIndex = 0
End If
Text1.Text = ""
End Sub
Private Sub Option2_Click()
sql1 = "select * from xdgl_user where yhlx='系统管理员'"
'Combo1.Clear
Combo2.Clear
Call Open_link
Set RS = ZHCX.Execute(sql1, 0)
Do While Not RS.EOF
If Not IsNull(RS(3)) Then
Combo2.AddItem Trim(RS(3))
End If
RS.MoveNext
Loop
If RS.State Then
RS.Close
End If
Call Close_link
If Combo1.ListCount > 0 Then
Combo1.ListIndex = 0
End If
Combo2.ListIndex = 0
Text1.Text = ""
End Sub
Private Sub Option3_Click()
sql1 = "select * from xdgl_user where yhlx='其它'"
'Combo1.Clear
Combo2.Clear
Call Open_link
Set RS = ZHCX.Execute(sql1, 0)
Do While Not RS.EOF
If Not IsNull(RS(3)) Then
Combo2.AddItem Trim(RS(3))
End If
RS.MoveNext
Loop
If RS.State Then
RS.Close
End If
Call Close_link
If Combo1.ListCount > 0 Then
Combo1.ListIndex = 0
End If
If Combo2.ListCount > 0 Then
Combo2.ListIndex = 0
End If
Text1.Text = ""
End Sub
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If Index = 0 Then
If KeyCode = 13 Then
Command1.SetFocus
Call command1_Click
Else
End If
Else
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -