* --------------------------------------------
* 程序: 创建、压缩Access数据库并修改密码演示
* 设计: 红雨
* --------------------------------------------
Local lcMdbFile, lcRetuStr
lcMdbFile = [C:\Temp\TestCreaMdbFile.mdb]
lcPswd1 = [test1]
lcPswd2 = [test2]
lcPswd3 = [test3]
lcRetuStr = [创建、压缩Access数据库并修改密码演示：] + Chr(13)

If CreateMDB( lcMdbFile, lcPswd1)
    lcRetuStr = lcRetuStr + Chr(13) + [1、创建数据库成功         - 密码: ] + lcPswd1
    If CompactMDB( lcMdbFile, lcPswd1, lcPswd2 )
        lcRetuStr = lcRetuStr + Chr(13) + [2、压缩并修改密码成功     - 密码: ] + lcPswd2
        If ChangeMdbPassword( lcMdbFile, lcPswd2, lcPswd3 )
            lcRetuStr = lcRetuStr + Chr(13) + [3、单独修改数据库密码成功 - 密码: ] + lcPswd3
        Else
            lcRetuStr = lcRetuStr + Chr(13) + [3、单独修改数据库密码失败]
        Endif
    Else
        lcRetuStr = lcRetuStr + Chr(13) + [2、压缩并修改密码失败]
    Endif
Else
    lcRetuStr = lcRetuStr + Chr(13) + [1、创建数据库失败]
Endif

= MessageBox( lcRetuStr, 0+64+0, [红雨提示] )
Return

* --------------------------------------------
Function CreateMDB( tcMdbFile, tcPswdStr )
    * 创建 Access 数据库文件(.mdb)
    Local IsOK
    IsOK = .F.
    tcMdbFile = iif(Type([tcMdbFile])=[C], tcMdbFile, [])
    tcPswdStr = iif(Type([tcPswdStr])=[C], tcPswdStr, [])
    If File(tcMdbFile)
        Erase (tcMdbFile)
    Endif
    If !File(tcMdbFile)
        IsOK = .T.
        Local loEngine, lcOldError, lcCmdStrs
        lcOldError = On([ERROR])
        On Error IsOK = .F.
        loCatalog = CreateObject( [ADOX.Catalog] )
        lcCmdStrs = [Provider=Microsoft.Jet.OLEDB.4.0] ;
            + [;Data Source=] + tcMdbFile ;
            + [;Jet OLEDB:Database Password=] + tcPswdStr
        loCatalog.Create( lcCmdStrs )
        Release loCatalog
        loCatalog = Null
        On Error &lcOldError.
    Endif
    Return IsOK and File(tcMdbFile)
Endfunc

* --------------------------------------------
Function CompactMDB ( tcMdbFile, tcOldPswd, tcNewPswd )
    * 压缩 Access 数据库并设置密码
    Local IsOK
    IsOK = .F.
    tcMdbFile = iif(Type([tcMdbFile])=[C], tcMdbFile, [])
    tcOldPswd = iif(Type([tcOldPswd])=[C], tcOldPswd, [])
    tcNewPswd = iif(Type([tcNewPswd])=[C], tcNewPswd, tcOldPswd)
    If File( tcMdbFile )
        IsOK = .T.
        Local loEngine, lcTmpFile, lcOldError, lcCompOldStr, lcCompNewStr
        lcOldError = On([ERROR])
        On Error IsOK = .F.
        lcTmpFile = Addb(JustPath(tcMdbFile)) + subs(Sys(2015),3) + [.mdb]
        Rename (tcMdbFile) To (lcTmpFile)
        If !File(tcMdbFile) and File(lcTmpFile)
            lcCompOldStr = [Provider=Microsoft.Jet.OLEDB.4.0] ;
                +   [;Data Source=] + lcTmpFile ;
                +   [;Jet OLEDB:Database Password=] + tcOldPswd
            lcCompNewStr = [Provider=Microsoft.Jet.OLEDB.4.0] ;
                +   [;Data Source=] + tcMdbFile ;
                +   [;Jet OLEDB:Database Password=] + tcNewPswd
            loEngine = CreateObject( [JRO.JetEngine] )
            loEngine.CompactDatabase( lcCompOldStr, lcCompNewStr )
            Release loEngine
            loEngine = Null
            If File(tcMdbFile)
                Erase (lcTmpFile)
            Else
                Rename (lcTmpFile) To (tcMdbFile)
            Endif
        Else
            IsOK = .F.
        Endif
        On Error &lcOldError.
    Endif
    Return IsOK and File(tcMdbFile)
Endfunc

* --------------------------------------------
Function ChangeMdbPassword ( tcMdbFile, tcOldPswd, tcNewPswd )
    * 修改 Access 数据库的密码,必须独占打开数据库,使用前请确保没有其他程序使用数据库
    Local IsOK
    IsOK = .F.
    lcRetuStr = []
    tcMdbFile = iif(Type([tcMdbFile])=[C], tcMdbFile, [])
    tcOldPswd = iif(Type([tcOldPswd])=[C], tcOldPswd, [])
    tcNewPswd = iif(Type([tcNewPswd])=[C], tcNewPswd, [])
    If File( tcMdbFile )
        IsOK = .T.
        Local loADODB, lcOldError
        lcOldError = On([ERROR])
        On Error IsOK = .F.
        loADODB = CreateObject( [ADODB.Connection] )
        loADODB.Mode = 12
        loADODB.Provider = [Microsoft.Jet.OLEDB.4.0]
        loADODB.Properties([Jet OLEDB:Database Password]) = tcOldPswd
        loADODB.Open([Data Source=] + tcMdbFile)
        loADODB.Execute('ALTER DATABASE PASSWORD [' + tcNewPswd + '][' + tcOldPswd + ']')
        loADODB.Close
        Release loADODB
        loADODB = Null
        On Error &lcOldError.
    Endif
    Return IsOK
Endfunc

* --------------------------------------------