Minh Tiên > 09-08-16, 11:56 AM
btnnhut > 16-10-16, 11:03 AM
NguyenDungAnh > 15-08-18, 10:30 PM
hoabattu3387 > 04-10-18, 10:33 AM
mrtoanbin > 25-10-18, 11:02 PM
maidinhdan > 03-11-18, 02:27 PM
mrtoanbin > 07-11-18, 08:00 PM
maidinhdan > 09-11-18, 12:39 PM
(07-11-18, 08:00 PM)mrtoanbin Đã viết: Có một vài vấn đề với ứng dụng này bác ơi:
- Các texbox không nhập gì nhưng khi Click vẫn báo thành công?
- Không đặt pass nhưng khi thay đổi pass vẫn báo thành công?
- Không đặt pass nhưng khi xóa pass vẫn báo thành công?
Bác code lại những vấn đề này là tuyệt vời, đang phù hợp với ứng dụng của một số người cần thêm độ bảo mật Acc.
Cảm ơn ạ!
'---------------------------------------------------------------------------------------
' Module : modDatpass
' Author : maidinhdan@gmail.com
' Date : 4/30/2016; update 9/11/2018
' Purpose : Ham dat pass cho file *.mdb
' Cu phap su dung:
' + Taopass: Datpass ("Duongdan", "Pass can tao")
' + Thaypass: Datpass ("Duongdan", "Pass moi", "Pass cu")
' + Xoapass : Datpass ("Duongdan", "", "Pass cu")
'---------------------------------------------------------------------------------------
Option Compare Database
Option Explicit
Public Function Datpass(DuongdancuaFile As String, Optional pNewPassword As Variant, Optional pOldPassword As Variant) As String
On Error GoTo Loi
Const cProvider = "Microsoft.Jet.OLEDB.4.0"
Dim cnn As ADODB.Connection
Dim strNewPassword As String
Dim strOldPassword As String
Dim strCommand As String
Dim strAction As String
Dim strResult As String
If IsMissing(pNewPassword) Then
strNewPassword = "NULL"
Else
strNewPassword = "[" & pNewPassword & "]"
End If
If IsMissing(pOldPassword) Then
strOldPassword = "NULL"
Else
strOldPassword = "[" & pOldPassword & "]"
End If
strCommand = "ALTER DATABASE PASSWORD " & strNewPassword & "" & strOldPassword & ";"
Set cnn = New ADODB.Connection
With cnn
.Mode = adModeShareExclusive
.Provider = cProvider
If Not IsMissing(pOldPassword) Then
.Properties("Jet OLEDB:Database Password") = pOldPassword
End If
strAction = "Open"
.Open "Data Source=" & DuongdancuaFile & ";"
strAction = "SetPassword"
.Execute strCommand
End With
If pNewPassword <> "" And IsMissing(pOldPassword) Then strResult = "Tao pass thanh cong, Pass la: " & pNewPassword
If pNewPassword <> "" And pOldPassword <> "" Then strResult = "Thay pass thanh cong, Pass moi la: " & pNewPassword
If pNewPassword = "" And pOldPassword <> "" Then strResult = "Xoa Pass thanh cong, File ban khong con mat khau nua"
exit_Datpass:
On Error Resume Next
cnn.Close
Set cnn = Nothing
MsgBox strResult, vbInformation, "Thông bao"
Exit Function
Loi:
If Err.Number = -2147467259 Then
If strAction = "Open" Then
strResult = "Loi: Data dang mo, khong the dat mau khau"
ElseIf strAction = "SetPassword" Then
strResult = "Loi: File ban khong co dat mat khau nao ca, ban mo thu xem"
Else
strResult = "Loi: Thuc thi hoat dong"
End If
ElseIf Err.Number = 13 Then
strResult = "Tao pass thanh cong, Pass la: " & pNewPassword
ElseIf Err.Number = -2147217843 Then
If pNewPassword <> "" And IsMissing(pOldPassword) Then
strResult = "Loi: File dang co mat khau, Neu muon Thay doi de nghi su dung nut [Thay Pass]"
Else
strResult = "Loi: Mat khau cu khong dung"
End If
Else
strResult = "Loi: Chua dien o Mat khau cu, vui long kiem tra lai Mat khau cu"
End If
Resume exit_Datpass
End Function