Memprotect suatu file database Access dengan password baru jika file tersebut belum dipassword. Jika file sudah dipassword sebelumnya, maka akan muncul pesan peringatan. Coding ini menggunakan reference "Microsoft DAO 3.51 Object Library" dari menu Project->References...
Persiapan:
1. Buat 1 Project baru dengan 1 Form, dan 2 Commandbutton.
2. Copy-kan coding berikut ke dalam editor form yang bertalian.
'Tombol Command1 untuk memprotect dengan password baru, sedangkan
'tombol Command2 untuk menghapus password yang ada, dengan syarat
'harus memasukkan password lamanya terlebih dahulu...
Public Sub SetDatabasePassword(DBFile As String, NewPassword$)
On Error GoTo salah
Dim db As Database
'Buka file database
Set db = OpenDatabase(DBFile, True)
'Set password baru
db.NewPassword "" ,NewPassword$
'db.NewPassword "", ""
'Tutup file database
db.Close
Exit Sub
salah:
Select Case Err.Number
Case 3024
MsgBox "File tidak ditemukan atau path file salah!", _
vbCritical, "File Tidak Ditemukan"
End
Case 3031
MsgBox "File sudah dipassword sebelumnya!", _
vbCritical, "File sudah dipassword"
End
Case 3044
MsgBox "Nama direktori/path salah!", _
vbCritical, "Direktori Salah"
End
Case Else
MsgBox Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Hubungi programmer Anda !", _
vbInformation, "Peringatan"
End
End Select
End Sub
Private Sub Command1_Click()
NewPassword$ = InputBox("Masukkan password: ", "Set Password Baru")
If NewPassword$ = "" Then Exit Sub
Call SetDatabasePassword(App.Path & "\Akademik.mdb" ,NewPassword$)
MsgBox "File berhasil dipassword!", vbInformation, "Sukses Password"
End Sub
Public Sub ClearDatabasePassword(DBFile As String, OldPassword$)
On Error GoTo salah
Dim db As Database
'Buka file database
Set db = OpenDatabase(DBFile, True, False, ";pwd=" & OldPassword$)
'Hapus password jika berhasil membuka file tsb
db.NewPassword OldPassword$, ""
'Tutup database
db.Close
Exit Sub
salah:
Select Case Err.Number
Case 3024
MsgBox "File tidak ditemukan atau path file salah!", _
vbCritical, "File Tidak Ditemukan"
End
Case 3031
MsgBox "Password salah!", vbCritical, "Password Salah"
End
Case 3044
MsgBox "Nama direktori/path salah!", _
vbCritical, "Direktori Salah"
End
Case Else 'Kasus lainnya, silahkan diterjemahkan sendiri
MsgBox Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Hubungi programmer Anda !", _
vbInformation, "Peringatan"
End
End Select
End Sub
Private Sub Command2_Click()
OldPassword$ = InputBox("Masukkan password lama: ", "Hapus Password")
Call ClearDatabasePassword(App.Path & "\Akademik.mdb" ,OldPassword$)
MsgBox "Password berhasil dihapus!", vbInformation, "Sukses Hapus Password"
End Sub
