base de données final version

base de donnée est un utilitaire pour vous faciliter la vie  quand dans votre application
quand vous avez besoin de récupérer des données de formulaire ectt.. 

reprenons depuis le début  tout d'abord

pour créer la base  instruction :gosub open_base      variable base$

vous allez ecrire dans la variable base$ les informations nécessaire a la création de la base
exemple base$="3,c:\base\mabase.bin,nom,25,prenom,25,adresse,50"  le premier chiffre le nombres d'index ici 3 (nom prenom adresse)
suivi d'une virgule puis du chemin et du nom de fichier a créer  ici c:\base\mabase.bin  puis virgule puis le nom de l'index1 puis sa taille en
nombres de caractère et puis ainsi de suite .on peu aller jusqu'à 200 valeurs
exemple:
 
base$="3,c:\base\mabase.bin,nom,25,prenom,25,adresse,50"
gosub open_base


la base est créer sous la forme d'un tableau  de 3 colonnes et de 1000 lignes
en position 1 de chaque colonne un pointeur avec la valeur 2 a été créer afin de
renseigner  au programme que a la prochaine fois if faudra écrire ou pas  a la ligne 2

pour ecrire dans la base instruction :gosub writebase_index_ligne_valeur    variables-  index$  valeurw$  et lignew
exemple:

valeurw$="bonjour"
indexw$="prenom"
lignew=3
gosub writebase_index_ligne_valeur

il va ecrire bonjour dans la ligne 3 de la collonne prenom


pour ecrire dans la base en fonction de la position du pointeur instruction: gosub writepop_index_valeur      variables  indexw$  valeurw$

exemple

valeurw$="philippe"
indexw$="prenom"
gosub writepop_index_valeur        il va ecrire philippe dans la collonne prenom a l'endroit indiquer en fonction de la position du pointeur (au depart ligne 2)
                                  puis incrementer le pointeur pour la prochaine valeur et ainsi de suite


pour lire dans la base  instruction : gosub readbase_index_ligne_valeur          variable:  indexw$    valeurw  lignew

exemple
lignew=2
indexw$="prenom"
readbase_index_ligne_valeur      il va lire dans la collonne prenom la valeur de la ligne  et la placer dans la variable valeurw$
print valeurw$

en locurence il va afficher philippe que j'ai précédament incrit dans la ligne 2

pour conaitre la position courante du pointeur d'un index      instruction: position_p_index_ligne    variable      indexw$  lignew

exemple
indexw$="prenom"
gosub position_p_index_ligne
print valeurw$

il affichera  la prochaine position d'ecriture avec le sous programme ----gosub writepop_index_valeur


pour suprimer dans la base en fonction de la position du pointeur. instruction: gosub delval_index_ligne    indexw$

exemple
indexw$="prenom"
lignew=2
gosub delval_index_ligne    il va suprimer la valeur dans la collonne prenom a la ligne 2 et replacer les autre valeur a sa suite 
                                  puis decrementer le pointeur pour la prochaine valeur et ainsi de suite



pour chercher une chaine dans une valeur  instruction : gosub search_valeur_index_nbs_vtx        variable indexw$  valeurw$  nbs vt(x)

exemple
indexw$="prenom"                            il va chercher la chaine "phi" au debut de toutes les valeurs de lindex prenom
valeurw$="phi"                              il indiquera le nombre de valeurs trouvé dan la variable nbs
gosub search_valeur_index_nbs_vtx          et indiquera leur positions dans le tableau vt(x)
print nbs
print vtx(1)


voila il ne reste plus que a tester  a  plus

label variable
 gosub variable



base$="3,c:\base\base3.bin,nom,25,prenom,25,adresse,50"
gosub open_base
rem **************************************************
rem *      essaie  un carnet dadresse simple      *
rem **************************************************

  COMBO 3
left 3,100
top 3,110
width 3,222

edit 4
left 4,100
top 4,140
width 4,222

edit 5
left 5,100
top 5,170
width 5,300
alpha 8
left 8,6
top 8,110
width 8,87
caption 8,"NOM"

alpha 9
left 9,10
top 9,140
caption 9,"PRENOM"

alpha 10
left 10,10
top 10,170
caption 10,"ADRESSE"
button 31
caption 31,"AJOUTER"
left 31,450
top 31,100
BUTTON 32
CAPTION 32,"MODIFIER"
left 32,450
top 32,130
button 33
caption 33,"SUPRIMER"
 left 33,450
top 33,160
clear 3
  for bo=2 to pointeur
  indexw$="nom"
 lignew=bo
  gosub readbase_index_ligne_valeur
  ITEM_ADD 3,valeurw$
    next bo
on_click 31,ajouter
on_click 32,modifier
on_click 33,effacer
on_click 3,rescombo
gosub init
end
rem **************************************************
rem *                    ajouter                    *
rem **************************************************
ajouter:
if text$(3)="" then return
valeurw$=text$(3)
indexw$="nom"
gosub writepop_index_valeur
valeurw$=text$(4)
indexw$="prenom"
gosub writepop_index_valeur
valeurw$=text$(5)
indexw$="adresse"
gosub writepop_index_valeur
clear 3
text 4,""
text 5,""
gosub init
rem **************************************************
rem *                        fin                    *
rem **************************************************
return
rem **************************************************
rem *                    modifier                    *
rem **************************************************
modifier:

 lignew=ITEM_INDEX(3)+1
if ITEM_INDEX(3)=0 then return
 valeurw$=text$(4)
 indexw$="prenom"
 gosub writebase_index_ligne_valeur
 valeurw$=text$(5)
 indexw$="adresse"
 gosub writebase_index_ligne_valeur
  gosub init
return
rem **************************************************
rem *                        fin                    *
rem **************************************************
rem **************************************************
rem *                      effacer                  *
rem **************************************************
effacer:

 lignew=ITEM_INDEX(3)+1
 if ITEM_INDEX(3)=0 then return
  indexw$="prenom"
 gosub delval_index_ligne
  indexw$="adresse"
  lignew=ITEM_INDEX(3)+1
 gosub delval_index_ligne
  indexw$="nom"
  lignew=ITEM_INDEX(3)+1
 gosub delval_index_ligne
 gosub init


 return
rem ***************************************************
rem *                        fin                      *
rem ***************************************************
rem ***************************************************
rem *                  recherche dans combos          *
rem ***************************************************
rescombo:



 lignew=ITEM_INDEX(3)+1

  indexw$="prenom"
  gosub readbase_index_ligne_valeur
  text 4,valeurw$
  lignew=ITEM_INDEX(3)+1
  indexw$="adresse"
  gosub readbase_index_ligne_valeur
  text 5,valeurw$

return
rem ***************************************************
rem *                        fin                      *
rem ***************************************************

rem ***************************************************
rem *            initialisation apres modif          *
rem ***************************************************
init:
clear 3
indexw$="nom"
lignew=1
gosub readbase_index_ligne_valeur
pointeur=val(valeurw$)
for bo=2 to pointeur-1
  indexw$="nom"
 lignew=bo
  gosub readbase_index_ligne_valeur
  ITEM_ADD 3,valeurw$
    next bo
  text 4,""
    text 5,""
return
rem ***************************************************
rem *                        fin                      *
rem ***************************************************




rem *************************************************************************
rem *                                                                      *
rem *                    debut progamme base de donnees                    *
rem *                                                                      *
rem *************************************************************************
rem **********************************************************
rem *                        topindex                        *
rem **********************************************************
 topindex:

 for bo=1 to nbindex
  indexw$=index$(bo)
 lignew=999
 valeurw$="findebase"
 gosub writebase_index_ligne_valeur
  indexw$=index$(bo)
 lignew=1
  gosub readbase_index_ligne_valeur

if valeurw$=string$(val(valeurchain$(bo)),chr$(0)) then indexw$=index$(bo):lignew=1 :valeurw$="2" : gosub writebase_index_ligne_valeur
 next bo
 return
rem **********************************************************
rem *                        fin                            *
rem **********************************************************





rem ***********************************************************
rem *                      open_base                        *
rem ***********************************************************
open_base:
a$="" : a=0 : b$="" :r=0
for i=1 to len (base$)
if mid$(base$,i,1)="," then goto saut_1
a$=a$+mid$(base$,i,1)
next i
saut_1:
a=val(a$)
nbindex=a
a$=""
b=1
for i=1 to len(base$)
if mid$(base$,i,1)="," then b=b+1
if b=2 then a$=a$+mid$(base$,i,1)
next i
a$=mid$(a$,2,len(a$)-1)
fichier$=a$
rem ---------
b=0 :a$="":b$=""
a$=""
for i=0 to nbindex+1
for x=1 to len(base$)
 if mid$(base$,x,1)="," then b=b+1
 if b=2+r  then a$=a$+mid$(base$,x,1)  : index$(i+1)=a$
 if b=3+r  then b$=b$+mid$(base$,x,1)  : valeurchain$(i+1)=b$
 next x
 r=r+2
 b=0
a$=""
b$=""
next i
for i=1 to nbindex
index$(i)=mid$(index$(i),2,len(index$(i))-1)
valeurchain$(i)=mid$(valeurchain$(i),2,len(valeurchain$(i))-1)
next i
gosub topindex
return
rem ***********************************************************
rem *                          fin                            *
rem ***********************************************************



rem ***********************************************************
rem *                writebase_index_ligne_valeur            *
rem ***********************************************************
 writebase_index_ligne_valeur:
 debchain=0
 for i=1 to nbindex
 if indexw$=index$(i) then p=i
 next i
  if p=1 then debchain=1000+(val(valeurchain$(p))*lignew)+1
 if p>1 then for i=1 to p-1:debchain=debchain+(val(valeurchain$(i))*1000):next i:debchain=debchain+1000+1+(val(valeurchain$(p))*lignew)
 a=val(valeurchain$(p))-len(valeurw$)
 if a<=0 then goto petitsaut
valeurw$=valeurw$+string$(a," ")
 petitsaut:
 valeurw$=left$(valeurw$,val(valeurchain$(p)))
filebin_open_write 1,fichier$
filebin_position 1,debchain-1
for i=debchain to debchain+len(valeurw$)-1
blanc%(i)=asc(mid$(valeurw$,i-debchain+1,1))
filebin_block_write 1,1,blanc%(i)
next i
filebin_close 1
return
rem ***********************************************************
rem *                        fin                            *
rem ***********************************************************


rem ***********************************************************
rem *                readbase_index_ligne_valeur              *
rem ***********************************************************
readbase_index_ligne_valeur:
debchain=0
for i=1 to nbindex
if indexw$=index$(i) then p=i
next i
if p=1 then debchain=1000+(val(valeurchain$(p))*lignew)+1
if p>1 then for i=1 to p-1:debchain=debchain+(val(valeurchain$(i))*1000):next i:debchain=debchain+1000+1+(val(valeurchain$(p))*lignew)
valeurw$=""
filebin_open_read 1,fichier$
filebin_position 1,debchain-1
for i=debchain to debchain+val(valeurchain$(p))-1

filebin_block_read 1,1,blanc%(i)
valeurw$=valeurw$+chr$(blanc%(i))
next i
filebin_close 1
return
rem ***********************************************************
rem *                          fin                          *
rem ***********************************************************

rem ***********************************************************
rem *                position_p_index_ligne                  *
rem ***********************************************************
position_p_index_ligne:
lignew=1
gosub readbase_index_ligne_valeur
lignew=val(valeurw$)
return
rem ***********************************************************
rem *                          fin                          *
rem ***********************************************************

rem ***********************************************************
rem *                  writepop_index_valeur                *
rem ***********************************************************
writepop_index_valeur:
valeurtw$=valeurw$
gosub position_p_index_ligne
valeurw$=valeurtw$
gosub writebase_index_ligne_valeur
lignew=1
gosub readbase_index_ligne_valeur
pointeur=val(valeurw$)
pointeur=pointeur+1
valeurw$=str$(pointeur)
gosub writebase_index_ligne_valeur
return
rem ***********************************************************
rem *                          fin                          *
rem ***********************************************************


rem ***********************************************************
rem *                      delval_index_ligne                *
rem ***********************************************************
delval_index_ligne:
 lignewt=lignew
 gosub position_p_index_ligne
for bo=lignewt to lignew
lignew=bo+1
gosub readbase_index_ligne_valeur
lignew=bo
gosub writebase_index_ligne_valeur
next bo
lignew=1
gosub readbase_index_ligne_valeur
pointeur=val(valeurw$)
pointeur=pointeur-1
valeurw$=str$(pointeur)
gosub writebase_index_ligne_valeur

return
rem ***********************************************************
rem *                          fin                          *
rem ***********************************************************

rem ***********************************************************
rem *                search_valeur_index_nbs_vtx            *
rem ***********************************************************

search_valeur_index_nbs_vtx:

nbs=0
valeurtw$=valeurw$
gosub position_p_index_ligne

for bo=2 to lignew-1
lignew=bo
gosub readbase_index_ligne_valeur
if valeurtw$=mid$(valeurw$,1,len(valeurtw$)) then nbs=nbs+1 :vtx(nbs)=bo
next bo
return
rem ***********************************************************
rem *                          fin                          *
rem ***********************************************************

rem ***********************************************************
rem *                  variables et labels                    *
rem ***********************************************************
variable:
dim base$,nbs,vtx(1000),a$,b$,c$,aa$,a,b,c,i,x,y,fichier$,nbindex,valindex,r,blanc%(10000000),p,temp$,aa(1000)
p=1
label readbase_index_ligne_valeur
label init
dim index$(200)
dim valeurchain$(100),valeurtw$
dim debchain
label saut_1
label open_base
label writebase_index_ligne_valeur
dim indexw$
dim lignew
dim valeurw$
label petitsaut
label topindex
label ajouter
label modifier
label effacer
label rescombo
dim pointeur,lignewt
dim bo,point
label position_p_index_ligne
label writepop_index_valeur
label delval_index_ligne
label search_valeur_index_nbs_vtx
return

label variable
 gosub variable



base$="14,c:\base\baseclient.bin,fournisseur,25,tel,15,fax,15,nbc,15,adresse,50,cdp,15,ville,30,lu,2,mar,2,mer,2,jeu,2,ven,2,sa,2,di,2"
gosub open_base
rem **************************************************
rem *      essaie  une base fournisseur simple      *
rem **************************************************

 left 0,1
top 0,1
width 0,800
height 0,600
caption 0,"AJOUTER FOURNISSEUR"

picture 1
left 1,660
top 1,10

picture 2
left 2,160
top 2,10
width 2,441
height 2,69

COMBO 3
left 3,100
top 3,110
width 3,324

edit 4
left 4,100
top 4,140
width 4,222

edit 5
left 5,100
top 5,170
width 5,221

edit 6
left 6,100
top 6,200
width 6,161



alpha 8
left 8,6
top 8,110
width 8,87
caption 8,"FOURNISSEUR"

alpha 9
left 9,10
top 9,140
caption 9,"TELEPHONE"

alpha 10
left 10,10
top 10,170
caption 10,"FAX"

alpha 11
left 11,10
top 11,200
caption 11,"NB CLIENT"



alpha 13
left 13,10
top 13,360
width 13,266
caption 13,"JOURS DE LIVRAISON"

check 14
left 14,120
top 14,390
caption 14,"MARDI"

check 15
left 15,230
top 15,390
caption 15,"MERCREDI"

check 16
left 16,340
top 16,390
caption 16,"JEUDI"

check 17
left 17,450
top 17,390
caption 17,"VENDREDI"

check 18
left 18,560
top 18,390
caption 18,"SAMEDI"

check 19
left 19,670
top 19,390
caption 19,"DIMANCHE"


check 21
left 21,10
top 21,390
caption 21,"LUNDI"

button 22
left 22,100
top 22,460
width 22,188
height 22,45
caption 22,"RETOUR SOMAIRE"
button 31
caption 31,"CREER"
left 31,380
top 31,150
 alpha 30
 left 30,450
