Modul untuk Mengelola Pengguna

Modul untuk mengelola pengguna berisi fungsi-fungsi yang digunakan untuk mengelola pengguna yang masuk ke dalam sistem. Seperti diketahui, hirarki sistem informasi manajemen ada tiga level, yaitu puncak, menengah, dan bawah. Masing-masing mempunyai hak akses yang melekat sesuai dengan levelnya. Level puncak tentu saja mempunyai hak akses terhadap sistem yang lebih lengkap daripada level di bawahnya. Level bawah mempunyai hak akses yang melekat sesuai dengan tugasnya, misalnya seseorang yang hanya bisa membuat jurnal, tentu saja tidak bisa memproses jurnal yang dibuatnya. Hanya otoritas yang berwenang, biasanya dengan level yang lebih tinggi dan menguasai bidangnya, yang bisa memproses jurnal itu. Level yang tinggi seperti manajer produksi dan pemasaran, karena tidak menguasai bidang akuntansi, tentu saja tidak berhak untuk memproses jurnal. Namun demikan, mereka berhak untuk mengakses laporan yang berkaitan dengan bagian atau departemen yang menjadi tanggung jawabnya.

Berikut ini adalah kode VBA untuk modul pengguna, simpanlah dengan nama: mdlPengguna.

Option Compare Database
Function LoginDialog(strCurrentUser As String)
'------------------------------------------------------------
' Fungsi yang digunakan saat login pertama kali
'------------------------------------------------------------
On Error GoTo Err_Msg
  With CodeContextObject
    If (Not IsNull(strCurrentUser)) Then
      TempVars.Add "IdPengguna", strCurrentUser
      Application.SetOption ("Confirm Action Queries"), False 
      DoCmd.RunSQL "UPDATE tblAdminPengguna SET LoginStatus = True, WaktuLogin = Now() WHERE PgnId=[TempVars]![IdPengguna];"
      Application.SetOption ("Confirm Action Queries"), True 
      DoCmd.Close , ""
      DoCmd.OpenForm "frmMenus", acNormal, "", "", , acNormal
      Exit Function
    End If
  End With
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description
  Resume Exit_Function
End Function
Function TampilkanLogin()
'------------------------------------------------------------
' Fungsi yang menampilkan id/nama pengguna di setiap
' form atau report yang dibuka.
'------------------------------------------------------------
  Dim strPgnName As String
On Error GoTo Err_Msg
  If PreferensSistem("GunakanNamaPgn") = True Then
    TampilkanLogin = Nz(DLookup("[PgnNama]", "tblAdminPengguna", "[PgnId]='" & [TempVars]![IdPengguna] & "'"), [TempVars]![IdPengguna])
  Else
    TampilkanLogin = Nz([TempVars]![IdPengguna], "")
  End If
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description
  Resume Exit_Function
End Function
Function LogoutDialog(strCurrentUser As String)
'------------------------------------------------------------
' Fungsi yang digunakan bila pengguna ingin logout dari sistem
'------------------------------------------------------------
On Error GoTo Err_Msg
  With CodeContextObject
    If (Not IsNull(strCurrentUser)) Then
      Application.SetOption ("Confirm Action Queries"), False 
      DoCmd.RunSQL "UPDATE tblAdminPengguna SET tblAdminPengguna.LoginStatus = false WHERE (((tblAdminPengguna.PgnId)=[TempVars]![IdPengguna]));"
      Application.SetOption ("Confirm Action Queries"), True 
      TempVars.Remove ("IdPengguna")
      DoCmd.Close , ""
      If SysCmd(acSysCmdGetObjectState, acForm, "frmMenus") <> 0 Then
        If Forms("frmMenus").CurrentView = 1 Then DoCmd.Close acForm, "frmMenus", acSaveNo
      End If
      DoCmd.OpenForm "frmLogin", acNormal, "", "", , acNormal
      Exit Function
    End If
  End With
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description
  Resume Exit_Function
End Function
Function TampilkanDataIjin(strIjin As String) As String
'------------------------------------------------------------
' Fungsi yang digunakan untuk menampilkan Control Tip Text
' pada field hak akses di tblAdminPengguna. Fiel hak akses
' pada tabel itu diawali dengan tanda "p_"
'------------------------------------------------------------
  Dim tdf As DAO.TableDef
  Dim fld As DAO.Field2
  Dim x, i, n As Integer
  Dim strDataIjin, strSymbol, strSplit As String
On Error GoTo Err_Msg
  Set dbs = CurrentDb()
  Set tdf = dbs.TableDefs("tblAdminPengguna")
  i = 0
  For Each fld In tdf.Fields
      If fld.Name = strIjin Then
          strDataIjin = "Nama Judul: " & fld.Properties ("Caption") & vbCrLf _
                      & "Nama Ijin: " & fld.Name & vbCrLf _
                      & "Nama Deskripsi: " & fld.Properties ("Description")
          Exit For
      End If
  Next fld
  TampilkanDataIjin = strDataIjin
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description
  Resume Exit_Function
End Function
Function UserTerdaftar(ByRef strCurrentUser As String) As Boolean
'------------------------------------------------------------
' Fungsi yang digunakan untuk mengecek apakah seorang pengguna (user) sudah terdaftar atau belum.
'------------------------------------------------------------
On Error GoTo Err_Msg
  If (Not IsNull(DLookup("[PgnId]", "tblAdminPengguna", "[PgnId]='" & strCurrentUser & "'"))) Then
    UserTerdaftar = True
  End If
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description
  Resume Exit_Function
End Function
Function PasswordOK(ByRef strCurrentUser, strCurrentPassword As String) As Boolean
'------------------------------------------------------------
' Fungsi yang digunakan untuk mengecek apakah password
' yang dimasukkan sesuai dengan paswword dalam
' daftar pengguna di tblAdminPengguna
'------------------------------------------------------------
  Dim strPgn_Password As String
On Error GoTo Err_Msg
  strPgn_Password = Nz(DLookup("[Pgn_Password]", "tblAdminPengguna","[PgnId]='" & strCurrentUser & "'"), "")
  If strPgn_Password = Nz(strCurrentPassword, "") Then PasswordOK = True
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description
  Resume Exit_Function
End Function
Function IjinDitolak(ByRef strNamaForm As String) As Boolean
'------------------------------------------------------------
' Fungsi yang digunakan untuk mengecek apakah ijin
' pengguna untuk membuka sebuah form ditolak berdasarkan
' persyaratan yang diatur dalam tblMenus/frmMenuPengaturan
'------------------------------------------------------------
  Dim strNamaIjin As Variant
On Error GoTo Err_Msg
  strNamaIjin = Nz(DLookup("[NamaIjin]", "tblMenus", "[IdForm]= '" & strNamaForm & "'"), "")
  If StatusPermisi(strNamaIjin) <> "y" Then IjinDitolak = True Else IjinDitolak = False
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description
  Resume Exit_Function
End Function
Function IjinPengguna(ByRef strAksesObjek As String) As Boolean
'------------------------------------------------------------
' Fungsi yang digunakan untuk mengecek apakah pengguna
' yang login dapat mengakses sebuah obyek seperti
' tertera dalam akses yang ada di daftar pengguna
'------------------------------------------------------------
  Dim strField As String
  Dim blCheck As Boolean
On Error GoTo Err_Msg
  If DLookup("[p_Admin]", "tblAdminPengguna", "[PgnId]= '" & [TempVars]![IdPengguna] & "'") = True Then
    IjinPengguna = True
    Exit Function
  End If
  strField = "[" & strAksesObjek & "]"
  blCheck = Nz(DLookup(strField, "tblAdminPengguna", "[PgnId]= '" & [TempVars]![IdPengguna] & "'"), False)
  If blCheck = True Then IjinPengguna = True
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description
  Resume Exit_Function
End Function
Function StatusPermisi(strNamaField As Variant) As String
'------------------------------------------
' Fungsi untuk mengambil nilai dari array
' admin pengguna, mirip dengan Function IjinPengguna
'------------------------------------------
  Dim vrtSplit As Variant
  Dim strSymbol, strSplit, strStatus As String
On Error GoTo Err_Msg
  If IsNull(strNamaField) Then
    StatusPermisi = "y"
    Exit Function
  End If
  For n = 1 To Len(strNamaField)
    strSymbol = Mid(strNamaField, n, 1)
    If strSymbol = "," Or strSymbol = "|" Then
    strSplit = strSymbol
    Exit For
    End If
  Next n
  vrtSplit = Split(strNamaField, strSplit)
  For i = 0 To UBound(vrtSplit)
    If strSplit = "|" Then
      If IjinPengguna(CStr(Trim(vrtSplit(i)))) Then
          strStatus = "y"
      End If
    ElseIf strSplit = "," Then
      If Not IjinPengguna(CStr(Trim(vrtSplit(i)))) Then
        StatusPermisi = ""
        Exit Function
      Else
        strStatus = "y"
      End If
    Else
      If IjinPengguna(CStr(Trim(vrtSplit(i)))) Then strStatus = "y" Else strStatus = ""
    End If
  Next i
  StatusPermisi = strStatus
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description
  Resume Exit_Function
End Function
Function checkUser()
On Error GoTo Err_Msg
  If Not UserTerdaftar("admin") Then
    Application.SetOption ("Confirm Action Queries"), False 
    DoCmd.RunSQL "INSERT INTO tblAdminPengguna ( PgnId, p_Admin ) SELECT 'admin' AS Expr1, True AS Expr2;"   '"INSERT INTO tblAdminPengguna ( PgnId ) SELECT 'admin' AS Expr1;"
    Application.SetOption ("Confirm Action Queries"), True 
  End If
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description
  Resume Exit_Function
End Function