module1.bas

学生管理系统 很不错的一个课程设计 适合大学生毕业设计用

Attribute VB_Name = "Module1"
Public txtsql As String
Public username As String
Public qxstr As String
Public qxstra As String

'执行相应的SQL命令
Public Function ExecuteSQL(ByVal sql As String) As ADODB.Recordset
    Dim mycon As ADODB.Connection
    Dim rst As ADODB.Recordset
    Set mycon = New ADODB.Connection
    mycon.ConnectionString = connstring
    mycon.Open
    Dim stokens() As String
    On Error GoTo exectuesql_error
    stokens = Split(sql)
    If InStr("INSERT,DELETE,UPDATE", UCase(stokens(0))) Then
        mycon.Execute sql
    Else
        Set rst = New ADODB.Recordset
        rst.Open Trim(sql), mycon, adOpenKeyset, adLockOptimistic
        Set ExecuteSQL = rst
    End If
exectuesql_exit:
    Set rst = Nothing
    Set mycon = Nothing
    Exit Function
exectuesql_error:
    Resume exectuesql_exit
End Function

'连接字符串，用户可以根据自己的数据库进行修改相应参数
Public Function connstring() As String
    connstring = "Provider=SQLOLEDB.1;Persist Security Info=False;UID=sa;PWD=;Initial Catalog=StuMIS;Data Source=(local)"
End Function

'检查用户的权限
Public Function Executeqx(ByVal txt As String) As String
    Dim sql As String
    Dim mycon As ADODB.Connection
    Dim rst As ADODB.Recordset
    Set mycon = New ADODB.Connection
    mycon.ConnectionString = connstring
    mycon.Open
    Set rst = New ADODB.Recordset
    sql = "select 标识 from 用户 where 用户名='" & username & "'"
    rst.Open Trim(sql), mycon, adOpenKeyset, adLockOptimistic
    If rst.EOF = True Then
        MsgBox "非法用户！", vbExclamation + vbOKOnly, "警告"
        Executeqx = "nothing"
        Exit Function
    End If
    If rst.Fields(0) = "1" Then
        Executeqx = "admin"
        Exit Function
    End If
    If rst.Fields(0) = "0" Then
        Executeqx = "readonly"
        Exit Function
    End If
     On Error GoTo exectuesql_error
exectuesql_exit:
    Set rst = Nothing
    Set mycon = Nothing
    Exit Function
exectuesql_error:
    Resume exectuesql_exit

End Function