1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150
| // Résumé : Supprime tout le contenu d'un fichier en prenant en compte les contraintes d'intégrité
// Syntaxe :
//HsupprimeTout(ps_nomFichier est une chaine)
//
// Paramètres :
// ps_nomFichier : Nom du fichier de données
// Valeur de retour :
// booléen : vrai si le contenu du fichier a été supprimer.
//
// Exemple :
// HsupprimeTout(Commande..Nom)
//
PROCEDURE HsupprimeTout(ps_nomFichier est une chaîne)
//----->Declaration des variables
ls_LstLiaison,ls_nomLiaison,ls_FichierClePrimaire, ls_clePrimaire, ls_fichierCleEtrangere, ls_CleEtrangere, ls_regleSupression, ls_cardinaliteFichierPrimaire, ls_cardinaliteFichierSecondaire est une chaîne
ls_LstValeurLiees,ls_nomFichierParametre, ls_requete, ls_nomReq est une chaîne
ls_MessageException1, ls_MessageException2, ls_MessageException3, ls_MessageException4 est une chaîne
lt_BufferRequete est un tableau de chaîne
//----->Initialisation des variables Message Exception
ls_MessageException1=[
La source de données <%1> n'est pas initialisée.
- S'il s'agit d'un fichier de données, le fichier n'a pas été trouvé dans l'analyse ou n'a pas été décrit avec les fonctions HDéclare / HDéclareExterne.
- S'il s'agit d'une requête ou d'une vue, l'exécution a peut-être échoué.
Pour récupérer l'erreur correspondante, testez le résultat des fonctions HExécuteRequête / HExécuteRequêteSQL / HCréeVue.
]
ls_MessageException2="Le champ '%1' n'est pas de type Fichier de données"
ls_MessageException3=[
Erreur d'intégrité.
L'application de la fonction aurait entraîné le non-respect de la contrainte d'intégrité référentielle 'restrict' entre les rubriques <%1.%2> (clé primaire) ET <%3.%4> (clé étrangère).
]
ls_MessageException4=[
Erreur d'intégrité.
Les cardinalités côté clé primaire (%1) entre les rubriques <%2.%3> et <%4.%5> ne sont pas respectées.
]
//----->Initialisation des variables
ls_nomFichierParametre=ps_nomFichier
//----->Test si la variable passé en paramètre existe en tantque fichier de données
QUAND EXCEPTION DANS
HLitPremier(ls_nomFichierParametre)
FAIRE
ExceptionDéclenche(1,ChaîneConstruit(ls_MessageException1,ls_nomFichierParametre))
FIN
//----->Test du type du pamètre
SI PAS ({ls_nomFichierParametre}..Type _DANS_ (hFichierAS400, hFichierAutre, hFichierClientServeur, hFichierHF5, hFichierMySQL, hFichierNormal, hFichierOLEDB, hFichierOracle, hFichierOracleLite, hFichierPostgreSQL, hFichierProgress)) ALORS
ExceptionDéclenche(2,ChaîneConstruit(ls_MessageException2,ls_nomFichierParametre))
FIN
//----->Rcp des liaisons liés au fichier passé en paramètre
ls_LstLiaison=HListeLiaison(ls_nomFichierParametre,hLstDétail)
//----->Boucle sur toutes les liaisons
POUR TOUTE CHAÎNE ls_liaison DE ls_LstLiaison SEPAREE PAR RC
//----->Récupération des caractéristiques de la liaison
ls_nomLiaison=ExtraitChaîne(ls_liaison,1,TAB,DepuisDébut)
ls_FichierClePrimaire=ExtraitChaîne(ls_liaison,2,TAB,DepuisDébut)
ls_clePrimaire=ExtraitChaîne(ls_liaison,3,TAB,DepuisDébut)
ls_cardinaliteFichierPrimaire=ExtraitChaîne(ls_liaison,4,TAB,DepuisDébut)
ls_fichierCleEtrangere=ExtraitChaîne(ls_liaison,5,TAB,DepuisDébut)
ls_CleEtrangere=ExtraitChaîne(ls_liaison,6,TAB,DepuisDébut)
ls_cardinaliteFichierSecondaire=ExtraitChaîne(ls_liaison,7,TAB,DepuisDébut)
ls_regleSupression=ExtraitChaîne(ls_liaison,9,TAB,DepuisDébut)
SI ls_FichierClePrimaire = ls_nomFichierParametre ALORS
SI Val(ExtraitChaîne(ls_cardinaliteFichierSecondaire,1,",",DepuisDébut)) > 0 ALORS
ExceptionDéclenche(3,ChaîneConstruit(ls_MessageException4,ls_cardinaliteFichierSecondaire,ls_fichierCleEtrangere,ls_CleEtrangere,ls_FichierClePrimaire,ls_clePrimaire))
FIN
//----->Initialisation des variables
ls_LstValeurLiees=""
//----->Req : recherche des valeurs à supprimer dans le fichier source
ls_requete="SELECT DISTINCT "+ls_clePrimaire+" FROM "+ls_FichierClePrimaire
ls_nomReq="ReqSelectValeurASupprimer"
//----->Req : Exécution et parcours de la requete
SI PAS HExécuteRequêteSQL(ls_nomReq,ls_requete) ALORS
HFerme(ls_nomReq)
RENVOYER Faux
SINON
HLitPremier(ls_nomReq)
TANTQUE PAS HEnDehors(ls_nomReq)
ls_LstValeurLiees+=HRécupèreRubrique(ls_nomReq,1)+"','"
HLitSuivant(ls_nomReq)
FIN
HLibèreRequête(ls_nomReq)
SI ls_LstValeurLiees <> "" ALORS
ls_LstValeurLiees="'"+Tronque(ls_LstValeurLiees,3,nombreDeCaractèresASupprimer)+"'"
FIN
FIN
//----->Test si des valeurs sont à suppimer
SI ls_LstValeurLiees<>"" ALORS
//----->Test selon la regle de suppression
SELON ls_regleSupression
CAS hIntégritéInterdite
//---->Req : Test si des enregistrements sont reliés au fichier source par le svaleurs à supprimer
ls_requete="SELECT COUNT(*) FROM "+ls_fichierCleEtrangere+" WHERE "+ls_CleEtrangere+" IN ("+ls_LstValeurLiees+")"
ls_nomReq="reqUpdateDetail"
//----->Req : Exécution et parcours
SI PAS HExécuteRequêteSQL(ls_nomReq,ls_requete) ALORS
HFerme(ls_nomReq)
RENVOYER Faux
SINON
HLitPremier(ls_nomReq)
//----->Test si des enregistrements sont reliés : on ne fait rien
SI HRécupèreRubrique(ls_nomReq,1) <> 0 ALORS
HLibèreRequête(ls_nomReq)
ExceptionDéclenche(3,ChaîneConstruit(ls_MessageException3,ls_FichierClePrimaire,ls_clePrimaire,ls_fichierCleEtrangere,ls_CleEtrangere))
FIN
HLibèreRequête(ls_nomReq)
FIN
CAS hIntégritéCascade
//----->Req : Ajout dans le buffer la requête de suppression des enregistrements reliés au fichier source par le svaleurs à supprimer
TableauAjoute(lt_BufferRequete,"DELETE FROM "+ls_fichierCleEtrangere+" WHERE "+ls_CleEtrangere+" IN ("+ls_LstValeurLiees+")")
CAS hIntégritéValeurDéfaut
//----->Req : Ajout dans le buffer la requête de maj des enregistrements par la valeur par défaut reliés au fichier source par le svaleurs à supprimer
TableauAjoute(lt_BufferRequete,"UPDATE "+ls_fichierCleEtrangere+" SET "+ls_CleEtrangere+"='"+{ls_fichierCleEtrangere+"."+ls_CleEtrangere,indRubrique}..ValeurParDéfaut+"' WHERE "+ls_CleEtrangere+" IN ("+ls_LstValeurLiees+")")
AUTRE CAS
FIN
FIN
FIN
FIN
//----->Exécution des requêtes pour mettre en place les contraintes d'intégrité
POUR li_i=1 _A_ TableauInfo(lt_BufferRequete,tiNombreTotal)
SI HExécuteRequêteSQL("Req"+li_i,lt_BufferRequete[li_i]) = Faux ALORS
ExceptionDéclenche(3,HErreurInfo(hErrComplet))
FIN
FIN
SI WL.HSupprimeTout(ps_nomFichier) ALORS
RENVOYER Vrai
SINON
RENVOYER Faux
FIN |