Voilà une version plus compléte de la récupération d'un fichier DBASE III + , IV.
Sous cette forme, il faut évidement que le(s) fichier(s) soient dans le répertoire de l'application...
De même les explications des structures des fichiers dBase, fournit à l'adresse donnée par
Code : Tout sélectionner
; ---------------------------------------
; --- Decodage de fichiers DBF !!! ---
; ---------------------------------------
;{- 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
;}
;
Enumeration;{
#Windows
#menu_Ouvrir
#menu_Quitter
#menu_Infos
#Liste
#B1
EndEnumeration ;}
Structure BufferDBS
N1.c ;0 03h Fichier Dbase III+ Valide sans memo .DBT file; 83h Avec memo (.DBT).
AA.c ;1
MM.c ;2
JJ.c ;3
NE.w ;4
NE2.w ;6
LG.w ;8
LG2.w ;10
EndStructure
;
; Tableau pour paramètres...
;
Dim EG$(200)
Dim EN$(200)
Dim EN1$(200)
Dim TP$(200)
Dim PR(200)
Dim NC(320)
;
Declare AfficheInfos(N1,AA,MM,JJ,NE,LG,LG2,NV1)
;
LonBuf=SizeOf(BufferDBS)
;
; NOM des fichiers DBF Disponibles.
; ---------------------------------
; NOMFICH$="CLIENTS"
NOMFICH$="CADRE"
; NOMFICH$="HISTO"
; NOMFICH$="RAPPORT"
; NOMFICH$="VOYAGES"
; NOMFICH$="ARCHI901"
;
RECOMMENCE:
;
NOMFICH$=InputRequester("Ouvrir un fichier DBASE","> Selection du fichier .DBF ","CADRE")
;
OpenFile(#B1,NOMFICH$+".DBF") ; ---------------------------------------
FileSeek(#B1,0) ; Positionne en debut de fichier
; ; ---------------------------------------
N1 =ReadAsciiCharacter(#B1) ; NOMBRE 3 ou 83h ; Indique si il y a mémo ou non (Ouvrir .DBT)
AA =ReadAsciiCharacter(#B1) ; MOIS DE MISE A JOURS ; Byte de 1 de 3
MM =ReadAsciiCharacter(#B1) ; ANNEE DE MISE A JOURS ; Byte de 2 de 3
JJ =ReadAsciiCharacter(#B1) ; JOUR DE MISE A JOURS ; Byte de 3 de 3
NE =ReadLong(#B1) ; Nombre D'Enregistrement ; Byte de 4 à 7 (Long)
LG =ReadWord(#B1) ; Nombre de Byte pour Entete ; Byte de 8 à 9
LG2 =ReadWord(#B1) ; Longueur d'ENREGISTREMENT ; Byte de 10 à 11
NV1 =Int((LG-1)/32)-1 ; Nombre de champs dans l'entête...
; ------------------------------; ---------------------------------------
; -- DBase File Structure -- ;
; ------------------------------; ---------------------------------------
; Sometimes it is necessary To delve into a dBASE table outside the control of the Borland Database
; Engine (BDE). For instance, If the .DBT file (that contains memo Data) For a given table is
; irretrievably lost, the file will Not be usable because the byte in the file header indicates
; that there should be a corresponding memo file. This necessitates toggling this byte To indicate
; no such accompanying memo file. Or, you may just want To write your own Data access routine.
; Below are the file structures For dBASE table files. Represented are the file structures As used For
; various versions of dBASE: dBASE III PLUS 1.1, dBASE IV 2.0, dBASE 5.0 For DOS, And dBASE 5.0 For Windows.
;
; Parfois il est nécessaire de se plonger dans fichier dBASE sans être sous DBASE (hors BDE) de Borland.
; Par exemple, si le fichier ".DBT" (qui contient des données mémo) pour une table donnée est irrémédiablement
; perdu, le fichier ne sera pas utilisable car le byte dans l'entête du fichier indique qu'il devrait y avoir
; un fichier mémo correspondant. Cela nécessite de basculer cet octet pour indiquer aucun fichier qu'il n'y a
; mémo d'accompagnement. Ou, vous pouvez juste vouloir écrire votre propre routine d'accès aux données.
; Voici les structures des tables des fichiers dBASE. Ceux représenté ici, sont les structures des fichiers
; utilisés par les différentes versions de dBASE, soit : dBase III Plus 1.1, dBASE IV 2.0 et 5.0 et en version
; pour DOS et dBASE 5,0 pour Window.
;
; The table file header:
; ---------------------------
; Byte +Contents+Description
; | |
; 0 | 1 byte |Valid dBASE III PLUS table file (03h without a memo .DBT file; 83h with a memo).
; 1- 3 | 3 bytes|Dernière mise a jours ; dans le format YYMMDD format.
; 4- 7 32-bit nombre d'enregistrement dans la table.
; 8- 9 16-bit nombre de bytes dans toute l'entête (32+les champs et descripteurs)
; 10-11 16-bit Taille d'un enregistrement (Nbr de Bytes).
; 12-14 3 bytes Bytes de Reserve.
; 15-27 13 bytes Reserve pour dBASE III PLUS en réseau.
; 28-31 4 bytes Bytes de reserve.
; 32- n 32 bytes début des les champs et descripteurs, la structure de cette table voir ci-après)
; n+1 1 byte 0Dh Placé comme caractère de fin de champs.
;
; n above is the last byte in the field descriptor Array. The size of the Array depends
; on the number of fields in the table file.
;
; Debug "-----------------------------------------------------------------------------"
; ; 123456789012345678901234567890123456 3 Espace par caractères ?
; Debug "> PREMIER NOMBRE : "+Str(N1)
; Debug "> DERNIERE DATE DE MISE A JOURS : "+Str(JJ)+"/"+Str(MM)+"/"+Str(AA)
; Debug "> NOMBRE D'ENREGISTREMENT : "+Str(NE+NE2)
; Debug "> LONGUEUR DES DESCRIPTEURS : "+Str(LG)
; Debug "> LONGUEUR DES ENREGISTREMENTS : "+Str(LG2)
Debug "> NOMBRE DE VARIABLES : "+Str(NV1)
;
; =======================================================
; Decodage et affichage des champs et paramètres associés.
; =======================================================
;
If NE+NE2>200
ReDim EN$(NE+NE2+100)
ReDim EG$(NE+NE2+100)
EndIf
;
; Table Field Descriptor Bytes
; ----------------------------
; Byte Contents Description
; ----------------------------
; 0-10 11 bytes Field name in ASCII (zero-filled).
; 11 1 byte Field type in ASCII (C, D, L, M, Or N).
; 12-15 4 bytes Field Data address (address is set in memory; not useful on disk).
; 16 1 byte Field length in binary.
; 17 1 byte Field decimal count in binary.
; 18-19 2 bytes Reserved For dBASE III PLUS on a LAN.
; 20 1 byte Work area ID.
; 21-22 2 bytes Reserved For dBASE III PLUS on a LAN.
; 23 1 byte SET FIELDS flag.
; 24-31 1 byte Reserved bytes.
;
#Debut_Descripteur=32 ; Taille Secteur 0
; ------------------------------------------
NCar =32 ; Buffer de dépard ou taille de la structure des champs...
Ndecal=0 ; Decallage à 0
LG_Fentre=0
For i=1 To NV1 ; Pour tout les champs on récupère les entêtes et taille des champs.
EN$=Space(NCar) ; ------------------------------------------------------------------
FileSeek(#B1,#Debut_Descripteur+Ndecal) ; Positionne le pointeur et prepare un espace de "NCar"
ReadData(#B1, @EN$,NCar); ; Pour y lire le nom du champs sur 11 Bytes
FileSeek(#B1,#Debut_Descripteur+Ndecal+11); Type de Champ en ASCII
TP$=Chr(ReadCharacter(#B1)) ; Type de donnée = (C, D, L, M, Or N): "+TP$
FileSeek(#B1,#Debut_Descripteur+Ndecal+12); 4 bytes pour ladresse de champs de donnée
PR.l=ReadLong(#B1) ; ">> Enregistrement ici : "+Str(PR)
FileSeek(#B1,#Debut_Descripteur+Ndecal+16); >> 1 byte Field length in binary.
NC=ReadAsciiCharacter(#B1) ; ">> Carcactère du champ : "+Str(NC)
; ;
EG$(I)=EN$:TP$(I)=TP$:PR(i)=PR:NC(i)=NC ; Création des tables de paramètres
Ndecal+NCar ; Incrémente le décallage ....
; ;
Next i
; ---------------
; Table Records
; ---------------
; The records follow the header in the table file. Data records are preceded by one byte,
; that is, a Space (20h) If the record is Not deleted, an asterisk (2Ah) If the record is
; deleted. Fields are packed into records without field separators or record terminators.
; The End of the file is marked by a single byte, With the End-of-file marker, an OEM code
; page character value of 26 (1Ah). You can input OEM code page Data As indicated below.
; ----------
; Les enregistrements suivent la table des entêtes dans le fichier. Enregistrements de données
; qui sont précédées par un octet, soit un espace (20h) si l'enregistrement n'est pas supprimé,
; un astérisque (2Ah) si l'enregistrement est supprimé. Les champs de l'enregsitrement sont inclus
; dans ce qui constitue alors un bloc sans séparateurs de champ ni de fin d'enregistrement.
; Seul la fin du fichier est marqué par un octet de fin de fichier, qui est le caractère 26 (1Ah).
;
; --------------------------------------
; Allowable Input For dBASE Data Types
; --------------------------------------
; Data Type Data Input
;
; C (Character) All OEM code page characters.
; D (Date) Numbers And a character To separate month, day, And Year (stored internally
; As 8 digits in YYYYMMDD format).
; N (Numeric) - . 0 1 2 3 4 5 6 7 8 9
; L (Logical) ? Y y N n T t F f (? when Not initialized).
; M (Memo) All OEM code page characters (stored internally As 10 digits representing a .DBT block number).
; ----------------------------------
;
; Binary, Memo, And OLE Fields And .DBT Files
;
; Memo fields store Data in .DBT files consisting of blocks numbered
; sequentially (0, 1, 2, And so on). The size of these blocks are internally set
; To 512 bytes. The first block in the .DBT file, block 0, is the .DBT file header.
; Memo field of each record in the .DBF file contains the number of the block (in OEM
; code page values) where the field's data actually begins. If a field contains no data,
; the .DBF file contains blanks (20h) rather than a number.
;
; When Data is changed in a field, the block numbers may also change And the number in
; the .DBF may be changed To reflect the new location.
;
; This information is from the Using dBASE III PLUS manual, Appendix C.
; ----------
; Les données du champs Mémo sont rangées dans le fichier ".DBT" constitués de blocs numérotés
; séquentiellement (0, 1, 2, et ainsi de suite). La taille de ces blocs sont en interne définie
; à 512 octets. Le premier bloc dans le fichier ".DBT", le bloc 0, est l'entête du fichier.
; Chaque Champ Mémo de l'enregistrement du fichier ".DBF" contient le numéro du bloc (en valeurs page
; de code OEM) où les données du champ commence réellement dans le ".DBT". Si un champ ne contient pas
; de données, le fichier ".DBF" contient des blancs (20h), plutôt que d'un nombre.
;
; Lorsque les données sont modifiées dans un champ, les numéros de blocs peuvent aussi changer Et le
; nombre dans la DBF. Peut être modifié pour refléter le nouvel emplacement.
;
; Ces informations sont tirées du manuel utilisateur dBASE III PLUS, l'annexe C.
;
; ---------------------------------------------------------------------
; Affichage .....
; ==============================================================
Debut_Donnee=LG+1 ; Début de lecture des données du fichier
Position =NE ;
Ndecal =0 ;
; ----------------;---------------
If LG<300:w_main_width = 600 ; Etablit un minimum...
Else:w_main_width =LG*2:EndIf
w_main_height = 590
ValOptions | #PB_Window_ScreenCentered|#PB_Window_SystemMenu ;|#PB_Window_SizeGadget
w_main_nr = OpenWindow(#PB_Any,0,0,w_main_width,w_main_height,"Lecture de "+nomFichier$,ValOptions);}
;{ ---------------------- Menu Barre ----------------------------------------------------
If CreateMenu(0,WindowID(w_main_nr)) ; Le Menu
MenuTitle("Fichier")
MenuItem(#menu_Ouvrir,"Ouvrir")
MenuItem(#menu_Quitter,"Quitter")
MenuTitle("Aides/Infos")
MenuItem(#menu_Infos,"Informations")
EndIf
; ---------------------- Status Barre ----------------------------------------------------
Lgww=ww/3-10
CreateStatusBar(0,WindowID(w_main_nr))
AddStatusBarField(150)
AddStatusBarField(200)
AddStatusBarField(#PB_Ignore)
; -------------------------------------------------------------------------
Statu01$=" Nombre de Champs : "+Str(NV1)+".."
Statu02$=" Nombre d'enregistrements : "+Str(NE)+".."
StatusBarText(0, 0, Statu01$)
StatusBarText(0, 1, Statu02$)
Aff$="Taille fenetre X="+Str(WindowWidth(w_main_nr))+" Y="+Str(WindowHeight(w_main_nr))
StatusBarText(0, 2, Aff$)
;}
; -------------------------- La grille des données ------------------------------------
;{ PART 1 <<< ENTETE >>>
For j=1 To NV1 ; Première Ligne et première colonne... ENTETE
LgCol=NC(J)*6:If LgCol<LgColP:LgCol=LgColP:Else:LgColP=LgCol:EndIf
If J=1
Caract=0
Caract | #PB_ListIcon_GridLines | #PB_ListView_ClickSelect
Caract | #PB_ListIcon_FullRowSelect | #PB_ListIcon_FullRowSelect
Caract | #PB_ListIcon_AlwaysShowSelection
Mot$=EG$(j); "Colonne "+Str(j)
list_nr = ListIconGadget(#PB_Any,5,5,w_main_width-10,w_main_height-50, Mot$+":",LgCol ,Caract)
Else
Mot$=EG$(j):; "Colonne "+Str(j)
AddGadgetColumn(list_nr, j ,Mot$+":",LgCol) ; 150) ;
EndIf
Next j;}
; - - - - - - - - - - - - - - - -
; - Decode et extrait les enregistrements -
;{- - - - - - - - - - - - - - - -
For i=1 To NE
Enregistrement$=Space(LG2)
FileSeek(#B1,Debut_Donnee+Ndecal)
ReadData(#B1, @Enregistrement$,LG2):Ndecal+LG2
Enreg$=Enregistrement$: En1$=""
For j=1 To NV1
En1$+Left(Enreg$,NC(j)):If j<NV1:En1$+Chr(10):EndIf
Enreg$=Mid(Enreg$,NC(j)+1)
If TP$(j)="D" ; Type Date ...
DAT$=Mid(En1$,7,2)+"/"+Mid(En1$,5,2)+"/"+Left(En1$,4):En1$+DAT$
ElseIf TP$(j)="N" ; Type numérique
RSet(En1$,NC(j)," ")
ElseIf TP$(j)="M" ; Type Mémo...
EndIf
Next j
ChaineBloc$=En1$
AddGadgetItem (list_nr, -1, ChaineBloc$) ; AJOUT <<<===========
Next i;}
; Attente pour la fenetre affichée....
Repeat
Event = WaitWindowEvent()
EvWin = EventWindow()
EvGad = EventGadget()
EvTyp = EventType()
EvMenu= EventMenu()
;
Select Event
Case #PB_Event_Menu
Select EvMenu
Case #menu_Ouvrir ; "Ouvrir"
CloseFile(#B1)
Goto RECOMMENCE ; Recommence le programme
Case #menu_Quitter ; "Quitter"
Debug "Quitter..."
event =#PB_Event_CloseWindow
Case #menu_Infos ;"Informations"
Debug "Information ..."
AfficheInfos(N1,AA,MM,JJ,NE,LG,LG2,NV1)
EndSelect
Case #PB_Event_Gadget
Select EvGad
;
; Case #Button_1 ;
; Case #Button_2 ;
; Case ......._n ;
; Case #Button_9 ;
EndSelect
; StatusBarText(#StatusBar_0, 0,"> Observation 1= "+Str(0))
; StatusBarText(#StatusBar_0, 1,"> Observation 1= "+Str(1))
; StatusBarText(#StatusBar_0, 2,"> Observation 1= "+Str(2))
; StatusBarText(#StatusBar_0, 3,"> Observation 1= "+Str(3))
Case #PB_Event_CloseWindow
Break
;
EndSelect
Until event =#PB_Event_CloseWindow
;
; ==============================================================
;
; ********* Forme avec Debug ***********
; (Retirer les Commentaires (;) )
; ==============================================================
; Debug "-------------------------------------------------------------------------------------"
; Debug "No.. - Entete colonne * Type * Precent * Nombre caractères"
; Debug "----- ------------------------ ------ ---------- -------------------------------"
; LG_Fentre=0
; For i=1 To NV1
; Debug Str(i)+"- "+Left(EG$(i)+"###########################",15)+" : "+TP$(i)+" : "+Str(PR(i))+" : "+Str(NC(i))
; Next i
; ;
; Debug "-----------------------------------------------------------------------------"
; Debut_Donnee=LG+1 ; Début de lecture des données du fichier
; Position =NE ;
; Ndecal =0
; ; - - - - - - - - - - - - - - - -
; ; - Decode et extrait les enregistrements -
; ; - - - - - - - - - - - - - - - -
; For i=1 To NE
; ;
; Enregistrement$=Space(LG2)
; FileSeek(#B1,Debut_Donnee+Ndecal)
; ReadData(#B1, @Enregistrement$,LG2):Ndecal+LG2
; EN$(i)=Enregistrement$
; Debug RSet(Str(i),2,"0")+" : "+Enregistrement$+" ==> "+Str(Len(Enregistrement$))
; Enreg$=EN$(i):
; Debug "----------------"
; For j=1 To NV1
; En1$(j)=Left(Enreg$,NC(j)):Enreg$=Mid(Enreg$,NC(j)+1)
; If TP$(j)="D"
; DAT$=Mid(En1$(j),7,2)+"/"+Mid(En1$(j),5,2)+"/"+Left(En1$(j),4):En1$(j)=DAT$
; EndIf
; Debug Str(Nc(j))+" :"+En1$(j)
; Next j
; Debug "----------------"
; Next i
; -- - --
CloseFile(#B1)
End
; -- - --
; *************************************************************************************
Procedure AfficheInfos(N1,AA,MM,JJ,NE,LG,LG2,NV1)
#Text_1=101: #Text_2=102: #Text_3=103
#Text_4=104: #Text_5=105: #Text_6=106
#Window2=110:#StringGad=111
;
If N1=3 : Fichier$="Type DBF":Else:Fichier$="Type DBF + DBT":EndIf
ValOptions | #PB_Window_ScreenCentered|#PB_Window_SystemMenu
If OpenWindow(#Window2,0,0,450,200,"Information sur le fichier : "+nomFichier$,ValOptions);
TextGadget(#Text_1, 20, 20, 340, 20, "> PREMIER NOMBRE (3=DBF, 83h=DBT aussi)")
TextGadget(#Text_2, 20, 50, 340, 20, "> DERNIERE DATE DE MISE A JOURS ")
TextGadget(#Text_3, 20, 80, 340, 20, "> NOMBRE D'ENREGISTREMENT ")
TextGadget(#Text_4, 20, 110, 340, 20, "> LONGUEUR DES DESCRIPTEURS ")
TextGadget(#Text_5, 20, 140, 340, 20, "> LONGUEUR DES ENREGISTREMENTS ")
TextGadget(#Text_6, 20, 170, 340, 20, "> NOMBRE DE CHAMPS ")
StringGadget(#StringGad+1,350, 20, 60, 20, Str(N1),#PB_Text_Right)
StringGadget(#StringGad+2,350, 50, 60, 20, Str(JJ)+"/"+Str(MM)+"/"+Str(AA),#PB_Text_Right)
StringGadget(#StringGad+3,350, 80, 60, 20, Str(NE),#PB_Text_Right)
StringGadget(#StringGad+4,350,110, 60, 20, Str(LG),#PB_Text_Right)
StringGadget(#StringGad+5,350,140, 60, 20, Str(LG2),#PB_Text_Right)
StringGadget(#StringGad+6,350,170, 60, 20, Str(NV1),#PB_Text_Right)
EndIf
Repeat
Event = WaitWindowEvent()
Until event =#PB_Event_CloseWindow
CloseWindow(#Window2)
EndProcedure
;
;
