项目源代码清单.doc

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

            End If
            
            Call TxtMove
            txtInput.SetFocus
            SendKeys ("{HOME}+{END}")
        End If
    End With
End Sub


1.1.11 ConRs源代码清单如下：

Option Explicit

Public Enum Operation
    Add = 1
    Modify = 2
    Delete = 3
    Search = 4
End Enum

Private intRowHeight As Integer     '字段之间的间隔
Public dbCtrlObj As DbCtrl          '数据库控制对象，用于执行指定的ＳＱＬ语句
Public strSelect As String          '数据库查询语句
Private Type dbSrc
    tableName As String             '操作数据表名
    Fields As String                '查询的字段(用,隔开)
    KeyName As String               '表的主键
    keyVal As Variant               '主键的值
End Type
Private Type RsData
    Count As Integer                '记录数
    IP    As Integer                '当前指针
    RowData() As String             '记录行集
    ColData() As String             '记录列集
End Type

Public Operat As Operation
Private dbSrc As dbSrc
Private RsData As RsData

Public Property Get title() As String
    title = lblTitle.Caption
End Property

Public Property Let title(strData As String)
    lblTitle.Caption = strData
End Property


Public Sub Init(dbctrl1 As DbCtrl, strSel As String)
    Set dbCtrlObj = dbctrl1
    dbSrc.tableName = dbCtrlObj.GetTable(strSel)
    If dbSrc.tableName = "" Then
        MsgBox "控件参数有误", vbCritical + vbOKOnly
    End If
    strSelect = strSel
    FrushAll
End Sub

Public Sub FrushMe()
    Dim intBak As Integer
    If RsData.Count > 0 Then
        If RsData.IP >= RsData.Count Then RsData.IP = RsData.Count - 1
        RsData.RowData(RsData.IP) = Replace(RsData.RowData(RsData.IP), dbCtrlObj.STR_SPLIT, "'")  '将'替换回来
        RsData.ColData = Split(RsData.RowData(RsData.IP), "%99%te%ch%")
        For intBak = 0 To txtCdn.Count - 1
            txtCdn(intBak).Text = Trim(RsData.ColData(intBak))
        Next intBak
        lblMsg.Caption = "共有" & RsData.Count & "条记录,当前记录:第" & Str(RsData.IP + 1) & "条"
    Else
        For intBak = 0 To txtCdn.Count - 1
            txtCdn(intBak).Text = ""
        Next intBak
        lblMsg.Caption = "没有发现记录!"
    End If
    If RsData.Count > 0 Then
        dbSrc.keyVal = Trim(RsData.ColData(0))
    Else
        dbSrc.keyVal = Empty
    End If
    
    If InStr(1, lblCdn(0), "(字串)") > 0 Then
        dbSrc.keyVal = "'" & dbSrc.keyVal & "'"
    End If
    
    
    
End Sub
Public Sub FrushAll()
    Dim rs As Recordset
    Dim intBak As Integer
    Dim StrRsData As String
    Set rs = dbCtrlObj.RunSql(strSelect)
    intRowHeight = 250
    
    If Not rs.EOF Then
        StrRsData = rs.GetString(adClipString, , "%99%te%ch%", "%9%9%t%e%c%h%")
        RsData.RowData = Split(StrRsData, "%9%9%t%e%c%h%")
        RsData.Count = UBound(RsData.RowData)
        If RsData.IP >= RsData.Count Then
            RsData.IP = RsData.Count - 1
        End If
        RsData.ColData = Split(RsData.RowData(RsData.IP), "%99%te%ch%")
    Else
        StrRsData = ""
        RsData.Count = 0
        RsData.IP = 0
    End If
    
    intBak = 0
    dbSrc.Fields = ""
    For intBak = 0 To rs.Fields.Count - 1
        If lblCdn.Count <= intBak Then Load lblCdn(intBak)
        If txtCdn.Count <= intBak Then Load txtCdn(intBak)
        lblCdn(intBak).Left = lblCdn(0).Left
        lblCdn(intBak).Top = lblCdn(0).Top + (lblCdn(0).Height + intRowHeight) * intBak
        txtCdn(intBak).Left = txtCdn(intBak).Left
        txtCdn(intBak).Top = lblCdn(intBak).Top
        txtCdn(intBak).TabIndex = intBak
        lblCdn(intBak) = dbCtrlObj.GetCName(rs.Fields(intBak).Name)
        dbSrc.Fields = dbSrc.Fields & 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
    Next intBak
    rs.Close
    dbSrc.Fields = Left(dbSrc.Fields, Len(dbSrc.Fields) - 1)
    Dim intTop As Integer
    intTop = lblCdn(0).Top + (lblCdn(0).Height + intRowHeight) * intBak
    For intBak = 0 To 3
        btnPg(intBak).Top = intTop
        btnPg(intBak).TabIndex = txtCdn.Count + intBak
    Next intBak
    lblMsg.Top = (lblCdn(0).Height + intRowHeight) + intTop
    Select Case Operat
        Case Add
            btnClk(0).Caption = "添加"
            'TxtClear
        Case Modify
        btnClk(0).Caption = "修改"
        Case Delete
            btnClk(0).Caption = "删除"
        Case Search
            btnClk(0).Caption = "查询"
            chkBlur.Top = btnPg(0).Top
            chkOr.Top = btnPg(0).Top
            chkOr.Visible = True
            chkBlur.Visible = True
    End Select
    btnClk(0).Visible = True
    btnClk(0).Top = lblMsg.Top + lblMsg.Height + intRowHeight
    
    If btnClk.Count < 2 Then Load btnClk(1)
    btnClk(1).Caption = "清除"
    
    btnClk(1).Top = btnClk(0).Top
    btnClk(1).Left = btnClk(0).Left + btnClk(0).Width + intRowHeight
    btnClk(1).Visible = True
    btnClk(1).Default = False
    btnClk(0).Default = True
    UserControl.Height = btnClk(1).Top + btnClk(1).Height + intRowHeight
    dbSrc.KeyName = rs.Fields(0).Name    '主键
    Set rs = Nothing
    FrushMe

    
End Sub


Private Sub btnClk_Click(Index As Integer)
    Select Case Index
        Case 0   '具体操作
            ProessData
        Case 1
            Call TxtClear
    End Select
End Sub
Private Sub TxtClear()
    Dim intBak As Integer
    For intBak = 0 To txtCdn.Count - 1
        txtCdn(intBak).Text = ""
    Next intBak
End Sub

Private Sub btnPg_Click(Index As Integer)
    If RsData.Count = 0 Then
        Exit Sub
    End If

    Select Case Index
        Case 0
            RsData.IP = 0
        Case 1
            If RsData.IP > 0 Then
                RsData.IP = RsData.IP - 1
            End If
        Case 2
            If RsData.IP < RsData.Count - 1 Then
                RsData.IP = RsData.IP + 1
            End If
        Case 3
            RsData.IP = RsData.Count - 1
    End Select
    FrushMe
End Sub

Private Sub txtCdn_click(Index As Integer)
    SendKeys "{Home}+{End}"
End Sub

Private Sub ProessData()
    Dim strCmd As String
    Dim intBak As Integer
    Dim Fields() As String
    Dim strIf As String
    strIf = " where " & dbSrc.KeyName & "=" & dbSrc.keyVal
    
    Fields = Split(dbSrc.Fields, ",")
    Select Case Operat
        Case Add
            If Trim(txtCdn(0)) = "" Then
                ShowErr "关键字段不能为空!"
                Exit Sub
            End If
            strCmd = "insert into [" & dbSrc.tableName & "] (" & dbSrc.Fields & ") values("
            For intBak = 0 To txtCdn.Count - 1 '添加
                If InStr(1, lblCdn(intBak), "(字串)") > 0 Then
                    strCmd = strCmd & "'" & Replace(txtCdn(intBak), "'", dbCtrlObj.STR_SPLIT) & "',"  '如果有'换掉里面的'
                Else
                    strCmd = strCmd & Trim(txtCdn(intBak)) & " ,"
                End If
            Next intBak
            strCmd = Mid(strCmd, 1, Len(strCmd) - 1)
            strCmd = strCmd & ")"
            If dbCtrlObj.RunSql(strCmd) <> 0 Then
                ShowOk "添加成功!"
            Else
                ShowErr "添加失败!"
            End If
            
        Case Delete
            strCmd = "delete " & dbSrc.tableName & strIf
            If dbCtrlObj.RunSql(strCmd) <> 0 Then
                ShowOk "删除成功!"
            Else
                ShowErr "删除失败!"
            End If
        Case Modify
            strCmd = "update [" & dbSrc.tableName & "] set "
            For intBak = 0 To txtCdn.Count - 1 '修改
                strCmd = strCmd & Fields(intBak) & "="
                If InStr(1, lblCdn(intBak), "(字串)") > 0 Then
                   txtCdn(intBak) = Replace(txtCdn(intBak), "'", dbCtrlObj.STR_SPLIT) '如果存在'则换
                   strCmd = strCmd & "'" & Trim(txtCdn(intBak)) & "',"
                Else
                    strCmd = strCmd & Trim(txtCdn(intBak)) & " ,"
                End If
            Next intBak
            strCmd = Mid(strCmd, 1, Len(strCmd) - 1)
            strCmd = strCmd & strIf
            If dbCtrlObj.RunSql(strCmd) <> 0 Then
                ShowOk "修改成功!"
            Else
                ShowErr "修改失败!"
            End If
        Case Search
            Dim strSearch As String
            strSearch = ""
            For intBak = 0 To txtCdn.Count - 1
            '字段条件
                If Trim(txtCdn(intBak)) <> "" Then
                    strSearch = strSearch & " (" & Fields(intBak) & " "
                    If InStr(1, lblCdn(intBak), "(字串)") Then '如果是字串
                        If InStr(1, txtCdn(intBak), "'") Then '如果是标准的SQL语句则直接连接
                            strSearch = strSearch & txtCdn(intBak)
                        Else
                            If chkBlur.Value Then  '如果选择模糊
                                strSearch = strSearch & "LIKE '%" & txtCdn(intBak) & "%'"
                            Else
                                If dbCtrlObj.IsSafeCode(txtCdn(intBak)) Then '是否含有SQL符号
                                    strSearch = strSearch & "='" & txtCdn(intBak) & "'"
                                Else
                                    strSearch = strSearch & txtCdn(intBak)
                                End If
                            End If
                        End If
                        strSearch = strSearch & ")"
                    Else  '为其它类型
                        If chkBlur.Value Then  '如果选择模糊
                            strSearch = strSearch & "LIKE '%" & txtCdn(intBak) & "%'"
                        Else
                                If dbCtrlObj.IsSafeCode(txtCdn(intBak)) Then '是否含有SQL符号
                                    strSearch = strSearch & "=" & txtCdn(intBak)
                                Else
                                    strSearch = strSearch & txtCdn(intBak)
                                End If
                        End If
                        strSearch = strSearch & ")"
                    End If
                    '与或条件
                    If chkOr.Value Then
                        strSearch = strSearch & " OR"
                    Else
                        strSearch = strSearch & " AND"
                    End If
                End If
            Next intBak
            If Right(strSearch, 2) = "OR" Then strSearch = Mid(strSearch, 1, Len(strSearch) - 2)
            If Right(strSearch, 3) = "AND" Then strSearch = Mid(strSearch, 1, Len(strSearch) - 3)
            If strSearch <> "" Then
                strSelect = "SELECT " & dbSrc.Fields & " from " & dbSrc.tableName & " Where " & strSearch
            Else
                strSelect = "SELECT " & dbSrc.Fields & " from " & dbSrc.tableName
            End If
    End Select
    FrushAll
    
End Sub

Private Sub ShowErr(strErr As String)
    MsgBox strErr, vbOKOnly + vbCritical, "错误"
End Sub
Private Sub ShowOk(strOk As String)
    MsgBox strOk, vbOKOnly + vbInformation, "信息"
End Sub



Private Sub txtCdn_KeyPress(Index As Integer, KeyAscii As Integer)

    If InStr(1, lblCdn(Index), "(数值)") > 0 Then
        If InStr(1, ".><=+-1234567890", Chr(KeyAscii)) > 0 Then
            Exit Sub
        Else
            KeyAscii = 0
        End If
    End If
End Sub

Private Sub UserControl_Initialize()

End Sub