<% Response.Buffer = True %>

<!-- Lien pour recharger la page et effectuer le compactage-->
<A HREF="compact.asp?compact=y">Compacter la base de données</A>



<%
If Request("compact")="y" then
    Server.ScriptTimeOut = 900

    Dim DB_connSTR

    ' *** Access !!!
    ' *** Modifier ici l'emplacement du fichier de base de données .mdb !
    ' *** Ici le fichier se trouve sur_le_serveur/data/myMDB.mdb
    DB_connSTR = "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.Mappath("/data/myMDB.mdb")
    CONST DB_TYPE = "Access"


    Select case CompactDB()
        Case -1, -2
            Response.Write "La connexion malformée! Vérifier le chemin DBQ=..."
        Case -3
            Response.Write "Erreur lors de la création du backup."
        Case -4
            Response.Write "Erreur lors du déplacement de la base de donnée compactée à la " & _
            position active.<BR>Aller dans le répertoire de la base de données et renomer le " & _
            fichier_compacte.mdb à son nom d'origine.<BR>" & _
            ATTENTION: La base de données est inacessible"

        Case Else
            Response.Write "La base de données a été compacté !"
    End Select

End if

Response.End
' *******************************    FIN   *******************************





Function CompactDB()

    Dim objEngine, strDBLoc, strDBPath, intPos
    DimstrCompDBLoc, strBackupDBLoc

    If DB_TYPE ="Access" then
        ' on peut compacter uniquement une base de données Access
		
        ' trouve l'emplacement de la base de données
        intPos = instrRev(DB_connSTR, "DBQ=")
        If intPos=0 then
            CompactDB = -1
                Exit Function
        End if

        strDBLoc = Right(DB_connSTR, Len(DB_connSTR)-intPos-3) 
        ' ici le -3 est pour pour supprimer "DBQ="

        ' trouve le chemin de la base de données
        intPos = instrRev(strDBLoc, "\")
        If intPos=0 then
            CompactDB = -2
                Exit Function
        End if

        strDBPath = Left(strDBLoc, intPos)

        ' construit l'emplacement de la base de données compacté
        strCompDBLoc = strDBPath & "compacted_database.mdb"

        ' construit l'emplacement du backup actuel
        strBackupDBLoc = strDBPath & "backup.mdb"

        ' supprime chaque base de données compacté pour le prochain compaquetage
        Call DeleteFile(strCompDBLoc)
        Call DeleteFile(strBackupDBLoc)		
		
        ' essaye avec JRO - nécessite MDAC 2.1 ou supérieur
        Set objEngine = CreateObject("JRO.JetEngine") 
        objEngine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
        strDBLoc, "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strCompDBLoc

        ' déplace la base de données non compacté dans le backup
        If NOT Movefile(strDBLoc, strBackupDBLoc) then
            CompactDB = -3
                Exit Function
        End if

        ' déplace la base de données compacté dans l'emplacement actif
        If not Movefile(strCompDBLoc, strDBLoc) then
            CompactDB = -4
                Exit Function
        End if

        ' supprime le backup
        Call DeleteFile(strBackupDBLoc)
    End if

End Function





Function MoveFile(strOldFile, strNewFile)

    Dim objFs, strOldFileLoc, strNewFileLoc
    If InStr(strOldFile, ":\") then
        strOldFileLoc = strOldFile
        Else
        strOldFileLoc = Server.Mappath("./" & strOldFile)
    End if

    If InStr(strNewFile, ":\") then
        strNewFileLoc = strNewFile
        Else
        strNewFileLoc = Server.Mappath("./" & strNewFile)
    End if

    Set objFs = Server.CreateObject("Scripting.FileSystemObject")
    If objFs.FileExists(strOldFileLoc) then
        Call objFs.MoveFile(strOldFileLoc, strNewFileLoc)
        MoveFile = true
        Else
        MoveFile = false
    End if

    Set objFs = Nothing

End Function





Function deleteFile(strFile)

    Dim objFs, strFileLoc

    If InStr(strFile, ":\") then
        strFileLoc = strFile

        Else
        strFileLoc = Server.Mappath("./" & strFile)
    End if

    Set objFs = Server.CreateObject("Scripting.FileSystemObject")

    If objFs.FileExists(strFileLoc) then
        Call objFs.Deletefile(strFileLoc)
        deleteFile = true
        Else
        deleteFile = false
    End if

    Set objFs = Nothing
End Function
%>