📄 项目源代码清单.doc
字号:
目 录
I. 窗体源代码 1
1.1.1 Frm_Main 源代码清单如下： 1
1.1.2 FrmAdMg源代码清单如下: 2
1.1.3 FrmGetPwd源代码清单如下： 3
1.1.4 FrmLogin源代码清单如下： 3
1.1.5 Frmmg源代码清单如下： 3
1.1.6 FrmShow源代码清单如下： 3
II. 模块源代码 4
1.1.7 mdlMenu源代码清单如下： 4
1.1.8 MdlPublic源代码清单如下： 8
III. 类模块源代码 11
1.1.9 DbCtrl源代码清单如下： 11
IV. 用户控件源代码 16
1.1.10 ConDbAdMg源代码清单如下： 16
1.1.11 ConRs源代码清单如下： 27
窗体源代码
1.1.1 Frm_Main 源代码清单如下：
Option Explicit
Private Sub Form_Load()
Init
End Sub
Public Sub Init()
Dim intBak As Integer
For intBak = 0 To UBound(MdlItem)
If lblMg.Count <= intBak Then Load lblMg(intBak)
lblMg(intBak) = MdlItem(intBak).mdlName
lblMg(intBak).Top = lblMg(0).Top + (lblMg(0).Height + 200) * intBak
lblMg(intBak).Visible = True
Next intBak
frm_Main.Refresh
lblMg_MouseDown 0, 0, 0, 0, 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
Cancel = True
End Sub
Private Sub lblExit_Click()
End
End Sub
Public Sub lblMg_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim intBak As Integer
For intBak = 0 To lblMg.Count - 1
lblMg(intBak).Font.Size = 10.5
lblMg(intBak).ForeColor = &HFFFFFF
Next intBak
lblMg(Index).Font.Size = 11
lblMg(Index).ForeColor = &H1FFFF
Call ShowMenu(Index, lstv1)
End Sub
Private Sub lstv1_DblClick()
If lstv1.SelectedItem.Index = -1 Then Exit Sub
Call RunMenu(Trim(lstv1.SelectedItem.Text))
End Sub
1.1.2 FrmAdMg源代码清单如下:
ConDbAdMg1.Init dbCtrlAll, strSql, strTitle
Me.Caption = strTitle
End Sub
1.1.3 FrmGetPwd源代码清单如下：
Public Sub Init(strSql As String, strTitle As String)
ConDbAdMg1.Init dbCtrlAll, strSql, strTitle
Me.Caption = strTitle
End Sub
1.1.4 FrmLogin源代码清单如下：
Public Sub Init(strSql As String, strTitle As String)
ConDbAdMg1.Init dbCtrlAll, strSql, strTitle
Me.Caption = strTitle
End Sub
1.1.5 Frmmg源代码清单如下：
Public Sub Init(operatBak As Operation, strSql As String, strTitle As String)
ConRs1.Operat = operatBak
ConRs1.Init dbCtrlAll, strSql
Me.Height = ConRs1.Height + ConRs1.Top + 800
ConRs1.title = strTitle
Me.Caption = ConRs1.title
End Sub
1.1.6 FrmShow源代码清单如下：
Public Sub Init(operatBak As Operation, strSql As String, strTitle As String)
ConRs1.Operat = operatBak
ConRs1.Init dbCtrlAll, strSql
Me.Height = ConRs1.Height + ConRs1.Top + 800
ConRs1.title = strTitle
Me.Caption = ConRs1.title
End Sub
V.
模块源代码
1.1.7 mdlMenu源代码清单如下：
Public Type MdlItems
mdlName As String
OprateIco() As String
OprateName() As String
CreateTable() As String
mdlCmd As String
mdlTable As String
End Type
Public MdlItem() As MdlItems
Public intCurMenu As Integer
'
'初始化主窗体菜单
Public Sub InitMainMenu()
Dim rs As Recordset
Set rs = dbCtrlAll.RunSql("select * from module order by 模块排序")
bak = rs.GetRows
Set rs = Nothing
ReDim MdlItem(UBound(bak, 2))
Dim intBak As Integer
For intBak = 0 To UBound(bak, 2)
MdlItem(intBak).mdlName = bak(0, intBak)
MdlItem(intBak).OprateName = Split(bak(1, intBak), "|")
MdlItem(intBak).OprateIco = Split(bak(2, intBak), "|")
MdlItem(intBak).mdlTable = bak(3, intBak)
MdlItem(intBak).mdlCmd = bak(4, intBak)
MdlItem(intBak).CreateTable = Split(bak(6, intBak), "|")
Next intBak
End Sub
'显示当前菜单项目
Public Sub ShowMenu(intIndex As Integer, lstv1 As ListView)
Dim intBak As Integer
lstv1.ListItems.Clear
For intBak = 0 To UBound(MdlItem(intIndex).OprateName) '显示菜单操作项目
lstv1.ListItems.Add , , MdlItem(intIndex).OprateName(intBak), Trim(MdlItem(intIndex).OprateIco(intBak))
Next intBak
intCurMenu = intIndex
End Sub
'
'
'
'执行菜单操作
Public Sub RunMenu(strCmd As String)
On Error Resume Next
Dim frmMg1 As frmMg
Dim frmlogin1 As New frmLogin
Dim frmBak As frm_Main
Dim frmAdMg1 As frmAdMg
If InStr(1, strCmd, "查询") > 0 Then
Set frmMg1 = GetFrm("frmMg")
If frmMg1 Is Nothing Then Set frmMg1 = New frmMg
frmMg1.Init Search, "select " & MdlItem(intCurMenu).mdlCmd & " from " & MdlItem(intCurMenu).mdlTable, Trim(MdlItem(intCurMenu).mdlName) & "『" & strCmd & "』"
frmMg1.Show vbModal
Exit Sub
End If
If InStr(1, strCmd, "添加") > 0 Then
Set frmMg1 = GetFrm("frmMg")
If frmMg1 Is Nothing Then Set frmMg1 = New frmMg
frmMg1.Init Add, "select " & MdlItem(intCurMenu).mdlCmd & " from " & MdlItem(intCurMenu).mdlTable, Trim(MdlItem(intCurMenu).mdlName) & "『" & strCmd & "』"
frmMg1.Show vbModal
Exit Sub
End If
If InStr(1, strCmd, "修改") > 0 Then
If frmMg1 Is Nothing Then Set frmMg1 = New frmMg
frmMg1.Init Modify, "select " & MdlItem(intCurMenu).mdlCmd & " from " & MdlItem(intCurMenu).mdlTable, Trim(MdlItem(intCurMenu).mdlName) & "『" & strCmd & "』"
frmMg1.Show vbModal
Exit Sub
End If
If InStr(1, strCmd, "删除") > 0 Then
If frmMg1 Is Nothing Then Set frmMg1 = New frmMg
frmMg1.Init Delete, "select " & MdlItem(intCurMenu).mdlCmd & " from " & MdlItem(intCurMenu).mdlTable, Trim(MdlItem(intCurMenu).mdlName) & "『" & strCmd & "』"
frmMg1.Show vbModal
Exit Sub
End If
If InStr(1, strCmd, "高级管理") > 0 Then
If frmAdMg1 Is Nothing Then Set frmAdMg1 = New frmAdMg
frmAdMg1.Init "select " & MdlItem(intCurMenu).mdlCmd & " from " & MdlItem(intCurMenu).mdlTable, Trim(MdlItem(intCurMenu).mdlName) & "『" & strCmd & "』"
frmAdMg1.Show vbModal
Exit Sub
End If
If InStr(1, strCmd, "生成") > 0 And InStr(1, strCmd, "表") > 0 Then '生成数据表
If MsgBox("该操作会导致" & MdlItem(intCurMenu).mdlName & "表丢失!" & "重新生成新的数据表,是否继续操作?", vbYesNo, "警告") = vbYes Then
If dbCtrlAll.RunSql("select * from " & MdlItem(intCurMenu).mdlTable) Is Nothing Then
Else
dbCtrlAll.RunSql ("drop table " & MdlItem(intCurMenu).mdlTable)
End If
Dim intBak As Integer
For intBak = 0 To UBound(MdlItem(intCurMenu).CreateTable)
dbCtrlAll.RunSql Replace(MdlItem(intCurMenu).CreateTable(intBak), dbCtrlAll.STR_SPLIT, "'")
Next intBak
MsgBox "操作完成，请检验！"
Exit Sub
End If
Exit Sub
End If
If strCmd = "退出" Then
End
End If
If strCmd = "注销" Then
'显示登录窗体
Set frmBak = GetFrm("frm_Main")
If frmBak Is Nothing Then
Else
frmBak.Hide
End If
frmlogin1.Show vbModal
Unload frmlogin1
If AdminCur.IsLogin Then
'初始化主窗体菜单
Call InitMainMenu
If frmBak Is Nothing Then
Else
frmBak.Show
frmBak.Caption = App.ProductName & " [管理员: " & AdminCur.UserName & "]"
frmBak.lblMg_MouseDown 0, 0, 0, 0, 0
End If
Else
End
End If
End If
If InStr(1, strCmd, "执行SQL") > 0 Then
Dim strGetSql As String
strGetSql = InputBox("请输入要执行的SQL语句:", "执行SQL", "Select * from module")
If strGetSql <> "" Then
dbCtrlAll.RunSql strGetSql
End If
Exit Sub
End If
If InStr(1, strCmd, "重载模块") > 0 Then
Set frmBak = GetFrm("frm_Main")
Call InitMainMenu
frmBak.Init
End If
End Sub
'获得指定窗体
Function GetFrm(strFrmCaption As String) As Form
For i = 0 To Forms.Count - 1
If Forms(i).Name = strFrmCaption Then
Set GetFrm = Forms(i)
Exit Function
End If
Next i
Set GetFrm = Nothing
End Function
1.1.8 MdlPublic源代码清单如下：
Option Explicit
'
'┎──────────────────────────────────────────────┒
'┃ ┃
'┃ 名 称： 学生信息管理系统基本模块 ［九九科技项目开发第一小组］ ┃
'┃ ┃
'┠──────────────────────────────────────────────┨
'┃ ┃
'┃ 包含模块： ┃
'┃ ┃
'┃ 过程：ShowErr(strErr) ── 显示错误信息 ┃
'┃ ┃
'┃ 过程：ShowOk(strOk) ── 显示成功或确定信息 ┃
'┃ ┃
'┃ 公用数据：全局对象、常量、变量定义模块 ┃
'┃ ┃
'┃ 过程：Main() ── 项目入口 ┃
'┃ ┃
'┖──────────────────────────────────────────────┚
'
'公用数据
'
Public Const STR_TITLE = "学生信息管理系统" '项目标题
Public Const STR_COMPANY = "湖南科技职业学院" '开发团队
'
Public Type AdminInf
UserName As String '当前管理员用户名
Password As String '当前管理员密码
Power As Integer '当前管理员操作权限
IsLogin As Boolean '当前管理员登录状态
End Type
Public AdminCur As AdminInf
Public dbCtrlAll As New DbCtrl '数据库操作对象
'
'
' 过程说明： 显示错误信息
'
' 调用方法： CALL ShowErr(strErr)
'
' 参数说明：
'
' strErr ── 要显示的错误信息字符串'
'
' 具体代码：
Public Sub ShowErr(strErr As String)
If Err.Number <> 0 Then
strErr = strErr & vbCrLf & vbCrLf & String(40, "-") & vbCrLf & "详 细 信 息: " & vbCrLf & vbCrLf & Err.Description
End If
Err.Clear
MsgBox strErr, vbOKOnly + vbCritical, STR_TITLE
End Sub
'
'
' 过程说明： 显示成功信息
'
' 调用方法： CALL Show(strErr)
'
' 参数说明：
'
' strOk ── 要显示的成功信息字符串'
'
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -