www.pudn.com > zzksxt.rar > Form1.frm, change:2007-04-14,size:29697b


VERSION 5.00 
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX" 
Object = "{DAAC6951-59A4-4C08-9D6E-FE3919B64861}#1.0#0"; "FlexCell.ocx" 
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX" 
Begin VB.Form Form1  
   BackColor       =   &H00404040& 
   BorderStyle     =   0  'None 
   Caption         =   "星零考试系统服务器端 版本0.1" 
   ClientHeight    =   7215 
   ClientLeft      =   -45 
   ClientTop       =   -435 
   ClientWidth     =   10680 
   Icon            =   "Form1.frx":0000 
   LinkTopic       =   "Form1" 
   ScaleHeight     =   7215 
   ScaleWidth      =   10680 
   StartUpPosition =   1  '所有者中心 
   Begin RichTextLib.RichTextBox txtRecive  
      Height          =   4320 
      Left            =   3240 
      TabIndex        =   8 
      Top             =   2400 
      Width           =   7410 
      _ExtentX        =   13070 
      _ExtentY        =   7620 
      _Version        =   393217 
      BackColor       =   4210752 
      BorderStyle     =   0 
      Enabled         =   -1  'True 
      ReadOnly        =   -1  'True 
      ScrollBars      =   2 
      Appearance      =   0 
      TextRTF         =   $"Form1.frx":F84A 
   End 
   Begin VB.Timer Timer1  
      Enabled         =   0   'False 
      Interval        =   50 
      Left            =   1800 
      Top             =   6720 
   End 
   Begin VB.PictureBox Picture3  
      BackColor       =   &H000000FF& 
      BorderStyle     =   0  'None 
      Height          =   60 
      Left            =   10080 
      ScaleHeight     =   60 
      ScaleWidth      =   375 
      TabIndex        =   6 
      Top             =   5880 
      Width           =   375 
   End 
   Begin VB.PictureBox Picture2  
      BackColor       =   &H000000FF& 
      BorderStyle     =   0  'None 
      Height          =   375 
      Left            =   9960 
      ScaleHeight     =   375 
      ScaleWidth      =   45 
      TabIndex        =   5 
      Top             =   5760 
      Width           =   50 
   End 
   Begin VB.PictureBox Picture1  
      BackColor       =   &H000000FF& 
      BorderStyle     =   0  'None 
      Height          =   375 
      Left            =   9840 
      ScaleHeight     =   375 
      ScaleWidth      =   45 
      TabIndex        =   4 
      Top             =   5760 
      Width           =   50 
   End 
   Begin 考试系统服务器端.ACPRibbon ACPRibbon1  
      Height          =   2130 
      Left            =   0 
      TabIndex        =   3 
      Top             =   0 
      Width           =   10680 
      _ExtentX        =   18838 
      _ExtentY        =   3757 
   End 
   Begin FlexCell.Grid Grid1  
      Height          =   4620 
      Left            =   0 
      TabIndex        =   2 
      Top             =   2115 
      Width           =   3225 
      _ExtentX        =   5689 
      _ExtentY        =   8149 
      AllowUserResizing=   0   'False 
      Appearance      =   0 
      BackColorBkg    =   8421504 
      BackColorFixed  =   12632319 
      BackColorFixedSel=   12632319 
      Cols            =   3 
      ExtendLastCol   =   -1  'True 
      FixedRowColStyle=   0 
      Rows            =   1 
      ScrollBars      =   2 
      ScrollBarStyle  =   0 
   End 
   Begin MSWinsockLib.Winsock sckListen  
      Left            =   10080 
      Top             =   6720 
      _ExtentX        =   741 
      _ExtentY        =   741 
      _Version        =   393216 
   End 
   Begin MSWinsockLib.Winsock sckBusy  
      Left            =   9120 
      Top             =   6720 
      _ExtentX        =   741 
      _ExtentY        =   741 
      _Version        =   393216 
   End 
   Begin MSWinsockLib.Winsock sckServer  
      Index           =   0 
      Left            =   9600 
      Top             =   6720 
      _ExtentX        =   741 
      _ExtentY        =   741 
      _Version        =   393216 
   End 
   Begin VB.Line Line1  
      BorderColor     =   &H00000000& 
      X1              =   0 
      X2              =   10680 
      Y1              =   6720 
      Y2              =   6720 
   End 
   Begin VB.Label Label2  
      Alignment       =   2  'Center 
      Appearance      =   0  'Flat 
      BackColor       =   &H00808080& 
      BorderStyle     =   1  'Fixed Single 
      Caption         =   "---信息区---" 
      BeginProperty Font  
         Name            =   "宋体" 
         Size            =   10.5 
         Charset         =   134 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      ForeColor       =   &H80000008& 
      Height          =   255 
      Left            =   3240 
      TabIndex        =   7 
      Top             =   2130 
      Width           =   7400 
   End 
   Begin VB.Image Image1  
      Height          =   450 
      Left            =   7080 
      Picture         =   "Form1.frx":F8E7 
      Top             =   10680 
      Visible         =   0   'False 
      Width           =   450 
   End 
   Begin VB.Image Image11  
      Height          =   345 
      Left            =   3480 
      Picture         =   "Form1.frx":F96E 
      Top             =   10680 
      Visible         =   0   'False 
      Width           =   360 
   End 
   Begin VB.Image Image2  
      Height          =   210 
      Left            =   3960 
      Picture         =   "Form1.frx":FE8D 
      Top             =   10680 
      Visible         =   0   'False 
      Width           =   165 
   End 
   Begin VB.Image Image3  
      Height          =   210 
      Left            =   4200 
      Picture         =   "Form1.frx":FFD4 
      Top             =   10680 
      Visible         =   0   'False 
      Width           =   240 
   End 
   Begin VB.Image Image4  
      Height          =   210 
      Left            =   4440 
      Picture         =   "Form1.frx":103CD 
      Top             =   10680 
      Visible         =   0   'False 
      Width           =   225 
   End 
   Begin VB.Image Image5  
      Height          =   210 
      Left            =   4680 
      Picture         =   "Form1.frx":1062B 
      Top             =   10680 
      Visible         =   0   'False 
      Width           =   210 
   End 
   Begin VB.Image Image6  
      Height          =   375 
      Left            =   5040 
      Picture         =   "Form1.frx":1088B 
      Top             =   10680 
      Visible         =   0   'False 
      Width           =   435 
   End 
   Begin VB.Image Image7  
      Height          =   450 
      Left            =   5520 
      Picture         =   "Form1.frx":10E30 
      Top             =   10680 
      Visible         =   0   'False 
      Width           =   450 
   End 
   Begin VB.Image Image8  
      Height          =   435 
      Left            =   6000 
      Picture         =   "Form1.frx":11444 
      Top             =   10680 
      Visible         =   0   'False 
      Width           =   420 
   End 
   Begin VB.Image Image9  
      Height          =   390 
      Left            =   6480 
      Picture         =   "Form1.frx":119FA 
      Top             =   10680 
      Visible         =   0   'False 
      Width           =   390 
   End 
   Begin VB.Image Image10  
      Height          =   375 
      Left            =   6960 
      Picture         =   "Form1.frx":11F9D 
      Top             =   10680 
      Visible         =   0   'False 
      Width           =   465 
   End 
   Begin VB.Label number  
      BackStyle       =   0  'Transparent 
      Caption         =   "0" 
      ForeColor       =   &H00FFFFFF& 
      Height          =   255 
      Left            =   840 
      TabIndex        =   1 
      Top             =   6840 
      Width           =   615 
   End 
   Begin VB.Label Label1  
      BackStyle       =   0  'Transparent 
      Caption         =   "连接数:" 
      ForeColor       =   &H00FFFFFF& 
      Height          =   255 
      Left            =   120 
      TabIndex        =   0 
      Top             =   6840 
      Width           =   735 
   End 
End 
Attribute VB_Name = "Form1" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Private MaxNumber As Integer 
Private hang As Integer 
Dim curnumber As Integer 
Dim chatname(50) As String 
Dim firstmess(50) As Boolean 
Dim FileInput(50) As Double '当前传送的字节数 
Public lngInputSize As Double '硬盘缓存支持最大数 
Dim FileSize(50) As Double '传送文件的大小 
Dim filename(50) As String '传送文件的文件名 
Dim FileSent As Double 
Private down(50) As Boolean 
Dim ListEXECLLOG As String '记录列表文件名 
Dim LISTMID '当前操作文件夹 
Dim INDEXID As Integer '索引ID 
 
Private Sub Form_Load() 
Grid1.SetRegisterInformation "CNwinndy", "W]vyY-nonvk-u\nty-Zbl_e-`hms^" '进行注册 
Picture1.BackColor = RGB(77, 77, 77) 
Picture2.BackColor = RGB(77, 77, 77) 
Picture3.BackColor = RGB(101, 101, 101) 
'菜单定义 
'# Set Circle Menu Button Picture 
Set ACPRibbon1.Picture = Image1.Picture 
 
'# Show Caption of Form 
ACPRibbon1.Caption = Me.Caption 
 
'# Show Button to Customize Menu 
ACPRibbon1.ShowCustomMenu = False 
 
'# Add TopButtons ---   ID - Capt. - Icons 
ACPRibbon1.AddTopButton "1", "新建", Image2.Picture 
ACPRibbon1.AddTopButton "2", "打开", Image3.Picture 
ACPRibbon1.AddTopButton "3", "打印", Image4.Picture 
ACPRibbon1.AddTopButton "3", "保存", Image5.Picture 
 
'# Add Tabs ---   ID - Caption 
ACPRibbon1.AddTab "1", "考试状态" 
ACPRibbon1.AddTab "2", "试题管理" 
ACPRibbon1.AddTab "3", "成绩管理" 
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为已向某用户发送需获取文件大小的指令 
    '正式发送文件 
    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