📄 module1.bas

📁 上学时写的一个进销存管理软件
💻 BAS
字号:
Attribute VB_Name = "Module1"
'定义用户管理数据库的变量
Public UserName As String
Dim db As Database
Dim td As TableDef
Dim fields(2) As Field
Dim dbrecordset As Recordset
'打开初始数据库(账户数据库)
Sub OpenAccountDatabase()
On Error Resume Next
'设置初始数据库所在的位置
Dim filename As String
Dim fullpath As String
filename = "source" + "\" + "Account"
If Right(App.Path, 1) = "\" Then
fullpath = App.Path + filename
Else
fullpath = App.Path + "\" + filename
End If
'打开初始数据库和初始工作表
Set db = DBEngine.Workspaces(0).OpenDatabase(fullpath, False, False, ";pwd=1271703468")
Set dbrecordset = db.OpenRecordset("logtable")
End Sub

'程序开始运行
Sub ProgramStart()
On Error Resume Next
'通过注册表检查是否是第一次登录
Dim reguser As String
Dim regpwd As String
'从注册表中获取数据
reguser = GetSetting("jxc", "startup", "firstuser", "")
regpwd = GetSetting("jxc", "startup", "userpwd", "")
'如果数据为空说明是第一次登录，要求输入管理员帐户
If reguser <> "" Then
    Else
    If regpwd <> "" Then
    Else
    '显示输入管理员帐号对话框
    mangerloginform.Show 1
    End If
End If
End Sub

Sub AddMangerToAccount()
On Error Resume Next
dbrecordset.AddNew
dbrecordset.fields(0) = GetSetting("jxc", "startup", "firstuser", "")
dbrecordset.fields(1) = "管理员"
dbrecordset.fields(2) = GetSetting("jxc", "startup", "userpwd", "")
dbrecordset.Update
End Sub

'初始化主窗体的过程
Sub InitMainform()
On Error Resume Next
'使按钮不可用
MainForm.mnufileopen.Enabled = False
MainForm.mnufilebackup.Enabled = False
MainForm.mnufilenew.Enabled = False
MainForm.mnufileclose.Enabled = False
MainForm.mnufilerestore.Enabled = False
MainForm.mnutoolchangpwd.Enabled = False
MainForm.mnutoolmanage.Enabled = False
MainForm.mnutoolusermanger.Enabled = False
MainForm.mnuworkin.Enabled = False
MainForm.mnuworklookup.Enabled = False
MainForm.mnuworkout.Enabled = False
MainForm.mnuworkprint.Enabled = False
MainForm.Toolbar1.Buttons(3).Visible = False
MainForm.Toolbar1.Buttons(4).Visible = False
MainForm.Toolbar1.Buttons(5).Visible = False
MainForm.Toolbar1.Buttons(6).Visible = False
MainForm.Toolbar1.Buttons(7).Visible = False
MainForm.Toolbar1.Buttons(8).Visible = False
MainForm.Toolbar1.Buttons(9).Visible = False
MainForm.Toolbar1.Buttons(10).Visible = False
MainForm.Toolbar1.Buttons(11).Visible = False
MainForm.Toolbar1.Buttons(12).Visible = False
MainForm.Toolbar1.Buttons(13).Visible = False
MainForm.Toolbar1.Buttons(14).Visible = False
MainForm.Toolbar1.Buttons(15).Visible = False
MainForm.Toolbar1.Buttons(16).Visible = False
End Sub

'操作员登录的过程
Sub UserLogin()
On Error Resume Next
'设置表格的索引
dbrecordset.Index = "操作员"
'查找是否有此用户
dbrecordset.Seek "=", loginform.Text1.Text
If dbrecordset.NoMatch Then
MsgBox "没有此用户"
loginform.Text1.Text = ""
loginform.Text2.Text = ""
loginform.Text1.SetFocus
Else
'检查密码是否正确
    If dbrecordset.fields(2) = loginform.Text2.Text Then
    UserName = loginform.Text1.Text '将当前登录用户名保存到全局变量UserName中
    Unload loginform
    'MsgBox "在这里是登录正确的代码"
        If dbrecordset.fields(1) = "管理员" Then
        Module1.MangerPass
        Else
        Module1.UserPass
        End If
    Else
    MsgBox "密码错误"
    loginform.Text2.Text = ""
    loginform.Text2.SetFocus
    End If
End If
End Sub

Sub MangerPass()
On Error Resume Next
Module1.InitMainform
'MsgBox "管理员登录成功的代码"
'使所有菜单可用
MainForm.mnufileopen.Enabled = True
MainForm.mnufilebackup.Enabled = False
MainForm.mnufilenew.Enabled = True
MainForm.mnufilerestore.Enabled = True
MainForm.mnutoolchangpwd.Enabled = True
MainForm.mnutoolmanage.Enabled = False
MainForm.mnutoolusermanger.Enabled = True
MainForm.mnuworkin.Enabled = False
MainForm.mnuworklookup.Enabled = False
MainForm.mnuworkout.Enabled = False
MainForm.mnuworkprint.Enabled = False
'使工具栏按钮可用
MainForm.Toolbar1.Buttons(3).Visible = True
MainForm.Toolbar1.Buttons(4).Visible = True
MainForm.Toolbar1.Buttons(5).Visible = True
MainForm.Toolbar1.Buttons(5).Enabled = False
MainForm.Toolbar1.Buttons(6).Visible = True
MainForm.Toolbar1.Buttons(7).Visible = True
MainForm.Toolbar1.Buttons(7).Enabled = False
MainForm.Toolbar1.Buttons(8).Visible = True
MainForm.Toolbar1.Buttons(9).Visible = True
MainForm.Toolbar1.Buttons(10).Visible = True
MainForm.Toolbar1.Buttons(10).Enabled = False
MainForm.Toolbar1.Buttons(11).Visible = True
MainForm.Toolbar1.Buttons(11).Enabled = False
MainForm.Toolbar1.Buttons(12).Visible = True
MainForm.Toolbar1.Buttons(13).Visible = True
MainForm.Toolbar1.Buttons(14).Visible = True
MainForm.Toolbar1.Buttons(15).Visible = True
MainForm.Toolbar1.Buttons(15).Enabled = False
MainForm.Toolbar1.Buttons(16).Visible = True
End Sub

Sub UserPass()
On Error Resume Next
Module1.InitMainform
'MsgBox "操作员登录成功的代码"
'使操作员权限内的按钮可用
MainForm.mnufileopen.Enabled = True
MainForm.mnufilebackup.Enabled = False
MainForm.mnufilenew.Enabled = True
MainForm.mnufileclose.Enabled = False
MainForm.mnufilerestore.Enabled = True
MainForm.mnutoolchangpwd.Enabled = True
MainForm.mnuworkin.Enabled = False
MainForm.mnuworklookup.Enabled = False
MainForm.mnuworkout.Enabled = False
MainForm.mnuworkprint.Enabled = False
'显示工具栏按钮
MainForm.Toolbar1.Buttons(3).Visible = True
MainForm.Toolbar1.Buttons(4).Visible = True
MainForm.Toolbar1.Buttons(5).Visible = True
MainForm.Toolbar1.Buttons(5).Enabled = False
MainForm.Toolbar1.Buttons(6).Visible = True
MainForm.Toolbar1.Buttons(7).Visible = True
MainForm.Toolbar1.Buttons(7).Enabled = False
MainForm.Toolbar1.Buttons(8).Visible = True
MainForm.Toolbar1.Buttons(9).Visible = True
MainForm.Toolbar1.Buttons(10).Visible = True
MainForm.Toolbar1.Buttons(10).Enabled = False
MainForm.Toolbar1.Buttons(11).Visible = True
MainForm.Toolbar1.Buttons(11).Enabled = False
MainForm.Toolbar1.Buttons(12).Visible = True
MainForm.Toolbar1.Buttons(13).Visible = True
MainForm.Toolbar1.Buttons(14).Visible = False
MainForm.Toolbar1.Buttons(15).Visible = False
MainForm.Toolbar1.Buttons(16).Visible = True
End Sub

'检查登录用户是否是管理员
Sub UserCheck()
On Error Resume Next
If loginform.Text1.Text = "" Then
MsgBox "请输入管理员帐户"
loginform.Text1.SetFocus
Else
    If loginform.Text2.Text = "" Then
    MsgBox "请输入密码"
    loginform.Text2.SetFocus
    Else
    '设置表格的索引
    dbrecordset.Index = "操作员"
    '查找是否有此用户
    dbrecordset.Seek "=", loginform.Text1.Text
        If dbrecordset.NoMatch Then
        MsgBox "没有此管理员"
        loginform.Text1.Text = ""
        loginform.Text2.Text = ""
        loginform.Text1.SetFocus
        Else
            If dbrecordset.fields(1) = "管理员" Then
                If dbrecordset.fields(0) = loginform.Text1.Text _
                And dbrecordset.fields(1) = "管理员" And dbrecordset.fields(2) = loginform.Text2.Text Then
                Unload loginform
                '显示操作员管理窗体
                usermangerform.Show 1
                Else
                MsgBox "密码错误"
                End If
            Else
            MsgBox "用户没有管理员权限"
            Unload loginform
            End If
        End If
    End If
End If
End Sub

'初始化用户管理的窗体
Sub InitUserMangerform()
On Error Resume Next
Set usermangerform.data1.Recordset = dbrecordset
usermangerform.Text1.Text = dbrecordset.fields(0)
usermangerform.Combo1.Text = dbrecordset.fields(1)
usermangerform.Text2.Text = dbrecordset.fields(2)
usermangerform.Text1.Enabled = False
usermangerform.Combo1.Enabled = False
usermangerform.Text2.Enabled = False
usermangerform.Command(6).Enabled = False
dbrecordset.MoveFirst
End Sub

'以用户管理数据库的操作
Sub UserMangerDb(ByRef idx As Integer)
On Error Resume Next
Select Case idx
Case 1
'MsgBox "这里是前一个的代码"
dbrecordset.MovePrevious
usermangerform.Command(2).Enabled = True
usermangerform.Text1.Enabled = False
usermangerform.Text2.Enabled = False
If dbrecordset.BOF Then
dbrecordset.MoveNext
usermangerform.Command(1).Enabled = False
Else
usermangerform.Text1.Text = dbrecordset.fields(0)
usermangerform.Combo1.Text = dbrecordset.fields(1)
usermangerform.Text2.Text = dbrecordset.fields(2)
End If
Case 2
'MsgBox "这里是下一个的代码"
dbrecordset.MoveNext
usermangerform.Command(1).Enabled = True
usermangerform.Text1.Enabled = False
usermangerform.Text2.Enabled = False
If dbrecordset.EOF Then
dbrecordset.MovePrevious
usermangerform.Command(2).Enabled = False
Else
usermangerform.Text1.Text = dbrecordset.fields(0)
usermangerform.Combo1.Text = dbrecordset.fields(1)
usermangerform.Text2.Text = dbrecordset.fields(2)
End If
Case 3
'MsgBox "这里是添加的代码"
dbrecordset.AddNew
usermangerform.Text1.Text = ""
usermangerform.Text2.Text = ""
usermangerform.Combo1.ListIndex = 1
usermangerform.Text1.Enabled = True
usermangerform.Combo1.Enabled = True
usermangerform.Text2.Enabled = True
usermangerform.Command(4).Enabled = False
usermangerform.Command(5).Enabled = False
Case 4
'MsgBox "这里是删除的代码"
If MsgBox("真的要删除吗？", vbQuestion + vbOKCancel, "提示") = vbOK Then
If dbrecordset.fields(0) = GetSetting("jxc", "startup", "firstuser", "") _
And dbrecordset.fields(1) = "管理员" _
And dbrecordset.fields(2) = GetSetting("jxc", "startup", "userpwd", "") Then
MsgBox "不能删除超级管理员"
Else
dbrecordset.Delete
If dbrecordset.EOF = False Then
dbrecordset.MoveNext
Else
dbrecordset.MovePrevious
usermangerform.Text1.Text = dbrecordset.fields(0)
usermangerform.Combo1.Text = dbrecordset.fields(1)
usermangerform.Text2.Text = dbrecordset.fields(2)
End If
End If
End If
Case 5
'MsgBox "这里时编辑的代码"
dbrecordset.Edit
usermangerform.Text1.Enabled = True
usermangerform.Combo1.Enabled = True
usermangerform.Text2.Enabled = True
Case 6
'MsgBox "这里是更新的代码"
If usermangerform.Text1.Text = "" Then
MsgBox "用户名不能为空"
usermangerform.Command(6).Enabled = True
Else
    If usermangerform.Text2.Text = "" Then
    MsgBox "密码不可以为空"
    usermangerform.Command(6).Enabled = True
    Else
    dbrecordset.fields(0) = usermangerform.Text1.Text
    dbrecordset.fields(1) = usermangerform.Combo1.Text
    dbrecordset.fields(2) = usermangerform.Text2.Text
    dbrecordset.Update
    dbrecordset.MoveFirst
    usermangerform.Command(6).Enabled = False
    usermangerform.Text1.Enabled = False
    usermangerform.Combo1.Enabled = False
    usermangerform.Text2.Enabled = False
    End If
