' BDR.bas - Base de Données Relationnelle
label valider, change_fonction
label affirmer, verifier, completer, infirmer, renommer, supprimer, informer
label creer_entite, chercher_triade1, chercher_triade2, chercher_triade3
label info_1xx, info_xrx, info_xx2
label chercher_entite
label chercher_triade_partielle_1Rx, chercher_triade_partielle_1x2
label chercher_triade_partielle_xR2
label chercher_triade_partielle_1xx, chercher_triade_partielle_xx2
label chercher_triade_partielle_xRx
label chercher_nom_par_id
label sauvegarder, restaurer
dim debug%
dim n_entite% , i%, j%, nom$, nom1$, nom2$, rel$, s$, oper%, t%, s1$, s2$
dim sr$, s3$, id%, id1%, idr%, id2%, inex%, triade$, libre%, zero$, file$
dim flag_1020%, start_1020%, cnt%, idx%, nomx$
zero$ = "0000000000"
debug% = 0
width 0,1100 : height 0,800
caption 0,"BDR V1.02 du 6/4/2011"
if debug%=0
dlist 1001 : ' entités chronologiques (id,nom)
dlist 1002 : ' entités triées (nom,id)
dlist 1011 : ' triades (A,R,B)
dlist 1012 : ' triades (R,B,A)
dlist 1013 : ' triades (B,A,R)
alpha 30 : top 30,100 : left 30,10
font_size 30,10 : font_bold 30
s$ = "Ce programme réalise une petite Base de Données Relationnelle (BDR) en mémoire."+chr$(13)+chr$(13)
s$ = s$ + "Les unités d'information sont des <entités>. Chaque entité est représenté par son nom."+chr$(13)
s$ = s$ + "Les trois zones de saisie reçoivent des noms d'entités. Celle du milieu est considérée"+chr$(13)
s$ = s$ + "comme <relation> reliant l'entité de gauche à l'entité de droite. Exemple:"+chr$(13)
s$ = s$ + " <Jack> est <auteur> de <Panoramic>"+chr$(13)
s$ = s$ + "La casse est libre mais significative pour la reconnaissance des entités."+chr$(13)+chr$(13)
s$ = s$ + "Le programme a 7 fonctions. La fonction de base est <J'affirme>. Elle requiert"+chr$(13)
s$ = s$ + "la présence des noms des 3 entités. Si une des entités n'existe pas encore, elle est"+chr$(13)
s$ = s$ + "créée automatiquement; sinon, elle est réutilisée. Une entité <objet> peut également"+chr$(13)
s$ = s$ + "être <relation>, comme dans l'exemple suivant:"+chr$(13)
s$ = s$ + " <Martin> est <père> de <Sylvain>"+chr$(13)
s$ = s$ + " <Martin> est <tuteur> de <Véronique>"+chr$(13)
s$ = s$ + " <père> est <responsable> de <enfants>"+chr$(13)
s$ = s$ + " <tuteur> est <responsable> de <enfants>"+chr$(13)
s$ = s$ + "Et on voit dans cet exemple que les relations <père> et <tuteur> sont liées par"+chr$(13)
s$ = s$ + "la relation <responsable> à l'entité objet <enfants>."+chr$(13)+chr$(13)
s$ = s$ + "La seconde fonction est <Est-ce que>. Cette fonction reqiert également la présence des"+chr$(13)
s$ = s$ + "3 entités. Mais cette fois, elles doivent exister, et leur lien relationnel est vérifié."+chr$(13)
s$ = s$ + "Le résultat est Vrai ou Faux"+chr$(13)+chr$(13)
s$ = s$ + "La troisième fonction est <Complète les champs>. Cette fois, un ou deux noms d'entités"+chr$(13)
s$ = s$ + "doivent être présents. Ces entités doivent exister, et le programme affiche dans la liste"+chr$(13)
s$ = s$ + "de droite un résultat textuel de la recherche, en affichant tous les résultats possibles."+chr$(13)+chr$(13)
s$ = s$ + "La quatrième fonction informe une relation établie. Les trois entités doivent exister."+chr$(13)
s$ = s$ + "Si la relation existe, elle est supprimée."+chr$(13)+chr$(13)
s$ = s$ + "La cinquième fonction renomme une entité. Le premier champ doit contenir le nom d'une entité"+chr$(13)
s$ = s$ + "existante, le second champ doit contenir le nouveau nom qui ne doit pas encore exister, et"+chr$(13)
s$ = s$ + "le troidième champ doit rester vide."+chr$(13)+chr$(13)
s$ = s$ + "La sixième fonction supprime une entité existante avec tous ses liens relationnels."+chr$(13)+chr$(13)
s$ = s$ + "La septième fonction retourne toutes les informations disponibles sur une entité."+chr$(13)+chr$(13)
s$ = s$ + "Les boutons <Sauvegarder> et <Restaurer> permettent d'enregistrer ou de réouvrir une BDR."
caption 30,s$
else
list 1001 : ' entités chronologiques (id,nom)
top 1001,100 : left 1001,10 : height 1001,300
list 1002 : ' entités triées (nom,id)
top 1002,100 : left 1002,150 : height 1002,300
list 1011 : ' triades (A,R,B)
top 1011,100 : left 1011,290 : height 1011,300
list 1012 : ' triades (R,B,A)
top 1012,100 : left 1012,430 : height 1012,300
list 1013 : ' triades (B,A,R)
top 1013,100 : left 1013,570 : height 1013,300
end_if
memo 1020 : ' liste de résultats
top 1020,100 : left 1020,710 : height 1020,300 : width 1020,300
bar_vertical 1020 : bar_horizontal 1020
sort_on 1002 : sort_on 1011 : sort_on 1012 : sort_on 1013
combo 10 : top 10,10 : left 10,10 : on_change 10,change_fonction
item_add 10,"J'affirme que"
item_add 10,"Est-ce que"
item_add 10,"Complète les champs"
item_add 10,"J'infirme que"
item_add 10,"Renommer"
item_add 10,"Supprimer"
item_add 10,"Que sait-on sur"
text 10,"J'affirme que"
edit 1 : top 1,40 : left 1,10
alpha 2 : top 2,40 : left 2,140 : caption 2,"est"
edit 3 : top 3,40 : left 3,180
alpha 4 : top 4,40 : left 4,310 : caption 4,"de"
edit 5 : top 5,40 : left 5,350
button 6 : top 6,40 : left 6,490 : caption 6,"Valider"
on_click 6,valider
button 7 : top 7,40 : left 7,600 : caption 7,"Sauvegarder"
on_click 7,sauvegarder
button 8 : top 8,40 : left 8,710 : caption 8,"Restaurer"
on_click 8,restaurer
save_dialog 20
open_dialog 21
filter 20,"Sauvegardes|*.bdr"
filter 21,"Sauvegardes|*.bdr"
end
change_fonction:
s$ = text$(10)
oper% = 0
for i%=1 to count(10)
if text$(10)=item_read$(10,i%) then oper% = i%
next i%
for i%=1 to 5
show i%
next i%
caption 2,"est"
if oper%=5
hide 4
hide 5
caption 2,"en"
end_if
if (oper%=6) or (oper%=7)
hide 2
hide 3
hide 4
hide 5
end_if
return
valider:
s$ = text$(10)
for i%=1 to count(10)
if text$(10)=item_read$(10,i%) then oper% = i%
next i%
if (oper%<3 ) or (oper%=4)
for i%=1 to 3
if trim$(text$(i%*2-1))=""
j% = message_error_ok("Le champ "+str$(i%)+" n'est pas renseigné.")
return
end_if
next i%
end_if
nom1$ = text$(1)
rel$ = text$(3)
nom2$ = text$(5)
select oper%
case 1: gosub affirmer
case 2: gosub verifier
case 3: gosub completer
case 4: gosub infirmer
case 5: gosub renommer
case 6: gosub supprimer
case 7: gosub informer
end_select
return
affirmer:
nom$ = nom1$
gosub creer_entite
id1% = id%
nom$ = rel$
gosub creer_entite
idr% = id%
nom$ = nom2$
gosub creer_entite
id2% = id%
gosub chercher_triade1
if inex%=1
item_add 1011,triade$
item_add 1012,str$(idr%)+","+str$(id2%)+","+str$(id1%)
item_add 1013,str$(id2%)+","+str$(id1%)+","+str$(idr%)
end_if
return
infirmer:
if count(1002)<3
j% = message_error_ok("Il n'y a pas assez d'entités.")
return
end_if
nom$ = text$(1)
gosub chercher_entite
if inex%=1
j% = message_error_ok("L'entité "+nom$+" n'existe pas.")
return
end_if
nom1$ = nom$
id1% = id%
nom$ = text$(3)
gosub chercher_entite
if inex%=1
j% = message_error_ok("L'entité "+nom$+" n'existe pas.")
return
end_if
rel$ = nom$
idr% = id%
nom$ = text$(5)
gosub chercher_entite
if inex%=1
j% = message_error_ok("L'entité "+nom$+" n'existe pas.")
return
end_if
nom2$ = nom$
id2% = id%
gosub chercher_triade1
if inex%=0
item_delete 1011,i%
gosub chercher_triade2
if inex%=0 then item_delete 1012,i%
gosub chercher_triade3
if inex%=0 then item_delete 1013,i%
j% = message_information_ok("La relation a été annulée.")
else
j% = message_information_ok(nom1$+" n'est pas "+rel$+" de "+nom2$)
end_if
return
verifier:
if count(1002)<3
j% = message_error_ok("Il n'y a pas assez d'entités.")
return
end_if
nom$ = text$(1)
gosub chercher_entite
if inex%=1
j% = message_error_ok("L'entité "+nom$+" n'existe pas.")
return
end_if
nom1$ = nom$
id1% = id%
nom$ = text$(3)
gosub chercher_entite
if inex%=1
j% = message_error_ok("L'entité "+nom$+" n'existe pas.")
return
end_if
rel$ = nom$
idr% = id%
nom$ = text$(5)
gosub chercher_entite
if inex%=1
j% = message_error_ok("L'entité "+nom$+" n'existe pas.")
return
end_if
nom2$ = nom$
id2% = id%
gosub chercher_triade1
if inex%=0
j% = message_information_ok(nom1$+" est bien "+rel$+" de "+nom2$)
else
j% = message_information_ok(nom1$+" n'est pas "+rel$+" de "+nom2$)
end_if
return
renommer:
if count(1002)<1
j% = message_error_ok("Il n'y a pas assez d'entités.")
return
end_if
nom$ = text$(3)
gosub chercher_entite
if inex%=0
j% = message_error_ok("L'entité "+nom$+" existe déjà.")
return
end_if
nom2$ = nom$
nom$ = text$(1)
gosub chercher_entite
if inex%=1
j% = message_error_ok("L'entité "+nom$+" n'existe pas.")
return
end_if
nom1$ = nom$
id1% = id%
sort_off 1002
item_delete 1002,i%
item_insert 1002,i%,nom2$+","+str$(id1%)
sort_on 1002
item_delete 1001,id1%
item_insert 1001,id1%,right$(zero$+str$(id1%),10)+","+nom2$
return
supprimer:
if count(1002)<1
j% = message_error_ok("Il n'y a pas assez d'entités.")
return
end_if
nom$ = text$(1)
gosub chercher_entite
if inex%=1
j% = message_error_ok("L'entité "+nom$+" n'existe pas.")
return
end_if
nom1$ = nom$
id1% = id%
item_delete 1002,i%
item_delete 1001,id1%
item_insert 1001,id1%,right$(zero$+str$(id1%),10)+",----------"
s1$ = str$(id1%)
for t%=1 to 3
for i%=1 to count(1010+t%)
s$ = item_read$(1010+t%,i%)
if (instr(s$,s1$+",")>0) or (instr(s$,","+s1$)>0)
item_delete 1010+t%,i%
i% = i% - 1
if i%=count(1010+t%) then exit_for
end_if
next i%
next t%
return
informer:
if count(1002)<1
j% = message_error_ok("Il n'y a pas assez d'entités.")
return
end_if
nom$ = text$(1)
gosub chercher_entite
if inex%=1
j% = message_error_ok("L'entité "+nom$+" n'existe pas.")
return
end_if
nomx$ = nom$
idx% = id%
clear 1020
flag_1020% = 0
start_1020% = count(1020)+1
id1% = idx%
nom1$ = nomx$
gosub info_1xx
start_1020% = count(1020)+1
idr% = idx%
rel$ = nomx$
gosub info_xrx
start_1020% = count(1020)+1
id2% = idx%
nom2$ = nomx$
gosub info_xx2
return
completer:
flag_1020% = 1
start_1020% = 1
nom1$ = trim$(text$(1))
rel$ = trim$(text$(3))
nom2$ = trim$(text$(5))
if nom1$=""
' [?,x,x] on cherche nom1
if rel$=""
' [?,?,x] on cherche rel
if nom2$=""
' [?,?,?] on cherche nom2
j% = message_error_ok("La recherche est trop vaste.")
return
else
' [?,?,$] on a nom2 ==> on cherche nom1 et rel pour nom2
nom$ = nom2$
gosub chercher_entite
id2% = id%
if inex%=1
j% = message_error_ok("L'entité "+nom$+" n'existe pas.")
return
end_if
gosub info_xx2
if inex%=1
j% = message_error_ok("Recherche vaine.")
return
end_if
end_if
else
' [?,$,x] on a rel
if nom2$=""
' [?,$,?] on cherche nom1 et nom2 pour rel
nom$ = rel$
gosub chercher_entite
idr% = id%
if inex%=1
j% = message_error_ok("L'entité "+nom$+" n'existe pas.")
return
end_if
gosub info_xrx
if inex%=1
j% = message_error_ok("Recherche vaine.")
return
end_if
else
' [?,$,$] on a nom2 ==> on cherche nom1 pour rel et nom2
nom$ = rel$
gosub chercher_entite
idr% = id%
if inex%=1
j% = message_error_ok("L'entité "+nom$+" n'existe pas.")
return
end_if
nom$ = nom2$
gosub chercher_entite
id2% = id%
if inex%=1
j% = message_error_ok("L'entité "+nom$+" n'existe pas.")
return
end_if
triade$ = str$(idr%)+","+str$(id2%)+","
t% = 2
gosub chercher_triade_partielle_xR2
if inex%=1
j% = message_error_ok("Recherche vaine.")
return
end_if
for i%=1 to count(1020)
id% = val(item_read$(1020,i%))
gosub chercher_nom_par_id
item_delete 1020,i%
item_insert 1020,i%,nom$
next i%
item_insert 1020,1,rel$ + " de " + nom2$ + ":"
end_if
end_if
else
' on a nom1
if rel$=""
' [$,?,x] on cherche rel et nom1
if nom2$=""
' [$,?,?] on cherche nom2 et rel pour nom1
nom$ = nom1$
gosub chercher_entite
id1% = id%
if inex%=1
j% = message_error_ok("L'entité "+nom$+" n'existe pas.")
return
end_if
gosub info_1xx
if inex%=1
j% = message_error_ok("Recherche vaine.")
return
end_if
else
' [$,?,$] on a nom2 ==> on cherche rel pour nom1 et nom2
nom$ = nom1$
gosub chercher_entite
id1% = id%
if inex%=1
j% = message_error_ok("L'entité "+nom$+" n'existe pas.")
return
end_if
nom$ = nom2$
gosub chercher_entite
id2% = id%
if inex%=1
j% = message_error_ok("L'entité "+nom$+" n'existe pas.")
return
end_if
triade$ = str$(id2%)+","+str$(id1%)+","
t% = 3
gosub chercher_triade_partielle_1x2
if inex%=1
j% = message_error_ok("Recherche vaine.")
return
end_if
for i%=1 to count(1020)
id% = val(item_read$(1020,i%))
gosub chercher_nom_par_id
item_delete 1020,i%
item_insert 1020,i%,nom$
next i%
item_insert 1020,1,nom1$ + " est pour " + nom2$ + ":"
end_if
else
' on a rel
if nom2$=""
' [$,$,?] on cherche nom2 pour nom1 et rel
nom$ = nom1$
gosub chercher_entite
id1% = id%
if inex%=1
j% = message_error_ok("L'entité "+nom$+" n'existe pas.")
return
end_if
nom$ = rel$
gosub chercher_entite
idr% = id%
if inex%=1
j% = message_error_ok("L'entité "+rel$+" n'existe pas.")
return
end_if
triade$ = str$(id1%)+","+str$(idr%)+","
t% = 1
gosub chercher_triade_partielle_1Rx
if inex%=1
j% = message_error_ok("Recherche vaine.")
return
end_if
for i%=1 to count(1020)
id% = val(item_read$(1020,i%))
gosub chercher_nom_par_id
item_delete 1020,i%
item_insert 1020,i%,nom$
next i%
item_insert 1020,1,nom1$ + " est " + rel$ + " de: "
else
' [$,$,$] on a nom2 ==> on ne cherche rien !
j% = message_error_ok("Il n'y a rien à compléter.")
return
end_if
end_if
end_if
return
info_1xx:
triade$ = str$(id1%)+","
t% = 1
gosub chercher_triade_partielle_1xx
if inex%=1 then return
for i%=start_1020% to count(1020)
s3$ = item_read$(1020,i%)
id% = val(left$(s3$,instr(s3$,",")-1))
gosub chercher_nom_par_id
sr$ = nom$ + " de "
id% = val(mid$(s3$,instr(s3$,",")+1,20))
gosub chercher_nom_par_id
sr$ = sr$ + nom$
item_delete 1020,i%
item_insert 1020,i%,sr$
next i%
item_insert 1020,start_1020%,nom1$ + " est: "
return
info_xrx:
triade$ = str$(idr%)+","
t% = 2
gosub chercher_triade_partielle_xRx
if inex%=1 then return
for i%=start_1020% to count(1020)
s3$ = item_read$(1020,i%)
id% = val(left$(s3$,instr(s3$,",")-1))
gosub chercher_nom_par_id
sr$ = " à " + nom$
id% = val(mid$(s3$,instr(s3$,",")+1,20))
gosub chercher_nom_par_id
sr$ = nom$ + sr$
item_delete 1020,i%
item_insert 1020,i%,sr$
next i%
item_insert 1020,start_1020%,rel$ + " lie:"
return
info_xx2:
triade$ = str$(id2%)+","
t% = 3
gosub chercher_triade_partielle_xx2
if inex%=1 then return
for i%=start_1020% to count(1020)
s3$ = item_read$(1020,i%)
id% = val(left$(s3$,instr(s3$,",")-1))
gosub chercher_nom_par_id
sr$ = nom$ + " est "
id% = val(mid$(s3$,instr(s3$,",")+1,20))
gosub chercher_nom_par_id
sr$ = sr$ + nom$
item_delete 1020,i%
item_insert 1020,i%,sr$
next i%
item_insert 1020,start_1020%,"Pour "+nom2$+":"
return
creer_entite:
if count(1002)>0
for i%=1 to count(1002)
s$ = item_read$(1002,i%)
if left$(s$,instr(s$,",")-1)=nom$
id% = val(mid$(s$,instr(s$,",")+1,10 ))
return
end_if
next i%
end_if
n_entite% = n_entite% + 1
id% = n_entite%
item_add 1001,right$(zero$+str$(id%),10)+","+nom$
item_add 1002,nom$+","+str$(id%)
return
chercher_entite:
if count(1002)>0
for i%=1 to count(1002)
s$ = item_read$(1002,i%)
if left$(s$,instr(s$,",")-1)=nom$
id% = val(mid$(s$,instr(s$,",")+1,10 ))
inex% = 0
return
end_if
next i%
end_if
inex% = 1
return
chercher_triade1:
triade$ = str$(id1%)+","+str$(idr%)+","+str$(id2%)
if count(1011)>0
inex% = 0
for i%=1 to count(1011)
if item_read$(1011,i%)=triade$ then return
next i%
end_if
inex% = 1
return
chercher_triade2:
triade$ = str$(idr%)+","+str$(id2%)+","+str$(id1%)
if count(1012)>0
inex% = 0
for i%=1 to count(1012)
if item_read$(1012,i%)=triade$ then return
next i%
end_if
inex% = 1
return
chercher_triade3:
triade$ = str$(id2%)+","+str$(id1%)+","+str$(idr%)
if count(1013)>0
inex% = 0
for i%=1 to count(1013)
if item_read$(1013,i%)=triade$ then return
next i%
end_if
inex% = 1
return
chercher_triade_partielle_1Rx:
inex% = 1
if flag_1020%=1 then clear 1020
j% = len(triade$)
if count(1010+t%)>0
for i%=1 to count(1010+t%)
s$ = item_read$(1010+t%,i%)
if triade$=left$(s$,j%) then item_add 1020,mid$(s$,j%+1,20)
next i%
end_if
if count(1020)>0 then inex% = 0
return
chercher_triade_partielle_1x2:
inex% = 1
if flag_1020%=1 then clear 1020
j% = len(triade$)
if count(1010+t%)>0
for i%=1 to count(1010+t%)
s$ = item_read$(1010+t%,i%)
if triade$=left$(s$,j%) then item_add 1020,mid$(s$,j%+1,20)
next i%
end_if
if count(1020)>0 then inex% = 0
return
chercher_triade_partielle_xR2:
inex% = 1
if flag_1020%=1 then clear 1020
j% = len(triade$)
if count(1010+t%)>0
for i%=1 to count(1010+t%)
s$ = item_read$(1010+t%,i%)
if triade$=left$(s$,j%) then item_add 1020,mid$(s$,j%+1,20)
next i%
end_if
if count(1020)>0 then inex% = 0
return
chercher_triade_partielle_1xx:
inex% = 1
cnt% = 0
if flag_1020%=1 then clear 1020
j% = len(triade$)
if count(1010+t%)>0
for i%=1 to count(1010+t%)
s$ = item_read$(1010+t%,i%)
if triade$=left$(s$,j%)
s$ = mid$(s$,instr(s$,",")+1,20)
item_add 1020,s$
cnt% = cnt% + 1
end_if
next i%
end_if
if cnt%>0 then inex% = 0
return
chercher_triade_partielle_xx2:
inex% = 1
cnt% = 0
if flag_1020%=1 then clear 1020
j% = len(triade$)
if count(1010+t%)>0
for i%=1 to count(1010+t%)
s$ = item_read$(1010+t%,i%)
if triade$=left$(s$,j%)
s$ = mid$(s$,instr(s$,",")+1,20)
item_add 1020,s$
cnt% = cnt% + 1
end_if
next i%
end_if
if cnt%>0 then inex% = 0
return
chercher_triade_partielle_xRx:
inex% = 1
cnt% = 0
if flag_1020%=1 then clear 1020
j% = len(triade$)
if count(1010+t%)>0
for i%=1 to count(1010+t%)
s$ = item_read$(1010+t%,i%)
if triade$=left$(s$,j%)
s$ = mid$(s$,instr(s$,",")+1,20)
item_add 1020,s$
cnt% = cnt% + 1
end_if
next i%
end_if
if cnt%>0 then inex% = 0
return
chercher_nom_par_id:
s2$ = item_read$(1001,id%)
nom$ = mid$(s2$,instr(s2$,",")+1,len(s2$))
return
sauvegarder:
file$ = file_name$(20)
file_open_write 2,file$+".bdr"
file_writeln 2,str$(n_entite%)
file_close 2
file_save 1001,file$+"_01.bdx"
file_save 1002,file$+"_02.bdx"
file_save 1011,file$+"_11.bdx"
file_save 1012,file$+"_12.bdx"
file_save 1013,file$+"_13.bdx"
return
restaurer:
file$ = file_name$(21)
if file$<>"_"
file_open_read 2,file$
file_readln 2,s$
file_close 2
n_entite% = val(s$)
file$ = left$(file$,instr(file$,".bdr")-1)
file_load 1001,file$+"_01.bdx"
file_load 1002,file$+"_02.bdx"
file_load 1011,file$+"_11.bdx"
file_load 1012,file$+"_12.bdx"
file_load 1013,file$+"_13.bdx"
end_if
return
Accueil 
Calendrier
