modmain.bas

一个vb的mis系统

Attribute VB_Name = "MODMAIN"

'主启动入口
Sub Main()
    frmLogin.Show vbModal
End Sub
'登陆密码检验函数
Public Function login(ByVal struser As String, ByVal strpwd As String) As Boolean
    frmLogin.Adodc1.Refresh
    While frmLogin.Adodc1.Recordset.EOF = False
    '以下是用户名正确的处理
    If Trim(struser) = Trim(frmLogin.Text1.Text) Then
        If Trim(strpwd) = Trim(frmLogin.Text2.Text) Then

            login = True
            Exit Function
        Else:
            login = False
            Set publicmbox.Picture = publicmbox.pic26.Picture: publicmbox.Show vbModal
            login = False
            Exit Function
        End If
    End If
    frmLogin.Adodc1.Recordset.MoveNext
    Wend
    Set publicmbox.Picture = publicmbox.pic27.Picture: publicmbox.Show vbModal
End Function
'清空数据库函数
Public Function cleardb(cleartsql) As Boolean
    Dim con As New ADODB.Connection
    con.ConnectionString = "driver={SQL Server};server=.;uid=sa;pwd=;database=accp"
    con.Open
    con.Execute (cleartsql)
    con.Close
    cleardb = True
End Function
'执行TSQL函数
Public Function runtsql(ByVal tsql As String) As Boolean
    Dim con As New ADODB.Connection
    con.ConnectionString = "driver={SQL Server};server=.;uid=sa;pwd=;database=accp"
    con.ConnectionTimeout = 5
    con.Open
    con.Execute (tsql)
    con.Close
    runtsql = True
End Function
'检查字符为数字的函数
Public Function strisnum(ByVal str As String) As Boolean
    If Trim(str) = "" Then
        Set publicmbox.Picture = publicmbox.pic31.Picture: publicmbox.Show vbModal
    End If
    If IsNumeric(Trim(str)) Then
        strisnum = True
    Else
        strisnum = False
    End If
End Function
'写入用户登陆时间
Public Function writeini_land(ByVal userland As String)
    Dim temptxt As String
        Open (App.Path & "\user.ini") For Input As #1
            Do While Not EOF(1)
                Line Input #1, linetxt
                temptxt = temptxt & linetxt & Chr(13) & Chr(10)
            Loop
        Close #1
        temptxt = temptxt & "用户：" & userland & "    " & "登陆时间：" & format(Now, "yy-mm-dd hh:mm:ss")
        Open (App.Path & "\user.ini") For Output As #1
        Print #1, temptxt
        Close #1
End Function
'写入用户退出时间
Public Function writeini_exit(ByVal userexit As String)
    Dim temptxt As String
        Open (App.Path & "\user.ini") For Input As #1
            Do While Not EOF(1)
                Line Input #1, linetxt
                temptxt = temptxt & linetxtt & linetxt & Chr(13) & Chr(10)
            Loop
        Close #1
        temptxt = temptxt & "用户：" & userexit & "    " & "退出时间：" & format(Now, "yy-mm-dd hh:mm:ss")
        Open (App.Path & "\user.ini") For Output As #1
        Print #1, temptxt
        Close #1
End Function
'读取曾经登陆过的用户名到LOGIN界面的登陆框中
Public Function readuser() As Boolean
Dim i As Integer
i = 0
Open (App.Path & "\users.ini") For Input As #1
Do While Not EOF(1)
    Line Input #1, username
    frmLogin.t1.List(i) = username
    i = i + 1
Loop
Close #1
End Function
'检查一个即将登陆的用户名是否出现在users.ini中，如果没有将自动加入其中
Public Function chkandwriteusername(ByVal username As String) As Boolean
    Dim tempallusername As String
    Open (App.Path & "\users.ini") For Input As #1
        Do While Not EOF(1)
            Line Input #1, tempusername
            If tempusername = username Then  '如果当前用户名出现在uses.ini上将跳出系统
                Close #1
                Exit Function
            End If
            tempallusername = tempallusername & tempusername & Chr(13) & Chr(10)    '累加所有用户名
        Loop
    Close #1
    '没有出现在users.ini文件中将添加入内
    tempallusername = tempallusername & username
    '写回users.ini
    Open (App.Path & "\users.ini") For Output As #1
        Print #1, tempallusername
    Close #1
End Function
'检查登陆密码的强度1(for 用户登陆版)
Public Function chkuserpwd(ByVal pwd As String)
    If pwd = "" Then
        frmLogin.pwd1.Visible = False
        frmLogin.pwd2.Visible = False
        frmLogin.pwd3.Visible = False
        Exit Function
    End If
    If IsNumeric(Trim(pwd)) And Len(pwd) < 6 Then
        frmLogin.pwd1.Visible = True
        frmLogin.pwd2.Visible = False
        frmLogin.pwd3.Visible = False
        Exit Function
    End If
    If Not IsNumeric(Trim(pwd)) And Len(pwd) < 6 Then
        frmLogin.pwd1.Visible = False
        frmLogin.pwd2.Visible = True
        frmLogin.pwd3.Visible = False
        Exit Function
    End If
    If IsNumeric(Trim(pwd)) And Len(pwd) > 6 Then
        frmLogin.pwd1.Visible = False
        frmLogin.pwd2.Visible = True
        frmLogin.pwd3.Visible = False
        Exit Function
    End If
    If Not IsNumeric(Trim(pwd)) And Len(pwd) > 6 Then
        frmLogin.pwd1.Visible = False
        frmLogin.pwd2.Visible = False
        frmLogin.pwd3.Visible = True
        Exit Function
    End If
