frmlogin.frm

一个用于交警的系统

        Exit Function
    End If
    If Trim(txtPassword) = vbNullString Then 'If user don't input password
        If LanguageUsed = Chinese Then
            MsgBox "请输入用户登录口令!", vbExclamation + vbOKOnly, "系统信息"
        Else
            MsgBox "Please input password!", vbExclamation + vbOKOnly, "System Message"
        End If
        With txtPassword
            .SelStart = 0
            .SelLength = Len(.Text)
            
            On Error GoTo SFErrMsg
            .SetFocus
            On Error GoTo ErrMsg
            
        End With
        Exit Function
    End If

    Screen.MousePointer = 11
    strSQL = "Select * From " & Trim(tblName) & " Where " & Trim(fldUserName) & "='" & UCase(Trim(txtUserName)) & "'"
    With rsNewUser
        If .State <> 0 Then .Close
        .Open strSQL, UserConnection, adOpenKeyset, adLockReadOnly, adCmdText 'Search user
        If .RecordCount <= 0 Then 'If user hasn't existed
            Screen.MousePointer = 0
            If LanguageUsed = Chinese Then
                MsgBox "当前用户" & IIf(Trim(txtUserName) = "", "", Space(1) & UCase(txtUserName) & Space(1)) & "不存在!", vbExclamation + vbOKOnly, "系统信息"
            Else
                MsgBox "The current user " & IIf(Trim(txtUserName) = "", "", Space(1) & UCase(txtUserName) & Space(1)) & " hasn't existed!", vbExclamation + vbOKOnly, "System Message"
            End If
            With txtUserName
                .SelStart = 0
                .SelLength = Len(.Text)
                
                On Error GoTo SFErrMsg
                .SetFocus
                On Error GoTo ErrMsg
                
            End With
            Exit Function
        Else 'If find current user
            strPassword = IIf(IsNull(.Fields(fldPassword)), "", Trim(.Fields(fldPassword))) 'Fetch user password
            If LCase(strPassword) <> LCase(txtPassword) Then 'Confirm password
                Screen.MousePointer = 0
                If LanguageUsed = Chinese Then
                    MsgBox "用户口令输入错误,请重新输入!", vbExclamation + vbOKOnly, "系统信息"
                Else
                    MsgBox "Password invalid,Please input it again!", vbExclamation + vbOKOnly, "System Message"
                End If
                With txtPassword
                    .SelStart = 0
                    .SelLength = Len(.Text)
                    
                    On Error GoTo SFErrMsg
                    .SetFocus
                    On Error GoTo ErrMsg
                    
                End With
                Exit Function
            Else 'If password is right
                CheckUserAndPassword = True
            End If
        End If
        .Close
        Set rsNewUser = Nothing
    End With
    SaveSetting App.Title, "Setting", "LoginUserName", Trim(txtUserName)
    Screen.MousePointer = 0
    Exit Function
    
SFErrMsg:
    Resume Next
    Exit Function

ErrMsg:
    CheckUserAndPassword = False
    Set rsNewUser = Nothing
    Call ShowErrorMessage
End Function

'*** 标签设置 ***************************************
'Created by ZhangGuoSheng
'On 06-17-2001

