frmmain.frm

网上收集的一个考试管理系统。带论文的

TWForm.UnLoadForm
Set TWForm = Nothing
End
End Sub

Private Sub Form_Resize()
Me.Top = 0
Me.Left = 0
Me.Width = Screen.Width * 2
Frame1.Width = Screen.Width
Me.Height = Screen.Height - 100

LvItem.Width = Me.Width + 200
LvItem.Height = Me.Height - 50
Me.WindowState = 0
End Sub




Public Function LockPC(locked As Boolean)
Dim X As Long

    Select Case locked
           Case True
                  wnd = FindWindow(sTrayWindow, vbNullString)
                  wnd = FindWindowEx(wnd, 0, sStartButton, vbNullString)
                  ShowWindow wnd, SW_HIDE
                  wnd = FindWindow(sTrayWindow, vbNullString)
                  wnd = FindWindow(sProgman, vbNullString)
                  wnd = FindWindowEx(wnd, 0, sDesktopIcon, vbNullString)
                  ShowWindow wnd, SW_HIDE
                  wnd = FindWindow(sTrayWindow, vbNullString)
                  wnd = FindWindowEx(wnd, 0, sAppSwitchBar, vbNullString)
                  wnd = FindWindowEx(wnd, 0, sAppIcon, vbNullString)
                  ShowWindow wnd, SW_HIDE
                  X = SystemParametersInfo(97, True, CStr(1), 0)
           Case False
                  X = SystemParametersInfo(97, False, CStr(1), 0)
                   wnd = FindWindow(sTrayWindow, vbNullString)
                   wnd = FindWindowEx(wnd, 0, sStartButton, vbNullString)
                   ShowWindow wnd, SW_SHOW
                   wnd = FindWindow(sTrayWindow, vbNullString)
                   wnd = FindWindow(sProgman, vbNullString)
                   wnd = FindWindowEx(wnd, 0, sDesktopIcon, vbNullString)
                   ShowWindow wnd, SW_SHOW
                   wnd = FindWindow(sTrayWindow, vbNullString)
                   wnd = FindWindowEx(wnd, 0, sAppSwitchBar, vbNullString)
                   wnd = FindWindowEx(wnd, 0, sAppIcon, vbNullString)
                   ShowWindow wnd, SW_SHOW
    End Select
End Function


Private Sub LvItem_DblClick()
On Error Resume Next
Select Case LvItem.SelectedItem.Text
       Case "考生登录"
          If UserLogin = False Then
                Load FrmLogin
                FrmLogin.Show
                FrmLogin.TWForm.ShowForm
                Me.Enabled = False
          Else
                MsgBox "你已经登录,快点考试吧", vbInformation, "提示"
          End If
       Case "基础题"
            If UserLogin = False Then
               MsgBox "你还未登录，快点登录", vbSystemModal, "提示 "
            Else
                Me.PopupMenu MenuQuick
            End If
       Case "操作题"
        If UserLogin = False Then
           MsgBox "你还未登录，快点登录", vbSystemModal, "提示 "
        Else
          Load FrmOperation
          FrmOperation.Show
          FrmOperation.TWForm.ShowForm
        End If
      Case "浏览计算机"
            Load FrmBrowse
            FrmBrowse.Show
     Case "交卷"
            If UserLogin = False Then
               MsgBox "你还未登录，快点登录", vbSystemModal, "提示 "
            Else
                 If ExamTime > 0 Then
                   If MsgBox("考试还未结束，确定要交卷吗？", vbExclamation + vbYesNo, App.Title) = vbYes Then
                      Call CountZongFeng(True)
                   End If
                 Else
                      Call CountZongFeng(True)
                 End If
            End If

        
       Case "退出"
          If UserLogin = False Then
                LockPC False
                   Kill App.Path & "\ExamBak.bak"
                   Kill App.Path & "\examktl.dll"
                  
                Unload Me
          Else
               MsgBox "考试中，无法结束程序，如要结束程序请交卷后在结束程序", vbInformation, App.Title
          End If
End Select
End Sub

Private Sub MenuFillSubject_Click()
  Load FrmFillTest
  FrmFillTest.Show
  FrmFillTest.TWForm.ShowForm
End Sub

Private Sub MenuSingleChoice_Click()
Load FrmSelectTest
FrmSelectTest.Show
FrmSelectTest.TWForm.ShowForm
End Sub

Private Sub MultiChoice_Click()
Load FrmMultiSelectTest
FrmMultiSelectTest.Show
FrmMultiSelectTest.TWForm.ShowForm
End Sub

Private Sub Timer1_Timer()
    Timer1.Enabled = False
    Label3.Caption = "还剩 " & ExamTime & " 分钟"
    If ExamTime = 5 Then
           MsgBox "注意：离考试结束时间还有5分钟！请抓紧完成考试", vbInformation, "提示"
    ElseIf ExamTime = 0 Then
           Timer1.Enabled = False
           Call CountZongFeng(True)
           Exit Sub
    End If
    ExamTime = ExamTime - 1
    WritePrivateProfileString "ExamTime", "Value", ExamTime, App.Path & "\ExamBak.bak"
    Timer1.Enabled = True
End Sub

Private Sub Winsock1_Connect()
If UserLogin = False Then
    FrmLogin.Label5.Caption = "连接到服务器"
    Winsock1.SendData "|StudenID|" & FrmLogin.Text1.Text
Else
    FrmMain.Winsock1.SendData FailedData
End If
End Sub


Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
Dim Dstring$
Winsock1.GetData Dstring, vbString, bytesTotal
Select Case Mid(Dstring, 1, 10)
       Case "|StudenEr|"
            FrmLogin.Timer1.Enabled = False
            FrmLogin.Text1.Enabled = True
            FrmLogin.CmdLogin.Enabled = True
            FrmLogin.Label5.Caption = "没有此考生"
            FrmLogin.Text1.SetFocus
       Case "|StudenOk|"
            FrmLogin.Timer1.Enabled = False
            FrmMain.Label2.Caption = Mid(Dstring, 11, bytesTotal) & " 考生你已经登录，可以考试了"
            StInfo.sName = Mid(Dstring, 11, bytesTotal)
            StInfo.sId = FrmLogin.Text1.Text
            Winsock1.SendData "|GetExamI|" '获得考试题型信息
       Case "|GetExamI|"
            Call GetExamInfo(Mid(Dstring, 11, bytesTotal))
            Call BakStudentInfo
            FrmMain.Enabled = True
            UserLogin = True
            FrmLogin.TWForm.UnLoadForm
            FrmLogin.Hide
            Label3.Caption = "还剩 " & ExamTime & " 分钟"
            Timer1.Enabled = True
            '已取消
            'Load FrmBuild
            'FrmBuild.Show
             Load FrmDownload
             FrmDownload.Show
       Case "|SendFile|"
              FrmDownload.WskFileComm.Close
              FrmDownload.WskFileComm.Connect ServerIP, Mid(Dstring, 11, bytesTotal)
       Case "|SendMsgs|"
           MsgBox Mid(Dstring, 11, bytesTotal), vbSystemModal, "警告"
       Case "|EXOverOK|"
           MsgBox "考试完毕，请离开考场!", vbSystemModal, "考试结束"
           Call OverExamSetup
       Case "|EXOverEr|"
           MsgBox "未知错误请联系老师", vbSystemModal, "警告"
       Case "|CheatMsg|"
            Winsock1.SendData "|CheatMsg|"
            MsgBox "由于的作弊行为,你被取消考试资格!", vbSystemModal, "警告"
                
End Select
End Sub

Private Sub Winsock1_Error(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)

If TryHost = 6 Then
    FrmLogin.Label5.Caption = "服务器未响应或繁忙请在试"
    FrmLogin.Text1.Enabled = True
    FrmLogin.Timer1.Enabled = False
    FrmLogin.CmdLogin.Enabled = True
    Exit Sub
Else
    Call ConnectServer
End If
TryHost = TryHost + 1
End Sub

Sub BakStudentInfo() '备份学生信息
    WritePrivateProfileString "SeverIP", "IP", Winsock1.RemoteHostIP, App.Path & "\ExamBak.bak"

    WritePrivateProfileString "StudentName", "Name", StInfo.sName, App.Path & "\ExamBak.bak"
    WritePrivateProfileString "StudentId", "Id", StInfo.sId, App.Path & "\ExamBak.bak"
    '已取消
    'WritePrivateProfileString "IsBak", "IsNot", "1", App.Path & "\ExamBak.bak"
    'WritePrivateProfileString "SelectSubject", "Value", SelectSubject, App.Path & "\ExamBak.bak"
    'WritePrivateProfileString "SelectSubjectValue", "Value", SelectSubjectValue, App.Path & "\ExamBak.bak"
    'WritePrivateProfileString "OperationSubject", "Value", OperationSubject, App.Path & "\ExamBak.bak"
     WritePrivateProfileString "ExamTime", "Value", ExamTime, App.Path & "\ExamBak.bak"
     WritePrivateProfileString "DownFile", "FileLen", StInfo.sId, App.Path & "\ExamBak.bak"

End Sub

Sub ResumeStudentInfo() '恢复学生信息
   Dim CString As String * 255
   
    GetPrivateProfileString "SeverIP", "IP", "", CString, Len(CString), App.Path & "\ExamBak.bak"
     ServerIP = TrimEnd(TrimIpSpace(CString))
     CString = Empty
    GetPrivateProfileString "StudentName", "Name", "", CString, Len(CString), App.Path & "\ExamBak.bak"
    StInfo.sName = TrimEnd(Trim(CString))
     CString = Empty
    GetPrivateProfileString "StudentId", "Id", "", CString, Len(CString), App.Path & "\ExamBak.bak"
    StInfo.sId = TrimEnd(Trim(CString))
     CString = Empty
    'GetPrivateProfileString "SelectSubject", "Value", "", CString, Len(CString), App.Path & "\ExamBak.bak"
     'SelectSubject = Val(CString)
     'CString = Empty
    'GetPrivateProfileString "SelectSubjectValue", "Value", "", CString, Len(CString), App.Path & "\ExamBak.bak"
    '' SelectSubjectValue = Val(CString)
     'CString = Empty
    'GetPrivateProfileString "OperationSubject", "Value", "", CString, Len(CString), App.Path & "\ExamBak.bak"
    'OperationSubject = Val(CString)
    ' CString = Empty
    GetPrivateProfileString "ExamTime", "Value", "", CString, Len(CString), App.Path & "\ExamBak.bak"
      ExamTime = Val(CString)
      CString = Empty
    GetPrivateProfileString "DownFile", "FileLen", "", CString, Len(CString), App.Path & "\ExamBak.bak"
      DownFileLenCount = Val(CString)
      CString = Empty
    FrmMain.Label2.Caption = StInfo.sName & " 考生你已经登录，可以考试了"
    Label3.Caption = "还剩 " & ExamTime & " 分钟"

End Sub