form1.frm

可进行学校或培训单位上机的自动日志管理跟踪,省去了手工填写日志

    Combo1.AddItem "电脑名字"
        
    '声明变量,设置注册表开机就自动运行该程序
    On Error Resume Next
    Dim sKeyName As String, sKeyValue As String, sKeyValueIcon As String
    Dim Ret As Integer, lphKey As Long
    sKeyName = "Software\Microsoft\Windows\CurrentVersion\Run"
    sKeyValue = App.Path & IIf(Len(App.Path) > 3, "\" & "服务器端.exe", "服务器端.exe")
    Ret = RegCreateKey&(HKEY_LOCAL_MACHINE, sKeyName, lphKey)
    Ret = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&)
    
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If Button = 2 Then PopupMenu 系统
End Sub

Private Sub Form_Resize()
If Form1.WindowState <> 1 Then
   Picture2.Width = Form1.Width - Picture1.Width
   DataGrid1.Width = Form1.Width - Frame1.Width - 460
   DataGrid1.Height = Form1.Height - Frame2.Height - 1200
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
 tcpwsock.Close
End Sub

Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  'MsgBox Button
End Sub

Private Sub Picture1_Resize()
 If Picture1.Height > 260 Then
   'MsgBox Picture1.Height
   Frame1.Height = Picture1.Height - 260
 End If
End Sub

Private Sub Picture2_Resize()
  'If Picture2.Width > 260 Then
   'MsgBox Picture1.Height
   Frame2.Width = Picture2.Width - 300
 'End If
End Sub

Private Sub tcpwsock_ConnectionRequest(ByVal requestID As Long)
On Error Resume Next
Dim i As Long
i = 1
Dim free As Boolean
free = False
'wsocknum为目前已经加载的winsock的数目
'在已经加载的空件数组中检查有没有连接的控件
For i = 1 To wsocknum
    If wsock(i).State = sckClosed Then
       free = True
       Exit For
    End If
Next i
'maxconnect为最大连接数,如果已经加摘的winsock控件达到最大，退出
If wsocknum = maxconnect And free = False Then
   Exit Sub
End If
'如果已经加载的控件都在连接，加载新控件
If free = False Then
   'wscok(i)为控件数组
   wsocknum = wsocknum + 1
   Load wsock(wsocknum)
   i = wsocknum
End If

If wsock(i).State <> sckClosed Then
   wsock(i).Close
End If

wsock(i).Accept requestID
'Wsock(i).SendData "/lgon你已经连上五子棋服务器"

'保存考生上站的时间,IP地址
'muser(i).mlogontime = Now()
'muser(i).ip = Wsock(i).RemoteHost
muser(i).mconnected = True
End Sub

Private Sub wsock_Close(Index As Integer)
  muser(Index).mconnected = False
  muser(Index).tmpinformation = ""
  muser(Index).tmpheader = ""
  muser(Index).tmpremains = ""
  muser(Index).name = ""
  muser(Index).ipn = ""
  muser(Index).ipw = ""
  muser(Index).tim = ""
  'muser(Index).xh = ""
End Sub

Private Sub wsock_DataArrival(Index As Integer, ByVal bytesTotal As Long)
  'Dim information As String
  'Dim conn As ADODB.Connection
  'Dim filesys As New Scripting.FileSystemObject
  'Dim tempstr As String
  'Dim rs As ADODB.Recordset
  'On Error Resume Next
  wsock(Index).GetData muser(Index).tmpinformation
  'Dim header As String
  muser(Index).tmpheader = Left$(muser(Index).tmpinformation, 5)
  
  muser(Index).tmpremains = Mid$(muser(Index).tmpinformation, 6)
  
  Select Case muser(Index).tmpheader
         
         Case "/banj" '获得班级信息
               'MsgBox "a"
               'Set muser(Index).srs = CreateObject("ADODB.Recordset")
               'muser(Index).srs.Open "select distinct bj from student order by bj", conn, 3, 3
               
               'muser(Index).tmpbj = ""
               
               'While Not muser(Index).srs.EOF
               '     muser(Index).tmpbj = muser(Index).srs("bj") & "★"
               'Wend
               
               'muser(Index).srs.Close
               'Set muser(Index).srs = Nothing
               
               wsock(Index).SendData "/banj" & tmpbj '发送所有班级
               DoEvents
               
         Case "/kech" '获得课程信息
               'MsgBox "a"
               'Set muser(Index).srs = CreateObject("ADODB.Recordset")
               'muser(Index).srs.Open "select distinct kc from kecheng order by kc", conn, 3, 3
               
               'muser(Index).tmpkc = ""
               
               'While Not muser(Index).srs.EOF
               '     muser(Index).tmpkc = muser(Index).srs("kc") & "★"
               'Wend
               
               'muser(Index).srs.Close
               'Set muser(Index).srs = Nothing
               
               wsock(Index).SendData "/kech" & tmpkc '发送所有班级
               DoEvents
          Case "/gryz" '获得更改个人验证码的信息
               Set muser(Index).srs = CreateObject("ADODB.Recordset")
               
               muser(Index).tmpsz = Split(muser(Index).tmpremains, "★")
               
               'For i = LBound(muser(Index).tmpsz) To UBound(muser(Index).tmpsz)
               '    MsgBox muser(Index).tmpsz(i)
               'Next
               
               muser(Index).srs.Open "select * from student where bj='" & muser(Index).tmpsz(0) & "' and xm='" & muser(Index).tmpsz(1) & "' and pwd='" & muser(Index).tmpsz(2) & "'", conn, 3, 3

               If muser(Index).srs.RecordCount = 0 Then
                  wsock(Index).SendData "/gecw" '个人信息错误
               Else
                  wsock(Index).SendData "/gezq" '个人信息正确
               End If

               muser(Index).srs.Close
               Set muser(Index).srs = Nothing
               DoEvents
           Case "/gyzm" '获得发送过来的更改后的验证码
               muser(Index).tmpsz = Split(muser(Index).tmpremains, "★")
               conn.Execute "update student set pwd='" & muser(Index).tmpsz(2) & "' where bj='" & muser(Index).tmpsz(0) & "' and xm='" & muser(Index).tmpsz(1) & "'"
               wsock(Index).SendData "/gsuc" '更改验证码成功后发送信息
               DoEvents
           Case "/dlyz" '获得登陆验证的信息
               Set muser(Index).srs = CreateObject("ADODB.Recordset")
               
               muser(Index).tmpsz = Split(muser(Index).tmpremains, "★")
               
               'For i = LBound(muser(Index).tmpsz) To UBound(muser(Index).tmpsz)
               '    MsgBox muser(Index).tmpsz(i)
               'Next
               
               muser(Index).srs.Open "select * from student where bj='" & muser(Index).tmpsz(2) & "' and xm='" & muser(Index).tmpsz(4) & "' and pwd='" & muser(Index).tmpsz(5) & "'", conn, 3, 3

               If muser(Index).srs.RecordCount = 0 Then
                  wsock(Index).SendData "/gecw" '个人信息错误
               Else
                  'wsock(Index).SendData "/gezq" '个人信息正确
                  conn.Execute "insert into dengji(zc,xq,jc,bj,ck,yq,xm,xh,sj,ip) values('" & muser(Index).tmpsz(0) & "','" & WeekdayName(Weekday(Date)) & "','" & muser(Index).tmpsz(1) & "','" & muser(Index).tmpsz(2) & "','" & muser(Index).tmpsz(3) & "','" & muser(Index).tmpsz(6) & "','" & muser(Index).tmpsz(4) & "'," & muser(Index).srs("xh") & ",'" & Now() & "','" & muser(Index).tmpsz(7) & "')"
                  wsock(Index).SendData "/dlsc" '登陆成功
               End If

               muser(Index).srs.Close
               Set muser(Index).srs = Nothing
               DoEvents
  End Select
End Sub

Private Sub wsock_Error(Index As Integer, ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
   '清理该考生的所有数据
   Call wsock_Close(Index)
End Sub

Private Sub hdbj() '获得所有班级
               Dim rs As ADODB.Recordset
               
               Set rs = CreateObject("ADODB.Recordset")
               
               rs.Open "select distinct bj from student order by bj", conn, 3, 3
               
               tmpbj = ""
               
               While Not rs.EOF
                    tmpbj = tmpbj & rs("bj") & "★"
                    rs.MoveNext
               Wend
               
               rs.Close
               Set rs = Nothing
End Sub

Private Sub hdkc() '获得所有课程
               Dim rs As ADODB.Recordset
               
               Set rs = CreateObject("ADODB.Recordset")
               
               rs.Open "select kc from kecheng order by kc", conn, 3, 3
               
               tmpkc = ""
               
               While Not rs.EOF
                    tmpkc = tmpkc & rs("kc") & "★"
                    rs.MoveNext
               Wend
               
               rs.Close
               Set rs = Nothing
End Sub

Private Sub 课程数据_Click()
  Call Command2_Click
End Sub

Private Sub 删除记录_Click()
  Call Command3_Click
End Sub

Private Sub 生成报表_Click()
   Call Command4_Click
End Sub


Private Sub 退出_Click()
   Call Command5_Click
End Sub

Private Sub 统计学生个数_Click()
   If Adodc1.Recordset.RecordCount > 0 Then
      Dim tmpprs As ADODB.Recordset
      Dim tmptjn1, tmptjn2 As Integer
      Dim i, k As Long
      Set tmpprs = CreateObject("ADODB.Recordset")
      
      Open "c:\tmp.htm" For Output As #1 '【生成未登陆的学生的报表】
      Print #1, "<html><title>该时间段学生登陆情况</title><br><br>在该时间段，没有登陆的学生如下：<br><br>"
      
      Adodc1.Recordset.Sort = "xh asc"
      Adodc1.Recordset.MoveFirst
      
      While Not Adodc1.Recordset.EOF
         tmptjn2 = Adodc1.Recordset("xh")
         If tmptjn1 <> tmptjn2 Then
             'If tmptjn1 > 40 Then MsgBox (tmptjn2 - 1) & (tmptjn1 + 1)
             If tmptjn2 - tmptjn1 > 1 Then '说明学号不连续
               For k = tmptjn1 + 1 To tmptjn2 - 1
                tmpprs.Open "select * from student where bj='" & Adodc1.Recordset("bj") & "' and xh=" & k, conn, 3, 3
                'MsgBox "select * from student where bj='" & Adodc1.Recordset("bj") & "' and xh=" & k
                 If tmpprs.RecordCount > 0 Then
                    Print #1, tmpprs("bj") & "，" & tmpprs("xh") & "号，" & tmpprs("xm") & "<br><br>"
                 End If
                 tmpprs.Close
               Next
             End If
            '增加人数
            i = i + 1
            tmptjn1 = tmptjn2
         End If
         Adodc1.Recordset.MoveNext
      Wend
      Set tmpprs = Nothing
      
      'MsgBox "在该时间段，登陆的学生有：【" & i & "】个人！", vbOKOnly, "统计学生人数"
      Print #1, "在该时间段，登陆的学生总共有：【" & i & "】个人！"
      Print #1, "</html>"
      Close #1
      
      Shell App.Path & "\IEXPLORE.EXE c:\tmp.htm", vbMaximizedFocus
   End If
End Sub

Private Sub 退出系统_Click()
   Call Command5_Click
End Sub

Private Sub connecta()
    Adodc1.ConnectionString = connstr '"provider=microsoft.jet.oledb.4.0; jet oledb:database password=office;data source=" & App.Path & "\msshuju.ocx"
    Adodc1.CommandType = adCmdText
    Adodc1.RecordSource = "select zc,xq,jc,bj,ck,yq,xm,xh,sj,ip from dengji order by sj desc,bj asc,xm asc"
    Adodc1.Refresh
    Set DataGrid1.DataSource = Adodc1
    DataGrid1.Columns(0).Width = 550
    DataGrid1.Columns(1).Width = 700
    DataGrid1.Columns(2).Width = 700
    DataGrid1.Columns(3).Width = 800
    DataGrid1.Columns(4).Width = 1800
    DataGrid1.Columns(6).Width = 1000
    DataGrid1.Columns(7).Width = 550
    DataGrid1.Columns(8).Width = 2000
    DataGrid1.Columns(0).Caption = "周次"
    DataGrid1.Columns(1).Caption = "星期"
    DataGrid1.Columns(2).Caption = "节次"
    DataGrid1.Columns(3).Caption = "班级"
    DataGrid1.Columns(4).Caption = "课程内容"
    DataGrid1.Columns(5).Caption = "仪器使用情况"
    DataGrid1.Columns(6).Caption = "学生姓名"
    DataGrid1.Columns(7).Caption = "学号"
    DataGrid1.Columns(8).Caption = "登陆时间"
    DataGrid1.Columns(9).Caption = "电脑名字"
End Sub

Private Sub 学生数据_Click()
    Call Command1_Click
End Sub