Private Sub SetCaption()
    If LanguageUsed = Chinese Then
        mnuLanguage.Caption = "语言 &L"
        mnuDatabase.Caption = "数据库 &D"
        mnuOption.Caption = "选项 &O"
        
        mnuChinese.Caption = "简体中文 &C"
        mnuEnglish.Caption = "美国英语 &E"
        
        mnuAccess.Caption = "Access 数据库 &A"
        mnuSQLServer.Caption = "SQL Server 数据库 &S"
        mnuOracle.Caption = "Oracle 数据库 &O"
        mnuFoxpro.Caption = "Foxpro 数据库 &F"
        mnuOther.Caption = "ODBC 连接的数据库 &D"
        
        mnuRememberUser.Caption = "记住登录用户名 &U"
        mnuRememberPassword.Caption = "记住登录口令 &P"
        
        fUserLogin.Caption = " 登录 "
        If fUserLogin.Enabled = True Then
            Me.Caption = " 用户登录"
        Else
            Me.Caption = " 数据库登录"
        End If
        
        With Me
            .lblDSN.Caption = "数据源 &S"
            .lblDSNDatabase.Caption = "数据库名 &D"
            .lblDSNPassword.Caption = "登录口令 &P"
            .lblDSNUser.Caption = "登录用户 &U"
            
            .lblAccessFile.Caption = "Access 数据库文件 &F"
            .lblAccessPassword.Caption = "登录口令 &P"
            .lblAccessUser.Caption = "登录用户 &U"
            
            .lblFoxproFile.Caption = "Foxpro 数据库文件 &F"
            .lblFoxproUser.Caption = "Foxpro 数据库排序序列 &S"
            
            .lblOraclePassword.Caption = "登录口令 &P"
            .lblOracleServer.Caption = "服务器名 &S"
            .lblOracleUser.Caption = "登录用户 &U"
        
            .lblSQLDatabase.Caption = "数据库名 &D"
            .lblSQLPassword.Caption = "登录口令 &P"
            .lblSQLServer.Caption = "服务器名 &S"
            .lblSQLUserName.Caption = "登录用户 &U"
            
            .lblUserName.Caption = "登录用户 &U"
            .lblPassword.Caption = "登录口令 &P"
        End With
        
        With Me
            .cmdLogin.Caption = "确定 &O"
            .cmdExit.Caption = "退出 &E"
            .cmdYes.Caption = "登录 &L"
            .cmdCancel.Caption = "退出 &E"
        End With
        
    ElseIf LanguageUsed = English Then
        mnuLanguage.Caption = "&Luaguage"
        mnuDatabase.Caption = "&Database"
        mnuOption.Caption = "&Option"
        
        mnuChinese.Caption = "&Chinese"
        mnuEnglish.Caption = "&English"
        
        mnuAccess.Caption = "&Access Database"
        mnuSQLServer.Caption = "&SQL Server Database"
        mnuOracle.Caption = "&Oracle Database"
        mnuFoxpro.Caption = "&Foxpro Database"
        mnuOther.Caption = "ODBC Connection &Database"
        
        mnuRememberUser.Caption = "Remember Login &User"
        mnuRememberPassword.Caption = "Remember Login &Password"
        
        fUserLogin.Caption = " Login "
        If fUserLogin.Visible = True Then
            Me.Caption = " User Login"
        Else
            Me.Caption = " Database Login"
        End If
        
        With Me
            .lblDSN.Caption = "Data &Source"
            .lblDSNDatabase.Caption = "&Database"
            .lblDSNPassword.Caption = "&Password"
            .lblDSNUser.Caption = "&User Name"
            
            .lblAccessFile.Caption = "Access Database &File"
            .lblAccessPassword.Caption = "&Password"
            .lblAccessUser.Caption = "&User Name"
            
            .lblFoxproFile.Caption = "Foxpro Database &File"
            .lblFoxproUser.Caption = "Foxpro Database Collating &Sequence"
            
            .lblOraclePassword.Caption = "&Password"
            .lblOracleServer.Caption = "&Server Name"
            .lblOracleUser.Caption = "&User Name"
        
            .lblSQLDatabase.Caption = "&Database Name"
            .lblSQLPassword.Caption = "&Password"
            .lblSQLServer.Caption = "&Server Name"
            .lblSQLUserName.Caption = "&User Name"
            
            .lblUserName.Caption = "&User Name"
            .lblPassword.Caption = "&Password"
        End With
        
        With Me
            .cmdLogin.Caption = "&OK"
            .cmdExit.Caption = "&Exit"
            .cmdYes.Caption = "&Login"
            .cmdCancel.Caption = "&Exit"
        End With
        
    End If
End Sub

Private Sub cboDSNDatabase_GotFocus()
    Call SetStatusText(cboDSNDatabase)
End Sub

Private Sub cboDSNList_GotFocus()
    Call SetStatusText(cboDSNList)
End Sub

Private Sub cboFoxproSequence_GotFocus()
    Call SetStatusText(cboFoxproSequence)
End Sub

Private Sub cboOracleServer_GotFocus()
    Call SetStatusText(cboOracleServer)
End Sub

Private Sub cboSQLDatabase_GotFocus()
    Call SetStatusText(cboSQLDatabase)
End Sub

Private Sub cboSQLServer_GotFocus()
    Call SetStatusText(cboSQLServer)
End Sub

