Gestion base de donnee
Contenu du snippet
Ce programme doit être pris comme un exemple de gestion interne des données.
Ceci est un moteur pour lire, écrire, modifier les données avec une méthode d'accès originale.
Cette suite de sous-programmes permet de :
creer une base qui sera automatiquement indexe.
De plus par non repetition des zones, cette organisation permet de gagner de la place.
Ceci est un moteur pour lire, écrire, modifier les données avec une méthode d'accès originale.
Cette suite de sous-programmes permet de :
creer une base qui sera automatiquement indexe.
De plus par non repetition des zones, cette organisation permet de gagner de la place.
Source / Exemple :
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
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.