Public miCount As Integer

Private Sub cmdCancel_Click() ''退出程序
End
End Sub

Private Sub cmdOK_Click() ''进入..确定
'On Error GoTo Err
    Dim txtSql As String
    UserName = ""
    If Trim(txtUserName.Text) = "" Then ''判断用户名是否为空
        MsgBox "请输入帐号！", vbOKOnly + vbExclamation, "警告"
        txtUserName.SetFocus
        Exit Sub
    End If
    If Trim(txtPassword.Text) = "" Then '判断密码是否为空
        MsgBox "请输入密码！", vbOKOnly + vbExclamation, "警告"
        txtPassword.SetFocus
        Exit Sub
    End If
   
    ''判断是否有这个用户
    txtSql = "select * from 用户信息表 where 用户名称= '" & txtUserName.Text & "'"
    If rs.State Then rs.Close
    rs.Open txtSql, CN, adOpenStatic, adLockOptimistic
    If rs.EOF = True Then ''如果没有这个用户
        MsgBox "没有这个帐号，请重新输入帐号!", vbOKOnly + vbExclamation, "警告"
        txtUserName.Text = ""
        txtPassword.Text = ""
        txtUserName.SetFocus
    Else ''如果有用户
        
        If Trim(rs.Fields(1)) = Trim(txtPassword.Text) Then
        ''判断权限
            UserPrivs = ""
            If Trim(rs.Fields(2)) = "管理员" Then ''管理员权限
                IsUserMode = 1
            ElseIf Trim(rs.Fields(2)) = "操作员" Then ''普通用户权限
                IsUserMode = 2
            Else ''无权
                IsUserMode = 0
                MsgBox "你没有权限!", vbExclamation, "警告"
                End
            End If
            UserPrivs = Trim(rs.Fields(2))
            UserName = Trim(txtUserName.Text)

            Unload Me
            Mainfrm.Show
            
            Exit Sub
        Else
            MsgBox "输入密码不正确，请重新输入！", vbOKOnly + vbExclamation, "警告"
            txtPassword.SetFocus
            txtPassword.Text = ""
        End If
    End If
    rs.Close
    miCount = miCount + 1
    If miCount = 3 Then ''三次错误,自动退出程序
        End
    End If
Exit Sub
Err:
    MsgBox Err.Description & "登录出错,请找管理员!", vbExclamation
    Ok = False
    End

End Sub

Private Sub Form_Activate()
txtUserName.SetFocus

End Sub

Private Sub Form_Load()
On Error GoTo Err
''连数据库代码

If CN.State Then CN.Close
CN.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\database.mdb;Persist Security Info=False"
CN.Open
miCount = 0

Ok = False
txtUserName.Text = GetSetting(App.Title, "Settings", "user_name", "")
Label2.MouseIcon = cmdOK.MouseIcon
Exit Sub
Err:
MsgBox Err.Description, , "数据库连接错误"
End
End Sub

Private Sub Label1_Click()
Form5.Show 1
End Sub

Private Sub Label2_Click()
End
End Sub

Private Sub txtPassword_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call cmdOK_Click
End If

End Sub

Private Sub txtUserName_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtPassword.SetFocus
End If
End Sub
主界面图及代码：

Private Sub DatabaseHf_Click()
frmHF.Show 1
End Sub

Private Sub Exit_Click()
End
End Sub



Private Sub FindStudent_Click()
Form2.Show 1
End Sub

Private Sub Findxg_Click()
Form8.Show 1
End Sub

Private Sub Form_Load()
PrivsSeting ''加载权限设置

End Sub

Private Sub Form_Resize()
On Error GoTo Err '''改变控件位置代码
Picture1.Top = 0
Picture1.Left = 0
Picture1.Height = Me.ScaleHeight - StatusBar1.Height
Picture1.Width = Me.ScaleWidth
StatusBar1.Panels(1).Text = "操作员:" & UserName
Label9.Left = (Picture1.ScaleWidth - Label9.Width) / 2
Label9.Top = Picture1.ScaleHeight / 2 - Label9.Height / 2
Label1.Top = Label9.Top + 50
Label1.Left = Label9.Left + 50
''加载背景代码
        Image1.Picture = LoadPicture(App.Path & "\1.jpg")
        Picture1.Refresh
        Picture1.PaintPicture Image1.Picture, Picture1.ScaleTop, Picture1.ScaleLeft, Picture1.ScaleWidth, Picture1.ScaleHeight, 0, 0, Image1.Width, Image1.Height
Err:
End Sub


Private Sub Form_Unload(Cancel As Integer)
End
End Sub


Private Sub HelpFiles_Click() '''帮助文件
On Error GoTo Err
Mainfrm.StatusBar1.Panels(2).Text = "帮助文件"
    Dim strPath As String
    strPath = App.Path + "\系统说明.doc"
    ShellExecute hWnd, "open", mFso.GetFileName(strPath), lpParameters, mFso.GetParentFolderName(strPath), 5
Exit Sub
Err:
MsgBox Err.Description
End Sub

Private Sub Infocj_Click()
strTableName = "成绩信息"
Form6.Show 1

End Sub

Private Sub InfoCqjl_Click()
strTableName = "考勤信息"
Form7.Show 1

End Sub

Private Sub InfoJf_Click()
strTableName = "奖罚信息"
Form7.Show 1

End Sub

Private Sub InfoKc_Click()
strTableName = "课程信息"
Form1.Show 1

End Sub

Private Sub InfoKwhd_Click()
strTableName = "课外活动信息"
Form7.Show 1

End Sub

Private Sub infoStudent_Click()
strTableName = "学生基本信息"
Form1.Show 1
End Sub

Private Sub InofBs_Click()
strTableName = "比赛信息"
Form7.Show 1

End Sub

Private Sub Sjbf_Click()
frmDatabase.Show 1
End Sub

Private Sub SysAbout_Click() ''关于
frmAbout.Show 1
End Sub


Private Sub sysManager_Click()
Form3.Show 1
End Sub


Private Sub Userpasword_Click() ''用户密码
Form4.Show 1
End Sub

Public Sub PrivsSeting() '权限设置
If IsUserMode = 1 Then ''管理员
   
ElseIf IsUserMode = 2 Then
    sysManager.Visible = False
    Infomanage.Visible = False
End If
End Sub
用户管理代码

Private Sub cmdExit_Click()
Unload Me
End Sub

Private Sub Command2_Click() ''添加用户
On Error GoTo Err
If Trim(Text8.Text) <> "" And Trim(Text9.Text) <> "" And Trim(Combo1.Text) <> "" Then
    Dim rs1 As New ADODB.Recordset
    If rs1.State Then rs1.Close
    rs1.Open "select count(*) from user_Form where user_Id='" & Trim(Text8.Text) & "'", Cn, adOpenStatic, adLockOptimistic
    If rs1.Fields(0) > 0 Then
    MsgBox "用户已经存在! 请改user_Id!", , "系统提示"
    Text8.Text = ""
    Exit Sub
    End If
   
    If rs1.State Then rs1.Close
    rs1.Open "select * from user_Form", Cn, adOpenStatic, adLockOptimistic
    rs1.AddNew
    rs1.Fields(0).Value = Trim(Text8.Text)
    rs1.Fields(1).Value = Trim(Text9.Text)
    rs1.Fields(2).Value = Date
    rs1.Fields(3).Value = Trim(Combo1.Text)
    rs1.Update
    Combo5.AddItem Trim(Text8.Text)
    MsgBox "用户添加成功!,初始密码为" & Text9.Text, , "系统提示"
    Text8.Text = ""
End If
Exit Sub
Err:
MsgBox Err.Description
End Sub

Private Sub Command3_Click() ''删除用户代码
    If Trim(Combo5.Text) = UserName Then
        MsgBox "不能删除正在操作的用户!"
        Exit Sub
    End If
    Cn.Execute "delete from user_Form where user_Id='" & Trim(Combo5.Text) & "'"
    Combo5.RemoveItem (Combo5.ListIndex)
    MsgBox "操作已成功!", , "提示"
End Sub

Private Sub Form_Load() ''初始化代码
On Error GoTo Err
Text8.Text = ""


Dim rs1 As New ADODB.Recordset
rs1.Open "select * from user_Form", Cn, adOpenStatic, adLockOptimistic
Combo5.Clear
While Not rs1.EOF
    If Not IsNull(rs1.Fields(0)) Then Combo5.AddItem Trim(rs1.Fields(0))
rs1.MoveNext
Wend
Err:

End Sub
查询界面及源代码

Dim rs2 As New ADODB.Recordset '''记录集,检索用的

Private Sub cmdExcel_Click() ''excel输出
On Error GoTo Err
If MSHFlexGrid1.TextMatrix(0, 0) = "" Then Exit Sub


Dim i As Integer
Dim j As Integer

Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet

Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add '打开已经存在的EXCEL工件簿文件
Set xlSheet = xlBook.Worksheets(1) '设置活动工作表
    For i = 0 To MSHFlexGrid1.Rows - 1
        For j = 0 To MSHFlexGrid1.Cols - 1
            xlSheet.Cells(i + 1, j + 1) = Trim(MSHFlexGrid1.TextMatrix(i, j))
        Next j
    Next i
xlApp.Visible = True
Exit Sub
Err:
MsgBox Err.Description, , "错误"
xlBook.Close (True) '关闭工作簿
xlApp.Quit '结束EXCEL对象
Set xlApp = Nothing '释放xlApp对象
End Sub

Private Sub cmdExit_Click()
Unload Me
End Sub

Private Sub cmdLook_Click() ''查询代码

If Trim(Combo2.Text) <> "" And Trim(Combo3.Text) <> "" And Trim(Combo4.Text) <> "" And Trim(Text1.Text) <> "" Then
        Dim strsql As String

        strsql = "select * from " & Trim(Combo2.Text) & " where " & Trim(Combo3.Text) & " " & Trim(Combo4.Text) & "'"
        If Combo4.Text = "like" Then
            strsql = strsql & "%" & Trim(Text1.Text) & "%'"
        Else
            strsql = strsql & Trim(Text1.Text) & "'"
        End If


    If rs2.State Then rs2.Close
    rs2.Open strsql, CN, adOpenStatic, adLockOptimistic
    Set MSHFlexGrid1.DataSource = rs2
Else
    MsgBox "请选择或输入数据!", , "系统提示"
End If
End Sub

Private Sub Combo2_Click()
If rs2.State Then rs2.Close
rs2.Open "select * from " & Trim(Combo2.Text), CN, adOpenStatic, adLockOptimistic
Dim i As Integer
Combo3.Clear
For i = 0 To rs2.Fields.Count - 1

        Combo3.AddItem rs2.Fields(i).Name

Next i
Combo3.Text = Combo3.List(0)
Set MSHFlexGrid1.DataSource = rs2
End Sub

Private Sub Form_Load()
Me.Caption = "综合检索"

'Combo2.Text = strTableName
Mainfrm.StatusBar1.Panels(2).Text = strTableName & "检索"



End Sub

没有人可以帮忙。。。