Pengaturan Hak Akses Level Menu

Salah satu fitur menarik yang sebaiknya dimiliki oleh aplikasi adalah fitur untuk pengaturan hak akses pengguna program. Contoh

Gambar diatas adalah fitur pengaturan hak akses yang dimiliki oleh aplikasi Smart Library School :D.

Artikel kali ini juga dibuat berdasarkan fitur tersebut dan tentunya sudah saya sensor agar layak untuk konsumsi umum :D.

Pertama kita akan buat rancangan tabelnya (operator, menu_induk dan menu_anak).

Berikut struktur lengkapnya :

Biar makin manteb kita liat juga contoh datanya :

Untuk menu program kita buat pake Menu Editor aja biar lebih simple, nah sekarang bagaimana caranya mengaktifkan/menonaktifkan menu sesuai dengan hak akses yang dimiliki oleh operator.

Query untuk mendapatkan hak akses masing-masing operator lebih kurang seperti berikut :

SELECT hak_akses FROM operator WHERE operator = ‘NAMA_OPERATOR’

Kemudian kita buat sebuah prosedur misal dengan nama disableMenu

Private Sub disableMenu(ByVal fMain As Form, ByVal hakAkses As String)
    Dim ctl     As Control
    Dim rsMenu  As ADODB.Recordset

    strSql = "SELECT menu_name " & _
             "FROM menu_anak " & _
             "WHERE id NOT IN (" & hakAkses & ") " & _
             "ORDER BY id"
    Set rsMenu = openRecordset(strSql)
    If Not rsMenu.EOF Then
        Do While Not rsMenu.EOF
            For Each ctl In fMain.Controls
                If TypeName(ctl) = "Menu" Then
                    If ctl.Name = rsMenu("menu_name").Value Then
                        ctl.Enabled = False
                        Exit For
                    End If
                End If
            Next

            rsMenu.MoveNext
        Loop
    End If
    Call closeRecordset(rsMenu)
End Sub

Nah query + prosedur diatas ini kita letakkan di bagian frmLogin

Private Sub cmdLogin_Click()
    Dim objOperator     As clsOperator
    Dim statusOperator  As STATUS_OPERATOR
    Dim hakAkses        As String

    If isEmptyText(txtOperator, "Operator") Then Exit Sub
    If isEmptyText(txtPassword, "Password") Then Exit Sub

    Set objOperator = New clsOperator
    With objOperator
        .operator = txtOperator.Text
        .password = txtPassword.Text

        statusOperator = .isValidUser
        hakAkses = .hakAkses
    End With
    Set objOperator = Nothing

    Select Case statusOperator
        Case OP_TDK_DITEMUKAN
            Call msgWarning("Operator belum terdaftar !!!")
            txtOperator.SetFocus

        Case OP_PASS_SALAH
            Call msgWarning("Password salah")
            txtPassword.SetFocus

        Case OP_PASS_OK
            Call disableMenu(frmMain, hakAkses) 'panggil prosedur disableMenu disini
            frmMain.Show

            Unload Me
    End Select
End Sub

Selanjutnya kita switch ke bagian manipulasi data operator, berikut tampilannya :

Untuk tombol Tambah, Perbaiki dan Hapus diabaikan saja dan kita fokus pada tombol Hak Akses

Private Function getSelectedMenu(ByVal menuID As Long, ByVal hakAkses As String) As Long
    Dim arrMenuAkses()  As String
    Dim strMenuID       As String

    Dim pos             As Long

    If Not Len(hakAkses) > 0 Then
        getSelectedMenu = 0

    Else
        If InStr(1, hakAkses, ",") > 0 Then
            arrMenuAkses = Split(hakAkses, ",")

            If menuID = arrMenuAkses(LBound(arrMenuAkses)) Then
                strMenuID = menuID & ","

            ElseIf menuID = arrMenuAkses(UBound(arrMenuAkses)) Then
                strMenuID = "," & menuID

            Else
                strMenuID = "," & menuID & ","
            End If

        Else
            strMenuID = CStr(menuID)
        End If

        pos = InStr(1, hakAkses, strMenuID)
        getSelectedMenu = IIf(pos > 0, 1, 0)
    End If
End Function

