Public Sub RemoveDatabase_Password(ByVal strDBWithPassword As String,ByVal strPassword As String)
On Error GoTo ErrorHandler
Dim objEngine As New JRO.JetEngine
Dim strBackupFile As String
Dim strDBWithOutPassword As String
Dim DBWithPwd As String,DBWithOutPwd As String
If Len(Dir(strDBWithPassword)) And Len(strPassword) <> 0 Then
' 是否备份
If MsgBox("删除密码之前是否备份源数据库?",vbYesNo,"提示") = vbYes Then
strBackupFile = "C:\Mybackup.mdb"
If Len(Dir(strBackupFile)) Then Kill strBackupFile
Filecopy strDBWithPassword,strBackupFile
End If
'建立临时文件
strDBWithOutPassword = "c:\Temp40005.mdb"
If Len(Dir(strDBWithOutPassword)) Then Kill strDBWithOutPassword '若临时文件存在,删除临时文件
DBWithPwd = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _
& strDBWithPassword & ";" & "Jet OLEDB:Database Password=" & strPassword & ";"
DBWithOutPwd = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _
& strDBWithOutPassword & " ;Jet OLEDB:Engine Type=5;"
DoEvents
objEngine.CompactDatabase DBWithPwd,DBWithOutPwd
Set objEngine = nothing
'删除有密码的数据库
Kill strDBWithPassword
'复制去除密码大数据
Filecopy strDBWithOutPassword,strDBWithPassword
Kill strDBWithOutPassword '删除临时数据库
MsgBox "恭喜,密码已成功从数据中删除",vbinformation,"成功"
Else
MsgBox "输入的数据库密码不正确!",vbCritical,"失败"
End If
Exit Sub
ErrorHandler:
If Err.Number = -2147217843 Then
MsgBox "密码无效请重试!","密码错误"
Else
MsgBox "错误 # " & Err.Number & " : " & Err.Description & _
" in RemoveDatabase_Password()",vbOKOnly,"提示"
End If
End Sub
Call RemoveDatabase_Password(‘数据库路径','数据库密码')
敬告:
莫做恶事!鄙视恶意攻击者!
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。