Génération d'un script de recréation d'index

Télécharger le projet
Commenter

Description

Cet outil vous permettra de générer un script pour recréer vos indexs en cas de détérioration de ceux ci... Je m'explique :

Pour ceux qui utilisent fréquemment access, ils auront remarqué que les indexs peuvent se déteriorer et entrainer des dysfonctionnements au niveau du logiciel qui exploite la base. Cela peut arriver suite à une coupure de courant, ou control alt suppr , bref... Si ça arrive, c'est pas cool !!!

J'ai donc créé ce petit programme :

Il va simplement exploiter la méthode openSchema d'ADO. Cette méthode permet de connaître des informations sur la constitution système des bases de données .On récupère ces informations dans un recordset que l'on a qu'à lire et analyser. En l'occurence, j'ai utilisé ici le critère de sélection adSchemaIndexes ( consultez MSDN pour plus de détail ). Je récupère les infos contenues dans cette "table" et à partir de celle ci , je génère un script du type :

ALTER TABLE [UTILISATEUR] DROP CONSTRAINT [NumUTILISATEUR]
CREATE INDEX [NumUTILISATEUR] ON [UTILISATEUR]([NUMUTILISATEUR] ASC)
ALTER TABLE [UTILISATEUR] DROP CONSTRAINT [PrimaryKey]
CREATE INDEX [PrimaryKey] ON [UTILISATEUR]([NUMUTILISATEUR] ASC) WITH PRIMARY DISALLOW NULL

Chaque index est supprimé puis recréé.
On obtient ensuite un petit fichier texte. Vous pouvez dès lors utiliser ce fichier : Lecture séquentielle de chaque ligne et execution de la requête sur la base de données... et le tour est joué... Les indexs sont recréés !

Ci-joint le code de l'unique form du programme

Source / Exemple : 


'--------------------------------------------------------------------------------------
'  MODULE      : frmIndex
'  BUT         : fenêtre principale du programme
'  DEVELOPPEUR : Jean-Francis OCHS             Date : 19/03/2003
'--------------------------------------------------------------------------------------
Option Explicit

' Connexion ADO utilisée
Private cnConnex As New ADODB.Connection

'*****************************************************************************************
' Procédure : gboolOuvrirDatabase
' Propriété : strchemin : Chemin de la base ; BDD : Connexion ADO
' Fonction : Permet d'ouvrir une base de données access 97 ou access 2000
'
' NOTES :-
' Auteur : Jean-Francis OCHS
'*****************************************************************************************
Private Function gboolOuvrirDatabase(ByRef strchemin As String, ByRef BDD As ADODB.Connection) As Boolean
On Error GoTo err:

Dim strNomProc As String
Dim strConnexionString As String ' Permet de définir la chaine de connexion ADO

' Tentative d'ouverture de la base en access 2000.
1    strConnexionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strchemin & ";"
3    BDD.Open strConnexionString
4    If BDD.State = adStateOpen Then
5       gboolOuvrirDatabase = True
6       Exit Function
7    Else
' Tentative d'ouverture de la base en access 97.
8       strConnexionString = "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & strchemin & ";"
9       BDD.Open strConnexionString
10       If BDD.State = adStateOpen Then
11           gboolOuvrirDatabase = True
12       Else
13           gboolOuvrirDatabase = False
14       End If
15   End If
16   Exit Function

err:
   gboolOuvrirDatabase = False
   strNomProc = "gboolOuvrirDatabase"
   MsgBox "Erreur à la ligne N°" & Erl & " de la procédure " & strNomProc & " : " & err.Description

End Function

'*****************************************************************************************
' Procédure :gboolFermerDatabase
' Propriété : BDD : Connexion ADO
' Fonction : Permet de fermer une base de données
'
' NOTES :
'
' Auteur : Jean-Francis OCHS
'*****************************************************************************************
Private Function gboolFermerDatabase(ByRef BDD As ADODB.Connection) As Boolean
On Error GoTo err:

Dim strNomProc As String

1    BDD.Close
2    gboolFermerDatabase = True
3    Exit Function

err:
   gboolFermerDatabase = False
   strNomProc = "gboolFermerDatabase"
   MsgBox "Erreur à la ligne N°" & Erl & " de la procédure " & strNomProc & " : " & err.Description
End Function

'*****************************************************************************************
' Fonction : blnGenerationScript ()
' Paramètres :  StrCheminFichierSortie : Chaine --> Chemin du fichier à génerer
' Fonction : génère le fichier de structure d'index
'
' NOTES : -
'
' Auteur : Jean-Francis OCHS
'*****************************************************************************************
Private Function blnGenerationScript(ByVal strCheminFichierSortie As String) As Boolean

