form1.frm

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

ACPRibbon1.AddButton "5", "5", "                                ", ImageTAB1.Picture, False, "设定本机ID编号,以让服务器端操作人员更好识别"
ACPRibbon1.AddButton "6", "6", "                                ", ImageTAB1.Picture, False, "设定连接服务器端的IP地址"
ACPRibbon1.AddButton "7", "7", "                                ", ImageTAB1.Picture, False, "退出本系统"

ACPRibbon1.Refresh
sckClient.Connect
End Sub

Private Sub Form_Resize()
If Me.WindowState <> 1 Then
Picture1.Move 0, Picture4.Top + Picture4.Height, Picture1.Width, Me.ScaleHeight - Picture1.Top
Picture2.Move Me.ScaleWidth - Picture1.Width, Picture4.Top + Picture4.Height, Picture2.Width, Me.ScaleHeight - Picture1.Top
Picture3.Move Picture1.Width, Me.ScaleHeight - Picture3.Height, Me.ScaleWidth - 50
Picture4.Top = ACPRibbon1.Height
Picture4.Left = 0
Picture4.Width = Me.ScaleWidth
Picture4.Height = 300
Label_Time.Left = Picture4.ScaleWidth - Label_Time.Width - 500
Labeltime.Left = Label_Time.Left + 1300
VScroll1.Move Me.ScaleWidth - VScroll1.Width - Picture2.Width, Picture4.Top + Picture4.Height, VScroll1.Width, Me.ScaleHeight - Picture4.Top - Picture4.Height - Picture3.Height
PictureBG1.Move Picture1.Width, Picture4.Top + Picture4.Height, Me.ScaleWidth - Picture1.Width - Picture2.Width - VScroll1.Width + 10, VScroll1.Height
If Create_Boolean = True Then '当试题已读取时
PictureQG1.Move 0, 0, PictureBG1.ScaleWidth, PictureQG1.Height
Else
PictureQG1.Move 0, 0, PictureBG1.ScaleWidth, PictureBG1.ScaleHeight
End If
ST_NAME.Left = (PictureQG1.ScaleWidth - ST_NAME.Width) / 2
Picture_panel.Left = PictureQG1.ScaleWidth - Picture_panel.Width
Vscroll_Max '重新计算vscroll1的最大值,再次区分比例
'XPPBR1.Width = Label_Time.Left - Label_cz.Left - Label_cz.Width - 30
Check1(0).Move Check1(0).Left, Check1(0).Top, PictureQG1.ScaleWidth - Check1(0).Left
Check2(0).Move Check2(0).Left, Check2(0).Top, PictureQG1.ScaleWidth - Check2(0).Left
Check3(0).Move Check3(0).Left, Check3(0).Top, PictureQG1.ScaleWidth - Check3(0).Left
Check4(0).Move Check4(0).Left, Check4(0).Top, PictureQG1.ScaleWidth - Check4(0).Left
XPPBR1.Left = Picture1.Width
XPPBR1.Width = VScroll1.Left - Picture1.Width
XPPBR1.Visible = False '以显示与不显示来实现控件的刷新
XPPBR1.Visible = True
End If
End Sub
Private Sub Vscroll_Max()
For j = 1 To 1000
 If ((PictureQG1.Height - PictureBG1.ScaleHeight) Mod j) = 0 And (PictureQG1.Height - PictureBG1.ScaleHeight) / j < 32767 Then
 vscmod = j
 Exit For
 End If
Next
VScroll1.Max = (PictureQG1.Height - PictureBG1.ScaleHeight) / vscmod
End Sub
Private Sub sckClient_Close()
MsgBox "服务器已关闭,请退出并重新连接。"
End
End Sub

Private Sub sckClient_Connect()

Dim name As String
LabelID.Caption = LoginName
LabelCZ.Caption = "已经成功连接服务器!"

If firsttime = True Then
name = LoginName
sckClient.SendData "NAME|" & name & vbCrLf
sckClient.SendData "COMPUTERID|" & Computer_id & vbCrLf
firsttime = False

End If
End Sub

Private Sub sckClient_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
    Dim strinput As String
    Dim strParse() As String
    Dim strText As String
    Dim stritem As String
    Dim strdata() As String
    bytesTotal = 8192
