Thủ thuật Log-In, Phân quyền dùng VBA

Liên hệ QC

lethanhnhan

Thành viên chính thức
Tham gia
27/5/07
Bài viết
76
Được thích
248
Chào các bạn,
Chắc có lẻ đây là câu hỏi mà các bạn thường gặp khi "trình độ lập trình VBA" của mình "có vẻ khả quan" !
_Làm thế nào để tôi phân quyền người dùng trên các worksheet?
_Làm thế nào để tôi phần quyền người dùng trên các form?
...và các câu hỏi gần như có cùng mục đích.

Tôi xin giới thiệu với các bạn "một giải pháp củ chuối" hy vọng các bạn hài lòng.

Để phân quyền tôi phải biết được tên người dùng.
Tôi muốn người dùng phải Log-In khi workbook mở ra, tôi dùng đọan code sau:
Mã:
Private Sub Workbook_Open()
    On Error GoTo Workbook_Open_Error
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    frmLogIn.Show
    Call ActionB4CloseOpen("OPEN")
ErrorExit:
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = True
    End With
    Exit Sub

Workbook_Open_Error:
    If bCentralErrorHandler("ThisWorkbook", "Workbook_Open", , False) Then
        Stop
        Resume
    Else
        Resume ErrorExit
    End If
End Sub


Khi workbook được mở tôi hiện form bắt buộc người dùng log-in
Log-In.jpg


Tòan bộ code của form này như sau:
Mã:
Option Explicit
Dim iCount As Long
Private Sub cmdLogIn_Click()
    Dim sUserName As String, sUserSoSanh As String
    Dim sPass As String, sPassSoSanh As String
    Dim sRight As String
    Dim rngRange As Range
    On Error GoTo cmdLogIn_Click_Error
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    If iCount > 3 Then
        MsgBox "You have enter more than " & iCount & " times!" & vbCrLf & _
               "Pls, contact your Administrator.", vbOKOnly, "Inf"
        End
    End If
    sUserName = txtTenTruyCap.Text
    sUserSoSanh = UserExist(sUserName)
    'Check the user name
    If Len(Trim(sUserSoSanh)) = 0 Then
        MsgBox "This user does not exist!", vbOKOnly, "Inf"
        txtTenTruyCap.Text = ""
        txtPass.Text = ""
        txtTenTruyCap.SetFocus
        iCount = iCount + 1
    End If

    sPass = txtPass.Text
    'Get Password
    sPassSoSanh = GetUserPassword(sUserName)
    'Get right of User
    sRight = GetUserRight(sUserName)
    If sPass = sPassSoSanh And Len(Trim(sUserSoSanh)) > 0 Then
        If Len(Trim(sRight)) > 0 Then
            MsgBox "Welcome to             " & vbCrLf & _
                   "STOCK COUNT HELPER TOOL " & vbCrLf & _
                   "Author: Le Van Duyet" & vbCrLf & _
                   "You have accessed with " & sRight & " right.", vbOKOnly, "Inf"
            Application.Range("UserName").Value = sUserSoSanh
        Else
            MsgBox "Welcome to             " & vbCrLf & _
                   "STOCK COUNT HELPER TOOL " & vbCrLf & _
                   "Author: Le Van Duyet" & vbCrLf & _
                   "You have accessed with " & "?" & " right.", vbOKOnly, "Inf"
            iCount = iCount + 1
            Application.Range("UserName").Value = sUserSoSanh
        End If
    ElseIf Len(Trim(sUserSoSanh)) > 0 Then
        MsgBox "Wrong Password !" & vbCrLf & _
               "Pls enter again.", vbOKOnly, "Inf"
        txtPass.Text = ""
        txtPass.SetFocus
        iCount = iCount + 1
        Exit Sub

    End If

    If sRight = "Admin" And Len(Trim(sUserSoSanh)) > 0 Then
        'Neu quyen la admin thi se mo cac sheet
        'de cap nhat du lieu
        Call ActionB4CloseOpen("ACCESSDATA")
        Me.Hide
    ElseIf Len(Trim(sUserSoSanh)) > 0 Then
        MsgBox "You can only enter data!", vbOKOnly, "Inf"
        Call ActionB4CloseOpen("OPEN")
        Me.Hide
    End If

