Lecture directe de fichier DBF (DBase)

Bonjour

J'ai souvent (malheureusement) besoin de connaître la structure d'un fichier DBase (champs, types de champs, etc.).
Pour obtenir facilement ces informations, je viens de terminer (aux éventuels bugs non détectés près) un petit utilitaire qui lit directement les fichiers DBF pour en extraire la structure. L'avantage est qu'il indique également le nombre de lignes marquées "deleted" qui ne servent plus à rien mais qui prennent quand même de la place. Par contre, il ne lit pas les données parce que ça ne m'était pas utile.

Je précise qu'il s'agit bien d'une lecture directe (par un TFileStreaam) sans utilisation de BDE ou ODBC.

Si ça intéresse quelqu'un, je donne le code source à qui le veut. C'est codé en XE7 avec un TClientDataset pour afficher et imprimer les résultats.

Merci papy214,
est ce que l'on ne peut pas aussi lire les fichiers DBF avec Excel ?

Mais surement moins bien ? (pas d'index, pas d'enregistrement supprimés , ...)

et on a surement pas la structure de la BD ?

sinon il y a des trucs comme DBFViewer. Est ce que ton outil est plus complet ?

A+
Charly

Comme je l'ai dit, c'est un outil tout simple qui n'a rien à voir avec ce genre d'outils.
Il ne fait que lire et afficher la structure sans outil supplémentaire.
Pour info, je l'ai fait à partir du contenu du site : http://www.independent-software.com/...le-format.html

L'outil ne fait qu'utiliser le code suivant à utiliser à votre guise :

Code:

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
 
unit UnitReaderDBF;
 
interface
 
uses
  System.SysUtils, System.StrUtils, System.Classes, System.IOUtils, System.DateUtils,
  Data.DB;
 
type
 
  TDBF = record
    Version: Byte;
    LastUpdateDate: array [0 .. 2] of Byte;
    TotalRecord: UInt32;
    TotalBytesInHeader: UInt16;
    TotalBytesInRec: UInt16;
    Reserved: array [0 .. 19] of Byte;
  end;
 
  TFieldDesc = record
    FieldName: string;
    FieldType: string;
    FieldDataAddr: UInt32;
    FieldLength: Byte;
    FieldDecimalCount: Byte;
    Reserved: array [0 .. 13] of Byte;
  end;
 
  TReaderDBF = class(TObject)
  private
    FFilename: string;
    DBF: TDBF;
    Flds: array of TFieldDesc;
    FTotalDeleted: NativeUInt;
    FSizeBytes: NativeInt;
    function GetVersion: string;
    function GetLastUpdate: TDate;
    function GetTotalBytesInRec: UInt16;
    function GetTotalRecord: UInt32;
    function GetFields(Idx: NativeInt): TFieldDesc;
    procedure SetFields(Idx: NativeInt; const Value: TFieldDesc);
    function GetTotalBytesInHeader: UInt16;
    function GetFieldCount: NativeInt;
    function GetSizeOfRec: NativeUInt;
  public
    constructor Create;
    procedure LoadFromFile(Filename: string);
    property Filename: string read FFilename write FFilename;
    property Version: string read GetVersion;
    property LastUpdate: TDate read GetLastUpdate;
    property TotalRecord: UInt32 read GetTotalRecord;
    property TotalBytesInRec: UInt16 read GetTotalBytesInRec;
    property TotalBytesInHeader: UInt16 read GetTotalBytesInHeader;
    property TotalDeleted: NativeUInt read FTotalDeleted;
    property Fields[Idx: NativeInt]: TFieldDesc read GetFields write SetFields;
    property FieldCount: NativeInt read GetFieldCount;
    property SizeOfRec: NativeUInt read GetSizeOfRec;
    property SizeBytes: NativeInt read FSizeBytes;
  end;
 
implementation
 
{ TReaderDBF }
 
constructor TReaderDBF.Create;
begin
  inherited;
 
end;
 
function TReaderDBF.GetFieldCount: NativeInt;
begin
  Result := Length(Flds);
end;
 
function TReaderDBF.GetFields(Idx: NativeInt): TFieldDesc;
begin
  Result := Flds[Idx];
end;
 
function TReaderDBF.GetLastUpdate: TDate;
begin
  Result := EncodeDate(1900 + DBF.LastUpdateDate[0], DBF.LastUpdateDate[1], DBF.LastUpdateDate[2]);
end;
 
function TReaderDBF.GetSizeOfRec: NativeUInt;
var
  I: NativeInt;
begin
  Result := 0;
  for I := Low(Flds) to High(Flds) do
    Inc(Result, Flds[I].FieldLength);
end;
 
function TReaderDBF.GetTotalBytesInHeader: UInt16;
begin
  Result := DBF.TotalBytesInHeader;
end;
 
function TReaderDBF.GetTotalBytesInRec: UInt16;
begin
  Result := DBF.TotalBytesInRec;
end;
 
function TReaderDBF.GetTotalRecord: UInt32;
begin
  Result := DBF.TotalRecord;
end;
 
