教育系统应用

开发平台：

Visual Basic

Module1.bas：源码内容

							Attribute VB_Name = "Module1"
Public modi As Boolean
Public classmodi As Boolean
Public xuefeimodi As Boolean
Public txtsql As String
Public find As Boolean
Public classfind As Boolean
Public xuefeifind As Boolean
Public username As String
Public qxstr As String
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("INSER,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=Microsoft.Jet.OLEDB.4.0;Data source =" & App.Path & "/xs.mdb"
End Function
Public Function Executeqx(ByVal txt As Integer) 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 admin from use where username='" & 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) = "y" Then
  Executeqx = "admin"
  Exit Function
End If
rst.Close
 sql = "select readonly from use where username='" & username & "'"
 rst.Open Trim(sql), mycon, adOpenKeyset, adLockOptimistic
  If rst.Fields(0) = "y" Then
  Executeqx = "readonly"
  Exit Function
End If
Select Case txt
  Case 1
  sql = "select qx1 from use where username='" & username & "'"
  Case 2
  sql = "select qx2 from use where username='" & username & "'"
  Case 3
  sql = "select qx3 from use where username='" & username & "'"
  Case 4
  sql = "select qx4 from use where username='" & username & "'"
End Select
On Error GoTo exectuesql_error
  Set rst = New ADODB.Recordset
  rst.Open Trim(sql), mycon, adOpenKeyset, adLockOptimistic
  If rst.Fields(0) = "y" Then
    Executeqx = "true"
  Else
    Executeqx = "false"
  End If
exectuesql_exit:
  Set rst = Nothing
  Set mycon = Nothing
  Exit Function
exectuesql_error:
  Resume exectuesql_exit
End Function

						