Bonjour,

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 et qu'ils existent... Je ne vérifie pas !

De même les explications des structures des fichiers DBASE !

Extension au sujet a l'adresse : ICI
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
; ********************************
; ---  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"   <=CELUI-CI EST ACTIF PAR DEFAUT 
;  NOMFICH$="HISTO"
;  NOMFICH$="RAPPORT"
;  NOMFICH$="VOYAGES"
;  NOMFICH$="ARCHI901"
;
RECOMMENCE:
;
NOMFICH$=InputRequester("Ouvrir un fichier DBASE","> Selection du fichier .DBF ",NOMFICH$)
;
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 "-----------------------------------------------------------------------------"
; ;  
; 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
;
;
Voilà, voilà !