module1.bas

实现学生选课功能

Attribute VB_Name = "Module1"
Option Explicit
Public con As ADODB.Connection
Public UserName As String
Public OldPassword As String
Public Right1 As String
Public ConnectionString As String
Global Const GS_DATABASE_FILENAME As String = "data\stu.mdb" '数据库名
Public id As String
Public DiskFile As String
Public Pos As Integer
Public Sub Main()
    If ConnectDatabase = True Then
        Dim loginfrm As New login_frm
        loginfrm.Show vbModal
        If loginfrm.ok = False Then
            con.Close
            End
        End If
        Unload loginfrm
        MDIForm1.Show
    Else
        End
    End If
End Sub
Public Function ConnectDatabase() As Boolean
    'ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\" & GS_DATABASE_FILENAME
    ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=stu;Data Source=localhost"
    Set con = New ADODB.Connection
    con.ConnectionString = ConnectionString
    con.CursorLocation = adUseClient
    con.CommandTimeout = 500
On Error GoTo error_proc
    If con.State = 0 Then
        con.Open
        ConnectDatabase = True
        Exit Function
    End If
error_proc:
    If Err.Number = -2147467259 Then
        MsgBox "找不到数据库,请检查网络配置或打开数据库服务器", vbExclamation, "错误"
    Else
        MsgBox "未知错误:" & Err.Description, vbExclamation, "错误"
    End If
    ConnectDatabase = False
    
End Function

Function makesqlstr(ByVal str As String) As String

    makesqlstr = Replace(str, "'", "''")

End Function

'执行 SQL 并且返回 Recordset
Public Function ExecuteSQL(ByVal sql As String, MsgString As String) As ADODB.Recordset

    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim sTokens() As String
   
On Error GoTo ExecuteSQL_Error
   
    sTokens = Split(sql)
   
    Set cnn = New ADODB.Connection
    cnn.ConnectionString = ConnectionString
    cnn.Open
    If InStr("INSERT,DELETE,UPDATE", UCase$(sTokens(0))) Then
        cnn.Execute sql
        MsgString = sTokens(0) & " 操作成功"
    Else
        Set rst = New ADODB.Recordset
        rst.CursorLocation = adUseClient
        rst.Open Trim$(sql), cnn, adOpenKeyset, adLockOptimistic
        Set ExecuteSQL = rst
        MsgString = "查询到" & rst.RecordCount & " 条记录 "
    End If
ExecuteSQL_Exit:
    Set rst = Nothing
    Set cnn = Nothing
    Exit Function
   
ExecuteSQL_Error:
    MsgString = "查询错误: " & Err.Description
    Resume ExecuteSQL_Exit
End Function