funcommon.bas

VB+access学生信息管理系统,基本完成了学生信息的添加,修改,打印,查询功能.大家互相学习吧.

Attribute VB_Name = "FunCommon"
Option Explicit

'数据库文件路径
Public StudentDBfile As String
'保存用户权限（是否为超级用户）
Public bolAuthority As Boolean

'>>执行SQL命令,参数为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 = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _
                             & StudentDBfile & ";Persist Security Info=False"
    mycon.Open '打开连接(连接数据源)
    If mycon Is Nothing Then
        MsgBox "连接失败，请你检查数据库路径！"
    End If
    Dim sArray() As String
    On Error GoTo executesql_error
    sArray = Split(sql)
    If InStr("INSERT,DELETE,UPDATE", UCase(sArray(0))) Then
          mycon.Execute sql
    Else
      Set rst = New ADODB.Recordset
      rst.Open sql, mycon, adOpenKeyset, adLockOptimistic '打开记录集对象
      Set ExecuteSQL = rst
    End If
executesql_exit:
      Set rst = Nothing
      Set mycon = Nothing
      Exit Function
executesql_error:
      Resume executesql_exit
End Function

'>>空 Null 转换函数
Public Function TransNull(RsField As Field) As Variant
    On Error Resume Next
    If IsNull(RsField.Value) Then
      Select Case RsField.Type
      Case adBoolean
        TransNull = False
      Case adDate, adChar
        TransNull = ""
      Case adInteger, adCurrency, adSingle, adDouble
        TransNull = 0
      Case Else
        TransNull = 0
      End Select
    Else
      TransNull = RsField.Value
    End If
End Function

'>>置窗体于屏幕中心
Public Sub ScreenCenter(fm As Form)
Dim mt!, ml!
With fm
    mt = (Screen.Height - .Height) * 0.5
    ml = (Screen.Width - .Width) * 0.5
    .Move ml, mt
End With
End Sub

'>>MDI子窗口中心定位
Public Sub CenterPos(parentfm As Form, childfm As Form)
With childfm
    .Top = (parentfm.ScaleHeight - .Height) * 0.5
    .Left = (parentfm.ScaleWidth - .Width) * 0.5
End With
End Sub

'>>关闭所有MDI子窗体
Public Function unloadChildForm() As Boolean
Dim i%
    unloadChildForm = True
    'Forms 集合的元素代表每一个在应用程序中加载的窗体。包括MDI窗体,MDI子窗体和非MDI窗体
    'Forms 集合只有一个属性Count，指定集合中元素的数目。
    If Forms.Count <= 1 Then Exit Function
    For i = Forms.Count - 1 To 1 Step -1
        Unload Forms(i)
    Next i
    If Forms.Count > 1 Then unloadChildForm = False
End Function


'>>显示的错误提示信息
Public Sub ShowDbRuleErrInf(sName As String)
    Select Case Err.Number
    Case -2147467259      '违背主关键字唯一性和非空性的规则时
        MsgBox sName & "不能出现重复值或空值！", vbCritical, "错误提示"
    End Select
End Sub

'>>删空记录集
Public Sub DBRecordset_Delete(rs As Recordset)
    If rs.RecordCount = 0 Then Exit Sub
    rs.MoveFirst
    Do While rs.RecordCount > 0
        rs.Delete
        rs.MoveNext
    Loop
End Sub

'>>初始化菜单和工具条
Public Sub InitMenuAndToolbars(bEn As Boolean)
Dim i%
With StudentMIS
    .mOpe.Enabled = bEn
    .mOpe_CreTable.Enabled = False
    For i = 1 To .Toolbar1.Buttons.Count
        .Toolbar1.Buttons(i).Enabled = bEn
    Next i
    .Toolbar1.Buttons("New").Enabled = False
    '为一般用户设置访问权限
    If Not bolAuthority Then .mSys_User.Enabled = False
End With
End Sub

'>>填充组合框
Public Sub ADDComboListRS(mbox As Object, rs As Recordset, AllEnable As Boolean, _
                   fld1Name As String, Optional fld2Name, Optional fld3Name)
'fld1Name为要添加到ComboBox控件中的记录集字段名
'fld2Name为可选字段名，存在时将该字段作为fld1Name字段的附加信息
Dim i%
    mbox.Clear
    If AllEnable = True Then
        mbox.AddItem "全部"
    End If
    If rs.RecordCount > 0 Then
    For i = 1 To rs.RecordCount
        If IsMissing(fld2Name) Then
            mbox.AddItem rs(fld1Name)
        Else
            If IsMissing(fld3Name) Then
                mbox.AddItem rs(fld1Name) & " " & rs(fld2Name)
            Else
                mbox.AddItem rs(fld1Name) & " " & rs(fld2Name) & " " & rs(fld3Name)
            End If
        End If
        rs.MoveNext
    Next i
    End If
    If mbox.ListCount > 0 Then mbox.ListIndex = 0
End Sub

'>>构造学生表查询SQL语句
Public Function CreateSqlStu(sql$, Optional snj, Optional sxy, Optional szy, _
                             Optional sbj) As String
'说明：like为模糊查询，"_"代表任意一个单字符,"%"代表任意多个字符
Dim qrySql$
    qrySql = sql
    '判别年级参数snj
    If Not IsMissing(snj) Then
        qrySql = qrySql & " where " & "number like '" & snj & "________'"
    End If
    '判别学院参数sxy
    If Not IsMissing(sxy) Then
        If InStr(1, qrySql, "where") Then
            qrySql = qrySql & " and " & "number like '____" & sxy & "______'"
        Else
            qrySql = qrySql & " where " & "number like '____" & sxy & "______'"
        End If
    End If
    '判别专业参数szy
    If Not IsMissing(szy) Then
        If InStr(1, qrySql, "where") Then
            qrySql = qrySql & " and " & "number like '____" & szy & "____'"
        Else
            qrySql = qrySql & " where " & "number like '____" & szy & "____'"
        End If
    End If
    '判别班级参数sbj
    If Not IsMissing(sbj) Then
        If InStr(1, qrySql, "where") Then
            qrySql = qrySql & " and " & "number like '________" & sbj & "__'"
        Else
            qrySql = qrySql & " where " & "number like '________" & sbj & "__'"
        End If
    End If
    qrySql = qrySql & " order by number asc"
    CreateSqlStu = qrySql
End Function

'>>构造课程表查询SQL语句
Public Function CreateSqlLes(sql$, Optional sxy, Optional szy, Optional sxq, _
                             Optional sty) As String
Dim qrySql$
    qrySql = sql
    '判别学院参数
    If Not IsMissing(sxy) Then
        qrySql = qrySql & " where " & "institute_id ='" & sxy & "'"
    End If
    '判别专业参数
    If Not IsMissing(szy) Then
        If InStr(1, qrySql, "where") Then
            qrySql = qrySql & " and " & "institute_id='" & Left(szy, 2) & "'" & _
                     " and major_id='" & Right(szy, 2) & "'"
        Else
            qrySql = qrySql & " where " & "institute_id='" & Left(szy, 2) & "'" & _
                     " and major_id='" & Right(szy, 2) & "'"
        End If
    End If
    '判别学期参数
    If Not IsMissing(sxq) Then
        If InStr(1, qrySql, "where") Then
            qrySql = qrySql & " and " & "term='" & sxq & "'"
        Else
            qrySql = qrySql & " where " & "term='" & sxq & "'"
        End If
    End If
    '判别课程性质参数
    If Not IsMissing(sty) Then
        If InStr(1, qrySql, "where") Then
            qrySql = qrySql & " and " & "lesson_type='" & sty & "'"
        Else
            qrySql = qrySql & " where " & "lesson_type='" & sty & "'"
        End If
    End If
    qrySql = qrySql & " order by institute_id,major_id asc"
    CreateSqlLes = qrySql
End Function