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.

view plainprint?

1. Option Compare Database  
2. Function LoginDialog(strCurrentUser As String)  
3. '------------------------------------------------------------  
4. ' Fungsi yang digunakan saat login pertama kali  
5. '------------------------------------------------------------  
6. On Error GoTo Err_Msg  
7.   With CodeContextObject  
8.     If (Not IsNull(strCurrentUser)) Then  
9.       TempVars.Add "IdPengguna", strCurrentUser  
10.       Application.SetOption ("Confirm Action Queries"), False   
11.       DoCmd.RunSQL "UPDATE tblAdminPengguna SET LoginStatus = True, WaktuLogin = Now() WHERE PgnId=[TempVars]![IdPengguna];"  
12.       Application.SetOption ("Confirm Action Queries"), True   
13.       DoCmd.Close , ""  
14.       DoCmd.OpenForm "frmMenus", acNormal, "", "", , acNormal  
15.       Exit Function  
16.     End If  
17.   End With  
18. Exit_Function:  
19.   Exit Function  
20. Err_Msg:  
21.   MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description  
22.   Resume Exit_Function  
23. End Function  
24. Function TampilkanLogin()  
25. '------------------------------------------------------------  
26. ' Fungsi yang menampilkan id/nama pengguna di setiap  
27. ' form atau report yang dibuka.  
28. '------------------------------------------------------------  
29.   Dim strPgnName As String  
30. On Error GoTo Err_Msg  
31.   If PreferensSistem("GunakanNamaPgn") = True Then  
32.     TampilkanLogin = Nz(DLookup("[PgnNama]", "tblAdminPengguna", "[PgnId]='" & [TempVars]![IdPengguna] & "'"), [TempVars]![IdPengguna])  
33.   Else  
34.     TampilkanLogin = Nz([TempVars]![IdPengguna], "")  
35.   End If  
36. Exit_Function:  
37.   Exit Function  
38. Err_Msg:  
39.   MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description  
40.   Resume Exit_Function  
41. End Function  
42. Function LogoutDialog(strCurrentUser As String)  
43. '------------------------------------------------------------  
44. ' Fungsi yang digunakan bila pengguna ingin logout dari sistem  
45. '------------------------------------------------------------  
46. On Error GoTo Err_Msg  
47.   With CodeContextObject  
48.     If (Not IsNull(strCurrentUser)) Then  
49.       Application.SetOption ("Confirm Action Queries"), False   
50.       DoCmd.RunSQL "UPDATE tblAdminPengguna SET tblAdminPengguna.LoginStatus = false WHERE (((tblAdminPengguna.PgnId)=[TempVars]![IdPengguna]));"  
51.       Application.SetOption ("Confirm Action Queries"), True   
52.       TempVars.Remove ("IdPengguna")  
53.       DoCmd.Close , ""  
54.       If SysCmd(acSysCmdGetObjectState, acForm, "frmMenus") <> 0 Then  
55.         If Forms("frmMenus").CurrentView = 1 Then DoCmd.Close acForm, "frmMenus", acSaveNo  
56.       End If  
57.       DoCmd.OpenForm "frmLogin", acNormal, "", "", , acNormal  
58.       Exit Function  
59.     End If  
60.   End With  
61. Exit_Function:  
62.   Exit Function  
63. Err_Msg:  
64.   MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description  
65.   Resume Exit_Function  
66. End Function  
67. Function TampilkanDataIjin(strIjin As String) As String  
68. '------------------------------------------------------------  
69. ' Fungsi yang digunakan untuk menampilkan Control Tip Text  
70. ' pada field hak akses di tblAdminPengguna. Fiel hak akses  
71. ' pada tabel itu diawali dengan tanda "p_"  
72. '------------------------------------------------------------  
73.   Dim tdf As DAO.TableDef  
74.   Dim fld As DAO.Field2  
75.   Dim x, i, n As Integer  
76.   Dim strDataIjin, strSymbol, strSplit As String  
77. On Error GoTo Err_Msg  
78.   Set dbs = CurrentDb()  
79.   Set tdf = dbs.TableDefs("tblAdminPengguna")  
80.   i = 0  
81.   For Each fld In tdf.Fields  
82.       If fld.Name = strIjin Then  
83.           strDataIjin = "Nama Judul: " & fld.Properties ("Caption") & vbCrLf _  
84.                       & "Nama Ijin: " & fld.Name & vbCrLf _  
85.                       & "Nama Deskripsi: " & fld.Properties ("Description")  
86.           Exit For  
87.       End If  
88.   Next fld  
89.   TampilkanDataIjin = strDataIjin  
90. Exit_Function:  
91.   Exit Function  
92. Err_Msg:  
93.   MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description  
94.   Resume Exit_Function  
95. End Function  
96. Function UserTerdaftar(ByRef strCurrentUser As String) As Boolean  
97. '------------------------------------------------------------  
98. ' Fungsi yang digunakan untuk mengecek apakah seorang pengguna (user) sudah terdaftar atau belum.  
99. '------------------------------------------------------------  
100. On Error GoTo Err_Msg  
101.   If (Not IsNull(DLookup("[PgnId]", "tblAdminPengguna", "[PgnId]='" & strCurrentUser & "'"))) Then  
102.     UserTerdaftar = True  
103.   End If  
104. Exit_Function:  
105.   Exit Function  
106. Err_Msg:  
107.   MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description  
108.   Resume Exit_Function  
109. End Function  
110. Function PasswordOK(ByRef strCurrentUser, strCurrentPassword As String) As Boolean  
111. '------------------------------------------------------------  
112. ' Fungsi yang digunakan untuk mengecek apakah password  
113. ' yang dimasukkan sesuai dengan paswword dalam  
114. ' daftar pengguna di tblAdminPengguna  
115. '------------------------------------------------------------  
116.   Dim strPgn_Password As String  
117. On Error GoTo Err_Msg  
118.   strPgn_Password = Nz(DLookup("[Pgn_Password]", "tblAdminPengguna","[PgnId]='" & strCurrentUser & "'"), "")  
119.   If strPgn_Password = Nz(strCurrentPassword, "") Then PasswordOK = True  
120. Exit_Function:  
121.   Exit Function  
122. Err_Msg:  
123.   MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description  
124.   Resume Exit_Function  
125. End Function  
126. Function IjinDitolak(ByRef strNamaForm As String) As Boolean  
127. '------------------------------------------------------------  
128. ' Fungsi yang digunakan untuk mengecek apakah ijin  
129. ' pengguna untuk membuka sebuah form ditolak berdasarkan  
130. ' persyaratan yang diatur dalam tblMenus/frmMenuPengaturan  
131. '------------------------------------------------------------  
132.   Dim strNamaIjin As Variant  
133. On Error GoTo Err_Msg  
134.   strNamaIjin = Nz(DLookup("[NamaIjin]", "tblMenus", "[IdForm]= '" & strNamaForm & "'"), "")  
135.   If StatusPermisi(strNamaIjin) <> "y" Then IjinDitolak = True Else IjinDitolak = False  
136. Exit_Function:  
137.   Exit Function  
138. Err_Msg:  
139.   MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description  
140.   Resume Exit_Function  
141. End Function  
142. Function IjinPengguna(ByRef strAksesObjek As String) As Boolean  
143. '------------------------------------------------------------  
144. ' Fungsi yang digunakan untuk mengecek apakah pengguna  
145. ' yang login dapat mengakses sebuah obyek seperti  
146. ' tertera dalam akses yang ada di daftar pengguna  
147. '------------------------------------------------------------  
148.   Dim strField As String  
149.   Dim blCheck As Boolean  
150. On Error GoTo Err_Msg  
151.   If DLookup("[p_Admin]", "tblAdminPengguna", "[PgnId]= '" & [TempVars]![IdPengguna] & "'") = True Then  
152.     IjinPengguna = True  
153.     Exit Function  
154.   End If  
155.   strField = "[" & strAksesObjek & "]"  
156.   blCheck = Nz(DLookup(strField, "tblAdminPengguna", "[PgnId]= '" & [TempVars]![IdPengguna] & "'"), False)  
157.   If blCheck = True Then IjinPengguna = True  
158. Exit_Function:  
159.   Exit Function  
160. Err_Msg:  
161.   MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description  
162.   Resume Exit_Function  
163. End Function  
164. Function StatusPermisi(strNamaField As Variant) As String  
165. '------------------------------------------  
166. ' Fungsi untuk mengambil nilai dari array  
167. ' admin pengguna, mirip dengan Function IjinPengguna  
168. '------------------------------------------  
169.   Dim vrtSplit As Variant  
170.   Dim strSymbol, strSplit, strStatus As String  
171. On Error GoTo Err_Msg  
172.   If IsNull(strNamaField) Then  
173.     StatusPermisi = "y"  
174.     Exit Function  
175.   End If  
176.   For n = 1 To Len(strNamaField)  
177.     strSymbol = Mid(strNamaField, n, 1)  
178.     If strSymbol = "," Or strSymbol = "|" Then  
179.     strSplit = strSymbol  
180.     Exit For  
181.     End If  
182.   Next n  
183.   vrtSplit = Split(strNamaField, strSplit)  
184.   For i = 0 To UBound(vrtSplit)  
185.     If strSplit = "|" Then  
186.       If IjinPengguna(CStr(Trim(vrtSplit(i)))) Then  
187.           strStatus = "y"  
188.       End If  
189.     ElseIf strSplit = "," Then  
190.       If Not IjinPengguna(CStr(Trim(vrtSplit(i)))) Then  
191.         StatusPermisi = ""  
192.         Exit Function  
193.       Else  
194.         strStatus = "y"  
195.       End If  
196.     Else  
197.       If IjinPengguna(CStr(Trim(vrtSplit(i)))) Then strStatus = "y" Else strStatus = ""  
198.     End If  
199.   Next i  
200.   StatusPermisi = strStatus  
201. Exit_Function:  
202.   Exit Function  
203. Err_Msg:  
204.   MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description  
205.   Resume Exit_Function  
206. End Function  
207. Function checkUser()  
208. On Error GoTo Err_Msg  
209.   If Not UserTerdaftar("admin") Then  
210.     Application.SetOption ("Confirm Action Queries"), False   
211.     DoCmd.RunSQL "INSERT INTO tblAdminPengguna ( PgnId, p_Admin ) SELECT 'admin' AS Expr1, True AS Expr2;"   '"INSERT INTO tblAdminPengguna ( PgnId ) SELECT 'admin' AS Expr1;"  
212.     Application.SetOption ("Confirm Action Queries"), True   
213.   End If  
214. Exit_Function:  
215.   Exit Function  
216. Err_Msg:  
217.   MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description  
218.   Resume Exit_Function  
219. End Function  

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