Private Sub showMenu(ByVal operator As String, ByVal tree As XTreeOpt)
    Dim rsMenuInduk     As ADODB.Recordset
    Dim rsMenuAnak      As ADODB.Recordset

    Dim selectedMenu    As Long
    Dim keyChild        As String
    Dim daftarHakAkses  As String

    'ambil hak akses operator
    strSql = "SELECT hak_akses FROM operator WHERE operator = '" & rep(operator) & "'"
    daftarHakAkses = CStr(dbGetValue(strSql, "1,2,3")) '1,2,3 -> hak akses default

    With tree
        .Clear

        .AddCheck "mnuAll", , "Daftar Menu Program", , True

        'menampilkan menu induk
        strSql = "SELECT id, menu_name, menu_caption " & _
                 "FROM menu_induk " & _
                 "ORDER BY id"
        Set rsMenuInduk = openRecordset(strSql)
        If Not rsMenuInduk.EOF Then
            Do While Not rsMenuInduk.EOF
                .AddCheck rsMenuInduk("menu_name").Value, .Nodes("mnuAll"), rsMenuInduk("menu_caption").Value, , True

                'menampilkan menu anak
                strSql = "SELECT id, menu_name, menu_caption " & _
                         "FROM menu_anak " & _
                         "WHERE menu_induk_id = " & rsMenuInduk("id").Value & " " & _
                         "ORDER BY id"
                Set rsMenuAnak = openRecordset(strSql)
                If Not rsMenuAnak.EOF Then
                    Do While Not rsMenuAnak.EOF
                        selectedMenu = getSelectedMenu(rsMenuAnak("id").Value, daftarHakAkses)

                        keyChild = "K" & CStr(rsMenuAnak("id").Value)
                        .AddCheck keyChild, .Nodes(rsMenuInduk("menu_name").Value), rsMenuAnak("menu_caption").Value
                        .Value(keyChild) = selectedMenu

                        rsMenuAnak.MoveNext
                    Loop
                End If
                Call closeRecordset(rsMenuAnak)

                rsMenuInduk.MoveNext
            Loop
        End If
        Call closeRecordset(rsMenuInduk)

        .ExpandAll
        .Nodes(1).Selected = True
    End With
End Sub

Private Sub cmdHakAkses_Click()
    With frmHakAkses
        .operator = gridOP.TextMatrix(gridOP.Row, 1)
        Call showMenu(.operator, .treeHakUser)

        .Caption = "Hak Akses : " & UCase(.operator)
        .Show vbModal
    End With
End Sub

Contoh tampilan jika kita mengklik tombol Hak Akses

Komponen yang saya gunakan untuk menampilkan menu dalam bentuk hirarki diatas adalah komponen vbAccelerator VB6 Option Tree Control

Terakhir kita tutup dengan kode untuk menyimpan hak akses sesuai dengan menu yang dipilih.

Private Function getMenuID(ByVal strKode As String) As String
    getMenuID = Right(strKode, Len(strKode) - 1)
End Function

Private Sub cmdSimpan_Click()
    Dim hakAkses   As String

    Dim nodX        As Object
    Dim nodY        As Object

    Dim x           As Long
    Dim y           As Long

    Set nodX = treeHakUser.Nodes(1).Child
    For x = 1 To treeHakUser.Nodes(1).Children
        Set nodY = nodX.Child

        For y = 1 To nodX.Children
            If treeHakUser.Value(nodY.Index) = OptionTreeCheckFull Or treeHakUser.Value(nodY.Index) = OptionTreeCheckPartial Then
                hakAkses = hakAkses & getMenuID(nodY.Key) & ","
            End If

            Set nodY = nodY.Next
        Next y

        Set nodX = nodX.Next
    Next x

    If Len(hakAkses) > 0 Then hakAkses = Left(hakAkses, Len(hakAkses) - 1)

    If Not Len(hakAkses) > 0 Then
        MsgBox "Minimal 1 hak akses untuk '" & UCase(operator) & "' harus dipilih", vbExclamation, "Peringatan"

    Else
        strSql = "UPDATE operator SET hak_akses = '" & hakAkses & "' WHERE operator = '" & rep(operator) & "'"
        conn.Execute strSql

        MsgBox "Perubahan hak akses '" & UCase(operator) & "' sudah disimpan.", vbInformation, "Informasi"
        Unload Me
    End If
End Sub

Eh tunggu dulu…. :D saya masih ada sedikit pertanyaan.

Gimana klo kita ingin menambah sub menu baru di bawah menu Laporan misal sub menu rekap pembelian dan rekap penjualan ?

Tentunya menu baru ini juga harus kita entrikan ke tabel menu_anak dan tentunya juga akan sedikit menyebalkan kalo ini dilakukan secara manual dan tentunya juga :D solusinya insya Allah akan kita bahas pada artikel berikutnya :D

Selamat MENCOBA :)

Coding4ever’s Blog

Just coding… coding… and coding… because coding should be fun :)

Comments