ErrorExit:
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = True
    End With
    Exit Sub

cmdLogIn_Click_Error:
    If bCentralErrorHandler("frmLogIn", "cmdLogIn_Click", , False) Then
        Stop
        Resume
    Else
        Resume ErrorExit
    End If


End Sub

Private Sub cmdThoat_Click()
    End
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'Do not allow the user close the form by clicking the X button
    If CloseMode = vbFormControlMenu Then
        Cancel = True
    End If
End Sub


Lê Thanh Nhân
 
Khi người dùng nhập vào textbox txtTenTruyCap, dựa vào dữ liệu nhập vào này mà chúng ta lấy password để so sánh.
Đầu tiên chúng ta kiểm tra xem tên người dùng này có tồn tại hay không? Nếu hàm trả về chuổi rỗng thì người dùng không tồn tại (Coi chừng lỗi injection !).
Mã:
Public Function UserExist(UserName As String) As String
    Dim rs As ADODB.Recordset
    Dim strSQL As String

    On Error GoTo UserExist_Error
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    If gcnAccess.state = ObjectStateEnum.adStateClosed Then
        Call ConnectToDatabase
    End If
    'Then get the data
    If gcnAccess.state = ObjectStateEnum.adStateClosed Then
        gcnAccess.Open
        strSQL = "SELECT User " & _
                 "FROM tbUsers " & _
                 "WHERE User = '" & UserName & "';"
        Set rs = New ADODB.Recordset
        rs.CursorType = adOpenStatic
        rs.Open strSQL, gcnAccess

        If rs.RecordCount = 0 Then
            UserExist = ""
        Else
            UserExist = rs.Fields(0)
        End If
    End If
ErrorExit:
    If gcnAccess.state = ObjectStateEnum.adStateOpen Then
        gcnAccess.Close
    End If
    If IsNull(rs) Then
        If rs.state = adStateOpen Then
            rs.Close
            Set rs = Nothing
        End If
    End If
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = True
    End With
    Exit Function
UserExist_Error:
    If bCentralErrorHandler("MainMod", "UserExist", , False) Then
        Stop
        Resume
    Else
        Resume ErrorExit
    End If
End Function
Chúng ta dựa vào câu truy vấn:
Mã:
strSQL = "SELECT User " & _
                 "FROM tbUsers " & _
                 "WHERE User = '" & UserName & "';"
Nếu tên người dùng tồn tại thì với câu truy vấn này sẽ trả về tên người dùng.
Sau đó chúng ta sẽ xem quyền của người dùng.
Mã:
Public Function GetUserPassword(UserName As String) As String
    Dim rs As ADODB.Recordset
    Dim strSQL As String
    On Error GoTo GetUserPassword_Error
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    If gcnAccess.state = ObjectStateEnum.adStateClosed Then
        Call ConnectToDatabase
    End If
    'Then get the data
    If gcnAccess.state = ObjectStateEnum.adStateClosed Then
        gcnAccess.Open
        strSQL = "SELECT Pass " & _
                 "FROM tbUsers " & _
                 "WHERE User = '" & UserName & "';"
        Set rs = New ADODB.Recordset
        rs.CursorType = adOpenStatic
        rs.Open strSQL, gcnAccess

        If rs.RecordCount = 0 Then
            GetUserPassword = ""
        Else
            GetUserPassword = rs.Fields(0)
        End If
    End If

ErrorExit:
    If gcnAccess.state = ObjectStateEnum.adStateOpen Then
        gcnAccess.Close
        bConnected = False
    End If
    If IsNull(rs) Then
        If rs.state = adStateOpen Then
            rs.Close
            Set rs = Nothing
        End If
    End If
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = True
    End With
    Exit Function

