mdlsql.bas

学生信息管理系统

Attribute VB_Name = "mdlSQL"
'----------------------------------mdlSQL.bas----------------------------------
Option Explicit

Public blnModifyDoc As Boolean
Public blnModifyClass As Boolean
Public strSQL As String
Public blnFindDoc As Boolean
Public blnFindClass As Boolean
Public UserName As String
Public strUserManage As String

Public Function ExecuteSQL(ByVal strSQL As String) As ADODB.Recordset
'    On Error GoTo ErrorTrap
    
    '声明ADODB.Connection对象变量
    Dim objConnection As ADODB.Connection
    '声明ADODB.Recordset对象变量
    Dim objRecordset As ADODB.Recordset
    '声明一个存放SQL查询条件的数组
    Dim strArray() As String
    
    '定义新连接
    Set objConnection = New ADODB.Connection
    '创建新连接
    objConnection.ConnectionString = ConnectString
    '打开数据库
    objConnection.Open
    
    'Split函数返回一个下标从零开始的一维数组，包含指定数目的子字符串
    strArray = Split(strSQL)
    If InStr("INSER,DELETE,UPDATE", UCase(strArray(0))) Then
        '执行SQL查询
        objConnection.Execute strSQL
    Else
        '打开记录集
        Set objRecordset = New ADODB.Recordset
        objRecordset.Open Trim(strSQL), objConnection, adOpenKeyset, adLockOptimistic
        Set ExecuteSQL = objRecordset
    End If
    
    '释放对象
    Set objRecordset = Nothing
    Set objConnection = Nothing
    Exit Function
    
'出错处理
ErrorTrap:
    Set objRecordset = Nothing
    Set objConnection = Nothing
End Function

'连接字符串赋值函数
Public Function ConnectString() As String
    ConnectString = "provider=Microsoft.Jet.OLEDB.4.0;Data source =" & App.Path & "/StudentsManagement.mdb"
End Function

'用户权限管理
Public Function UserManage(ByVal intUsrClass As Integer) As String
    On Error GoTo ErrorTrap
    
    '声明SQL字符串
    Dim strSQL As String
    '声明ADODB.Connection对象变量
    Dim objConnection As ADODB.Connection
    '声明ADODB.Recordset对象变量
    Dim objRecordset As ADODB.Recordset
    
    '定义新连接
    Set objConnection = New ADODB.Connection
    '创建新连接
    objConnection.ConnectionString = ConnectString
    '打开数据库
    objConnection.Open
    '打开记录集
    Set objRecordset = New ADODB.Recordset
    
    '查询高级用户
    strSQL = "select Administration from Users where UserName='" & UserName & "'"
    objRecordset.Open Trim(strSQL), objConnection, adOpenKeyset, adLockOptimistic
    '如果没查询到当前用户
    If objRecordset.EOF = True Then
        MsgBox "非法用户！", vbExclamation + vbOKOnly, "警告"
        UserManage = "nothing"
        Exit Function
    End If
    '高级用户
    If objRecordset.Fields(0) = "Y" Then
        UserManage = "Administration"
        Exit Function
    End If
    '关闭记录集
    objRecordset.Close
    
    '查询只读用户
    strSQL = "select ReadOnly from Users where UserName='" & UserName & "'"
    objRecordset.Open Trim(strSQL), objConnection, adOpenKeyset, adLockOptimistic
    '只读用户
    If objRecordset.Fields(0) = "Y" Then
        UserManage = "ReadOnly"
        Exit Function
    End If
    
    '普通用户
    Select Case intUsrClass
        '权限
        Case 1
            strSQL = "select Weight1 from Users where UserName='" & UserName & "'"
        Case 2
            strSQL = "select Weight2 from Users where UserName='" & UserName & "'"
        Case 3
            strSQL = "select Weight3 from Users where UserName='" & UserName & "'"
        Case 4
            strSQL = "select Weight4 from Users where UserName='" & UserName & "'"
    End Select
    
    '打开记录集
    Set objRecordset = New ADODB.Recordset
    objRecordset.Open Trim(strSQL), objConnection, adOpenKeyset, adLockOptimistic
    '权限
    If objRecordset.Fields(0) = "Y" Then
        UserManage = "True"
    Else
        UserManage = "False"
    End If
    
    '释放对象
    Set objRecordset = Nothing
    Set objConnection = Nothing
    Exit Function
    
'出错处理
ErrorTrap:
    Set objRecordset = Nothing
    Set objConnection = Nothing
End Function