Private Sub cmdAccessFile_Click()
    On Error GoTo ErrMsg
    Dim strFileName As String
    
    With Me.CommonDialog1
        .CancelError = True
        .DialogTitle = "文件选择"
        .Filter = "Access 文件(*.mdb)|*.mdb|所有文件(*.*)|*.*"
        .Flags = &H4
        .ShowOpen
        strFileName = .FileName
    End With
    If Trim(strFileName) <> vbNullString Then
        If LCase(Right$(Trim(strFileName), 3)) <> "dbf" Then
            Screen.MousePointer = 0
            If LanguageUsed = Chinese Then
                MsgBox "当前选择的文件不是 Access 库文件 (*.mdb)!" & vbCrLf & Trim(strFileName), vbExclamation + vbOKOnly, "系统信息"
            Else
                MsgBox "The current file isn't an access file (*.mdb)!" & vbCrLf & Trim(strFileName), vbExclamation + vbOKOnly, "System Message"
            End If
        Else
            txtAccessFile = strFileName
        End If
    End If
    Exit Sub

ErrMsg:
    Exit Sub
End Sub

Private Sub cmdCancel_Click()
    Unload Me
    End
End Sub

Private Sub cmdCancel_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
    Call SetStatusText(cmdCancel)
End Sub

Private Sub cmdExit_Click()
    Unload Me
    End
End Sub
Private Sub ShowErrorMessage()
    Screen.MousePointer = 0
    If LanguageUsed = Chinese Then
        MsgBox "错误号: " & Err.Number & vbCrLf & _
            "错误描述: " & Err.Description & vbCrLf & _
            "错误源: " & Err.Source, vbExclamation + vbOKOnly, "系统信息"
    Else
        MsgBox "ErrorNumber: " & Err.Number & vbCrLf & _
            "ErrorDescription: " & Err.Description & vbCrLf & _
            "ErrorSource: " & Err.Source, vbExclamation + vbOKOnly, "System Message"
    End If
End Sub

Private Sub cmdExit_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
    Call SetStatusText(cmdExit)
End Sub

Private Sub cmdFoxproFile_Click()
    On Error GoTo ErrMsg
    Dim strFileName As String
    
    With Me.CommonDialog1
        .CancelError = True
        .DialogTitle = "文件选择"
        .Filter = "Foxpro 文件(*.dbf)|*.dbf|所有文件(*.*)|*.*"
        .Flags = &H4
        .ShowOpen
        strFileName = .FileName
    End With
    If Trim(strFileName) <> vbNullString Then
        If LCase(Right$(Trim(strFileName), 3)) <> "dbf" Then
            Screen.MousePointer = 0
            If LanguageUsed = Chinese Then
                MsgBox "当前选择的文件不是 Foxpro 库文件 (*.dbf)!" & vbCrLf & Trim(strFileName), vbExclamation + vbOKOnly, "系统信息"
            Else
                MsgBox "The current file isn't a foxpro file (*.dbf)!" & vbCrLf & Trim(strFileName), vbExclamation + vbOKOnly, "System Message"
            End If
        Else
            txtFoxproFile = strFileName
        End If
    End If
    Exit Sub

ErrMsg:
    Exit Sub
End Sub