GetUserPassword_Error:

    If bCentralErrorHandler("MainModule", "GetUserPassword", , False) Then
        Stop
        Resume
    Else
        Resume ErrorExit
    End If
End Function

Tương tự trên hàm này sẽ trả về chuỗi phân quyền của người dùng. Ở đây trong bảng tbUsers tôi phân quyền là Admin và NormalUser.
Ngòai ra dựa vào ý tửơng này các bạn có thể cho biết với quyền Admin họăc NormalUser thì sẽ được truy cập đến các form nào, các thủ tục nào,...

Và cuối cùng nếu tên người dùng tồn tại ta sẽ ghi vào
Mã:
Application.Range("UserName").Value = sUserSoSanh
Nằm trong một worksheet mà người dùng bình thừơng không có quyền truy cập. Với việc lưu lại tên người dùng này, chúng ta sẽ lưu tên người dùng cùng với những thao tác với cơ sở dữ liệu như: xóa, sửa...

Ngòai ra chúng ta còn dựa vào biến đếm
Dim iCount As Long
Khai báo vào đầu module để đếm số lần nhập sai của người dùng. Nếu lớn hơn 3 lần thì..."bye bye và thóat".

Lê Thanh Nhân
 
Tương ứng với mỗi hành động mà ta cho hiện worksheet nào.
Sau đây là một "thủ tục củ chuối" nữa nhằm hiện, ẩn các worksheet tùy thuộc vào hành động của người dùng.
Ở đây tôi chia làm 3 hành động: CLOSE, OPEN và ACCESSDATA. Các bạn có thể phát triển thêm.
Mã:
Sub ActionB4CloseOpen(sCloseOpen As String)
    Dim sLeft3 As String, sWsName As String
    Dim i As Integer, WsCount As Integer
    Dim sWsVisible As String, sWsMenu As String
    Dim sWsAccessData As String, sWsAccessData1 As String
On Error GoTo ActionB4CloseOpen_Error
   With Application
      .Calculation = xlCalculationManual
      .ScreenUpdating = False
   End With
    On Error Resume Next
    sWsVisible = "HID_FIRST": sWsMenu = "SHO_MENU"
    sWsAccessData = "HID_DATA": sWsAccessData1 = "HID_SAP_CODE"
    WsCount = Application.ThisWorkbook.Worksheets.Count
    With Application.ThisWorkbook
        If sCloseOpen = "CLOSE" Then
            .Worksheets(sWsVisible).Visible = xlSheetVisible
            For i = 1 To WsCount
                sWsName = .Worksheets(i).Name
                If sWsName <> sWsVisible Then
                    .Worksheets(i).Visible = xlSheetVeryHidden
                End If
            Next i
        ElseIf sCloseOpen = "OPEN" Then
            For i = 1 To WsCount
                sWsName = .Worksheets(i).Name
                sLeft3 = Mid(sWsName, 1, 3)
                If sLeft3 = "SHO" Or sLeft3 = "SAP" Then
                    .Worksheets(i).Visible = xlSheetVisible
                Else
                    .Worksheets(i).Visible = xlSheetVeryHidden
                End If
            Next i
            .Worksheets(sWsMenu).Activate
        ElseIf sCloseOpen = "ACCESSDATA" Then
            .Worksheets(sWsAccessData).Visible = xlSheetVisible
            For i = 1 To WsCount
                sWsName = .Worksheets(i).Name
                If sWsName <> sWsVisible Then
                    .Worksheets(i).Visible = xlSheetVeryHidden
                End If
            Next i
            .Worksheets(sWsAccessData1).Visible = xlSheetVisible
        End If

    End With

ErrorExit:
   With Application
      .Calculation = xlCalculationManual
      .ScreenUpdating = True
   End With
   Exit Sub
ActionB4CloseOpen_Error:
If bCentralErrorHandler("MainMod", "ActionB4CloseOpen", , False) Then
     Stop
     Resume
Else
     Resume ErrorExit
End If
End Sub

Lê Thanh Nhân
 
Anh Duyệt!(Có lộn người không nhỉ?)
Việc phân quyền trong EX bị giới hạn trong khoảng bao nhiêu người vậy anh??
 
NEO đã viết:
Anh Duyệt!
Việc phân quyền trong EX bị giới hạn trong khoảng bao nhiêu người vậy anh??
Như trên tôi đã giới thiệu. Nếu bạn đọc kỹ đoạn mã, bạn sẽ thấy ta phân quyền khi người dùng log-in mở file Excel. Và việc phân quyền này là trên cơ sở dữ liệu Access. Do đó theo tôi nghĩ là nó sẽ "OK" cho doanh nghiệp vừa và nhỏ.

Lê Văn Duyệt
 
Em bị lỗi này rồi, anh chỉ em cách khai báo nha
"User-difined typed not defined"
Dim rs As ADODB.Recordset
 
Lần chỉnh sửa cuối:
bigbigworld đã viết:
Em bị lỗi này rồi, anh chỉ em cách khai báo nha
"User-difined typed not defined"
Dim rs As ADODB.Recordset
Trước khi sử dụng phải khai báo
set rs= New ADODB.Recordset

Lê Thanh Nhân
 
lethanhnhan đã viết:
Trước khi sử dụng phải khai báo
set rs= New ADODB.Recordset

Lê Thanh Nhân

bạn có "lethanhnhan" này bạn có thể nào giởi fiel đó lên cho mình xem không zậy chứ mình không biết " xác định các textbox và CommandButton1 đâu khó lắm, bạn nào làm cái này xong cho mình file đó đi! thank:=\+ )(&&@@ --=-- }}}}}
 
ongtrungducmx25 đã viết:
bạn "lethanhnhan" này bạn có thể nào giởi fiel đó lên cho mình xem không zậy chứ mình không biết " xác định các textbox và CommandButton1 đâu khó lắm, bạn nào làm cái này xong cho mình file đó đi! thank:=\+ )(&&@@ --=-- }}}}}

Chào bạn ongtrungducmx25,
Như trên tôi đã giới thiệu, đó là một thủ thuật nho nhỏ nhằm phân quyền trong ứng dụng của bạn.

Ví dụ dựa trên tên người dùng nhập vào chúng ta có thể lấy về chuổi dữ liệu phân quyền.
Ví dụ ta có các trường trong bảng :

tb_user1.jpg


_User: là trường để lưu trữ tên truy cập.
_Pass: để lưu trữ Password của người dùng.
_Right: chuổi phân quyền.
Như trên tôi đã giới thiệu bạn phải thiết kế form để cho người dùng đăng nhập vào mỗi khi workbook_Open, hoặc bạn dùng thủ tục Auto_Open.
Sau khi người dùng nhập vào bạn sẽ kiểm tra:
_Tên người dùng có tồn tại hay không?
_Nếu tên người dùng đúng thì mới kiểm tra Password có đúng hay không?
_Sau đó tiếp tục để lấy về chuỗi phân quyền. Ví dụ: chuổi phân quyền như sau: frmEdit, frmMain
Khi phân quyền dùng form thì chúng ta sẽ dựa vào chuổi này để cho hiện form hay không bằng việc dùng hàm instr() để kiểm tra xem tên form có trong chuỗi này hay không.
Còn việc kết nối với CSDL để lấy về chuỗi này thì tôi đã giới thiệu ở trên.

File đính kèm là file của form log-in và form thay đổi Password. Bạn tham khảo nha.

Lê Văn Duyệt
 

File đính kèm

  • frmChangePw.rar
    1.5 KB · Đọc: 1,772
  • frmLogIn.rar
    1.7 KB · Đọc: 1,819
bạn "Lê Văn Duyệt" nè mình mở file của bạn hoài mà không được nó báo lỗi gì mà không mở được bạn chỉ mình mở đi nhé!có video cho bạn xem nhé
 

File đính kèm

  • loigizay.rar
    80.2 KB · Đọc: 1,091
Gởi ongtrungducmx25,
Bạn ơi, đó là hai file form *.frm. Bạn vào VBA, chọn File/Import File và chọn đường dẫn đến file tôi gởi cho bạn. Chương trình sẽ cập nhật hai form vào.
Lúc đó bạn có thể xem mã của chương trình.
Bạn cũng có thể làm như sau: Extract ra một thư mục, sau đó bạn chọn Open with và bạn chọn Note Pad để xem code.

Chúc bạn thành công.

Lê Văn Duyệt
 
mình làm được cái này chứ,nhưng hai form của bạn bị lỗi gì rồi đó mình mở thì nó thông báo lỗi nhiều lắm bạn xem lại file của mình đi nhé! hay là bạn chép vào 2 file.from của bạn vào excel luôn nhé để mình tham khảo?Thank
 
Lần chỉnh sửa cuối:
ongtrungducmx25 đã viết:
mình làm được cái này chứ,nhưng hai form của bạn bị lỗi gì rồi đó mình mở thì nó thông báo lỗi nhiều lắm bạn xem lại file của mình đi nhé! hay là bạn chép vào 2 file.from của bạn vào excel luôn nhé để mình tham khảo?Thank
Vấn đề là bạn phải biết thông báo lỗi gì?
Tôi chắc chắn đó là việc bạn phải reference đến các *.ocx.

Lê Văn Duyệt
 
nhưng vấn đề ở chỗ là ko biết đó là file ocx gì. Mong được các bạn giúp đỡ
 
Bác ongtrungducmx25 Tại sao tôi không Dowload được File của Bác ? Hay bác đã thay đường dẫn ?
vbmenu_register("postmenu_24990", true);
 
bạn muốn lấy file gì nói rõ hơn nhé! đường dẫn nào chưa hiểu ý bạn nhé
 
Mô hình Phân quyền

Em thường thiết kế phân quyền trong ứng dụng như thế này:

+ Trong một doanh nghiệp thì có các bộ phần: Giám đốc, Kế toán, Bán hàng, Marketing... Một table chứa tên các bộ phận này gọi là tbGroup.
+ Trong mỗi Group lại có các thành viên (nhân viên), một table chứa các thành viên gọi là tbUser.
+ Một table liệt kê tất cả các chức năng sử dụng trong ứng dụng gọi là tbFunction.
+ Một table thể hiện nội dung phân quyền gọi là tbRight

Việc phân quyền là phân cho nhóm chứ không phân cho User, khi phân cho nhóm "Bán hàng" thực hiện {"Cáo cáo 1"; "Báo cáo 2"} thì tất cả các thành viên trong nhóm này có quyền như nhau.

Mô hình quan hệ giữa các table như sau:
RightRls.jpg

Khi thiết kế màn hình Login (Đăng nhập), để kiểm tra thông tin user hợp lệ thì dùng câu lệnh truy vấn:

SELECT tbGroup.Level, tbRight.*
FROM (tbGroup INNER JOIN tbRight ON tbGroup.GroupID=tbRight.GroupID) INNER JOIN tbUser ON tbGroup.GroupID=tbUser.GroupID
WHERE (((tbUser.UserID)='tuan') AND ((tbUser.Password)='123'));

Nếu thỏa mãn điều kiện, nội dung trong Recordset sẽ như dưới đây:
RightLogin.jpg
 

File đính kèm

  • Rights.zip
    24.4 KB · Đọc: 507
Tuân nhảy sang Data base rùi ah? :)