On Error GoTo err:

' Recordset qui contient la table adSchemaIndexes
Dim rsSYSTEME As New Recordset
' Requête que l'on génère
Dim strRequete As String
' Requête de suppression d'une contrainte
Dim strSuppression As String

' Compteur pour les boucles
Dim lngI As Long
' Variable contenant le N° de fichier
Dim intCompteur As Integer

' Variable Variant utilisée pour le tri du spread
Dim vatabTri As Variant

' Variable qui contient le nom de l'index traité
Dim strNomIndex As String
' Variable qui contient le nom de la table traité
Dim strNomTable As String
' Variable qui contient le nom de l'index de la ligne suivante du spread
' Elle permet de vérifier si l'index de la ligne suivante est identique au précédent.
Dim strNomIndexTraités As String
' Variable qui contient le nom de la table de la ligne suivante du spread
' Elle permet de vérifier si la table de la ligne suivante est identique à la précédente.
Dim strNomTableTraités As String

' Variable qui permet de savoir si l'index traité est une clé primaire ou non
Dim blnPrimaire As Boolean
' Variable contenant une chaine construite qui indiqueles clauses de nullités d'index.
Dim strNullite As String

    ' Initialisation des variables
    strNomIndex = vbNullString
    strNomTable = vbNullString
    strNomIndexTraités = vbNullString
    strNomTableTraités = vbNullString
    strRequete = vbNullString
    blnPrimaire = False
    strNullite = vbNullString
    vatabTri = vbNullString
    lngI = 0
    intCompteur = FreeFile
    
    ' Ouverture du recordset
    Set rsSYSTEME = cnConnex.OpenSchema(adSchemaIndexes)

    ' On vérifie que le moteur de base de donnée a bien renvoyé des informations.
    If rsSYSTEME.Fields.Count < 0 Then
        ' On créé une erreur diverse pour sortir proprement de la fonction...
        err.Raise 25000
    End If

    ' Ouverture du fichier de sortie
    Open strCheminFichierSortie For Output Shared As #intCompteur
    
    'Remplissage du spread
    With spradSchemaIndexes
                
        .MaxCols = rsSYSTEME.Fields.Count
        .Row = 1
        .Col = 1
         rsSYSTEME.MoveFirst
         Do Until rsSYSTEME.EOF
             .MaxRows = .MaxRows + 1
             .Row = .MaxRows
             For lngI = 0 To rsSYSTEME.Fields.Count - 1
                .Col = lngI + 1
                .Text = rsSYSTEME.Fields(lngI).Value
             Next lngI
             rsSYSTEME.MoveNext
        Loop
    
        ' Tri du spread
        vatabTri = Array(3, 6, 17)
        .Sort 1, 1, .MaxCols, .MaxRows, SortByRow, vatabTri, Array(1, 1, 1)
        
        ' On met à jour la propriété Max de la progressbar.
        pbProgression.Max = .MaxRows
    
        ' Création des indexs
        For lngI = 1 To .MaxRows
            ' RéInitialisation du blnPrimaire
            blnPrimaire = False
            .Row = lngI
            .Col = 7
            ' Si l'index en cours n'est pas Primaire
            If .Value = 0 Then
                .Col = 8
                ' Si l'index en cours est unique
                If .Value = -1 Then
                    strRequete = "CREATE UNIQUE INDEX " ' --> L'index est unique
                Else
                    
                    strRequete = "CREATE INDEX " ' --> L'index est standard
                End If
            Else
                blnPrimaire = True
                strRequete = "CREATE INDEX " ' --> L'index est primaire --> MAJ blnPrimaire
            End If
            
            ' On vérifie maintenant si l'index en terme de nullité  :
                ' est Standard ( pas de contraintes ) : 0
                ' interdit les champs NULL : 1
                ' Ignore les champs NULL : 2
            
            .Col = 13
            Select Case .Value:
                Case 0: strNullite = vbNullString
                Case 1: strNullite = "DISALLOW NULL"
                Case 2: strNullite = "IGNORE NULL"
            End Select
            
            ' On construit la chaine "ON [MATABLE]([CHAMPS1]" et on enregistre le nom de l'index
            ' en cours de traitement et le nom de sa table attachée.
            .Col = 6
            strRequete = strRequete & "[" & .Text & "] ON "
            strNomIndex = .Text
            .Col = 3
            strRequete = strRequete & "[" & .Text & "]("
            strNomTable = .Text
            .Col = 18
            strRequete = strRequete & "[" & .Text & "]"
            
            ' GEstion du tri de l'index --> COLLATION vaut 1 si croissant, 2 si décroissant
            .Col = 21
            If .Text = 1 Then
                ' Champs est indexé de manière croissante
                strRequete = strRequete & " ASC"
            Else
                ' Champs est indexé de manière décroissante
                strRequete = strRequete & " DESC"
            End If
            
            ' Insertion de l'instruction DROP
            strSuppression = "ALTER TABLE [" & strNomTable & "] DROP CONSTRAINT [" & strNomIndex & "]"
            
            ' On récupère le nom de la table et le nom de l'index de la ligne suivante.
            .Row = .Row + 1
            .Col = 6
            strNomIndexTraités = .Text
            .Col = 3
            strNomTableTraités = .Text
            
            ' On enregistre la ligne courante
            'lngLigneCourante = .Row
            
            ' Si ces informations sont identiques aux informations récupèrés sur la ligne
            ' précédente, on rajoute le nom du champs à la requête.
            While strNomIndex = strNomIndexTraités And strNomTable = strNomTableTraités
                .Col = 18
                strRequete = strRequete & ",[" & .Text & "]"
                ' GEstion du tri de l'index --> COLLATION vaut 1 si croissant, 2 si décroissant
                .Col = 21
                If .Text = 1 Then
                    ' Champs est indexé de manière croissante
                    strRequete = strRequete & " ASC"
                Else
                    ' Champs est indexé de manière décroissante
                    strRequete = strRequete & " DESC"
                End If
                .Row = .Row + 1
                If .Row > .MaxRows Then Exit For
                .Col = 6
                strNomIndexTraités = .Text
                .Col = 3
                strNomTableTraités = .Text
                lngI = .Row - 1
                pbProgression.Value = pbProgression.Value + 1
            Wend
            
            'If .Row <> lngLigneCourante Then
            
            ' On ferme la paranthèse . On se retrouve ici avec une instruction du type :
            ' CREATE (UNIQUE) INDEX ON MA_TABLE(CHAMPS1 [,CHAMPS2,CHAMPS...])
            strRequete = strRequete & ")"
            
            ' On vérifie si on est en présence d'un index primaire
            If blnPrimaire = True Then
                ' C'est un index primaire. A ce stade, la requête doit ressembler à :
                ' CREATE (UNIQUE) INDEX ON MA_TABLE(CHAMPS1 [,CHAMPS2,CHAMPS...]) WITH PRIMARY
                strRequete = strRequete & " WITH PRIMARY " & strNullite
            Else
                ' On vérifie ici s'il existe des contraintes de nullité... si oui...
                ' CREATE (UNIQUE) INDEX ON MA_TABLE(CHAMPS1 [,CHAMPS2,CHAMPS...]) WITH PRIMARY | DISALLOW NULL | IGNORE NULL
                If LenB(strNullite) <> 0 Then
                    strRequete = strRequete & " WITH " & strNullite
                End If
            End If
            
            
            ' On vérifie que la table traité ne soit pas système ( préfixe msys )
            ' La requête est construite. On l'enregistre dans le fichier texte.
            If InStr(UCase(strRequete), "MSYS") = 0 Then
                Print #intCompteur, strSuppression
                Print #intCompteur, strRequete
                Debug.Print strRequete
            End If
            
            ' Mise à jour de l'indicateur de progression.
            pbProgression.Value = .Row
            
        Next lngI
    
    End With

    ' Fermeture du fichier
    Close #intCompteur

    ' Renvoie de valeur et sortie de function.
    blnGenerationScript = True

