项目源代码清单.doc

学生信息管理系统详细设计说明书

    Public Sub ShowOk(strOk As String)
        MsgBox strOk, vbOKOnly + vbInformation, STR_TITLE
    End Sub
'
'


'   过程说明：      项目入口函数
'
'   调用方法：      无
'
'   参数说明：      无

Sub Main()
    Dim FrmShow1 As New frmShow
    Dim frmlogin1 As frmLogin
    Dim frmMain1 As frm_Main
    Dim lTime As Long
        
    
    FrmShow1.Show
    lTime = Second(Time) + Minute(Time) * 60
    '装载基本窗体
    FrmShow1.lblWarning.Caption = "正在初始化窗体..." & vbCrLf
    Set frmlogin1 = New frmLogin
    Set frmMain1 = New frm_Main
    FrmShow1.lblWarning.Caption = FrmShow1.lblWarning.Caption & "窗体初始化完毕!" & vbCrLf

    FrmShow1.lblWarning.Caption = FrmShow1.lblWarning.Caption & "系统初始化完毕!" & vbCrLf & _
        "正在登录系统..." & vbCrLf
    Do While (Second(Time) + Minute(Time) * 60 < lTime + 1) '登录画面最少要显示3秒
        DoEvents
    Loop
    Unload FrmShow1
    
    '显示登录窗体
    
    frmlogin1.Show vbModal
    Unload frmlogin1
    
    If AdminCur.IsLogin Then
    '初始化主窗体菜单
        Call InitMainMenu
        frmMain1.Caption = App.ProductName & "  [管理员: " & AdminCur.UserName & "]"
        frmMain1.Show
    End If
    
End Sub

类模块源代码

1.1.9 DbCtrl源代码清单如下：

'保持属性值的局部变量
Private mStrConn As String '局部复制
Private connDb As New Connection
Private Const STR_ASPLIT = "A#Z3$C"


Public Property Get STR_SPLIT() As String
    STR_SPLIT = STR_ASPLIT
End Property
Public Property Let strConn(ByVal vData As String) '写strConn
    mStrConn = vData
End Property


Public Property Get strConn() As String  '读strConn
    strConn = mStrConn
End Property
'
'
    

'   过程说明：      链接到学生信息数据库
'
'   调用方法：      blnValue= LinkDb()
'
'   参数说明：      （无）
'
'   具体代码：
    
Private Function LinkDb() As Boolean
    
    On Error GoTo GetErr
    If mStrConn = "" Then mStrConn = "Driver={SQL Server};uid=sa;pwd=;server=127.0.0.1;database=SIMSData" '连接字串
    connDb.ConnectionTimeout = "5"
    connDb.Open mStrConn
    LinkDb = True
    Exit Function

GetErr:
    LinkDb = False
        
End Function
'
'
    

'   过程说明：      执行数据库操作
'
'   调用方法：      set rsValue = RunSql(strSql as string )
'
'   参数说明：      strSql SQL查询语句
'
'   具体代码：
    
    Public Function RunSql(strSql As String) As Variant
        Dim intBak As Integer
        On Error GoTo GetErr
        If connDb Is Nothing Or connDb = "" Then '自动连接到数据库
                   
            If Not LinkDb() Then
                ShowErr "数据库连接失败！请检查连接字串!点确定退出" & STR_TITLE
                End
            End If
        End If
        strSql = Trim(strSql)
        If Right(UCase(strSql), 5) = "WHERE" Then
            strSql = Left(strSql, Len(strSql) - 5)
        End If
        
     
        If InStr(1, UCase(strSql), "DELETE ") > 0 Or InStr(1, UCase(strSql), "INSERT ") > 0 Or InStr(1, UCase(strSql), "UPDATE ") > 0 Then
             connDb.Execute strSql, intBak
             RunSql = intBak    '返回操作的记录数
        Else
             Set RunSql = connDb.Execute(strSql) '返回获得的记录集
        End If
        
        
 '       Call CloseDb   '关闭数据库
        Exit Function
        
GetErr:
        If Err.Number <> 0 Then
            ShowErr "SQL执行出错!"
            If InStr(1, UCase(strSql), "SELECT") > 0 Then
                Set RunSql = Nothing
            End If
        End If
        
    End Function
'
'

'
'   过程说明：      断开学生信息数据库
'
'   调用方法：      CALL CloseDb()
'
'   参数说明：      （无）
'
'   具体代码：
    
Private Sub CloseDb()
    
    If connDb Is Nothing Then
        Exit Sub
    Else
        Set connDb = Nothing
    End If
        
End Sub
'
'

'
'   过程说明：     将英文字段名显示为对应的中文字段名(返回中文字段名)
'
'   调用方法：      strValue= GetCName(strBak as String )
'
'   参数说明：      StrBak 英文字段名
'
'   具体代码：

Public Function GetCName(strBak As String) As String
    strBak = Trim(UCase(strBak))
    GetCName = ""
    If InStr(strBak, "STD") Then GetCName = "学生"
    If InStr(strBak, "STU") Then GetCName = "学生"
    If InStr(strBak, "QQ") Then GetCName = GetCName & "QQ号码"
    If InStr(strBak, "ADDR") Then GetCName = GetCName & "地址"
    If InStr(strBak, "NAME") Then GetCName = GetCName & "名字"
    If InStr(strBak, "SEX") Then GetCName = GetCName & "性别"
    If InStr(strBak, "PHONE") Then GetCName = GetCName & "电话"
    If InStr(strBak, "CLASS") Then GetCName = GetCName & "班级"
    If InStr(strBak, "NO") Then GetCName = GetCName & "学号"
    If InStr(strBak, "PASSWORD") Then GetCName = GetCName & "密码"
    If InStr(strBak, "POWER") Then GetCName = GetCName & "权限"
    If InStr(strBak, "QUESTION") Then GetCName = GetCName & "问题"
    If InStr(strBak, "ANSWER") Then GetCName = GetCName & "答案"
    If InStr(strBak, "MATH") Then GetCName = GetCName & "数学"
    If InStr(strBak, "CJ") Then GetCName = GetCName & "成绩"
    If GetCName = "" Or GetCName = "学生" Then GetCName = strBak
End Function
'
'

'
'   过程说明：      获得执行语句的表名
'
'   调用方法：      strValue= GetTable(strCmd as String )
'
'   参数说明：      StrCmd SQL语句
'
'   具体代码：

Public Function GetTable(strCmd As String) As String
    On Error GoTo GetErr
    Dim strBak() As String
    Dim inkBak As Integer
    Getable = ""
    strBak = Split(Trim(strCmd), " ")
    For intBak = 0 To UBound(strBak)
        If UCase(strBak(intBak)) = "FROM" Then Exit For
    Next intBak
    If intBak < UBound(strBak) Then
        GetTable = strBak(intBak + 1)
    End If
GetErr:
End Function
'
'

'   函数说明：      检测strCheck是否安全验证串:如果安全返回true,否则返回false
'
'   调用方法：       value = ShowErr(strCheck)
'
'   返回类型：       Boolean
'
'   参数说明：
'
'       strCheck        ──    待检测的字符串
'
'   具体代码：

Public Function IsSafeCode(strCheck As String) As Boolean
    Dim strSafe As String
    Dim i As Integer
    strSafe = "=<>':+-*&%$#^:;|-/" & Chr(34)
    IsSafeCode = True
    For i = 1 To Len(strSafe)
        If InStr(1, strCheck, Mid(strSafe, i, 1)) > 0 Then
            IsSafeCode = False
            Exit Function
        End If
    Next i
End Function
'
'

Private Sub Class_Terminate()
    Call CloseDb
End Sub


用户控件源代码

1.1.10 ConDbAdMg源代码清单如下：

Option Explicit

Private strSearchCmd As String
Private dbCtrlObj As DbCtrl
Private Type MdfyMsg
    isMdfing As Boolean '是否正在修改
    id As String   '当前修改的信息ID，为空就是添加
    Row As Integer '当前修改的行
    MdfOldData As String '当前修改的值
End Type
Private MdfyInf As MdfyMsg


Private Type dbSrc
    tableName As String             '操作数据表名
    Fields As String                '查询的字段(用,隔开)
    KeyName As String               '表的主键
    keyVal As Variant               '主键的值
End Type
Private dbSrc As dbSrc
'

Public Sub Init(dbctrl1 As DbCtrl, strSql As String, strTitle As String)
    Set dbCtrlObj = dbctrl1
    dbSrc.tableName = dbCtrlObj.GetTable(strSql)                                  '获取操作对象(表)
    If dbSrc.tableName = "" Then
        MsgBox "控件参数有误", vbCritical + vbOKOnly
    End If
    strSearchCmd = strSql
    FrushFramCdn (Replace(UCase(strSql), "SELECT ", "Select top 1 "))   '生成字段名及相应的修改文本框
    FrushFgrid (strSql)                                                 '刷新表格
    lblTitle = strTitle
End Sub

Private Sub FrushFramCdn(strCmd As String)
    Dim rs As Recordset
    Dim intBak As Integer
    Set rs = dbCtrlObj.RunSql(strCmd)
    dbSrc.Fields = ""
    dbSrc.KeyName = rs.Fields(0).Name   '获取关键字段:第一个
    intBak = 0
    For intBak = 0 To rs.Fields.Count - 1
        dbSrc.Fields = dbSrc.Fields & rs.Fields(intBak).Name & ","       '获取字段列表
        If lblcdn.Count <= intBak Then Load lblcdn(intBak)
        If txtCdn.Count <= intBak Then Load txtCdn(intBak)
        If intBak <> rs.Fields.Count - 1 Then
            If chkOperate.Count <= intBak Then Load chkOperate(intBak)
        End If
        
        lblcdn(intBak).Left = lblcdn(0).Left
        lblcdn(intBak).Top = lblcdn(0).Top + (lblcdn(0).Height + 200) * intBak
        txtCdn(intBak).Left = txtCdn(intBak).Left
        txtCdn(intBak).Top = lblcdn(intBak).Top
        If intBak <> rs.Fields.Count - 1 Then
            chkOperate(intBak).Left = chkOperate(0).Left
            chkOperate(intBak).Top = txtCdn(intBak).Top
        End If
        lblcdn(intBak) = dbCtrlObj.GetCName(rs.Fields(intBak).Name)
        Select Case rs.Fields(intBak).Type
            Case adTinyInt, adSmallInt, adInteger, adBigInt, adUnsignedTinyInt, adUnsignedSmallInt, adUnsignedInt, adUnsignedBigInt, adSingle, adDouble, adNumeric
                lblcdn(intBak) = lblcdn(intBak) & "(数值)"
            Case adBoolean
                lblcdn(intBak) = lblcdn(intBak) & "(逻辑)"
            Case adWChar, adLongVarChar, adChar, adVarChar, adLongVarWChar, adBSTR, 202
                lblcdn(intBak) = lblcdn(intBak) & "(字串)"
            Case adDBDate, adDBTime, adDBTimeStamp, adFileTime
                lblcdn(intBak) = lblcdn(intBak) & "(日期)"
                
        End Select
        txtCdn(intBak).Visible = True
        lblcdn(intBak).Visible = True
        If intBak <> rs.Fields.Count - 1 Then
            chkOperate(intBak).Visible = True
        End If
    Next intBak
    rs.Close
    dbSrc.Fields = Left(dbSrc.Fields, Len(dbSrc.Fields) - 1)
    Set rs = Nothing
    
    
End Sub
Private Sub FrushFgrid(strCmd As String)
    Dim rs As Recordset
    Dim intcount As Integer
    Dim intBak As Integer
    Set rs = dbCtrlObj.RunSql(strCmd)
    txtInput.Visible = False
    
    With FgdData
        .Rows = 2
        .Clear
        .Cols = rs.Fields.Count + 1