📄 frmmain.frm
字号:
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "mswinsck.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form FrmMain
BorderStyle = 1 'Fixed Single
Caption = "图书馆管理系统服务器"
ClientHeight = 3990
ClientLeft = 45
ClientTop = 360
ClientWidth = 7710
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 3990
ScaleWidth = 7710
StartUpPosition = 3 '窗口缺省
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 375
Left = 0
TabIndex = 3
Top = 3615
Width = 7710
_ExtentX = 13600
_ExtentY = 661
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Alignment = 1
Object.Width = 3528
MinWidth = 3528
Text = "客户端连接数："
TextSave = "客户端连接数："
EndProperty
EndProperty
End
Begin VB.CommandButton CmdCancel
Cancel = -1 'True
Caption = "退出"
Height = 375
Left = 6360
TabIndex = 2
Top = 3120
Width = 1215
End
Begin MSComctlLib.ListView LvCnn
Height = 2535
Left = 120
TabIndex = 0
Top = 480
Width = 7455
_ExtentX = 13150
_ExtentY = 4471
View = 3
Arrange = 2
Sorted = -1 'True
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 4
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "管理员ID"
Object.Width = 2893
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "连接状态"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 2
Text = "时间"
Object.Width = 4304
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 3
Text = "通道号"
Object.Width = 2117
EndProperty
End
Begin MSWinsockLib.Winsock SockToCln
Index = 0
Left = 7080
Top = 0
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.Label Label1
Caption = "客户端连接状态："
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 375
Left = 240
TabIndex = 1
Top = 120
Width = 3855
End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub CmdCancel_Click() '退出
Dim i As Integer
'检查sock连接是否关闭
For i = 1 To ClMax
If Me.SockToCln(i).State <> sckClosed Then
Me.SockToCln(i).Close
End If
Next i
'结束程序
End
End Sub
Private Sub Form_Load()
Dim SqlStr As String
'设置网络属性
'服务器端口
SvrPort = "1234"
'设置侦听Winsock
Me.SockToCln(0).LocalPort = SvrPort
Me.SockToCln(0).Listen
'连接数据库
SqlStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
App.Path & "\mdb\library.mdb;Persist Security Info=False"
DBCnn.Open SqlStr
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim i As Integer
'关闭还没有关闭的Winsock连接
For i = 1 To ClMax
If Me.SockToCln(i).State <> sckClosed Then
Me.SockToCln(i).Close
End If
Next i
End Sub
'网络连接关闭
Private Sub SockToCln_Close(index As Integer)
Dim i As Integer
Dim FindItm As ListItem
For i = 1 To ClMax
'找到该连接
If Client(i).index = index Then
Set FindItm = Me.LvCnn.FindItem(Client(i).UsrID)
FindItm.SubItems(1) = "断开"
FindItm.SubItems(2) = Now
Exit For
End If
Next i
End Sub
'接受连接请求
Private Sub SockToCln_ConnectionRequest(index As Integer, ByVal requestID As Long)
Dim i As Integer
'查询是否有关闭的空闲控件
For i = 1 To MaxSvrSock
If SockToCln(i).State = sckClosed Then
SockToCln(i).LocalPort = 0
'不能占用侦听端口
If SockToCln(i).LocalPort = SvrPort Then
Exit Sub
End If
SockToCln(i).Accept requestID
Exit Sub
End If
Next i
'没有空闲的控件,原有socket都被占用，需要新增Winsock
MaxSvrSock = MaxSvrSock + 1 '控件数增加
Load SockToCln(MaxSvrSock) '动态生成一个winsock控件
SockToCln(MaxSvrSock).LocalPort = 0 '设置新端口
SockToCln(MaxSvrSock).Accept requestID '接受连接请求
End Sub
'接受并处理数据
Private Sub SockToCln_DataArrival(index As Integer, ByVal bytesTotal As Long)
Dim StrArrival As String, StrGet() As String
Dim strBack As String
Dim RdrID As String
Dim bkNum As Long
Dim StatNum As Integer
Dim UsrID As String
Dim UsrPwd As String
'接受数据
Me.SockToCln(index).GetData StrArrival, vbString
If Len(StrArrival) < 1 Then Exit Sub
'拆分接收到的数据
StrGet() = Split(StrArrival, ",", -1)
'判断类型
Select Case StrGet(0)
'图书借阅
Case "Lend"
'得到RdrID和BkNum
RdrID = StrGet(1)
bkNum = Val(StrGet(2))
'回复客户端
strBack = CheckLend(RdrID, bkNum)
'图书归还
Case "Return"
'得到BkNum
bkNum = Val(StrGet(1))
'回复客户端
strBack = CheckReturn(bkNum)
'缴纳欠款
Case "Pay"
'得到RdrID
RdrID = StrGet(1)
'回复客户端
strBack = CheckPay(RdrID)
'操作图书类别
Case "Type"
'调用BookType函数处理图书管理命令
strBack = BookType(StrGet, index)
'图书管理
Case "Book"
'调用BookInfo函数处理图书管理命令
strBack = BookInfo(StrGet, index)
'读者管理
Case "Rdr"
'调用Reader函数处理图书管理命令
strBack = Reader(StrGet, index)
'管理员管理
Case "Usr"
'调用User函数处理图书管理命令
strBack = User(StrGet, index)
Case "Stat"
'得到StatNum
StatNum = Val(StrGet(1))
'回复客户端
strBack = CheckStat(StatNum)
'连接信息
Case "Cnn"
'得到UsrID和UsrPwd
UsrID = StrGet(1)
UsrPwd = StrGet(2)
'回复客户端
strBack = CheckUsr(UsrID, UsrPwd, index)
End Select
'检验sock连接
If Me.SockToCln(index).State <> sckConnected Then
Exit Sub
End If
'发送返回信息
Me.SockToCln(index).SendData strBack
End Sub
'
'以下为DataArrival（）过程中用到的函数
'
'*****************************************************************************
'检验图书类别信息管理的函数 BookType
'功能：检验客户端发送来的图书类别管理信息，处理数据库后返回信息。
'输入：StrGet（），String类型，客户端传送的协议数组，
' index，Integer类型，客户端连接Winsock下标。
'输出：BookType，String类型，返回的响应信息。
'*****************************************************************************
Private Function BookType(ByRef StrGet() As String, index As Integer) As String
Dim iType As Integer
Dim TypeName As String
Dim TypeNum As Integer
'得到类型
iType = StrGet(1)
If iType = 1 Then
'得到TypeName
TypeName = StrGet(2)
'回复客户端
BookType = CheckType1(TypeName, index)
ElseIf iType = 2 Then
'回复客户端
BookType = CheckType2()
End If
End Function
'*****************************************************************************
'检验图书信息管理的函数 BookInfo
'功能：检验客户端发送来的图书管理信息，处理数据库后返回信息。
'输入：StrGet（），String类型，客户端传送的协议数组，
' index，Integer类型，客户端连接Winsock下标。
'输出：BookInfo，String类型，返回的响应信息。
'*****************************************************************************
Private Function BookInfo(ByRef StrGet() As String, index As Integer) As String
Dim iType As Integer
Dim BkName As String, BkAuthor As String, BkPress As String
Dim BkPrsNum As Integer
Dim BkPrsDate As Date
Dim BkType As Integer
iType = StrGet(1)
Select Case iType
Case 1
'得到BkName，BkAuthor，BkPress，BkPrsNum，BkPrsDate，BkType，
BkName = StrGet(2)
BkAuthor = StrGet(3)
BkPress = StrGet(4)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -