begin process at 2012 02 09 23:41:55
  Trouver un code source :
 
dans
 
[ Dernières recherches ]
Accueil > 

Code

 > 

Base de Donnees

 > GESTION BASE DE DONNEE

GESTION BASE DE DONNEE


 Information sur la source

Note :
7,29 / 10 - par 72 personnes
7,29 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10
Catégorie :Base de Donnees Classé sous :gestion, base, données Niveau :Débutant Date de création :22/10/1999 Date de mise à jour :17/10/2004 09:01:31 Vu :79 408
Auteur : gvient

Ecrire un message privé
Site perso
Commentaire sur cette source (18)
Ajouter un commentaire et/ou une note

 Description

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.

Source

  • 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
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



 Historique

17 octobre 2004 09:01:32 :
Informations complémentaires

 Sources du même auteur

Source avec Zip UN UTILITAIRE UTILISANT LE GESTIONNAIRE DE BASE DE DONNÉES
FORCER LE FORMAT DATE EN FRANÇAIS
UN PROGRAMME PSYCHOLOGUE
CRYPTAGE DE PHRASE DANS UN DESSIN BMP
UN EXEMPLE DE COMPRESSEUR DE FICHIERS
Toutes les sources de gvient

 Sources de la même categorie

Source avec Zip Source avec une capture BIEN ADMINISTRER LES ETUDIANTS ET LEURS CÔTES par okosa
Source avec Zip VBA EXEL GESTION DE PERSONEL NOUVEAU CONTRAT DE TRAVAI par oudlarbi
Source avec Zip Source avec une capture CREATION D'UN OBJET D'ACCÈS AUX DONNÉES par okosa
Source avec Zip Source .NET (Dotnet) MISAHORAIRE par MdelM
Source avec Zip Source avec une capture BASEDEDONNEES,GESTIONDEMALADES,DATABASSE par shadkitenge
Toutes les sources de la catégorie Base de Donnees

 Sources en rapport avec celle ci

Source avec Zip Source avec une capture Source .NET (Dotnet) GESTION DE BASE DE DONNÉE ACCESS COMPLÈTE AVEC ORIENTÉ OBJET par ThoT49
Source avec Zip Source .NET (Dotnet) GESTION D'UN CONCOURS DE PÊCHE SANS BASE DE DONNÉES par theboogymaster
Source avec Zip Source avec une capture QUICK_EXP : BASE DE DONNÉES par Exploreur
Source avec Zip BASE DE DONNÉES EN ADO POUR DÉBUTANT par Exploreur
Source avec Zip Source avec une capture PROGRAMME COMPLET DE GESTION DE BASE DE DONNÉE EXCEL par XGuarden

Commentaires et avis

Commentaire de farid91 le 14/02/2002 09:38:08

Les commentaires qui faut mettre c ce que l'on pense de la source de l'auteur et non pour faire une demande d'aide. Il y a un forum pour ça mais bon.

Commentaire de cyberlulu le 08/01/2003 19:50:31

T'as tout à fait raison farid91, les commentaires c'est pour la source déposée, le reste il y a le forum qui est là !

Commentaire de PROGRAMMIX le 01/06/2003 11:13:13

Est-il possible de bénéficier d'un zip avec un exemple bien concret ?
Merci

Commentaire de abderrah le 04/03/2004 14:51:09

j'ai vraiment besoin de savoir comment realiser ADO, je suis debutant

Commentaire de code1 le 15/09/2004 19:01:10

abderrah si tu etre un pro en ado va regoindre
le cite www.developpez.com est clic sur language visual
basic tu trouve ennormement de chose en format .pdf

Commentaire de code1 le 15/09/2004 19:04:02

ce que je n'est pas compris dans cette source si
il ya beaucoup de carrécteré bisare mais en execussons cette source elle s'execute fassilement

Commentaire de saados le 17/09/2004 19:48:32

superb!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Commentaire de clementpat le 13/10/2004 15:08:25

Cela a l'air tres bien mais tu devrais mettre un exemple en zip , et cela serais parfait.

Commentaire de PROGRAMMIX le 13/10/2004 17:15:32

>>> clementpat
L'exemple existe...
Jette un oeil dans la section "Les 5 derniers codes ajoutés par gvient" et clique sur "UN UTILITAIRE UTILISANT LE GESTIONNAIRE DE BASE DE DONNÉES"...

ou http://www.vbfrance.com/codes/UN_UTILITAIRE_UTILISANT_LE_GESTIONNAIRE_DE_BASE_DE_DONNEES/593.aspx

Commentaire de clementpat le 13/10/2004 22:19:21

merci a toi programmix , amicalement /

Commentaire de kojo le 08/01/2005 11:58:57

tres bien mais c'est bien long(pas grav!)

Commentaire de mourafik19 le 21/05/2005 00:27:07

bien

Commentaire de reine005 le 29/08/2005 16:39:32

c'est intéressant, mais je penses quec'est un peu trop long. merci

Commentaire de Exploreur le 04/11/2006 20:00:46

Salut,

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

Commentaire de philippe laschweng 1 le 20/01/2007 20:50:45

Vraiment dommage qu'il n'y est pas de ZIP avec exemple concret car assez complexe a décodé le fonctionnement !

Commentaire de philippe laschweng 1 le 20/01/2007 21:00:27

Autant pour moi, je n'avais pas vu que tu l'avais créé !!! Désolé
Ton code à l'air intéressant, je vais voir comment cela fonctionne !

Merci
Phil

Commentaire de Beginner37 le 16/09/2007 09:17:48

Bonjour à tous,
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

Commentaire de gvient le 17/09/2007 10:42:47

ATTENTION CE PROGRAMME EST UN EXEMPLE DE GESTIONNAIRE DE BASE DE DONNEES.
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

 Ajouter un commentaire


Discussions en rapport avec ce code source dans le forum

Base de données pour la gestion des E-mail [ par imad8 ] Je vous demande cheres DBA de m'envoyer la structure classique d'une base de données capable de gérer les boites au lettres d'un grand nombre d'utilis Gestion de base de données Access [ par Boris88 ] Je suis débutant et je réalise un jeu en VB. Je doit lire, des données dans une table. Celles-ci sont susceptibles d'être modifiées et doivent ecraser Base de données avec access [ par xeresakrom ] Bonjour,Je suis étudiant et l'on me demande de faire un programme de gestion de vidéo club. Le problème est que je n'ai rien compris dans la gestion d Gestion plantage [ par kat40 ] Bonjour à tous,J'ai une application VB avec une base de données ACCESS. Lorsque quelqu'un ouvra l'application un 1 va s'inscrire dans la base de donn gestion d'un base de données [ par hasen ] Bonjour,Je vais beintot mettre en place une base de données Access qui sera utilisé par plusieurs personnes. Je voudrais savoir s'il est nécessaire de base de données gestion de stock [ par romeo77 ] je souhaite mettre en place une bonne de donnée de gestion de stock.si quelqu'un à un bon point de départ à me proposer. Base de données ciel gestion (devis factures) [ par latchoumanin ] Bonjour à tous,Voila mon problème:A l'heure actuel j'ai développé une application qui attaque un fichier client et article d'une logiciel de gestion a gestion de base de données comptable [ par montinin ] bonjour &#224; tous, voila mon probleme, je travaille sur un projet de developpement d'un moteur sous VB qui gere 2 bases de donn&#233;es l'une comerc je veux un conseil! [ par j_aub ] salut ttt le monde,je veux developper une application en vb.net ( sous forme exe et non pas du asp.net), qui permet le gestion des cr&#233;dits (rembo Gestion de base de données (compléter, consulter) [ par mikl07 ] Bonjour,J'ai un problème. J'ai créer plusieur userform (formulaires) pour qui créeent uen base de données automatiquement. tout fonctionne mais mainte


Nos sponsors


Sondage...

CalendriCode

Février 2012
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
272829    

Consulter la suite du CalendriCode

Photothèque

Photo Beautiful woman in a bikini meditating on the beachPhoto Framed Landscape Image of Monument Valley
Photo ?? 

Visiter la photothèque
 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 1,186 sec (4)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales
Outils Convertisseur VB/C# Snippets et scripts Outils en ligne La ToolBox
Communauté Programmation Photographie Technologie Newsgroups Emploi Forum Blogs
Guide d'achat Téléphonie mobile Image et son Informatique Bureautique Jeux vidéo
Logiciels Internet & Réseau Développement Market Android Jeux & Loisirs Graphisme Multimédia Sécurité Pilotes
Loisirs Cartes virtuelles Vidéos droles Jeux en ligne Géoguide AndroLib (Android Market)