module1.bas

来自「源码+论文 vB+access的毕业设计,请大家参考」· BAS 代码 · 共 95 行

Attribute VB_Name = "Module1"
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
       MsgString = sTokens(0) & " query successful"
Else
  Set rst = New ADODB.Recordset
  rst.Open Trim(sql), mycon, adOpenKeyset, adLockOptimistic
 Set ExecuteSQL = rst
 MsgString = "查询到" & rst.RecordCount & " 条记录 "
End If
exectuesql_exit:
  Set rst = Nothing
  Set mycon = Nothing
  Exit Function
exectuesql_error:
MsgString = "查询错误: " & Err.Description
  Resume exectuesql_exit
  
End Function


Public Function connstring() As String
connstring = "provider=Microsoft.Jet.OLEDB.4.0;Data source =" & App.Path & "/Student.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