top 30,116
rem FILE_LOAD 1,"C:\gestomenu\tartefraise.jpg"
rem FILE_LOAD 2,"C:\gestomenu\region_bretagne_logo.bmp"
BUTTON 32
CAPTION 32,"MODIFIER"
left 32,380
top 32,180
button 33
caption 33,"SUPRIMER"
 left 33,380
top 33,210
edit 34
left 34,100
top 34,250
width 34,324
edit 35
left 35,100
top 35,275
width 34,324
edit 36
left 36,100
top 36,300
width 34,324
alpha 37
left 37,6
top 37,250
width 37,87
caption 37,"ADRESSE"
alpha 38
left 38,6
top 38,275
width 38,87
caption 38,"CODE POSTAL"
alpha 39
left 39,6
top 39,300
width 39,87
caption 39,"VILLE"
clear 3
indexw$="fournisseur"
gosub position_p_index_ligne
for bo=2 to pointeur-1
indexw$="fournisseur"
lignew=bo
gosub readbase_index_ligne_valeur
ITEM_ADD 3,valeurw$
next bo
on_click 31,ajouter
on_click 32,modifier
on_click 33,effacer
on_click 3,rescombo
gosub init
end
rem **************************************************
rem *                    ajouter                    *
rem **************************************************
ajouter:
if text$(3)="" then return
valeurw$=text$(3)
indexw$="fournisseur"
gosub writepop_index_valeur
valeurw$=text$(4)
indexw$="tel"
gosub writepop_index_valeur
valeurw$=text$(5)
indexw$="fax"
gosub writepop_index_valeur
valeurw$=text$(6)
indexw$="nbc"
gosub writepop_index_valeur
valeurw$=text$(34)
indexw$="adresse"
gosub writepop_index_valeur
valeurw$=text$(35)
indexw$="cdp"
gosub writepop_index_valeur
valeurw$=text$(36)
indexw$="ville"
gosub writepop_index_valeur
valeurw$=str$(CHECKED(21))
indexw$="lu"
gosub writepop_index_valeur
valeurw$=str$(CHECKED(14))
indexw$="mar"
gosub writepop_index_valeur
valeurw$=str$(CHECKED(15))
indexw$="mer"
gosub writepop_index_valeur
valeurw$=str$(CHECKED(16))
indexw$="jeu"
gosub writepop_index_valeur
valeurw$=str$(CHECKED(17))
indexw$="ven"
gosub writepop_index_valeur
valeurw$=str$(CHECKED(18))
indexw$="sa"
gosub writepop_index_valeur
valeurw$=str$(CHECKED(19))
indexw$="di"
gosub writepop_index_valeur


gosub init
rem **************************************************
rem *                        fin                    *
rem **************************************************
return
rem **************************************************
rem *                    modifier                    *
rem **************************************************
modifier:
lignew=ITEM_INDEX(3)+1
 if ITEM_INDEX(3)=0 then return
if text$(3)="" then return
valeurw$=text$(3)
indexw$="fournisseur"
gosub writebase_index_ligne_valeur
valeurw$=text$(4)
indexw$="tel"
gosub writebase_index_ligne_valeur
valeurw$=text$(5)
indexw$="fax"
gosub writebase_index_ligne_valeur
valeurw$=text$(6)
indexw$="nbc"
gosub writebase_index_ligne_valeur
valeurw$=text$(34)
indexw$="adresse"
gosub writebase_index_ligne_valeur
valeurw$=text$(35)
indexw$="cdp"
gosub writebase_index_ligne_valeur
valeurw$=text$(36)
indexw$="ville"
gosub writebase_index_ligne_valeur
valeurw$=str$(CHECKED(21))
indexw$="lu"
gosub writebase_index_ligne_valeur
valeurw$=str$(CHECKED(14))
indexw$="mar"
gosub writebase_index_ligne_valeur
valeurw$=str$(CHECKED(15))
indexw$="mer"
gosub writebase_index_ligne_valeur
valeurw$=str$(CHECKED(16))
indexw$="jeu"
gosub writebase_index_ligne_valeur
valeurw$=str$(CHECKED(17))
indexw$="ven"
gosub writebase_index_ligne_valeur
valeurw$=str$(CHECKED(18))
indexw$="sa"
gosub writebase_index_ligne_valeur
valeurw$=str$(CHECKED(19))
indexw$="di"
gosub writebase_index_ligne_valeur

