frmmain.frm

<Visual Basic 数据库开发实例精粹（第二版）>一书首先介绍了Visual Basic(简称VB)开发的技巧和重点技术

        BkPrsNum = Val(StrGet(5))
        BkPrsDate = StrGet(6)
        BkType = StrGet(7)
        '回复客户端
        BookInfo = CheckBook1(BkName, BkAuthor, BkPress, BkPrsDate, BkType, index)
        
    Case 2
        '得到BkName
        BkName = StrGet(2)
        '回复客户端
        BookInfo = CheckBook2(BkName)
        
    Case 3
        '得到BkAuthor
        BkAuthor = StrGet(2)
        '回复客户端
        BookInfo = CheckBook3(BkAuthor)
    End Select
    
End Function

'*****************************************************************************
'检验读者信息管理的函数 Reader
'功能：检验客户端发送来的读者管理信息，处理数据库后返回信息。
'输入：StrGet（），String类型，客户端传送的协议数组，
'      index，Integer类型，客户端连接Winsock下标。
'输出：Reader，String类型，返回的响应信息。
'*****************************************************************************
Private Function Reader(ByRef StrGet() As String, index As Integer) As String
Dim iType As Integer
Dim RdrID As String
Dim RdrName As String
Dim RdrType As Integer

    '得到类型
    iType = StrGet(1)
    Select Case iType
    Case 1
        '得到RdrID，RdrName，RdrType，
        RdrID = StrGet(2)
        RdrName = StrGet(3)
        RdrType = StrGet(4)
        '回复客户端
        Reader = CheckRdr1(RdrID, RdrName, RdrType, index)
    Case 2
        '得到RdrID
        RdrID = StrGet(2)
        '回复客户端
        Reader = CheckRdr2(RdrID, index)
    Case 3
        '得到RdrID
        RdrID = StrGet(2)
        '回复客户端
        Reader = CheckRdr3(RdrID, index)
    End Select
    
End Function

'*****************************************************************************
'检验管理员信息管理的函数 User
'功能：检验客户端发送来的管理员管理信息，处理数据库后返回信息。
'输入：StrGet（），String类型，客户端传送的协议数组，
'      index，Integer类型，客户端连接Winsock下标。
'输出：User，String类型，返回的响应信息。
'*****************************************************************************
Private Function User(ByRef StrGet() As String, index As Integer) As String
Dim iType As Integer
Dim UsrID As String
Dim UsrName As String
Dim UsrPwd As String
Dim UsrType As Integer

    '管理员管理操作类型
    iType = StrGet(1)
    Select Case iType
    '添加管理员
    Case 1
        '得到 UsrID，UsrName，UsrPwd，UsrType
        UsrID = StrGet(2)
        UsrName = StrGet(3)
        UsrPwd = StrGet(4)
        UsrType = StrGet(5)
        '回复客户端
        User = CheckUsr1(UsrID, UsrName, UsrPwd, UsrType, index)
    '删除管理员
    Case 2
         '得到 UsrID
        UsrID = StrGet(2)
        '回复客户端
        User = CheckUsr2(UsrID, index)
    '查询管理员
    Case 3
         '得到 UsrID
        UsrID = StrGet(2)
        '回复客户端
        User = CheckUsr3(UsrID, index)
    End Select
    
End Function

'
'以下为本程序中用到的功能函数
'

'********************************************************************************
'检验用户名和密码的函数 CheckUsr
'功能：检验客户端发送来的用户名和密码是否正确。
'输入：UsrID，String类型，用户ID，
'      UsrPwd，String类型，用户密码。
'输出：CheckUsr，String类型，返回帧头＋登录响应信息。
'********************************************************************************
Private Function CheckUsr(ByVal UsrID As String, _
                          ByVal UsrPwd As String, _
                          ByVal index As Integer) As String
Dim rsCheck As New ADODB.Recordset
Dim DBstr As String
Dim bEnter As Boolean
Dim FindItm As ListItem, LtItm As ListItem

     '1.读出数据库中的记录
     '2.找到输入的管理员名
     '3.比较输入的密码是否与数据库中的记录相符
     '4.返回响应信息
     
     bEnter = False
     DBstr = "select * from User_Info where Usr_ID='" & Replace(UsrID, "'", "''") & "'"
     '打开数据集
     rsCheck.Open DBstr, DBCnn, adOpenStatic, adLockReadOnly, -1
     
     '返回响应信息
     CheckUsr = "Cnn,"
     '查找到的记录数为0
     If rsCheck.RecordCount <= 0 Then  '找不到该管理员名
         CheckUsr = CheckUsr & "该管理员名不存在！请重新输入！"
     Else
         '数据集指针指向第一个记录，这里查找到的记录唯一
         rsCheck.MoveFirst
         If UsrPwd = rsCheck.Fields("Usr_Pwd").Value Then
             '返回信息
             CheckUsr = CheckUsr & "欢迎进入图书馆管理系统！"
             bEnter = True
         Else
             CheckUsr = CheckUsr & "密码错误！请重新输入！"
         End If
     End If
     '关闭数据集
     rsCheck.Close
     
    If bEnter Then
        '最大连接数加1
        ClMax = ClMax + 1
        Client(ClMax).UsrID = UsrID
        Client(ClMax).index = index
        
        '添加到连接状态列表中
        Set FindItm = Me.LvCnn.FindItem(Client(ClMax).UsrID)
            If FindItm Is Nothing Then  '找不到，添加新列表
                Set LtItm = Me.LvCnn.ListItems.Add()
                    LtItm.Text = Client(ClMax).UsrID
                    LtItm.SubItems(1) = "登录"
                    LtItm.SubItems(2) = Now
                    LtItm.SubItems(3) = index
            Else                        '已有，更改
                FindItm.SubItems(1) = "登录"
                FindItm.SubItems(2) = Now
                FindItm.SubItems(3) = index
            End If
        '在状态栏显示连接数
        Me.StatusBar1.Panels(1).Text = "客户端连接数：" & ClMax
    End If
    
End Function

'********************************************************************************
'检验读者借阅图书的函数 CheckLend
'功能：检验客户端发送来的读者借书信息，处理数据库后返回信息。
'输入：RdrID，String类型，读者ID，
'      bkNum，Long类型，借阅书号。
'输出：CheckLend，String类型，返回帧头＋读者借书响应信息。
'********************************************************************************
Private Function CheckLend(ByVal RdrID As String, ByVal bkNum As Long) As String
Dim DBstr As String
Dim RdrType As Integer, RdrBkTotal As Integer
Dim BkTotal As Integer, dLimit As Integer
Dim DateLimit As Date, dNow As Date
Dim SqlStr As String
Dim rsCheck As New ADODB.Recordset
Dim book As New ADODB.Recordset
        
    CheckLend = "Lend,"
        
    '1.读出读者信息，判断是否可以借阅该书
    DBstr = "select * from Reader_Info where Rdr_ID='" & Replace(RdrID, "'", vbNullString) & "'"
    '打开数据集
    rsCheck.Open DBstr, DBCnn, adOpenStatic, adLockOptimistic
    '查找到的记录数为0
    If rsCheck.RecordCount <= 0 Then  '找不到该读者
        CheckLend = CheckLend & "该读者不存在！借阅图书失败！"
        Exit Function
    End If
    '数据集指针指向第一个记录，这里查找到的记录唯一,读出读者信息
    rsCheck.MoveFirst
    
    'ID是否有效
    If rsCheck.Fields("Rdr_Entitle").Value = False Then
        CheckLend = CheckLend & "该读者已过期！借阅图书失败！"
        Exit Function
    End If
    '欠款是否超过 3.00
    If rsCheck.Fields("Rdr_Arrearage").Value > 3 Then
        CheckLend = CheckLend & "该读者欠款已超过3.00元！借阅图书失败！"
        Exit Function
    End If
    
    RdrType = rsCheck.Fields("Rdr_Type").Value
    RdrBkTotal = rsCheck.Fields("Rdr_BkTotal").Value
    
    Select Case RdrType
    Case 1  '本科生
        BkTotal = 5
        dLimit = 1
    Case 2  '研究生
        BkTotal = 8
        dLimit = 2
    Case 3  '教师
        BkTotal = 10
        dLimit = 2
    End Select
    '借书是否超过数量
    If RdrBkTotal > BkTotal Then
        CheckLend = CheckLend & "该读者借书已达最大！借阅图书失败！"
        Exit Function
    End If
    
    '2.该书是否可借
    DBstr = "select * from Book_Info where Book_Num=" & bkNum
    book.Open DBstr, DBCnn, adOpenStatic, adLockOptimistic
    
    If book.RecordCount < 1 Then
        CheckLend = CheckLend & "您的输入有误！该图书不存在！"
        Exit Function
    End If
    
    book.MoveFirst  '书号唯一
    If book.Fields("Book_Available").Value = False Then '该书已借出
        CheckLend = CheckLend & "您的输入有误！该图书已借出！"
        Exit Function
    End If
    
    '3.借阅成功，计算应还日期，读者借阅书数＋1
    dNow = Format(Now, "yy - mm - dd")
    DateLimit = DateAdd("m", dLimit, dNow)
    rsCheck.Fields("Rdr_BkTotal").Value = rsCheck.Fields("Rdr_BkTotal").Value + 1
    
    '4.图书借阅次数＋1,标记该书已借出
    book.Fields("Book_Total").Value = book.Fields("Book_Total").Value + 1
    book.Fields("Book_Available").Value = False
    
    '更新数据集
    rsCheck.Update
    book.Update
    '关闭数据集
    rsCheck.Close
    book.Close
    '返回信息
    CheckLend = CheckLend & "借阅图书成功！" & "归还期限是" & DateLimit & ","
    
    '5.记录到数据库
    SqlStr = "INSERT INTO Book_Record" & _
    "(Rec_RdrID,Rec_BkNum,Rec_LendTime,Rec_LendLimit) " & _
    "VALUES ('" & RdrID & "'" & _
             "," & bkNum & _
             ",#" & dNow & "#" & _
             ",#" & DateLimit & "#);"
    DBCnn.Execute SqlStr
    
End Function

'*****************************************************************************
'检验读者归还图书的函数 CheckReturn
'功能：检验客户端发送来的读者还书信息，处理数据库后返回信息。
'输入：bkNum，Long类型，还书号。
'输出：CheckReturn，String类型，返回帧头＋读者还书响应信息。
'*****************************************************************************
Private Function CheckReturn(ByVal bkNum As Long) As String
Dim rsCheck As New ADODB.Recordset
Dim dec As New ADODB.Recordset
Dim book As New ADODB.Recordset
Dim pay As Single
Dim RdrID As String
Dim DBstr As String
        
    '1.找到该书的借阅信息记录
    DBstr = "select * from Book_Record where Rec_BkNum=" & bkNum
    rsCheck.Open DBstr, DBCnn, adOpenStatic, adLockOptimistic
    
    '2.返回响应信息
    CheckReturn = "Return,"
    If rsCheck.RecordCount < 1 Then '找不到该读者
        CheckReturn = CheckReturn & "该书并没有借出！归还图书失败！"
        Exit Function
    End If
    
    '3.判断是否超期,
    '4.添加到数据库,计算是否欠款,欠款累加, 借阅书数-1
    rsCheck.MoveLast   '最后一条记录
    If rsCheck.Fields("Rec_LendLimit").Value < Now Then
        pay = DateDiff("d", rsCheck.Fields("Rec_LendLimit").Value, Now) / 100 '每天一分钱
        CheckReturn = CheckReturn & "归还图书已成功！" & vbCrLf
        CheckReturn = CheckReturn & "但该书已过期，应交罚款" & pay & "元！"
        rsCheck.Fields("Rec_Arrearage").Value = pay
        '欠款累加
        RdrID = rsCheck.Fields("Rec_RdrID").Value
        DBstr = "select * from Reader_Info where Rdr_ID='" & RdrID & "'"
        dec.Open DBstr, DBCnn, adOpenStatic, adLockOptimistic
        dec.MoveFirst   '唯一
        dec.Fields("Rdr_Arrearage").Value = dec.Fields("Rdr_Arrearage").Value + pay
        '借阅书数-1
        dec.Fields("Rdr_BkTotal").Value = dec.Fields("Rdr_BkTotal").Value - 1
        dec.Update
        dec.Close
        rsCheck.Update
        rsCheck.Close
        Exit Function
    End If
    
    '5.记录该书可借
    DBstr = "select * from Book_Info where Book_Num=" & bkNum
    book.Open DBstr, DBCnn, adOpenStatic, adLockOptimistic
    book.Fields("Book_Available").Value = True
    book.Update
    book.Close
    
    CheckReturn = CheckReturn & "归还图书已成功！"
    rsCheck.Fields("Rec_ReturnTime").Value = Now
    rsCheck.Update
    rsCheck.Close
    
End Function

'*****************************************************************************