form1.frm

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

ACPRibbon1.AddTab "4", "用户管理"
ACPRibbon1.AddTab "5", "退出系统"

'# Add Cats ---   ID - Tab - Caption - ShowDialogButton
ACPRibbon1.AddCat "1", "1", "考试模式", False
ACPRibbon1.AddCat "2", "1", "试卷设置", False
ACPRibbon1.AddCat "3", "1", "连接设置", False
ACPRibbon1.AddCat "4", "2", "试题管理", False
ACPRibbon1.AddCat "6", "3", "Vitaking!", False

'# Add Button ---    ID - Cat - Capt. - Icons -   More Arrow   - ToolTip
ACPRibbon1.AddButton "1", "1", "                   ", Image6.Picture, False, "考试模式设置"
ACPRibbon1.AddButton "2", "2", "                   ", Image7.Picture, False, "试题生成数量设置"
ACPRibbon1.AddButton "3", "3", "                   ", Image7.Picture, False, "客户端连接设置"
ACPRibbon1.AddButton "4", "4", "                   ", Image10.Picture, False, "进入试题管理页面"

'# Repaint Ribbon
ACPRibbon1.Refresh
Me.Show '强行显示窗体
'*******************************************
'开启侦听通道
Grid1.Cell(0, 0).Text = "机器编号"
Grid1.Cell(0, 1).Text = "在线姓名"
Grid1.Cell(0, 2).Text = "识别ID"
Grid1.ReadOnly = True
Grid1.Column(0).Width = 60
Grid1.Column(1).Width = 100
Grid1.Column(2).Width = 50

MaxNumber = 50

curnumber = 0

For l = 0 To MaxNumber

firstmess(l) = True

Next l

For i = 1 To MaxNumber - 1
Load sckServer(i)
Next
sckListen.LocalPort = 8888
sckListen.Listen
'系统加载的应用程序
load_stnumber '加载试题数量
load_strule '加载试题规则
load_feng '加载分数分配表
ST_NAME = "星零测试试卷"
End Sub

Private Sub Form_Resize()
If Me.WindowState <> 1 Then
Picture1.Top = 2040
Picture1.Left = 0
Picture1.Height = Me.ScaleHeight - Picture1.Top
Picture2.Top = 2040
Picture2.Left = Me.ScaleWidth - Picture1.Width
Picture2.Height = Me.ScaleHeight - Picture1.Top
Picture3.Top = Me.ScaleHeight - Picture3.Height
Picture3.Left = Picture1.Width
Picture3.Width = Me.ScaleWidth - 50
End If
End Sub

Private Sub Grid1_RowColChange(ByVal Row As Long, ByVal Col As Long)
hang = Row
End Sub




Private Sub sckBusy_Close()

sckBusy.Close

End Sub

Private Sub sckBusy_DataArrival(ByVal bytesTotal As Long)

sckBusy.SendData "服务器忙，请稍后再连接！"

DoEvents

End Sub

Private Sub sckBusy_SendProgress(ByVal bytesSent As Long, ByVal bytesRemaining As Long)
    On Error Resume Next
    '加入本过程才能保证数据不会出现掉包现象.
    FileSent = FileSent + bytesSent
    DoEvents
End Sub

Private Sub sckListen_ConnectionRequest(ByVal requestID As Long)

Dim i As Integer

For i = 0 To MaxNumber - 1

If sckServer(i).State = 0 Then

Exit For

End If

Next i

If sckServer(i).State = 0 Then

sckServer(i).Accept requestID
sckServer(i).SendData "欢迎您连接服务器！"

curnumber = curnumber + 1

number.Caption = curnumber

Exit Sub

End If

sckBusy.Close

sckBusy.Accept requestID

End Sub

Private Sub sckListen_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)

sckListen.Close

sckListen.LocalPort = 8888

sckListen.Listen

End Sub

Private Sub sckServer_Close(Index As Integer)

Dim j As Integer

sckServer(Index).Close
firstmess(Index) = True

For j = 0 To MaxNumber - 1
For n = 1 To Grid1.Rows - 1
 If Grid1.Cell(n, 1).Text = chatname(Index) Then
   txtRecive.SelText = txtRecive.SelText & "用户" & chatname(Index) & "已断开连接." & vbCrLf
   Grid1.RemoveItem (n)
   Exit For
  End If
 Next
'If sckServer(j).State = 7 Then '发送消息给其它在线用户

'sckServer(j).SendData chatname(Index) + "断开网络"
'txtRecive.seltext = txtRecive.seltext & "用户" & chatname(Index) & "已断开连接." & vbCrLf

'DoEvents

'End If

Next j

curnumber = curnumber - 1

