Voilà, mon problème était de pouvoir travailler avec un des fichiers de type "aléatoire" avec enregistrements de longueur fixe
avec accès direct (Ramdon Acces Files) que l'on retrouve dans d'autres langages. Ou si on veut du type :
'Open "Adresses.dat" for Random As #Buffer Len=Longueur'.
Le problème pour créer un bloc de donnée de longueur fixe provenait de la nécessité de convertir les valeurs numériques
qu'elles soit "entier", "double précision", ou autres en une forme telle qu'elles aient des longueurs fixes en fonction de leurs types.
C'est ce que font les procédures crées par "Wilbert" du forum officiel.
A partir de là il "suffit" de composer l'enregistrement en fonction du Type(i) et de la longueur octroyé Long(i) pour chaque Champ$(i) de donnée.
Fichier à ACCES DIRECT de longueur fixe sur DISQUE :
* C'est simplement une autre forme de possibilité d'accéder aux données sur disque.
Avantage :
- Sur de très gros fichier, ne pas avoir à charger tout le fichier en mémoire
- D'accéder à l'enregistrement "N°" directement sans devoir lire les autres...
- Pouvoir travailler à plusieurs sur un même fichier en verrouillant l'enregistrement sur lequel on travaille (Mise à jours)
tout en laissant les autres en libre accès.
- Pouvoir mettre à jours n'importe quel enregistrement sans devoir déplacer les autres (c'est une pile de "blocDATA$" de même longueur...)
- Ajouter / Supprimer des enregistrements sans aucun déplacement des autres...
Dans ce cas il est préférable d'avoir une bonne gestion des enregistrements occupés ou libres via une Bitmap par exemple ou à la position de chaque BIT
corresponde la position d'un enregistrement sur le disque. Dès l'or l'état du Bit définit également l'état de l'enregistrement. Bit à 1 occupé et 0 libre.
Ce qui conduit par exemple au fait que pour supprimer un enregistrement , il suffit de mettre son Bit de la "BitMap" à 0…
Inconvénient / Désavantage majeur !
- La longueur fixe de l'enregistrement !
- En conséquence prédétermination obligatoire des longueurs des champs
- N'existe pas de système de base de conversion pour les valeurs numérique dans PureBasic tel que :
Par exemple : MKI, MKL, MKF, MKD, MKQ et CVI, CVL, CVF, CVD, CVQ) mais ici cela à été remédié dans ces exemples...
Méthodologie :
Pour travailler efficacement sur un fichier résident sur disque, il est préférable de disposer d'un enregistrement d'initialisation ou "Secteur Zéro". Ce secteur sera composé d'information identifiant le fichier et ayant les paramètres utiles à sa gestion. Il va de soit que cela est une convention et que celle-ci dépendra de celui qui le crée. Aussi je commencerais par définir mon "Secteur Zéro". Comme avec PureBasic on peut définir une structure, nous allons l'utiliser pour créer ce "Secteur". Il est évident que ce type de "Secteur Zéro" peut-être utilisé pour n'importe quel type de fichier… Même un séquentiel de PureBasic ou nous aurions cette structure pour le secteur d'initialisation et une autre structure qui définirait la nature des données elles mêmes.
Si la BitMap est d'un grand intérêt, elle n'est pas utilisée ici, mais le sera dans un prochain modèle. Si je ne l'ai pas installé ici c'est par soucis de présenter un système assez clair à lire et de le comprendre sans trop l'encombrer.
Nous avons donc un module charnière qui est le"IncLectureDirect.pbi", contenant la plupart des procédures de lectures, écritures dans le fichier Direct.
Puis, un module créant un fichier "EcritureDirect.pb" sur base des "data" inclue. Ce module utilise l'include ci-dessus.
Evidement un module lisant ce qui a été créé par le premier "LectureDirect.pb", utilisant aussi l'include…
Et enfin un modèles plus complet "ExpleGestionDirect.pb", qui lui présente une fenêtre qui est censé gérer un fichier d'adresse… Il y a donc une partie avec une fenêtre, une partie qui lis les datas définissant les types et longueur des champs et une boucle de gestion des différents champs de la fenêtre. Le tout reposant comme les deux premiers sur "IncLectureDirect.pbi"...
Les 3 programmes et l'Includes sont commentés... !
Ils ne sont pas spécialement sécurisés et presque toutes les variables sont Globales.
Voilà, si ça vous intéresse il y aura une suite avec la BitMap Inclue...
Voir une gestion indexée et ordonnée avec plusieurs clefs donc la première unique ou automatique...
Voilà, voilà...
Première partie l'Include "IncLectureDirect.pbi"
Code : Tout sélectionner
; **************************************************************************;
; Exemple de GESTION d'un FICHIER à ACCES DIRECT sur DISQUE Vers.: 1.0 ;
; ---------------+----------------------------------------------------------;
; Auteur : GeBonet (et merci à Wilbert pour MK...CV.. ) ;
; Mise en oeuvre : 01/11/2011 ;
; Dern. Update : 11/11/2011 **************************** ;
; PureBasic 4.6 : *** IncLectureDirect.pbi *** ;
; XpPro,Windows 7: **************************** ;
; ************ +----------------------------------------------------------;
; ATTENTION : A compiler avec UNICODE décoché dans "Options du compilateur";
; ************ +----------------------------------------------------------;
; **************************************************************************;
; Tableaux de base utiles : A INITIALISER SI ON UTILISE PAS AILLEURS AVANT...
; EnableExplicit
; Global Rep$
; --------------------------------------------------------------------------------------
;{ Si on travaillait avec plusieurs fichiers ces tableaux pourraient-être :
; ======>>> Type(NoFile, NbChamp), Long(NoFile, NbChamp) et Champ$(NoFile, NbChamp)
;
; En sachant que Type(j) ou Type(i,j) contient le type de donnee du Champ$(i) ou Champ$(i,j)
; et que selon le Cas il serait codé ou décodé selon que :
; Type = 0 :Champ$(j)=LSet(Champ$(j),long(j)," ") ; AlphaNumérique
; 1 :Champ$(j)=MKI(Val(Champ$(j))) ; Entier
; 2 :Champ$(j)=MKL(Val(Champ$(j))) ; Long
; 3 :Champ$(j)=MKF(ValF(Champ$(j))) ; Flottant
; 4 :Champ$(j)=MKD(ValD(Champ$(j))) ; Double
; 5 :Champ$(j)=MKQ(Val(Champ$(j))) ; Quad
; 6 :Champ$(j)=Champ$(j) ; Date forme "jj/mm/aaaa"
;} --------------------------------------------------------------------------------------
Structure CV_MK_Struct ;{ ***-- Conversion functions --***
StructureUnion
f.f
d.d
l.l
q.q
s5.s{5}
s10.s{10}
EndStructureUnion
EndStructure;}
;{ - CONSTANTES pour l'enregistrement ZERO -
; - Entete de fichier standard - 40 Bytes ! Mais peut être allongé si nécéssite d'autre infos.
#File_Nature = 0 ; 0 Nature du fichier (Voir code ci-après)
#File_RecNumber = 1 ; 1 Nombre d'enregistrement
#File_LongRecord = 5 ; 5 Longueur de l'enregistrement
#File_CreationDate = 9 ; 9 Date de création
#File_LastAccessDate= 13 ;13 Date dernier accès
#File_KeyRecord = 17 ;17 Champs qui contient la clef d'accès principale
#File_BitMap = 21 ;21 Optionnel si BitMap (Nbr. Enregistrement BitMap)
#File_Reserve = 25 ;25 Chaine de caractères variable mais < que "LongRECORD")
;}
Structure Record_Zero ;{ Enregistrement de Gestion du fichier...
NatureFILE.b ; #File_Nature = 0 ; Type de fichier
RecNumber.l ; #File_RecNumber = 1 ; Nombre d'enregistrement
LongRECORD.l ; #File_LongRecord = 5 ; Longueur de l'enregistrement
CreationDate.l ; #File_CreationDate = 9 ; Date de création
LastAccessDate.l ; #File_LastAccessDate = 13 ; Date dernier accès
ChampDeLaClef.l ; #File_KeyRecord = 17 ; Champs qui contient la clef d'accès principale
TailleBitMap.l ; #File_BitMap = 21 ; Optionnel si utile (nbr d'enregistrement utile)
FlagReserve.s{15} ; #File_Reserve = 25 ; Chaine de caractères variable mais < que "LongRECORD"
EndStructure ;} Longueur total = 25 + 15 => 40 Bytes si FlagReserve.s = 15...
Global *mon.Record_Zero ;
#Max_Premier=SizeOf(Record_Zero)
;{ - - - - - Global - - - - - - - - - - - - - - - - - --
Global FirstRec, nomFichier.s ,Phrase.s
Global RecNo, Position, Resultat, Suivant
Global DebFichier.q, FinFichier.q, Dernier.l, Nb_Colonne, list_nr
Global NbLigne, ChampKey, Expression$
Global NbrBitMap, BitMap$, Fonction
; --------------------------------------------------------
Global i, j, k, No, Type, DebutString, NbCar, D1$, Texte$
Global NoFile, NoKey, NbChamp, NbRecord, LongTOT, Nature
; --------------------------------------------------------
Global Nature, NatureFILE.b, RecNumber.l, LongRecord.l, LongTOT, CreationDate.l
Global LastAccessDate.l, ChampDeLaClef.l, TailleBitMap.l, FlagReserve.s
; Premier enregistrement (paramètres)
Global blocDATA$, Record$, Clef$, I$
Global FontID1: FontID1 = LoadFont(1, "Arial", 22, #PB_Font_Bold)
Global FontID2: FontID2 = LoadFont(2, "Arial", 10)
; --------------------------------------------------------------------------------------
; Tableaux de base si on utilise les DATAs pour fichier à longueur FIXE :
; -
Global Dim Type(NbChamp) ; Tableau des types de données dans le fichier...
Global Dim Long(NbChamp) ; Tableau des longueur de champs dans le fichier...
Global Dim Champ$(NbChamp) ; Tableau recevant les données de chaque champs...
;Global Dim TextToSort$(1) ; Tableau si utilise le triage
;} -
; - Declaration Gestion Fichiers
;{ - - - - - - - - - - - - - - - - - - - - - - - - - - -
Declare.s Creation_Fichier(NoFile, NomFichier.s)
Declare.s OuvreFichier(NoFile, NomFichier.s,LongTOT)
Declare LecturePremier()
Declare EcritPremier()
Declare EcritZero()
; - - - - : ------------------;
Declare.s Get(NoFile, RecNo) ; 3
Declare.s Put(NoFile, RecNo) ; 4
Declare.s Add(NoFile, Record$); 5
Declare.s Upd(NoFile, RecNo) ; 6 Mise a jours actuel
Declare.s Del(NoFile, RecNo) ; 7 Efface "" ""
Declare.s Nex(NoFile, RecNo) ; 8 Suivant
Declare.s Prv(NoFile, RecNo) ; 9 Precedent
Declare.s Der(NoFile) ;10 Dernier
Declare.s Pre(NoFile) ;11 Premier
; - - - - : ------------------;
Declare.s Cherche(NoFile, Key$)
Declare.s CloseRandom(NoFile)
; - - - - : ------------------;
Declare AfficheDebug() ; Pour les TESTS
Declare GadgetBalTip(WindowNumber.l, GadgetNumber.l, Text.s)
Declare Triage(Taille, Array TextToSort$(1))
; - - - - : ------------------;
Declare Gest_BitMap(BitMap$, FoncTion, RecNo)
;} - - - -: ------------------;
; -------------------------------------------------------------------------------------:
;{ - Declaration Conversions -
;
Declare CV_Adapt(*cv, bytes)
Declare MK_Adapt(*cv, bytes)
; ----------------------------------
Declare.s MKI(i.i)
Declare.i CVI(s.s)
Declare.s MKF(f.f)
Declare.f CVF(s.s)
Declare.s MKD(d.d)
Declare.d CVD(s.s)
Declare.s MKL(l.l)
Declare.l CVL(s.s)
Declare.s MKQ(q.q)
Declare.q CVQ(s.s)
; ----------------------------------
Declare.s conver_En_DataBLOC(NbChamp, LongTOT, Array Type(1), Array Long(1), Array Champ$(1))
Declare.s conver_Record_EnCHAMP(NbChamp, Record$, Array Type(1), Array Long(1), Array Champ$(1))
;} ---------------------------------------------------------------------------------------------:
; =======================================================
; - O U V R E FICHIER et C R E A T I O N si inexistant -
; =======================================================
Procedure.s OuvreFichier(NoFile, NomFichier.s, LongTOT) ; Ouvre le fichier
; ENTREE : NoFile : ID du fichier
; : NomFichier.s : Nom du fichier (avec extension)
; -------------------------------------------------------------------
FirstRec=SizeOf(Record_Zero)+1 ; Position pour écrire le premier enregistrement
If OpenFile(NoFile, Rep$+NomFichier.s) ; Ouverture du fichier
Resultat = IsFile(NoFile) ; Valable ?
If Resultat ; Ok
DebFichier=Loc(NoFile) ; Debut du fichier
FinFichier=Lof(NoFile) ; Fin du fichier
; -----------------------------------------------------------------------------------------------------
If FinFichier=DebFichier ; Elle sont égale si Le fichier est nouveau il doit etre initialisé
; ; ; -----------------------------------------------------------------
Creation_Fichier(NoFile, NomFichier.s) ; ALORS - On crée l'enregistrement ZERO (Paramètres)
; --------------------------------- -----------------------------------------------------------------
Else ; ICI le fichier existe et contient des données...
; ----------------------------------------------------
; Lecture premier enregistrement...
LecturePremier() ; Lecture de l'enregistrement "0"
;
Suivant=Loc(NoFile)
FinFichier=Lof(NoFile)
FirstRec=SizeOf(Record_Zero)+1
; ------------
NbLigne=RecNumber
;
EndIf
; -----------------------------------------------
; Positionne le pointeur à la fin du fichier... (du premier)
FileSeek(NoFile,FinFichier) ; Se positionne en fin
ProcedureReturn Str(FinFichier)
EndIf
EndIf
;
EndProcedure
; =======================================================
; - Initialisation du FICHIER -
; =======================================================
Procedure.s Creation_Fichier(NoFile, NomFichier.s) ; Création et Initialise le fichier
; Ou initialisation du fichier ...
FirstRec =SizeOf(Record_Zero) ; --------------------------------
Nature =Nature ; Type de fichier ; 0=Séqu, 1=Direct long. FIXE, 2=Direct Long. VARIABLE
NbLigne =0 ; Nombre d'enregistrement
LongTOT =LongTOT; Longueur de l'enregistrement
CreationDate.l =Date() ; Date de création
ChampKey =0 ; Champ de la clef principale unique si il y a lieu
NbrBitMap =0 ; Taille de la BitMap s'il y a
Expression$ =LSet("GeBonet",15,"*") ; Chaine de 15 caractères
; ;
EcritPremier() ; Ecrit enregistrement 0
;
EndProcedure
; =======================================================
; - E C R I T U R E Enregistrement ZERO (Init Secteur) -
; -------------------------------------------------------
Procedure EcritPremier() ; Ecriture du secteur ZERO
; Le premier enregistrement (0) est utilisé pour sauver des paramètres
; de gestion du fichier ou des indicateurs de travail. Il doit être mis
; à jour après chaque écriture d'un enregistrement. Par appel de 'EcritZero()'
; ---------------------------------------------------------------------
If CreationDate =0:CreationDate=Date():EndIf; Si la date de création n'existe pas !
;
Nature=1 ; Fichier de type Direct
FirstRec =SizeOf(Record_Zero) ; Position du premier enregistrement
FinFichier =Lof(NoFile) ; Fin de fichier (taille)
; ---------------+---------------------------+-----------------------
NatureFILE.b =Nature ; 0 Etat du fichier ( 2 = Fichier de longueur Variable )
RecNumber.l =NbLigne ; 1 Nombre d'enregistrement
LongRecord.l =LongTOT ; 5 ---- SANS OBJET ICI......
CreationDate.l =CreationDate ; 9 Date de création
LastAccessDate.l =Date() ; 13 Date dernier accès
ChampDeLaClef.l =ChampKey ; 17 Champs qui contient la clef principale
TailleBitMap.l =NbrBitMap ; 21 ---- SANS OBJET ICI......
FlagReserve.s =Expression$ ; 25 Bloc disponible
; ---------------+---------------------------+-----------------------
FileSeek(NoFile, #File_Nature ) ; Initialisation pour secteur ZERO !
WriteString(NoFile,LSet("_",SizeOf(Record_Zero),"_"))
EcritZero()
EndProcedure
Procedure EcritZero() ;
FileSeek(NoFile, #File_Nature ) :WriteByte (NoFile, NatureFILE)
FileSeek(NoFile, #File_RecNumber) :WriteLong (NoFile, RecNumber)
FileSeek(NoFile, #File_LongRecord) :WriteWord (NoFile, LongRecord)
FileSeek(NoFile, #File_CreationDate) :WriteLong (NoFile, CreationDate)
FileSeek(NoFile, #File_LastAccessDate):WriteLong (NoFile, LastAccessDate)
FileSeek(NoFile, #File_KeyRecord) :WriteLong (NoFile, ChampDeLaClef)
FileSeek(NoFile, #File_BitMap) :WriteLong (NoFile, TailleBitMap)
FileSeek(NoFile, #File_Reserve) :WriteString(NoFile,FlagReserve)
EndProcedure
Procedure.s EcritRecord(NoFile,Position) ; Ecriture de l'enregistrement à la "position"
FileSeek(NoFile,Position)
WriteData(NoFile,@blocDATA$, LongTOT); Ecriture sur disque
FlushFileBuffers(NoFile) ; Force l'enregistrement
NbLigne=NbLigne+1: EcritPremier() ; Ajoute un ENregistrement secteur Zero...
EndProcedure
; -------------------------------------------------------
; - L E C T U R E de l'Enregistrement ZERO -
; -------------------------------------------------------
Procedure LecturePremier() ; Lecture du secteur ZERO...
;
FileSeek(NoFile, #File_Nature ) :NatureFILE =ReadLong (NoFile)
FileSeek(NoFile, #File_RecNumber) :RecNumber =ReadLong (NoFile)
FileSeek(NoFile, #File_LongRecord) :LongRecord =ReadWord (NoFile)
FileSeek(NoFile, #File_CreationDate) :CreationDate =ReadLong (NoFile)
FileSeek(NoFile, #File_LastAccessDate):LastAccessDate =ReadLong (NoFile)
FileSeek(NoFile, #File_KeyRecord) :ChampDeLaClef =ReadLong (NoFile)
FileSeek(NoFile, #File_BitMap) :TailleBitMap =ReadLong (NoFile)
FileSeek(NoFile, #File_Reserve) :FlagReserve =Left(ReadString(NoFile),15)
FileSeek(NoFile, #File_Reserve+15)
;
EndProcedure
Procedure AfficheDebug() ; Affichage du Secteur ZERO...
; ;
Define Event, Base, TxtID, WinID, Item ;
Base=20 ;
; ----------------------------------- Le fenêtre ------------------------
WinID=OpenWindow(#PB_Any,0,0,350,395,"Secteur Zero",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
;
; ------------------------------------- Titre --------------------------
TxtID=TextGadget(#PB_Any,0,10,350,40,"Carnet d'Adresse",#PB_Text_Center)
SetGadgetFont(TxtID, FontID1)
; ---------------------------------- Les libellés ---------------------
Item=Base+1
EditorGadget(Item,10,55,330,325,#PB_Editor3D_ReadOnly)
SetGadgetFont(Item, FontID2)
;
AddGadgetItem(Item,-1,"Début Ecriture : "+Str(SizeOf(Record_Zero)+1))
AddGadgetItem(Item,-1," ")
AddGadgetItem(Item,-1,"Nature du Fichier : "+Str(NatureFILE))
AddGadgetItem(Item,-1," ")
AddGadgetItem(Item,-1,"Nombre Enregistrement : "+Str(RecNumber))
AddGadgetItem(Item,-1," ")
AddGadgetItem(Item,-1,"Longueur Enregistrement : "+Str(LongRecord))
AddGadgetItem(Item,-1," ")
AddGadgetItem(Item,-1,"Date Création : "+FormatDate("%dd/%mm/%yy",CreationDate))
AddGadgetItem(Item,-1," ")
AddGadgetItem(Item,-1,"Dernier accès : "+FormatDate("%dd/%mm/%yy",LastAccessDate))
AddGadgetItem(Item,-1," ")
AddGadgetItem(Item,-1,"Champ de la Clef : "+Str(ChampDeLaClef))
AddGadgetItem(Item,-1," ")
AddGadgetItem(Item,-1,"Lignes de la BitMap : "+Str(TailleBitMap))
AddGadgetItem(Item,-1," ")
AddGadgetItem(Item,-1,"Réserve : "+FlagReserve) ; Left(FlagReserve,15)
AddGadgetItem(Item,-1," ")
AddGadgetItem(Item,-1,"Fin de fichier : "+Str(FinFichier))
AddGadgetItem(Item,-1," ")
;
Repeat
;
Event = WaitWindowEvent()
Until Event=#PB_Event_CloseWindow
CloseWindow(WinID)
EndProcedure
; =====================================================
; - Extrait un enregistrement
Procedure.s Get(NoFile, RecNo) ; Lecture enregistrement "RecNo"
Position=#Max_Premier+LongTOT*(RecNo-1) ; ATTENTION : Ici l'enregistrement commence à 0
blocDATA$=Space(LongTOT) ; Donc pour 10 bytes écrit le dernier est à la
FileSeek(NoFile,Position) ; position 9 (0->9) et le suivant à 10...
ReadData(NoFile,@blocDATA$, LongTOT) ;
conver_Record_EnCHAMP(NbChamp, blocDATA$, Type(), Long(), Champ$())
EndProcedure
; =====================================================
; - Ecrit un enregistrement
Procedure.s Put(NoFile, RecNo) ; Ecriture enregistrement "RecNo"
; Dans un espace existant....
blocDATA$=conver_En_DataBLOC(NbChamp, LongTOT, Type(), Long(),Champ$())
; Positionne le pointeur ...........;
Position=#Max_Premier+LongTOT*(RecNo-1)+1
If Position+LongTOT>FinFichier ; Position hors dimension du fichier
ProcedureReturn Add(NoFile, blocDATA$) ; Passe en mode "Ajoute"
EndIf
ProcedureReturn EcritRecord(NoFile,Position) ; La positioon existe alors écrit
EndProcedure
; =====================================================
; - Ajoute un enregistrement
Procedure.s Add(NoFile, blocDATA$) ; Ajoute un enregistrement
; Avec Bitmap... Ici on va chercher la position grace à la bitMap ;
Position=Lof(NoFile)
ProcedureReturn EcritRecord(NoFile,Position)
EndProcedure
; =====================================================
; - Efface l'enregsitrement courant
Procedure.s Del(NoFile, RecNo) ; Efface "" ""
;
; Avec Bitmap... Ici on va mettre le BIT de la position à zéro
;
Position=#Max_Premier+LongTOT*(RecNo-1)
blocDATA$=Space(LongTOT):NbLigne=NbLigne-1 ;
ProcedureReturn EcritRecord(NoFile,Position)
EndProcedure
; =====================================================
; - Mise à jour de l'enregsitrement courant
Procedure.s Upd(NoFile, RecNo) ; Mise a jours actuel
Position=#Max_Premier+LongTOT*(RecNo-1):NbLigne=NbLigne-1
blocDATA$=conver_En_DataBLOC(NbChamp, LongTOT, Type(), Long(),Champ$())
ProcedureReturn EcritRecord(NoFile,Position)
EndProcedure
; =====================================================
; - Prend le Suivant
Procedure.s Nex(NoFile, RecNo) ; Passe au Suivant
If RecNo<RecNumber:RecNo+1:EndIf
ProcedureReturn Get(NoFile, RecNo)
EndProcedure
; =====================================================
; - Prend le Précedent
Procedure.s Prv(NoFile, RecNo) ; Passe au Précédent
If RecNo>1:RecNo-1:EndIf
ProcedureReturn Get(NoFile, RecNo)
EndProcedure
; =====================================================
; - Prend le Dernier
Procedure.s Der(NoFile) ; Passe au Dernier
RecNo=RecNumber
ProcedureReturn Get(NoFile, RecNo)
EndProcedure
; =====================================================
; - Prend le Premier
Procedure.s Pre(NoFile) ; Passe au Premier
RecNo=1
ProcedureReturn Get(NoFile, RecNo)
EndProcedure
; =====================================================
; - Cherche avec la clef
Procedure.s Cherche(NoFile, Key$) ; Recherche selon la clef
EndProcedure
; =====================================================
; - Ferme le fichier courant et son Index...
Procedure.s CloseRandom(NoFile) ; Ferme les fichiers
;
; OpenFile(NoFile+1, Rep$+FichierIndex$) ; Ouvre l'index...
; ;
; For i=1 To NbRecord
; WriteString(NoFile+1,Index(i,1)) ; Ecriture de la clef
; WriteLong(NoFile+1,Val(Index.s(i,2))) ; Ecriture du pointeur
; Next i
; ;
; CloseFile(NoFile+1) ; Ferme l'index
;
CloseFile(NoFile) ; Ferme le fichier principal
;
EndProcedure
; ---------------------------------------------------------------------------------:
; --- 1 Convertion des Champ$() en Record$ ----------------------
Procedure.s conver_En_DataBLOC(NbChamp, LongTOT, Array Type(1), Array Long(1), Array Champ$(1))
; -------------------------------------------------------------------------------
; CONVERTIR des Champ$() en un BLOC de longueur FIXE !
; CONVERT Fields() in one Fixed lengh dataBLOC
; -------------------------------------------------------------------------------
Protected j, Type
; ----------------
blocDATA$=""
For j=1 To NbChamp
Type=Type(j)
Select Type
Case 0 :Champ$(j)=LSet(Champ$(j),long(j)," ") ; AlphaNumérique
Case 1 :Champ$(j)=MKI(Val(Champ$(j))) ; Entier
Case 2 :Champ$(j)=MKL(Val(Champ$(j))) ; Long
Case 3 :Champ$(j)=MKF(ValF(Champ$(j))) ; Flottant
Case 4 :Champ$(j)=MKD(ValD(Champ$(j))) ; Double
Case 5 :Champ$(j)=MKQ(Val(Champ$(j))) ; Quad
Case 6 :Champ$(j)=Champ$(j) ; Date forme "jj/mm/aaaa"
EndSelect
blocDATA$+Champ$(j)
Next j
ProcedureReturn blocDATA$
EndProcedure
; ---------------------------------------------------------------------------------:
; --- 2 Convertion du Record$ en Champ$() ----------------------
Procedure.s conver_Record_EnCHAMP(NbChamp, Record$, Array Type(1), Array Long(1), Array Champ$(1))
; -------------------------------------------------------------------------------
; CONVERTIR un enregistrement de longueur FIXE et place dans CHAMPS()
; CONVERT Fixed lengh Record$ back in Field()
; -------------------------------------------------------------------------------
Protected j, Type
; ----------------
For j=1 To NbChamp
Champ$(j)=Left(Record$,long(j)) ; Decompose en champs
Record$=Mid(Record$,long(j)+1) ;
Type=Type(j) ; Type de donnée
Select Type
Case 1 :Champ$(j)=Str(CVI(Champ$(j))) ; Entier < 65536 ou >-32335
Case 2 :Champ$(j)=Str(CVL(Champ$(j))) ; Entier - Long
Case 3 :Champ$(j)=StrF(CVF(Champ$(j))); Flottant
Case 4 :Champ$(j)=StrD(CVD(Champ$(j))); Double
Case 5 :Champ$(j)=Str(CVQ(Champ$(j))) ; Quad
Case 6 ; Date forme "jj/mm/aaaa"
EndSelect
Next j
EndProcedure
; -------------------------------------------------------------------------------------:
; - - - fonctions de conversion - - -
Procedure CV_Adapt(*cv, bytes) ;{
EnableASM
CompilerIf #PB_Compiler_Unicode
MOV edx, *cv
MOV ecx, bytes
!push ebx
!inc ecx
!mov ebx, ecx
!xor ecx, ecx
!xor ax, ax
!cv_adapt_unic_loop:
!mov ax, [edx + ecx * 2]
!mov [edx + ecx], al
!inc ecx
!cmp ecx, ebx
!jng cv_adapt_unic_loop
!pop ebx
CompilerEndIf
MOV edx, *cv
MOV ecx, bytes
!add edx, ecx
!mov ax, [edx]
!cv_adapt_loop:
!dec edx
!rcr ax, 2
!jc cv_adapt_skip
!btr word [edx], 7
!cv_adapt_skip:
!loop cv_adapt_loop
DisableASM
EndProcedure
Procedure MK_Adapt(*cv, bytes)
EnableASM
MOV edx, *cv
MOV ecx, bytes
!xor ax, ax
!mk_adapt_loop:
!bts word [edx], 7
!rcl ax, 2
!inc edx
!loop mk_adapt_loop
!or ax, 0x5555
!mov [edx], ax
CompilerIf #PB_Compiler_Unicode
MOV edx, *cv
MOV ecx, bytes
!inc ecx
!xor ax, ax
!mk_adapt_unic_loop:
!mov al, [edx + ecx]
!mov [edx + ecx * 2], ax
!sub ecx, 1
!jnc mk_adapt_unic_loop
CompilerEndIf
DisableASM
EndProcedure
; ------------------
Procedure.s MKI(i.i)
I$=Right("0000"+Hex(i),4)
ProcedureReturn I$
EndProcedure
Procedure.i CVI(I$)
I=Val("$"+I$)
ProcedureReturn I
EndProcedure
; ------------------
Procedure.s MKF(f.f)
Protected cv.CV_MK_Struct\f = f
MK_Adapt(@cv, 4)
ProcedureReturn cv\s5
EndProcedure
Procedure.f CVF(s.s)
Protected cv.CV_MK_Struct\s5 = s
CV_Adapt(@cv, 4)
ProcedureReturn cv\f
EndProcedure
; ------------------
Procedure.s MKD(d.d)
Protected cv.CV_MK_Struct\d = d
MK_Adapt(@cv, 8)
ProcedureReturn cv\s10
EndProcedure
Procedure.d CVD(s.s)
Protected cv.CV_MK_Struct\s10 = s
CV_Adapt(@cv, 8)
ProcedureReturn cv\d
EndProcedure
; ------------------
Procedure.s MKL(l.l)
Protected cv.CV_MK_Struct\l = l
MK_Adapt(@cv, 4)
ProcedureReturn cv\s5
EndProcedure
Procedure.l CVL(s.s)
Protected cv.CV_MK_Struct\s5 = s
CV_Adapt(@cv, 4)
ProcedureReturn cv\l
EndProcedure
; ------------------
Procedure.s MKQ(q.q)
Protected cv.CV_MK_Struct\q = q
MK_Adapt(@cv, 8)
ProcedureReturn cv\s10
EndProcedure
Procedure.q CVQ(s.s)
Protected cv.CV_MK_Struct\s10 = s
CV_Adapt(@cv, 8)
ProcedureReturn cv\q
EndProcedure
;}
; --------------------------------------------------------------------
; --- La BITMAP ou carte de représentation de l'occupation DISQUE !
; --------------------------------------------------------------------
; ENTREE : BitMap$ = Chaine contenant la bit map
; Fonction = 1 ou 2 (Ecrit ou supprime, met a 1 ou 0)
; RecNo = Position …A supprimer si FONC=2 met a 0
;
; SORTIE : RecNo = Position vaccante OU -99 si erreur dans routine
; BitMap$ = Chaine contenant la bit map modifiée
; =====================================================================
; =====================================================================
; - Procédures Gadget BallooonTools...
; --------------------------------------------------------
Procedure GadgetBalTip(WindowNumber.l, GadgetNumber.l, Text.s)
Protected Tooltip.l, Balloon.TOOLINFO
Tooltip = CreateWindowEx_(0, "ToolTips_Class32", "", #WS_POPUP | #TTS_NOPREFIX | #TTS_BALLOON, 0, 0, 0, 0, WindowID(WindowNumber), 0, GetModuleHandle_(0), 0)
SendMessage_(Tooltip, #TTM_SETTIPTEXTCOLOR, GetSysColor_(#COLOR_INFOTEXT), 0)
SendMessage_(Tooltip, #TTM_SETTIPBKCOLOR, GetSysColor_(#COLOR_INFOBK), 0)
SendMessage_(Tooltip, #TTM_SETMAXTIPWIDTH, 0, 180)
Balloon\cbSize = SizeOf(TOOLINFO)
Balloon\uFlags = #TTF_IDISHWND | #TTF_SUBCLASS
Balloon\hwnd = GadgetID(GadgetNumber)
Balloon\uId = GadgetID(GadgetNumber)
Balloon\lpszText = @Text
SendMessage_(Tooltip, #TTM_ADDTOOL, 0, @Balloon)
ProcedureReturn Tooltip
EndProcedure
; ---------------------------------- FIN D'INCLUDE ------------------------------------:
Code : Tout sélectionner
; **************************************************************************;
; Exemple de GESTION d'un FICHIER à ACCES DIRECT sur DISQUE Vers.: 1.0 ;
; ---------------+----------------------------------------------------------;
; Auteur : GeBonet (et merci à Wilbert pour MK...CV.. ) ;
; Mise en oeuvre : 01/11/2011 ;
; Dern. Update : 11/11/2011 ************************* ;
; PureBasic 4.6 : *** EcritureDirect.pb *** ; ;
; XpPro,Windows 7: ************************* ;
; ************ +----------------------------------------------------------;
; ATTENTION : A compiler avec UNICODE décoché dans "Options du compilateur";
; ************ +----------------------------------------------------------;
; **************************************************************************;
;{ -------+---------------------------------------------------------------------------/
; Le problème pour créer un bloc de donnée de longueur fixe provient du fait de la
; conversion des valeurs numériques qu'il soit entier ou double prècision et les autres.
; Il faut qu'ils aient des longueurs fixes. C'est ce que font les procedures crées par
; "wilbert" du forum officiel. A partir de là il "suffit" de composer l'enregistrement
; en fonction du "Type(i)" et de la longueur octroyé pour chaque donnée.
;
; Fichier à ACCES DIRECT de longueur fixe sur DISQUE :
; ----------------------------------------------------
; C'est simplement une autre forme de possibilité d'accèder au données .
;
; Avantages :
;
; - Sur de très gros fichier, ne pas avoir à charger tout le fichier en mémoire
; - D'accèder à l'enregistrement "N°" directement sans devoir lire les autres...
; - Pouvoir travailler à plusieurs sur un même fichier en verrouillant l'enregistrement
; sur lequel on travaille (Mise à jours) et en laissant les autres en libre accès.
; - Pouvoir mettre à jours n'importe quel enregistrement sans devoir déplacer les autres
; (c'est une pile de blocDATA$ de même et identique longueur... )
; - Ajouter / Supprimer des enregistrements sans aucun déplacement des autres...
; Dans ce cas il est préférable d'avoir une bonne gestion des enregistremets occupés ou
; libres via une Bitmap par exemple ou chaque BIT représente l'occupation 1, ou libre 0.
; Ce type de gestion évite les trous, l'expension inutile du fichier tout en maintenant
; un accès contrôlé, direct et rapide à n'importe quel enregistrement.
;
; Inconvénient / Désavantage majeur
;
; - La longueur fixe de l'enregistrement !
; - En conséquence prédetermination obligatoire des longueurs des champs
; - N'existe pas de système de base de conversion pour les valeurs numérique dans PB
; tel Que par exemple : MKI, MKL, MKF, MKD, MKQ et CVI, CVL, CVF, CVD, CVQ)
;
; ---------------------------------------------------------------------
; - DONNEES UTILES POUR LA GESTION D'UN TEL FICHIER !
; ---------------------------------------------------------------------
; - S T R U C T U R E de l'Enregistrement ZERO (Init Secteur)
; ---------------------------------------------------------------------
; Cet enregistrement doit avoir une structure fixe minimum avec des infos de bases
; tel que par EXEMPLE :
;
; ; Structure Record_Zero
; ; Position ; Type de fichier
; ; NatureFILE.b ; #File_Check = 0 ; Type de fichier
; ; RecordNumber.l ; #File_RecNumber = 1 ; Nombre d'enregistrement
; ; LongRECORD.l ; #File_LengRecord = 5 ; Longueur de l'enregistrement
; ; CreationDate.l ; #File_CreationDate = 9 ; Date de création
; ; LastAccessDate.l ; #File_LastAccessDate = 13 ; Date dernier accès
; ; ChampDeLaClef.l ; #File_KeyRecord = 17 ; Champs qui contient la clef d'accès principale
; ;** TailleBitMap.l ; #File_BitMap = 21 ; Optionnel si utile.... (nombre d'enregistrement)
; ; FlagReserve.s{15} ; #File_Reserve = 25 ; Chaine de caractères variable mais < que "LongRECORD"
; ;
; ; EndStructure
; ; Global mon.Record_Zero
; ---------------------------
; NOTE : Forme qui pourrait s'appliquer à toute forme de fichier voir
;
; Codes "NatureFILE.b" (premier Byte)
; -----------------------------------
; 0 = Séquentiel
; 1 = Direct avec enregistrement de longueur FIXE
; 2 = Direct avec enregistrement de longueur VARIABLE
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; - La longueur ou taille du fichier peut être connue par : File_Size.l =Lof(NoFile)"
; - Et le dernier enregistrement par LastRecord.l=File_Size-LengRecord
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; - L'accès à un enregistrement est donné par :
;
; ON A : #Max_Premier=SizeOf(Record_Zero) ; Taille de l'enregistrement Zéro ! (voir ci-après)
; #Premier_REC=#Max_Premier+LongueurBitMap+1; Position du premier enregistrement
;
; ** Si TailleBitMap existe il faudra ajouter à #Max_Premier + (TailleBitMap x LongRECORD)
; en effet il faut créer "TailleBitMap" enregsitrements pour constituer la BitMap en sachant
; que pour chaque Byte on contrôle 8 bit donc 8 enregistrements...
; d'ou : 128 bytes = 1024 enregsitrements, 256=>2048, 512=>4096, 1024=>8192 etc...
; et si on à plusieurs enregistrement on multiplie par autant. Ainsi par exemple :
; si nous avons 5 enregsitrements de 1024 = 5120 Bytes cela contrôle 40960 enregistrements
; et le premier enregistrement commencerais à : Position= LongTOT x (No-1)+ #Premier_REC
; avec #Premier_REC = #Premier_REC + (5 x 1024) => #Premier_REC + 5096
;
; SI : No = le numéro d'enregistrement
; ET : LongTOT = sa Longueur
; ALORS : Position= LongTOT x (No-1)+ #Premier_REC (y inclus s'il y a lieu (TailleBitMap x LongRECORD))
; : d'ou "FileSeek(#File,Position)" permet de lire les "LongTOT" bytes suivants correspondant à
; : l'enregistrement "No"
;}
;
;{- Attribution du répertoire Rep$ -
Global Rep$ ; Localisation de l'application
Rep$= GetPathPart(ProgramFilename()) ; Le programme actuel se trouve ICI
SetCurrentDirectory(Rep$) ; On fixe le répertoire
;}
; - - - - - - - - - - - - - - - - - - - - - - - - - - -
EnableExplicit
;
; ------------------------------------------
XIncludeFile "IncLectureDirect.pbi"
; ------------------------------------------
;
Nature = 1 ; Nature du fichier
NoFile = 1 ; No du Fichier
NoKey = 1 ; Champ contenant la clef si il y a lieu
NbChamp = 8 ; Nombre de champs
NbRecord=10 ; Nombre d'enregistrement (en réalité donné par le Secteur ZERO du fichier)
LongTOT = 0 ; Longueur du bloc de donnée ou enregistrement !
;
; - Initialisation des paramètres de codage -
;
ReDim Type(NbChamp) ; Tableau des types de données dans le fichier...
ReDim Long(NbChamp) ; Tableau des longueur de champs dans le fichier...
ReDim Champ$(NbChamp) ; Tableau recevant les données de chaque champs...
;
Restore Carnet1 ;{ A Remarquer : que ces données pourraient venir d'un fichier...
For i=1 To NbChamp ; Pour chaque champ
Read.i Type(i) ; Lecture du Type
Read.i Long(i) ; "" de la longueur
LongTOT+Long(i) ; Cumule dans LongTOT la longueur que devra avoir le bloc de donnée.
Next i;} ; ou taille de l'enregsitrement dans le fichier a acces DIRECT...
;
; ================================================================
; - Exemple de Création de données dans le fichier ci-dessous
; afin d'être lue par le programme de lecture "LectureDirect.pb"
;
NomFichier.s="FichierTestX.dat"
OuvreFichier(NoFile, NomFichier.s, LongTOT)
;
AfficheDebug(); Pendant période de test ...
; *****************************************************************************
; > ------------ >>> ICI ECRITURE DES ENREGISTREMENTS <<<< ----------------'
; ==========================================================
; - - PARTIE 1 Enregistrement des Donnée à partir des DATA
;{ ---------------------------------------------------------
; Partie de création pour tester -- A partir du premier bloc de données
;
; Note : Si ce programme est executé plusieurs fois il ajoute à chaque
; fois les 10 lignes de data ci-dessous...
; -----------------------------------------
;
For i=1 To NbRecord ; -----------------------------------------------------------
For j=1 To NbChamp:Read.s Champ$(j) ; Lecture des données à partir des DATA, normalement à partir
Debug Champ$(j):Next j ; d'une fenêtre de saisie de donnée ou autre....
; -----------------------------------------------------------
Debug "--------------------"
RecNo=i+RecNumber ; On ajoute aux enregistrement existant (RecNumber)
Put(NoFile, RecNo)
Debug "Ecrit No : "+Str(i+RecNumber) ;
Next i
FileSeek(NoFile,DebFichier) ; Relecture du premier enregistrement ...
EcritPremier(); ; pour y écrire le nouvel Etat !!!
;}
End
; -------------------------------------------------------------------------------------:
; 10 lignes de DATA pour faire les TESTS
; -------------------------------------------------------------------------------------:
DataSection ;{
;" 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 "
; Data.s "Sujet" , N1 , "Titre", N2 , "NomFamille", N3 , "Nom Editeur" , "AnnéeCopyright"
; -------------------------------------------------------------------------------------------:
Carnet1:
;{ Type | Longueur | Objet
Data.i 0 , 16 ; "Sujet"
Data.i 1 , 4 ; N1 Long
Data.i 0 , 34 ; "Titre"
Data.i 3 , 5 ; N2 Float
Data.i 0 , 34 ; "NomFamille"
Data.i 4 , 10 ; N3 Double
Data.i 0 , 29 ; "Nom Editeur"
Data.i 6 , 10 ; "AnnéeCopyright"
;}
; ---------------------------------------------------------------------------------------- "
Carnet2: ; Donnée d'exemple correspondant au descripteur ci-dessus pour éviter l'encodage..
;{
Data.s "Histoire","12","Fisionomía histórica de Chile","223.6","Eyzaguirre","31236.17","Editorial universitaria","03/05/1999"
Data.s "Tourisme","62233","Salvador da Bahia : 100 Colorfotos","-556.9","Richter","218915.152","Alpina-Ceú azul de Copacabana","02/06/2000"
Data.s "Poésie de france","2","Oeuvres complètes Tome premier","3265.32","Boileau","25322.60","Hachette","12/06/1830"
Data.s "Vie pratique","128","Manuel scout des arbres","122.125","Vieux Castor","2253.36","Au Lasso (éd. Scoutes)","22/12/1938"
Data.s "Album enfant","6632","Nouvelles aventures du petit diable Malice, Les","832.86","Scheggia","5523.36","Chagor","11/10/1959"
Data.s "Enseignement","23","Allemand sans peine, L","122","Chérel","653.47","Assimil","01/01/1960"
Data.s "Album enfant","692","Album des jeunes 1961, L'","563.85","Collectif","225.33","Sélection du Reader's Digest","18/05/1960"
Data.s "Religion","6","Sainte Bible, La","854.134","Collectif","875.3","Cerf","22/10/1961"
Data.s "Essai","18","Présence de Camus","66532.121","Simon","12.41","Renaissance du livre","26/11/1961"
Data.s "Biographie","956","Napoléon","124.16","Bainville","8965332.22","Librairie générale française","15/08/1965"
;}
EndDataSection;}
Code : Tout sélectionner
; **************************************************************************;
; Exemple de GESTION d'un FICHIER à ACCES DIRECT sur DISQUE Vers.: 1.0 ;
; ---------------+----------------------------------------------------------;
; Auteur : GeBonet (et merci à Wilbert pour MK...CV.. ) ;
; Mise en oeuvre : 01/11/2011 ;
; Dern. Update : 11/11/2011 ************************ ;
; PureBasic 4.6 : *** LectureDirect.pb *** ;
; XpPro,Windows 7: ************************ ;
; ************ +----------------------------------------------------------;
; ATTENTION : A compiler avec UNICODE décoché dans "Options du compilateur";
; ************ +----------------------------------------------------------;
; **************************************************************************;
;{- Attribution du répertoire Rep$ -
Global Rep$ ; Localisation de l'application
Rep$= GetPathPart(ProgramFilename()) ; Le programme actuel se trouve ICI
SetCurrentDirectory(Rep$) ; On fixe le répertoire
;}
; - - - - - - - - - - - - - - - - - - - - - - - - - - -
EnableExplicit
;
; ------------------------------------------
XIncludeFile "IncLectureDirect.pbi"
; ------------------------------------------
;
NoFile = 1 ; No du Fichier
NoKey = 1 ; Champ contenant la clef si il y a lieu
NbChamp = 8 ; Nombre de champs
NbRecord=10 ; Nombre d'enregistrement (en réalité donné par le Secteur ZERO du fichier)
LongTOT = 0 ; Longueur du bloc de donnée ou enregistrement !
;
; - Initialisation des paramètres de codage -
;
ReDim Type(NbChamp) ; Tableau des types de données dans le fichier...
ReDim Long(NbChamp) ; Tableau des longueur de champs dans le fichier...
ReDim Champ$(NbChamp) ; Tableau recevant les données de chaque champs...
;
; - Exemple de lecture du fichier créer avec "EcritureDirect.pb"
;
Restore Carnet1 ;{
For i=1 To NbChamp ;
Read.i Type(i) ; Lecture du Type
Read.i Long(i) ; "" de la longueur
LongTOT+Long(i) ; Cumule dans LongTOT la longueur que devra avoir le bloc de donnée.
Next i;}
;
NomFichier.s="FichierTestX.dat"
OuvreFichier(NoFile, NomFichier.s, LongTOT)
AfficheDebug() ; Montre l'état du secteur ZERO du fichier
Debug RecNumber
;
; >>>>>>>>>>>>>>>>>>>>>>>>>>> ICI LECTURE DES ENREGISTREMENTS <<<<<<<<<<<<<<<<<<<<<<<<'
;
;{ Phase decodage des enregistrement
Debug "***************************************"
Debug "> Phase DECODAGE Nomale... "
Debug "***************************************"
;
If RecNumber>NbRecord:NbRecord=RecNumber:EndIf
;
For No=1 To NbRecord
;
RecNo=No:Get(NoFile, RecNo)
;
Debug "N° ENregistrement = "+Str(RecNo)
Debug ". . . . . . . . .. .. . . . . . ."
For j=1 To NbChamp
Debug Str(j)+"- "+Champ$(j)
Next j
Debug " -- -- -- -- -- -- -- -- -- "
Next No;}
; ===========================================
;{ Accès Aléatoire aux données du fichier
Debug "================================="
Debug "*-- ACCES ALEATOIRE --*"
Debug "================================="
;
For No=1 To 7
RecNo=Random(NbRecord-1)+1
Get(NoFile, RecNo)
;
Debug "N° ENregistrement = "+Str(RecNo)
Debug ". . . . . . . . .. .. . . . . . ."
For j=1 To NbChamp
Debug Str(j)+"- "+Champ$(j)
Next j
Debug " -- -- -- -- -- -- -- -- -- "
Next No
Debug "***************** Dernier ******************************************************";}
End
; -------------------------------------------------------------------------------------:
; - lignes de DATA pour définir le type et la longueur de chaque Champs(i) -
; -------------------------------------------------------------------------------------:
DataSection ;{
;" 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 "
; Data.s "Sujet" , N1 , "Titre", N2 , "NomFamille", N3 , "Nom Editeur" , "AnnéeCopyright"
; -------------------------------------------------------------------------------------------:
Carnet1:
; Type | Longueur | Objet
Data.i 0 , 16 ; "Sujet"
Data.i 1 , 4 ; N1 Long
Data.i 0 , 34 ; "Titre"
Data.i 3 , 5 ; N2 Float
Data.i 0 , 34 ; "NomFamille"
Data.i 4 , 10 ; N3 Double
Data.i 0 , 29 ; "Nom Editeur"
Data.i 6 , 10 ; "AnnéeCopyright"
EndDataSection;}
; ============================================================================================:
Merci.