LES FICHIERS DBASE SUR TURBO PASCAL

---

Accédez facilement à vos fichiers DBase sur Turbo Pascal Version 5.5

---

Accédez aux fichiers DBase :

Voici une méthode pour avoir accès aux fichiers DBase III+ ou IV (ou compatible) sur Turbo Pascal. Nous utiliserons la version 5.5 (ou 6.0) du Turbo Pascal pour avoir accès à la programmation orientée objet. L'intérêt est de pouvoir encapsuler les données et les procédures dans un même objet. Ce principe permet à l'utilisateur d'utiliser en même temps autant de fichier DBase qu'il le désire.

Avant de décrire le programme, sous forme d'Unit, nous allons nous pencher sur la structure des fichiers DBase III+ et IV.

Structure des fichiers DBase :

Les fichiers DBase sont composés d'une entête, de la description des champs de données et des enregistrements des données.

L'entête a la structure suivante, de longueur 32 octets :

• Octet 0 (1 octet) : Bits 0-2 = No de version, Bit 7 = 1 si fichier Mémo .DBT,
• Octet 1 à 3 (3 octets) : Date de dernière modification de format AAMMJJ en binaire,
• Octet 4 à 7 (4 octets) : Nombre d'enregistrements (Nombre de 32 bits),
• Octet 8 à 9 (2 octets) : Taille de l'entête et de la description des champs de données (Nombre de 16 bits),
• Octet 10 à 11 (2 octets) : Taille d'un enregistrement de données (Nombre de 16 bits),
• Octet 12 à 13 (2 octets) : Réservé,
• Octet 14 (1 octet) : Indicateur de transaction (DBase IV),
• Octet 15 (1 octet) : Indicateur de cryptage (DBase IV),
• Octet 16 à 27 (12 octets) : Réservés pour le réseau local,
• Octet 28 (1 octet) : Indicateur de fichier d'exploitation,
• Octet 29 à 31 (3 octets) : Réservés.

Suit la description des champs de données, de longueur (n x 32) + 1 octets, avec n le nombre de champs (de 1 à 255) :

• Octet 0 à 11 (11 octets) : Nom du champs de données,
• Octet 11 (1 octet) : Type du champ de données en ASCII (C, N, L , D ou M),
• Octet 12 à 15 (4 octets) : Adresse du champ de données (en mémoire), nombre de 32 bits,
• Octet 16 (1 octet) : Longueur du champ en binaire,
• Octet 17 (1 octet) : Nombre de décimales pour un nombre,
• Octet 18 à 19 (2 octets) : Réservés,
• Octet 20 (1 octet) : Numéro de la zone de travail,
• Octet 21 à 31 (11 octets) : Réservés,
• Octet 32 à N : Description des autres champs de données, selon la structure ci dessus,
• Octet N+1 (1 octet) = 0Dh pour fin de description des champs.

Suivent enfin les enregistrements de données, composés comme suit :

• Chaque enregistrement est précédé d'un octet : 20h (espace) si l'enregistrement n'est pas à effacer et 2Ah (étoile) s'il est à effacer,
• Les enregistrements sont rangés à la suite sans séparateur, ni indicateur de fin d'enregistrement,
• Les données sont rangées selon le format suivant :

Type de données	Stockage
Caractère (C)	Caractère ASCII
Numérique (N)	- . 0 à 9
Logique (L)	? Y N T F *
Mémo (M)	10 octets **
Date (D)	8 octets ***

* ? quand non initialisé,
** Représente le numéro du bloc du fichier .DBT,
*** Format AAAAMMJJ en ASCII, par exemple 19921001 pour le 01 octobre 1992.

Description du programme :

Nous avons vu que l'approche orientée objet permet d'encapsuler les données et les procédures dans un seul et même objet.

Nous allons donc construire un objet DBase avec ses données et ses procédures.

Les données sont en autres l'entête du fichier, la description des champs de données et une variable tampon pour les enregistrements.

Les procédures sont l'ouverture et la fermeture du fichier DBase et toutes les procédures permettants de lire, rechercher ou écrire des enregistrements.

Nous avons vu que l'intérêt de cette encapsulation est de pouvoir utiliser autant de fichier DBase en même temps que possible (dans la limite du DOS bien sûr).

Par exemple pour utiliser trois fichiers DBase en même temps, il suffit d'écrire :

 
 
Var D1,D2,D3 : DBObj;
 
 

Nous allons décrire les procédures du programmes :

L'ouverture du fichier DBase (procedure Open) se fait de la manière suivante :

Après ouverture du fichier au moyen de la fonction Reset, on va lire l'entête du fichier. Nous utiliserons pour cela la procédure du Turbo Pascal BlockRead qui permet de lire d'un seul bloc les données sur disque dans une variable tampon. Ensuite nous lirons de la même manière l'ensemble des descriptions des champs de données. Nous les sauverons dans le tableau Fields. Pour économiser la mémoire au maximum, nous utiliserons un tableau de pointeurs, et nous réserverons seulement la mémoire des champs utilisés.

La fermeture du fichier Dbase (procedure Close) se fait de la manière suivante :

On modifie la date de modification du fichier Dbase, puis on ferme le fichier à l'aide de la procedure Close de l'unité standard du Turbo Pascal System. Enfin on libère la mémoire utilisée par les champs de données.

La procédure Delete permet de marquer un enregistrement à effacer. Pour cela, il faut remplacer le premier octet de l'enregistrement par une étoile (2Ah). Pour la procedure inverse Recall, il faut remplacer le premier octet de l'enregistrement par un espace (20h).

La fonction Version retourne le numéro de version de Dbase. Il faut pour cela retourner les 3 premiers bits du premier octet de l'entête du fichier.

La fonction IsMemo indique si le fichier DBase utilise ou non un fichier Memo .DBT. Il suffit pour cela de retourner le dernier bit du premier octet de l'entête du fichier Dbase.

La fonction RecCount retourne le nombre d'enregistrement du fichier DBase: c'est le nombre de 32 bits à partir du quatrième octet de l'entête. Nous prendrons alors un nombre de type LongInt.

La fonction RecNo retourne le numéro de l'enregistrement en cours : c'est la position du pointeur de ficher moins la longueur de l'entête et de la description des champs, divisé par la longueur d'un enregistrement.

Les fonctions FieldName, FieldType et FieldLength retournent respectivement le nom, le type et la longueur d'un champ de données. Ce sont respectivement le premier, le onzième et le seizième octet du descripteur du champ considéré.

La procedure Skip et Go permettent respectivement de passer à l'enregistrement suivant, ou de se positionner sur un enregistrement quelconque. Pour cela, il faut soit lire l'enregistrement suivant, soit positionner le pointeur de fichier sur l'enregistrement voulu au moyen de la procedure du Turbo Pascal Seek.

La procédure Pack efface tous les enregistrements marqués. Il faut pour cela réécrire le fichier Dbase en oubliant les enregistrements marqués. Cette procédure est beaucoup plus rapide que le Pack de Dbase.

La procédure Zap efface tous les enregistrements du fichier DBase. Elle efface le fichier et en réécrit un nouveau vide.

Les procédures Append et Insert permettent respectivement d'ajouter ou d'insérer des enregistrements. Il faut pour cela positionner le pointeur de fichier à l'endroit voulu puis créer l'enregistrement au moyen de la commande BlockWrite. Pour la procédure Insert, il faudra veiller à déplacer d'un enregistrement tous les enregistrements qui se trouvent Après l'enregistrement à insérer.

Les fonctions Deleted, BOF et EOF indiquent respectivement si l'enregistrement est marqué pour être effacé, si c'est le premier du fichier ou le dernier. Pour cela elles retournent respectivement si le premier octet de l'enregistrement est une étoile (2Ah), si le numéro de l'enregistrement (fonction RecNo) est égale à 1 et si le pointeur de fichier est à la fin du fichier (fonction EOF de l'unité System du Turbo Pascal).

La fonction Get retourne le contenu d'un champ dans l'enregistrement courant, selon le format de stockage DBase indiqué ci-dessus.

La procédure Put modifie le contenu d'un dans l'enregistrement courant. Cette procédure vérifie d'abord la syntaxe selon le type du champ de données avant de modifier l'enregistrement. Un indicateur de modification Modified permet de savoir si un des enregistrements du fichier a été modifié depuis son ouverture.

Enfin la procédure Locate permet de rechercher une chaîne de Caractère dans un des champs du fichier. Nous utiliserons pour cela la fonction Pos du Turbo Pascal.

Le listing de l'unité Dbase est suivit d'un listing d'un programme d'essai de cette unité.

Ce programme permet d'afficher la structure de n'importe qu'elle fichier DBase, ainsi que ses enregistrements, de rechercher une chaîne de caractères parmi les enregistrements, de marquer ou démarquer un enregistrement, et d'effacer les enregistrements marqués.

L'unité qui a été décrite ci-dessus est une ébauche d'une librairie qui pourra être bien plus complète. Elle pourra être complétée entre autres de procédures permettant la lecture des fichiers mémo ainsi que de la gestion de fichier d'index.

Listing de l'unité en Turbo-Pascal

{ +-------------------------------------------------------------------+
 ¦ ACCES AUX FICHIERS DBASE POUR TURBO PASCAL 5.5 ¦
 ¦-------------------------------------------------------------------¦
 ¦ CopyRight (c) 1992 Frédéric HARDY pour Réponse Micro ¦
 +-------------------------------------------------------------------+ }
 
Unit DBASE;
 
Interface
 
Uses DOS;
 
Type DateType = Record
 Year, Month, Day : Byte;
 end;
 
 TypeHeader = Record { -- EN-TETE -- }
 Version : Byte; { No de version DBase }
 Date : DateType; { Date de modification }
 NumRec : LongInt; { Nombre d'enregistrements }
 LenHeader : Word; { Taille de l'entête }
 LenData : Word; { Taille d'un enregistrement }
 Reserve1 : Word; { Réservé }
 Transaction : Byte;  { Indicateur de transaction }
 Crypted : Byte; { Indicateur de cryptage }
 Reserve2 : Array[1..12] of Byte; { Réservés réseau local }
 Exploitation : Byte; { Indicateur de fichier d'expl. }
 Reserve3 : Array[1..3] of Byte; { Résevés }
 end;
 
 FieldDesc = Record { -- DESCRIPTION DES CHAMPS -- }
 Name : Array[1..11] of char; { Nom du champ }
 Typ : Char;  { Type de champ (CDFLMN) }
 Addr : Pointer; { Adresse du champ en mémoire }
 Dim : Byte; { Longeur du champ }
 Dec : Byte; { Nombre de décimales }
 Reserve1 : Word; { Réservé }
 Zone : Byte; { Numéro de zone de travail }
 Reserve2 : Array[1..11] of Byte; { Réservés }
 end;
 
 Str12 = String[12]; { Type pour le nom des champs }
 
 TypeBuffer = Array[0..4000] of char; { Type tampon pour enreg. }
 
 DBObj = Object
 FileName : PathStr; { Nom du fichier }
 Fich : File; { Fichier .DBF }
 DBOk : Boolean; { Indicateur d'erreur }
 Modified : Boolean; { Indicateur de modification }
 Header : TypeHeader; { En-tête du fichier }
 NbFields : Byte; { Nombre de champs }
 Fields : Array [1..255] of ^FieldDesc; { Description des champs }
 Buffer : ^TypeBuffer; { Tampon pour enregistrement }
 
 Procedure Open (Name : PathStr);  { Ouverture du fichier .DBF }
 Procedure Close; { Fermeture du fichier .DBF }
 Procedure Skip; { Enregistrement suivant }
 Procedure Go (N : LongInt); { Aller à l'enreg. N }
 Procedure Delete; { Marque l'enreg. en cours }
 Procedure Recall; { Démarque l'enreg.en cours }
 Procedure Pack; { Efface les enreg. marqués }
  Procedure Zap; { Efface tous les enreg. }
 Procedure Append; { Ajoute un enreg. à la fin }
 Procedure Insert; { Insére un enregistrement }
 Procedure Put (N : Byte; S : String); { Modifie le champ N }
 
 Function Version : Byte; { Retourne le no de version }
 Function IsMemo : Boolean; { Indicateur de fichier Mémo }
 Function IsCrypted : Boolean;  { Indicateur de cryptage }
 Function IsMdx : Boolean; { Indicateur d'exploitation }
 Function RecCount : LongInt; { Retourne le nbre d'enreg. }
 Function RecNo : LongInt; { No de l'enreg. en cours }
 Function FieldName ( N : Byte ) : Str12; { Nom du champ N }
 Function FieldType ( N : Byte ) : Char; { Type du champ N }
 Function FieldLength ( N : Byte ) : Byte; { Longueur du champ N }
 Function Deleted : Boolean; { Enreg. en cours marqué }
 Function Get ( N : Byte ) : String; { Champ N de l'enreg. en cours }
 Function BOF : Boolean; { Début du fichier }
 Function EOF : Boolean; { Fin du fichier }
 Function Locate ( N : Byte; { Recherche d'une chaîne de }
 S : String ) : Boolean; { carac. dans le champ N }
 
 end;
 
Implementation
 
{ +-------------------------------------------------------------------------+
 ¦ ¦
 ¦ OPEN : Ouverture du fichier .DBF ¦
 ¦  ¦
 +-------------------------------------------------------------------------+ }
 
Procedure DBObj.Open;
 
Var j : Byte;
 i : Word;
 
Begin
 j:=1;
 While (j<=Length(Name)) do
 Begin
 Name[j]:=UpCase(Name[j]);
 Inc(j);
 end;
 If pos('.DBF',Name)<>0 Then System.Delete(Name,Pos('.DBF',Name),4);
 FileName := FExpand(Name);
 Modified := False;
 Assign(Fich,Name+'.DBF');
 {$I-} Reset(Fich,1); {$I+}
 DBOk := IOResult=0;
 If Not(DBok) then exit;
 {$I-} BlockRead(Fich,Header,SizeOf(Header)); {$I+}
 DBOk := IOresult=0;
 GetMem(Buffer,Header.LenData);
 NbFields := (Header.LenHeader-33) div 32;
 i := 1;
 For j:=1 to NbFields do
 Begin
 New(Fields[j]);
 {$I-} BlockRead(Fich,Fields[j]^,SizeOf(Fields[j]^)); {$I+}
 DBOk := IOResult=0;
 Fields[j]^.Addr := Addr(Buffer^[i]);
 i := i + Fields[j]^.Dim;
 end;
 Seek(Fich,LongInt(Header.LenHeader));
 {$I-} BlockRead(Fich,Buffer^,Header.LenData); {$I+}
 DBOk := IOResult=0;
End;
 
{ +-------------------------------------------------------------------------+
 ¦ ¦
 ¦ CLOSE : Fermeture du fichier .DBF ¦
 ¦  ¦
 +-------------------------------------------------------------------------+ }
 
Procedure DBObj.Close;
 
Var j : Byte;
 Ye,Mo,Da,Dw : Word;
 
Begin
 If Modified then
 Begin
 GetDate(Ye,Mo,Da,Dw);
 Header.Date.Year := Byte(Ye-1900);
 Header.Date.Month := Byte(Mo);
 Header.Date.Day := Byte(Da);
 Seek(Fich,0);
 BlockWrite(Fich,Header,SizeOf(Header));
 end;
 {$I-} System.Close(Fich); {$I+}
 DBok := IOResult=0;
 For j := 1 to NbFields do Dispose(Fields[j]);
 FreeMem(Buffer,Header.LenData);
End;
 
{ +-------------------------------------------------------------------------+
 ¦ ¦
 ¦ DELETE : Marque l'enregistrement en cours ¦
 ¦ ¦
 +-------------------------------------------------------------------------+ }
 
Procedure DBObj.Delete;
 
Begin
  If Buffer^[0]<>Chr($2A) then
 Begin
 Buffer^[0] := Chr($2A);
 Seek(Fich,FilePos(Fich)-Header.LenData);
 {$I-} BlockWrite(Fich,Buffer^,Header.LenData); {$I+}
 DBOk := (IOResult=0);
 end else DBOk := True;
end;
 
{ +-------------------------------------------------------------------------+
 ¦ ¦
 ¦ RECALL : Démarque l'enregistrement en cours ¦
 ¦  ¦
 +-------------------------------------------------------------------------+ }
 
Procedure DBObj.Recall;
 
Begin
 IF Buffer^[0]<>Chr($20) then
 Begin
 Buffer^[0] := Chr($20);
 Seek(Fich,FilePos(Fich)-Header.LenData);
 {$I-} BlockWrite(Fich,Buffer^,Header.LenData); {$I+}
 DBOk := (IOResult=0);
 end else DBOk := True;
end;
 
 
{ +-------------------------------------------------------------------------+
 ¦  ¦
 ¦VERSION : Retourne le numéro de version DBase du fichier (3 ou 4) ¦
 ¦ ¦
 +-------------------------------------------------------------------------+ }
 
Function DBObj.Version;
 
Begin
 Version := Header.Version and $7;
end;
 
{ +-------------------------------------------------------------------------+
 ¦ ¦
 ¦ ISMEMO : Indique si la base utilise un fichier .DBT ¦
 ¦ ¦
 +-------------------------------------------------------------------------+ }
 
Function DBObj.IsMemo;
 
Begin
 IsMemo := Header.Version and $80 <> 0;
end;
 
{ +-------------------------------------------------------------------------+
 ¦ ¦
 ¦ ISCRYPTED : Indicateur de cryptage ¦
 ¦ ¦
 +-------------------------------------------------------------------------+ }
 
 
Function DBObj.IsCrypted;
 
Begin
 IsCrypted := (Header.Crypted=$01);
end;
 
{ +-------------------------------------------------------------------------+
 ¦ ¦
 ¦ ISMDX : Indicateur de fichier d'exploitation .MDX ¦
 ¦  ¦
 +-------------------------------------------------------------------------+ }
 
 
Function DBObj.IsMdx;
 
Begin
 IsMdx := (Header.Exploitation=$01);
end;
 
 
{ +-------------------------------------------------------------------------+
 ¦ ¦
 ¦ RECCOUNT : Retourne le nombre d'enregistrement de la base ¦
 ¦  ¦
 +-------------------------------------------------------------------------+ }
 
Function DBObj.RecCount;
 
Begin
 RecCount := Header.NumRec;
end;
 
{ +-------------------------------------------------------------------------+
 ¦ ¦
 ¦ RECNO : Retourne le numéro de l'enregistrement en cours ¦
 ¦  ¦
 +-------------------------------------------------------------------------+ }
 
Function DBobj.RecNo;
 
Begin
 RecNo := (FilePos(Fich)-Header.LenHeader) div Header.LenData;
end;
 
{ +-------------------------------------------------------------------------+
 ¦ ¦
 ¦ FIELDTYPE : Retourne le type du champ de donnée N ¦
 ¦ ¦
 +-------------------------------------------------------------------------+ }
 
Function DBObj.FieldType;
 
Begin
 DBOk := True;
 If (N<1) or (N>NbFields) then DBOk := False
 else FieldType := Fields[N]^.Typ;
end;
 
{ +-------------------------------------------------------------------------+
 ¦ ¦
 ¦ FIELDNAME : Retourne le nom du champ de donnée N ¦
 ¦  ¦
 +-------------------------------------------------------------------------+ }
 
Function DBObj.FieldName;
 
Var i : Byte;
 S : Str12;
 
Begin
 DBOk := True;
 S := '';
 i := 1;
 If (N<1) or (N>NbFields) then DBOk := False
 else
 begin
 While (i<11) and (Fields[N]^.Name[i]<>#0) do
 Begin
 S := S + Fields[N]^.Name[i];
 Inc(i);
 end;
 end;
 FieldName := S;
end;
 
 
{ +-------------------------------------------------------------------------+
 ¦  ¦
 ¦ FIELDLENGTH : Retourne la longueur du champ de donnée N ¦
 ¦ ¦
 +-------------------------------------------------------------------------+ }
 
Function DBObj.FieldLength;
 
Var T : Char;
 L : Byte;
 
Begin
 DBOk := False;
 If (N<1) or (N>NbFields) then DBOK := False
 else FieldLength := Fields[N]^.Dim;
end;
 
 
{ +-------------------------------------------------------------------------+
 ¦ ¦
 ¦ SKIP : Passe à l'enregistrement suivant ¦
 ¦  ¦
 +-------------------------------------------------------------------------+ }
 
Procedure DBObj.Skip;
 
Begin
 {$I-} BlockRead(Fich,Buffer^,Header.LenData); {$I+}
 DBOk := IOResult=0;
end;
 
{ +-------------------------------------------------------------------------+
 ¦ ¦
 ¦ GO : Va à l'enregistrement N ¦
 ¦  ¦
 +-------------------------------------------------------------------------+ }
 
Procedure DBObj.Go;
 
Begin
 DBOk := True;
 If (N<0) or (N>Header.NumRec) then DBOk := False else
 Begin
 Seek(Fich,(N-1)*Header.LenData+Header.LenHeader);
 {$I-} BlockRead(Fich,Buffer^,Header.LenData); {$I+}
 DBOk := IOResult=0;
 end;
end;
 
{ +-------------------------------------------------------------------------+
 ¦ ¦
 ¦  PACK : Efface tous les enregistrement marqués ¦
 ¦ ¦
 +-------------------------------------------------------------------------+ }
 
Procedure DBObj.Pack;
 
Var Temp : File;
 i : Byte;
 NbRec, j : LongInt;
 Term : Char;
 
Begin
 Assign(Temp,FileName+'.$$$');
 {$I-} Rewrite(Temp,1); {$I+}
 DBOk := IOResult=0;
 If Not(DBOk) Then Exit;
 BlockWrite(Temp,Header,SizeOf(Header));
 For i:=1 to NbFields do
 BlockWrite(Temp,Fields[i]^,SizeOf(Fields[i]^));
 Term := Chr($0D);
 BlockWrite(Temp,Term,1);
 NbRec := 0;
 Seek(Fich,LongInt(Header.LenHeader));
 For j := 1 to Header.NumRec do
 Begin
 BlockRead(Fich,Buffer^,Header.LenData);
 If Buffer^[0]<>Chr($2A) then
 Begin
 BlockWrite(Temp,Buffer^,Header.LenData);
 Inc(NbRec);
 end;
 end;
 Term := Chr($1A);
 BlockWrite(Temp,Term,1);
 System.Close(Fich);
 System.Close(Temp);
 Erase(Fich);
 Rename(Temp,FileName+'.DBF');
 Header.NumRec := NbRec;
 Modified := True;
 Reset(Fich,1);
 Go(1);
end;
 
{ +-------------------------------------------------------------------------+
 ¦ ¦
 ¦ ZAP : Efface tous les enregistrements de la base ¦
 ¦ ¦
 +-------------------------------------------------------------------------+ }
 
Procedure DBObj.Zap;
 
Var i : Byte;
 Term : Array[1..2] of Char;
 
Begin
 System.Close(Fich);
 {$I-} ReWrite(Fich,1); {$I+}
 DBOk := IOResult=0;
 If Not(DBOk) Then Exit;
 Header.NumRec := 0;
 Modified := True;
 BlockWrite(Fich,Header,SizeOf(Header));
 For i:=1 to NbFields do
 BlockWrite(Fich,Fields[i]^,SizeOf(Fields[i]^));
 Term[1] := Chr($0D);
 Term[2] := Chr($1A);
 BlockWrite(Fich,Term,2);
end;
 
{ +-------------------------------------------------------------------------+
 ¦  ¦
 ¦ APPEND : Ajoute un enregistrement à la fin de la base ¦
 ¦ Il devient l'enregistrement en cours ¦
 ¦  ¦
 +-------------------------------------------------------------------------+ }
 
Procedure DBObj.Append;
 
Var Term : Char;
 
Begin
 Modified := True;
 Inc(Header.NumRec);
 Seek(Fich,FileSize(Fich));
 FillChar(Buffer^,Header.LenData,Chr($20));
  BlockWrite(Fich,Buffer^,Header.LenData);
 Term := Chr($1A);
 {$I-} BlockWrite(Fich,Term,1); {$I+}
 DBOk := (IOResult=0);
end;
 
{ +-------------------------------------------------------------------------+
 ¦  ¦
 ¦INSERT : Insére un enregistrement AVANT l'enregistrement en cours ¦
 ¦ Il devient l'enregistrement en cours ¦
 ¦  ¦
 +-------------------------------------------------------------------------+ }
 
Procedure DBObj.Insert;
 
Var i, r : LongInt;
 Term : Char;
 
Begin
 Modified := True;
 Inc(Header.NumRec);
 r := RecNo;
 Term := Chr($1A);
 Go(RecCount);
  BlockWrite(Fich,Buffer^,Header.LenData);
 BlockWrite(Fich,Term,1);
 For i:=RecCount-1 DownTo r do
 Begin
 Go(i);
 BlockWrite(Fich,Buffer^,Header.LenData);
 end;
 Seek(Fich,(r-1)*Header.LenData+Header.LenHeader);
 FillChar(Buffer^,Header.LenData,Chr($20));
 {$I-} BlockWrite(Fich,Buffer^,Header.LenData); {$I+}
 DBOk := (IOResult=0);
end;
 
 
{ +-------------------------------------------------------------------------+
 ¦  ¦
 ¦ DELETED : Indique si l'enregistrement en cours est marqué ¦
 ¦ ¦
 +-------------------------------------------------------------------------+ }
 
Function DBObj.Deleted;
 
Begin
 Deleted := Buffer^[0] = Chr($2A);
end;
 
{ +-------------------------------------------------------------------------+
 ¦ ¦
 ¦ BOF : Indique que l'enregistrement en cours est le premier de la base ¦
 ¦ ¦
 +-------------------------------------------------------------------------+ }
 
Function DBObj.BOF;
 
Begin
 If RecNo=1 Then BOF := True else BOF := False;
end;
 
{ +-------------------------------------------------------------------------+
 ¦ ¦
 ¦ EOF : Indique que le pointeur a lu le dernier enregistrement ¦
 ¦ ¦
 +-------------------------------------------------------------------------+ }
 
Function DBObj.EOF;
 
Begin
 EOF := System.EOF(Fich);
end;
 
{ +-------------------------------------------------------------------------+
 ¦ ¦
 ¦ GET : Retourne le contenu du champ N de l'enregistrement en cours ¦
 ¦  ¦
 +-------------------------------------------------------------------------+ }
 
Function DBobj.Get;
 
Var S : String;
 
Begin
 DBOk := True;
 S := '';
 If (N<1) or (N>NbFields) then DBOk := False
  else
 begin
 Move(Fields[N]^.Addr^,S[1],Fields[N]^.Dim);
 S[0] := Chr(Fields[N]^.Dim);
 end;
 Get := S;
end;
 
{ +-------------------------------------------------------------------------+
 ¦  ¦
 ¦ PUT : Modifie le champ N de l'enregistrement en cours ¦
 ¦ ¦
 +-------------------------------------------------------------------------+ }
 
Procedure DBObj.Put;
 
Var Nb : Real;
 Li : LongInt;
 Err : Integer;
 T : Char;
 
Begin
 DBOk := True;
 T := FieldType(N);
 If Not(DBOk) then exit;
 Case T of
 'C' : Begin
 If Length(S)>Fields[N]^.Dim then S := Copy(S,1,Fields[N]^.Dim)
 else While Length(S)<Fields[N]^.Dim Do S := S + ' ';
 end;
 'D' : Begin
 Val(S,Li,Err);
 DBok := (Err=0) and (Length(s)=8);
 If Not(DBOk) then Exit;
 end;
 'L' : If (Length(S)<>1) or not(Upcase(S[1]) in ['?','Y','O','N','T','F'])
 then Begin
 DBOk := False;
 end;
 'M' : Begin
 Val(S,Li,Err);
 DBOk := (Err=0) and (Li>0);
  If Not(DBOk) then Exit;
 Str(Li:10,S);
 end;
 'N' : Begin
 Val(S,Nb,Err);
 DBOk := Err=0;
 If Not(DBOk) Then Exit;
 If Fields[N]^.Dec=0 Then Str(Nb:Fields[N]^.Dim:0,S)
  else Str(Nb:Fields[N]^.Dim-Fields[N]^.Dec-1:Fields[N]^.Dec,S);
 end;
 end;
 Modified := True;
 Move(s[1],Fields[N]^.Addr^,Fields[N]^.Dim);
 Seek(Fich,FilePos(Fich)-Header.LenData);
 {$I-} BlockWrite(Fich,Buffer^,Header.LenData); {$I+}
 DBOk := (IOResult=0);
end;
 
{ +-------------------------------------------------------------------------+
 ¦ ¦
 ¦LOCATE : Recherche une chaîne de caractére dans le champ N de la base ¦
 ¦ à partir de l'enregistrement en cours. ¦
 ¦ L'enregistrement trouvé devent celui en cours, sinon le pointeur¦
 ¦ est placé sur le dernier est la fonction retourne FALSE. ¦
 ¦  ¦
 +-------------------------------------------------------------------------+ }
 
Function DBObj.Locate;
 
Begin
 DBOk := True;
 If (N<1) or (N>NbFields) then DBOk := False
 else While Not(EOF) and (Pos(S,Get(N))=0) do Skip;
 Locate := Pos(S,Get(N))<>0;
end;
 
Begin
end.

Listing du programme de test

{ +-------------------------------------------------------------------+
 ¦ PROGRAMME D'ESSAI DE L'UNITE DBASE.TPU ¦
 ¦-------------------------------------------------------------------¦
 ¦ Copyright (c) 1992 par Frédéric HARDY pour Réponse Micro ¦
 +-------------------------------------------------------------------+ }
 
Program DBTest;
 
Uses CRT, DBase;
 
 
Var D : DBObj;
 i, c : Byte;
 l : LongInt;
 DF : String;
 
Begin
 Repeat
 Write('Nom du fichier DBASE : ');
 ReadLn(DF);
 D.Open(DF);
 If Not(D.DBOk) then WriteLn('Fichier non trouvé !!!');
 Until D.DBOk;
 WriteLn;
 WriteLn('Fichier : ',D.FileName);
 WriteLn('No Version : ',D.Version);
 WriteLn('Nb d''enreg. : ',D.RecCount);
 If D.IsMemo then WriteLn('Avec mémo');
 Repeat
 
 WriteLn;
 WriteLn('1 - Affichage de la structure du fichier');
 WriteLn('2 - Affichage des enregistrements');
 WriteLn('3 - Recherche d''une chaîne de caractére dans un champs');
 WriteLn('4 - Marque un enregistrement');
 WriteLn('5 - Démarque un enregistrement effacé');
 WriteLn('6 - Efface les enregistrements marqués');
 WriteLn;
 WriteLn('0 - Quitter');
 WriteLn;
 
 Repeat
 Write('Votre choix : ');
 {$I-} ReadLn(C); {$I+}
 until (IOResult=0);
 
 Case C of
 
 { -- Affichage de la structure du fichier DBase -- }
 
 1 : Begin
 ClrScr;
 For i:= 1 to D.NbFields do WriteLn(D.FieldName(i):11,' ',
 D.FieldType(i),' ',D.FieldLength(i));
 end;
 
 { -- Affichage des enregistrementes du fichier DBase -- }
 
 2 : Begin
  ClrScr;
 D.Go(1);
 While Not(D.EOF) do
 Begin
 { -- Affichage du numéro d'enregistrement -- }
 Write(D.RecNo:4);
 { -- Indique si l'enregistrement est effacée -- }
 If D.Deleted Then Write('*') else Write(' ');
 { -- Affichage de l'enregistrement -- }
 For i:=1 to D.NbFields do Write(D.Get(i),' ');
 WriteLn;
 { -- Enregistrement suivant -- }
 D.Skip;
  end;
 end;
 
 { -- Recherche d'une chaine de caractére dans un champ -- }
 
 3 : Begin
 ClrScr;
 D.Go(1);
 Repeat
 Write('No du champ :');
 {$I-} ReadLn(c); {$I+}
  Until (IOResult=0);
 Write('Chaine de caractére à rechercher :');
 ReadLn(DF);
 While D.Locate(C,DF) do
 Begin
 Write(D.RecNo:4);
 For i:=1 to D.NbFields do Write(' ',D.Get(i));
  WriteLn;
 D.Skip;
 end;
 end;
 
 { -- Efface un enregistrement -- }
 
 4 : Begin
 WriteLn;
 Repeat
 Write('No de l''enregistrement à marquer :');
 {$I-} ReadLn(l); {$I+}
 Until (IOResult=0);
 D.Go(l);
 If D.DBOk then D.Delete
 else WriteLn('Enreregistrement non trouvée');
 end;
 
 { -- Rappele un enregistrement effacé -- }
 
 5 : Begin
  WriteLn;
 Repeat
 Write('No de l''enregistrement à démarquer :');
 {$I-} ReadLn(l); {$I+}
 Until (IOResult=0);
 D.Go(l);
 If D.DBOk then D.Recall
 else WriteLn('Enreregistrement non trouvée');
 end;
 
 6 : Begin
 ClrScr;
 Write('Effacement des enregistrements marqués en cours ...');
 D.Pack;
 WriteLn(#13);
 end;
 
 7 : D.Insert;
 
 end;
 Until (c=0);
 D.Close;
end.
 

---

© COPYRIGHT 1992 PAR F.HARDY