LOGIN FORM AND DISABLE FULLMENU MODUL?

• Question

• 

  

  0

  Sign in to vote

  Option Compare Database

  Option Explicit

   

  Private Sub CMD_CANCEL_Click()

      DoCmd.RunCommand acCmdExit

  End Sub

   

  Private Sub cmd_ok_Click()

      'Dim myset As Recordset, Doi As Integer

     

     

      If IsNull(Me!User.Value) Then

          DoCmd.RunCommand acCmdExit

      Else

          CodeUserChk = Me!User.Value

          CodeUser = DLookup("TEN_NSD", "ST_NSD", "TEN_NSD = '" & CodeUserChk & "'")

          If IsNull(CodeUser) Then

          DoCmd.RunCommand acCmdExit

          End If

      End If

   

      If IsNull(Me!PW.Value) Then

           DoCmd.RunCommand acCmdExit

      Else

          CodePwdChk = Me!PW.Value

          CodePwd = Dlookup("MM", "ST_NSD", "MM = '" & CodePwdChk & "'And [TEN_NSD] ='" & CodeUser & "'")

          If IsNull(CodePwd) Then

              DoCmd.RunCommand acCmdExit

            End If

      End If

   

      If Not IsNull(CodeUser) And Not IsNull(CodePwd) Then

      DoCmd.Close

      DoCmd.OpenForm "SFSTART"

      Else

      DoCmd.RunCommand acCmdExit

      End If

  End Sub

   

  Private Sub cmdexit_Click()

  DoCmd.Close

  End Sub

   

  Private Sub cmdLock_Click()

   

   

    '‘Bi?u m?u này du?c n?p tru?c

   

    ChangeProperty "StartupForm", dbText, "SF_MATMA"

   

    ChangeProperty "StartupShowDBWindow", dbBoolean, False

   

    ChangeProperty "StartupShowStatusBar", dbBoolean, False

   

    ChangeProperty "AllowBuiltinToolbars", dbBoolean, False

   

    ChangeProperty "AllowFullMenus", dbBoolean, False

   

    ChangeProperty "AllowBreakIntoCode", dbBoolean, False

   

    ChangeProperty "AllowSpecialKeys", dbBoolean, False

   

    'Không cho xài phím Shift d? b? qua bi?u m?u frmKhoiDong

   

    ChangeProperty "AllowBypassKey", dbBoolean, False

   

    cmdexit.SetFocus

   

    cmdUnlock.Visible = True

   

    cmdLock.Visible = False

   

   

  End Sub

   

  Private Sub cmdUnlock_Click()

   

    'Không c?n bi?u m?u kh?i d?ng n?a

  If txtpassword.Value = "24564" Then

    ChangeProperty "StartupForm", dbText, ""

   

    ChangeProperty "StartupShowDBWindow", dbBoolean, True

   

    ChangeProperty "StartupShowStatusBar", dbBoolean, True

   

    ChangeProperty "AllowBuiltinToolbars", dbBoolean, True

   

    ChangeProperty "AllowFullMenus", dbBoolean, True

   

    ChangeProperty "AllowBreakIntoCode", dbBoolean, True

   

    ChangeProperty "AllowSpecialKeys", dbBoolean, True

   

    ChangeProperty "AllowBypassKey", dbBoolean, True

   

    cmdexit.SetFocus

   

    txtpassword = ""

   

    cmdLock.Visible = True

   

    cmdUnlock.Visible = False

   

    txtpassword.Visible = False

    Else

    THONGBAO "baïn khoâng coù quyeàn!"

    Exit Sub

  End If

  End Sub

   

  Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

      If KeyCode = vbKeyEscape Then

          KeyCode = 0

          DoCmd.RunCommand acCmdExit

      End If

  End Sub

   

  Private Sub Form_Open(Cancel As Integer)

   

    Dim dbs As Database

   

    Set dbs = CurrentDb

   

    On Error GoTo KhongCoThuocTinh_Err

   

    If dbs.Properties("AllowBypassKey") Then

   

      cmdLock.Visible = True

   

      txtpassword.Visible = False

   

    Else

   

      cmdLock.Visible = False

   

      txtpassword.Visible = True

   

    End If

   

    Exit Sub

   

  KhongCoThuocTinh_Err:

   

    cmdLock.Visible = True

   

    txtpassword.Visible = False

   

   

   

   

  End Sub

   

  Private Sub txtPassword_LostFocus()

   

    If txtpassword = "24564" Then

   

      cmdUnlock.Visible = True

   

    End If

   

   

  End Sub

   

   

   

   

   

   

  Option Compare Database

   

  Function ChangeProperty(strPropName, varPropType, varPropValue)

   

    Dim dbs As Database, prp As Property

   

    Const conPropNotFoundError = 3270

   

    Set dbs = CurrentDb

   

    On Error GoTo Change_XuLyLoi

   

    dbs.Properties(strPropName) = varPropValue

   

    ChangeProperty = True

   

  Change_KetThuc:

   

    Exit Function

   

  Change_XuLyLoi:

   

    'Thu?c tính không th?y

   

    If Err = conPropNotFoundError Then

   

    Set prp = dbs.CreateProperty(strPropName, varPropType, varPropValue)

   

    dbs.Properties.Append prp

   

    Resume Next

   

    Else

   

    'Không bi?t l?i gì

   

    ChangeProperty = False

   

    Resume Change_KetThuc

   

    End If

   

  End Function

  Tuesday, March 22, 2011 1:34 PM