End If
usermangerform.Command(4).Enabled = True
usermangerform.Command(5).Enabled = True
End Select
End Sub

'在程序结束时关闭所有窗体
Sub CloseAllForm()
Dim i As Integer
For i = Forms.Count - 1 To 0 Step -1
Unload Forms(i)
Next
End Sub

'关闭所有数据库的过程
Sub CloseAllDatabase()
'关闭所有的数据库
On Error Resume Next
Dim ws As Workspace
Dim db As Database
Dim rs As Recordset
For Each ws In Workspaces
For Each db In ws.Databases
For Each rs In db.Recordsets
rs.Close
Set rs = Nothing
Next
db.Close
Set db = Nothing
Next
ws.Close
Set ws = Nothing
Next
End Sub

Sub ChangePassWord()
On Error Resume Next
passwordform.Show
passwordform.Text1.SetFocus
passwordform.Caption = "改变密码"
'分别检查，用户名和密码是否正确
If passwordform.Command1.Value = True Then
    If passwordform.Text1.Text = "" Then
    MsgBox "名称不能主空!请输入姓名"
    Else
        If passwordform.Text2.Text = "" Then
        MsgBox "请输入密码"
        Else
            If passwordform.Text2.Text <> passwordform.Text3.Text Then
            MsgBox "密码不一致，请重新输入"
            passwordform.Text2.Text = ""
            passwordform.Text3.Text = ""
            passwordform.Text2.SetFocus
            Else
            '更改用户名和密码
            '设置表格的索引
            dbrecordset.Index = "操作员"
            '查找是否有此用户
            dbrecordset.Seek "=", UserName
            dbrecordset.Edit
            dbrecordset.fields(0) = passwordform.Text1.Text
            dbrecordset.fields(2) = passwordform.Text2.Text
            dbrecordset.Update
            Unload passwordform
            End If
        End If
    End If
End If
End Sub

'把帐号表绑定到查询表的dataaccount表上
Sub InitSeachformCaozuoyuan()
On Error Resume Next
Set SeachForm.DataAccount.Recordset = dbrecordset
SeachForm.DBComboCaozuoyuan.ListField = "操作员"
End Sub
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -