?? 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
_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)
BkPrsNum = Val(StrGet(5))
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -