| Mai 2024 | | Lun | Mar | Mer | Jeu | Ven | Sam | Dim |
|---|
| | | 1 | 2 | 3 | 4 | 5 | | 6 | 7 | 8 | 9 | 10 | 11 | 12 | | 13 | 14 | 15 | 16 | 17 | 18 | 19 | | 20 | 21 | 22 | 23 | 24 | 25 | 26 | | 27 | 28 | 29 | 30 | 31 | | |  Calendrier |
|
| | | Maintenance de fichiers chaînés |  |
| | | Auteur | Message |
|---|
Klaus
Nombre de messages : 12301
Age : 75
Localisation : Ile de France
Date d'inscription : 29/12/2009
| | Sujet: Maintenance de fichiers chaînés Ven 8 Nov 2013 - 17:30 | |
| J'ai ajouté un gros morceau à KGF.dll: la gestion des fichiers chaînés ! Imaginez un fichier binaire, non lisible par un éditeur de texte. Ce fichier ets préformaté à sa création, et organisé en un enregistrement entête contenant des informations de gestion, et un certain nombre d'enregistrements de données, toutes vides au départ, et organisés en une chaîne liée par un double chaînage en amont et en aval. Maintenant, on peut créer une chaîne de données dans ce fichier. Concrètement, l'outil détachera le premier des enregistrements de la chaîne des libres et le formate en un enregistrement application, avec certaines informations de gestion et ses données application. A partir de ce moment, on peut lui attacher d'autres enregistrements, soit à la fin de la chaîne, soit au début, soit inséré en n'importe quel point de la chaîne. La chaine des enregistrements application est elle-même liée par un double chaînage amont/aval. Ceci permet à tout instant, à partir de n'importe quel enregistrement de la chaîne, de lire le suivant, le précédent, le dernier et le premier de la chaîne, et ce quelque soit l'ordre dans lequel la chaîne a été constituée ! On peut bien sûr supprimer la chaîne entière qui retourne alors à la chaîne des libres, ou supprimer spécifiquement un quelconque membre de la chaîne, sans perturber la cohérence du reste de la chaîne. Tous les liens sont réorganisés automatiquement. Et surtout, on peut créer autant de chaînes que nécessaire. Le tout est seulement limité par la taille du fichier (nombre total d'enregistrements) qui doit être spécifié à la création du fichier. Prochainement, une fonction d'extension de fichier sera également disponible. Voici le programme de maintenance: cfMaintenance.bas (cf signifie "chained file") - Code:
-
' cfMaintenance.bas
' Maintenance des fichiers chaînés
labels()
constantes()
variables()
form0()
invisibles()
visuel()
initialisations()
end
' =================================================================
' SUBs princpales
' =================================================================
sub labels()
label exit, Numerique, SelFile, Ouvrir, Supprimer
label CreerFic, Fermer, Reparer, Reorganiser
label rOption, Executer
end_sub
sub constantes()
dim KGF$ : KGF$ = "KGF.dll"
end_sub
sub variables()
dim no%, no1%, no2%, no3%, obj%, dialog%
dim eNom%, nom$
dim eLongueur%, eNombre%, eLibre%, eOccupe%
dim sLongueur$, sNombre$, sChoisi$
dim eAdresse%, eSuivant%, ePrecedent%, eID%, eSequence%
dim eDonnees%, eChoisi%
dim cflng%, cftot%, funct%, n%
end_sub
sub form0()
height 0,500 : width 0,930
caption 0,"cfMaintenance"
on_close 0,exit
end_sub
sub invisibles()
no% = no% + 1 : save_dialog no% : dialog% = no%
filter dialog%,"Fichier chaîné|*.dat"
end_sub
sub visuel()
' les deux containers
xContainer(8,8,900,145,"Fichier") : no1% = no%
xContainer(160,8,900,290,"Enregistrement") : no2% = no%
' objets pour container "Fichier"
xAlpha(32,40,no1%,10,"Nom du fichier:")
xAlpha(64,32,no1%,10,"Longueur enreg.:")
xAlpha(104,48,no1%,10,"Premier libre:")
xAlpha(64,240,no1%,10,"Nombre enreg.:")
xAlpha(104,232,no1%,10,"Nombre occupés:")
xEdit(32,136,537,no1%,0,0) : eNom% = no%
xEdit(64,136,81,no1%,1,0) : eLongueur% = no%
xEdit(64,344,81,no1%,1,0) : eNombre% = no%
xEdit(104,136,81,no1%,0,1) : eLibre% = no%
xEdit(104,344,81,no1%,0,1) : eOccupe% = no%
xButton(32,680,25,no1%,"?") : on_click no%,SelFile
xButton(32,720,73,no1%,"Ouvrir") : on_click no%,Ouvrir
xButton(32,800,81,no1%,"Supprimer") : on_click no%,Supprimer
xButton(64,432,105,no1%,"Créer nouveau") : on_click no%,CreerFic
xButton(64,544,90,no1%,"Fermer") : on_click no%,Fermer
xButton(64,720,73,no1%,"Réparer") : on_click no%,Reparer
xButton(64,800,81,no1%,"Réorganiser") : on_click no%,Reorganiser
' objets pour container "Enregistrement"
xAlpha(32,32,no2%,10,"Adresse:")
xAlpha(32,224,no2%,10,"Suivant:")
xAlpha(32,384,no2%,10,"Précédent:")
xAlpha(32,568,no2%,10,"ID:")
xAlpha(32,704,no2%,10,"Séquence:")
xAlpha(72,32,no2%,10,"Donnees:")
xAlpha(96,96,no2%,10,"....;....1....;....2....;....3....;....4....;....5....;....6....;....7....;....8....;....9....;..")
font_name no%,"Courier"
xAlpha(144,568,no2%,10,"Adresse:")
xEdit(32,96,81,no2%,0,1) : eAdresse% = no%
xEdit(32,280,81,no2%,0,1) : eSuivant% = no%
xEdit(32,456,81,no2%,0,1) : ePrecedent% = no%
xEdit(32,592,81,no2%,0,1) : eID% = no%
xEdit(32,776,81,no2%,0,1) : eSequence% = no%
xEdit(72,96,769,no2%,0,0) : eDonnees% = no%
xEdit(144,632,81,no2%,1,0) : eChoisi% = no%
xContainer_Option(120,24,521,153,no2%,"Fonctions à exécuter") : no3% = no%
xOption(20,10,161,no3%,"Nouvelle chaîne") : on_click no%,rOption
xOption(48,10,161,no3%,"Supprimer chaîne") : on_click no%,rOption
xOption(20,170,161,no3%,"Lire par adresse") : on_click no%,rOption
xOption(48,170,161,no3%,"Lire suivant") : on_click no%,rOption
xOption(72,170,161,no3%,"Lire précédent") : on_click no%,rOption
xOption(96,170,161,no3%,"Lire premier") : on_click no%,rOption
xOption(120,170,161,no3%,"Lire dernier") : on_click no%,rOption
xOption(20,304,161,no3%,"Ajouter en fin de chaîne") : on_click no%,rOption
xOption(48,304,161,no3%,"Ajouter en début de chaîne") : on_click no%,rOption
xOption(72,304,161,no3%,"Insérer après enregistrement") : on_click no%,rOption
xOption(94,304,161,no3%,"Supprimer enregistrement") : on_click no%,rOption
xOption(120,304,161,no3%,"Remplacer données") : on_click no%,rOption
xButton(184,632,81,no2%,"Exécuter") : on_click no%,Executer
end_sub
sub initialisations()
KGF_initialize(KGF$)
end_sub
' =================================================================
' SUBs auxiliaires
' =================================================================
sub xContainer(t%,l%,w%,h%,c$)
no% = no% + 1 : container no%
top no%,t% : left no%,l% : width no%,w% : height no%,h%
caption no%,c$
end_sub
sub xContainer_Option(t%,l%,w%,h%,p%,c$)
no% = no% + 1 : container_option no%
top no%,t% : left no%,l% : width no%,w% : height no%,h%
caption no%,c$
if p%>0 then parent no%,p%
end_sub
sub xAlpha(t%,l%,p%,s%,c$)
no% = no% + 1 : alpha no% : font_size no%,s%
if p%>0 then parent no%,p%
top no%,t% : left no%,l% : caption no%,c$
end_sub
sub xEdit(t%,l%,w%,p%,n%,a%)
no% = no% + 1 : edit no%
top no%,t% : left no%,l% : width no%,w%
if p%>0 then parent no%,p%
if n%>0 then on_change no%,Numerique
if a%=1 then inactive no%
end_sub
sub xButton(t%,l%,w%,p%,c$)
no% = no% + 1 : button no%
top no%,t% : left no%,l% : width no%,w%
if p%>0 then parent no%,p%
caption no%,c$
end_sub
sub xoption(t%,l%,w%,p%,c$)
no% = no% + 1 : option no%
top no%,t% : left no%,l% : width no%,w%
if p%>0 then parent no%,p%
caption no%,c$
end_sub
sub ResetOptions()
text eChoisi%,""
end_sub
sub AfficherRecord()
cfInfoFile("cfAct")
text eAdresse%,Str$(cfInfoFile%)
cfInfoFile("cfNxt")
text eSuivant%,Str$(cfInfoFile%)
cfInfoFile("cfPrv")
text ePrecedent%,Str$(cfInfoFile%)
cfInfoFile("cfID")
text eID%,Str$(cfInfoFile%)
cfInfoFile("cfSeq")
text eSequence%,Str$(cfInfoFile%)
cfInfoFile("cfDTA")
text eDonnees%,cfInfoFile$
end_sub
' =================================================================
' routines évènement
' =================================================================
exit:
cfCloseFile()
dll_off
return
Numerique:
obj% = number_change
if obj%=eLongueur%
if numeric(text$(eLongueur%))=1
sLongueur$ = text$(eLongueur%)
else
if text$(eLongueur%)<>"" then text eLongueur%,sLongueur$
end_if
end_if
if obj%=eNombre%
if numeric(text$(eNombre%))=1
sNombre$ = text$(eNombre%)
else
if text$(eNombre%)<>"" then text eNombre%,sNombre$
end_if
end_if
if obj%=eChoisi%
if numeric(text$(eChoisi%))=1
sChoisi$ = text$(eChoisi%)
else
if text$(eChoisi%)<>"" then text eChoisi%,sChoisi$
end_if
end_if
return
SelFile:
nom$ = file_name$(dialog%)
if nom$="_"
text eNom%,""
else
if lower$(right$(nom$,4))<>".dat" then nom$ = nom$ + ".dat"
text eNom%,nom$
end_if
return
Ouvrir:
nom$ = trim$(text$(eNom%))
if nom$=""
message "Le nom du fichier manque."
return
end_if
cfOpenFile(nom$)
if cfOpenFile%<0
if cfOpenFile%=-1
message "Un fichier est déjà ouvert."
return
end_if
if cfOpenFile%=-2
message "Le fichier n''existe pas."
return
end_if
end_if
cfInfoFile("cfLng")
text eLongueur%, Str$(cfInfoFile%)
cfInfoFile("cfTot")
text eNombre%, Str$(cfInfoFile%)
cfInfoFile("cfFre")
text eLibre%, Str$(cfInfoFile%)
cfInfoFile("cfOcc")
text eOccupe%, Str$(cfInfoFile%)
return
Supprimer:
cfInfoFile("cfOpn")
if cfInfoFile%=0
message "Un fichier est encore ouvert."
return
end_if
nom$ = trim$(text$(eNom%))
if nom$=""
message "Le nom de fichier manque."
return
end_if
if File_Exists(nom$)=1 then File_delete nom$
text eNom%,""
text eLongueur%, ""
text eNombre%, ""
text eLibre%, ""
text eOccupe%, ""
return
CreerFic:
if trim$(text$(eLongueur%))=""
message "La longueur d'enregistrement manque."
return
end_if
if trim$(text$(eNombre%))=""
message "Le nombre d'enregistrements manque."
return
end_if
cflng% = val(text$(eLongueur%))
cftot% = val(text$(eNombre%))
nom$ = text$(eNom%)
' effectuer la création
cfCreateFile(cflng%,cftot%,nom$)
' traitement des erreurs
if cfCreateFile%<0
if cfCreateFile%=-1
message "La longueur d'enregistrement est invalide (<40)."
return
end_if
if cfCreateFile%=-2
message "Le nombre d'enregistrements est invalide (<2)."
return
end_if
if cfCreateFile%=-3
message "Ce fichier existe déjà."
return
end_if
if cfCreateFile%=-4
message "Le nom du fichier manque."
return
end_if
end_if
' mise à jour de l'affichage
text enom%,nom$
cfFileInfo("cfFre")
' message "fre="+str$(cffileinfo%)
text eLibre%,Str$(cfFileInfo%)
cfFileInfo("cfOcc")
text eOccupe%.Str$(cfFileInfo%)
return
Fermer:
cfCloseFile()
if cfCloseFile%<0 then message "Aucun fichier n'est ouvert."
text eLongueur%, ""
text eNombre%, ""
text eLibre%, ""
text eOccupe%, ""
return
Reparer:
message "Fonction pas encore implémentée."
return
Reorganiser:
message "Fonction pas encore implémentée."
return
rOption:
ResetOptions()
funct% = number_click - no3%
return
Executer:
cfInfoFile("cfOpn")
if cfInfoFile%=-2
message "Aucun fichier n'est ouvert."
return
end_if
if Funct%=0
message "Aucune fonction n'est choisie."
return
end_if
cfReadHeader()
cfInfoFile("cfSta")
if cfInfoFile%<>0
message "Une action est en cours."
return
end_if
select funct%
case 1: ' nouvelle chaîne
cfNewChain(trim$(text$(eDonnees%)))
if cfNewChain%<0
if cfNewChain%=-1
message "Une action est en cours."
return
end_if
if cfNewChain%=-2
message "Le fichier est plein."
return
end_if
end_if
cfInfoFile("cfOcc")
text eOccupe%,Str$(cfInfoFile%)
cfInfoFile("cfFre")
text eLibre%,Str$(cfInfoFile%)
AfficherRecord()
case 2: ' supprimer chaîne
if Trim$(text$(eChoisi%))=""
message "L'adresse manque."
return
end_if
n% = val(text$(eChoisi%))
cfDeleteChain(n%)
if cfDeleteChain%=1
message "Impossible de supprimer la chaîne des libres.'"
return
end_if
if cfDeleteChain%<0
if cfDeleteChain%=-1
message "L'adresse choisie est invalide."
return
end_if
if cfDeleteChain%=-2
message "Une action est en cours."
return
end_if
end_if
cfInfoFile("cfOcc")
text eOccupe%,Str$(cfInfoFile%)
cfInfoFile("cfFre")
text eLibre%,Str$(cfInfoFile%)
case 3: ' lire par adresse
if Trim$(text$(eChoisi%))=""
message "L'adresse manque."
return
end_if
n% = val(text$(eChoisi%))
cfReadByAddress(n%)
if cfReadByAddress%<0
if cfReadByAddress%=-1
message "L'adresse choisie est invalide."
return
end_if
end_if
AfficherRecord()
case 4: ' lire suivant
if Trim$(text$(eChoisi%))=""
message "L'adresse manque."
return
end_if
n% = val(text$(eChoisi%))
cfReadNext(n%) : ' res=1 ==> on est dans la chaîne des libres
if cfReadNext%<0
if cfReadNext%=-1
message "L'adresse choisie est invalide."
return
end_if
if cfReadNext%=-2
message "L'adresse choisie est la fin de chaîne."
return
end_if
end_if
AfficherRecord()
case 5: ' lire précédent
if Trim$(text$(eChoisi%))=""
message "L'adresse manque."
return
end_if
n% = val(text$(eChoisi%))
cfReadPrevious(n%) : ' res=1 ==> on est dans la chaîne des libres
if cfReadPrevious%<0
if cfReadPrevious%=-1
message "L'adresse choisie est invalide."
return
end_if
if cfReadPrevious%=-2
message "L'adresse choisie est le début de chaîne."
return
end_if
end_if
AfficherRecord()
case 6: ' lire premier
if Trim$(text$(eChoisi%))=""
message "L'adresse manque."
return
end_if
n% = val(text$(eChoisi%))
cfReadFirst(n%) : ' // res=1 ==> on est dans la chaîne des libres
if cfReadFirst%<0
if cfReadFirst%=-1
message "L'adresse choisie est invalide."
return
end_if
end_if
AfficherRecord()
case 7: ' lire dernier
if Trim$(text$(eChoisi%))=""
message "L'adresse manque."
return
end_if
n% = val(text$(eChoisi%))
cfReadLast(n%) : ' res=1 ==> on est dans la chaîne des libres
if cfReadLast%<0
if cfReadLast%=-1
message "L'adresse choisie est invalide."
return
end_if
end_if
AfficherRecord()
case 8: ' ajouter en fin de chaîne
if Trim$(text$(eChoisi%))=""
message "L'adresse manque."
return
end_if
n% = val(text$(eChoisi%))
cfAppendToChain(n%,trim$(text$(eDonnees%)))
if cfAppendToChain%<0
if cfAppendToChain%=-1
showmessage('Une action est en cours.');
return
end_if
if cfAppendToChain%=-2
showmessage('L''adresse choisie est invalide.');
return
end_if
if cfAppendToChain%=-3
showmessage('Le fichier est plein.');
return
end_if
if cfAppendToChain%=-4
showmessage('Ajout interdit sur la chaîne des libres.');
return
end_if
end_if
AfficherRecord()
cfInfoFile("cfOcc")
text eOccupe%,Str$(cfInfoFile%)
cfInfoFile("cfFre")
text eLibre%,Str$(cfInfoFile%)
case 9: ' ajouter en début de chaîne
if Trim$(text$(eChoisi%))=""
message "L'adresse manque."
return
end_if
n% = val(text$(eChoisi%))
cfInsertTopChain(n%,trim$(text$(eDonnees%)))
if cfInsertTopChain%<0
if cfInsertTopChain%=-1
message "Une action est en cours."
return
end_if
if cfInsertTopChain%=-2
message "L'adresse choisie est invalide."
return
end_if
if cfInsertTopChain%=-3
message "Le fichier est plein."
return
end_if
if cfInsertTopChain%=-4
message "Ajout interdit sur la chaîne des libres."
return
end_if
end_if
AfficherRecord()
cfInfoFile("cfOcc")
text eOccupe%,Str$(cfInfoFile%)
cfInfoFile("cfFre")
text eLibre%,Str$(cfInfoFile%)
case 10: ' insérer après après enregistrement
if Trim$(text$(eChoisi%))=""
message "L'adresse manque."
return
end_if
n% = val(text$(eChoisi%))
cfInsertIntoChain(n%,trim$(text$(eDonnees%)))
if cfInsertIntoChain%<0
if cfInsertIntoChain%=-1
message "Une action est en cours."
return;
end_if
if cfInsertIntoChain%=-2
message "L'adresse choisie est invalide."
return
end_if
if cfInsertIntoChain%=-3
message "Le fichier est plein."
return
end_if
if cfInsertIntoChain%=-4
message "Ajout interdit sur la chaîne des libres";
return
end_if
end_if
AfficherRecord()
cfInfoFile("cfOcc")
text eOccupe%,Str$(cfInfoFile%)
cfInfoFile("cfFre")
text eLibre%,Str$(cfInfoFile%)
case 11: ' supprimer enregistrement
if Trim$(text$(eChoisi%))=""
message "L'adresse manque."
return
end_if
n% = val(text$(eChoisi%))
cfRemoveFromChain(n%)
if cfRemoveFromChain%<0
if cfRemoveFromChain%=-1
message "Une action est en cours."
return
end_if
if cfRemoveFromChain%=-2
message "L'adresse choisie est invalide."
return
end_if
if cfRemoveFromChain%=-4
message "Ajout interdit sur la chaîne des libres."
return
end_if
end_if
cfInfoFile("cfOcc")
text eOccupe%,Str$(cfInfoFile%)
cfInfoFile("cfFre")
text eLibre%,Str$(cfInfoFile%)
case 12: ' remplacer les données
if Trim$(text$(eChoisi%))=""
message "L'adresse manque."
return
end_if
n% = val(text$(eChoisi%))
cfReplaceData(n%,trim$(text$(eDonnees%)))
if cfReplaceData%<0
if cfReplaceData%=-1
message "Une action est en cours."
return
end_if
if cfReplaceData%=-2
message "L'adresse choisie est invalide."
return
end_if
if cfReplaceData%=-4
message "Ecriture interdite sur la chaîne des libres."
return
end_if
end_if
end_select
ResetOptions()
return
#INCLUDE "KGF_SUB.bas"
La version de KGF.dll pour cela est la V2.47 du 07/11/2013. WebDav et site funpic sont à jour, ainsi que la distribution des sources dur le WebDav. EDIT Voilà deux suggestions d'application pour ces fichiers. En réalité, les applications sont infinies. J'avais, en son temps, bâti une comptabilité générale, analytique, prévisionnelle et budgétaire ainsi qu'un logiciel de paye intégré, entièrement basé sur ces fichiers. Traitement ultra-rapide garanti ! 1ère suggestion d'utilisation:Enoncé:Dans un fichier, on prévoit de créer 5 chaînes d'enregistrements, le nombre de chaînes de variera pas, pas le nombre d'enregistrements dans chaque chaîne reste variable. Solution:On crée le fichier, puis directement les 5 chaînes à la suite. Ainsi, on sait que le fichier contient la structure suivante: 0: entête 1: début chaîne 1 2: début chaîne 2 3: début chaîne 3 4: début chaîne 4 5: début chaîne 5 Ensuite, on attache des enregistrements à n'importe laquelle de ces chênes, soit à la fin, soit en insertion au milieu, mais jamais au début. Et on peut supprimer n'importe quel enregistrement, sauf le premier de chaque chaîne. On considère ainsi le premier enregistrement de chaque chaîne comme une entête de chaîne, et on est certain de toujours le trouver à la même place, soit un des enregistrements entgre 1 et 5. Et une telle chaîne est considérée "vide" si son entête (premier enregistrement) n'a pas de suivant. 2ème suggestion:Enoncé:On veut créer un nombre variable de chaînes, et les chaînes peuvent également disparaître complètement. Mais, on veut retrouver facilement le début de chaque chaîne. Solution:On crée un fichier, ainsi qu'une seule chaîne qui, elle, ne doit jamais être supprimée. On obtient ainsi la structure suivante: 0: entête 1: début chaîne fixe Cette chaîne fixe nous servira à identifier les chaînes créées et supprimées dynamiquement. Après la création de chaque nouvelle chaîne, on ajoute un enregistrement à la chaîne fixe contant une identification quelconque de la chaîne nouvellement créée (un libelle, un code, ...), ainsi que le numéro d'enregistrement de l'enregistrement représentant le début de la chaîne nouvellement créée. En parcourant cette chaîne fixe, il est alors facile de retrouver le début d'une chaîne recherchée, et d'obtenir l'adresse de son premier enregistrement. Lors de la suppression définitive de la chaîne application, il suffit d'enlever l'enregistrement correspondant dans la chaîne fixe.
Conclusion:L'intérêt principal de ces fichiers, c'est d'une part la rapidité d'accès, et d'autre part, la gestion sans déchet de la granulosité du fichier. Je m'explique: il n'y a aucune place perdue. Chaque enregistrement supprimé est rendu à la chaîne des libres, d'où il sera directement utilisable pour la création d'un nouvel enregistrement. Tout se passe par l'adaptation des pointeurs - aucune donnée n'est déplacée, et il n'y a pas besoin d'une phase de défragmentation. | |
| | | | JL35
Nombre de messages : 7095
Localisation : 77
Date d'inscription : 29/11/2007
| | Sujet: Re: Maintenance de fichiers chaînés Ven 8 Nov 2013 - 19:42 | |
| Là c'est du lourd et du pro, pas très évident à assimiler, à étudier de plus près ! | |
| | | | Klaus
Nombre de messages : 12301
Age : 75
Localisation : Ile de France
Date d'inscription : 29/12/2009
| | Sujet: Re: Maintenance de fichiers chaînés Sam 9 Nov 2013 - 13:26 | |
| Voici une petite maquette pour montrer comment on peut se servir de ces fonctions. On imagine une gestion de clients et fournisseurs. Dans un même fichier, on gère les deux ensembles. On peut avoir un client Dupont et un fournisseur Dupont - ils seront différents. Dans la base (un fichier chaîné), on construit 2 chaînes: l'une pour les clients, l'autre pour les fournisseurs. Pour optimiser l'accès, on attache 26 enregistrements à la racine de la chaine des clients qui contient donc 27 enregistrements: le premier pour la racine, les autres pour chaque lettre de l'alphabet. On fait de même pour les fournisseurs. Mais, on prend soi de créer les deux chaînes directement, avant de leur attacher les 26 enregistrements. Ceci permet d'avoir avec certitude l'adresse 1 pour la chaîne des clients, et l'adresse 2 pour les fournisseurs. On appelle cela la "racine" - le point d'entrée à adresse connue. Le programme gère un seul champ: le nom du client ou fournisseur. Une combo donne le type (client ou fournisseur). Le programme a 3 fonctions: création, recherche et suppression. La fonction de recherche est utilisée par les 2 autres fonctions, pour éviter la création de doublons ou de supprimer un enregistrement inexistant. Voilà le code, bien documenté: - Code:
-
' test_base.bas
' fichier chaîné base.dat avec 2 chaînes permanentes:
' 1 = clients
' 2 = fournisseurs
' Chaque chaîne pointe vers une chaine
' dont chacune pointe vers une chaîne fixe
' correspondant à la première lettre du nom.
' Ces chaînes à leur tout pointent vers une
' chaîne rassemblant tous ceux dont le nom
' commence par la même lettre.
' format des donnés des enregistrements:
' enfant libellé
' enfant: adresse en format D6 du niveau inférieur
' pour cet enregistrement.
labels()
constantes()
variables()
form0()
nonvisuels()
visuels()
initialisations()
end
sub labels()
label exit, creer, chercher, effacer
end_sub
sub constantes()
dim kgf$ :kgf$ = "KGF.dll"
dim base$ : base$ = "base.dat"
dim zero$ : zero$ = "000000"
end_sub
sub variables()
dim dll%, data$, i%, d6$, no%, no_type%, no_nom%
dim nom$, adr%, adr1%, adr2%, lettre$, s$
end_sub
sub form0()
width 0,700
on_close 0,exit
end_sub
sub nonvisuels()
end_sub
sub visuels()
xAlpha(10,10,0,10,"Nom de la personne:")
xEdit(10,150,300,0,0,0) : no_nom% = no%
xCombo(10,470,0) : no_type% = no%
xButton(40,150,90,0,"Créer") : on_click no%,creer
xButton(40,250,90,0,"Chercher") : on_click no%,chercher
xButton(40,350,90,0,"Effacer") : on_click no%,effacer
end_sub
sub initialisations()
item_add no_type%,"Client"
item_add no_type%,"Fournisseur"
text no_type%,item_read$(no_type%,1)
KGF_initialize(kgf$)
dll% = 1
if file_exists(base$)=0
' créer le fichier vide
cfCreateFile(128,200,base$)
' créer la chaine fixe clients
data$ = zero$ + "* Clients *"
cfNewChain(data$)
' créer la chaine fixe fournisseurs
data$ = zero$ + "* Fournisseurs *"
cfNewChain(data$) : ' enregistrement servant de racine
' créer la chaîne des 26 lettres pour clients et fournisseurs
for i%=1 to 26
data$ = zero$ + chr$(64+i%) : ' clients i%
cfAppendToChain(1,data$) : ' ajouter à la chaine des clients
cfAppendToChain(2,data$) : ' et à celle des clients
next i%
else
' ouvrir une base existante
cfOpenFile(base$)
end_if
end_sub
' Cette procédure produit une variable d6$.
' Elle contient la représentation d'un entier en format D6.
sub d6(n%)
d6$ = right$(zero$+str$(n%),6)
end_sub
' procédure qui recherche un nom dans la base.
' Au retour, les variables suivantes sont chargées:
' adr% 0 si inexistant, adresse de l'enregistrement si existant
' adr1% adresse de base de la chaîne des lettres (client ou fournisseur)
' adr2% adresse de base pour tous les éléments d'une même lettre
sub chercher(nom$)
dim_local d%, s$
adr1% = 0
lettre$ = left$(nom$,1) : ' récupérer la première lettre
for i%=1 to 26 : ' recherche de l'enregistrement pour cette lettre
cfReadNext(adr%) : ' le premier enregistrement est la racine !...
cfInfoFile("cfAct") : ' récupérer l'adresse de l'enregistrement lu
adr% = cfInfoFile%
cfInfoFile("cfDta") : ' et récupérer ses données
if instr(cfInfoFile$,lettre$)=7 : ' est-ce bien l'enregistrement pour la lettre ?
adr1% = adr% : ' adr1% = adresse de la base pour la première lettre
adr% = val(left$(cfInfoFile$,6)) : ' extraire le pointer vers la chaine des noms de cette lettre
if adr%=0 then exit_sub : ' la chaîne est encore vide ? donc, rien trouve !
adr2% = adr% : ' adr2 := début de la chaîne pour la première lettre
cfInfoFile% = adr2%
while cfInfoFile%>0 : ' boucle sur la chaîne de la lettre
cfReadNext(cfInfoFile%) : ' le premier enregistrement est la racine !
if cfReadNext%<0 then exit_while : ' c'était le dernier ? alors on n'a rien trouvé !
cfInfoFile("cfDta") : ' extraire les données
s$ = cfInfoFile$
cfInfoFile("cfAct") : ' et l'adresse
adr% = cfInfoFile%
if instr(s$,nom$+" ")=7 : ' est-ce le nom exact ?
' éventuellement, d'autres traitements sur l'enregistrement trouvé...
exit_sub : ' si oui, on a trouvé, et adr% = son adresse
end_if
end_while : ' fin de boucle pour la lettre
adr% = 0 : ' nom non trouvé
exit_sub
end_if
next i% : ' fin de boucle sur la chaîne des lettres
adr% = 0 : ' on ne devrait jamais arriver ici !
end_sub
exit:
' ici, on s'assure que le fichier est fermé et la DLL déchargée, à la sortie
if dll%=1
cfCloseFile()
dll_off
end_if
return
' création d'un nouveau nom
creer:
nom$ = upper$(trim$(text$(no_nom%)))
if nom$=""
message "Le nom manque."
return
end_if
adr% = 0
if text$(no_type%)=item_read$(no_type%,1) then adr% = 1
if text$(no_type%)=item_read$(no_type%,2) then adr% = 2
if adr%=0
message "La nature de la personne est inconnue."
return
end_if
chercher(nom$)
if adr%<>0
message "Ce "+lower$(text$(no_type%))+" existe déjà."
return
end_if
if adr2%=0 : ' il n'y a pas encore de chaîne pour cette lettre
data$ = zero$ + "* "+lettre$ + " *" : ' préparer l'enregistrement racine pour cette lettre
cfNewChain(data$) : ' créer la chaîne (avec l'enregistrement racine)
cfInfoFile("cfAct") : ' récupérer son adresse
adr2% = cfInfoFile% : ' adresse du début de la chaîne pour cette lettre
cfReadByAddress(adr1%) : ' relire la base pour cette lettre
cfInfoFile("cfDta") : ' récupérer les données
d6(adr2%) : ' formater l'adresse en D6
data$ = d6$ + mid$(cfInfoFile$,7,len(cfInfoFile$)) : ' préparer les nouvelles données
cfReplaceData(adr1%,data$) : ' mise à jour des données
end_if
data$ = zero$ + nom$ : ' préparer les données pour le nouveau nom
cfAppendToChain(adr2%,data$) : ' créer le nouvel enregistrement en l'attachant à la fin de la chaîne pour la lettre
message "Ce "+lower$(text$(no_type%))+" a été créé."
return
chercher:
nom$ = upper$(trim$(text$(no_nom%)))
if nom$=""
message "Le nom manque."
return
end_if
adr% = 0
if text$(no_type%)=item_read$(no_type%,1) then adr% = 1
if text$(no_type%)=item_read$(no_type%,2) then adr% = 2
if adr%=0
message "La nature de la personne est inconnue."
return
end_if
chercher(nom$)
if adr%=0
message "Ce "+lower$(text$(no_type%))+" est inconnu."
return
end_if
message "Ce "+lower$(text$(no_type%))+" existe."
return
effacer:
nom$ = upper$(trim$(text$(no_nom%)))
if nom$=""
message "Le nom manque."
return
end_if
adr% = 0
if text$(no_type%)=item_read$(no_type%,1) then adr% = 1
if text$(no_type%)=item_read$(no_type%,2) then adr% = 2
if adr%=0
message "La nature de la personne est inconnue."
return
end_if
chercher(nom$)
if adr%=0
message "Ce "+lower$(text$(no_type%))+" est inconnu."
return
end_if
s$ = "Voulez-vous vraiment effacer le "+lower$(text$(no_type%))+" "+nom$+" ?"
if message_confirmation_yes_no(s$)=1
cfRemoveFromChain(adr%) : ' enlever simplement l'enregistrement pour ce nom
message "Le "+lower$(text$(no_type%))+" "+nom$+" a été effacé."
end_if
return
#INCLUDE "KGF_OBJ.bas"
#INCLUDE "KGF_SUB.bas"
Ce programme a besoin d'un module INCLUDE: KGF_OBJ.bas. Il est maintenant sur mon WebDav, dossier DLLs, sous-dossier KGF_SUB. Pour la facilité immédiate, je le publie ici: - Code:
-
' KGF_OBJ.bas
' Ce fichier implémente la création normalisée d'objets visuels.
' Il n'y a rien d'autre à insérer dans le programme.
' ############# ici, le #INCLUDE KGF_OBJ.bas contenant tout ce qui suit #########
' ===============================================================================
' interface de procédures autour de KGF.dll
' Auteur: Klaus
'
' Objets géré:
' alpha edit button combo container container_option
' memo list check image scene2d scene3d
' =============== dipatching des fonctions ====================================
message "KGF: on ne peut pas executer ce module directement !"
terminate
' paramètres: (top,left,width,height,caption)
sub xContainer(t%,l%,w%,h%,c$)
if variable("no%")=0 then dim no%
no% = no% + 1 : container no%
top no%,t% : left no%,l% : width no%,w% : height no%,h%
caption no%,c$
end_sub
' paramètres: (top,left,width,height,parent,caption)
sub xContainer_Option(t%,l%,w%,h%,p%,c$)
if variable("no%")=0 then dim no%
no% = no% + 1 : container_option no%
top no%,t% : left no%,l% : width no%,w% : height no%,h%
caption no%,c$
if p%>0 then parent no%,p%
end_sub
' paramètres: (top,left,parent,font_size,caption)
sub xAlpha(t%,l%,p%,s%,c$)
if variable("no%")=0 then dim no%
no% = no% + 1 : alpha no% : font_size no%,s%
if p%>0 then parent no%,p%
top no%,t% : left no%,l% : caption no%,c$
end_sub
' paramètres: (top,left,width,parent,inactive)
sub xEdit(t%,l%,w%,p%,n%,a%)
if variable("no%")=0 then dim no%
no% = no% + 1 : edit no%
top no%,t% : left no%,l% : width no%,w%
if p%>0 then parent no%,p%
if n%>0 then on_change no%,Numerique
if a%=1 then inactive no%
end_sub
' paramètres: (top,left,width,parent,caption)
sub xButton(t%,l%,w%,p%,c$)
if variable("no%")=0 then dim no%
no% = no% + 1 : button no%
top no%,t% : left no%,l% : width no%,w%
if p%>0 then parent no%,p%
caption no%,c$
end_sub
' paramètres: (top,left,width,parent,caption)
sub xOption(t%,l%,w%,p%,c$)
if variable("no%")=0 then dim no%
no% = no% + 1 : option no%
top no%,t% : left no%,l% : width no%,w%
if p%>0 then parent no%,p%
caption no%,c$
end_sub
' paramètres: (top,left,parent)
sub xCombo(t%,l%,p%)
if variable("no%")=0 then dim no%
no% = no% + 1 : combo no%
top no%,t% : left no%,l%
if p%>0 then parent no%,p%
end_sub
' paramètres: (top,left,width,height,parent,bar_horizontal,bar_vertical)
sub xMemo(t%,l%,w%,h%,p%,bh%,bv%)
if variable("no%")=0 then dim no%
no% = no% + 1 : memo no%
top no%,t% : left no%,l% : width no%,w% : height no%,h%
if p%>0 then parent no%,p%
if bh%>0 then bar_horizontal no%
if bv%>0 then bar_vertical no%
end_sub
' paramètres: (top,left,width,height,parent)
sub xList(t%,l%,w%,h%,p%)
if variable("no%")=0 then dim no%
no% = no% + 1 : list no%
top no%,t% : left no%,l% : width no%,w% : height no%,h%
if p%>0 then parent no%,p%
end_sub
' paramètres: (top,left,width,parent,caption)
sub xCheck(t%,l%,w%,p%,c$)
if variable("no%")=0 then dim no%
no% = no% + 1 : option no%
top no%,t% : left no%,l% : width no%,w%
if p%>0 then parent no%,p%
caption no%,c$
end_sub
sub xPicture(t%,l%,w%,h%,p%)
if variable("no%")=0 then dim no%
no% = no% + 1 : picture no%
top no%,t% : left no%,l% : width no%,w%
if p%>0 then parent no%,p%
end_sub
sub xScene2d(t%,l%,w%,h%,p%)
if variable("no%")=0 then dim no%
no% = no% + 1 : picture no%
top no%,t% : left no%,l% : width no%,w%
if p%>0 then parent no%,p%
end_sub
sub xScene3d(t%,l%,w%,h%,p%)
if variable("no%")=0 then dim no%
no% = no% + 1 : picture no%
top no%,t% : left no%,l% : width no%,w%
if p%>0 then parent no%,p%
end_sub
Ce module contient quelques procédures pour créer des objets vsuels. Rien de bien particulier, en Panoramic pur. Maintenant, vous me direz: quel intérêt de gérer une liste de noms, même séparée en clients et fournisseurs ? Eh bien, plusieurs remarques: 1. dans cet exemple, les données application contiennent un pointeur en D6 et une chaîne de caractères contenant le nom. C'est tout. Mais, à l'évidence, il est facile d'étendre cela et mettre plein d'autres zones propres à chaque client ou fournisseur (adresse, téléphone, total encours, ...). On peut aussi y placer un autre pointeur en D6 qui indiquerait l'adresse de la racine d'une chaîne dont chaque enregistrement suivant est une facture de ce client ou fournisseur. Vous commencez à voir à quoi cela peut mener ? 2. Rien n'impose l'utilisation de clients ou fournisseurs. On peut gérer sa collection de timbres, organisée par pays, motifs ou tout autre critère. On peut gérer ses recettes de cuisine, des fiches pour la collection de papillons, la cave à vins, ... 3. Rien n'impose de se limiter à 2 racines de chaînes initiales, comme ici. On peut évidemment en créer autant qu'on veut, ayant ainsi des points d'entrée fixes pour toutes ces chaînes qui peuvent ensuite s'allonger ou raccourcir sans pour autant changer leur point d'entrée. Pratique. 4. On peut même imaginer de faire une seule chaîne initiale à point d'entrée fixe (ce sera l'adresse 1 forcément), et les données decchaque enregistrement de cette chaîne donnent l'adresse de la racine d'une autre chaîne, ainsi qu'un texte décrivant la chaîne... 5. un dernier point sur l'exemple avec clients et fournisseurs: il est facile de modifier la procédure sub chercher(nom$) de sorte que la recherche dans la chaîne des noms pour une lettre donnée s'arrête, soit à la fin de la chaîne, soit lorsque le nom trouvé dans l'enregistrement analysé commence à être supérieur au nom proposé. Et si, en création, on insère le nouvel enregistrement à l'endroit où s'est arrêté la recherche au lieu de coller le nouvel enregistrement à la fin comme actuellement, on obtient des chaînes triées alphabétiquement pour chaque lettre de l'alphabet. J'espère que cela permettra de voir un peu mieux les possibilités de cet outil. | |
| | | | Klaus
Nombre de messages : 12301
Age : 75
Localisation : Ile de France
Date d'inscription : 29/12/2009
| | Sujet: Re: Maintenance de fichiers chaînés Sam 9 Nov 2013 - 19:46 | |
| Avec la version V2.49 de KGF.dll sortie il y a quelques minutes, j'ai repris la démo de gestion des noms de clients et fournisseurs. Au lieu de mémoriser par Panoramic des adresses codées en format D6, j'utilise la fonctionnalité des chaînes liées pour attacher le début de chaque chaîne contenant les noms commençant par une même lettre, à l'enregistrement contenant cette lettre dans la chaîne associée à la racine "Clients" et "Fournisseurs". C'est fonctionnellement identique, mais les fichiers ne sont pas compatibles entre les deux versions - évident car dans un cas, un a un pointeur en D6, dans l'autre cas, on a un pointeur en I4. Cette fonctionnalité, même si elle paraît abstraite, est très puissante. Imaginez une gestion locative d'un immeuble, avec une vingtaine d'appartements. On construirait alors une chaîne représentant l'immeuble, et dont chaque enregistrement représente un appartement. Maintenant, on a des locataires. On aura alors une chaîne des locataires pour chaque appartement, le dernier enregistrement de ces chaînes représentant le locataire actuel, et les autres sont donc l'historique des locataires pour chaque appartement. En réalisant cette chaîne des locataires sous forme de chaîne liée à l'enregistrement de l'appartement concerné, on obtient une structure arborescente qui sera l'amorce d'une base de données pour la gestion de cette activité. Toujours sur le même modèle, on attache une chaîne liée à chaque locataire, et chaque enregistrement de cette chaîne contiendra une échéance et l'information sur le règlement. On attache une deuxième chaîne liée à chaque enregistrement locataire, et chaque enregistrement contient un lien ou un nom de fichier pour les courriers envoyés au locataire. Un chrono, en quelque sorte. Et ainsi de suite. On peut sophistiquer à loisir. On voit qu'on n'est pas loin d'une base de données, avec une structure logique entièrement conçue pour chaque problème applicatif, mais avec un seul et même outil entièrement maîtrisable avec Panoramic (et KGF.dll, bien sûr). Assez de baratin, voici la démo réécrite: test_base.bas - Code:
-
' test_base.bas
' fichier chaîné base.dat avec 2 chaînes permanentes:
' 1 = clients
' 2 = fournisseurs
' Chaque chaîne pointe vers une chaine
' dont chacune pointe vers une chaîne fixe
' correspondant à la première lettre du nom.
' Ces chaînes à leur tout pointent vers une
' chaîne rassemblant tous ceux dont le nom
' commence par la même lettre.
' format des donnés des enregistrements:
' enfant libellé
' enfant: adresse en format I4 du niveau inférieur
' pour cet enregistrement.
labels()
constantes()
variables()
form0()
nonvisuels()
visuels()
initialisations()
end
sub labels()
label exit, creer, chercher, effacer
end_sub
sub constantes()
dim kgf$ :kgf$ = "KGF.dll"
dim base$ : base$ = "base1.dat"
end_sub
sub variables()
dim dll%, data$, i%, d6$, no%, no_type%, no_nom%
dim nom$, adr%, adr1%, adr2%, lettre$, s$, res%
dim zero$
end_sub
sub form0()
width 0,700
on_close 0,exit
end_sub
sub nonvisuels()
end_sub
sub visuels()
xAlpha(10,10,0,10,"Nom de la personne:")
xEdit(10,150,300,0,0,0) : no_nom% = no%
xCombo(10,470,0) : no_type% = no%
xButton(40,150,90,0,"Créer") : on_click no%,creer
xButton(40,250,90,0,"Chercher") : on_click no%,chercher
xButton(40,350,90,0,"Effacer") : on_click no%,effacer
end_sub
sub initialisations()
item_add no_type%,"Client"
item_add no_type%,"Fournisseur"
text no_type%,item_read$(no_type%,1)
KGF_initialize(kgf$)
dll% = 1
cfZeroLinks(1)
zero$ = cfZeroLinks$
if file_exists(base$)=0
' créer le fichier vide
cfCreateFile(128,200,base$)
' créer la chaine fixe clients
data$ = zero$ + "* Clients *"
cfNewChain(data$) : ' enregistrement servant de racine Clients
' créer la chaine fixe fournisseurs
data$ = zero$ + "* Fournisseurs *"
cfNewChain(data$) : ' enregistrement servant de racine Fournisseurs
' créer la chaîne des 26 lettres pour clients et fournisseurs
for i%=1 to 26
data$ = zero$ + chr$(64+i%) : ' clients i%
cfAppendToChain(1,data$) : ' ajouter à la chaine des clients
cfAppendToChain(2,data$) : ' et à celle des clients
next i%
else
' ouvrir une base existante
cfOpenFile(base$)
end_if
end_sub
' procédure qui recherche un nom dans la base.
' Au retour, les variables suivantes sont chargées:
' adr% 0 si inexistant, adresse de l'enregistrement si existant
' adr1% adresse de base de la chaîne des lettres (client ou fournisseur)
' adr2% adresse de base pour tous les éléments d'une même lettre
sub chercher(nom$)
dim_local d%, s$
adr1% = 0
lettre$ = left$(nom$,1) : ' récupérer la première lettre
for i%=1 to 26 : ' recherche de l'enregistrement pour cette lettre
cfReadNext(adr%) : ' le premier enregistrement est la racine !...
cfInfoFile("cfAct") : ' récupérer l'adresse de l'enregistrement lu
adr% = cfInfoFile%
cfInfoFile("cfDta") : ' et récupérer ses données
if mid$(cfInfoFile$,5,1)=lettre$ : ' est-ce bien l'enregistrement pour la lettre ?
adr1% = adr% : ' adr1% = adresse de la base pour la première lettre
adr% = 0
cfFindLinkedChain(adr1%,0) : ' lire la chaîne liée indexe 0
if cfFindLinkedChain%<0 then exit_sub : ' pas encore de chaîne liée ?
cfInfoFile("cfAct") : ' récuparer la position début de chaîne liée
adr2% = cfInfoFile% : ' adr2 := début de la chaîne pour la première lettre
while cfInfoFile%>0 : ' boucle sur la chaîne de la lettre
cfReadNext(cfInfoFile%) : ' le premier enregistrement est la racine !
if cfReadNext%<0 then exit_while : ' c'était le dernier ? alors on n'a rien trouvé !
cfInfoFile("cfDta") : ' extraire les données
s$ = cfInfoFile$
cfInfoFile("cfAct") : ' et l'adresse
adr% = cfInfoFile%
if instr(s$,nom$+" ")=5 : ' est-ce le nom exact ?
' éventuellement, d'autres traitements sur l'enregistrement trouvé...
exit_sub : ' si oui, on a trouvé, et adr% = son adresse
end_if
end_while : ' fin de boucle pour la lettre
adr% = 0 : ' nom non trouvé
exit_sub
end_if
next i% : ' fin de boucle sur la chaîne des lettres
adr% = 0 : ' on ne devrait jamais arriver ici !
end_sub
exit:
' ici, on s'assure que le fichier est fermé et la DLL déchargée, à la sortie
if dll%=1
cfCloseFile()
dll_off
end_if
return
' création d'un nouveau nom
creer:
nom$ = upper$(trim$(text$(no_nom%)))
if nom$=""
message "Le nom manque."
return
end_if
adr% = 0
if text$(no_type%)=item_read$(no_type%,1) then adr% = 1
if text$(no_type%)=item_read$(no_type%,2) then adr% = 2
if adr%=0
message "La nature de la personne est inconnue."
return
end_if
chercher(nom$)
if adr%<>0
message "Ce "+lower$(text$(no_type%))+" existe déjà."
return
end_if
if adr2%=0 : ' il n'y a pas encore de chaîne pour cette lettre
data$ = zero$ + "* "+lettre$ + " *" : ' préparer l'enregistrement racine pour cette lettre
cfNewLinkedChain(adr1%,0,data$) : ' créer la chaîne (avec l'enregistrement racine)
cfInfoFile("cfAct") : ' récupérer son adresse
adr2% = cfInfoFile% : ' adresse du début de la chaîne pour cette lettre
end_if
data$ = zero$ + nom$ : ' préparer les données pour le nouveau nom
cfAppendToChain(adr2%,data$) : ' créer le nouvel enregistrement en l'attachant à la fin de la chaîne pour la lettre
message "Ce "+lower$(text$(no_type%))+" a été créé."
return
chercher:
nom$ = upper$(trim$(text$(no_nom%)))
if nom$=""
message "Le nom manque."
return
end_if
adr% = 0
if text$(no_type%)=item_read$(no_type%,1) then adr% = 1
if text$(no_type%)=item_read$(no_type%,2) then adr% = 2
if adr%=0
message "La nature de la personne est inconnue."
return
end_if
chercher(nom$)
if adr%=0
message "Ce "+lower$(text$(no_type%))+" est inconnu."
return
end_if
message "Ce "+lower$(text$(no_type%))+" existe."
return
effacer:
nom$ = upper$(trim$(text$(no_nom%)))
if nom$=""
message "Le nom manque."
return
end_if
adr% = 0
if text$(no_type%)=item_read$(no_type%,1) then adr% = 1
if text$(no_type%)=item_read$(no_type%,2) then adr% = 2
if adr%=0
message "La nature de la personne est inconnue."
return
end_if
chercher(nom$)
if adr%=0
message "Ce "+lower$(text$(no_type%))+" est inconnu."
return
end_if
s$ = "Voulez-vous vraiment effacer le "+lower$(text$(no_type%))+" "+nom$+" ?"
if message_confirmation_yes_no(s$)=1
cfRemoveFromChain(adr%) : ' enlever simplement l'enregistrement pour ce nom
message "Le "+lower$(text$(no_type%))+" "+nom$+" a été effacé."
end_if
return
#INCLUDE "KGF_OBJ.bas"
#INCLUDE "KGF_SUB.bas"
| |
| | | | Klaus
Nombre de messages : 12301
Age : 75
Localisation : Ile de France
Date d'inscription : 29/12/2009
| | Sujet: Re: Maintenance de fichiers chaînés Mar 12 Nov 2013 - 0:36 | |
| Et voici un programme plus général, permettant de faire la maintenance (ou l'analyse) d'un fichier chaîné, en intégrant aussi la nouvelle fonction cfExtendFile de KGF.dll V2.52 , pour permettre d'étendre un fichier. - Code:
-
' cfMaintenance.bas
' Maintenance des fichiers chaînés
labels()
constantes()
variables()
form0()
invisibles()
visuel()
initialisations()
end
' =================================================================
' SUBs princpales
' =================================================================
sub labels()
label exit, Numerique, SelFile, Ouvrir, Supprimer
label CreerFic, Fermer, Reparer, Reorganiser
label rOption, Executer, Etendre
end_sub
sub constantes()
dim KGF$ : KGF$ = "KGF.dll"
end_sub
sub variables()
dim no%, no1%, no2%, no3%, obj%, dialog%
dim eNom%, nom$, s$
dim eLongueur%, eNombre%, eLibre%, eOccupe%
dim sLongueur$, sNombre$, sChoisi$, sExtension$
dim eAdresse%, eSuivant%, ePrecedent%, eID%, eSequence%
dim eDonnees%, eChoisi%, eExtension%
dim cflng%, cftot%, funct%, n%
end_sub
sub form0()
height 0,500 : width 0,930
caption 0,"cfMaintenance"
on_close 0,exit
end_sub
sub invisibles()
no% = no% + 1 : save_dialog no% : dialog% = no%
filter dialog%,"Fichier chaîné|*.dat"
end_sub
sub visuel()
' les deux containers
xContainer(8,8,900,145,"Fichier") : no1% = no%
xContainer(160,8,900,290,"Enregistrement") : no2% = no%
' objets pour container "Fichier"
xAlpha(32,40,no1%,10,"Nom du fichier:")
xAlpha(64,32,no1%,10,"Longueur enreg.:")
xAlpha(104,48,no1%,10,"Premier libre:")
xAlpha(64,240,no1%,10,"Nombre enreg.:")
xAlpha(104,232,no1%,10,"Nombre occupés:")
xAlpha(104,650,no1%,10,"Extension:")
xEdit(32,136,537,no1%,0,0) : eNom% = no%
xEdit(64,136,81,no1%,1,0) : eLongueur% = no%
xEdit(64,344,81,no1%,1,0) : eNombre% = no%
xEdit(104,136,81,no1%,0,1) : eLibre% = no%
xEdit(104,344,81,no1%,0,1) : eOccupe% = no%
xEdit(104,720,73,no1%,1,0) : eExtension% = no%
xButton(32,680,25,no1%,"?") : on_click no%,SelFile
xButton(32,720,73,no1%,"Ouvrir") : on_click no%,Ouvrir
xButton(32,800,81,no1%,"Supprimer") : on_click no%,Supprimer
xButton(64,432,105,no1%,"Créer nouveau") : on_click no%,CreerFic
xButton(64,544,90,no1%,"Fermer") : on_click no%,Fermer
xButton(64,720,73,no1%,"Réparer") : on_click no%,Reparer
xButton(64,800,81,no1%,"Réorganiser") : on_click no%,Reorganiser
xButton(104,800,81,no1%,"Etendre") : on_click no%,Etendre
' objets pour container "Enregistrement"
xAlpha(32,32,no2%,10,"Adresse:")
xAlpha(32,224,no2%,10,"Suivant:")
xAlpha(32,384,no2%,10,"Précédent:")
xAlpha(32,568,no2%,10,"ID:")
xAlpha(32,704,no2%,10,"Séquence:")
xAlpha(72,32,no2%,10,"Donnees:")
xAlpha(96,96,no2%,10,"....;....1....;....2....;....3....;....4....;....5....;....6....;....7....;....8....;....9....;..")
font_name no%,"Courier"
xAlpha(144,568,no2%,10,"Adresse:")
xEdit(32,96,81,no2%,0,1) : eAdresse% = no%
xEdit(32,280,81,no2%,0,1) : eSuivant% = no%
xEdit(32,456,81,no2%,0,1) : ePrecedent% = no%
xEdit(32,592,81,no2%,0,1) : eID% = no%
xEdit(32,776,81,no2%,0,1) : eSequence% = no%
xEdit(72,96,769,no2%,0,0) : eDonnees% = no%
xEdit(144,632,81,no2%,1,0) : eChoisi% = no%
xContainer_Option(120,24,521,153,no2%,"Fonctions à exécuter") : no3% = no%
xOption(20,10,161,no3%,"Nouvelle chaîne") : on_click no%,rOption
xOption(48,10,161,no3%,"Supprimer chaîne") : on_click no%,rOption
xOption(20,170,161,no3%,"Lire par adresse") : on_click no%,rOption
xOption(48,170,161,no3%,"Lire suivant") : on_click no%,rOption
xOption(72,170,161,no3%,"Lire précédent") : on_click no%,rOption
xOption(96,170,161,no3%,"Lire premier") : on_click no%,rOption
xOption(120,170,161,no3%,"Lire dernier") : on_click no%,rOption
xOption(20,304,161,no3%,"Ajouter en fin de chaîne") : on_click no%,rOption
xOption(48,304,161,no3%,"Ajouter en début de chaîne") : on_click no%,rOption
xOption(72,304,161,no3%,"Insérer après enregistrement") : on_click no%,rOption
xOption(94,304,161,no3%,"Supprimer enregistrement") : on_click no%,rOption
xOption(120,304,161,no3%,"Remplacer données") : on_click no%,rOption
xButton(184,632,81,no2%,"Exécuter") : on_click no%,Executer
end_sub
sub initialisations()
KGF_initialize(KGF$)
end_sub
' =================================================================
' SUBs auxiliaires
' =================================================================
sub ResetOptions()
text eChoisi%,""
end_sub
sub AfficherRecord()
cfInfoFile("cfAct")
text eAdresse%,Str$(cfInfoFile%)
cfInfoFile("cfNxt")
text eSuivant%,Str$(cfInfoFile%)
cfInfoFile("cfPrv")
text ePrecedent%,Str$(cfInfoFile%)
cfInfoFile("cfID")
text eID%,Str$(cfInfoFile%)
cfInfoFile("cfSeq")
text eSequence%,Str$(cfInfoFile%)
cfInfoFile("cfDTA")
text eDonnees%,cfInfoFile$
end_sub
' =================================================================
' routines évènement
' =================================================================
exit:
cfCloseFile()
dll_off
return
Numerique:
obj% = number_change
if obj%=eLongueur%
if numeric(text$(eLongueur%))=1
sLongueur$ = text$(eLongueur%)
else
if text$(eLongueur%)<>"" then text eLongueur%,sLongueur$
end_if
end_if
if obj%=eNombre%
if numeric(text$(eNombre%))=1
sNombre$ = text$(eNombre%)
else
if text$(eNombre%)<>"" then text eNombre%,sNombre$
end_if
end_if
if obj%=eChoisi%
if numeric(text$(eChoisi%))=1
sChoisi$ = text$(eChoisi%)
else
if text$(eChoisi%)<>"" then text eChoisi%,sChoisi$
end_if
end_if
if obj%=eExtension%
if numeric(text$(eExtension%))=1
sExtension$ = text$(eExtension%)
else
if text$(eExtension%)<>"" then text eExtension%,sExtension$
end_if
end_if
return
SelFile:
nom$ = file_name$(dialog%)
if nom$="_"
text eNom%,""
else
if lower$(right$(nom$,4))<>".dat" then nom$ = nom$ + ".dat"
text eNom%,nom$
end_if
return
Ouvrir:
nom$ = trim$(text$(eNom%))
if nom$=""
message "Le nom du fichier manque."
return
end_if
cfOpenFile(nom$)
if cfOpenFile%<0
if cfOpenFile%=-1
message "Un fichier est déjà ouvert."
return
end_if
if cfOpenFile%=-2
message "Le fichier n''existe pas."
return
end_if
end_if
cfInfoFile("cfLng")
text eLongueur%, Str$(cfInfoFile%)
cfInfoFile("cfTot")
text eNombre%, Str$(cfInfoFile%)
cfInfoFile("cfFre")
text eLibre%, Str$(cfInfoFile%)
cfInfoFile("cfOcc")
text eOccupe%, Str$(cfInfoFile%)
return
Supprimer:
cfInfoFile("cfOpn")
if cfInfoFile%=0
message "Un fichier est encore ouvert."
return
end_if
nom$ = trim$(text$(eNom%))
if nom$=""
message "Le nom de fichier manque."
return
end_if
if File_Exists(nom$)=1 then File_delete nom$
text eNom%,""
text eLongueur%, ""
text eNombre%, ""
text eLibre%, ""
text eOccupe%, ""
return
CreerFic:
if trim$(text$(eLongueur%))=""
message "La longueur d'enregistrement manque."
return
end_if
if trim$(text$(eNombre%))=""
message "Le nombre d'enregistrements manque."
return
end_if
cflng% = val(text$(eLongueur%))
cftot% = val(text$(eNombre%))
nom$ = text$(eNom%)
' effectuer la création
cfCreateFile(cflng%,cftot%,nom$)
' traitement des erreurs
if cfCreateFile%<0
if cfCreateFile%=-1
message "La longueur d'enregistrement est invalide (<40)."
return
end_if
if cfCreateFile%=-2
message "Le nombre d'enregistrements est invalide (<2)."
return
end_if
if cfCreateFile%=-3
message "Ce fichier existe déjà."
return
end_if
if cfCreateFile%=-4
message "Le nom du fichier manque."
return
end_if
end_if
' mise à jour de l'affichage
text enom%,nom$
cfFileInfo("cfFre")
' message "fre="+str$(cffileinfo%)
text eLibre%,Str$(cfFileInfo%)
cfFileInfo("cfOcc")
text eOccupe%.Str$(cfFileInfo%)
return
Fermer:
cfCloseFile()
if cfCloseFile%<0 then message "Aucun fichier n'est ouvert."
text eLongueur%, ""
text eNombre%, ""
text eLibre%, ""
text eOccupe%, ""
return
Reparer:
message "Fonction pas encore implémentée."
return
Reorganiser:
message "Fonction pas encore implémentée."
return
rOption:
ResetOptions()
funct% = number_click - no3%
return
Executer:
cfInfoFile("cfOpn")
if cfInfoFile%=-2
message "Aucun fichier n'est ouvert."
return
end_if
if Funct%=0
message "Aucune fonction n'est choisie."
return
end_if
cfReadHeader()
cfInfoFile("cfSta")
if cfInfoFile%<>0
message "Une action est en cours."
return
end_if
select funct%
case 1: ' nouvelle chaîne
cfNewChain(trim$(text$(eDonnees%)))
if cfNewChain%<0
if cfNewChain%=-1
message "Une action est en cours."
return
end_if
if cfNewChain%=-2
message "Le fichier est plein."
return
end_if
end_if
cfInfoFile("cfOcc")
text eOccupe%,Str$(cfInfoFile%)
cfInfoFile("cfFre")
text eLibre%,Str$(cfInfoFile%)
AfficherRecord()
case 2: ' supprimer chaîne
if Trim$(text$(eChoisi%))=""
message "L'adresse manque."
return
end_if
n% = val(text$(eChoisi%))
cfDeleteChain(n%)
if cfDeleteChain%=1
message "Impossible de supprimer la chaîne des libres.'"
return
end_if
if cfDeleteChain%<0
if cfDeleteChain%=-1
message "L'adresse choisie est invalide."
return
end_if
if cfDeleteChain%=-2
message "Une action est en cours."
return
end_if
end_if
cfInfoFile("cfOcc")
text eOccupe%,Str$(cfInfoFile%)
cfInfoFile("cfFre")
text eLibre%,Str$(cfInfoFile%)
case 3: ' lire par adresse
if Trim$(text$(eChoisi%))=""
message "L'adresse manque."
return
end_if
n% = val(text$(eChoisi%))
cfReadByAddress(n%)
if cfReadByAddress%<0
if cfReadByAddress%=-1
message "L'adresse choisie est invalide."
return
end_if
end_if
AfficherRecord()
case 4: ' lire suivant
if Trim$(text$(eChoisi%))=""
message "L'adresse manque."
return
end_if
n% = val(text$(eChoisi%))
cfReadNext(n%) : ' res=1 ==> on est dans la chaîne des libres
if cfReadNext%<0
if cfReadNext%=-1
message "L'adresse choisie est invalide."
return
end_if
if cfReadNext%=-2
message "L'adresse choisie est la fin de chaîne."
return
end_if
end_if
AfficherRecord()
case 5: ' lire précédent
if Trim$(text$(eChoisi%))=""
message "L'adresse manque."
return
end_if
n% = val(text$(eChoisi%))
cfReadPrevious(n%) : ' res=1 ==> on est dans la chaîne des libres
if cfReadPrevious%<0
if cfReadPrevious%=-1
message "L'adresse choisie est invalide."
return
end_if
if cfReadPrevious%=-2
message "L'adresse choisie est le début de chaîne."
return
end_if
end_if
AfficherRecord()
case 6: ' lire premier
if Trim$(text$(eChoisi%))=""
message "L'adresse manque."
return
end_if
n% = val(text$(eChoisi%))
cfReadFirst(n%) : ' // res=1 ==> on est dans la chaîne des libres
if cfReadFirst%<0
if cfReadFirst%=-1
message "L'adresse choisie est invalide."
return
end_if
end_if
AfficherRecord()
case 7: ' lire dernier
if Trim$(text$(eChoisi%))=""
message "L'adresse manque."
return
end_if
n% = val(text$(eChoisi%))
cfReadLast(n%) : ' res=1 ==> on est dans la chaîne des libres
if cfReadLast%<0
if cfReadLast%=-1
message "L'adresse choisie est invalide."
return
end_if
end_if
AfficherRecord()
case 8: ' ajouter en fin de chaîne
if Trim$(text$(eChoisi%))=""
message "L'adresse manque."
return
end_if
n% = val(text$(eChoisi%))
cfAppendToChain(n%,trim$(text$(eDonnees%)))
if cfAppendToChain%<0
if cfAppendToChain%=-1
showmessage('Une action est en cours.');
return
end_if
if cfAppendToChain%=-2
showmessage('L''adresse choisie est invalide.');
return
end_if
if cfAppendToChain%=-3
showmessage('Le fichier est plein.');
return
end_if
if cfAppendToChain%=-4
showmessage('Ajout interdit sur la chaîne des libres.');
return
end_if
end_if
AfficherRecord()
cfInfoFile("cfOcc")
text eOccupe%,Str$(cfInfoFile%)
cfInfoFile("cfFre")
text eLibre%,Str$(cfInfoFile%)
case 9: ' ajouter en début de chaîne
if Trim$(text$(eChoisi%))=""
message "L'adresse manque."
return
end_if
n% = val(text$(eChoisi%))
cfInsertTopChain(n%,trim$(text$(eDonnees%)))
if cfInsertTopChain%<0
if cfInsertTopChain%=-1
message "Une action est en cours."
return
end_if
if cfInsertTopChain%=-2
message "L'adresse choisie est invalide."
return
end_if
if cfInsertTopChain%=-3
message "Le fichier est plein."
return
end_if
if cfInsertTopChain%=-4
message "Ajout interdit sur la chaîne des libres."
return
end_if
end_if
AfficherRecord()
cfInfoFile("cfOcc")
text eOccupe%,Str$(cfInfoFile%)
cfInfoFile("cfFre")
text eLibre%,Str$(cfInfoFile%)
case 10: ' insérer après après enregistrement
if Trim$(text$(eChoisi%))=""
message "L'adresse manque."
return
end_if
n% = val(text$(eChoisi%))
cfInsertIntoChain(n%,trim$(text$(eDonnees%)))
if cfInsertIntoChain%<0
if cfInsertIntoChain%=-1
message "Une action est en cours."
return;
end_if
if cfInsertIntoChain%=-2
message "L'adresse choisie est invalide."
return
end_if
if cfInsertIntoChain%=-3
message "Le fichier est plein."
return
end_if
if cfInsertIntoChain%=-4
message "Ajout interdit sur la chaîne des libres";
return
end_if
end_if
AfficherRecord()
cfInfoFile("cfOcc")
text eOccupe%,Str$(cfInfoFile%)
cfInfoFile("cfFre")
text eLibre%,Str$(cfInfoFile%)
case 11: ' supprimer enregistrement
if Trim$(text$(eChoisi%))=""
message "L'adresse manque."
return
end_if
n% = val(text$(eChoisi%))
cfRemoveFromChain(n%)
if cfRemoveFromChain%<0
if cfRemoveFromChain%=-1
message "Une action est en cours."
return
end_if
if cfRemoveFromChain%=-2
message "L'adresse choisie est invalide."
return
end_if
if cfRemoveFromChain%=-4
message "Ajout interdit sur la chaîne des libres."
return
end_if
end_if
cfInfoFile("cfOcc")
text eOccupe%,Str$(cfInfoFile%)
cfInfoFile("cfFre")
text eLibre%,Str$(cfInfoFile%)
case 12: ' remplacer les données
if Trim$(text$(eChoisi%))=""
message "L'adresse manque."
return
end_if
n% = val(text$(eChoisi%))
cfReplaceData(n%,trim$(text$(eDonnees%)))
if cfReplaceData%<0
if cfReplaceData%=-1
message "Une action est en cours."
return
end_if
if cfReplaceData%=-2
message "L'adresse choisie est invalide."
return
end_if
if cfReplaceData%=-4
message "Ecriture interdite sur la chaîne des libres."
return
end_if
end_if
end_select
ResetOptions()
return
Etendre:
s$ = text$(eExtension%)
if s$="" then s$ = "0"
n% = val(s$)
cfExtendFile(n%)
if cfExtendFile%<0
if cfExtendFile=-1
message "Le fichier n'est pas ouvert."
return
end_if
if cfExtendFile=-2
message "Nombre d'extensions invalide."
return
end_if
if cfExtendFile=-3
message "Une action est en cours."
return
end_if
end_if
cfInfoFile("cfTot")
text eNombre%, Str$(cfInfoFile%)
message "Extension terminée."
return
#INCLUDE "KGF_OBJ.bas"
#INCLUDE "KGF_SUB.bas"
| |
| | | | Yannick
Nombre de messages : 8611
Age : 53
Localisation : Bretagne
Date d'inscription : 15/02/2010
| | Sujet: re Mar 12 Nov 2013 - 8:27 | |
| @ Klaus,
Comme je l' ai dit il y a quelques jours, je ne peux pas tester toutes ces avancées
car je ne suis pas chez moi sur mon ordi et je ne peux pas me permettre d' installer Panoramic et le reste sur cet ordi.
Mais, je le ferai dès que je rentre car je vois une application possible sur les fichiers *.ged.
En tout cas Bravo pour cette nouvelle avancée de KGF. | |
| | | | Contenu sponsorisé
| | Sujet: Re: Maintenance de fichiers chaînés | |
| |
| | | | | | Maintenance de fichiers chaînés | |
|
Sujets similaires | |
|
| | Permission de ce forum: | Vous ne pouvez pas répondre aux sujets dans ce forum
| |
| |
| |
