frmmain.frm

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

    CheckRdr2 = "Rdr,02,"
    
    '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
                CheckRdr2 = CheckRdr2 & "超出权限！删除读者信息失败！"
                Exit Function
            End If
            rsCheck.Close
            Exit For
        End If
    Next i
            
    '3.添加到数据库
    DBstr = "select * from Reader_Info where Rdr_ID='"
    DBstr = DBstr & Replace(RdrID, "'", vbNullString) & "'"
    rsCheck.Open DBstr, DBCnn, adOpenStatic, adLockOptimistic
    If rsCheck.RecordCount < 1 Then '读者不存在
        CheckRdr2 = CheckRdr2 & "该读者不存在！删除读者失败！"
        Exit Function
    End If
    rsCheck.MoveFirst
    If rsCheck.Fields("Rdr_Entitle").Value = False Then
        CheckRdr2 = CheckRdr2 & "删除失败，该读者已经无效！"
    Else
        rsCheck.Fields("Rdr_Entitle").Value = False
        rsCheck.Update
        CheckRdr2 = CheckRdr2 & "删除读者信息成功！"
        CheckRdr2 = CheckRdr2 & vbCrLf
        CheckRdr2 = CheckRdr2 & "ID：" & Replace(RdrID, "'", vbNullString)
        CheckRdr2 = CheckRdr2 & " 姓名：" & rsCheck.Fields("Rdr_Name").Value
    End If
    
    rsCheck.Close
    
End Function

'*****************************************************************************
'检验查询读者信息的函数 CheckRdr3
'功能：检验客户端发送来的查询读者信息，处理数据库后返回信息。
'输入：RdrID，String类型，读者ID，
'      index，Integer类型，sock通道号。
'输出：CheckRdr3，String类型，返回查询读者信息响应信息，
'      响应信息格式：Rdr，03，
'                    Rdr_ID1+Rdr_Name1+Rdr_Type1+Rdr_BkTotal1
'                    +Rdr_Arrearage1+Rdr_Entitle1，…
'*****************************************************************************
Private Function CheckRdr3(ByVal RdrID As String, ByVal index As Integer) As String
Dim rsCheck As New ADODB.Recordset
Dim DBstr As String
Dim i As Integer
Dim sType As String, sEntitle As String

    CheckRdr3 = "Rdr,03"
    '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
                CheckRdr3 = CheckRdr3 & ",超出权限！查询读者信息失败！"
                Exit Function
            End If
            rsCheck.Close
            Exit For
        End If
    Next i
            
    '2.执行查询
    DBstr = "select * from Reader_Info where Rdr_ID LIKE"
    DBstr = DBstr & "'%" & Replace(RdrID, "'", vbNullString) & "%'"
    rsCheck.Open DBstr, DBCnn, adOpenStatic, adLockOptimistic
    
    '3.返回查询信息
    If rsCheck.RecordCount < 1 Then '读者不存在
        CheckRdr3 = CheckRdr3 & ",该读者不存在！查询读者失败！"
        Exit Function
    End If
    
    '查询结果唯一
    rsCheck.MoveFirst
    For i = 1 To rsCheck.RecordCount
        Select Case rsCheck.Fields("Rdr_Type").Value
        Case 1
            sType = "本科生"
        Case 2
            sType = "研究生"
        Case 3
            sType = "教师"
        End Select
        If rsCheck.Fields("Rdr_Entitle").Value Then
            sEntitle = "可用"
        Else
            sEntitle = "不可用"
        End If
        
        CheckRdr3 = CheckRdr3 & ","
        CheckRdr3 = CheckRdr3 & "读者ID：" & rsCheck.Fields("Rdr_ID").Value
        CheckRdr3 = CheckRdr3 & " 姓名：" & rsCheck.Fields("Rdr_Name").Value
        CheckRdr3 = CheckRdr3 & " 类型： " & sType
        CheckRdr3 = CheckRdr3 & " 已借书数：" & rsCheck.Fields("Rdr_BkTotal").Value
        CheckRdr3 = CheckRdr3 & " 超期欠款：" & rsCheck.Fields("Rdr_Arrearage").Value
        CheckRdr3 = CheckRdr3 & " 有效性：" & sEntitle
        
        rsCheck.MoveNext
    Next i
    '关闭数据集
    rsCheck.Close
    
End Function

'*****************************************************************************
'检验添加管理员信息的函数 CheckUsr1
'功能：检验客户端发送来的添加管理员信息，处理数据库后返回信息。
'输入：UsrID，String类型，管理员ID，
'      UsrName，String类型，管理员姓名，
'      UsrPwd，String类型，管理员密码，
'      UsrType，Integer类型，管理员类型，
'      index，Integer类型，sock通道号。
'输出：CheckUsr1，String类型，返回帧头＋添加管理员响应信息。
'*****************************************************************************
Private Function CheckUsr1(ByVal UsrID As String, _
                           ByVal UsrName As String, _
                           ByVal UsrPwd As String, _
                           ByVal UsrType 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

    CheckUsr1 = "Usr,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 > 0 Then
                CheckUsr1 = CheckUsr1 & "超出权限！添加管理员信息失败！"
                Exit Function
            End If
            rsCheck.Close
            Exit For
        End If
    Next i
            
    '2.查看是否重复ID
    DBstr = "select * from User_Info where Usr_ID='" & Replace(UsrID, "'", "''") & "'"
    rsCheck.Open DBstr, DBCnn, adOpenStatic, adLockOptimistic
    If rsCheck.RecordCount > 0 Then
        CheckUsr1 = CheckUsr1 & "该管理员已存在！添加管理员失败！"
        Exit Function
    End If
    rsCheck.Close
            
    '3.添加到数据库
    SqlStr = "INSERT INTO User_Info" & "(Usr_ID,Usr_Name,Usr_Pwd,Usr_Type) "
    SqlStr = SqlStr & "VALUES ('" & Replace(UsrID, "'", "''") & "',"
    SqlStr = SqlStr & "'" & Replace(UsrName, "'", vbNullString) & "',"
    SqlStr = SqlStr & "'" & Replace(UsrPwd, "'", "''") & "',"
    SqlStr = SqlStr & UsrType & ");"
    DBCnn.Execute SqlStr
    CheckUsr1 = CheckUsr1 & "添加管理员信息成功！"
    
End Function

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

    CheckUsr2 = "Usr,02,"
    '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 > 0 Then
                CheckUsr2 = CheckUsr2 & "超出权限！删除管理员失败！"
                Exit Function
            End If
            rsCheck.Close
            Exit For
        End If
    Next i
            
    '2.查看ID是否存在
    DBstr = "select * from User_Info where Usr_ID='" & Replace(UsrID, "'", "''") & "'"
    rsCheck.Open DBstr, DBCnn, adOpenStatic, adLockOptimistic
    If rsCheck.RecordCount < 1 Then   '没有这个ID
        CheckUsr2 = CheckUsr2 & "该管理员不存在！"
        Exit Function
    End If
    '不能删除在线管理员
    For i = 1 To ClMax
        If UsrID = Client(i).UsrID Then
            CheckUsr2 = CheckUsr2 & "不能删除在线管理员！"
            Exit Function
        End If
    Next i
        
    '3.添加到数据库
    SqlStr = "DELETE * FROM User_Info where Usr_ID = '" & Replace(UsrID, "'", "''") & "'"
    DBCnn.Execute SqlStr
    CheckUsr2 = CheckUsr2 & "删除管理员成功！ID：" & UsrID & ","
    
End Function

'*****************************************************************************
'检验查询管理员信息的函数 CheckUsr3
'功能：检验客户端发送来的查询管理员信息，处理数据库后返回信息。
'输入：UsrID，String类型，管理员ID，
'      index，Integer类型，sock通道号。
'输出：CheckUsr1，String类型，返回帧头＋查询结果。
'      响应信息格式：Usr，03，Usr_ID1+Usr_Name1+Usr_Type1，…
'*****************************************************************************
Private Function CheckUsr3(ByVal UsrID As String, ByVal index As Integer) As String
Dim rsCheck As New ADODB.Recordset
Dim DBstr As String
Dim i As Integer
Dim sType As String
    
    CheckUsr3 = "Usr,03"
    '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 > 0 Then
                CheckUsr3 = CheckUsr3 & ",超出权限！查询管理员信息失败！"
                Exit Function
            End If
            rsCheck.Close
            Exit For
        End If
    Next i
            
    '2.返回查询信息
    DBstr = "select * from User_Info where Usr_ID LIKE'%" & Replace(UsrID, "'", "''") & "%'"
    rsCheck.Open DBstr, DBCnn, adOpenStatic, adLockOptimistic
    If rsCheck.RecordCount < 1 Then '管理员不存在
        CheckUsr3 = CheckUsr3 & ",该管理员不存在！查询管理员失败！"
        Exit Function
    End If
    rsCheck.MoveFirst
    For i = 1 To rsCheck.RecordCount
        Select Case rsCheck.Fields("Usr_Type").Value
        Case 0
            sType = "系统管理员"
        Case 1
            sType = "高级管理员"
        Case 2
            sType = "普通管理员"
        End Select
        
        CheckUsr3 = CheckUsr3 & ","
        CheckUsr3 = CheckUsr3 & "管理员ID：" & rsCheck.Fields("Usr_ID").Value
        CheckUsr3 = CheckUsr3 & " 姓名：" & rsCheck.Fields("Usr_Name").Value
        CheckUsr3 = CheckUsr3 & " 类型： " & sType
        
        rsCheck.MoveNext
    Next i
    
    rsCheck.Close
    
End Function

'*****************************************************************************
'检验查询图书借阅次数排行的函数 CheckStat
'功能：检验客户端发送来的查询图书排行信息，读取数据库后按个数返回图书信息。
'输入：StatNum，Integer类型，图书排行个数。
'输出：CheckStat，String类型，返回帧头＋查询结果。
'      响应信息格式：Stat，
'                    Book_Num1+Book_Name1+Book_Author1+Book_Press1+Book_PrsNum1
'                    +Book_PrsDate1+Book_Type1+Book_Available1+Book_Total1，…
'*****************************************************************************
Private Function CheckStat(ByVal StatNum As Integer) As String
Dim rsCheck As New ADODB.Recordset
Dim DBstr As String
Dim i As Integer
Dim sAvailable As String
Dim Num As Integer

    '1.查询结果
    DBstr = "select * from Book_Info order by Book_Total DESC"
    rsCheck.Open DBstr, DBCnn, adOpenStatic, adLockOptimistic
    
    '2.返回响应信息
    CheckStat = "Stat"
    If rsCheck.RecordCount < 1 Then '没有图书
        CheckStat = CheckStat & ",目前没有图书排行信息！"
        Exit Function
    End If
    rsCheck.MoveFirst
    If StatNum > rsCheck.RecordCount Then
        Num = rsCheck.RecordCount
    Else
        Num = StatNum
    End If
    '逐个返回
    For i = 1 To Num
        CheckStat = CheckStat & ","
        CheckStat = CheckStat & "书名：" & rsCheck.Fields("Book_Name").Value
        CheckStat = CheckStat & " 作者：" & rsCheck.Fields("Book_Author").Value
        CheckStat = CheckStat & " " & rsCheck.Fields("Book_Press").Value
        CheckStat = CheckStat & " 版本号" & rsCheck.Fields("Book_PrsNum").Value
        CheckStat = CheckStat & " 出版日期：" & rsCheck.Fields("Book_PrsDate").Value
        CheckStat = CheckStat & " 图书类型：" & rsCheck.Fields("Book_Type").Value
        If rsCheck.Fields("Book_Available").Value Then
            CheckStat = CheckStat & " 在库：是"
        Else
            CheckStat = CheckStat & " 在库：否"
        End If
        CheckStat = CheckStat & " 借阅次数：" & rsCheck.Fields("Book_Total").Value
        rsCheck.MoveNext
    Next i
    
    rsCheck.Close
End Function