main.bas

这是一个用VB编写的在线考试系统

Attribute VB_Name = "Module1"
'config.dat的文件号为21　是系统的全局设定的保存
'jiao.dat as 22　是教师名及教师密码的保存文件
'userid.dat as 23　是本次或说是当前可以参加考试的考生姓名及考号的保存文件
'考生的文件号为30+sock号
'filename 是用保存当前考试的科目及文件名
'sockip(30,3) 是保存在线人数及sock连接使用的情况及当前连接的人是合法与否
'sockname(30,2)用来保存考生的姓名和考号
'y有mian()中的for语句给出值
'filenum(8,3)中X，1保存考题库的下限2为上限3为该项可给考生的题数
'studentinf(30) 用来保存该考号本次的考题号
Option Explicit
'VAL
Public filename(8) As String
Public logdate(3) As String
Public filenum(8, 3) As Integer
Public dat(30) As String
Public studentinf(30) As String
Public bytedat(9) As Byte
Public fen As String
Public Y As Integer
Public alfen As Integer
Public bytemp As Integer
Public bytime As Integer
Public sendinfto As Integer
Public sockname(30, 2) As String
Public sockip(30, 3) As Integer
'API
Public OldProc As Long

Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long


Public Const WM_USER = &H400
Public Const WM_LBUTTONUP = &H202
Public Const WM_MBUTTONUP = &H208
Public Const WM_RBUTTONUP = &H205
Public Const TRAY_CALLBACK = (WM_USER + 1001&)
Public Const GWL_WNDPROC = (-4)
Public Const GWL_USERDATA = (-21)
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIF_MESSAGE = &H1
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2

Public Type NOTIFYICONDATA
    cbSize As Long
    hwnd As Long
    uID As Long
    uFlags As Long
    uCallbackMessage As Long
    hIcon As Long
    szTip As String * 64
End Type

Public TheData As NOTIFYICONDATA
Sub Main()
If Not FindWindow(vbNullString, "绝龙考试系统服务端") = 0 Then
MsgBox "绝龙考试系统服务端在本地只能执行一个实例"
End
End If
Load Form1
fen = ""
bytemp = 1
For Y = 1 To Len(Trim(Str(Date)))
If Mid(Trim(Str(Date)), Y, 1) > "9" Or Mid(Trim(Str(Date)), Y, 1) < "0" Then
Y = Y + 1
logdate(bytemp) = fen
fen = ""
bytemp = bytemp + 1
End If
fen = fen & Mid(Trim(Str(Date)), Y, 1)
If Y = Len(Trim(Str(Date))) Then
logdate(3) = fen
End If
Next
For Y = 1 To 30
sockip(Y, 1) = 1
sockip(Y, 2) = 1
sockip(Y, 3) = 0
studentinf(Y) = ""
Form1.Command1(Y).Picture = LoadPicture(App.Path & "\Null.bmp")
Next
On Error Resume Next
MkDir App.Path & "\log\" & logdate(1)
If Err.Number = 0 Then
On Error GoTo 0
MkDir App.Path & "\log\" & logdate(1) & "\" & logdate(2)
Else
Err.Number = 0
On Error GoTo 0
End If
Open App.Path & "\log\" & logdate(1) & "\" & logdate(2) & "\" & logdate(3) & ".log" For Append As #3
Open App.Path & "\Config.dat" For Binary As 21
Open App.Path & "\data\inf.dat" For Output As 22
dat(0) = readfile(0, 21, 0)
Form1.List1.AddItem ("服务器：" & "服务器的名称：" & dat(0))
Print #3, "服务器：" & "服务器的名称：" & dat(0) & Chr(16) & Chr(17)
Form1.List1.AddItem ("服务器：" & "今天的日期为：" & Date)
Print #3, "服务器：" & "今天的日期为：" & Date & Chr(16) & Chr(17)
Form1.Caption = dat(0) & "服务端"
Form1.Sockser(0).LocalPort = Val(readfile(0, 21, 0))
fen = readfile(0, 21, 0)
bytemp = Val(readfile(0, 21, 0))
Form1.List1.AddItem ("服务器：开放的服务端口为：" & Form1.Sockser(0).LocalPort)
Print #3, "服务器：开放的服务端口为：" & Form1.Sockser(0).LocalPort & Chr(16) & Chr(17)
Form1.List1.AddItem ("服务器：" & "本次考试共有：" & bytemp & "个题类")
Print #3, "服务器：" & "本次考试共有：" & bytemp & "个题类" & Chr(16) & Chr(17)
For Y = 1 To bytemp
filename(Y) = readfile(0, 21, 0)
filenum(Y, 1) = Val(readfile(0, 21, 0))
filenum(Y, 2) = Val(readfile(0, 21, 0))
filenum(Y, 3) = Val(readfile(0, 21, 0))
Print #22, Trim(Str(filenum(Y, 3))) & Chr(16) & Chr(17)
Form1.List1.AddItem ("服务器：" & Left(filename(Y), Len(filename(Y)) - 4) & "有：" & filenum(Y, 3) & "个题目数")
Form1.List1.ListIndex = Form1.List1.ListCount - 1
Print #3, "服务器：" & Left(filename(Y), Len(filename(Y)) - 4) & "有：" & filenum(Y, 3) & "个题目数" & Chr(16) & Chr(17)
Next
Form1.Combo1.AddItem ("所有在线考生")
Form1.Combo1.ListIndex = 0
sendinfto = 0
filename(Y) = readfile(0, 21, 0)
Y = Y + 1
Close #21
Close #22
dat(1) = ""
dat(2) = ""
Form1.Icon = LoadPicture(App.Path & "\ico\jlong.ICO")
Load form3
form3.Visible = True
bytime = 0
bytedat(0) = &H30
bytedat(1) = &H31
bytedat(2) = &H32
bytedat(3) = &H33
bytedat(4) = &H34
bytedat(5) = &H35
bytedat(6) = &H36
bytedat(7) = &H37
bytedat(8) = &H38
bytedat(9) = &H39
End Sub
Function findid(Index As Integer, userid As String) As Integer
Dim timeid, timename, jkey As String
Open App.Path & "\Userid.dat" For Binary As #(Index + 30)
Do While 1
timeid = readfile(0, Index + 30, 0)
timename = readfile(0, Index + 30, 0)
jkey = readfile(0, Index + 30, 0)
If timeid = "seek_end" Then
Close #(Index + 30)
sockip(Index, 1) = 2
findid = 0
Exit Function
End If
If timeid = userid Then
If jkey = "60" Then
sockip(Index, 1) = 3
sockname(Index, 1) = timename
sockname(Index, 2) = timeid
findid = 1
Close #(Index + 30)
Exit Function
Else
Close #(Index + 30)
sockip(Index, 1) = 2
findid = 2
Exit Function
End If
End If
Loop
Close #(Index + 30)
sockip(Index, 1) = 2
End Function