number.Caption = curnumber
End Sub
Private Sub Key_contrast(ByVal Index As Integer) '答案比对
Dim keycontrast As String
Dim keycontrast1() As String
Dim keycontrast2() As String
Dim Rightnumber As Integer
FileSize(Index) = FileLen(App.Path & "\DATALIST\" & chatname(Index) & "_key.txt")
Open App.Path & "\DATALIST\" & chatname(Index) & "_key.txt" For Binary As #1
keycontrast = Space(FileSize(Index))
Get #1, , keycontrast
keycontrast1 = Split(keycontrast, vbCrLf)
Close #1
FileSize(Index) = FileLen(App.Path & "\DATALIST\" & chatname(Index) & "_answer.txt")
Open App.Path & "\DATALIST\" & chatname(Index) & "_answer.txt" For Binary As #1
keycontrast = Space(FileSize(Index))
Get #1, , keycontrast
keycontrast2 = Split(keycontrast, vbCrLf)
Close #1
For i = 0 To UBound(keycontrast1) - 1
 If keycontrast1(i) = keycontrast2(i) Then
  Rightnumber = Rightnumber + 1
 End If
Next
'计算分数
Dim Count_Ment As Double
Count_Ment = Feng_xz * Rightnumber
'存储此次考试成绩
'发送到客户端成绩
 sckServer(Index).SendData "RSTNUMBER|" & Rightnumber & vbCrLf '发送正确做对试题的数量
 sckServer(Index).SendData "WSTNUMBER|" & Int_xz - Rightnumber & vbCrLf '发送错误试题的数量
 sckServer(Index).SendData "RIGHTMENT|" & Count_Ment & vbCrLf '发送得分
'发送正确答案对比
    filename(Index) = App.Path & "\datalist\" & chatname(Index) & "_key.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
TEXTCOLOR_start
txtRecive.SelText = txtRecive.SelText & "用户" & chatname(Index) & "此次考试成绩为" & Count_Ment & "分" & vbCrLf

End Sub
Private Sub sckServer_DataArrival(Index As Integer, ByVal bytesTotal As Long)
On Error Resume Next

    Dim i As Integer
    Dim strinput As String
    Dim strParse() As String
    Dim strText As String
    Dim stritem As String
    Dim strdata() As String
    Dim intFile As Integer '获取文件行数
If down(Index) = True Then '当状态为接收文件时
    Dim strbyte() As Byte
    intFile = FreeFile
    sckServer(Index).GetData strbyte, , bytesTotal
    MkDir App.Path & "\" & LISTMID
    Open App.Path & "\" & LISTMID & "\" & filename(Index) For Binary As #intFile
    Put #intFile, LOF(intFile) + 1, strbyte
    Close #intFile
If FileLen(App.Path & "\" & LISTMID & "\" & filename(Index)) >= FileSize(Index) Then
    down(Index) = False
    sckServer(Index).SendData "FULFILLINCEPT|" & vbCrLf '发出已完成接收指令
    If Dir(App.Path & ListEXECLLOG, vbNormal) <> "" And ListEXECLLOG <> "" Then
    Dim ListEXL As String
    Dim listEXLMENU() As String
    Open App.Path & ListEXECLLOG For Binary As #1
    FileSize(Index) = FileLen(App.Path & ListEXECLLOG)
    ListEXL = Space(FileSize(Index))
    Get #1, , ListEXL
    Close #1
    listEXLMENU = Split(ListEXL, vbCrLf)
    For i = 0 To UBound(listEXLMENU) - 1

     If Dir(App.Path & listEXLMENU(i), vbNormal) = "" Then
       sckServer(Index).SendData "ASKLIST|" & listEXLMENU(i) & vbCrLf
       LISTMID = Mid(listEXLMENU(i), 2, InStrRev(listEXLMENU(i), "\") - 2)
       Exit For
     End If
    Next
    End If
 End If
 txtRecive.SelText = txtRecive.SelText & "已成功接收用户" & chatname(Index) & "的考试答案！" & vbCrLf
 '进入答案比对
 Key_contrast (Index)
Else
sckServer(Index).GetData strinput
strdata = Split(strinput, vbCrLf)
For i = 0 To UBound(strdata)
strText = ""
strText = strdata(i)
If strText <> "" Then
        strParse = Split(strText, "|")
        '由于出现接收到下标越界的错误，因此使用判断分隔strparse出的行是否=0
        '等于0时退出操作
        If UBound(strParse) = 0 Then
        Exit Sub
        End If
        strText = strParse(0)
        stritem = strParse(1)
Select Case UCase(strText)
Case "FILESIZE" '获取文件大小
    FileSize(Index) = stritem
    down(Index) = True '接收名称后自动进入接收文件状态
    If Dir(App.Path & "\DATALIST\" & filename(Index), vbNormal) <> "" Then
    Kill App.Path & "\DATALIST\" & filename(Index)
    End If
    If ListEXECLLOG = "" Then
     ListEXECLLOG = "\DATALIST\" & filename(Index)
     LISTMID = "DATALIST"
    End If
    INDEXID = Index
    Timer1.Enabled = True '发送进入传送状态指令，用时钟来保证各传输数据间的间隙
    Exit Sub
Case "FILENAME" '获取文件名称
    filename(Index) = stritem
Case "COMPLETE"
    down(Index) = False '退出文件传输状态
Case "OPENPLAY" '接收到客户端的文件接收请求
    send_file (Index)
Case "ASKLIST"
    filename(Index) = App.Path & stritem
    sckServer(Index).SendData "FILENAME|" & Mid(filename(Index), InStrRev(filename(Index), "\") + 1) & vbCrLf
    FileSize(Index) = FileLen(filename(Index))
    sckServer(Index).SendData "FILESIZE|" & FileSize(Index) & vbCrLf
    'DoEvents '转让控制权，以便让计算机执行其它操作
Case "ASKFORQUESTIMONS" '请求得到试题
    INDEXID = Index
    txtRecive.SelText = txtRecive.SelText & "用户" & chatname(Index) & "发出生成试题请求！" & vbCrLf
    sckServer(Index).SendData "KSTIME|" & ST_TIME & vbCrLf
    sckServer(Index).SendData "KSNAME|" & ST_NAME & vbCrLf
    sckServer(Index).SendData "COUNTFENG|" & Feng_count & vbCrLf
    sckServer(Index).SendData "COUNTSTNUMBER|" & Int_xz & vbCrLf '发送试题的数量
    Make_ST '生成试题
    '生成一个文件名
    '执行文件名的发送
    '执行试题生成
    '获取文件大小
    '执行文件大小的发送
    'txtrecive为已向某用户发送需获取文件大小的指令
    '正式发送文件
    '获取文件大小
    '执行文件大小的发送
    'txtrecive为已向某用户发送需获取文件大小的指令