Soyez le premier à donner votre avis sur cette source.
Snippet vu 84 201 fois - Téléchargée 91 fois
GESTIONNAIRE DE BASE DE DONNEES SUPER INDEXE ' ' VERSION 1.0 du 23/07/1999 GERARD VIENT (FRANCE) ' Langage testé : ' VISUAL BASIC 5 ' IL EXISTE UNE VERSION EN QUICK BASIC ' ' Ceci est une suite de modules pour gérer une base de donnée ' dont tous les champs sont indéxés ' Le produit permet de compresser les données en évitant la répétition ' des données identiques (exemple 49100 n'apparaitra qu'une fois dans la base) ' Pour voir la structure des fichiers aller dans le module creafic ' longueur des zones en variables de 0 à 255 caracteres ' pas de caractère chr(0) dans les variables ! ' 255 champs maxi ' Pour modifier un enregistrement : ' - le supprimer ' - le créer avec les modifications ' NOTES : ' - la structure est un peu compliquée mais elle permet de bons temps de réponse ' la lecture séquentielle est la moins performante ' - Pour faire une recherche sur x zones de la base : ' exemple : ' une base contient nom prenom ' faire un concaténation des deux champs et les mettres dans un nouveau champ ' ensuite faire la recherche sur ce champ ' - La suppression consiste à mettre le valeur 0 dans le numéro de champ ' pas de suppression réel , il faut penser à réorganiser la base en la copiant dans une autre ' ' Il faut déclarer ces variables ! ' on peut ouvrir plusieurs bases (ici 3 3*7) ' 1 à 7, 8 à 14, 15 à 21 ' Public Type enregistrement enr As String End Type Public anccur, numero, numero2, enra(255), donnee(21, 256), donneea(21, 256), modif, erreur, nbresauve Const x1 = 256# * 256# * 256# Const x2 = 256# * 256# Const x3 = 256# Sub creafic(nom$) ' ' sp de creation d un fichier super indexe ' ' STRUCTURE : ' Les fichiers xxxxxxxx.1 . xxxxxxxx.6 : ' 7 octets (debut de clef) ' 1 octet ( sert pour la recherche séquentiel champ de 1 à 8 ' pour une recherche plus rapide) ' 4 octets (pointeur sur clef dans fichier .dat) ' le fichier xxxxxxxx.dat : ' pour le premier enregistrement d une serie ' 4 octets indique l enregistrement suivant ( a zero si rien) ' 4 octets indique le dernier enregistrement de la serie ' 4 octets pointe sur la zone clef ' 1 octet numero de champ ' 4 octets pointe sur le champ suivant ' x octets clef + chr$(0) ' pour les autres de la serie ' 4 octets indique l enregistrement suivant ' 4 octets indique l enregistrement precedant ' 4 octets pointe sur la zone clef ' 1 octet numero de champ ' 4 octets pointe sur le champ suivant Open nom$ + ".dat" For Binary As 1 a$ = mkl(0) Put #1, 1, a$ Close #1 a$ = String$(7, 0) + Chr$(255) + mkl(0) + String$(7, 255) + Chr$(255) + mkl(0) For g = 1 To 6 ext$ = Mid$(Str$(g), 2) Open nom$ + "." + ext$ For Binary As numero + 1 Put numero + 1, 1, a$ Close numero + 1 Next g End Sub Sub basechoixindex(numero, enr4$, enr7$, g, clerech7$, clerech$, recorn, numero2, anccur, trouve) ' ' sp pour choix du fichier index ' on choisit l'index suivant le code ASCII du premier caractère ' mini = 1 anccur = 1 trouve = 0 clerech$ = donneea(numero, g) + Chr$(0) clerech2$ = clerech$ clerech7$ = Left$(clerech$ + String$(7, 255), 7) Select Case Asc(clerech$) Case Is <= 32 numero2 = numero + 1 Case Is <= 64 numero2 = numero + 2 Case Is <= 68 numero2 = numero + 3 Case Is <= 77 numero2 = numero + 4 Case Is <= 82 numero2 = numero + 5 Case Else numero2 = numero + 6 End Select maxi = LOF(numero2) / 12 While mini < maxi cur = Int((maxi - mini) / 2) + mini If cur <= mini Then mini = maxi anccur = cur + 1 Else cur2# = (cur - 1) * 12 + 1 Get numero2, cur2#, enr7$ If clerech7$ = enr7$ Then Get numero2, cur2# + 8, enr4$ recorn = cvl(enr4$) Get numero, recorn, clerech2$ If clerech$ = clerech2$ Then trouve = 1 mini = maxi anccur = cur Else If clerech2$ < clerech$ Then anccur = cur + 1 mini = cur Else anccur = cur maxi = cur End If End If Else If enr7$ < clerech7$ Then anccur = cur + 1 mini = cur Else anccur = cur maxi = cur End If End If End If Wend End Sub Sub baselectart(trouve, numero, recorn, aa As String, b$, d$, e$) ' ' sp de lecture d'un enregistrement ' trouve = 1 Get numero, recorn + 8, e$ donnee(numero, nbre) = recorn Get numero, cvl(e$), d$ donneea(numero, nbre) = Left$(d$, InStr(d$, Chr$(0)) - 1) Get numero, recorn + 13, e$ recorn = cvl(e$) aa = Chr$(0) While aa <> b$ Get numero, recorn + 12, aa Get numero, recorn + 8, e$ Get numero, cvl(e$), d$ donneea(numero, Asc(aa)) = Left$(d$, InStr(d$, Chr$(0)) - 1) donnee(numero, Asc(aa)) = recorn Get numero, recorn + 13, e$ recorn = cvl(e$) Wend recorn = 0 End Sub Sub closefic(nom$, numero) ' ' sp de fermeture ' Close numero For g = 1 To 6 Close numero + g Next g End Sub Sub creaenr(nom$, numero, nbre) ' ' sp de creation les donnees sont dans donneea(numero,) ' les données vides ne sont pas enregistrées ' Dim place, ancien, ancien2 As Long, recor As enregistrement, aa As enregistrement mkl0$ = mkl(0) enr1$ = " " enr4$ = String$(4, 0) enr7$ = String$(7, 0) ancien = 0 ancien2 = 0 place = 0 For g = nbre To 1 Step -1 If donneea(numero, g) <> "" Then chrg$ = Chr$(g) Call basechoixindex(numero, enr4$, enr7$, g, clerech7$, clerech$, recorn, numero2, anccur, trouve) If trouve = 0 Then cur2 = (anccur - 1) * 12 + 1 place = LOF(numero) + 1 recor.enr = mkl0$ + mkl(place) + mkl(place + 17) + chrg$ + mkl(ancien) + clerech$ Put numero, place, recor.enr a# = LOF(numero2) - cur2 + 1 If a# <= 4096 Then pt# = cur2 enr$ = String$(a#, 0) Get numero2, pt#, enr$ Put numero2, pt# + 12, enr$ Else pt# = LOF(numero2) - 4096 + 1 enr$ = String$(4096, 0) While a# <> 0 Get numero2, pt#, enr$ Put numero2, pt# + 12, enr$ a# = a# - 4096 If a# <= 4096 Then pt# = cur2 enr$ = String$(a#, 0) Get numero2, pt#, enr$ Put numero2, pt# + 12, enr$ a# = 0 Else pt# = pt# - 4096 End If Wend End If If g > 8 Then enr$ = clerech7$ + Chr$(0) + mkl(place + 17) Else enr$ = clerech7$ + Chr$(2 ^ (g - 1)) + mkl(place + 17) End If Put #numero2, cur2, enr$ Else place = LOF(numero) + 1 Get numero, recorn - 13, enr4$ recor2# = cvl(enr4$) enr4$ = mkl(place) recor.enr = enr4$ Put numero, recor2#, recor.enr Put numero, recorn - 13, recor.enr recor.enr = mkl0$ + mkl(recor2#) + mkl(recorn) + chrg$ + mkl(ancien) Put numero, place, recor.enr cur2 = (anccur - 1) * 12 + 1 ' ' ici on met à jour le code dans l'index pour la recherche séquentielle ' If g < 9 Then Get #numero2, cur2 + 7, enr1$ a = Asc(enr1$) b = 2 ^ (g - 1) enr1$ = Chr$(a Or b) Put #numero2, cur2 + 7, enr1$ End If End If If ancien2 = 0 Then ancien2 = place End If ancien = place donnee(numero, g) = place End If Next g If ancien2 <> 0 Then aa.enr = mkl(ancien) Put numero, ancien2 + 13, aa.enr End If End Sub Sub lectfic(numero, nbre, trouve) ' ' sp de lecture ' clef compléte ' enr4$ = String$(4, 0) enr7$ = String$(7, 0) Call basechoixindex(numero, enr4$, enr7$, nbre, clerech7$, clerech$, recorn, numero2, anccur, trouve) If trouve = 1 Then a$ = " " b$ = Chr$(nbre) c$ = " " While recorn > 0 Get numero, recorn - 5, a$ If a$ = b$ Then recorn = -recorn Else Get numero, recorn - 17, c$ recorn = cvl(c$) If recorn <> 0 Then recorn = recorn + 17 End If End If Wend If recorn = 0 Then trouve = 0 Else a$ = Chr$(0) d$ = String$(256, 0) e$ = " " recorn = Abs(recorn) donnee(numero, nbre) = recorn - 17 Get numero, recorn - 4, e$ recorn = cvl(e$) While a$ <> b$ Get numero, recorn + 12, a$ Get numero, recorn + 8, e$ Get numero, cvl(e$), d$ donneea(numero, Asc(a$)) = Left$(d$, InStr(d$, Chr$(0)) - 1) donnee(numero, Asc(a$)) = recorn Get numero, recorn + 13, e$ recorn = cvl(e$) Wend End If End If End Sub Sub lectfic2(numero, nbre, trouve) ' ' sp de lecture avec clef incomplete ' enr4$ = String$(4, 0) enr7$ = String$(7, 0) mini = 1 anccur = 1 trouve = 0 clerech$ = donneea(numero, nbre) clerech2$ = clerech$ l = Len(clerech$) If l < 7 Then clerech7$ = clerech$ Else clerech7$ = Left$(clerech$, 7) End If Select Case Asc(clerech$) Case Is <= 32 numero2 = numero + 1 Case Is <= 64 numero2 = numero + 2 Case Is <= 68 numero2 = numero + 3 Case Is <= 77 numero2 = numero + 4 Case Is <= 82 numero2 = numero + 5 Case Else numero2 = numero + 6 End Select maxi = LOF(numero2) / 12 While mini < maxi cur = Int((maxi - mini) / 2) + mini If cur <= mini Then mini = maxi anccur = cur + 1 Else cur2 = (cur - 1) * 12 + 1 Get numero2, cur2, enr7$ If clerech7$ = Left$(enr7$, l) Then Get numero2, cur2 + 8, enr4$ recorn = cvl(enr4$) Get numero, recorn, clerech2$ If clerech$ = clerech2$ Then While clerech$ = clerech2$ And cur > 1 cur = cur - 1 cur2 = (cur - 1) * 12 + 1 Get numero2, cur2, enr7$ If clerech7$ = Left$(enr7$, l) Then Get numero2, cur2 + 8, enr4$ recor2# = cvl(enr4$) Get numero, recor2#, clerech2$ If clerech$ = clerech2$ Then recorn = recor2# End If Else clerech2$ = String$(l, Chr$(0)) End If Wend trouve = 1 mini = maxi anccur = cur + 1 Else If clerech2$ < clerech$ Then anccur = cur + 1 mini = cur Else anccur = cur maxi = cur End If End If Else If enr7$ < clerech7$ Then anccur = cur + 1 mini = cur Else anccur = cur maxi = cur End If End If End If Wend If trouve = 1 Then ok = 0 Else ok = 1 End If While ok = 0 If trouve = 1 Then trouve = 0 a$ = " " b$ = Chr$(nbre) c$ = " " While recorn > 0 Get numero, recorn - 5, a$ If a$ = b$ Then recorn = -recorn trouve = 1 Else Get numero, recorn - 17, c$ recorn = cvl(c$) If recorn <> 0 Then recorn = recorn + 17 End If End If Wend If recorn = 0 Then cur = cur + 1 cur2 = (cur - 1) * 12 + 1 Get numero2, cur2, enr7$ If clerech7$ = Left$(enr7$, l) Then Get numero2, cur2 + 8, enr4$ recorn = cvl(enr4$) Get numero, recorn, clerech2$ If clerech$ <> clerech2$ Then ok = 1 Else trouve = 1 Else ok = 1 End If Else a$ = Chr$(0) d$ = String$(256, 0) e$ = " " recorn = Abs(recorn) Get numero, recorn, d$ donneea(numero, nbre) = Left$(d$, InStr(d$, Chr$(0)) - 1) donnee(numero, nbre) = recorn - 17 Get numero, recorn - 4, e$ recorn = cvl(e$) While a$ <> b$ Get numero, recorn + 12, a$ Get numero, recorn + 8, e$ Get numero, cvl(e$), d$ donneea(numero, Asc(a$)) = Left$(d$, InStr(d$, Chr$(0)) - 1) donnee(numero, Asc(a$)) = recorn Get numero, recorn + 13, e$ recorn = cvl(e$) ok = 1 Wend End If End If Wend End Sub Sub lectnext(numero, nbre, trouve) ' ' sp de lecture de l enregistrement suivant ' trouve = 9 fin de fichier ' trouve = 1 ok trouve suivant ' Dim aa As String finfic = numero + 5 debfic = numero record# = donnee(numero, nbre) chr0$ = Chr$(0) aa = Chr$(0) b$ = Chr$(nbre) c2 = 2 ^ (nbre - 1) e$ = String$(4, 0) d$ = String$(256, 0) enr4$ = String$(4, 0) enr7$ = String$(7, 0) trouve = 0 a = debfic x = 8 If record# = 0 Then numero2 = numero + a While a <= finfic x = x + 12 Get #numero2, x, aa anccur = (x - 8) / 12 If (Asc(aa) And c2) > 0 Or nbre > 8 Then Get #numero2, x + 1, e$ record# = cvl(e$) If record# = 0 Then a = a + 1 numero2 = numero + a x = 8 If a > finfic Then trouve = 9 donnee(numero, nbre) = 0 End If Else record# = record# - 17 While record# <> 0 Get #numero, record# + 12, aa If aa = b$ Then Call baselectart(trouve, numero, record#, aa, b$, d$, e$) a = numero + 9 Else Get #numero, record#, e$ record# = cvl(e$) End If Wend End If End If Wend End If While trouve = 0 If record# = 0 Then record# = anccur * 12 + 1 anccur = anccur + 1 Get #numero2, record# + 7, aa Get #numero2, record# + 8, e$ record# = cvl(e$) - 17 While (Asc(aa) And c2) = 0 And nbre < 9 And record# > 0 record# = anccur * 12 + 1 anccur = anccur + 1 Get #numero2, record# + 7, aa Get #numero2, record# + 8, e$ record# = cvl(e$) - 17 Wend If record# < 0 Then numero2 = numero2 + 1 a = numero2 - numero x = 8 If a > numero + 5 Then trouve = 9 donnee(numero, nbre) = 0 End If While a < 7 x = x + 12 Get #numero2, x, aa If (Asc(aa) And c2) > 0 Or nbre > 8 Then Get #numero2, x + 1, e$ record# = cvl(e$) If record# = 0 Then a = a + 1 numero2 = numero + a x = 8 If a > numero + 5 Then trouve = 9 donnee(numero, nbre) = 0 End If Else record# = record# - 17 While record# > 0 Get #numero, record# + 12, aa If aa = b$ Then Call baselectart(trouve, numero, record#, aa, b$, d$, e$) a = 9 Else Get #numero, record#, e$ record# = cvl(e$) End If Wend End If End If Wend Else Get #numero, record# + 8, e$ donnee(numero, nbre) = record# Get #numero, cvl(e$), d$ donneea(numero, nbre) = Left$(d$, InStr(d$, Chr$(0)) - 1) While record# > 0 Get #numero, record# + 12, aa If aa = b$ Then Call baselectart(trouve, numero, record#, aa, b$, d$, e$) Else Get #numero, record#, e$ record# = cvl(e$) End If Wend End If Else Get #numero, record#, e$ record# = cvl(e$) While record# > 0 Get #numero, record# + 12, aa If aa = b$ Then Call baselectart(trouve, numero, record#, aa, b$, d$, e$) Else Get #numero, record#, e$ record# = cvl(e$) End If Wend End If Wend End Sub Sub lectprev(numero, nbre, trouve) ' ' sp de lecture de l enregistrement precedant ' trouve = 9 fin de fichier ' trouve = 1 ok trouve precedant ' Dim aa As String record# = donnee(numero, nbre) chr0$ = Chr$(0) aa = Chr$(0) b$ = Chr$(nbre) c2 = 2 ^ (nbre - 1) e$ = String$(4, 0) e2$ = String$(4, 0) d$ = String$(256, 0) enr4$ = String$(4, 0) enr7$ = String$(7, 0) trouve = 0 a = numero + 5 x = LOF(numero + a) - 4 If record# = 0 Then While a > 1 numero2 = numero + a anccur = (x - 8) / 12 x = x - 12 Get #numero2, x, aa If (Asc(aa) And c2) > 0 Or nbre > 8 Then Get #numero2, x + 1, e$ record# = cvl(e$) If record# = 0 Then a = a - 1 numero2 = numero + a x = LOF(numero2) - 4 If a < numero Then trouve = 9 donnee(numero, nbre) = 0 End If Else record# = cvl(e$) - 13 If record# > 0 Then Get #numero, record#, e$ record# = cvl(e$) End If While record# <> 0 Get #numero, record# + 12, aa If aa = b$ Then Call baselectart(trouve, numero, record#, aa, b$, d$, e$) a = 0 End If If record# > 0 Then Get #numero, record# + 4, e$ Get #numero, record# + 8, e2$ If record# + 17 = cvl(e2$) Then record# = 0 Else record# = cvl(e$) End If End If Wend End If End If Wend End If While trouve = 0 If record# = 0 Then anccur = anccur - 1 a = numero2 - numero trouve = 0 record# = (anccur - 2) * 12 + 1 Get #numero2, record# + 7, aa Get #numero2, record# + 8, e$ record# = cvl(e$) - 13 While (Asc(aa) And c2) = 0 And nbre < 9 And record# > 13 anccur = anccur - 1 record# = (anccur - 2) * 12 + 1 Get #numero2, record# + 7, aa Get #numero2, record# + 8, e$ record# = cvl(e$) - 13 Wend If record# > 0 Then Get #numero, record#, e$ record# = cvl(e$) End If If record# < 0 Then a = a - 1 numero2 = numero + a If a < 1 Then trouve = 9 donnee(numero, nbre) = 0 Else x = LOF(numero + a) - 4 End If While a > 0 x = x - 12 Get #numero2, x, aa If (Asc(aa) And c2) > 0 Or nbre > 8 Then Get #numero2, x + 1, e$ record# = cvl(e$) If record# = 0 Then a = a - 1 numero2 = numero + a x = LOF(numero2) - 4 If a < 1 Then trouve = 9 donnee(numero, nbre) = 0 End If Else record# = record# - 13 If record# > 0 Then Get #numero, record#, e$ record# = cvl(e$) End If While record# > 0 Get #numero, record# + 12, aa If aa = b$ Then Call baselectart(trouve, numero, record#, aa, b$, d$, e$) a = 0 End If If record# > 0 Then Get #numero, record# + 4, e$ Get #numero, record# + 8, e2$ If record# + 17 = cvl(e2$) Then record# = 0 Else record# = cvl(e$) End If End If Wend End If End If Wend Else Get #numero, record# + 8, e$ donnee(numero, nbre) = record# Get #numero, cvl(e$), d$ donneea(numero, nbre) = Left$(d$, InStr(d$, Chr$(0)) - 1) While record# > 0 If record# <> 0 Then Get #numero, record# + 12, aa If aa = b$ Then Call baselectart(trouve, numero, record#, aa, b$, d$, e$) Else Get #numero, record# + 4, e$ Get #numero, record# + 8, e2$ If record# + 17 = cvl(e2$) Then record# = 0 Else record# = cvl(e$) End If End If End If Wend End If Else While record# > 0 Get #numero, record# + 4, e$ Get #numero, record# + 8, e2$ If record# + 17 = cvl(e2$) Then record# = 0 Else record# = cvl(e$) End If If record# <> 0 Then Get #numero, record# + 12, aa If aa = b$ Then Call baselectart(trouve, numero, record#, aa, b$, d$, e$) End If End If Wend End If Wend End Sub Sub openfic(nom$, numero) ' ' sp d ouverture de fichier ' ' la zone indexe est mise dans enra(numero) ' Open nom$ + ".dat" For Binary As numero For g = 1 To 6 Open nom$ + "." + Mid$(Str$(g), 2) For Binary As numero + g Next g End Sub Function mkl(chiffre) ' ' sp pour transformer un nombre en 4 caractères ' Note : nombre entier et positif ' chiffre2 = chiffre a1$ = Chr(Int(chiffre2 / x1)) chiffre2 = chiffre2 - Asc(a1$) * x1 a2$ = Chr(Int(chiffre2 / x2)) chiffre2 = chiffre2 - Asc(a2$) * x2 a3$ = Chr(Int(chiffre2 / x3)) chiffre2 = chiffre2 - Asc(a3$) * x3 a4$ = Chr(Int(chiffre2)) mkl = a1$ + a2$ + a3$ + a4$ End Function Function cvl(chiffre$) ' ' sp pour tranformer une chaine de 4 caractères ' en un nombre entier positif ' cvl = Asc(Left(chiffre$, 1)) * x1 + Asc(Mid(chiffre$, 2, 1)) * x2 + Asc(Mid(chiffre$, 3, 1)) * x3 + Asc(Right(chiffre$, 1)) End Function
17 sept. 2007 à 10:42
Il doit être pris comme un exemple de code.
Si vous désirez un accès à une base de données classique,voir les sources sur access, oracle....
Cordialement
16 sept. 2007 à 09:17
j'essaye de m'initier à la Base de données (sur VB5). Sur l'exemple ci-dessus et vos messages associés , tout le monde trouve le programme très bien. J'ai téléchargé le point Zip et je trouve 4 fichiers "Base" et 1 module. Mais ensuite je ne sais pas ce qui il est nécessaire de faire pour essayer ce programme (il en est de même pour tout autre programme qui ne comporte pas de .exe). Vu les messages cela ne doit pas être compliqué mais peut-on avoir un petit coup de pouce pour un débutant.
Merci
20 janv. 2007 à 21:00
Ton code à l'air intéressant, je vais voir comment cela fonctionne !
Merci
Phil
20 janv. 2007 à 20:50
4 nov. 2006 à 20:00
Comme à l'école quand on travail bien on a une bonne note!!!Alors : 10/10
A+
Exploreur..Les chefs cé comme les étagères + cé o, - on sans sert !! lol
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.