[ Home  |  FAQ-Related Q&As  |  General Q&As  |  Answered Questions ]

    Search the Q&A Archives

my codes....... 'login form Dim iCtr As Integer Dim...

<< Back to: FAQ: (1/95) comp.lang.basic.visual.* General Frequently Asked Questions

Question by Arlene
Submitted on 7/8/2003
Related FAQ: FAQ: (1/95) comp.lang.basic.visual.* General Frequently Asked Questions
Rating: Not yet rated Rate this question: Vote
my codes.......


'login form

Dim iCtr As Integer
Dim iIn As Integer
Dim sMsg(1) As String
Private Function isFound(sUser As String, sPass As String) As Boolean
    Call ConnectDB
    'strSQL = "SELECT * FROM Security WHERE PWord = '" & sPass & "' AND UName = '" & sUser & "'"
    strSQL = "SELECT * FROM Security WHERE UName = '" & sUser & "'"
    Set rs = New ADODB.Recordset
    rs.Open strSQL, cn, adOpenStatic, adLockReadOnly
    If rs.RecordCount = 1 Then
        strSQL = "SELECT * FROM Security WHERE PWord = '" & sPass & "' AND UName = '" & sUser & "'"
        Set rs = New ADODB.Recordset
        rs.Open strSQL, cn, adOpenStatic, adLockReadOnly
        
        If rs.RecordCount = 1 Then
            isFound = True
        Else
            iIn = 0
            isFound = False
        End If
    Else
        iIn = 1
        isFound = False
    End If
    rs.Close
    cn.Close
End Function

Private Sub cmdLogin_Click(Index As Integer)
    Select Case Index
            Case 0
                If isFound(txtLogin(0).Text, txtLogin(1).Text) = True Then
                    frmMainMenu.Show
                    Unload Me
                Else
                    iCtr = iCtr + 1
                    MsgBox sMsg(iIn)
                    If iCtr = 5 Then
                        End
                    End If
                End If
            Case 1
                Unload Me
        End Select
End Sub

Private Sub Form_Load()
    sMsg(0) = "Wrong password"
    sMsg(1) = "Invalid Username"
End Sub


'this codes is for my user maintenance forms which will add , delete or edit username......

Dim tmpUName As String
Dim tmpPWord As String
Dim tmpLevel As Integer
Dim iAction As Integer
Dim iFlag As Integer
'width=4695+200
'height=3000+200
Private Sub LoadLevel()
cboLevel.Clear
cboLevel.AddItem ""
cboLevel.AddItem "[1] Fina Officer"
cboLevel.AddItem "[2] HRD"
cboLevel.AddItem "[3] Accountant"
cboLevel.AddItem "[4] Secretary"
cboLevel.AddItem "[5] Administrator"
End Sub
Private Sub DoEnable(oks As Boolean)
    If oks = False Then ClearFields
    txtSecurity(0).Enabled = oks
    txtSecurity(1).Enabled = oks
    If iAction = 2 Then GoTo Action2
    txtSecurity(2).Enabled = oks
    cboLevel.Enabled = oks
Action2:
    itmSave.Enabled = oks
    itmCancel.Enabled = oks
    If oks = True Then oks = False Else oks = True
    itmNew.Enabled = oks
    itmEdit.Enabled = oks
    itmDelete.Enabled = oks
End Sub
Private Sub ClearFields()
    txtSecurity(0).Text = ""
    txtSecurity(1).Text = ""
    txtSecurity(2).Text = ""
    cboLevel.ListIndex = 0
End Sub
Private Function isDataOk() As Boolean
    isDataOk = True
    iFlag = 0
    If Trim(txtSecurity(0).Text) = "" Then isDataOk = False
    If Trim(txtSecurity(1).Text) = "" Then isDataOk = False
    If Trim(txtSecurity(2).Text) = "" Then isDataOk = False
    If Trim(txtSecurity(2).Text) <> Trim(txtSecurity(1).Text) Then
        isDataOk = False
        iFlag = 1
    End If
End Function
Private Sub DeleteMode()
Dim retVal
    If isFound(txtSecurity(0).Text, txtSecurity(1).Text) = True Then
        rs.Close
        cn.Close
        objChar.speak "Are you sure to delete this record?"
        retVal = MsgBox("Are you sure to delete this record?", vbQuestion + vbYesNo, "DELETE?")
        If retVal = vbYes Then
            Call ConnectDB
            strSQL = "DELETE * FROM Security WHERE UName LIKE '" & txtSecurity(0).Text & "' AND PWord = '" & txtSecurity(1).Text & "'"
            cn.Execute strSQL
            cn.Close
        End If
        Call DoEnable(False)
    Else
        objChar.speak "No Record to Delete"
        MsgBox "No Record to Delete"
    End If
End Sub
Private Sub EditMode()
Dim retVal
    If isFound(txtSecurity(0).Text, txtSecurity(1).Text) = True Then
        txtSecurity(0).Text = rs.Fields(0)
        txtSecurity(1).Text = rs.Fields(1)
        txtSecurity(2).Text = rs.Fields(1)
        cboLevel.ListIndex = rs.Fields(2)
        tmpUName = rs.Fields(0)
        tmpPWord = rs.Fields(1)
    Else
        objChar.speak "No record to edit."
        MsgBox "No Record to Edit"
    End If
End Sub
Private Function isDuplicateUser(strU As String) As Boolean
    Call ConnectDB
    strSQL = "SELECT * FROM Security WHERE UName LIKE '" & strU & "'"
    Set rs = New ADODB.Recordset
    rs.Open strSQL, cn, adOpenStatic, adLockReadOnly, adCmdText
    If rs.RecordCount = 1 Then
        isDuplicateUser = True
    Else
        isDuplicateUser = False
    End If
End Function

Private Function isFound(strU As String, strP As String) As Boolean
    Call ConnectDB
    strSQL = "SELECT * FROM Security WHERE UName LIKE '" & strU & "' AND PWord = '" & strP & "'"
    Set rs = New ADODB.Recordset
    rs.Open strSQL, cn, adOpenStatic, adLockReadOnly, adCmdText
    If rs.RecordCount = 1 Then
        isFound = True
    Else
        isFound = False
    End If
End Function
Private Sub EditUser()
    Call ConnectDB
    strSQL = "UPDATE Security SET UName = '" & txtSecurity(0).Text & "', PWord = '" & txtSecurity(1).Text & "', iLevel = " & cboLevel.ListIndex & " WHERE UName LIKE '" & tmpUName & "'AND PWord LIKE '" & tmpPWord & "';"
    cn.Execute strSQL
    cn.Close
End Sub
Private Sub AddNewUser()
    If isDuplicateUser(Trim(txtSecurity(0).Text)) = True Then
        objChar.speak "Please chose another username!"
        MsgBox "Please chose another username!", vbInformation
        Exit Sub
    End If
    Call ConnectDB
    strSQL = "INSERT INTO Security (UName, PWord, iLevel) VALUES ('" & txtSecurity(0).Text & "', '" & txtSecurity(1).Text & "', " & cboLevel.ListIndex & ")"
    cn.Execute strSQL
    cn.Close
End Sub
Private Sub Form_Activate()
    Call DoEnable(False)
End Sub
Private Sub Form_Load()
    Call LoadLevel
End Sub
Private Sub itmCancel_Click()
    Call DoEnable(False)
End Sub
Private Sub itmDelete_Click()
    iAction = 2
    Call DoEnable(True)
End Sub
Private Sub itmEdit_Click()
    iAction = 1
    Call DoEnable(True)
End Sub
Private Sub itmNew_Click()
    iAction = 0
    Call DoEnable(True)
End Sub
Private Sub itmSave_Click()
    If isDataOk = False Then
        If iFlag = 0 Then
            objChar.speak "Please check the entries!"
            MsgBox "Please check the entries", vbInformation
        ElseIf iFlag = 1 Then
            objChar.speak "Password mismatch!"
            MsgBox "Password mismatch", vbInformation
        End If
        Exit Sub
    End If
    Select Case iAction
            Case 0
                Call AddNewUser
            Case 1
                Call EditUser
        End Select
    Call DoEnable(False)
End Sub
Private Sub itmUtil_Click()
    Unload Me
End Sub
Private Sub txtSecurity_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then
    Select Case Index
            Case 0
                txtSecurity(1).SetFocus
            Case 1
                If iAction = 1 Then
                    Call EditMode
                ElseIf iAction = 2 Then
                    Call DeleteMode
                Else
                    txtSecurity(2).SetFocus
                End If
            Case 2
                cboLevel.SetFocus
        End Select
End If
End Sub



'this is my codes for my module

Public rs As ADODB.Recordset
Public cn As ADODB.Connection
Public strSQL As String
Public strConnection As String

Sub Main()
    strConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db1.mdb;Persist Security Info=False"
    frmLogin.Show
End Sub

Public Sub ConnectDB()
    On Error Resume Next
    cn.Close
    Set cn = New ADODB.Connection
    cn.Open strConnection
End Sub

'error message when i'm executing my prog....

'connection cannot be used to perform this operation.It is either closed or invalid in this context



Your answer will be published for anyone to see and rate.  Your answer will not be displayed immediately.  If you'd like to get expert points and benefit from positive ratings, please create a new account or login into an existing account below.


Your name or nickname:
If you'd like to create a new account or access your existing account, put in your password here:
Your answer:

FAQS.ORG reserves the right to edit your answer as to improve its clarity.  By submitting your answer you authorize FAQS.ORG to publish your answer on the WWW without any restrictions. You agree to hold harmless and indemnify FAQS.ORG against any claims, costs, or damages resulting from publishing your answer.

 

FAQS.ORG makes no guarantees as to the accuracy of the posts. Each post is the personal opinion of the poster. These posts are not intended to substitute for medical, tax, legal, investment, accounting, or other professional advice. FAQS.ORG does not endorse any opinion or any product or service mentioned mentioned in these posts.

 

<< Back to: FAQ: (1/95) comp.lang.basic.visual.* General Frequently Asked Questions

[ Home  |  FAQ-Related Q&As  |  General Q&As  |  Answered Questions ]
© 2008 FAQS.ORG. All rights reserved.