If down = True Then '当状态为接收文件时
    Dim strbyte() As Byte
    intFile = FreeFile
    If (Filesize - Filecountsize) <= bytesTotal Then
      bytesTotal = Filesize - Filecountsize
      down = False
      Filecountsize = 0
    Else
      Filecountsize = Filecountsize + bytesTotal
    End If
    sckClient.GetData strbyte, , bytesTotal
    MkDir App.Path & "\" & LISTMID
    Open App.Path & "\" & LISTMID & "\" & Filename For Binary As #intFile
    Put #intFile, LOF(intFile) + 1, strbyte
    Close #intFile
    sckClient.GetData strbyte, , 8192 '此语句防止冗余数据扰乱程序运行,因此读出其残余记录
If FileLen(App.Path & "\" & LISTMID & "\" & Filename) >= Filesize Then
    down = False
    sckClient.SendData "FULFILLINCEPT|" & LoginName & vbCrLf '发出已完成接收指令
    If Filename = LoginName & "_key.txt" Then '当文件名为标准答案时
     LabelCZ.Caption = "已接收标准答案,正在分析答案!"
     AnswerBD '答案比对
     Exit Sub
    End If
    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 = FileLen(App.Path & ListEXECLLOG)
    ListEXL = Space(Filesize)
    Get #1, , ListEXL
    Close #1
    listEXLMENU = Split(ListEXL, vbCrLf)
    For i = 0 To UBound(listEXLMENU) - 1
     If Dir(App.Path & listEXLMENU(i), vbNormal) = "" Then
       sckClient.SendData "ASKLIST|" & listEXLMENU(i) & vbCrLf
       LISTMID = Mid(listEXLMENU(i), 2, InStrRev(listEXLMENU(i), "\") - 2)
       Exit For
     End If
    Next
    End If
    LabelCZ.Caption = "已经完成试题的接收,可以生成(点击开始考试按钮)试卷了!"
    '进入打开列表,利用回车区分,按顺序获取文件名,并发送给服务器端,这样重复传输各种文件
    Exit Sub
End If
Else
sckClient.GetData strinput, , bytesTotal
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 = stritem
    down = True '接收名称后自动进入接收文件状态
    If ListEXECLLOG = "" Then
     ListEXECLLOG = "\DATALIST\" & Filename
     LISTMID = "DATALIST"
    End If
    Timer1.Enabled = True '发送进入传送状态指令，用时钟来保证各传输数据间的间隙
    Exit Sub
Case "FILENAME" '获取文件名称
    Filename = stritem
    If Dir(App.Path & "\DATALIST\" & Filename, vbNormal) <> "" Then
    Kill App.Path & "\DATALIST\" & Filename
    End If
    LabelCZ.Caption = "获取需接收文件的文件名!"
Case "KSTIME" '考试时间
    KS_TIME = stritem * 60
    TIMECOUNT.Caption = "考试时间：" & stritem & "分钟"
Case "OPENPLAY" '接收到客户端的文件接收请求
    send_file
Case "KSNAME" '考试的名称
    ST_NAME.Caption = stritem
    ST_NAME.Left = (PictureQG1.ScaleWidth - ST_NAME.Width) / 2
Case "COUNTFENG" '试卷总分
    count_mark.Caption = "总分：" & stritem & "分"
Case "RIGHTMENT"
    score_label.Caption = "得分：" & stritem & "分"
Case "COUNTSTNUMBER"
    Count_stnumber.Caption = "总题数：" & stritem & "题"
Case "RSTNUMBER"
    R_stnumber.Caption = "正确题数：" & stritem & "题"
Case "WSTNUMBER"
    W_stnumber.Caption = "错误题数：" & stritem & "题"
End Select
End If
Next
End If
End Sub
Private Sub send_file()
On Error GoTo 1
          Dim myFile()  As Byte
          Dim dblSent As Double
          Dim filemax As Double
          filemax = 8192
Open Filename For Binary As #1
    If Filesize <= filemax Then '8192为极限缓存
        myFile = Space(Filesize)
        Get #1, , myFile
        sckClient.SendData myFile
        GoTo 1
    End If
    '超过 1KB - 将分段为 8192 字节
    
    Do While EOF(1) = False
        If dblSent + filemax <= Filesize Then
            myFile = Space(filemax)
            Get #1, , myFile
            sckClient.SendData myFile
            dblSent = dblSent + filemax
            DoEvents
        Else
            myFile = Space(filemax - dblSent)
            Get #1, , myFile
            sckClient.SendData myFile
            Exit Do
        End If
        DoEvents
    Loop
    Close #1
   LabelCZ.Caption = "答案已成功的发送到服务器端！等待计算得分中...."
1:
Close #1
End Sub
Private Sub sckClient_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)
sckClient.Close
End Sub
'***********************************************
'以下为单选项的处理
Private Sub Check1_Click(Index As Integer)
Check2(Index).Value = 0
Check3(Index).Value = 0
Check4(Index).Value = 0
End Sub

Private Sub Check2_Click(Index As Integer)
Check1(Index).Value = 0
Check3(Index).Value = 0
Check4(Index).Value = 0
End Sub

Private Sub Check3_Click(Index As Integer)
Check1(Index).Value = 0
Check2(Index).Value = 0
Check4(Index).Value = 0
End Sub

Private Sub Check4_Click(Index As Integer)
Check1(Index).Value = 0
Check2(Index).Value = 0
Check3(Index).Value = 0
End Sub
'****************************************
Private Sub Client_load() '客户端设置读取机器ID快捷识别编号
Dim buff As String
Dim backFile As String
Dim ret As Integer
buff = String(255, 0)
ret = GetPrivateProfileString("Client", "ClientID", "", buff, 256, App.Path & "\client.ini")
If ret = 0 Then '当client文件不存在或无clientID目录时
Computer_id = "A01"
ret = WritePrivateProfileString("Client", "ClientID", Computer_id, App.Path & "\client.ini")
Else
Computer_id = buff
End If
ret = GetPrivateProfileString("Client", "ServerIP", "", buff, 256, App.Path & "\client.ini")
ServerIP = buff
End Sub
'***********************************
Private Sub AnswerBD() '答案比对
On Error GoTo finish:
 Dim keycontrast As String
Dim keycontrast1() As String
Dim keycontrast2() As String
Dim Rightnumber As Integer
Filesize = FileLen(App.Path & "\DATALIST\" & LoginName & "_key.txt")
Open App.Path & "\DATALIST\" & LoginName & "_key.txt" For Binary As #1
keycontrast = Space(Filesize)
Get #1, , keycontrast
keycontrast1 = Split(keycontrast, vbCrLf)
Close #1
Filesize = FileLen(App.Path & "\DATALIST\" & LoginName & "_answer.txt")
Open App.Path & "\DATALIST\" & LoginName & "_answer.txt" For Binary As #1
keycontrast = Space(Filesize)
Get #1, , keycontrast
keycontrast2 = Split(keycontrast, vbCrLf)
Close #1
For i = 0 To UBound(keycontrast1) - 1
  Load Answer_R(Answer_R.UBound + 1)
  Answer_R(Answer_R.Count - 1).Left = Label1(i + 1).Left + Label1(i + 1).Width + 30
  Answer_R(Answer_R.Count - 1).Top = Label1(i + 1).Top + (Label1(i + 1).Height / 2) - (Answer_R(Answer_R.Count - 1).Height / 2)
  Answer_R(Answer_R.Count - 1).Caption = "正确答案：" & keycontrast1(i)
  If (Answer_R(Answer_R.Count - 1).Left + Answer_R(Answer_R.Count - 1).Width) > PictureQG1.ScaleWidth Then
   'Answer_R(Answer_R.Count - 1).Top = Answer_R(Answer_R.Count - 1).Top + Answer_R(Answer_R.Count - 1).Height + 30
   Answer_R(Answer_R.Count - 1).Left = PictureQG1.ScaleWidth - Answer_R(Answer_R.Count - 1).Width
   Label1(i + 1).Width = Answer_R(Answer_R.Count - 1).Left - Label1(i + 1).Left - 20
  End If
  Answer_R(Answer_R.Count - 1).Visible = True
 If keycontrast1(i) <> keycontrast2(i) Then
  Load Img_w(Img_w.UBound + 1)
  Img_w(Img_w.Count - 1).Left = Label1(0).Left - (Img_w(Img_w.Count - 1).Width / 2)
  Img_w(Img_w.Count - 1).Top = Label1(i + 1).Top + (Label1(i + 1).Height / 2) - (Img_w(Img_w.Count - 1).Height / 2)
  Img_w(Img_w.Count - 1).Visible = True
 End If
Next
LabelCZ.Caption = "此次考试已完成,计时中止!"
Exit Sub
finish:
MsgBox "发现未知错误！错误内容：" & Err.Description, vbInformation, "提示"
End Sub