mdlpub.bas

北大青鸟教学管理系统是学习规范编程范本.功能非常完备,代码编写有章法,不可多得

Attribute VB_Name = "ModMain"
Option Explicit
Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Public Const SRCAND = &H8800C6  ' (DWORD) dest = source AND dest
Public Const SRCERASE = &H440328        ' (DWORD) dest = source AND (NOT dest )
Public Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
Public Const SRCINVERT = &H660046       ' (DWORD) dest = source XOR dest
Public Const SRCPAINT = &HEE0086        ' (DWORD) dest = source OR dest

Private FileNo As Integer
Public StrUserName As String
Public StrPwd As String
Public Con As New ADODB.Connection
Public Rst As New ADODB.Recordset
Public UserPopedom As String
Public ImagePath As String
Private Count_Login As Integer

Sub Main()      '程序从此启动,初始化
    
    frmSplash.Show
    
End Sub
Public Function Login(ByVal X As String, ByVal Y As String) As Boolean
    Call Rst.Find("UserName='" & X & "'", 0, adSearchForward, 0)    '
    'Rst.Filter = ("UserName='" & X & "'")
    If Rst.Fields("password").Value = Y Then
        If Rst.Fields("status").Value = "正常" Then     '如果密码正确且处于正常状态则返回真
            Login = True
            StrUserName = X
            StrPwd = Y
            UserPopedom = Rst.Fields("popedom").Value   '取得用户权限
        Else
            MsgBox "此用户已注销....", vbInformation + vbOKOnly, "登录信息"
            frmlogin.cmbUserName.SetFocus
        End If
    Else
        Count_Login = Count_Login + 1
        MsgBox "密码错误....", vbInformation + vbOKOnly, "登录信息"
        If Count_Login >= 3 Then
            MsgBox "您输入的密码已超过三次,请重新启动程序", vbInformation + vbOKOnly, "密码错误"
            End
        Else
            frmlogin.txtPassword.SetFocus
        End If
        
               
    End If
End Function


Sub ChangePwd(ByVal Pwd As String)            '更改密码
On Error GoTo ErrLab
    Set Rst = Nothing
    
    Call Fun_Rst("select * from sysuser")
    Rst.MoveFirst
    Do While Rst.EOF = False
        If Rst.Fields("UserName").Value = StrUserName Then
            Rst.Fields("Password").Value = Pwd
            Rst.Update
            MsgBox "密码修改成功", vbInformation + vbOKOnly, "密码修改"
            StrPwd = Pwd
            Exit Do
        End If
        Rst.MoveNext
    Loop
    
    Exit Sub
ErrLab:
    MsgBox "密码修改失败", vbCritical + vbOKOnly, "密码修改"
End Sub
Sub CloseDB()   '关闭数据库
    Con.Close
End Sub

Public Function Fun_Rst(StrSQL As String) As Boolean        '打开记录集
On Error GoTo Err_Rct
       Call Rst.Open(StrSQL, Con, adOpenDynamic, adLockOptimistic)  'recordset对象
       Fun_Rst = True
    Exit Function
Err_Rct:
    MsgBox "未知错误:" & Err.Description & vbCrLf & "错误代号:" & Err.Number, vbCritical + vbOKOnly, "未知错误"
End Function