gosub init
return
rem **************************************************
rem *                        fin                    *
rem **************************************************
rem **************************************************
rem *                      effacer                  *
rem **************************************************
effacer:

 lignew=ITEM_INDEX(3)+1
 if ITEM_INDEX(3)=0 then return
  indexw$="fournisseur"
 gosub delval_index_ligne
  indexw$="tel"
  lignew=ITEM_INDEX(3)+1
 gosub delval_index_ligne
  indexw$="fax"
  lignew=ITEM_INDEX(3)+1
 gosub delval_index_ligne
 indexw$="nbc"
  lignew=ITEM_INDEX(3)+1
 gosub delval_index_ligne
 indexw$="adresse"
  lignew=ITEM_INDEX(3)+1
 gosub delval_index_ligne
 indexw$="cdp"
  lignew=ITEM_INDEX(3)+1
 gosub delval_index_ligne
 indexw$="ville"
  lignew=ITEM_INDEX(3)+1
 gosub delval_index_ligne
 indexw$="lu"
  lignew=ITEM_INDEX(3)+1
 gosub delval_index_ligne
 indexw$="mar"
  lignew=ITEM_INDEX(3)+1
 gosub delval_index_ligne
 indexw$="mer"
  lignew=ITEM_INDEX(3)+1
 gosub delval_index_ligne
 indexw$="jeu"
  lignew=ITEM_INDEX(3)+1
 gosub delval_index_ligne
 indexw$="ven"
  lignew=ITEM_INDEX(3)+1
 gosub delval_index_ligne
 indexw$="sa"
  lignew=ITEM_INDEX(3)+1
 gosub delval_index_ligne
 indexw$="di"
  lignew=ITEM_INDEX(3)+1
 gosub delval_index_ligne
 
 gosub init


 return
rem ***************************************************
rem *                        fin                      *
rem ***************************************************
rem ***************************************************
rem *                  recherche dans combos          *
rem ***************************************************
rescombo:



 lignew=ITEM_INDEX(3)+1

  indexw$="tel"
  gosub readbase_index_ligne_valeur
  text 4,valeurw$
  lignew=ITEM_INDEX(3)+1
  indexw$="fax"
  gosub readbase_index_ligne_valeur
  text 5,valeurw$
  indexw$="nbc"
  gosub readbase_index_ligne_valeur
  text 6,valeurw$
  indexw$="adresse"
  gosub readbase_index_ligne_valeur
  text 34,valeurw$
  indexw$="cdp"
  gosub readbase_index_ligne_valeur
  text 35,valeurw$
  indexw$="ville"
  gosub readbase_index_ligne_valeur
  text 36,valeurw$
  indexw$="lu"
  gosub readbase_index_ligne_valeur
  if valeurw$="1 " then  a=1:mark_on  21
  if valeurw$="0 " then a=1 : MARK_off 21
  indexw$="mar"
  gosub readbase_index_ligne_valeur
  if valeurw$="1 " then  a=1:mark_on  14
  if valeurw$="0 " then a=1 : MARK_off 14
  indexw$="mer"
  gosub readbase_index_ligne_valeur
  if valeurw$="1 " then  a=1:mark_on  15
  if valeurw$="0 " then a=1 : MARK_off 15
  indexw$="jeu"
  gosub readbase_index_ligne_valeur
  if valeurw$="1 " then  a=1:mark_on  16
  if valeurw$="0 " then a=1 : MARK_off 16
  indexw$="ven"
  gosub readbase_index_ligne_valeur
  if valeurw$="1 " then  a=1:mark_on  17
  if valeurw$="0 " then a=1 : MARK_off 17
  indexw$="sa"
  gosub readbase_index_ligne_valeur
  if valeurw$="1 " then  a=1:mark_on  18
  if valeurw$="0 " then a=1 : MARK_off 18
  indexw$="di"
  gosub readbase_index_ligne_valeur
  if valeurw$="1 " then  a=1:mark_on  19
  if valeurw$="0 " then a=1 : MARK_off 19
 
return
rem ***************************************************
rem *                        fin                      *
rem ***************************************************

rem ***************************************************
rem *            initialisation apres modif          *
rem ***************************************************
init:
clear 3
indexw$="fournisseur"
lignew=1
gosub readbase_index_ligne_valeur
pointeur=val(valeurw$)
for bo=2 to pointeur-1
  indexw$="fournisseur"
 lignew=bo
  gosub readbase_index_ligne_valeur
  ITEM_ADD 3,valeurw$
    next bo
  text 4,""
    text 5,""
    text 6,""
    text 34,""
    text 35,""
    text 36,""
    MARK_off 21
  MARK_Off 14
  MARK_Off 15
  MARK_Off 16
  MARK_Off 17
  MARK_Off 18
  MARK_Off 19
return
rem ***************************************************
rem *                        fin                      *
rem ***************************************************




rem *************************************************************************
rem *                                                                      *
rem *                    debut progamme base de donnees                    *
rem *                                                                      *
rem *************************************************************************
rem **********************************************************
rem *                        topindex                        *
rem **********************************************************
 topindex:

 for bo=1 to nbindex
  indexw$=index$(bo)
 lignew=999
 valeurw$="findebase"
 gosub writebase_index_ligne_valeur
  indexw$=index$(bo)
 lignew=1
  gosub readbase_index_ligne_valeur

if valeurw$=string$(val(valeurchain$(bo)),chr$(0)) then indexw$=index$(bo):lignew=1 :valeurw$="2" : gosub writebase_index_ligne_valeur
 next bo
 return
rem **********************************************************
rem *                        fin                            *
rem **********************************************************





rem ***********************************************************
rem *                      open_base                        *
rem ***********************************************************
open_base:
a$="" : a=0 : b$="" :r=0
for i=1 to len (base$)
if mid$(base$,i,1)="," then goto saut_1
a$=a$+mid$(base$,i,1)
next i
saut_1:
a=val(a$)
nbindex=a
a$=""
b=1
for i=1 to len(base$)
if mid$(base$,i,1)="," then b=b+1
if b=2 then a$=a$+mid$(base$,i,1)
next i
a$=mid$(a$,2,len(a$)-1)
fichier$=a$
rem ---------
b=0 :a$="":b$=""
a$=""
for i=0 to nbindex+1
for x=1 to len(base$)
 if mid$(base$,x,1)="," then b=b+1
 if b=2+r  then a$=a$+mid$(base$,x,1)  : index$(i+1)=a$
 if b=3+r  then b$=b$+mid$(base$,x,1)  : valeurchain$(i+1)=b$
 next x
 r=r+2
 b=0
a$=""
b$=""
next i
for i=1 to nbindex
index$(i)=mid$(index$(i),2,len(index$(i))-1)
valeurchain$(i)=mid$(valeurchain$(i),2,len(valeurchain$(i))-1)
next i
gosub topindex
return
rem ***********************************************************
rem *                          fin                            *
rem ***********************************************************



rem ***********************************************************
rem *                writebase_index_ligne_valeur            *
rem ***********************************************************
 writebase_index_ligne_valeur:
 debchain=0
 for i=1 to nbindex
 if indexw$=index$(i) then p=i
 next i
  if p=1 then debchain=1000+(val(valeurchain$(p))*lignew)+1
 if p>1 then for i=1 to p-1:debchain=debchain+(val(valeurchain$(i))*1000):next i:debchain=debchain+1000+1+(val(valeurchain$(p))*lignew)
 a=val(valeurchain$(p))-len(valeurw$)
 if a<=0 then goto petitsaut
valeurw$=valeurw$+string$(a," ")
 petitsaut:
 valeurw$=left$(valeurw$,val(valeurchain$(p)))
filebin_open_write 1,fichier$
filebin_position 1,debchain-1
for i=debchain to debchain+len(valeurw$)-1
blanc%(i)=asc(mid$(valeurw$,i-debchain+1,1))
filebin_block_write 1,1,blanc%(i)
next i
filebin_close 1
return
rem ***********************************************************
rem *                        fin                            *
rem ***********************************************************


rem ***********************************************************
rem *                readbase_index_ligne_valeur              *
rem ***********************************************************
readbase_index_ligne_valeur:
debchain=0
for i=1 to nbindex
if indexw$=index$(i) then p=i
next i
if p=1 then debchain=1000+(val(valeurchain$(p))*lignew)+1
if p>1 then for i=1 to p-1:debchain=debchain+(val(valeurchain$(i))*1000):next i:debchain=debchain+1000+1+(val(valeurchain$(p))*lignew)
valeurw$=""
filebin_open_read 1,fichier$
filebin_position 1,debchain-1
for i=debchain to debchain+val(valeurchain$(p))-1

filebin_block_read 1,1,blanc%(i)
valeurw$=valeurw$+chr$(blanc%(i))
next i
filebin_close 1
return
rem ***********************************************************
rem *                          fin                          *
rem ***********************************************************

rem ***********************************************************
rem *                position_p_index_ligne                  *
rem ***********************************************************
position_p_index_ligne:
lignew=1
gosub readbase_index_ligne_valeur
lignew=val(valeurw$)
return
rem ***********************************************************
rem *                          fin                          *
rem ***********************************************************

rem ***********************************************************
rem *                  writepop_index_valeur                *
rem ***********************************************************
writepop_index_valeur:
valeurtw$=valeurw$
gosub position_p_index_ligne
valeurw$=valeurtw$
gosub writebase_index_ligne_valeur
lignew=1
gosub readbase_index_ligne_valeur
pointeur=val(valeurw$)
pointeur=pointeur+1
valeurw$=str$(pointeur)
gosub writebase_index_ligne_valeur
return
rem ***********************************************************
rem *                          fin                          *
rem ***********************************************************


rem ***********************************************************
rem *                      delval_index_ligne                *
rem ***********************************************************
delval_index_ligne:
 lignewt=lignew
 gosub position_p_index_ligne
for bo=lignewt to lignew
lignew=bo+1
gosub readbase_index_ligne_valeur
lignew=bo
gosub writebase_index_ligne_valeur
next bo
lignew=1
gosub readbase_index_ligne_valeur
pointeur=val(valeurw$)
pointeur=pointeur-1
valeurw$=str$(pointeur)
gosub writebase_index_ligne_valeur

return
rem ***********************************************************
rem *                          fin                          *
rem ***********************************************************

rem ***********************************************************
rem *                search_valeur_index_nbs_vtx            *
rem ***********************************************************

search_valeur_index_nbs_vtx:

nbs=0
valeurtw$=valeurw$
gosub position_p_index_ligne

for bo=2 to lignew-1
lignew=bo
gosub readbase_index_ligne_valeur
if valeurtw$=mid$(valeurw$,1,len(valeurtw$)) then nbs=nbs+1 :vtx(nbs)=bo
next bo
return
rem ***********************************************************
rem *                          fin                          *
rem ***********************************************************

rem ***********************************************************
rem *                  variables et labels                    *
rem ***********************************************************
variable:
dim base$,nbs,vtx(1000),a$,b$,c$,aa$,a,b,c,i,x,y,fichier$,nbindex,valindex,r,blanc%(10000000),p,temp$,aa(1000)
p=1
label readbase_index_ligne_valeur
label init
dim index$(200)
dim valeurchain$(100),valeurtw$
dim debchain
label saut_1
label open_base
label writebase_index_ligne_valeur
dim indexw$
dim lignew
dim valeurw$
label petitsaut
label topindex
label ajouter
label modifier
label effacer
label rescombo
dim pointeur,lignewt
dim bo,point
label position_p_index_ligne
label writepop_index_valeur
label delval_index_ligne
label search_valeur_index_nbs_vtx
return