Private Sub cmdLogin_Click()
    On Error GoTo ErrMsg
    
    Select Case DatabaseUsed
    Case AccessDatabase
        If CreateConnection(AccessDatabase, Trim(txtAccessFile), Trim(txtAccessUser), Trim(txtAccessPassword)) = False Then Exit Sub
        SaveSetting App.Title, "Setting", "DatabaseSelected", AccessDatabase
        SaveSetting App.Title, "Setting", "DSN", Trim(txtAccessFile)
        SaveSetting App.Title, "Setting", "Other", ""
        SaveSetting App.Title, "Setting", "UserName", Trim(txtAccessUser)
        SaveSetting App.Title, "Setting", "Password", Trim(txtAccessPassword)
    Case SQLServerDatabase
        If CreateConnection(SQLServerDatabase, Trim(Me.cboSQLServer.Text), Trim(txtSQLUser), Trim(txtSQLPassword), Trim(Me.cboSQLDatabase.Text)) = False Then Exit Sub
        SaveSetting App.Title, "Setting", "DatabaseSelected", SQLServerDatabase
        SaveSetting App.Title, "Setting", "DSN", Trim(Me.cboSQLServer.Text)
        SaveSetting App.Title, "Setting", "Other", Trim(Me.cboSQLDatabase.Text)
        SaveSetting App.Title, "Setting", "UserName", Trim(txtSQLUser)
        SaveSetting App.Title, "Setting", "Password", Trim(txtSQLPassword)
    Case OracleDatabase
        If CreateConnection(OracleDatabase, Trim(Me.cboOracleServer.Text), Trim(txtOracleUser), Trim(txtOraclePassword)) = False Then Exit Sub
        SaveSetting App.Title, "Setting", "DatabaseSelected", OracleDatabase
        SaveSetting App.Title, "Setting", "DSN", Trim(Me.cboOracleServer.Text)
        SaveSetting App.Title, "Setting", "Other", ""
        SaveSetting App.Title, "Setting", "UserName", Trim(txtOracleUser)
        SaveSetting App.Title, "Setting", "Password", Trim(txtOraclePassword)
    Case FoxproDatabase
        If CreateConnection(FoxproDatabase, Trim(txtFoxproFile), , , Trim(Me.cboFoxproSequence.Text)) = False Then Exit Sub
        SaveSetting App.Title, "Setting", "DatabaseSelected", FoxproDatabase
        SaveSetting App.Title, "Setting", "DSN", Trim(txtFoxproFile)
        SaveSetting App.Title, "Setting", "Other", Trim(Me.cboFoxproSequence.Text)
        SaveSetting App.Title, "Setting", "UserName", ""
        SaveSetting App.Title, "Setting", "Password", ""
    Case OtherDatabase
        If CreateConnection(OtherDatabase, Trim(cboDSNList.Text), Trim(txtDSNUserName), Trim(txtDSNPassword), Trim(cboDSNDatabase.Text)) = False Then Exit Sub
        SaveSetting App.Title, "Setting", "DatabaseSelected", OtherDatabase
        SaveSetting App.Title, "Setting", "DSN", Trim(cboDSNList.Text)
        SaveSetting App.Title, "Setting", "Other", Trim(cboDSNDatabase.Text)
        SaveSetting App.Title, "Setting", "UserName", Trim(txtDSNUserName)
        SaveSetting App.Title, "Setting", "Password", Trim(txtDSNPassword)
    Case Else
        
    End Select
    
    If LanguageUsed = Chinese Then
        SaveSetting App.Title, "Setting", "LanguageUsed", Chinese
    Else
        SaveSetting App.Title, "Setting", "LanguageUsed", English
    End If
    
    Call ShowControlsSelected(DatabaseUsed, True)
    Call FormResize(True)
    
    Call SetCaption
    
    Exit Sub
    
ErrMsg:
    Call ShowErrorMessage
End Sub

Private Sub cmdLogin_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
    Call SetStatusText(cmdLogin)
End Sub

Private Sub cmdYes_Click()
    
    If UserConnection Is Nothing Then
        Call cmdLogin_Click
    End If
    If UserConnection = vbNullString Then
        Call cmdLogin_Click
    End If
    
    If LanguageUsed = Chinese Then
        ShowText "正在验证用户身份 ..."
    Else
        ShowText "Verifing user ..."
    End If
    
    '****************************************************************
    '根据程序的不同,改变下面参数的设置
    
    If CheckUserAndPassword(UserConnection, "acd_useright", "puser", "pwd") = False Then
    
    '****************************************************************
    
        If LanguageUsed = Chinese Then
            ShowText "验证用户身份时出错!"
        Else
            ShowText "Error!"
        End If
        Exit Sub
    Else
        SaveSetting App.Title, "Setting", "LoginUserName", Trim(txtUserName)
        SaveSetting App.Title, "Setting", "LoginPassword", Trim(txtPassword)
        
        SaveSetting App.Title, "Setting", "RememberUserName", IIf(mnuRememberUser.Checked = False, 0, 1)
        SaveSetting App.Title, "Setting", "RememberPassword", IIf(mnuRememberPassword.Checked = False, 0, 1)
        
        If LanguageUsed = Chinese Then
            ShowText "验证用户身份成功"
        Else
            ShowText "Verify user successfully"
        End If
    End If
    
    '*****************************************************************
    '接用户其它程序
    '......
    
'    Dim frmNew As New frmAbout
'    Call frmNew.SetParameter(LanguageUsed)
'    frmNew.Show 1
'    Set frmNew = Nothing

    Dim frmNew As New frmSplash
    Call frmNew.SetParameter(LanguageUsed, Me.Icon)
    Call frmNew.FormLoad