function TReaderDBF.GetVersion: string;
begin
  case DBF.Version of
    $2:
      Result := 'FoxBase 1.0';
    $3:
      Result := 'FoxBase 2.x / dBASE III';
    $83:
      Result := 'FoxBase 2.x / dBASE III with memo file';
    $30:
      Result := 'Visual FoxPro';
    $31:
      Result := 'Visual FoxPro with auto increment';
    $32:
      Result := 'Visual FoxPro with varchar/varbinary';
    $43:
      Result := 'dBASE IV SQL Table, no memo file';
    $63:
      Result := 'dBASE IV SQL System, no memo file';
    $8B:
      Result := 'dBASE IV with memo file';
    $CB:
      Result := 'dBASE IV SQL Table with memo file';
    $FB:
      Result := 'FoxPro 2';
    $F5:
      Result := 'FoxPro 2 with memo file';
  end;
end;
 
procedure TReaderDBF.LoadFromFile(Filename: string);
type
  TFldDesc = record
    FieldName: array [0 .. 10] of AnsiChar;
    FieldType: AnsiChar;
    FieldDataAddr: UInt32;
    FieldLength: Byte;
    FieldDecimalCount: Byte;
    Reserved: array [0 .. 13] of Byte;
  end;
var
  F: TFileStream;
  Desc: TFldDesc;
  Ended, Sep: AnsiChar;
  T: NativeInt;
begin
  FFilename := Filename;
  F := TFileStream.Create(Filename, fmOpenRead);
  FSizeBytes := F.Size;
  F.ReadBuffer(DBF, SizeOf(DBF));
 
  while True do
  begin
 
    Ended := #0;
    F.ReadBuffer(Ended, SizeOf(Ended));
    if Ended = #13 then
      Break
    else
      F.Position := F.Position - SizeOf(Ended);
 
    F.ReadBuffer(Desc, SizeOf(Desc));
    SetLength(Flds, Length(Flds) + 1);
    T := High(Flds);
    Flds[T].FieldName := string(Desc.FieldName);
    case Desc.FieldType of
      'C':
        Flds[T].FieldType := 'Character';
      'D':
        Flds[T].FieldType := 'Date';
      'F':
        begin
          Flds[T].FieldType := 'Float';
          Flds[T].FieldDecimalCount := Desc.FieldDecimalCount;
        end;
      'M':
        Flds[T].FieldType := 'Memo';
      'N':
        begin
          Flds[T].FieldType := 'Numeric';
          Flds[T].FieldDecimalCount := Desc.FieldDecimalCount;
        end;
      'L':
        Flds[T].FieldType := 'Logical';
    end;
    Flds[T].FieldDataAddr := Desc.FieldDataAddr;
    Flds[T].FieldLength := Desc.FieldLength;
    Flds[T].FieldDecimalCount := Desc.FieldDecimalCount;
 
  end;
 
  F.Position := DBF.TotalBytesInHeader;
  FTotalDeleted := 0;
  F.Read(Sep, 1);
  while True do
  begin
    if Sep = '*' then
      Inc(FTotalDeleted);
    F.Position := F.Position + SizeOfRec;
    if F.Position >= F.Size then
      Break;
    F.Read(Sep, 1);
  end;
 
  F.Free;
end;
 
procedure TReaderDBF.SetFields(Idx: NativeInt; const Value: TFieldDesc);
begin
  Flds[Idx] := Value;
end;
 
end.

Quand au code qui l'utilise :

Code:

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
 
procedure TForm1.Button1Click(Sender: TObject);
var
  ReaderDBF: TReaderDBF;
  I: NativeInt;
  Filename: string;
begin
  if not PromptForFileName(Filename, 'Fichiers DBase|*.dbf;*.DBF', '.dbf', 'Choix fichier DBF', 'F:\Data\') then
    Exit;
 
  ReaderDBF := TReaderDBF.Create;
 
  Enabled := False;
  Cursor := crHourGlass;
  try
    try
      ReaderDBF.LoadFromFile(Filename);
 
      lbleFichier.Text := Filename;
      lbleVersion.Text := ReaderDBF.Version;
      lbleNbChamps.Text := Format('%d', [ReaderDBF.FieldCount]);
      lbleNbLignes.Text := Format('%d', [ReaderDBF.TotalRecord]);
      lbleNbSupprimes.Text := Format('%d', [ReaderDBF.TotalDeleted]);
 
      Cds.EmptyDataSet;
      for I := 0 to Pred(ReaderDBF.FieldCount) do
        with ReaderDBF.Fields[I] do
          Cds.AppendRecord([FieldName, FieldType, FieldLength, FieldDecimalCount]);
 
      Button2.Enabled := True;
    except
      on E: Exception do
        ShowMessage(E.Message);
    end;
 
  finally
    FreeAndNil(ReaderDBF);
    Enabled := True;
    Cursor := crDefault;
  end;
 
end;

Merci en tout cas de la partager

A+
Charly

Normal ... Après, ce n'est pas parfait mais ça m'a suffit pour ce qu'il me fallait.
Mais si quelqu'un veut le compléter ou l'améliorer, surtout qu'il ne se gène pas :-)