End Function
'检查登陆密码的强度2(for 软件锁定版)
Public Function chkuserpwd2(ByVal pwd As String)
    If pwd = "" Then
        frmlock.pwd1.Visible = False
        frmlock.pwd2.Visible = False
        frmlock.pwd3.Visible = False
        Exit Function
    End If
    If IsNumeric(Trim(pwd)) And Len(pwd) < 6 Then
        frmlock.pwd1.Visible = True
        frmlock.pwd2.Visible = False
        frmlock.pwd3.Visible = False
        Exit Function
    End If
    If Not IsNumeric(Trim(pwd)) And Len(pwd) < 6 Then
        frmlock.pwd1.Visible = False
        frmlock.pwd2.Visible = True
        frmlock.pwd3.Visible = False
        Exit Function
    End If
    If IsNumeric(Trim(pwd)) And Len(pwd) > 6 Then
        frmlock.pwd1.Visible = False
        frmlock.pwd2.Visible = True
        frmlock.pwd3.Visible = False
        Exit Function
    End If
    If Not IsNumeric(Trim(pwd)) And Len(pwd) > 6 Then
        frmlock.pwd1.Visible = False
        frmlock.pwd2.Visible = False
        frmlock.pwd3.Visible = True
        Exit Function
    End If
End Function
'检查登陆密码的强度3(for 提升权限版)
Public Function chkuserpwd3(ByVal pwd As String)
    If pwd = "" Then
        frmsuperuser.pwd1.Visible = False
        frmsuperuser.pwd2.Visible = False
        frmsuperuser.pwd3.Visible = False
        Exit Function
    End If
    If IsNumeric(Trim(pwd)) And Len(pwd) < 6 Then
        frmsuperuser.pwd1.Visible = True
        frmsuperuser.pwd2.Visible = False
        frmsuperuser.pwd3.Visible = False
        Exit Function
    End If
    If Not IsNumeric(Trim(pwd)) And Len(pwd) < 6 Then
        frmsuperuser.pwd1.Visible = False
        frmsuperuser.pwd2.Visible = True
        frmsuperuser.pwd3.Visible = False
        Exit Function
    End If
    If IsNumeric(Trim(pwd)) And Len(pwd) > 6 Then
        frmsuperuser.pwd1.Visible = False
        frmsuperuser.pwd2.Visible = True
        frmsuperuser.pwd3.Visible = False
        Exit Function
    End If
    If Not IsNumeric(Trim(pwd)) And Len(pwd) > 6 Then
        frmsuperuser.pwd1.Visible = False
        frmsuperuser.pwd2.Visible = False
        frmsuperuser.pwd3.Visible = True
        Exit Function
    End If
End Function
'检查登陆密码的强度4(for 登陆用户帐户管理版)
Public Function chkuserpwd4(ByVal pwd As String)
    If pwd = "" Then
        frmuserlogin.pwd1.Visible = False
        frmuserlogin.pwd2.Visible = False
        frmuserlogin.pwd3.Visible = False
        Exit Function
    End If
    If IsNumeric(Trim(pwd)) And Len(pwd) < 6 Then
        frmuserlogin.pwd1.Visible = True
        frmuserlogin.pwd2.Visible = False
        frmuserlogin.pwd3.Visible = False
        Exit Function
    End If
    If Not IsNumeric(Trim(pwd)) And Len(pwd) < 6 Then
        frmuserlogin.pwd1.Visible = False
        frmuserlogin.pwd2.Visible = True
        frmuserlogin.pwd3.Visible = False
        Exit Function
    End If
    If IsNumeric(Trim(pwd)) And Len(pwd) > 6 Then
        frmuserlogin.pwd1.Visible = False
        frmuserlogin.pwd2.Visible = True
        frmuserlogin.pwd3.Visible = False
        Exit Function
    End If
    If Not IsNumeric(Trim(pwd)) And Len(pwd) > 6 Then
        frmuserlogin.pwd1.Visible = False
        frmuserlogin.pwd2.Visible = False
        frmuserlogin.pwd3.Visible = True
        Exit Function
    End If
End Function
'状态栏的警告信息
Public Function pwdinfo()
    If frmLogin.pwd1.Visible = True Then
        frmmain.statmain.Panels(2).Text = "提示：您当前用户的密码强度太弱。"
    End If
    If frmLogin.pwd2.Visible = True Then
        frmmain.statmain.Panels(2).Text = "提示：您当前用户的密码强度普通。"
    End If
    If frmLogin.pwd3.Visible = True Then
        frmmain.statmain.Panels(2).Text = "提示：您当前用户的密码强度安全。"
    End If
End Function
'提升权限
Public Function chksuperuser() As Boolean
    frmsuperuser.Show vbModal
    If frmmain.chkuser.Value = 1 Then
        chksuperuser = True
    Else
        chksuperuser = False
    End If
End Function