main.bas

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

Dim j As Integer
For j = 1 To Len(studentinf(Index))
If Mid(studentinf(Index), j, 1) = "\" Then
p(i) = Val(sa)
i = i + 1
sa = ""
j = j + 1
End If
sa = sa & Mid(studentinf(Index), j, 1)
Next
End If

dat(Index) = readfile(5, Index + 30, p(1) - 1) & Chr(16) & Chr(17) & Chr(13) & Chr(10)
dat(Index) = dat(Index) & readfile(0, Index + 30, 0) & Chr(16) & Chr(17) & Chr(13) & Chr(10)
For i = 2 To filenum(sockip(Index, 2), 3)
studentinf(Index) = studentinf(Index) & p(i) & "\"
dat(Index) = dat(Index) & readfile(5, Index + 30, p(i) - p(i - 1) - 1) & Chr(16) & Chr(17) & Chr(13) & Chr(10)
If i = filenum(sockip(Index, 2), 3) Then
dat(Index) = dat(Index) & readfile(0, Index + 30, 0) & Chr(16) & Chr(17)
Else
dat(Index) = dat(Index) & readfile(0, Index + 30, 0) & Chr(16) & Chr(17) & Chr(13) & Chr(10)
End If
Next
Close #(Index + 30)
If sockip(Index, 2) = Y - 2 Then
studentinf(Index) = studentinf(Index) & Chr(16) & Chr(17)
Else
studentinf(Index) = studentinf(Index) & Chr(16) & Chr(17) & Chr(13) & Chr(10)
End If
Form1.Sockser(Index).SendData "datasend" & dat(Index)
sockip(Index, 2) = sockip(Index, 2) + 1
End Function
Function textpass(passtext As String) As String
Dim p, i, j As Integer
Dim st(3) As String
p = Len(passtext)
For i = 1 To p
If i = p Then
st(0) = Str(Asc(Mid(passtext, i, 1)))
st(1) = Str(Asc(Mid(passtext, 1, 1)))
Else
st(0) = Str(Asc(Mid(passtext, i, 1)))
st(1) = Str(Asc(Mid(passtext, i + 1, 1)))
End If
st(0) = Str(Val(st(0)) + Val(st(1)))
For j = 1 To Len(st(0))
st(2) = Str(Val(Mid(st(0), j, 1)) * 20)
st(3) = st(3) & st(2)
Next
Next
textpass = Trim(st(3))
End Function
Function readfile(seekid As Integer, fileid As Integer, hao As Integer) As String
'seekid是功能码用来说明本次是何操作
'fileid是文件号说明要对哪个文件进行操作
'hao：备用说明，在seekid为5或2指明要前进或后退多少，0为退2，1就是退3或进1（两行就是进2）
Dim st As String
Dim sa As String * 1
Dim sb As String * 1
Select Case seekid
Case 0
'get next
If Seek(fileid) >= LOF(fileid) Then
readfile = "seek_end"
Exit Function
End If
Do While 1
Get #fileid, , sa
If sa = Chr(16) Then
Get #fileid, , sb
If sb = Chr(17) Then
readfile = st
Seek #fileid, Seek(fileid) + 2
Exit Function
Else
Seek #fileid, Seek(fileid) - 1
End If
End If
st = st & sa
If Seek(fileid) >= LOF(fileid) Then
readfile = st
Exit Function
End If
Loop
Case 1
' go top
Seek #fileid, 1
readfile = readfile(0, fileid, 0)
Exit Function
Case 2
' go -1
If Seek(fileid) = 1 Then
readfile = readfile(0, fileid, 0)
Exit Function
End If
Dim ba As Byte
Dim bb As Byte
Dim bc As Byte
Dim bd As Byte
bc = &H10
bd = &H11
Seek #fileid, Seek(fileid) - 5
Do While 1
If Seek(fileid) = 1 Then
readfile = readfile(0, fileid, 0)
Exit Function
End If
Get #fileid, , ba
If ba = bc Then
Get #fileid, , bb
If bb = bd Then
Seek #fileid, Seek(fileid) + 2
If hao = -1 Then
readfile = readfile(0, fileid, 0)
Exit Function
Else
readfile = readfile(2, fileid, hao - 1)
Exit Function
End If
Else
Seek #fileid, Seek(fileid) - 1
End If
End If
Seek #fileid, Seek(fileid) - 2
Loop
Case 3
'go boot
Seek #fileid, LOF(fileid)
readfile = readfile(0, fileid, 0)
Exit Function

Case 4
If hao = 1 Then
readfile = readfile(0, fileid, 0)
Exit Function
End If
Dim isee As Integer
For isee = 1 To hao
readfile = readfile(0, fileid, 0)
Next
Exit Function

Case 5
'go N
If hao = 0 Then
readfile = readfile(0, fileid, 0)
Exit Function
End If
Dim X As Integer
For X = 1 To hao * 2
readfile = readfile(0, fileid, 0)
If readfile = "seek_end" Then
Exit Function
End If
Next
readfile = readfile(0, fileid, 0)
Exit Function
Case 9
Dim stra, strb As String
stra = ""
strb = ""
stra = readfile(0, fileid, 0)
Do While 1
strb = strb & stra & Chr(16) & Chr(17) & Chr(13) & Chr(10)
stra = readfile(0, fileid, 0)
If stra = "seek_end" Then
readfile = strb
Exit Function
End If
Loop
End Select
End Function
Function rndnu(X As Integer, Y As Integer, k As Integer, r() As Integer) As Integer
'x下限Y上限K为要生成的个数，R（）为返回的数组
Dim i As Integer
Dim j As Integer
Dim ke As Integer
Randomize
r(1) = Int(Rnd(Time) * Y + X)
For i = 2 To k
ke = 1
Randomize
r(i) = Int(Rnd(Time) * Y + X)
For j = 1 To i - 1
If r(i) = r(j) Then
ke = 0
i = i - 1
Exit For
End If
Next
Next
For i = 1 To k - 1
For j = i + 1 To k
If r(i) > r(j) Then
ke = r(i)
r(i) = r(j)
r(j) = ke
End If
Next
Next
End Function
Function writetime(Index As Integer, userid As String, bytim As String) As Integer
Dim timeid, timename, jkey As String
timeid = readfile(0, Index + 30, 0)
timename = readfile(0, Index + 30, 0)
Do While 1
If timeid = "seek_end" Then Exit Do
If timeid = userid Then
Dim byt(1) As Byte
byt(0) = bytedat(Val(Mid(bytim, 1, 1)))
byt(1) = bytedat(Val(Mid(bytim, 2, 1)))
Put #(Index + 30), , byt
Close #(Index + 30)
Exit Function
End If
jkey = readfile(0, Index + 30, 0)
timeid = readfile(0, Index + 30, 0)
timename = readfile(0, Index + 30, 0)
Loop
Close #(Index + 30)
End Function

Function addtime(userid As String, fileid As Integer, hs As String) As Integer
Dim s, sa As String
sa = ""
Do While 1
s = readfile(0, fileid, 0)
If s = "seek_end" Then
Exit Do
End If
If userid = s Then
sa = sa & s & Chr(16) & Chr(17) & Chr(13) & Chr(10)
s = readfile(0, fileid, 0)
sa = sa & s & Chr(16) & Chr(17) & Chr(13) & Chr(10)
s = readfile(0, fileid, 0)
sa = sa & Trim(Str(Val(s) + Val(hs))) & Chr(16) & Chr(17) & Chr(13) & Chr(10)
Else
sa = sa & s & Chr(16) & Chr(17) & Chr(13) & Chr(10)
s = readfile(0, fileid, 0)
sa = sa & s & Chr(16) & Chr(17) & Chr(13) & Chr(10)
s = readfile(0, fileid, 0)
sa = sa & s & Chr(16) & Chr(17) & Chr(13) & Chr(10)
End If
Loop
Close #fileid
Open App.Path & "\useridb.dat" For Output As #fileid
Print #fileid, Left(sa, Len(sa) - 2)
Close #fileid
End Function
Function addfen(userid As String, fileid As Integer, fen As String) As Integer
Dim s, sa As String
sa = ""
Do While 1
s = readfile(0, fileid, 0)
If s = "seek_end" Then
Exit Do
End If
If userid = s Then
sa = sa & s & Chr(16) & Chr(17) & Chr(13) & Chr(10)
s = readfile(0, fileid, 0)
sa = sa & s & Chr(16) & Chr(17) & Chr(13) & Chr(10)
s = readfile(0, fileid, 0)
sa = sa & fen & Chr(16) & Chr(17) & Chr(13) & Chr(10)
Else
sa = sa & s & Chr(16) & Chr(17) & Chr(13) & Chr(10)
s = readfile(0, fileid, 0)
sa = sa & s & Chr(16) & Chr(17) & Chr(13) & Chr(10)
s = readfile(0, fileid, 0)
sa = sa & s & Chr(16) & Chr(17) & Chr(13) & Chr(10)
End If
Loop
Close #fileid
Open App.Path & "\idend.dat" For Output As #fileid
Print #fileid, Left(sa, Len(sa) - 2)
Close #fileid
End Function
Public Function NewProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If Msg = TRAY_CALLBACK Then
        ' The user clicked on the tray icon.
        ' Look for click events.
        If lParam = WM_LBUTTONUP Then
            ' On left click, show the form.

        End If
        If lParam = WM_RBUTTONUP Then
            ' On right click, show the menu.
            Form1.PopupMenu Form1.indexmnu
            Exit Function
        End If
    End If
    
    ' Send other messages to the original
    ' window proc.
    NewProc = CallWindowProc(OldProc, hwnd, Msg, wParam, lParam)
End Function