Exit Function

err:
    ' Message généré : Si le moteur Jet n'a renvoyé aucune info au recordset
    If err.Number = 25000 Then
        MsgBox "Le programme n'a pu récuperer suffisamment d'informations de la base de données. La base de données doit être ré-analysée.", vbCritical, "Erreur d'accès aux données"
        blnGenerationScript = False
    Else
        ' Message filtré : Se produit lorsque l'on tente d'inscrire une valeur nulle dans un spread.
        ' On passe outre.
        If err.Number = 13 Then
            Resume Next
        Else
            Close #intCompteur
            blnGenerationScript = False
        End If
    End If
End Function

'*****************************************************************************************
' Procédure : cmdGeneration_Click ()
' Propriété : -
' Fonction : Permet de lancer la génération du fichier de structure d'index
'
' NOTES : -
'
' Auteur : Jean-Francis OCHS
'*****************************************************************************************
Private Sub cmdGeneration_Click()
On Error GoTo err:
    ' On vérifie tout d'abord que le champs de saisie du chemin de la  base de données
    ' a bien été saisi et qu'il soit valide.
1   If LenB(txtPathBDD) = 0 Or LenB(Dir(txtPathBDD, vbNormal)) = 0 Then
2       MsgBox "Veuillez sélectionner une base de données d'analyse valide !", vbExclamation + vbOKOnly, "Erreur de sélection de fichier."
3       Exit Sub
4   Else
        ' On vérifie ensuite que le nom du script a bien été renseigné.
