📄 form1.frm
字号:
Height = 8175
Left = 120
TabIndex = 1
Top = 120
Width = 1815
End
End
Begin MSAdodcLib.Adodc Adodc1
Align = 2 'Align Bottom
Height = 495
Left = 0
Top = 8055
Visible = 0 'False
Width = 12510
_ExtentX = 22066
_ExtentY = 873
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 8
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 1
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = ""
OLEDBString = ""
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = ""
Caption = "Adodc1"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin VB.Menu 基本操作
Caption = "【基本操作】(&J)"
Begin VB.Menu 删除记录
Caption = "【删除记录】(&D)"
Shortcut = ^D
End
Begin VB.Menu 生成报表
Caption = "【生成报表】(&S)"
Shortcut = ^S
End
Begin VB.Menu 退出系统
Caption = "【退出系统】(&Q)"
Shortcut = ^Q
End
End
Begin VB.Menu 其他数据表
Caption = "【其他数据表】(&T)"
Begin VB.Menu 学生数据
Caption = "【学生数据】(&X)"
Shortcut = ^X
End
Begin VB.Menu 课程数据
Caption = "【课程数据】(&K)"
Shortcut = ^K
End
End
Begin VB.Menu 系计
Caption = "【系计】(&S)"
Begin VB.Menu 统计学生个数
Caption = "【统计学生个数】(&G)"
Shortcut = ^G
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim zxh As Boolean '标记激活第一次最小化
Private Sub Combo1_KeyPress(KeyAscii As Integer)
On Error Resume Next
KeyAscii = ""
End Sub
Private Sub Command1_Click()
Form2.Show 1
End Sub
Private Sub Command2_Click()
Form3.Show 1
End Sub
Private Sub Command3_Click()
If Not Adodc1.Recordset.EOF And Not Adodc1.Recordset.BOF Then
a = MsgBox("你确定要删除数据吗？", vbYesNo, "提示")
If a = vbYes Then
Adodc1.Recordset.Delete
DataGrid1.SetFocus
End If
End If
End Sub
Private Sub Command4_Click()
If Adodc1.Recordset.RecordCount <= 0 Then Exit Sub
Open "c:\tmp.htm" For Output As #1 '【生成报表】
Print #1, "<html><title>专用实验室使用情况表</title>"
Print #1, "<mate content=text/html charset=gb2312 http-equiv=Content-Type>"
'Print #1, "<style type=text/css>" & _
' "Body{font-size=2pt;font-famliy:宋体,Tahoma}" & _
' "</style><body topmargin='0' leftmargin='0'>"
'Print #1, "<body style='font-size: 10pt; font-family: 宋体' topmargin='0' leftmargin='0'>"
Print #1, "<body topmargin='0' leftmargin='0'>"
Print #1, "<center><font size='6'><b>专用实验室使用情况</b></font>"
Print #1, "<table border='1' width='1000' bordercolor='#000000'style='border-collapse: collapse' cellspacing='0' cellpadding='3'>"
'Print #1, "<tr><td align='center'><table><tr><td>专用实验室使用情况</td></tr></table></td></tr>"
Adodc1.Recordset.MoveFirst
Print #1, "<b><tr><td width='45'><b>周次</b></td><td width='66'><b>星期</b></td><td width='77'><b>节次</b></td><td width='122'><b>班级</b></td><td width='159'><b>课程内容</b></td><td width='265'><b>仪器使用情况</b></td><td width='97'><b>学生姓名</b></td><td width='35'><b>学号</b></td><td width='120'><b>登陆时间</b></td><td width='120'><b>电脑名字</b></td></tr>"
While Not Adodc1.Recordset.EOF
Print #1, "<tr>"
For i = 0 To 9
Print #1, "<td>" & Adodc1.Recordset.Fields(i).Value & "</td>"
Next
Print #1, "</tr>"
Adodc1.Recordset.MoveNext
Wend
Adodc1.Recordset.MoveFirst
Print #1, "</table></center>"
Print #1, "</body></html>"
Close #1
Shell App.Path & "\IEXPLORE.EXE c:\tmp.htm", vbMaximizedFocus
End Sub
Private Sub Command5_Click()
tcpwsock.Close
End
End Sub
Private Sub Command6_Click()
If Trim(Combo1.Text) = "" Then
MsgBox "请选择搜索字段！", vbOKOnly, "信息提示"
Combo1.SetFocus
Else
If Not Adodc1.Recordset.EOF And Not Adodc1.Recordset.BOF Then
Select Case Trim(Combo1.Text)
Case "周次", "星期", "班级", "课程内容", "学生姓名", "学号", "电脑名字"
Select Case Trim(Combo1.Text)
Case "周次"
fieldss = "zc"
Case "星期"
fieldss = "xq"
Case "班级"
fieldss = "bj"
Case "课程内容"
fieldss = "ck"
Case "学生姓名"
fieldss = "xm"
Case "学号"
fieldss = "xh"
Case "电脑名字"
fieldss = "ip"
End Select
'
'Adodc1.Refresh
'Adodc1.Recordset.Filter = ""
On Error Resume Next
'Call connecta
'Adodc1.Recordset.Filter = ""
If fieldss = "xh" Then
Adodc1.Recordset.Filter = "[" & fieldss & "] = " & Val(Trim(Text1.Text))
Else
Adodc1.Recordset.Filter = "[" & fieldss & "] like '*" & Trim(Text1.Text) & "*'"
End If
'DataGrid1.Refresh
Case "登陆时间"
On Error Resume Next
fieldss = "sj"
tmpa = Split(Trim(Text1.Text), ",")
If Not IsDate(tmpa(LBound(tmpa))) Or Not IsDate(tmpa(UBound(tmpa))) Then
MsgBox "日期输入有错！", vbOKOnly, "信息提示"
'Text1.Text = ""
Text1.SetFocus
Else
'MsgBox CDate(tmpa(LBound(tmpa)))
Adodc1.Recordset.Filter = "[" & fieldss & "]>='" & CDate(tmpa(LBound(tmpa))) & "' and [" & fieldss & "]<='" & CDate(tmpa(UBound(tmpa))) & "'"
'MsgBox Adodc1.Recordset.Filter
End If
End Select
End If
End If
End Sub
Private Sub Command7_Click()
Call connecta
Call hdbj '获得所有班级
Call hdkc '获得所有课程
End Sub
Private Sub DataGrid1_HeadClick(ByVal ColIndex As Integer)
Select Case ColIndex
Case 0
If clickflg = False Then
Adodc1.Recordset.Sort = "zc asc"
clickflg = True
Else
Adodc1.Recordset.Sort = "zc desc"
clickflg = False
End If
Case 1
If clickflg = False Then
Adodc1.Recordset.Sort = "xq asc"
clickflg = True
Else
Adodc1.Recordset.Sort = "xq desc"
clickflg = False
End If
Case 2
If clickflg = False Then
Adodc1.Recordset.Sort = "jc asc"
clickflg = True
Else
Adodc1.Recordset.Sort = "jc desc"
clickflg = False
End If
Case 3
If clickflg = False Then
Adodc1.Recordset.Sort = "bj asc"
clickflg = True
Else
Adodc1.Recordset.Sort = "bj desc"
clickflg = False
End If
Case 4
If clickflg = False Then
Adodc1.Recordset.Sort = "ck asc"
clickflg = True
Else
Adodc1.Recordset.Sort = "ck desc"
clickflg = False
End If
Case 6
If clickflg = False Then
Adodc1.Recordset.Sort = "xm asc"
clickflg = True
Else
Adodc1.Recordset.Sort = "xm desc"
clickflg = False
End If
Case 7
If clickflg = False Then
Adodc1.Recordset.Sort = "xh asc"
clickflg = True
Else
Adodc1.Recordset.Sort = "xh desc"
clickflg = False
End If
Case 8
If clickflg = False Then
Adodc1.Recordset.Sort = "sj asc"
clickflg = True
Else
Adodc1.Recordset.Sort = "sj desc"
clickflg = False
End If
Case 9
If clickflg = False Then
Adodc1.Recordset.Sort = "ip asc"
clickflg = True
Else
Adodc1.Recordset.Sort = "ip desc"
clickflg = False
End If
End Select
End Sub
Private Sub Form_Activate()
DataGrid1.SetFocus
If zxh = False Then
Form1.WindowState = 1
zxh = True
End If
End Sub
Private Sub Form_Initialize()
If App.PrevInstance = True Then
MsgBox "程序正在运行！", vbOKOnly + vbExclamation, "注意 ！"
End
End If
'On Error Resume Next
'If conn = Nothing Then MsgBox "a"
tcpwsock.LocalPort = 10000
tcpwsock.Listen
wsocknum = 1
Form1.WindowState = 2
End Sub
Private Sub Form_Load()
Call connected '打开conn
'MsgBox conn.State
Call hdbj '获得所有班级
Call hdkc '获得所有课程
connstr = "provider=microsoft.jet.oledb.4.0; jet oledb:database password=office;data source=" & App.Path & "\db.mdb"
Call connecta
Combo1.AddItem "周次"
Combo1.AddItem "星期"
Combo1.AddItem "班级"
Combo1.AddItem "课程内容"
Combo1.AddItem "学生姓名"
Combo1.AddItem "学号"
Combo1.AddItem "登陆时间"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -