form1.frm

vb.net开发的考试系统,界面美观

    '正式发送文件
    txtRecive.SelText = txtRecive.SelText & "正在向用户" & chatname(Index) & "发送传送文件列表！" & vbCrLf
    filename(Index) = App.Path & "\datalist\" & chatname(Index) & ".txt"
    sckServer(Index).SendData "FILENAME|" & Mid(filename(Index), InStrRev(filename(Index), "\") + 1) & vbCrLf
    FileSize(Index) = FileLen(filename(Index))
    sckServer(Index).SendData "FILESIZE|" & FileSize(Index) & vbCrLf

Case "FULFILLINCEPT"
   txtRecive.SelText = txtRecive.SelText & "用户" & chatname(Index) & "已经成功接收文件." & vbCrLf
   txtRecive.SelText = txtRecive.SelText & "文件路径:" & filename(Index) & vbCrLf
Case "COMPUTERID"
   For n = 1 To Grid1.Rows - 1
    If Grid1.Cell(n, 2).Text = Index Then
     Grid1.Cell(n, 0).Text = stritem
    End If
   Next
Case "NAME" '登陆用户处理状态
If firstmess(Index) = True Then
chatname(Index) = stritem
firstmess(Index) = False
For m = 0 To 49

   If (Index <> m) And (chatname(m) = stritem) Then

     sckServer(Index).Close

     firstmess(Index) = True

     curnumber = curnumber - 1

     number.Caption = curnumber

     Exit Sub

   End If

Next m
   Dim strdatabakname As String
   strdatabakname = stritem '这里提前备份出用户名
   txtRecive.SelText = txtRecive.SelText & "用户" & strdatabakname & "已经连接服务器." & vbCrLf
   Grid1.Rows = Grid1.Rows + 1 '记录进入服务器后左边的登陆栏,方便内部发送信息
   Grid1.Cell(Grid1.Rows - 1, 1).Text = strdatabakname
   Grid1.Cell(Grid1.Rows - 1, 2).Text = Index
End If
'For j = 0 To MaxNumber - 1 '发送消息给其它用户

'If sckServer(j).State = 7 Then

'sckServer(j).SendData stritem
'DoEvents

'End If
'Next
1:
DoEvents
Close #intFile
End Select
End If
Next
End If
End Sub

Private Sub sckServer_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)
sckServer(Index).Close
End Sub
Private Sub ACPRibbon1_MainMenuClick()

'# This Event occurs on click in Main Button Menu
MsgBox "欢迎进入星零网络考试系统服务器端" & vbCrLf & "联系QQ:342483870"

End Sub

Private Sub ACPRibbon1_CustomClick()

'# This Event occurs on click in Custom Button Menu
MsgBox "Custom Click"

End Sub

Private Sub ACPRibbon1_MenuClick(ByVal ID As String, ByVal Caption As String)

'# This Event occurs when click on each Menu Button
MsgBox "MenuClick: " & ID & "--" & Caption

End Sub

Private Sub ACPRibbon1_CatClick(ByVal ID As String, ByVal Caption As String)

'# This Event occurs when click on each ShowDialogButton for each Categorie
MsgBox "这个是 " & ID & "--" & Caption

End Sub

Private Sub ACPRibbon1_ButtonClick(ByVal ID As String, ByVal Caption As String)
'第二大菜单栏
Select Case ID
Case 1
  PopupMenu menu.ks_mode
Case 2
  Form2.Show 1 '试题规划
Case 3
  cnn_clear
End Select
End Sub
Public Sub load_feng() '加载分数分配表
Set qy1 = cnn.Execute("select * from 分数")
Dim i As Integer
Do While Not qy1.EOF
i = i + 1
Feng_st(i) = qy1.Fields(1)
qy1.MoveNext
Loop
'将获取的各种题型分数输出到各变量,以后后面的引用

Feng_xz = Feng_st(1)
txtRecive.SelText = txtRecive.SelText & "   选择题单题分数：" & Feng_xz & "分(每题)." & vbCrLf

Feng_tk = Feng_st(2)
txtRecive.SelText = txtRecive.SelText & "   填空题单题分数：" & Feng_tk & "分(每题)." & vbCrLf

Feng_dc = Feng_st(3)
txtRecive.SelText = txtRecive.SelText & "   答错题单题分数：" & Feng_dc & "分(每题)." & vbCrLf

Feng_jd = Feng_st(4)
txtRecive.SelText = txtRecive.SelText & "   简答题单题分数：" & Feng_jd & "分(每题)." & vbCrLf

Feng_wd = Feng_st(5)
txtRecive.SelText = txtRecive.SelText & "   问答题单题分数：" & Feng_wd & "分(每题)." & vbCrLf

End Sub
Private Sub send_file(ByVal Index As Integer)
On Error GoTo 1
          Dim myFile()  As Byte
          Dim dblSent As Double
          Dim filemax As Double
          filemax = 8192
Open filename(Index) For Binary As #1
    If FileSize(Index) <= filemax Then '8192为极限缓存
        myFile = Space(FileSize(Index))
        Get #1, , myFile
        sckServer(Index).SendData myFile
        GoTo 1
    End If
    '超过 1KB - 将分段为 8192 字节
    
    Do While EOF(1) = False
        If dblSent + filemax <= FileSize(Index) Then
            myFile = Space(filemax)
            Get #1, , myFile
            sckServer(Index).SendData myFile
            dblSent = dblSent + filemax
            DoEvents
        Else
            myFile = Space(filemax - dblSent)
            Get #1, , myFile
            sckServer(Index).SendData myFile
            Exit Do
        End If
        DoEvents
    Loop
    Close #1
   txtRecive.SelText = txtRecive.SelText & "文件已成功的发送给用户" & chatname(Index) & "." & vbCrLf
1:
Close #1
End Sub
Public Sub load_strule() '加载试题规则
'读取试题规则，默认为规则1
TEXTCOLOR_start
txtRecive.SelText = txtRecive.SelText & "正在读取当前默认试卷组成规则...." & vbCrLf

Set qy1 = cnn.Execute("select * from 试题设置 where 规则='规则1'")
If qy1.EOF = False Then
 Int_xz = qy1.Fields(1)
 txtRecive.SelText = txtRecive.SelText & "生成选择题数量：" & Int_xz & "题." & vbCrLf
 Int_tk = qy1.Fields(2)
 txtRecive.SelText = txtRecive.SelText & "生成填空题数量：" & Int_tk & "题." & vbCrLf
 Int_dc = qy1.Fields(3)
 txtRecive.SelText = txtRecive.SelText & "生成答错题数量：" & Int_dc & "题." & vbCrLf
 Int_jd = qy1.Fields(4)
 txtRecive.SelText = txtRecive.SelText & "生成简答题数量：" & Int_jd & "题." & vbCrLf
 Int_wd = qy1.Fields(5)
 txtRecive.SelText = txtRecive.SelText & "生成问答题数量：" & Int_wd & "题." & vbCrLf
 Feng_count = qy1.Fields(6)
 txtRecive.SelText = txtRecive.SelText & "生成的试卷总分：" & Feng_count & "分." & vbCrLf
 ST_TIME = qy1.Fields(7)
 txtRecive.SelText = txtRecive.SelText & "√试卷定义考试时间：" & ST_TIME & "分钟." & vbCrLf

Else

End If
TEXTCOLOR2_end
End Sub

Private Sub Timer1_Timer()
txtRecive.SelText = txtRecive.SelText & "正在接收用户" & chatname(INDEXID) & "的答案文件" & vbCrLf
sckServer(INDEXID).SendData "OPENPLAY|" & filename(INDEXID) & vbCrLf
Timer1.Enabled = False
End Sub

Private Sub txtRecive_Change()
TEXTCOLOR_start
TEXTCOLOR2_end
If Me.Enabled = True Then
txtRecive.SetFocus '使用此语句实现文本内容改变时光标自动调到文本尾部
End If
txtRecive.SelStart = Len(txtRecive.Text)
End Sub
Private Sub Make_ST() '生成试题
Dim stnnumber As Integer
stnnumber = Int_xz
Set qy1 = cnn1.Execute("select count(*) from 选择题")
If qy1.Fields(0) < stnnumber Then
 MsgBox "设置生成的试题数超出题库数量，请重新设置"
 Exit Sub
End If
'设定试题与生成试题数之间的比例，如果大于或等于1/3时才进行选择操作，否则，直接选择某切入点
'进行试题的生成，可以取试题
Dim j, k As Integer
Set qy2 = cnn1.Execute("select 题目编号 from 选择题")
   Dim strtargetfile As String
   Dim strtargetfile_ASK As String
   Dim strtargetfile_Key As String
   strtargetfile = App.Path & "\DATALIST\" & chatname(INDEXID) & ".txt"
   strtargetfile_ASK = App.Path & "\DATALIST\" & chatname(INDEXID) & "_ASK.txt"
   strtargetfile_Key = App.Path & "\DATALIST\" & chatname(INDEXID) & "_key.txt"
    If Dir(strtargetfile, vbNormal) <> "" Then
       Kill strtargetfile
    End If
    If Dir(strtargetfile_ASK, vbNormal) <> "" Then
       Kill strtargetfile_ASK
    End If
    If Dir(strtargetfile_Key, vbNormal) <> "" Then
       Kill strtargetfile_Key
    End If
Open strtargetfile For Append As #1
Print #1, "\DATALIST\" & chatname(INDEXID) & "_ask.txt"
Close #1
If qy1.Fields(0) / 3 >= stnnumber Then '这里是进入选题
 Dim nnum(99999) As Double
 For i = 0 To qy1.Fields(0) - 1 '向数组中写入入选的题目编号
        nnum(i) = qy2.Fields(0)
        qy2.MoveNext
   Next
   '进入生成循环中心
      j = 0
      Do While j < stnnumber '生成的试题数
        Randomize '加入此句保证每次程序启动时生成的随机数都不会一样
        k = Int((qy1.Fields(0) - 1) * Rnd)
        If nnum(k) <> 0 Then
          '查找对应的题目编号内容
          Set qy3 = cnn1.Execute("select * from 选择题 where 题目编号=" & nnum(k))
          nnum(k) = 0 '清空已生成的题目编号，使目标为0
          '读取数据并写入文本

             Open strtargetfile For Append As #1
             Open strtargetfile_ASK For Append As #2
             Open strtargetfile_Key For Append As #3
             For n = 3 To qy3.Fields.Count - 1
              If qy3.Fields(n) <> "" Then
               If Mid(qy3.Fields(n), 1, 4) = "BMP|" Then
                Print #1, Mid(qy3.Fields(n), 5, Len(qy3.Fields(n)) - 4)
               End If
              End If
             Next
             If qy3.Fields(7) = "" Then
             Print #2, j + 1 & "." & qy3.Fields(2) & "@" & qy3.Fields(3) & vbCrLf & "A. " & qy3.Fields(4) & vbCrLf & "B. " & qy3.Fields(5) & vbCrLf & "C. " & qy3.Fields(6) & vbCrLf
             Else
             Print #2, j + 1 & "." & qy3.Fields(2) & "@" & qy3.Fields(3) & vbCrLf & "A. " & qy3.Fields(4) & vbCrLf & "B. " & qy3.Fields(5) & vbCrLf & "C. " & qy3.Fields(6) & vbCrLf & "D. " & qy3.Fields(7)
             End If
             Print #3, qy3.Fields(8)
             Close #1
             Close #2
             Close #3
           j = j + 1
        End If
       Loop
    txtRecive.SelText = txtRecive.SelText & "试题已成功生成！" & vbCrLf
Else '直接得到试题，无需进行随机生成
      Set qy2 = cnn1.Execute("select * from 选择题")
      j = 0
      Do While j < stnnumber '生成的试题数
             Open strtargetfile For Append As #1
             Open strtargetfile_ASK For Append As #2
             Open strtargetfile_Key For Append As #3
             For n = 3 To qy2.Fields.Count - 1
              If qy2.Fields(n) <> "" Then
               If Mid(qy2.Fields(n), 1, 4) = "BMP|" Then
                Print #1, Mid(qy2.Fields(n), 5, Len(qy2.Fields(n)) - 4)
               End If
              End If
             Next
             If qy2.Fields(7) = "" Then
             Print #2, j + 1 & "." & qy2.Fields(2) & "@" & qy2.Fields(3) & vbCrLf & "A. " & qy2.Fields(4) & vbCrLf & "B. " & qy2.Fields(5) & vbCrLf & "C. " & qy2.Fields(6) & vbCrLf
             Else
             Print #2, j + 1 & "." & qy2.Fields(2) & "@" & qy2.Fields(3) & vbCrLf & "A. " & qy2.Fields(4) & vbCrLf & "B. " & qy2.Fields(5) & vbCrLf & "C. " & qy2.Fields(6) & vbCrLf & "D. " & qy2.Fields(7)
             End If
             Print #3, qy2.Fields(8)
             Close #1
             Close #2
             Close #3
           qy2.MoveNext
           j = j + 1
      Loop
      txtRecive.SelText = txtRecive.SelText & "试题已成功生成！" & vbCrLf
End If
End Sub