Function findidb(Index As Integer, userid As String, timefen As String) As Integer
Dim timeid, timename As String
Open App.Path & "\Useridb.dat" For Binary As #(Index + 30)
Do While 1
timeid = readfile(0, Index + 30, 0)
timename = readfile(0, Index + 30, 0)
timefen = readfile(0, Index + 30, 0)
If timeid = "seek_end" Then
Close #(Index + 30)
sockip(Index, 1) = 2
findidb = 0
Exit Function
End If
If timeid = userid Then
sockip(Index, 1) = 3
sockname(Index, 1) = timename
sockname(Index, 2) = timeid
Close #(Index + 30)
findidb = 1
Exit Function
End If
Loop
Close #(Index + 30)
sockip(Index, 1) = 2
End Function

Function idend(userid As String) As Integer
Dim timeid, timename, jkey As String
Open App.Path & "\idend.dat" For Binary As #6
Do While 1
timeid = readfile(0, 6, 0)
timename = readfile(0, 6, 0)
jkey = readfile(0, 6, 0)
If timeid = "seek_end" Then
Close #6
idend = 0
Exit Function
End If
If timeid = userid Then
idend = 1
Close #6
Exit Function
End If
Loop
End Function

Function findadd(fileid As Integer, userid As String, timefen As String) As String
Dim timeid, timename As String
Do While 1
timeid = readfile(0, fileid, 0)
If timeid = "seek_end" Then
Close #fileid
findadd = "nullname"
Exit Function
End If
If timeid = userid Then
findadd = readfile(0, fileid, 0)
timefen = readfile(0, fileid, 0)
Close #fileid
Exit Function
End If
timename = readfile(0, fileid, 0)
timefen = readfile(0, fileid, 0)
Loop
Close #fileid
End Function

Function openf(Index As Integer) As Integer
If sockip(Index, 2) = Y Then
Form1.Sockser(Index).SendData "data_end"
sockip(Index, 1) = 4
If sockip(Index, 0) = 3 Then
Close #(Index + 260)
sockip(Index, 0) = 2
End If
Exit Function
End If
Open App.Path & "\data\" & filename(sockip(Index, 2)) For Binary As #(Index + 30)
Form1.Sockser(Index).SendData "sendname" & filename(sockip(Index, 2))
End Function
Function jiao(name As String, pass As String) As Integer
Open App.Path & "\jiao.dat" For Binary As #22
Dim tmname, tmpass As String
Do While 1
tmname = readfile(0, 22, 0)
tmpass = readfile(0, 22, 0)
If tmname = "seek_end" Then Exit Do
If textpass(name) = tmname And textpass(pass) = tmpass Then
jiao = 1
Close #22
Exit Function
End If
Loop
Close #22
jiao = 0
End Function
Function sendata(Index As Integer) As Integer
If sockip(Index, 2) = Y - 1 Then
dat(Index) = readfile(9, (Index + 30), 0)
Close #(Index + 30)
Form1.Sockser(Index).SendData "datasend" & dat(Index)
sockip(Index, 2) = sockip(Index, 2) + 1
Exit Function
End If
Dim i As Integer
Dim p(50) As Integer
If sockip(Index, 0) = 1 Then
i = rndnu((filenum(sockip(Index, 2), 1)), (filenum(sockip(Index, 2), 2)), (filenum(sockip(Index, 2), 3)), p)
studentinf(Index) = studentinf(Index) & p(1) & "\"
Else
If sockip(Index, 0) = 2 Then
Open App.Path & "\job\" & sockname(Index, 2) & "\data\" & "inf.dat" For Binary As (Index + 260)
sockip(Index, 0) = 3
End If
studentinf(Index) = readfile(0, Index + 260, 0)
Dim sa As String
i = 1