5       If LenB(txtNomScript) = 0 Then
6           MsgBox "Veuillez saisir un nom de script correct valide !", vbExclamation + vbOKOnly, "Erreur de sélection de fichier."
7           Exit Sub
8       Else
        ' On a passé tous les contrôles... On lance la génération
9           txtNomScript.Enabled = False
10          txtPathBDD.Enabled = False
11          cmdGeneration.Enabled = False
12          cmdQuitter.Enabled = False
13          cmdSelection.Enabled = False
14          Me.MousePointer = vbHourglass
            ' Ouverture de la base de données.
15          gboolOuvrirDatabase txtPathBDD, cnConnex
            ' Appel de la fonction de génération. On lui passe en paramètre le chemin du fichier
            ' de sortie qui est un composé du chemin de l'application et du nom du fichier de
            ' sortie
16          If blnGenerationScript(App.Path & "\" & txtNomScript.Text) = True Then
                ' La génération s'est bien effectuée. On affiche un message qui demande si l'on veut
                ' consulter le fichier de sortie.
17              If MsgBox("Génération du script terminée. Voulez-vous visualiser le script généré ?", vbInformation + vbYesNo, "Génération terminée.") = vbYes Then
18                  Me.MousePointer = vbDefault
19                  Shell "notepad.exe" & " " & App.Path & "\" & txtNomScript, vbMaximizedFocus
20              End If
21          Else
                ' La génération de script a échoué. On affiche un message d'erreur et on sort de l'application
22              MsgBox "Une erreur est survenue lors de la mise à jour des index. "
23          End If
24          Me.MousePointer = vbDefault
25      End If
26  cmdQuitter.Enabled = True
27  End If
28  Exit Sub

err:
    MsgBox "Une erreur est survenue à la ligne N° " & Erl & " de la procédure cmdGeneration_Click." & vbCrLf & "N° d'erreur : " & err.Number & "Description : " & err.Description, vbCritical + vbOKOnly, "Erreur d'application"
    cmdQuitter.Enabled = True
    
End Sub

'*****************************************************************************************
' Procédure : cmdQuitter_Click ()
' Propriété : -
' Fonction : Permet de quitter le programme.
'
' NOTES : -
'
' Auteur : Jean-Francis OCHS - 05/03/2003
'*****************************************************************************************

Private Sub cmdQuitter_Click()
    
On Error GoTo err:
    
1    Unload Me

2    Exit Sub

err:
   MsgBox "Une erreur est survenue à la ligne N° " & Erl & " de la procédure cmdGeneration_Click." & vbCrLf & "N° d'erreur : " & err.Number & "Description : " & err.Description, vbCritical + vbOKOnly, "Erreur d'application"
    ' On force la sortie de programme...
    End
End Sub

'*****************************************************************************************
' Procédure : CmdSelection_Click ()
' Propriété : -
' Fonction : Permet d'afficher la fenêtre de sélection de fichier.
'
' NOTES : -
'
' Auteur : Jean-Francis OCHS - 05/03/2003
'*****************************************************************************************

Private Sub CmdSelection_Click()
    
On Error GoTo err:

1   dlgDialogue.CancelError = False
2   dlgDialogue.Flags = cdlOFNFileMustExist
3   dlgDialogue.InitDir = App.Path
4   dlgDialogue.Filter = "Base de données ( *.mdb )|*.mdb|"
5   dlgDialogue.FilterIndex = 2
6   dlgDialogue.ShowOpen
7   txtPathBDD = dlgDialogue.FileName
    
    Exit Sub

err:
    MsgBox "Une erreur est survenue à la ligne N° " & Erl & " de la procédure cmdGeneration_Click." & vbCrLf & "N° d'erreur : " & err.Number & "Description : " & err.Description, vbCritical + vbOKOnly, "Erreur d'application"

End Sub

Conclusion :


L'utilisation de ce programme requiert le composant Spread de Farpoint...
COmpressé le composant fait 1,16 mo...du coup, impossible de vous l'envoyer...
Pour récupérer ce composant, je vous invite à le télécharger sur le site de farpoint à l'adresse suivante.

https://netserv.fpoint.com/fpTrials/trialform.asp?pcode=spread6

Si naturellement vous trouvez des bugs...please dites le moi !
Je déposerais , dès que j'en aurais le temps, les sources d'un programme qui va executer séquentiellement le script et ainsi recréer les indexs sur la base.

@ +
Jeff
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (JeanFrancis68)