Về phân quyền mình hay dùng một mảng bit hay chuỗi 010101 để chia quyền có hay không. thông thường nếu lưu quyền vào database thường hay dễ bị vọc. Sếp là người quản lý nhưng lại ít am hiểu máy tính ==> mã hóa 128 bit là ăn chắc, sau đó cắt lấy 8 ký tự đầu để so sánh ==> quyền

Kiểu trên rất tùy biến và có thể bổ sung khá tiện.
Giải thuật mã 128 thì tìm nhé "SHA128".

@Tuanvuni: Năm mới nâng cấp trang bluesoft.net đi.
Mình hỗ trợ host và thiết kế cho. có gì PM nhé.
 
+ Trong một doanh nghiệp thì có các bộ phần: Giám đốc, Kế toán, Bán hàng, Marketing... Một table chứa tên các bộ phận này gọi là tbGroup.
+ Trong mỗi Group lại có các thành viên (nhân viên), một table chứa các thành viên gọi là tbUser.
+ Một table liệt kê tất cả các chức năng sử dụng trong ứng dụng gọi là tbFunction.
+ Một table thể hiện nội dung phân quyền gọi là tbRight
Sorry nếu mình không đúng, nhưng nếu là mình thì mình có 1 mô hình khác dù mình chưa làm lần nào:
1. 2 table Function và Right mình gom làm 1 và dàn hàng ngang, mỗi function là 1 field, loại dữ liệu là Yes/No. Như vậy tiện cho việc add user mới trên form: chỉ việc click đánh dấu check cho mỗi function có Right.
Còn nếu hàng dọc thì có thể sai hoặc sót function, đồng thời phải nhập liệu vừa cho FunctionID vừa nhập liệu cho Allowance.
2. Table Group là liệt kê các group: kế toán, bán hàng, tiếp thị; còn level sẽ là 1 bảng khác liệt kê mức độ truy cập của user.

Mô hình như sau:

RelationPQ.jpg


Form nhập liệu ngoài ra có thể tùy biến như sau: Nếu Group là Acc thì chỉ hiện 3 field AccFunc của bộ phận Kế toán, nếu Group là Sale thì chỉ hiện 3 field SaleFunc của bộ phận Sale, tương tự cho bộ phận Tiếp thị:

Sale.jpg



Acc.jpg


Đồng thời có thể mặc định 1 số field có giá trị True, chẳng hạn như nếu Group là Admin thì tất cả lập tức được gán giá trị True:

Adm.jpg


khi test user đăng nhập thành công ta sẽ có:

TestUser.jpg


File mình đang làm, nếu TuanVNUNI thấy hứng thú, mình sẽ gởi lên.
 
Lần chỉnh sửa cuối:
Longnh đã viết:
Về phân quyền mình hay dùng một mảng bit hay chuỗi 010101 để chia quyền có hay không. thông thường nếu lưu quyền vào database thường hay dễ bị vọc. Sếp là người quản lý nhưng lại ít am hiểu máy tính ==> mã hóa 128 bit là ăn chắc, sau đó cắt lấy 8 ký tự đầu để so sánh ==> quyền

Vụ này nghe hấp dẫn đây. Bác có thể chia sẻ anh em chút demo không?

@Tuanvuni: Năm mới nâng cấp trang bluesoft.net đi.
Mình hỗ trợ host và thiết kế cho. có gì PM nhé.

Cảm ơn bác trước! Vụ này năm mới sẽ phải nhờ bác giúp hai tay đấy!


ptm0412 đã viết:
File mình đang làm, nếu TuanVNUNI thấy hứng thú, mình sẽ gởi lên.

Ngày trước em cũng nghĩ làm theo cách của bác nhưng em nghĩ các chức năng sẽ có rất nhiều (>255), nếu bố trí theo cột sẽ mất nhiều, em chưa thử không biết giới hạn các cột trong Access là bao nhiêu? Khi nào bác làm file demo xong thì gửi lên dây anh em cùng học hỏi thêm.
 
Web KT
Back
Top Bottom