ACCES AU FORMAT DBF

// Auteur : eric Launay 2002
// 
// contact : eric.launay@numericable.fr

// dans le fichier principal, ajouter {$i dbase.pas } pour inclure les fonctions de ce fichier
// declarer en constante nb= nombre de fichier dbf ouverts simultanement
// ensuite, ouvrir le fichier dbf : 
// ex: ouvrir_table('\hello.dbf',1)
// le nom du fichier doit inclure le chemin, 1 = numero du fichier par rapport à nb ( maximum )
// Cela permet l'analyse du fichier DBf ( champs.... )
// Nombre de champs detectés stocké dans nombre_champs[no_f]
// note : maximum 18 ici
//
// Ensuite executer debut_table(1); 
// place le pointeur au debut du fichier, après entete
// lire_table(1);
// stocke les infos des differents champs dans le tableau table_colonnes[no_f,no_c] 
// no_f= no du fichier ( ex ici : 1) 
// no_c= No de la colonne ( ou champs ) max 18 dans cette version
// 
// la fonction fin_table(no_f) teste la fin du fichier 
// renvoi true si oui / false sinon

// ceci a été testé et marche bien avec certains fichiers DBF, contenant du texte uniquement
// et peut surement etre amélioré.
// En tout cas, ca m'a évité d'utiliser les composants Borland ou Microsoft

{ parametres pour fichiers dbf }

var
  nombre_champs:array[1..nb] of integer;
  longueur_champs:array[1..nb,1..18] of integer;
      {18 colonnes max }
  depart:array[1..nb] of integer;
  ligne:array[1..nb] of integer;
  table_colonnes:array[1..nb,1..18] of string;
  no_fichier:array[1..nb] of integer; { no fichier ouvert }
  limite_table:array[1..nb] of longint; { eviter depassement table : longint }

procedure ouvrir_table(var m:string;n:integer);

 { structure des fichiers dbf :

     entete  : 2 lignes de 16 car.

             definitions des champs

     donnees : 2 lignes de 16 car.   -> 1  NOM du champ + ???
                                     -> 2 taille du champs(1er car)+????
          .................................

     Si le le premier caractere du nom du champ= return ( chr 13 )
     alors fin de la definition des champs

     soit :          ????????????????     entete
                     ????????????????

                     NOM ????????????     Definition des champs
                     T???????????????     T=taille ( 1 caractere )
                     NOM ????????????
                     T???????????????
                     F xxxxxxxxxxxxxx     F chr(13)+chr(10)+ chr(32)
                       ^                  xxx début des donnees

     Ici, debut= 2 (nbre champs) * 32 (blocs) + 2 ( chr13+chr10 ) + chr(32)    }



var pos,l,i:integer;
    car:char;


begin
     no_fichier[n]:=fileopen(m,fmOpenRead);  { en lecture seulement }
     limite_table[n]:=fileseek(no_fichier[n],0,2); { fin de la table }
     pos:=1;
     l:=0;
     fileseek(no_fichier[n],48,0);    { debut de table }
     repeat
           fileread(no_fichier[n],car,1); { on lit 1 caractere }
           longueur_champs[n,pos]:=ord(car);
           fileseek(no_fichier[n],15,1); { ligne suivante, 16- 1 car. }
           fileread(no_fichier[n],car,1); { voir si chr 13 }
           if car<>chr(13)then
           begin
                pos:=pos+1;
                fileseek(no_fichier[n],15,1); { ligne suivante, 16- 1 car.}
           end;
     until (car=chr(13));
     nombre_champs[n]:=pos;
     fileread(no_fichier[n],car,1);
     fileread(no_fichier[n],car,1);
     if car=chr(32)
        then depart[n]:=(pos+1)*32+2
             { fichier dbase correct }
        else depart[n]:=(pos+1)*32+1;
             { fichier modifié par excel, pas de chr(32) }
     for i:=1 to nombre_champs[n] do
         l:=l+longueur_champs[n,i];
     ligne[n]:=l+1;
end;


procedure debut_table(n:integer);

begin
       fileseek(no_fichier[n],depart[n],0);
end;

procedure lire_table(n:integer);

var i,x:integer;
    donnee:string;
    s:array[1..255] of char;
begin
     donnee:='';
     fileread(no_fichier[n],s,ligne[n]);
     for i:=1 to (ligne[n]-1) do
         donnee:=donnee+s[i+1];
     x:=1;
     for i:=1 to nombre_champs[n] do
     begin
          table_colonnes[n,i]:=copy(donnee,x,longueur_champs[n,i]);
          x:=x+longueur_champs[n,i];
     end;
end;

function fin_table(n:integer):boolean;

var i:longint;

begin
	i:=fileseek(no_fichier[n],0,1); { teste si le eof=vrai }
	if (i=limite_table[n])
		then fin_table:=true
		else fin_table:=false;
end;