frmmain.frm

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

'检验缴纳罚款的函数 CheckPay
'功能：检验客户端发送来的缴纳罚款信息，处理数据库后返回信息。
'输入：RdrID，String类型，缴纳罚款的读者ID。
'输出：CheckPay，String类型，返回帧头＋缴纳罚款响应信息，包括应缴纳罚款数。
'*****************************************************************************
Private Function CheckPay(ByVal RdrID As String) As String
Dim rsCheck As New ADODB.Recordset
Dim DBstr As String

    '1.找到该读者记录
    DBstr = "select * from Reader_Info where Rdr_ID='" & Replace(RdrID, "'", "''") & "'"
    rsCheck.Open DBstr, DBCnn, adOpenStatic, adLockOptimistic
    
    '2.返回响应信息
    CheckPay = "Pay,"
    If rsCheck.RecordCount < 1 Then '找不到该读者
        CheckPay = CheckPay & "该读者不存在！缴纳罚款失败！"
        Exit Function
    End If
    
    '3.添加到数据库
    rsCheck.MoveFirst   '记录唯一
    If rsCheck.Fields("Rdr_Arrearage").Value > 0 Then
        CheckPay = CheckPay & "缴纳罚款已记录！"
        CheckPay = CheckPay & vbCrLf
        CheckPay = CheckPay & "请交" & rsCheck.Fields("Rdr_Arrearage").Value & "元！"
        rsCheck.Fields("Rdr_Arrearage").Value = 0
    Else
        CheckPay = CheckPay & "该用户没有欠款！"
    End If
    rsCheck.Update
    rsCheck.Close
        
End Function

'*****************************************************************************
'检验添加图书类别的函数 CheckType1
'功能：检验客户端发送来的添加图书类别信息，处理数据库后返回信息。
'输入：TypeName，String类型，图书类别名，
'      index，Integer类型，sock通道号。
'输出：CheckType1，String类型，返回帧头＋检验添加图书类别响应信息。
'*****************************************************************************
Private Function CheckType1(ByVal TypeName As String, index As Integer) As String
Dim rsCheck As New ADODB.Recordset
Dim DBstr As String
Dim SqlStr As String
Dim i As Integer

    CheckType1 = "Type,01,"
    
    '1.查看权限是否允许
    For i = 1 To ClMax
        If Client(i).index = index Then
            DBstr = "select * from User_Info where Usr_ID='"
            DBstr = DBstr & Replace(Client(i).UsrID, "'", "''") & "'"
            rsCheck.Open DBstr, DBCnn, adOpenStatic, adLockOptimistic
            If rsCheck.Fields("Usr_Type").Value = 2 Then
                CheckType1 = CheckType1 & "超出权限！添加类型失败！"
                Exit Function
            End If
            rsCheck.Close
            Exit For
        End If
    Next i
        
    '2.查看是否重复
    DBstr = "select * from Book_Type where Type_Name='" & Replace(TypeName, "'", "''") & "'"
    rsCheck.Open DBstr, DBCnn, adOpenStatic, adLockOptimistic
    If rsCheck.RecordCount > 0 Then '已经存在
        CheckType1 = CheckType1 & "该类型已存在！添加类型失败！"
        Exit Function
    End If
    rsCheck.Close
    
    '3.添加到数据库
    SqlStr = "INSERT INTO Book_Type"
    SqlStr = SqlStr & "(Type_Name) "
    SqlStr = SqlStr & "VALUES ('" & Replace(TypeName, "'", "''") & "');"
    DBCnn.Execute SqlStr
    CheckType1 = CheckType1 & "添加类型成功！"

End Function

'*****************************************************************************
'检验查看图书类别的函数 CheckType2
'功能：检验客户端发送来的查询图书类别信息，处理数据库后返回信息。
'输入：无。
'输出：CheckType1，String类型，返回帧头＋查询图书类别响应信息，
'      响应信息格式：Type_Num1+Type_Name1，…
'*****************************************************************************
Private Function CheckType2() As String
Dim rsCheck As New ADODB.Recordset
Dim i As Integer

    '1.返回查询结果
    rsCheck.Open "select * from Book_Type", DBCnn, adOpenStatic, adLockOptimistic
    
    CheckType2 = "Type,02,"
    If rsCheck.RecordCount < 1 Then '无类别
        CheckType2 = CheckType2 & "目前数据库中没有图书类别！"
        Exit Function
    End If
    rsCheck.MoveFirst
    For i = 1 To rsCheck.RecordCount
        CheckType2 = CheckType2 & rsCheck.Fields("Type_Num").Value & " "
        CheckType2 = CheckType2 & rsCheck.Fields("Type_Name").Value & ","
        rsCheck.MoveNext
    Next i
    rsCheck.Close
    
End Function

'*****************************************************************************
'检验添加图书信息的函数 CheckBook1
'功能：检验客户端发送来的添加图书信息，处理数据库后返回信息。
'输入：BkName，String类型，图书名，
'      BkAuthor，String类型，作者，
'      BkPress，String类型，出版社，
'      BkPrsDate，String类型，出版日期，
'      BkType，Integer类型，图书类型，
'      index，Integer类型，sock通道号。
'输出：CheckBook1，String类型，返回帧头＋检验添加图书信息响应信息。
'*****************************************************************************
Private Function CheckBook1(ByVal BkName As String, _
                            ByVal BkAuthor As String, _
                            ByVal BkPress As String, _
                            ByVal BkPrsDate As String, _
                            ByVal BkType As Integer, _
                            ByVal index As Integer) As String
Dim rsCheck As New ADODB.Recordset
Dim DBstr As String
Dim SqlStr As String
Dim i As Integer

    CheckBook1 = "Book,01,"
    '1.查看权限是否允许
    For i = 1 To ClMax
        If Client(i).index = index Then
            DBstr = "select * from User_Info where Usr_ID='"
            DBstr = DBstr & Replace(Client(i).UsrID, "'", "''") & "'"
            rsCheck.Open DBstr, DBCnn, adOpenStatic, adLockOptimistic
            If rsCheck.Fields("Usr_Type").Value = 2 Then
                CheckBook1 = CheckBook1 & "超出权限！添加图书信息失败！"
                Exit Function
            End If
            rsCheck.Close
            Exit For
        End If
    Next i
            
    '2.检验类型号
    DBstr = "select * from Book_Type where Type_Num=" & BkType
    rsCheck.Open DBstr, DBCnn, adOpenStatic, adLockOptimistic
    If rsCheck.RecordCount < 1 Then   '类型号不存在
        CheckBook1 = CheckBook1 & "该类型号不存在，添加图书信息失败！"
        Exit Function
    End If
    
    '3.添加到数据库
    SqlStr = "INSERT INTO Book_Info"
    SqlStr = SqlStr & "(Book_Name,"
    SqlStr = SqlStr & "Book_Author,"
    SqlStr = SqlStr & "Book_Press,"
    SqlStr = SqlStr & "Book_PrsDate,"
    SqlStr = SqlStr & "Book_Type,"
    SqlStr = SqlStr & "Book_Available) "
    SqlStr = SqlStr & "VALUES ('" & Replace(BkName, "'", vbNullString) & "',"
    SqlStr = SqlStr & "'" & Replace(BkAuthor, "'", vbNullString) & "',"
    SqlStr = SqlStr & "'" & Replace(BkPress, "'", vbNullString) & "',"
    SqlStr = SqlStr & "#" & BkPrsDate & "#,"
    SqlStr = SqlStr & BkType & ","
    SqlStr = SqlStr & True & ");"
    
    DBCnn.Execute SqlStr
    CheckBook1 = CheckBook1 & "添加图书信息成功！"
    
End Function

'*****************************************************************************
'检验查询图书信息的函数 CheckBook2
'功能：检验客户端发送来的查询图书信息，处理数据库后返回信息。
'输入：BkName，String类型，图书名。
'输出：CheckBook2，String类型，返回查询图书信息响应信息，
'      响应信息格式：Book，02，
'                    Book_Num1+Book_Name1+Book_Author1+Book_Press1+Book_PrsNum1
'                    +Book_PrsDate1+Book_Type1+Book_Available1+Book_Total1，…
'*****************************************************************************
Private Function CheckBook2(ByVal BkName As String) As String
Dim rsCheck As New ADODB.Recordset
Dim i As Integer
Dim sAvailable As String
Dim DBstr As String

    '1.查询数据库
    DBstr = "select * from Book_Info where Book_Name Like"
    DBstr = DBstr & "'%" & Replace(BkName, "'", "''") & "%'"
    rsCheck.Open DBstr, DBCnn, adOpenStatic, adLockOptimistic
    
    '2.生成响应字符串
    CheckBook2 = "Book,02"
    
    If rsCheck.RecordCount < 1 Then '书名不存在
        CheckBook2 = CheckBook2 & ",该书名不存在！查询图书失败！"
        Exit Function
    End If
    
    rsCheck.MoveFirst
    For i = 1 To rsCheck.RecordCount
        CheckBook2 = CheckBook2 & ","
        CheckBook2 = CheckBook2 & "图书信息：" & rsCheck.Fields("Book_Name").Value
        CheckBook2 = CheckBook2 & " 作者：" & rsCheck.Fields("Book_Author").Value
        CheckBook2 = CheckBook2 & " " & rsCheck.Fields("Book_Press").Value
        CheckBook2 = CheckBook2 & " 版本号" & rsCheck.Fields("Book_PrsNum").Value
        CheckBook2 = CheckBook2 & " 出版日期：" & rsCheck.Fields("Book_PrsDate").Value
        CheckBook2 = CheckBook2 & " 图书类型：" & rsCheck.Fields("Book_Type").Value
        If rsCheck.Fields("Book_Available").Value Then
            CheckBook2 = CheckBook2 & " 在库：是"
        Else
            CheckBook2 = CheckBook2 & " 在库：否"
        End If
        CheckBook2 = CheckBook2 & " 借阅次数：" & rsCheck.Fields("Book_Total").Value
        rsCheck.MoveNext
    Next i
    
    rsCheck.Close
    
End Function

'*****************************************************************************
'检验查询图书信息的函数 CheckBook3
'功能：检验客户端发送来的查询图书信息，处理数据库后返回信息。
'输入：BkAuthor，String类型，图书名。
'输出：CheckBook3，String类型，返回帧头＋查询图书信息响应信息。
'      响应信息格式：与上一条协议完全相同。
'*****************************************************************************
Private Function CheckBook3(ByVal BkAuthor As String) As String
Dim rsCheck As New ADODB.Recordset
Dim i As Integer
Dim sAvailable As String
Dim DBstr As String

    '1.查询数据库
    DBstr = "select * from Book_Info where Book_Author Like"
    DBstr = DBstr & "'%" & Replace(BkAuthor, "'", "''") & "%'"
    rsCheck.Open DBstr, DBCnn, adOpenStatic, adLockOptimistic
    
    '2.生成响应字符串
    CheckBook3 = "Book,02"
    If rsCheck.RecordCount < 1 Then '作者不存在
        CheckBook3 = CheckBook3 & ",该作者不存在！查询图书失败！"
        Exit Function
    End If
    rsCheck.MoveFirst
    
    For i = 1 To rsCheck.RecordCount
        CheckBook3 = CheckBook3 & ","
        CheckBook3 = CheckBook3 & "图书信息：" & rsCheck.Fields("Book_Name").Value
        CheckBook3 = CheckBook3 & " 作者：" & rsCheck.Fields("Book_Author").Value
        CheckBook3 = CheckBook3 & " " & rsCheck.Fields("Book_Press").Value
        CheckBook3 = CheckBook3 & " 版本号" & rsCheck.Fields("Book_PrsNum").Value
        CheckBook3 = CheckBook3 & " 出版日期：" & rsCheck.Fields("Book_PrsDate").Value
        CheckBook3 = CheckBook3 & " 图书类型：" & rsCheck.Fields("Book_Type").Value
        If rsCheck.Fields("Book_Available").Value Then
            CheckBook3 = CheckBook3 & " 在库：是"
        Else
            CheckBook3 = CheckBook3 & " 在库：否"
        End If
        CheckBook3 = CheckBook3 & " 借阅次数：" & rsCheck.Fields("Book_Total").Value
        rsCheck.MoveNext
    Next i
    
    rsCheck.Close
    
End Function

'*****************************************************************************
'检验添加读者信息的函数 CheckRdr1
'功能：检验客户端发送来的添加读者信息，处理数据库后返回信息。
'输入：RdrID，String类型，读者ID，
'      RdrName，String类型，读者姓名，
'      RdrType，Integer类型，读者类型，
'      index，Integer类型，sock通道号。
'输出：CheckRdr1，String类型，返回帧头＋添加读者信息响应信息。
'*****************************************************************************
Private Function CheckRdr1(ByVal RdrID As String, _
                           ByVal RdrName As String, _
                           ByVal RdrType As Integer, _
                           ByVal index As Integer) As String
Dim rsCheck As New ADODB.Recordset
Dim DBstr As String
Dim SqlStr As String
Dim i As Integer
    
    CheckRdr1 = "Rdr,01,"
    
    '1.查看权限是否允许
    For i = 1 To ClMax
        If Client(i).index = index Then
            DBstr = "select * from User_Info where Usr_ID='"
            DBstr = DBstr & Replace(Client(i).UsrID, "'", "''") & "'"
            rsCheck.Open DBstr, DBCnn, adOpenStatic, adLockOptimistic
            If rsCheck.Fields("Usr_Type").Value = 2 Then
                CheckRdr1 = CheckRdr1 & "超出权限！添加读者信息失败！"
                Exit Function
            End If
            rsCheck.Close
            Exit For
        End If
    Next i
            
    '2.查看是否重复ID
    DBstr = "select * from Reader_Info where Rdr_ID='" & Replace(RdrID, "'", vbNullString) & "'"
    rsCheck.Open DBstr, DBCnn, adOpenStatic, adLockOptimistic
    If rsCheck.RecordCount > 0 Then '读者已存在
        CheckRdr1 = CheckRdr1 & "该读者已存在！添加读者失败！"
        rsCheck.Close
        Exit Function
    End If
    
    '3.添加到数据库
    SqlStr = "INSERT INTO Reader_Info" & "(Rdr_ID,Rdr_Name,Rdr_Type,Rdr_Entitle) "
    SqlStr = SqlStr & "VALUES ('" & Replace(RdrID, "'", vbNullString) & "',"
    SqlStr = SqlStr & "'" & Replace(RdrName, "'", vbNullString) & "',"
    SqlStr = SqlStr & RdrType & ","
    SqlStr = SqlStr & True & ");"
    DBCnn.Execute SqlStr
    CheckRdr1 = CheckRdr1 & "添加读者信息成功！"
    
End Function

'*****************************************************************************
'检验删除读者信息的函数 CheckRdr2
'功能：检验客户端发送来的删除读者信息，处理数据库后返回信息。
'输入：RdrID，String类型，读者ID，
'      index，Integer类型，sock通道号。
'输出：CheckRdr2，String类型，返回帧头＋删除读者信息响应信息。
'*****************************************************************************
Private Function CheckRdr2(ByVal RdrID As String, ByVal index As Integer) As String
Dim rsCheck As New ADODB.Recordset
Dim DBstr As String
Dim i As Integer